编程爱好者电子杂志 2001年第六期

自从ASP（Active Server Pages）问世以来，因其可以创建健壮易于维护、与平台无关的应用系统，ASP技术受到了越来越多网络程序员的喜爱，使用ASP从事WEB开发的人也越来越多。但ASP只是一种非编译型的、在服务端运行的脚本语言，采用明文(plain text)方式来编写，即使采用了ASP加密程序对ASP源码进行加密，也不一定能保证发布到运行环境中去的ASP应用程序不被非法拷贝。对于高权限的管理员，可以轻而易举从服务器端拷贝出ASP程序应用到别的非授权网站。这样给ASP应用商业化带来了一定的困难。如何有效保护开发出来的ASP程序，本文基于磁盘序列号产生的随机性，结合微软官方免费提供的ASP脚本加密程序SCRENC.EXE，很好地解决了这个问题。

磁盘序列号，简称磁盘ID，是对磁盘进行格式化时随机产生的磁盘标识信息，是一个卷序列号。同一机器两次格式化随机产生固定格式的序列号相同几率几乎为零， DOS的后期版本和WINDOWS、WINNT均采用了这种磁盘标识方式，因而磁盘序列号常被运用用于商业化软件进行加密使用。从WINDOWS9.X切换到MS-DOS方式，键入DIR命令后回车，屏幕出现当前卷标序列号信息，这个类似"0A48-1CD7"的序列号是一个16进制数。一些限期使用的软件，在使用期限到了之后，会要求使用者在线申请新的授权序列号（使用许可）。这种授权序列号相当一部分是采用了静态磁盘序列号结合时间产生的。安装完毕之后的软件，程序即使被非法拷贝到非初始安装环境中，也不能使用。

上述思想用VC、VB及DELIPHI编程语言都容易实现，那么，在ASP中又如何实现呢？VBScript作为一种健壮的、安全的用户语言，是受客户机系统限制的，不能处理客户机上API的调用，也不能直接操纵客户机上的文件和文件系统之外的控件。因而本文采用VBScript并结合ASP内置组件FileSystem来实现上述思想。以下程序根据具体情况略加修改，可以应用于实际的ASP应用系统。

作为讲解实例，本文用到Access数据库安全机制，实际应用中，可以用其它格式的文件存放的数据。为便于阐述，我们先建一个Access数据库ID.mdb(密码为"kxj")，内建一个DriveInfo表，数据结构如下：

id(自动编号) ；

Serno（文本，12，磁盘序列号（10进制））；

Wrimark（数字，1，写盘标志，）。

说明

Wrimark 值为0代表合法用户未安装系统，值为1代表该系统已安装。当值为1且序列号与当前盘不符时，则判定为非法拷贝用户。

初始化时先定义一个新记录，各字段初始值分别为1,12345678,0。

在同一目录下，例如C:\INTERPUB\WWWROOT下，放置首页Default.asp，合法用户首页Success.asp，非法安装用户提示页Fail.htm及ID.mdb序列号存放库。

各ASP文件的编写操作如下：

1、用FrontPage（或NotePad），新建一个ASP文件Default.asp，录入以下程序代码：

＜html＞

＜head＞

＜title＞Sample＜/title＞

＜/head＞

＜% dim conn,fs,f

Set conn = Server.CreateObject("ADODB.Connection")

conn.open "driver={Microsoft Access Driver (*.mdb)};uid=;pwd=kxj;dbq="&server.mappath("id.mdb")

set fs=server.createObject("scripting.filesystemobject")

testDrive=Server.MapPath("/DRIVEINFO.ASP")

'通过MapPath获得当前盘盘符

testDrive=Left(testDrive,3)

set f=fs.getdrive(testDrive)

'调用GetDrive方法，将驱动器赋予一个变量

Mysql="SELECT * From driveinfo where id=1"

set rsCheck = Server.CreateObject("ADODB.Recordset")

rsCheck.open Mysql,conn,1,1

FSER=trim(f.serialnumber)

'获得当前盘序列号

StrSerno=trim(rsCheck.fields("SERNO"))

StrMark=rsCheck.fields("WRIMARK")

if StrSerno＜＞FSER and StrMark=0 then

'若是首次安装，则置写盘标志为1

session("pass")=true

'定义用户Session，并置为全局ASP文档标识变量

set rsMain = Server.CreateObject("ADODB.Recordset")

Mysql1="update driveinfo SET SERNO="&FSER&", WRIMARK=1"

rsMain.open Mysql1,conn,1,2

response.write("＜a href='success.asp'＞SETUP

SUCCESSFUL!WELCOME TO ACCESS THE WEBSITE!＜/a＞")

set rsMain=nothing

else

if StrSerno=FSER then

'若是合法用户再次合法进入

session("pass")=true

response.write("＜a href='success.asp'＞YOU ARE AUTHORIZED BY THE WEBSITE MANAGER，WELCOME TO ACCESS !＜/a＞")

else

'非法拷贝用户

session("pass")=false

response.write("＜a href='fail.htm'＞IT IS ILLEGAL TO COPY THE WEBSITE'S ASP DOCUMENT.YOU ARE NOT RIGRT TO USE THE PROGRAM.＜/a＞")

end if

response.write("＜br＞")

response.write("Volume Serial Number in drive "&testDrive)

response.write(f.serialnumber)

response.write("＜br＞")

response.write("Volume hex Serial Number in drive "&testDrive)

response.write(hex(f.serialnumber))

response.write("＜br＞")

'作为演示，本程序把当前盘序列号列出来(16进制)

set f=nothing

set fs=nothing

%＞

＜/html＞

2、在合法用户可以访问的各个ASP文件头部，添加如下代码：

＜% if Session("pass")=false then

'对Session变量进行判定，非法则跳出本ASP文件

response.redirect("fail.htm")

end if

%＞

3、用ASP加密程序（例如微软公司的SCRENC.EXE，别的ASP加密程序也可以）对各个ASP文件进行加密。

在DOS状态下运行SCRENC -l vbscript source.asp destination.asp，即把源文件source.asp生成了包含密文ASP脚本的新文件destination.asp。SCRENC.EXE可以在微软公司站点（http://www.microsoft.com免费下载）。

以上程序代码在简体中文NT4.0、IIS3.0及简体中文PWIN9.8、PWS4.0下通过。

回到目录

用VC++ 6.0制作网络自动测试程序

由MICROSOFT公司开发的WINDOWS SOCKETS提供了WINDOWS环境下网络通讯的编程接口。在VC++6.0中，可以通过调用WINDOWS SOCKETS函数，采用原始套接字（RAW SOCKETS）类型和互连网控制消息协议（ICMP），来编制一个能实现PING功能的函数。通过定时调用该函数，就可实现网络的自动测试。若再加上语音报警功能，就是一个很实用的网络测试程序。本文拟介绍实现此功能的程序的制作方法。

为便于说明起见，我们还是按撚肰C++6.0制作网络测试程序斠晃慕樯艿姆椒ǎ茸鲆桓黾虻サ耐绮馐猿绦颍∟etest）。注意，在制作Netest工程的STEP 4 OF 6时，要钩选WINDOWS SOCKETS选项。否则，在下面要编译AUTOP.CPP文件时，将会出错。在Netest工程编译成功后，再做以下几项工作：

一、增加AUTOP. CPP到工程文件中

在工程à添加工程à文件à将AUTOP.CPP添加到当前工程文件中（AUTOP.CPP的源码见下面第三节的内容所示，应事先将其COPY到当前工程的目录中）。

二、在工程中增加自动测试的有关菜单和函数

（1）在撚肰C++6.0制作网络测试程序斠晃慕樯艿腘etest工程中，其Readinfo()函数的最后一条语句GlobalFree(hHost)释放了装载有初始化信息的内存，当随后调用PING.EXE时，问题不是很大。但若调用WINSOCK函数，内存中的初始化信息会被冲掉。所以须将该语句移到程序结束处再执行。可如下增加OnDestroy()函数：

在ClassWizard中，对应Class name=CNetestView， Object IDs= CNetestView，Message =WM_DESTROY，点击Add FunctionàOnDestroyàEdit Code,增加相应代码如下：

void CNtestView::OnDestroy()

{

CFormView::OnDestroy();

GlobalFree(hHost); //从Readinfo()移到此

for (int i=0; i<nodeNum; i++)

DeleteObject(lpHost[i].hrgn);

}

（2）增加自动测试菜单Autotest：在资源工作区，选中MENUàIDR_MAINFRAMEà点中空的菜单条à属性à令ID=ID_AUTOTEST，标题=Autotest。

在ClassWizard中，对应Class name=CNetestView，Object IDs=ID_AUTOTEST，Message =COMMAND，点击Add FunctionàOnAutotest àEdit Code,增加相应代码如下：

void CNtestView::OnAutotest()

{

SetTimer(1, 30000,NULL)； //each 30s interupt 1 time.

Tc=20;

CWnd* pParent=GetParent();

CMenu * pMenu=pParent->GetMenu();

pMenu->EnableMenuItem(ID_AUTOPING,MF_BYCOMMAND| MF_DISABLED | MF_GRAYED);

pMenu->EnableMenuItem(ID_STOPAUTO,MF_ENABLED);

AfxGetMainWnd()->SendMessage (WM_TIMER,0, 0L);

}

其中SetTimer()将定时器设为每30秒中断一次。由Tc计算中断次数。余下几句条语句令Autotest菜单变灰，以免多次重入。最后一条语句使得鼠标点击Autotest菜单后，即转到OnTimer()函数开始自动测试。

（3）增加定时测试代码。在ClassWizard中，对应Class name=CNetestView的Message，选中WM_TIMERàAdd FunctionàEdit Code，在OnTimer() 函数中增加如下代码：

void CNetestView::OnTimer(UINT nIDEvent)

{

if(Tc++<20) return;

KillTimer(1);

Tc=0;

BOOL bOK=TRUE;

InvalidateRect(NULL);

for(int ipT=0;ipT

{

if(Autotest(lpHost[ipT].nodeIP,3)==FALSE) {

CString strerr;

strerr.Format("err%d.wav",ipT+1);

sndPlaySound(strerr, SND_LOOP |SND_ASYNC );

HDC hdc= CreateDC("DISPLAY",0,0,0);

SelectObject(hdc,lpHost[ipT].hrgn);

InvertRgn(hdc,lpHost[ipT].hrgn);

DeleteDC(hdc);

bOK=FALSE;

}

else if(bOK) sndPlaySound("Bird0.wav", SND_ASYNC);

}

SetTimer(1, 30000,NULL);

CFormView::OnTimer(nIDEvent);

}

本程序设计为每10分钟对网络作一次自动测试。所以第一条语句须检查定时器中断是否已够20次（30秒*20=10分钟）。若够的话，就关断定时器,循环调用Autotest()对所有网络节点进行测试。若Autotest()的返回值为FALSE，说明该节点有问题，随即调用对应声波文件发出不停的报警声。在报警的同时，程序继续往下运行，作余下网络节点的测试。若所有节点均正常，则调用BIRD0.WAV声波文件发出动听的鸟鸣声。全部节点测试完后，才用SetTimer()再次启动定时器。

报警声波文件的制作，可在WINDOWS的附件à娱乐à录音机，通过麦克风录下报警语音。按照在INFO.INI文件中各节点的顺序，将语音文件分别存为ERR1.WAV，ERR2.WAV……。这样，网络节点的报警声就能和出错节点正确对应。

测试时，若有2个以上网络节点有问题，前一个出错节点只会报警一次，最后一个出错节点则会发出循环报警声。为了便于用户观察出错情况，用InvertRgn()来反相显示出错节点的区域。InvalidateRect(NULL)函数用来使屏幕刷新，以便下一次测试的观察。

三、AUTOP.CPP的源码及说明

AUTO.CPP的源码如下：

//#include 头文件略

. . . . . . . . . . .

typedef struct _ihdr {

BYTE i_type, i_code;

u_short i_cksum,i_id, i_seq;

}IcmpHeader;

struct sockaddr_in saDestAddr;

CString Messtr,Tmpstr;

u_short checksum(u_short *buffer, int size) {

. . . . . . .（略）

}

BOOL Autotest(char far * szDestHost,int Ktest)

{

WSADATA wsaData;

SOCKET sockRaw;

struct sockaddr_in dest,from;

char icmp_data[10], recvbuf[100];

unsigned int addr=0;

int fromlen = sizeof(from);

int timeout = 1000; //ms

WSAStartup(MAKEWORD(2,1),&wsaData) ;

sockRaw = socket (AF_INET,SOCK_RAW,IPPROTO_ICMP);

setsockopt(sockRaw,SOL_SOCKET,SO_RCVTIMEO,

(char*)&timeout,sizeof(timeout) );

memset(&dest,0,sizeof(dest));

dest.sin_family = AF_INET;

dest.sin_addr.s_addr= inet_addr(szDestHost);

memset(icmp_data,0,sizeof(icmp_data)); //clear icmp_data.

((IcmpHeader*)icmp_data)->i_type = 8; //ICMP_ECHO

((IcmpHeader*)icmp_data)->i_code = 0;

((IcmpHeader*)icmp_data)->i_id = (u_short)GetCurrentProcessId();

((IcmpHeader*)icmp_data)->i_seq = 0;

for(int k=0; k

{

((IcmpHeader*)icmp_data)->i_cksum = 0;

((IcmpHeader*)icmp_data)->i_seq ++;

((IcmpHeader*)icmp_data)->i_cksum=checksum((u_short*)icmp_data,8);

sendto(sockRaw,icmp_data,8,0,(struct sockaddr*)&dest,sizeof(dest));

int bread=recvfrom(sockRaw,recvbuf,1024,0,(struct sockaddr*)&from,

&fromlen);

if (bread == SOCKET_ERROR){

if(k==Ktest-1) goto ERR1 ;

else continue; //try again(3 times)

}

return TRUE; //no erros.

ERR1:

closesocket (sockRaw);

sockRaw= INVALID_SOCKET;

WSACleanup();

return FALSE;

}

为简洁起见，源码中大部分的出错处理语句都删去了。整个函数执行的过程如下：

(1)用WSAStartup()函数初始化WINSOCK DLL。

(2)用socket()函数建立一个原始套接字sockRaw。

(3)用setsockopt()函数来设置套接字的选择项。这里用SO_RCVTIMEO参数来设置接收超时。超时值由timeout=1000设定超时最长时间为1秒钟。

(4)给被测节点的dest和Icmpheader结构变量赋值。其中szDestHost放被测节点的IP地址(点间隔格式)，inet_addr()函数将一个点间隔的地址转换成4字节的地址；Icmpheader结构的i_type=8表示发送一个请求响应数据包（ICMP_ECHO)，i_id为数据包的标识，i_cksum为数据包的校验和，i_seq用来为发送包计数。

(5)用sendto()函数向被测节点发送信息，用recvfrom()函数接收被测节点的应答信息。若在规定时间内（1秒）收不到应答信息，再连测2次。若3次的发送均收不到应答信息，可认为网络故障。Ktest的值决定对被测节点反复测试的次数。（当收到应答信息时，还认应检查应答信息内容正确后，才认为网络正常。本例略去这些检查似乎也无妨）。

(6)测试完一个节点后，用closesocket()函数关闭套接字，用WSAcCleanup()函数释放为应用程序分配的资源。

至此，就可以编译和执行程序，体会个中乐趣。

回到目录

美化你的文字

想玩点文字横向拉宽的特效吗？很简单，你不需要去计算什么 Width + 1 之类的象素值，只需调用一个 API 函数，就可以搞定！她就是棗SetTextCharacterExtra()

这个函数的作用是改变字符串中各字符的间隔大小。想去开 API Viewer 了吗？且慢！API Viewer 中对此函数的声明有问题！！！怎么搞的？不知道，问微软去吧。

API Viewer 的声明：Private Declare Function SetTextCharacterExtra Lib "gdi32" Alias "SetTextCharacterExtraA" (ByVal hdc As Long, ByVal nCharExtra As Long) As Long

应该是：Private Declare Function SetTextCharacterExtra Lib "gdi32" (ByVal hdc As Long, ByVal nCharExtra As Long) As Long

即：API Viewer 中多加了在 gdi32.dll 中的入口（"SetTextCharacterExtraA"），不信你试试，准说撊肟诤也坏綌。好了，知道了问题就好办了，你先准备一个 PictureBox 吧，我们就用它的 hDC。

Private I As Long

Private Sub Timer1_Timer()

Timer1.Interval = 100

With Picture1

.Cls

SetTextCharacterExtra .hdc, I

Picture1.Print "Midnight"

I = I + 1

If I >= 30 Then I = 1

End With

End Sub

当然，我这里用的是 Timer，你如果觉得 CPU 占用率太高的话，就自己改嘛，比如说加在一个循环中，用系统时钟的 Timer 值来控制间隔时间就行了。

最后，美化你的 PictureBox，改一个好看的字体、醒目的颜色，甚至在循环中改变颜色和字体大小、用 Step 值使它左右循环拉伸等等，随你怎么改！

回到目录

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;

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;

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

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;

以上简要谈了谈数据库的树状显示的基本方法，另外，编辑树上节点的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;

三.动态生成控件的方法及应用

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;

注:

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;

注：

(a).MachineBurthen[i]为一实型数组，其值为对应设备的利用率，已在另一函数中计算得到；

(b). MachinesBurthenCharts为TChart控件，在type段说明。

3.程序运行结果显示

(1).动态生成Shape控件，显示零件排产计划图(略)

(2).动态生成Chart控件的ChartSeries组件，显示设备利用率(略)

回到目录

VFP7 中的语言增强

想要偷看一眼在VFP7中有什么新内容吗？Doug Hennig 讨论了 Microsoft 实现的语言增强以及怎样现在就利用它们的途径，这是一系列文章的第一篇。

在 Foxtalk 2000年12月刊里我的文章（"Reusable Tools: Have Your Cake and Eat it, Too"，译者注：这篇文章是要收费的，我们无法得到，所以没办法翻译给大家了，我们甚至不知道这篇文章的后续部分是否要收费，那样的话我们也得不到了。:-{ ）中，我讨论了“版本嫉妒”：想要在一个产品的现有版本中使用未发行版本中将要提供的新功能。在那篇文章中，我讨论了在VFP7中的几个新的函数并演示了几个在VFP6中能够实现它们的功能的PRG。在读了那篇文章以后，Foxtalk的编辑 Whil Hentzen 认为这是一个很棒的主意：把内容扩展到涵括VFP7中所有的新命令和函数，使你熟悉它们，如果可能的话，甚至在VFP6中使用它们。

那么，我们以这个主意开始新的一年并花费几个月的时间去看看VFP7中的语言增强。我们不会讨论VFP7中的每样新的事物（例如智能感知、编辑器增强、DBC事件等等），覆盖那么广泛的主题将需要一本书的内容。相反，我们将关注于与三件事有关的命令和函数：

我们简要的考虑每个命令和函数的目的而不去陷入细节的泥潭（例如，我将不会讨论参数或者返回值的细节，你可以从VFP7的帮助中了解它们）

我们将看看怎样来实际使用这些命令和函数

如果可能的话，我们将探索现在在VFP6中获得这些功能的途径

记住，当我写这篇文章的时候，VFP7甚至还不是一个BETA版（它被当作一个技术预览版），而这篇文章是基于2000年9月在DevCon发布的版本。所以，命令和函数可能会被添加、取消、或者改变。

让我们从已经存在的命令和函数开始，按字母的顺序通过它们。一旦我们完成了这些，我们将转移到新的命令和函数。

ALINES()

从 ALINES() 被介绍开始，它就成了我最喜爱的函数之一。它传递一个字符串（可能在一个变量或者备注字段中）到一个以回车符（CR）、换行符(LF)或者回车换行的结合体(CRLF)结束的行，并把每一行放到一个数组中的它自己的元素中。Alins()现在可以接受一个或者多个字符表达式，所以，“行”可以被除了CR和LF以外的一些东西所分隔。例如，一个用逗号分隔的字段名列表可以很容易的被转换到一个数组。为什么你要这么做呢？因为它处理一个数组要比处理一个逗号分隔的字符串容易的多。这里是一个处理一个字符串中的数据项的野蛮的途径：

lnItems = occurs(',', lcString) + 1

lnOld = 1

for lnI = 1 to lnItems

lnPos = iif(lnI = lnItems, len(lcString) + 1, ;

at(',', lcString, lnI))

lcItem = substr(lcString, lnOld, lnPos - lnOld)

lnOld = lnPos + 1

* 在这里对数据项进行操作

next lnI

这段代码无论对读还是写来说都是一段丑陋的代码。这里是一个更优雅的处理方法，它把逗号转换成CR，然后使用ALINES():

lcString = strtran(lcString, ',', chr(13))

lnItems = alines(laItems, lcString)

for lnI = 1 to lnItems

lcItem = laItems[lnI]

* do something with lcItem here

next lnI

在VFP7里，这段代码开始的两行可以被减少到这个样子：

lnItems = alines(laItems, lcString, , ',')

AMEMBERS()

这是一个那些你不会经常使用的函数之一，但它在你需要它的时候非常的有用。 AMEMBERS()用一个对象或者类的属性、事件、方法（PEMs）填充一个数组。VFP7里的AMEMBERS() 有两个改变：你现在能够获得一个COM对象的PEMs，并且你能够为PEMs指定一个筛选条件。

给第三个参数传递一个3表示第二个参数是一个COM对象。这里是一个例子，为EXCEL把PEMs放到laPEMs数组中去:

oExcel = createobject('Excel.Application')

? amembers(laPEMs, oExcel, 3)

一个新增的第四个参数允许你筛选PEMs的列表，以便数组只包含一个希望得到的子集。例如，你也许想要被保护的、隐藏的、或者公共的PEMs，原有的或者用户自定义的PEMs、更改了的PEMs，等等。这是很顺手的，因为在VFP7以前，要筛选一个列表的PEMs唯一的办法只有一个接一个的使用 PEMSTATUS()。我使用下面的程序，, CopyProperties，在VFP6中拷贝一个对象的属性到与它属于同一个类的另一个实例上，为什么你会想那样做？想象一个表单，你给表单传递了一个对象并允许用户在表单的控制中编辑对象的属性。如果用户想要通过按下Cancel按钮来撤销他或她所做的修改时，该怎么办？我决定拷贝对象的属性到另一个属于同一个类的对象，并且然后让表单工作在新的对象上，如果用户选择了OK，那么拷贝被编辑了的对象的属性到当前对象中去。如果用户相反的选择了Cancel，当前对象不会被碰到一个毫毛。那么，表单建立另一个被传递来的对象所属类的实例，然后调用 CopyProperties 来从当前对象拷贝属性到新的实例上。这里是 CopyProperties 的代码（你也可以在附带的下载文件中的 COPYPROPERTIES6.PRG 找到它）：

lparameters toSource, ;

toTarget local laProperties[1], ;

lnProperties, ;

lnI, ;

lcProperty, ;

luValue

* 获得一个属性的数组并处理每一个

lnProperties = amembers(laProperties, toSource)

for lnI = 1 to lnProperties

lcProperty = laProperties[lnI]

do case

* 保证这个属性存在于目的对象中，不是只读并且不被保护。

* 注意：分隔 PEMSTATUS 语句让它单独作为一个工作区

* 因为如果 VFP 在一行代码中有两个这样的命令会产生问题

case not pemstatus(toTarget, lcProperty, 5)

case pemstatus(toTarget, lcProperty, 1)

case pemstatus(toTarget, lcProperty, 2)

* 如果这是一个数组属性使用, ACOPY (对元素0的检查是对一个

* VFP bug 的变通办法，这个 Bug 使得本身的属性看起来象是

* 一个数组；就是说：TYPE('OBJECT.NAME[1]') is not "U")。

case type('toTarget.' + lcProperty + ;

'[0]') = 'U' and ;

type('toTarget.' + lcProperty + '[1]') <> 'U'

acopy(toSource.&lcProperty, toTarget.&lcProperty)

* 如果属性没有被改变，我们可以忽略它。注意：由于 PEMSTATUS()

* 中的一个 bug，这个 Bug 即使数组属性没有被改变也会返回 .F.，

* 我们必须在上面处理完数组后进行这个测试。

case not pemstatus(toSource, lcProperty, 0)

* 拷贝属性的值到目的对象中去。

otherwise

luValue = evaluate('toSource.' + lcProperty)

store luValue to ('toTarget.' + lcProperty)

endcase

next lnI

return

VFP7版本有一点简单。首先，它使用一个新的"G"标志，这样数组只能包含源对象的公共属性——以后我们就不需要为了忽略被保护的或隐藏的属性而使用 PEMSTATUS() 了。其次，虽然目前还有一个 bug 使它不能对数组属性进行操作，我们将能够使用一个新的"C"标志，这样数组就只能包含那些已经被从它们的默认值做出了改变的属性；当这个Bug被改正了以后（注意我乐观的态度并且我没有说“如果”），我们将能够取消为改变了的属性所做的 PEMSTATUS() 检查。最后，我已经对 Microsoft 提交了一个增强的要求（ER）为可读写属性提供一个标志。如果这个ER实现了，我们将能够取消为只读属性所做的 PEMSTATUS() 检查。这样，VFP7版本与VFP6中的对应者相比将更简单和快速。这里是 COPYPROPERTIES7.PRG 文件的代码（为了节省控件，我忽略了与VFP6版本中的那些相重复的注释）：

lparameters toSource, ;

toTarget

local lcFlags, ;

laProperties[1], ;

lnProperties, ;

lnI, ;

lcProperty, ;

luValue

* 获得一个公共数组，改变数组并处理每一个。注意：由于VFP7当前

* 版本的一个 bug 以至不会把被改变了的数组属性放入到数组中去，

* 我们将避免现在使用 "C" 标志并稍候测试一个改变了的属性。

* 注意：如果一个使我们能够筛选只读属性的标志被增加了，我们也

* 将添加它。

*!* lcFlags = 'G+C'

lcFlags = 'G'

lnProperties = amembers(laProperties, toSource, 0, ;

lcFlags)

for lnI = 1 to lnProperties

lcProperty = laProperties[lnI]

do case

* 确保存在于目的对象中的属性不是只读的。

* 注意：如果我们在以后的版本中能够筛选出只读属性，我们就能够去掉

* 第二个Case

case not pemstatus(toTarget, lcProperty, 5)

case pemstatus(toTarget, lcProperty, 1)

* 拷贝一个数组属性。

case type('toTarget.' + lcProperty + ;

'[0]') = 'U' and ;

type('toTarget.' + lcProperty + '[1]') <> 'U'

acopy(toSource.&lcProperty, toTarget.&lcProperty)

* 通常我们不需要这个 case 来测试一个没有改变过的属性，但现

* 在因为前面提到的数组属性 bug 的原因我们还需要它。

case not pemstatus(toSource, lcProperty, 0)

* 拷贝属性的值到目的对象中去

otherwise

luValue = evaluate('toSource.' + lcProperty)

store luValue to ('toTarget.' + lcProperty)

endcase

next lnI

return

顺便说一句，如果你查看 COPYPROPERTIES7.PRG 文件，你将看到在文件顶部的注释中包含我的 Email 和网址，它们显示为蓝色并且带着下划线，就像在你的浏览器中的一个超级链接。单击它们的任何一个将得到预期的动作（一个发送信件对话框其中已经填入了我的Email地址，或者在你的浏览器中查看我的主页）。这个编辑器增强使得在其它程序员和你的主页之间可以简单的直接联系，以获得技术支持、更多的信息或者文档、升级，等等。

TESTCOPYPROPERTIES.PRG 演示了怎样使用 CopyProperties。改变调用 CopyProperties6 的语句为调用 CopyProperties7 以查看 VFP7 版本怎样工作。

这里是另一个有点类似的使用 AMEMBERS() 的例子。PERSIST.PRG 提供了一个保存一个对象的属性的途径，以供在另一时间进行恢复（例如，下一次用户运行应用程序）。它建立了一个可以被储存的字符串，例如，保存在一个表的备注字段中。这个字符串中包含可以被用来恢复一个对象的属性的代码。例如，这个字符串看起来可能象是这样：

.cType = 'C'

dimension .aTest[3]

.aTest[1] = 'string1'

.aTest[2] = 'string2'

.aTest[3] = 'string3'

在从字符串被保存的地方找回它以后，你最好像这样做一些事情来恢复被保存的属性（在这个例子里，lcPersist 包含那个字符串）：

oObject = createobject('MyClass')

with oObject

execscript(lcPersist)

endwith

这里例子使用了 VFP7 中新增的 EXECSCRIPT() 函数，我将在下个月讨论它。

在这里我就不展示 PERSIST.PRG 的代码了，不仅因为空间限制还因为它非常类似于COPYPROPERTIES7.PRG 。要看看这个程序怎么运作，运行 TESTPERSIST.PRG。

ASCAN()

有两件事情我已经期待了很长时间了，我希望 Microsoft 给 ASCAN() 增加能够指定在那个列中搜索和随意的返回列而不是元素（以避免随后还必须调用 ASUBSCRIPT() 来获得列）的功能。我的愿望在 VFP 7 里实现了，增强的 ASCAN() 获得了精确的或者大小写不敏感的能力。新的第五个参数指定在那个列中搜索，同时新的第六个参数是一个“标志”设置，由它来判定返回值使一个元素还是列，以及使精确搜索还是大小写不敏感的搜索。

因为我总是想要获得行而从不需要数组元素的编号，一般想要大小写不敏感而不是精确搜索，并且很难准确的记住为标志使用哪个值 (年轻的读者可不要讲俏皮话 ), 我建立了 ArrayScan，它接收一个数组，要搜索的值，在那个列中搜索 (默认的列是 1)，和用来覆盖精确和大小写不敏感设置的逻辑参数。这里是在 ARRAYSCAN7.PRG 中的代码(为了简洁起见，我忽略了开头的注释和声明语句):

lparameters taArray, ;

tuValue, ;

tnColumn, ;

tlNotExact, ;

tlCase

external array taArray

local lnColumn, ;

lnFlags, ;

lnRow

* Determine how we're going to do things based on

* parameters.

#define cnEXACT_OFF 4

#define cnEXACT_ON 5

#define cnCASE_SENS 0

#define cnCASE_INSENS 1

#define cnRETURN_ROW 8

lnColumn = iif(type('tnColumn') = 'N', tnColumn, 1)

lnFlags = iif(tlNotExact, cnEXACT_OFF, cnEXACT_ON) + ;

iif(tlCase, cnCASE_SENS, cnCASE_INSENS) + ;

cnRETURN_ROW

* Do the search and return the row it was found in.

lnRow = ascan(taArray, tuValue, -1, -1, lnColumn, ;

lnFlags)

* Note: A bug in the current version of VFP 7 returns a

* row value 1 too high if the search column is the last

* one.

lnRow = iif(lnRow > 0 and lnColumn = alen(taArray, 2), ;

lnRow - 1, lnRow)

return lnRow

在 VFP 6中，我们能够做一些类似的事情，但由于我们没有新的 ASCAN() 的能力，我们必须使用一个不同的手段：我们将使用 ASCAN() 来找到那个值而不管它在数组的任何地方，然后判定它是否在正确的列中。如果不是，我们将改变开始的元素编号并再试一次。ARRAYSCAN6.PRG 有着与 ARRAYSCAN7.PRG 几乎同样的功能。（尽管它比较慢并且代码更复杂），除了支持大小写不敏感以外——要实现那个功能，你最好通过野蛮的方法遍历数组中的每一个列并在期望的列中查找大小写不敏感的匹配的方法。

lparameters taArray, ;

tuValue, ;

tnColumn, ;

tlNotExact

external array taArray

local lnColumn, ;

lnRow, ;

lnRows, ;

lnColumns, ;

lnElement, ;

lnStartElement, ;

lnCol

lnColumn = iif(vartype(tnColumn) = 'N', tnColumn, 1)

lnRow = 0

lnRows = alen(taArray, 1)

lnColumns = alen(taArray, 2)

lnStartElement = 1

do while .T.

lnElement = ascan(taArray, tuValue, lnStartElement)

if lnElement <> 0

lnCol = iif(lnColumns > 1, ;

asubscript(taArray, lnElement, 2), 1)

if lnCol = lnColumn and (tlNotExact or ;

taArray[lnElement] == tuValue)

lnRow = iif(lnColumns > 1, ;

asubscript(taArray, lnElement, 1), lnElement)

exit

endif lnCol = lnColumn ...

lnStartElement = lnElement + 1

else

exit

endif lnElement <> 0

enddo while .T.

return lnRow

TESTARRAYSCAN.PRG 演示了 ARRAYSCAN6.PRG 和 ARRAYSCAN7.PRG 怎样工作。

ASORT()

VFP 7 给 ASORT() 增加了一个新功能: 一个大小写敏感标志 (在 VFP 6里， ASORT() 总是大小写敏感的)。

BITOR(), BITXOR(), 和 BITAND()

现在，这些函数与它们在VFP6里只能接受两个参数相比，能够接受的参数要多的多。在VFP7里，它们能够接受最多27个参数。在几个标志必须被 oRed 在一起的情况下（例如某些API函数和COM对象）这是很有用的；在VFP6中，你不得不使用一些像 BITOR(BITOR(BITOR(expr1, expr2), expr3), expr4) 这样的事情来做这件事。

BROWSE

终于，我们获得了一个 BROWSE 的 NOCAPTION 选项，可以在浏览窗口中显示真正的字段名而不是定义在数据库容器的字段中的标题。你可以在 VFP6 中通过运行BROWSEIT.PRG 代替 BROWSE 来实现这个特性。这依靠于事实上一个浏览器窗口其实是一个表格，所以我们能够改变每一列的标题为真正的字段名。这里是 BROWSEIT.PRG 的代码：

browse name oBrowse nowait

for each loColumn in oBrowse.Columns

loColumn.Header1.Caption = ;

justext(loColumn.ControlSource)

next loColumn

COMPILE

在 VFP7 中，COMPILE命令(COMPILE, COMPILE CLASSLIB, COMPILE REPORT,等等)服从 SET NOTIFY 的设置。如果 SET NOTIFY OFF，没有“编译”对话框会显示。它之所以重要是因为两个原因：在加工 COM 服务器的过程中不能显示任何用户界面，并且你更倾向于不让你的用户看到那样一个对话框。

在 VFP6 中，我们能够通过使用 Windows API 函数 LockWindowUpdate 来抑制这个对话框，这个函数阻止更新一个窗口，类似于 VFP 的 LockScreen 属性（虽然这样但还是不会有助于加工 COM 服务器，因为这个对话框虽然看不到但还是要被调用的。）下载的文件包含 LOCKWINDOW.PRG，它接收 .T. 来防止窗口更新和接收 .F. 来恢复窗口更新。这里是这个 PRG 的代码：

lparameters tlLock

local lnHWnd

declare integer LockWindowUpdate in Win32API ;

integer nHandle

if tlLock

declare integer GetDesktopWindow in Win32API

lnHWnd = GetDesktopWindow()

else

lnHWnd = 0

endif tlLock

LockWindowUpdate(lnHWnd)

return

要阻止显示“编译”对话框，使用类似于下面这样的代码：

LockWindow(.T.)

compile MyProgram.prg

LockWindow()

回到目录