Delphi笔记大全

1. Record   ：
 

   TX     =     Record   
          A     :     Char;   
          B     :     Integer;   
    End;   
 
type TIntSet = set of 1..250;     
Set1 := [1, 3, 5, 7, 9];           //集合用[]来赋值
var MyArray: array[1..100] of Char;
 
type
TDateRec = record
      Year: Integer;
      Month: (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
      Day: 1..31;
end;

2. 执行exe:

ShellExecute()：

uses   ShellApi
ShellExecute(handle,nil,pchar('http://blog.youkuaiyun.com/cadenza7'),nil,nil,SW_SHOWNORMAL);

WinExec()： 

 uses  WINlApi 
<1>WinExec(’Notepad.exe Readme.txt’, SW_SHOW);  
<2> ShellExecute(handle, ‘open’, ‘  www.neu.edu.cn’, nil, nil, SW_SHOWNORMAL); 

  
3. 指针：
<1>类型指针的定义。
var
ptr : ^Integer;
ptr : ^char;
其实也就是符号的差别而已。
<2>无类型指针的定义。
ptr : Pointer;
 

4 ：测试一个过程变量是否被赋值

使用标准函数

Assigned：
if Assigned(OnClick) then OnClick(X);
 
5. DLL 的使用：
 
Function SetStationTime(Station:Byte):Integer;stdcall;External DllName;
 
7. 九九乘法表：

program ex414b;
   {$APPTYPE CONSOLE}
   var
     i,j:integer;
   begin
     for i:=1 to 9 do
       begin
       for j:=1 to i do
         write(j:1,'*',i:1,'=',i*j:2,' ':2);
         writeln;
       end;  
         readln
   end.

 
8 ：enter转到下一个控件：
   if key = #13 then
    Perform(WM_NEXTDLGCTL, 0, 0);
 
9. string Tstrings,Tstringlist区别：
    String就是一个果子   
  TStrings一串果子（多个果子串起来）   
  TStringList一串糖葫芦（将一串果子外面涂了糖）   
    
  而TList虽然也是一个链，但它是指针链，不只字符串链！
 
10．保存图片到数据库：

  procedure TABWholeEmployeeForm.SaveImage(field: TField; image: Timage);    //保存图片
{var
  stream : TMemoryStream;
begin
        //if image.Picture.Height > 0 then
        if openpic.FileName<>'' then
        begin
          stream:=TMemoryStream.create;
          image.Picture.Graphic.SaveToStream(stream);
          stream.Position := 0;
          TBlobField(field).LoadFromStream(stream);
          stream.Free;
        end
        else
        begin
         //field.Clear;
        end;
end; }
var
  pjpg:tjpegimage;
  pic:TMemoryStream;
  begin
  //adoquery1.Edit;
  //picdiag.Filter:='jpg';
  if openpic.FileName<>'' then                  //如果更换了图片，则载入
  begin
   try
    pjpg:=tjpegimage.Create;
    pjpg.LoadFromFile(openpic.FileName);
    pic:=TMemoryStream.Create;
    pjpg.SaveToStream(pic);
    pic.Position:=0;
    TBlobField(field).LoadFromStream(pic);
   except
    showmessage('图片格式不对，请选择jpg格式图片！');
   end;
  end;
  if  image.Picture.Height=0 then
   begin
    //field.Clear;
    TBlobField(field).AsVariant:=null;
   end;
 // adoquery1.post;
  openpic.FileName:='';
  try
  pic.Free;
  pjpg.free;
  except
  end;
  end;

 
5.ini文件：
Delphi提供了读写INI文件的方法，Delphi操作INI文件最为简洁，这是因为Delphi提供了一个TInifile类，使我们可以非常灵活的处理INI文件。   
一、INI文件的结构：
;注释
[小节名]
关键字=值
...
INI文件允许有多个小节，每个小节又允许有多个关键字，“=”后面是该关键字的值。 
值的类型有三种：字符串、整型数值和布尔值。其中字符串存贮在INI文件中时没有引号，布尔真值用1表示，布尔假值用0表示。 
注释以分号“;”开头。 
二、定义
1、在Interface的Uses节增加IniFiles； 
2、在Var变量定义部分增加一行： 
myinifile:Tinifile;
然后，就可以对变量myinifile进行创建、打开、读取、写入等操作了。 
三、打开INI文件
myinifile:=Tinifile.create(program.ini);
上面这一行语句将会为变量myinifile与具体的文件program.ini建立联系，然后，就可以通过变量myinifile，来读写program.ini文件中的关键字的值了。 
值得注意的是，如果括号中的文件名没有指明路径的话，那么这个Program.ini文件会存储在Windows目录中,把Program.ini文件存储在应用程序当前目录中的方法是：为其指定完整的路径及文件名。下面的两条语句可以完成这个功能： 
Filename:=ExtractFilePath(application.exename)+program.ini;
myinifile:=Tinifile.Create(filename);
四、读取关键字的值
针对INI文件支持的字符串、整型数值、布尔值三种数据类型，TINIfiles类提供了三种不同的对象方法来读取INI文件中关键字的值。 
假设已定义变量vs、vi、vb分别为string、integer、boolean类型。 
vs:=myinifile.Readstring(小节名,关键字,缺省值);
vi:=myinifile.Readinteger(小节名,关键字,缺省值);
vb:=myinifile.Readbool(小节名,关键字,缺省值);
其中缺省值为该INI文件不存在该关键字时返回的缺省值。 
五、写入INI文件
同样的，TInifile类也提供了三种不同的对象方法，向INI文件写入字符串、整型数及布尔类型的关键字。 
myinifile.writestring(小节名,关键字,变量或字符串值);
myinifile.writeinteger(小节名,关键字,变量或整型数值);
myinifile.writebool(小节名,关键字,变量或True或False);
当这个INI文件不存在时，上面的语句还会自动创建该INI文件。 
六、删除关键字
除了可用写入方法增加一个关键字，Tinifile类还提供了一个删除关键字的对象方法： 
myinifile.DeleteKey(小节名,关键字);
七、小节操作
增加一个小节可用写入的方法来完成，删除一个小节可用下面的对象方法： 
myinifile.EraseSection(小节名);
另外Tinifile类还提供了三种对象方法来对小节进行操作： 
myinifile.readsection(小节名,TStrings变量);可将指定小节中的所有关键字名读取至一个字符串列表变量中； 
myinifile.readsections(TStrings变量);可将INI文件中所有小节名读取至一个字符串列表变量中去。 
myinifile.readsectionvalues(小节名,TStrings变量);可将INI文件中指定小节的所有行（包括关键字、=、值）读取至一个字符串列表变量中去。 
八、释放
在适当的位置用下面的语句释放myinifile：
myinifile.free;
  
-------------------------------------------------------------------------------------------------------------------------
 

11．数据类型：

一、数据类型：

(1) 基本数据类型：
a、 整数类型： (通用类型<32位>：Integer－有符号；Cardinal－无符号)
具体：
有符号：Shortint<8位>，Smallint<16位>，Longint<32位 >
无符号：Byte<8位>，Word<16位>，LongiWord<32位 >

b、字符类型： (通用类型<8位>：Char －与AnsiChar等同)
具体：
AnsiChar<8位> ：主要存放Ansi字符
WideChar<16位>：主要存放Unicode字符

c、布尔类型： (通用类型<8位>：Boolean－与ByteBool等同)
具体：
ByteBool<8位>，WordBool<16位>，LongBool<32位>
不同的布尔类型主要用于鱼其它编程语言及不同windows系统兼容。

d、枚举类型：
定义：type 枚举类型标识符＝(key1[=val1],.。。。，keyn[=valn]) ：n<=255
如果给某些key指定了值，则未指定值的key是前一个key值加1；
如果全部默认不指定值，则key1值为0，往后逐个加1。

e、子界类型：
定义：type 子界类型标识符＝下界 ．．下界
如：type SubInt＝1．．3 0；表示 1～30的整数
type SubChar＝''''a''''．．''''z''''；表示字符
※注：1、以上四种类型称为有序类型，即除第一个数为都有先行数、除最后一个数外都有后继数。在这里 
(计算机里)，整数是有限的。有序类型的数都有一个序号，称为序数。整数的序数为其本身，其他类型第一

个数序数为0，依次递增。

2、子界类型上、下界必须是有同一有序类型，且上界序数大于下界序数。

f、浮点类型： (通用类型<8字节>：Real－与Double等同)
具体：
Double<8字节>，Real48<6字节>Single<4字节>,
Extended<10字节>，Comp<8字节>，Currency<8字节>
g、字符串类型： (通用类型：String－与AnsiString等同)
具体：
ShortString ：最多存放255个字符，第一个自己存放字符个数，不以NULL结尾
AnsiString ：存放Ansi字符，以NULL结尾
WideString：存放Unicode字符，以NULL结尾
h、时间、日期类型：TDateTime －实际是浮点类型的别称

(2)复杂数据类型：
a、指针类型：
定义：type 指针类型标识符＝^基本类型；
内在分配：New() 内存释放：Destroy()( 类型指针)
对于Pointer 和PChar 用GetMem()或AllocMem()分配内存(无类型指针)，用FreeMem()释放内存
分配内存后，就可以当成基本类型一样使用：指针类型标识符^
实际上常如下运用指针： 
var 变量标识符：^基本类型；
为变量分配内存后就可以将(变量标识符^)当成普通变量使用。
b、记录类型：
定义：type 记录类型标识符＝Record
字段1：类型；
．．．
字段n：类型；
end；
c、集合类型：
定义： type 集合类型标识符＝Set of 基本类型的子集或子界类型；(<=255个元素)
d、变体(通用)类型： Variant；
Delphi   2.0引进了一个功能强大的数据类型，称为变体类型(Variant)，主要是为了支持Ole自动化   
  操作。实际上，   Delphi的Variant封装了OLE使用的Variant，但Delphi  的Variant在Delphi  程序的其他领域   
  也很有用。正如不久就要学到的，   Object   Pascal是唯一能在运行期间和编译期间识别Variant的语言。   
  Delphi   3引进了一个新的被称为OLeVariant类型，它跟Variant基本一致，但是它只能表达与OLE   自   
  动化操作相兼容的数据类型。本节介绍Variant,然后介绍OLEVariant，并对两者进行比较。   
  1.   Variant能动态改变类型   
  有时候变量的类型在编译期间是不确定的，而Variant能够在运行期间动态地改变类型饩褪且?  
  入Variant   类型目的。例如，下面的代码在编译期间和运行期间都是正确的：   

  var
  V:   Variant;   
 begin 
  V:='Delphi   is   Great!';   //Variant   此时是一个字符串   
  V:   =   1   ;   //   Variant   此时是一个整数   
  V:   =   123.34   ;   //   Variant   此时是一个浮点数   
  V:   =   True   ;   //   Variant   此时是一个布尔值   
  V:=CreateOleObject('word.Basic');   //Variant此时是一个OLE   对象   
 end  ;   

 Variant能支持所有简单的数据类型，例如整型、浮点型、字符串、布尔型、日期和时间、货币以   
  及OLE自动化对象等。注意Variant不能表达Object   Pascal对象。Variant可以表达不均匀的数组(数组的   
  长度是可变的，它的数据元素能表达前面介绍过的任何一种类型，也可包括另一个Variant数组)。  
(3)数组类型：
a、一维数组：
定义：type 数组标识符＝Array[下标下限．．下标上限] of 基本类型；
b、多位数组：
定义： type 数组标识符＝Array[下限1．．上限１，．．．，下限n．．上限n] of 基本类型；
c、动态数组(变量)：
var 标识符：array of 基本类型；
SetLength(标识符，个数）；//分配空间
标识符:=nil；//释放
DELPHI基础数组类型
数组类型
数组是相同类型的元素按一定顺序组成的序列.数组中的每一个数据元素都可以通过数组变量名和一个惟一的索引号来存取,它们被顺序地安排在内存中的一段连续的存储区域.
数组可以分为一维数组和多维数组,从DELPHI5开始又引入了动态数组,因此,在DELPHI语言中,数据又可分为表态数组和动态数组两种类型.
数据类型的声明,数组也是高级数据类型,因此,在使用数组类型之前,应当首先使用保留字ARRAY进行类型声明.下面,我们以一维和二维,表态和动态数组为例,说明数组类型的声明格式.

一维静态数组的声明
type
数组标识符=array[下标类型] of 基类型:
二维静态数组的声明
type
数组标识符=array[下标类型] of array[下标类型] of 基类型;
一维动态数组的声明
type
数组标识符=array of 基类型;
二维动态数组的声明;
type
数组标识符=array of array of 基类型;
在上述声明语句中,下标类型必须是以子界形式给出的有序类型,基类型可以是除文件类型之外的任意数据类型.例如:
type
myarray1=array [1..10] of integer;
//一维静态数组,可以容纳10个整形数据
myarray2=array [1..10,’a’..’z’] of integer;
//二维表态数组,可以容纳20个字符串数据
myarray3=array of real;
//一维动态数组,可以容纳实型整数
myarray4=array of array of real;
//二维动态数组,可以容纳实型数据

数组变量及其使用,在声明了数组类型之后,就可以在程序中定义变量并在程序中使用,数组变量的定义仍然是使用保留字VAR,但对于表态数组变量和动态数组变量来说,它们的存储分配是不同的,静态数组在声明时通过下标给定了存储基类型数据的容量,因而,其变量所需的存储可以通过静态分配完成.而动态数据在声明时,没有使用下标指定存储基类型数据的容量,所以,其变量所需的存储只能通过标准例程SETLENGTH来动态进行分配.
数组变量在声明之后,对数组元素的访问是通过数组变量标识符和方括号界定的’’ 下标值”来进行的,对于静态数组变量,其下标值范围已经在类型声明时给出,而对于动态数组变量来说,动态分配存储之后,其下标值范围为0到容量-1.如果要释放一个不再用到的动态数组,可以将NIL赋值给该动态数组变量.
下面新建一个控制台应用程序,在代码编辑器中编写下列程序:

type
myarray1=array[1..10] of integer;
myarray2=array[2..11,'a'..'c'] of string;
myarray3=array of real;
myarray4=array of array of real;
var
a1:myarray1;
a2:myarray2;
a3:myarray3;
a4:myarray4;
begin
writeln('sizeof(a1):',sizeof(a1));//10
writeln('sizeof(a2):',sizeof(a2));//120
writeln('sizeof(a3):',sizeof(a3));//4
writeln('sizeof(a4):',sizeof(a4));//4
(*通过下标写静态数组变量*)
a1[2]:=200;
a2[2,'a']:='string';
(*通过下标写动态数组变量*)
setlength(a3,1);  //为A3赋值8个字节存储
a3[0]:=2000.05;
setlength(a4,2,2);  //为A4分配另外32字节存储
a4[1,1]:=-19.32;
(*读数组变量*)
writeln('a1[2]的值:',a1[2]); //200
writeln('a2[2,''a'']的值',a2[2,'a']);//string
writeln('a3[0]的值:',a3[0]:10:3); //2000.050
writeln('a4[1,1]的值:',a4[1,1]:10:3); //-19.320
(*各个数组变的长度和下标值范围*)
writeln('a1的长度:',length(a1));//10
write('a1的最小下标值:',low(a1),'  ');
writeln('a1的最大下标值:',high(a1));
writeln('a2的第一维的长度:',length(a2));//10
write('a2第一维的最小下标值:',low(a2),'  '); //2
writeln('a2第一维的最大下标值:',high(a2)); //11
writeln('a2第二维的长度:',length(a2[2])); //3
write('a2第二维的最小下标值:',low(a2[2]),'  '); //a
writeln('a2的第二维最大下标值:', high(a2[2])); //c
writeln('a3的长度:',length(a3)); //1
write('a3的最小下标值:',low(a3),'  ');//0
writeln('a3的最大下标值:',high(a3)); //0即1-1
writeln('a4的第一维长度:',length(a4));//2
write('a4第一维最小下标值:',low(a4),'  ');//0
writeln('a4第一维最大下标值:',high(a4));//1
writeln('a4的第二维长度:',length(a4[0])); //2
write('a4第二维最小下标值:',low(a4[0]),'  ');//0
writeln('a4第二维最大下标值:',high(a4[0]));//1
setlength(a3,0);
writeln('a3的长度:',length(a3));//0
write('a3的最小下标值:',low(a3),'  ');//0
writeln('a3的最大下标值:',high(a3));//-1
readln;
end.

说明,通过前四前语句的输出,我们可以看到静态数组变量和动态数组变量的存储分配情况.a1可以保存10个integer类型整型数据的静态数组,而每个integer需要4个字节的存储,因此编译器为其分配了40个字节的存储.a2为二维静态数组,可以保存10×3即30个STRING类型字符串数据的静态数组,而每个string需要4个字节存储实际字符串存储的引用,因此编译器为其分配120个字节的存储,但对于a3和a4来说,编译器仅为其分配4个字节存储,以保存对动态分配空间的引用值.

在程序的后半部分,用了若干条语句反映了各个数组每一维的长度及其最小,最大下标值,数组的长度可以由标准函数例程length得到,最小,最大下标值则可以分别由标准函数例程low和high得到,需要指出的是,在尚未通过setlength为其分配存储或者使用setlength(动态数组变量标识符,0)为其分配存储,使得某动态数组变量的长度为0时,由low返回的最小下标值为0,最大下标值为-1.

对于数组变量来说,我们可以先声明数组类型,再根据类型来定义变量,如上例所示,也可以采用简化的办法,直接通过变量定义来完成.如:

var    
a1:array[1..10] of integer;
a2:array[1..10,’a’..’z’] of string;
a3:array of real;
a4:array of array of real;

尽管如此,但对于高级数据类型,先声明类型后定义变量的概念是不能混淆的.
另外,在上面的范例中,我们使用setlength(a4,2,2)语句创建了一个”矩形”的动态数组,即a4第一维的长度2,第二维的长度2,实际上,对于多维动态数组来说,其各维的长度可以是不同的,在下面的范围中,我们就建立一个三角形的动态数组.
编写控制台应用程序,建立各维长度不同的动态数组.在代码编辑器中写下程序;

var
a:array of array of string;
i,j:integer;
begin
setlength(a,10); //第一维的长度为10
for i:=low(a) to high(a) do begin
setlength(a,i); //第二维的长度随第一维的长度变化而变化
  for j:=low(a) to high(a) do begin
  a[i,j]:=inttostr(i)+'/'+inttostr(j)+'  ';
  write(a[i,j]);
  end;
  writeln;
  end;
  readln;
end.  

 
13： 注册表的使用：
32位Delphi程序中可利用TRegistry对象来存取注册表文件中的信息。 
一、创建和释放TRegistry对象
　　1.创建TRegistry对象。为了操作注册表，要创建一个TRegistry对象：
ARegistry := TRegistry.Create； 
　　2.释放TRegistry对象。对注册表操作结束后，应释放TRegistry对象所占内存：ARegistry.Destroy。 

二、指定要操作的键 

　　操作注册表时，首先应指定操作的主键：先给属性RootKey赋值以指定根键，然后用方法OpenKey来指定要操作的主键名。 

　　1.指定根键(RootKey)。 
　　根键是注册表的入口，也注册表信息的分类，其值可为： 
　　HKEY—CLASSES—ROOT：存储整个系统对象类信息，如ActiveX对象注册、文件关联等信息。 
　　HKEY—CURRENT—USER：存储当前用户的配置信息。为属性RootKey的默认值。 
　　HKEY—LOCAL—MACHINE：存储当前系统的软硬件配置信息。应用程序自己的信息可以存储在该根键下。 
　HKEY—USERS：存储所有用户通用的配置信息。 
　　还可以是HKEY—CURRENT—CONFIG、HKEY—DYN—DATA。 

　　2.指定要操作的主键。 
　　Function OpenKey(const Key: string; CanCreate: Boolean): Boolean; 
　　Key：主键名，是键名全名中除去根键的部分，如Software/Borland/Delphi。 
　　CanCreate：在指定的主键名不存在时，是否允许创建该主键，True表示允许。 
　　返回值True表示操作成功。 

　　3.关闭当前主键。 
　　在读取或存储信息之后，应及时将关闭当前主键：procedure CloseKey。 

三、从注册表中读取信息 
　　Read系列方法从注册表读取指定的信息（字符串、二进制和十六进制），并转换为指定的类型。 

　　1.Read系列方法。 
　　function ReadString(const Name: string): string; 
　　读取一个字符串值，Name为字符串名称。 
　　function ReadInteger(const Name: string): Integer; 
　　读取一个整数值，Name为整数名称。 
　　function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer):Integer; 
　　读取二进制值，Name为二进制值名称，Buffer为接收缓冲区，BufSize为缓冲区大小，返回为实际读取的字节数。 
　　其它方法还有：ReadBool、ReadCurrency、ReadDate、ReadDateTime、ReadFloat、ReadTime。 

　　2.读取信息一例（显示Windows的版本）。 
　在HKEY—LOCAL—MACHINE/Software/Microsoft/Windows/CurrentVersion下，有三个字符串值Version、VersionNumber和SubVersionNumber，用于记录当前Windows的版本号。 

　　{请在Uses中包含Registry单元} 
　　procedure TForm1.Button1Click(Sender:TObject); 
　　var 
　　 ARegistry : TRegistry; 
　　begin 
　　 ARegistry := TRegistry.Create; 
　　//建立一个TRegistry实例 
　　 with ARegistry do 
　 　 begin 
　　 RootKey := HKEY—LOCAL—MACHINE;//指定根键为HKEY—LOCAL—MACHINE 
　　 //打开主键Software/Microsoft/Windows/CurrentVersion 
　　 if OpenKey( ′Software/Microsoft/Windows/CurrentVersion′,false ) then 
　　 begin 
　　 memo1.lines.add('Windows版本：′＋ ReadString(′Version′)); 
　　 memo1.lines.add('Windows版本号：′＋ ReadString(′VersionNumber′)); 
　　 memo1.lines.add(′Windows子版本号：′＋ ReadString(′SubVersionNumber′)); 
　　 end; 
　　 CloseKey;//关闭主键 
　　 Destroy;//释放内存 
　　 end; 
　　end; 

四、向注册表中写入信息 
　　Write系列方法将信息转化为指定的类型，并写入注册表。 

　　1.Write系列方法。 
　　procedure WriteString(const Name, Value: string); 
　　写入一个字符串值，Name为字符串的名称，Value为字符串值。 
　　procedure WriteInteger(const Name: string; Value: Integer); 
　　写入一个整数值。 
　　procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer); 
　　写入二进制值，Name为二进制值的名称，Buffer为包含二进制值的缓冲区，BufSize为缓冲区大小。 
　　其它方法还有：WriteBool、WriteCurrency、WriteDate、WriteDateTime、WriteFloat、WriteTime。 

　　2.写入信息一例。 
　　下面程序使Delphi随Windows启动而自动运行。 

　　var 
　　 ARegistry : TRegistry; 
　　begin 
　　 ARegistry := TRegistry.Create; 
　　//建立一个TRegistry实例 
　　 with ARegistry do 
　　 begin 
　　 RootKey:=HKEY—LOCAL—MACHINE; 
　 　 if OpenKey(′Software/Microsoft/Windows/CurrentVersion/Run′,True) then 
　　 WriteString(′delphi′,′C:/Program Files/borland/delphi3/bin/delphi32.exe′); 
　　 CloseKey; 
　　 Destroy; 
　　 end; 
　　end; 

五、键值维护 
　　除了在注册表中读取、存储外，程序可能还需要增加主键、删除主键、主键改名、数据值改名等。 

　　1.创建新主键：function CreateKey(const Key: string): Boolean。 
　　Key即为主键名，返回值True表示操作成功。 

　　2.删除主键：function DeleteKey(const Key: string): Boolean。 
　　Key即为主键名，返回值True表示操作成功。 

　　3.复制或移动主键：procedure MoveKey(const OldName, NewName: string; Delete: Boolean)。 
　　OldName、NewName分别表示源主键名和目标主键名；Delete表示是否删除源主键，True表示删除，False表示保留。 
　　复制或移动一个主键将复制或移动该子键下的所有数据值和子键内容。 

　　4.判断指定主键是否存在，其下是否有主键，并获取主键名称。 
　　KeyExists用于判断指定主键是否存在： 　　

function KeyExists(const Key: string): Boolean;//返回值为True表示主键存在。 

　　HasSubKeys用于判断指定主键下是否有子键：function HasSubKeys: Boolean; 
　　返回值为True表示主键下有子键。 
　GetKeyNames用于获取子键名称：procedure GetKeyNames(Strings: TStrings); 
　Strings用于返回当前主键下各子键的名称。 

　　5.获取主键下的数据值名称：procedure GetValueNames(Strings: TStrings)。 
　　Strings用于返回当前主键下各数值名称。 
　　如要获取当前系统中的拨号连接名称，可利用获取主键HKEY—USERS /.DEFAULT/RemoteAccess/Addresses下的数值名称的方法来进行。 

　　6.判断数值名称存在、数值名称改名。 
　　ValueExists用于判断数值名称是否存在： 　　

function ValueExists(const Name: string): Boolean; 

　　返回值为True表示数值名称存在。 
　　RenameValue用于数值名称改名： 

　　procedure RenameValue(const OldName, NewName: string); 

　以上是注册表常用操作所对应的TRegistry的方法和属性，其它方法和属性请参见Delphi联机帮助文件。 
以上程序在PWIN 98＋Delphi 3.0下调试通过。  
  
 
14.Delphi文件操作
 
 文件是同一类型元素的有序集合，是内存与外设间传输数据的渠道。一些外设如显示器、键盘、打印机等都可以看作文件，但最常用的还是磁盘文件，这也是本章我们主要讨论的对象。
         Delphi继承了Object Pascal的文件管理功能，并有很大的发展，其中最主要的是提供了用于文件管理的标准控件，同时也提供了更多的文件管理函数。利用Delphi的强大功能，开发一个自己的文件管理系统就成为很容易的事。
         本章首先介绍Delphi文件管理的基本概念和标准过程/函数，并提供了一个记录文件的应用实例，这是从我们实际课题开发中提取出来的。而后介绍Delphi提供的文件控件的使用方法。最后提供的一个综合例程MDI文件管理器则是对Delphi文件管理功能的综合应用。

6.1 文件类型和标准过程　
        Delphi同Object Pascal一样支持三种文件类型，即：文本文件、记录文件、无类型文件。　
6.1.1文本文件　
      文本文件类型的变量用如下方法声明：

var
TextFileVar: Text ;　

       文本文件是以行为单位进行读、写操作的。由于每一行长度不一定相同，不能计算出给定行在文件中的确切位置，因而只能顺序地读写。而且文本文件只能单独为读或写而打开，在一个打开的文本文件上同时进行读、写操作是不允许的。　

6.1.1.1 文本文件的打开、关闭　
      文本文件的打开需要两个步骤：(1). 文件变量与文件名关联；(2). 初始化读写。

      联文件变量与文件名调用AssignFile标准过程：　

     AssignFile ( TextFileVar , FileName ) ;

     FileName 既可以是全路径名，也可以仅是文件名。对于后者系统将在当前目录下查找。

     AssignFile是Delphi新提供的一个函数，其功能等价于Object Pascal中的Assign。而Assign在Delphi中更多地被用作一个方法名。

初始化读写有三种方式：

1. Reset : 为读打开文件并把文件指针移动到文件首；
2. Rewrite : 为写创建一个新文件；
3. Append : 为写打开存在的文件并把文件指针定位在文件尾。

        当使用Reset或Append过程而文件不存在时将会引发一个I/O异常。有关I/O异常的处理请参看本章例程和第十二章中的介绍。

       文件的关闭很简单，只须调用CloseFile过程即可。

       虽然Delphi应用程序在退出时会自动关闭所有打开的文件，但自己动手关闭文件可以确保释放文件句柄，并使程序的可移植性增强。

       为保持兼容，Delphi也允许用户用Assign建立关联，Close关闭文件。　


6.1.1.2 文本文件的读写　
        从文本文件中读取信息用Read、Readln两个标准过程。
        当读入数值时，Read、Readln假定数值是用一个或多个空格分开的，而不是逗号、分号或其它字符。对如下一条语句：　

Read ( TextFileVar , Num1 , Num2 , Num3 ) ;

      如果文件中的数值是：
100 200 300
      则能够成功读入，而若文件中的数值是
100 200， 300

      则Read读入“200，”并试图把它转化成一个数值时会引发一个异常。

       当读入字符是字符串时，Read、Readln过程总是读取尽可能多的字符填充到字符串变量中或一直读到行结束符为止。因此从文本文件中读取格式化的字符串数据，必须声明与其长度相匹配的字符串变量。如果要从文件中读取单词，必须先把文件中的每一行读入字符串，然后再从字符串中逐个分析出单词。或者一次只从文本文件中读入一个字符并测试每个字符后是否是单词断开处。

        格式化字符串之间的分隔符应读入到一个临时变量中，而字符串与数值、数值与数值间的分隔符读入时会自动识别剔除。对如下一行数据：
Mon 12:10 40 50
定义　

var
Day: string[3] ;
Time: string[5] ;
Num1, Num2: Integer ;

则须用如下的read 语句读入：　

read ( TextFileVar , Day , c , Time , Num1 , Num2 ) ;　

C为一个临时字符变量。　


6.1.1.3 文本文件的编辑　

        在Delphi中实现对一个文本文件的编辑，只须让其与一个Tmemo控件建立关联即可：　

Memo1.Lines.LoadFromFile ( TextFileName ) ;　

这样在TMemo上所做的一切修改当调用Memo部件的SaveToFile方法后都会反映到文件中去。　


6.1.2 记录文件　

       记录文件是一种操作更为灵活的文件类型。它允许同时为读和写打开，而且由于记录文件中每条记录的长度固定，所以可随机存取。
记录文件的类型变量可如下声明：　

var
RecordFileVar: file of RecordType;　
RecordType是一个自定义的记录类型。

      有关记录文件的操作我们将在下一节中结合例程进行讨论。　


6.1.3 无类型文件　

      无类型文件提供了底层的I/O通道，可用于存取可变长度记录的文件。经常用于文件的复制操作中。由于Delphi提供了更好的方法(见第四节)，所以无类型文件很少使用。有兴趣的读者可参看BlockRead、BlockWrite两个联机帮助主题。　


6.1.4 Delphi的文件管理标准过程　
      根据功能我们把标准过程划分为十一类进行介绍。　

6.1.4.1 文件的打开与关闭　

AssignFile ：把一个外部文件名和一个文件变量相关联
Reset ：打开一个存在的文件
Rewrite ：创建并打开一个新文件（或覆盖原有文件）
Append ：以添加方式打开一个文件（只适用于文本文件）
CloseFile ： 关闭一个打开的文件
FileOpen ：打开一个特定的文件并返回文件句柄
FileCreate ：创建一个给定文件名的文件并返回文件句柄
FileClose ：关闭一个特定句柄的文件　

       后边三个文件主要供系统内部使用，在文件复制的编程中也往往会用到。它们操作的对象是文件句柄而不是文件变量。　


6.1.4.2 文件定位　

Seek ：把文件当前位置移到指定部分
FilePos ： 返回文件的当前位置
Eoln ： 返回行结束标志
EOF ： 返回文件结束标志
FileSeek ： 改变当前文件指针的位置

       Seek与FileSeek的区别是：1. Seek仅用于记录文件；2. FileSeek的参数是文件句柄、偏移量、起始位置。其中起始位置有文件首、当前位置、文件尾三种选择。Seek的参数是文件变量、偏移量，偏移量是从文件首开始定位的。3. FileSeek的偏移量以字节数来计算，而Seek是根据记录号进行移动。

       Seek、FilePos仅用于记录文件。但任何文件都可以看作是基于字节的记录文件。下面一段程序表示了它们的用法。

{ 该例子的设计界面为一个包含TOpenDialog部件的窗体。}　

uses Dialogs;
var
f: file of Byte;
size: Longint;
S: String;
y: Integer;
begin
if OpenDialog1.Execute then
begin
AssignFile(f, OpenDialog1.FileName);
Reset(f);
size := FileSize(f);
S := 'File size in bytes: ' + IntToStr(size);
y := 10;
Canvas.TextOut(5, y, S);
y := y + Canvas.TextHeight(S) + 5;
S := 'Seeking halfway into file...';
Canvas.TextOut(5, y, S);
y := y + Canvas.TextHeight(S) + 5;
Seek(f,size div 2);
S := 'Position is now ' + IntToStr(FilePos(f));
Canvas.TextOut(5, y, S);
CloseFile(f);
end;

end.　

6.1.4.3 文件删除与截断　

Erase ： 删除一个存在的文件
DeleteFile ： 删除一个文件
Truncate ：从文件当前位置将文件截断　
         Erase与DeleteFile的区别是：Erase以文件变量为参数，当文件不能删除时引起一个异常；DeleteFile以文件名为参数，当文件不存在或不能删除时返回False，而并不引起一个异常。　


6.1.4.4 文件名操作　

Rename ：文件更名，以文件变量为操作对象
RenameFile ：文件更名，参数为文件的原名和新名
ChangeFileExt ：改变文件扩展名
ExpandFileName ：返回文件全路径名
ExtractFileExt ：返回文件扩展名
ExtractFileName ：从全路径名中返回文件名
ExtractFilePath ：返回特定文件的路径　

6.1.4.5 文件属性　

FileGetAttr ：返回文件属性
FileSetAttr ：设置文件属性　

6.1.4.6 文件状态　

FileSize ：返回文件对象大小
IOResult ：返回上一次I/O操作的状态
FileExists ：检测文件是否存在　

6.1.4.7 文件日期　
DateTimeToFileDate ：把Delphi日期格式转换为DOS日期格式
FileDateToDateTime ：把DOS日期格式转换为Delphi日期格式
FileGetDate ：返回文件的DOS日期时间戳
FileSetDate ：设置文件的DOS日期时间戳　

6.1.4.8 文件读写　

Read，Readln ：从文本或记录文件中读取变量
Write ：将指定变量写入文本或记录文件
Writeln ：将指定变量写入文本文件并写入一个行结束标志
FileRead ：从一个指定文件中读取变量
FileWrite ：向指定文件写入数据　
FileRead和FileWrite都是以文件句柄为操作对象，主要供系统内部使用。　

6.1.4.9 目录操作　

MkDir ：创建当前目录的子目录
ChDir ：改变当前目录
GetDir ：返回特定磁盘的当前目录
RmDir ：删除一个空子目录　

6.1.4.10 磁盘操作　

DiskFree ：返回磁盘自由空间
DiskSize ：返回特定磁盘的大小　

6.1.4.11 文件查找

FileSearch ：查找目录中是否存在某一特定文件
FindFirst ：在目录中查找与给定文件名（可以包含匹配符）及属性集相匹配的第一个文件
FindNext ：返回符合条件的下一个文件
FindClose ：中止一个FindFirst / FindNext序列　

        有关文件管理标准过程/函数的更详细资料，请查阅Delphi相关的Help主题。以上的大部分过程在后面都有应用实例，读者可以从中体会其用法。

        在Delphi的联机帮助Help系统中把有关文件的过程/函数分为两个主题：I/O Routine和File_Management Routine。前者大部分以文件变量为操作对象，而后者大部分以文件名或文件句柄为操作对象。这里为了方便读者的使用，我们按功能重新进行了分类。在下一节中主要应用I/O Routine主题下的过程，而在第四节的综合举例中主要应用File_Management Routine主题下的过程。

       另外，Windows提供了许多有关文件管理的API函数。虽然在一般情况下，利用Delphi提供的函数已足够解决问题，但有时候仍然需要使用Windows API。在(6.4.4.2)中我们就用到了Windows API函数GetDriveType。有关Windows API函数的情况，请读者参阅相关的资料，这里不再进行介绍。


6.2 记录文件的应用　

6.2.1 任务介绍　
　　在这一节，我们开发一个系统安全性综合评估方法管理系统。系统安全性在复杂项目开发中十分重要，但由于牵涉面广因而很难获得客观、全面的评估值。鉴于此我们提出多角度、多侧面评估而后定量集成的思路，并在此基础上提出了多种安全性综合评估方法。每种方法由不同部门进行评估而后把结果汇总、综合。
　　为此我们定义如下的记录类型：　

type
TNature = (Micro,Macro);
{方法性质，分为微观和宏观两类}　
　　　TMethod = Record
Name: string[20]; {方法名}
Condition: string[40]; {方法适用条件}
Nature: TNature; {方法性质}
Result: Real; {方法评估值}
end;　

用来记录不同方法的信息。
　　由于不同方法的条件、性质不同，因而对工程开发的不同阶段适用方法集也不同。因此需要根据实际情况对方法集进行管理。我们把每一方法作为一条记录，每一方法集作为一个记录文件。下面讨论系统的实现方法。　

6.2.2 设计基本思路　
　　本系统要实现的基本功能是文件的打开、创建、关闭、显示，记录的增加、修改、删除以及结果的综合和显示。为此我们使用了两组按钮分别用于文件和记录的操作，使用一个StringGrid控件来显示文件内容，使用一个只读编辑框显示结果的综合。
其中各部件的名称、功能如下表所示：　
表6.1 主窗口部件的设计
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
部件名称 主要属性 备注
──────────────────────────────────────
RecFileForm BorderStyle=bsDialog 文件打开后把文件名附到窗口标题后
Position=poScreenCenter
StringGrid1 大小行数动态确定
HazAttr(编辑框) ReadOnly=True 显示综合结果
OpenButton TabOrder=0 打开一个记录文件,若文件不存在则创建
NewButton Caption='打开' 创建一个记录文件,若文件存在则打开
CloseButton Caption='关闭' 关闭一个已打开的文件
AddButton Caption='增加' 增加一条记录
ModifyButton Caption='修改' 修改一条记录
DeleteButton Caption='删除' 删除一条记录
CalcuButton Caption='计算' 计算最终结果并显示
ExitButton Caption='退出' 系统终止。若当前有打开的文件则先关闭
OpenDialog1 Filter= 选择或输入欲打开的文件
'Record File(*.Rec)|.Rec
|Any File(*.*)|*.*'
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　

　　另外，StringGrid1、HazAttr的标题用两个标签框(Label)来显示。
　　另外我们还需要一个编辑对话框。其中四个编辑框Name、Condition、Nature、 Result分别对应TMethod记录的四个域。
为协调程序运行，我们定义了一组全局变量。各变量的类型、作用如下表。　

　　 表6.2　全局变量及其作用
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　 变量名 类型 作用
─────────────────────────────────
MethodFile MethodFileType 与当前打开文件相关联的文件变量
FileName string[70] 当前打开文件的文件名
Count Count 当前打开文件的记录总数
CurrentRec Integer 当前处理记录号
FileOpened Boolean 当前是否有文件打开
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　

记录文件类型MethodFileType的定义为　
　　type
MethodFileType = file of TMethod;　
        布尔变量FileOpened用于控制文件按钮的使能、变灰，记录按钮的反应以及系统结束时是否需要首先关闭文件。　


6.2.3 记录文件的打开和创建　
　　记录文件的打开和创建同文本文件一样也需要关联和初始化两个步骤。同文本文件唯一的不同是不能使用Append过程。
　　记录文件缺省情况下以读写方式打开，如果想以只读或只写方式打开，则需要修改System单元中定义的变量FileMode的值。
　　FileMode的取值和意义如下表。　
　　 表6.3 FileMode的取值和意义
━━━━━━━━━━━━━━
取值 意义
──────────────
0 只读
1 只写
2 读写
━━━━━━━━━━━━━━　
　　FileMode是一个全局变量，对它的每次修改都将影响所有Reset的操作，因此在打开自己的文件后应还原它的值。
　　在本系统中，当用户按下“打开”按钮时，首先弹出一个标准文件打开对话框，要求用户输入或选择文件名。确认后如果该文件名的文件存在，则用Reset打开，若不存在则创建。程序清单如下。　

procedure TRecFileForm.OpenButtonClick(Sender: TObject);
begin
if OpenDialog1.Execute then
FileName := OpenDialog1.FileName
else
exit;
AssignFile(MethodFile,Filename);
try
Reset(MethodFile);
FileOpened := True;
except
On EInOutError do
begin
try
if FileExists(FileName) = False then
begin
ReWrite(MethodFile);
FileOpened := True;
end
else
begin
FileOpened := False;
MessageDlg('文件不能打开',mtWarning,[mbOK],0);
end;
except
On EInOutError do
begin
FileOpened := False;
MessageDlg('文件不能创建',mtWarning,[mbOK],0);
end;
end;
end;
end;
if FileOpened = False then exit;
Count := FileSize(MethodFile);
if Count>0 then
ChangeGrid;
RecFileForm.Caption := FormCaption+' -- '+FileName;
NewButton.Enabled := False;
OpenButton.Enabled := False;
CloseButton.Enabled := True;
end;

　　首先系统试图用Reset打开一个文件，并置FileOpened为True。如果文件不能打开，则引发一个I/O异常。在异常处理过程中，首先检测文件是否存在。若不存在则创建这个文件。否则是其它原因引发的异常，则把FileOpend重置为False， 并显示信息“文件不能打开”。在文件创建过程中仍可能引发异常，因而在一个嵌套的异常处理中把FileOpened重置为False，并提示信息“文件不能创建”。
　　有关异常处理的内容请读者参看第十二章。这段程序说明：异常处理机制不仅能使我们的程序更健壮，而且为编程提供了灵活性。
　　当用户按下“创建”按钮时，系统首先弹出一个标准输入框，要求用户输入文件名，确认后系统首先检测文件是否存在。若存在则直接打开，否则创建一个新文件。打开或创建过程导致异常，则重置FileName和FileOpened两个全局变量。　

procedure TRecFileForm.NewButtonClick(Sender: TObject);
begin
FileName := InputBox('输入框','请输入文件名','');
if FileName = '' then Exit;
try
AssignFile(MethodFile,FileName);
if FileExists(FileName) then
begin
Reset(MethodFile);
Count := FileSize(MethodFile);
if Count>0 then
ChangeGrid;
end
else
begin
Rewrite(MethodFile);
count := 0;
end;
FileOpened := true;
Except
on EInOutError do
begin
FileName := '';
FileOpened := False;
end;
end;

if FileOpened then
begin
NewButton.Enabled := False;
OpenButton.Enabled := False;
CloseButton.Enabled := True;
RecFileForm.Caption := FormCaption+' -- '+FileName;
end;
end;

　　当文件打开或创建后，所要做的工作有：


　　● 若文件非空，则计算文件长度，并用文件内容填充StringGrid1


　　● “创建”、“打开”按钮变灰，“关闭”按钮使能


　　● 把文件名附到窗口标题后


6.2.4 记录文件的读入和显示　


　　定义一个全局变量Count用来保存文件中的记录个数。当文件装入时：　


　　Count := FileSize(MethodFile)；　


　　如果Count > 0，则首先确定StringGrid1的高度、行数。为保证StringGrid1不会覆盖窗口下面的编辑框，定义一个常量MaxShow。当Count < MaxShow时，记录可全部显示；当Count >= MaxShow时，StringGrid1自动添加一个滚动棒。为保证滚动棒不覆盖掉显示内容，StringGrid1的宽度应留有余地。


　　确定StringGrid1高度、行数的代码如下：　


　　With StringGrid do


if count < MaxShow then


Height := DefaultRowHeight * (Count+1)+10


else


Height := DefaultRowHeight * MaxShow+10;


RowCount := Count+1;


end;　


        而后从文件中逐个读入记录并显示在StringGrid1的相应位置：　


　　for i := 1 to Count do


begin


Read(MethodFile,MethodRec);


ShowMethod(MethodRec,i);


end;　


         ShowMehtod是一个过程，用来把一条记录填入StringGrid1的一行中。对于Name、Condition域而言，只须直接赋值即可；而对Nature 域需要把枚举类型值转化为对应意义的字符串(0：“微观”，1：“宏观”)；而对Result域则需要把数值转化为一定格式的字符串：　


Str (MethodRec.Result:6:4,ResultStr)；


　 StringGrid1.Cells[3,Pos] := ResultStr;　


即Result显示域宽为6，其中小数点后位数为4。　


6.2.5 增加一条记录　


　　当用户单击“增加”按钮时屏幕将会弹出一个记录编辑模式对话框EditForm。在编辑框中填入合适的内容并按OK键关闭后，相应值写入一个TMethod类型的变量MethodRec中。其中Nature和Result 域需要进行转换。之后增加的记录添加到StringGrid1的显示中。


　　最后文件定位于尾部，写入当前记录，总记录数加1。　


　 Seek(MethodFile,Count);


Write(MethodFile,MethodRec);


Count := Count+1;　


完整的程序清单如下：　


procedure TRecFileForm.AddButtonClick(Sender: TObject);


var


MethodRec: TMethod;


Rl: Real;


k: Integer;


EditForm: TEditForm;


begin


if FileOpenEd = False then Exit;


EditForm := TEditForm.Create(self);


if EditForm.ShowModal <> idCancel then


begin


HazAttr.text := '';


MethodRec.Name := EditForm.MethodName.text;


MethodRec.Condition := EditForm.Condition.text;


case EditForm.NatureCombo.ItemIndex of


0:


MethodRec.Nature := Micro;


1:


MethodRec.Nature := Macro ;


end;


Val(EditForm.Result.text,Rl,k);


MethodRec.Result := Rl;


with StringGrid1 do


begin


if Count < MaxShow then


Height := Height+DefaultRowHeight;


RowCount := RowCount+1;


end;


ShowMethod(MethodRec,Count+1);


seek(MethodFile,Count);


write(MethodFile,MethodRec);


Count := Count+1;


end;


end;　


6.2.6 修改记录　


　　首先获取当前记录位置：　


　　CurrentRec := StringGrid1.Row - 1;　


        而后打开编辑对话框并显示当前值。修改完毕后，修改结果保存在一个记录中并在StringGrid1中重新显示。


　　最后修改结果写入文件：　


Seek(MethodFile,CurrentRec);


Write(MethodFile,MethodRec);　


完整程序如下：　


procedure TRecFileForm.ModifyButtonClick(Sender: TObject);


var


MethodRec: TMethod;


Rl: Real;


k: Integer;


EditForm: TEditForm;


begin


if FileOpened = False then Exit;


EditForm := TEditForm.Create(self);


CurrentRec := StringGrid1.Row-1;


with EditForm do


begin


MethodName.text := StringGrid1.Cells[0,CurrentRec+1];


Condition.text := StringGrid1.Cells[1,CurrentRec+1];


if StringGrid1.Cells[2,CurrentRec+1] = '微 观' then


NatureCombo.ItemIndex := 0


else


NatureCombo.ItemIndex := 1;


Result.text := StringGrid1.Cells[3,CurrentRec+1];


if ShowModal <> idCancel then


begin


HazAttr.text := '';


MethodRec.Name := MethodName.text;


MethodRec.Condition := Condition.text;


case NatureCombo.ItemIndex of


0:


MethodRec.Nature := Micro;


1:


MethodRec.Nature := Macro ;


end;


Val(Result.text,Rl,k);


MethodRec.Result := Rl;


ShowMethod(MethodRec,CurrentRec+1);


seek(MethodFile,CurrentRec);


write(MethodFile,MethodRec);


end;


end;


end;　　


6.2.7 记录的删除、插入、排序　


　　删除一条记录的基本思路是：获取当前记录的位置并把该位置后的记录逐个向前移动。 文件在最后一条记录前截断。　


　　for i:=CurrentRec+1 to Count-1 do


begin


seek(MethodFile,i);


read(MethodFile,MethodRec);


seek(MethodFile,i-1);


Write(MethodFile,MethodRec);


end;


Truncate(MethodFile);　


          为避免误删除，在进行删除操作前弹出一个消息框进行确认。删除后要更新全局变量的值和显示内容：　


Count := Count - 1;


ChangeGrid;　


           完整的程序如下：　


procedure TRecFileForm.DeleteButtonClick(Sender: TObject);


var


NewFile: MethodFileType;


MethodRec: TMethod;


NewFileName: String;


i: Integer;


begin


if FileOpened = False then Exit;


CurrentRec := StringGrid1.Row-1;


if CurrentRec < 0 then Exit;


if MessageDlg('Delete Current Record ?', mtConfirmation,


[mbYes, mbNo], 0) = idYes then


begin


HazAttr.text := '';


for I := CurrentRec+1 to Count-1 do


begin


seek(MethodFile,i);


read(MethodFile,MethodRec);


seek(MethodFile,i-1);


Write(MethodFile,MethodRec);


end;


Truncate(MethodFile);


Count := Count-1;


ChangeGrid;


end;


end;


　　这里所显示的删除操作简单明了。但在程序开始设计时我却走了一条弯路，后来发现虽然这种方法用于记录的删除操作显得笨拙、可笑，但却恰恰是记录插入、排序的思想。


　　这种思想的核心是创建一个新文件保存更新后的内容。若新文件顺利创建，则删除原文件，否则恢复原来的文件。程序清单如下：　


procedure TRecFileForm.DeleteButtonClick(Sender: TObject);


var


NewFile: MethodFileType;


MethodRec: TMethod;


NewFileName: String;


i: Integer;


begin


if FileOpened = False then Exit;


CurrentRec := StringGrid1.Row-1;


if CurrentRec < 0 then Exit;


if MessageDlg('Delete Current Record ?', mtConfirmation,


[mbYes, mbNo], 0) = idYes then


begin


HazAttr.text := '';


NewFileName := ChangeFileExt(FileName,'.sav');


try


AssignFile(NewFile,FileName);


ReWrite(NewFile);


Except


On EInOutError do


begin


Rename(MethodFile,FileName);


Exit;


end;


end;


for i := 1 to Count do


if I <> CurrentRec+1 then


begin


MethodRec := GridToRec(i);


Write(NewFile,MethodRec);


end;


closeFile(MethodFile);


try


AssignFile(MethodFile,Filename);


Reset(MethodFile);


except


on EInOutError do


begin


DeleteFile(FileName);


AssignFile(MethodFile,NewFileName);


Reset(MethodFile);


Rename(MethodFile,FileName);


Exit;


end;


DeleteFile(NewFileName);


Count:=Count-1;


ChangeGrid;


end;


end;


　　对于记录插入，方法基本同上。对于排序，可先将关键域读入排序，而后再按排序结果对应的记录号顺序重写文件。　


6.2.8 结果综合　


　　对不同方法的评估结果，可按一定的公式进行综合。当用户按下“计算”按钮时，系统进行计算并把综合结果写入HazAttr只读编辑框中。


　　为保证结果显示的正确性，每次增加、修改、删除操作确认后HazAttr编辑框清空。　


6.2.9 编辑对话框的输入检查　


　　当用户单击“增加”或“修改”按钮时系统将弹出一个编辑对话框，让用户输入或修改记录内容。其中的三个编辑框，一个组合列表框分别对应TMethod 的四个域。由于TMethod的Result域必须是[0,1]间的小数，因此当用户按OK键关闭对话框时应进行类型和范围检查。


　　在VB中我做过同样的工作，那时需要对用户输入的键码逐个进行判断。但这种方法很繁琐、很难做圆满(如不能很好地支持编辑键)。而Object Pascal提供了更好的方法。这种方法的关键就在于它的类型转换函数Val：　


procedure Val(Str: String;var V; var Code: Integer)；　


　　V是由Str转换成的整型或实型数。若字符串非法，则出错位置返至Code;否则置Code为0。字符串非法并不会引发一个转换异常。


　　如果转换后的数超出了我们的范围，则显式把Code置为-1。最后统一通过检测Code是否为0来判断输入是否合法。


　　我们把输入检查放在对话框的OnCloseQuery事件处理过程中。如输入非法，则禁止对话框关闭，并将输入焦点置于Result编辑框中。但假如用户按了Cancel按钮，则这种检查是多余的。为此定义一个布尔变量IsCancel，对话框生成时置为False。假如用户按下Cancel，则置为True，此时OnCloseQuery事件不进行输入检查。


　　对话框的OnCloseQuery事件处理过程的程序清单如下：　


procedure TEditForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);


var


Res: Real;


k: Integer;


begin


if IsCancel = False then


begin


val(Result.text,Res,k);


if (Res > 1) or (Res < 0) then k := -1;


if k <> 0 then


begin


MessageDlg('非法输入 ！',mtWarning,[mbOK],0);


Result.text := '';


CanClose := False;


Result.SetFocus;


end;


end;


end;　


6.2.10 文件和系统的关闭　


　　文件关闭须调用CloseFile过程：　


　　 CloseFile(MethodFile);　


并对系统的状态重新进行设置。


          系统关闭时首先检测当前是否有打开的文件。若有则先关闭文件。这在主窗口的OnCloseQuery事件中实现。


实现文件关闭的程序清单如下：　


procedure TRecFileForm.CloseButtonClick(Sender: TObject);


begin


if FileOpened then


begin


CloseFile(MethodFile);


FileOpened := False;


ClearGrid;


OpenButton.Enabled := True;


NewButton.Enabled := True;


CloseButton.Enabled := False;


RecFileForm.Caption := FormCaption;


end;


end;　


实现系统关闭前检查的程序清单如下：


procedure TRecFileForm.FormCloseQuery(Sender: TObject;


var CanClose: Boolean);


begin


if FileOpened then


closeFile(MethodFile);


end;　


6.2.11 记录文件小结　


　　我们所举的例子虽然简单，但基本覆盖了记录文件操作的主要方面。这里关键问题在于灵活应用Delphi提供的文件管理函数。同时，为了保证程序的健壮性应对异常进行捕获并处理。在数据库应用技术发展的今天，记录文件的重要性也许有所下降，但对象我们这里所处理的简单问题它仍有用武之地。


　　这里所举的例子一次只能处理一个文件。但读者可以很容易把它改为一个MDI程序。虽然对于这里的实际情况来说，似乎并无必要。　


6.3 文件控件的应用　


　　Delphi文件管理的最大特色是提供了一组文件操作控件。利用这些控件我们可以快速开发一个文件名浏览系统。其功能强大与其所需书写代码之少所形成的强烈反差，正是Dephi生命力的体现。　


6.3.1 文件控件及其相互关系　


　　Delphi提供的专用文件控件如下表所示。　


　　 表6.4 Delphi专用文件控件━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


控件名 功能


─────────────────────────────────────


DriveComboBox 驱动器组合列表框。用于选择当前驱动器


FileListBox 文件列表框。用于显示当前目录中的文件和选中当前文件


FilterComboBox 文件类型组合列表框。用于选择显示文件的类型


DirectoryOutline 目录树(6.4节专门介绍)


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


　　以上控件前四个在Component Palette(部件选择板)的System页中，DirectoryOutline在Component Palette的Samples页中。


　　以上文件控件再加上文件编辑框、目录标签框(事实上是一般的编辑框、标签框)就可以构成一个完整的文件操作系统。它们之间的联系几乎不用代码支持，只要设置好相应的属性就可以了。


　 FileEdit、DirLabel、FileListBox、FileFilterComloList、 DirectoryListBox、DriveComboList六个控件间的属性联系如下：　


　　DriveComboList .DirList := DirectoryListBox;


　　DirectoryListBox.DirLabel := DirLabel;


DirectoryListBox.FileList := FileListBox;


FileFilterComboList.FileList := FileListBox;


FileListBox.FileEdit := FileEdit;　


         以上联系可以在设计时完成。只要打开相应属性的选择列表框进行选择即可。也可以在运行时利用如上的赋值语句建立联系。


　　文件控件的关键属性基本上都在以上联系中反映出来了。除此之外，FileFilterComboList有一个Filter属性，用来设置组合列表框的选择项；FileListBox 有一个Mask属性，用于设置显示文件的类型，这就允许FileListBox在脱离FileFilterComboList单独应用时仍能根据需要显示特定的文件。在6.4节中我们将应用这一功能。


　　文件控件的方法、事件基本是从ListBox和ComboBox中继承的。但FileListBox 中有一个ApplyFilePath方法很有用，我们将在后边给出其用法。　


6.3.2 文件名浏览查找系统的设计思路　


　　作为文件控件的应用实例，我们开发了一个简单的文件名浏览查找系统。这个系统可用于文件名的显示，把选中的文件写入列表框，并能按文件编辑框中输入的通配符对文件进行查找。


表6.5 部件的设计


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


部件 属性 功能


─────────────────────────────────────


FileCtrForm Position=poDefault 主窗口


DirLabel 显示当前目录


FileEdit TabOrder=0 显示当前文件/输入文件显示匹配符


FileListBox1 FileEdit=FileEdit 显示当前目录文件


DirectoryListBox1 DirLabel=DirLabel 显示当前驱动器目录


FileList= FileListBox1


DriveComboBox1 DirList= DirectoryListBox1 选择当前驱动器


FilterComboBox1 FileList=FileListBox1 选择文件显示类型


Filter='All Files(*.*)|*.*|


Source Files(*.pas)|*.pas|


Form Files(*.dfm)|*.dfm|


Project Files(*.dpr)|*.dpr'


ListBox1 显示选中或查找的文件


Button1 Caption='查找' 按 FileEdit 中的内容进行查找


Button2 Caption='退出' 退出系统


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　


6.3.3 文件名浏览查找系统的功能和实现　


6.3.3.1 按指定后缀名显示当前目录中的文件　


　　实现这一功能只需要在控件间建立正确的联系即可，不需要代码支持。建立联系的方法如(6.3.1)中的介绍。　


6.3.3.2 把选中的文件添加到列表框中　


　　在FileListBox1的OnClick事件中：　


procedure TFileCtrForm.FileListBox1Click(Sender: TObject);


begin


if Searched then


begin


Searched := False;


ListBox1.Items.Clear;


Label5.Caption := 'Selected Files';


end;


if NotInList(ExtractFileName(FileListBox1.FileName),ListBox1.Items) then


ListBox1.Items.Add(ExtractFileName(FileListBox1.FileName));


end;


　　Searched是一个全局变量，用于标明ListBox1当前显示内容是查找的结果还是从FileListBox1中选定的文件。


函数NotInList用于判断待添加的字符串是否已存在于一个TStrings对象中。函数返回一个布尔型变量。


　　NotInList的具体实现如下。　


Function TFileCtrForm.NotInList(FileName: String;Items: TStrings): Boolean;


var


i: Integer;


begin


for I := 0 to Items.Count-1 do


if Items[i] = FileName then


begin


NotInList := False;


Exit;


end;


NotInList := True;


end;　


6.3.3.3 按指定匹配字符串显示当前目录中的文件　


　　当在FileEdit中输入一个匹配字符串，并回车，文件列表框将显示匹配结果。这一功能在FileEdit的OnKeyPress事件中实现。　


procedure TFileCtrForm.FileEditKeyPress(Sender: TObject; var Key: Char);


begin


if Key = #13 then


begin


FileListBox1.ApplyFilePath(FileEdit.Text);


Key := #0;


end;


end;


　　文件列表框提供的ApplyFilePath方法是解决这一问题的关键所在。　


6.3.3.4 按指定匹配字符串查找当前目录中的文件　


　　为了进行比较，我们用另一种方法来实现文件的查找功能，即利用标准过程FindFirst、FindNext。FileList1与ListBox1 中的内容完全一致。


        当用户单击“查找”按钮时，与FileEdit 中字符串相匹配的文件将显示在ListBox1中。下面是实现代码。　


procedure TFileCtrForm.Button1Click(Sender: TObject);


var


i: Integer;


SearchRec: TSearchRec;


begin


Searched := True;


Label5.Caption := 'Search Result';


ListBox1.Items.Clear;


FindFirst(FileEdit.text,faAnyFile,SearchRec);


ListBox1.Items.Add(SearchRec.Name);


Repeat


i := FindNext(SearchRec);


If i = 0 then


ListBox1.Items.Add(SearchRec.Name);


until i <> 0;


end;


　　SearchRec是一个TSearchRec类型的记录。TSearchRec的定义如下：　


TSearchRec = record


Fill: array[1..21] of Byte;


Attr: Byte;


Time: Longint;


Size: Longint;


Name: string[12];


end;


　 在这一结构中提供了很多信息，灵活应用将给编程带来很大方便。下面我们举几个例子。


　　1. 检测给定文件的大小。　


function GetFileSize(const FileName: String): LongInt;


var


SearchRec: TSearchRec;


begin


if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then


Result := SearchRec.Size


else


Result := -1;


end;　


这一程序将在下一节中应用。


　　2. 获取给定文件的时间戳，事实上等价于FileAge函数。　


　　function GetFileTime(const FileName: String): Longint;


var


SearchRec: TSearchRec;


begin


if FindFirst(ExpandFileName(FileName),faAnyFile, SearchRec) = 0 then


Result := SearchRec.Time


else


Result := -1;


end;　


3. 检测文件的属性。如果文件具有某种属性，则　


SearchRec.Attr And GivenAttr > 0　


属性常量对应的值与意义如下表：　


　　 表6.6 属性常量对应的值与意义


━━━━━━━━━━━━━━━━━━━━


常量 值 描述


─────────────────────


faReadOnly $01 只读文件


faHidden $02 隐藏文件


faSysFile $04 系统文件


faVolumeID $08 卷标文件


faDirectory $10 目录文件


faArchive $20 档案文件


faAnyFile $3F 任何文件


━━━━━━━━━━━━━━━━━━━━　


6.4 文件管理综合举例：文件管理器的实现　


　　在本章的最后，我们利用Delphi提供的文件控件和文件管理函数开发一个简单的文件管理器。虽然这一文件管理器还无法和Windows提供的文件管理器相比拟，但它也为一般的文件操作提供了足够多的功能，而且如果读者感兴趣，还可以对它做进一步的扩充。在后边的拖放操作一章中，我们就为它提供了拖放支持，使它看起来更象一个“文件管理器”。


6.4.1 设计基本思路　


6.4.1.1 窗口设计　


　　文件管理器的主窗口是一个多文档界面(MDI)。有关文件、目录的显示和文件管理功能的实现都放在子窗口中。在程序执行过程中将根据需要弹出一些完成不同操作的对话框。这些对话框都是在需要时动态生成的。表6.7给出了本程序所设计窗体的清单。　


　　 表6.7 FileManger窗体清单


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


窗体类 功能 用于创建该类窗体的菜单项


──────────────────────────────────────


TFileManager 主窗口


TFMForm 子窗口 Windows|New Window


TFileAttrForm 显示文件属性 File|Properties;Function|Search


TChangeForm 文件移动、拷贝、改名、改变 File|Move.Cope.Rename 当前目录等操作的输入对话框 Directory|change Directory


TSearchForm 输入待查找文件的名称和路径 Function|Search


TDiskViewForm 显示磁盘信息 Function|Disk View


TViewDir 输入待创建的子目录 Directory|CreateDirectory


TAboutBox 显示版权信息 Help|About


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　


6.4.1.2 界面设计　


　　主窗口界面主要是主菜单和用于表示当前目录、当前文件的状态条。　


　　 表6.8 主窗口界面设计


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


部件 属性 功能


　─────────────────────────────


FileManager Style=fsMDI 主窗口


WindowMenu=Windows


Position=poDefault


MainMenu1 主菜单


FilePanel Align=alBottom 显示当前选中文件


BevelInner=bvLowered


BevelWidth=2


DirectoryPanel Align=alBottom 显示当前选中目录


Alignment=taLeftJustify


BevelInner=bvLowered


BevelWidth=2


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


　


主窗口主菜单包括File、WIndows、Help三项。File菜单项在子窗口生成时被子窗口同名菜单项所取代。设置Windows、Help的GroupIndex = 9，可以使子窗口生成时这两个菜单项仍存在。


　　子窗口界面包括主菜单、目录树(DirectoryOutline)、文件列表框、 用于显示驱动器的标签集(TabSet)以及三个用于显示驱动器类型的TImage部件。　


　 表6.9 子窗口界面设计


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


部件 属性 功能


───────────────────────────────────────


FMForm ActiveControl=DirectoryOutline 子窗口


Position=poDefault


Style=fsMDIChild


MainMenu1 主菜单


DriveTabSet Align=alTop 显示驱动器


style=tsOwnerDraw


DirectoryOutline Align=alLeft 显示当前驱动器的目录树


options=[ooDrawTreeRoot,


ooDrawFocusRect,ooStretchBitmaps]


FileList Align=alClient 显示当前目录中的文件


FileType=[ftReadOnly,


ftHidden,ftSystem,ftArchive,ftNormal]


ShowGlyphs=True


Network(Image) Picture(Network.bmp) 标志网络驱动器


Vsible=False


Floppy(Image) Picture(Floppy.bmp) 标志软驱


Visible=False


Fixed(Image) Picture(Fixed.bmp) 标志硬驱


Visible=False


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━


　


子窗口主菜单包括File、Function、Directory三个菜单项， 分别用于完成文件的基本管理功能、其它管理功能和目录管理功能。


　　由于对话框界面设计很简单，这里不再进行赘述。 读者可直接参考后面将给出的对话框界面图(图6.8---6.13)进行设计。


　


6.4.2 子窗口的创建、布置和关闭


　


　　子窗口的创建、布置由父窗口的Windows菜单控制，其菜单项如下：


　　● New Windows : 创建新的子窗口


● Tile : 平铺


　　● Cascade : 层叠


　　● ArrangeIcon : 排列图标


　 ● Minimized All : 极小化所有子窗口


　


　　子窗口的创建只需要简单调用窗体的Create方法：


　


　　FileMan := TFMForm.Create(Application);


　


子窗口的标准排列方式直接调用MDI窗口的标准方法Tile、Cascade和ArrangeIcons。


　　极小化所有子窗口的实现利用MDI窗口的两个属性：MDIChildCount和MDIChildren：


　


　　for i := 0 to MDICount - 1 do


MDIChildren[i].Windowstate := wsMinimized;


　


　


　　子窗口关闭时释放内存空间，为此在子窗口TFMForm的OnClose事件中令


　


Action := OnFree；


　


　　为了保持和Windows的File Manager的一致性，我们也禁止关闭最后一个子窗口，这需要在子窗口的OnCloseQuery事件处理过程中实现：


　


If FileManager.MDIChildCount <= 1 then


CanClose := False;


　


CanClose是OnCloseQuery事件过程返回的一个参数，用于判定窗口是否可以关闭。


　　由于这一过程归子窗口所有，因而MDIChildCount前必须加上其对象名FileManager。


　　但不幸的是：这样一来我们的程序无法终止了！原来MDI窗口关闭前首先关闭其所有的子窗口。如果子窗口不能关闭，MDI窗口也不能关闭。


为此我们需要判断发出关闭消息的是子窗口的系统菜单还是菜单的Exit项。


　　定义一个全局变量


　


　　var


ExitClick: Boolean;


　


在子窗口的Exit1Click事件处理过程中：


　


ExitClick := True;


FileManager.Exit1Click(Sender);


　


　


　　子窗口关闭前可以利用这一全局变量检测是否应关闭：


　


　　If (FileManager.MDIChildCount <= 1) and (Not ExitClick) then


CanClose := False;


　


6.4.3 文件控件的联系


　


　　在本例中我们使用了一组新的控件：TabSet、DirectoryOutline、FileListBox，用于显示和选择驱动器、目录和文件。与(6.3)中所用方法相比，使用这一组控件需要少量的代码支持。


　　TabSet与DirectoryOutline的联系在TabSet的Click事件处理过程中建立：


　


　　With DriveTabSet do


DirectoryOutline.Drive := Tabs[TabIndex][1];


　


DirectoryOutline与FileListBox的联系在DirectoryOutline的Change事件处理过程中建立：


　


FileList.Directory := DirectoryOutline.Directory;


FileList.Update;


　


6.4.4 DriveTabSet的自画风格显示　


　　Dephi为一些控件提供了自画风格的显示，如ListBox、ComboBox、TabSet等。 在缺省情况下，这些控件自动显示文本。而在自画风格下，拥有控件的窗体在运行时间内自己画出控件的每一项目。


自画风格显示通常的应用是为项目除文本外再添加图形显示。能以自画风格显示的控件有一个共同特点：都拥有一个TStrings类型的项目链。由于TStrings类的特点(参第三章)，它们都可以加入一个和对应文本相联系的对象。 而这正是自画风格显示的关键。


　　通常情况下产生一个自画风格需要三个步骤：


　　1.设置自画风格；


　　2.向字符串链表添加图形对象；


　　3.画出自画项目。　


6.4.4.1 设置自画风格　


　　控件属性Style 用于设置自画风格。对于DriveTabSet，我们把Style 属性设置为tsOwnerDraw。


　　对于ListBox、ComboBox等控件的设置与TabSet略有差异，读者可参阅联机帮助文档。　


6.4.4.2 向字符串链表添加图形对象　


　　1.在应用程序中添加图片部件


　　在本程序中我们设置了三个图片部件NetWork、Floppy、Fixed，并分别与三个位图文件NetWork.bmp、Floppy.bmp、Fixed.bmp相关联。


　　2.把图片添加到字符串链表中


　　根据字符串链表的性质，我们可以把对象与已存在的字符串建立联系，也可以同时添加字符串和对象。这里我们采用后一种方法。


　　在子窗口的OnCreate事件处理过程中，我们利用一个循环依次检测从a到z的驱动器是否存在以及驱动器的类型。这利用了Windwos API函数GetDrivetype, 如果驱动器不存在则返回0，否则返回驱动器的类型(DRIVE_REMOVABLE、DRIVE_FIXED、DRIVE_REMOTE)。根据驱动器类型我们可以判断与文本(驱动器名)同时添加到Tabs中的不同图形对象。在添加过程中，DriveTabSet的TabIndex被设置为当前驱动器。


程序清单如下：　


procedure TFMForm.FormCreate(Sender: TObject);


var


Drive, AddedIndex: Integer;


DriveLetter: Char;


begin


for Drive := 0 to 25 do


begin


DriveLetter := Chr(Drive + ord('a'));


case GetDrivetype(Drive) of


DRIVE_REMOVABLE:


AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Floppy.Picture.Graphic);


DRIVE_FIXED:


AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Fixed.Picture.Graphic);


DRIVE_REMOTE:


AddedIndex := DriveTabSet.Tabs.AddObject(DriveLetter, Network.Picture.Graphic);


end;


if UpCase(DriveLetter) = UpCase(FileList.Drive) then


DriveTabSet.TAbIndex := AddedIndex;


end;


end;


6.4.4.3 画出自画项目　


　　当把一个控件的风格设置为自画时，Windows不再负责往屏幕上画出控件的项目，而是为每个可见项目产生自画事件。应用程序可以通过处理自画事件画出控件的项目。　


1.确定自画项目的大小　


　　对于TabSet而言，这在OnMeasureTab事件处理过程中完成。我们需要把DriveTabSet每个标签的宽度增大到足以同时放下文本和位图。　


procedure TFMForm.DriveTabSetMeasureTab(Sender: TObject; Index: Integer;


var TabWidth: Integer);


var


BitmapWidth: Integer;


begin


BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;


Inc(TabWidth, 2 + BitmapWidth);


end;


　　由于TStrings的Objects属性中存放的对象都是TObject类型，并没有Width属性，因而需要再把它转化为TBitmap类型的对象：　


　 BitmapWidth := TBitmap(DriveTabSet.Tabs.Objects[Index]).Width;


2.画出每个自画项目　


　　这在TabSet的OnDrawTab事件处理过程中完成。这一事件处理过程的参数中包含了待画项目索引、画板、待画区域、是否被选中等。这里我们只利用了前三个参数。事实上利用最后一个参数，我们可以对被选中的标签进行一些特殊的视觉效果处理。这一工作就留给读者自己去完成。　


procedure TFMForm.DriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;


R: TRect; Index: Integer; Selected: Boolean);


var


Bitmap: TBitmap;


begin


Bitmap := TBitmap(DriveTabSet.Tabs.Objects[Index]);


with TabCanvas do


begin


Draw(R.Left, R.Top + 4, Bitmap);


TextOut(R.Left + 2 + Bitmap.Width, R.Top + 2, DriveTabSet.Tabs[Index]);


end;


end;　


6.4.5 文件管理基本功能的实现　


　　在子窗口的File菜单中，定义了文件管理的基本功能，它们是：


　　● Open ：打开或运行一个文件(从文件列表框双击该文件可实现同样效果)


● Move ：文件在不同目录间的移动


　　● Copy ：文件拷贝


　　● Delete ：文件删除


　　● Rename ：文件更名


　　● Properties ：显示文件属性　


6.4.5.1 文件打开　


　　文件打开功能可以运行一个可执行文件，或把文件在与之相关联的应用程序中打开。文件总是与创建它的应用程序相关联，这种关联可以在Windows的文件管理器中修改。要注意的是：文件的关联是以后缀名为标志的，因而对一个文件关联方式的修改将影响所有相同后缀名的文件。


　　文件打开功能实现的关键是利用了Windows API函数ShellExecute 。由于Windows API函数的参数要求字符串类型是PChar，而Delphi中一般用的是有结束标志的String类型，因此为调用方便我们把这一函数进行了重新定义如下。　


function ExecuteFile(const FileName, Params, DefaultDir: String;


ShowCmd: Integer): THandle;


var


zFileName, zParams, zDir: array[0..79] of Char;


begin


Result := ShellExecute(Application.MainForm.Handle, nil,


StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),


StrPCopy(zDir, DefaultDir), ShowCmd);


end;


　　以上函数在fmxutils单元中定义。fmxutils是一个自定义代码单元。


　　有关ShellExecute中各参数的具体含义读者可查阅联机Help文件。


　　StrPCopy把一个Pascal类型的字符串拷贝到一个无结束符的PChar类型字符串中。


　　在子窗口的Open1Click事件处理过程中：　


procedure TFMForm.Open1Click(Sender: TObject);


begin


with FileList do


ExecuteFile(FileName, '', Directory, SW_SHOW) ;


end;


　　如果FileList允许显示目录的话(即FileType属性再增加一项ftDirectory)，那么对于一个目录而言，打开的含义应该是显示它下边的子目录和文件。程序修改如下。　


　 procefure TFMForm.Open1Click(Sender: Tobject);


begin


With FileList do


begin


if HasAttr(FileName,faDirectory) then


DirectoryOutline.Directory := FileName


else


ExecuteFile(FileName,' ' ,Directory,SW_SHOW);


end;


end;　


其中HasAttr是一个fmxutils单元中的自定义函数，用于检测指定文件是否具有某种属性。　


function HasAttr(const FileName: String; Attr: Word): Boolean;


begin


Result := (FileGetAttr(FileName) and Attr) = Attr;


end;　


6.4.5.2 文件拷贝、移动、删除、更名　


　　文件拷贝的关键是使用了以文件句柄为操作对象的文件管理函数，因而提供了一种底层的I/O通道。在Object Pascal中这一点是利用无类型文件实现的。


　　在文件拷贝中首先检查目标文件名是否是一个目录。如是则把原文件的文件名添加到目标路径后，生成目标文件全路径名。而后提取源文件的时间戳，以备拷贝完成后设置目标文件。拷贝过程中使用了返回文件句柄或以文件句柄为参数的文件管理函数FileOpen、FileCreate、FileRead、FileWrite、FileClose。为保证文件的正常关闭和内存的释放，在拷贝过程中进行异常保护。


过程CopyFile实现上述功能，它定义在fmxutils单元中。　


procedure CopyFile(const FileName, DestName: TFileName);


var


CopyBuffer: Pointer;


TimeStamp, BytesCopied: Longint;


Source, Dest: Integer;


Destination: TFileName;


const


ChunkSize: Longint = 8192;


begin


Destination := ExpandFileName(DestName);


if HasAttr(Destination, faDirectory) then


Destination := Destination + '/' + ExtractFileName(FileName);


TimeStamp := FileAge(FileName);


GetMem(CopyBuffer, ChunkSize);


try


Source := FileOpen(FileName, fmShareDenyWrite);


if Source < 0 then


raise EFOpenError.Create(FmtLoadStr(SFOpenError, [FileName]));


try


Dest := FileCreate(Destination);


if Dest < 0 then


raise EFCreateError.Create(FmtLoadStr(SFCreateError,[Destination]));


try


repeat


BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize);


if BytesCopied > 0 then


FileWrite(Dest, CopyBuffer^, BytesCopied);


until BytesCopied < ChunkSize;


finally


FileSetDate(Dest,TimeStamp);


FileClose(Dest);


end;


finally


FileClose(Source);


end;


finally


FreeMem(CopyBuffer, ChunkSize);


end;


end;


　　如果我们不使用FileSetDate过程，Windows自动把当前时间作为时间戳写入文件。


　　文件移动事实上是文件拷贝与文件删除的结合。fmxutils单元中的MoveFile过程实现了这一功能。　


procedure MoveFile(const FileName, DestName: TFileName);


var


Destination: TFileName;


begin


Destination := ExpandFileName(DestName);


if not RenameFile(FileName, Destination) then


begin


if HasAttr(FileName, faReadOnly) then


raise EFCantMove.Create(Format(SFCantMove, [FileName]));


CopyFile(FileName, Destination);


DeleteFile(FileName);


end;


end;　


EFCanMove是一个自定义异常类：　


　　type


EFCanMove := Class(EStreamError);


　　有关自定义异常类请参阅第十二章。


　　文件删除、文件更名直接调用Delphi文件管理过程DeleteFile、RenameFile。它们都以文件名为参数。操作执行前应弹出一个对话框进行确认，执行完毕后应调用Update方法更新FileList的显示。　


6.4.5.3 一致的界面　


　　文件拷贝、文件移动、 文件更名以及后边的改变当前目录在形式上都表现为从一个源文件到一个目标文件。因而可以采用统一的用户界面，即ChangeForm对话框


这四个菜单项共用一个Click事件处理过程，通过对Sender参数的检测，决定将要打开对话框的标题和显示内容。当用户按OK键关闭且目标文件(目录)非空时，程序弹出一个消息对话框要求用户进一步确认，而后执行相应的动作。


　　共用的事件处理过程FileChange的程序清单如下：　


procedure TFMForm.FileChange(Sender: TObject);


var


ChangeForm: TChangeForm;


IsFile: Boolean;


begin


ChangeForm := TchangeForm.Create(Self);


IsFile := True;


with ChangeForm do


begin


if Sender = Move1 then Caption := 'Move'


else if Sender = Copy1 then Caption := 'Copy'


else if Sender = Rename1 then Caption := 'Rename'


else if Sender = ChangeDirectory1 then


begin


Caption:='Change Directory';


IsFile:=False;


end


else Exit;


if IsFile then


begin


CurrentDir.Caption := FileList.Directory;


FromFileName.Text := FileList.FileName;


ToFileName.Text := '';


end


else


begin


CurrentDir.Caption := DriveTabSet.Tabs[DriveTabSet.TabIndex];


FromFileName.Text := DirectoryOutline.Directory;


ToFileName.Text := '';


end;


if (ShowModal <> idCancel) and (ToFileName.Text <> '') then


ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);


end;


end;　


其中用到的自定义私有过程ConfirmChange用于执行相应的动作：　


procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: String);


begin


if MessageDlg(Format('%s %s to %s', [ACaption, FromFile, ToFile]),


mtConfirmation, [mbYes, mbNo], 0) = idYes then


begin


if ACaption = 'Move' then


MoveFile(FromFile, ToFile)


else if ACaption = 'Copy' then


CopyFile(FromFile, ToFile)


else if ACaption = 'Rename' then


RenameFile(FromFile, ToFile)


else if ACaption = 'Change Directory' then


changeDirectory(ToFile);


FileList.Update;


end;


end;　


6.4.5.4 显示文件属性　


　　当程序执行Properties 菜单项的Click 事件处理过程时，首先弹出一个TFileAttrForm类型的对话框，显示文件的属性


当用户修改并确认后程序重新设置文件属性。


　　Properties菜单项的Click事件处理过程如下：　


procedure TFMForm.Properties1Click(Sender: TObject);


var


Attributes, NewAttributes: Word;


FileAttrForm: TFileAttrForm;


begin


FileAttrForm := TFileAttrForm.Create(self);


ShowFileAttr(FileAttrForm,FileList.FileName,FileList.Directory);


end;


　　其中过程ShowFileAttr的实现如下：　


procedure TFMForm.ShowFileAttr(FileAttrForm:TFileAttrForm;


AFileName,Directory:String);


var


Attributes,NewAttributes: Word;


begin


with FileAttrForm do


begin


FileName.Caption := AFileName;


FilePath.Caption := Directory;


ChangeDate.Caption := DateTimeToStr(FileDateTime(AFileName));


Attributes := FileGetAttr(AFileName);


ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly;


Archive.Checked := (Attributes and faArchive) = faArchive;


System.Checked := (Attributes and faSysFile) = faSysFile;


Hidden.Checked := (Attributes and faHidden) = faHidden;


if ShowModal <> idCancel then


begin


NewAttributes := Attributes;


if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly


else NewAttributes := NewAttributes and not faReadOnly;


if Archive.Checked then NewAttributes := NewAttributes or faArchive


else NewAttributes := NewAttributes and not faArchive;


if System.Checked then NewAttributes := NewAttributes or faSysFile


else NewAttributes := NewAttributes and not faSysFile;


if Hidden.Checked then NewAttributes := NewAttributes or faHidden


else NewAttributes := NewAttributes and not faHidden;


if NewAttributes <> Attributes then


FileSetAttr(AFileName, NewAttributes);


end;


end;


end;　


以上过程中用到的函数FileDataTime在fmxutils单元中定义，返回一个TDatatime类型的变量。　


function FileDateTime(const FileName: String): System.TDateTime;


begin


Result := FileDateToDateTime(FileAge(FileName));


end;　


6.4.6 其它文件管理功能的实现　


　　在子窗口的Function菜单中，定义了一些其它的文件管理功能：


　　● Search ：查找一个给定名字的文件，若存在则显示该文件属性


　　● Disk View ：显示当前驱动器的大小和剩余空间


　　● View type ：确定显示文件的类型　


6.4.6.1 文件查找　


　　当用户单击Search菜单项时，程序弹出一个对话框(如图6.10)，要求输入待查找的文件名和查找路径。文件名可以是通配符。当用户确认后程序显示第一个匹配文件的属性(如图6.9)。查找不到匹配文件则给出相应的信息。


       在实现这一功能的最初设计中，我试图使用FileSearch函数，这个函数允许在多个不同路径中查找。但可惜的是：也许由于系统设计者的失误，这个函数并没有返回它应该返回的东西(第一个匹配文件的全路径名)，而是仍把输入的匹配符返回。


　　没有办法我只能再次使用FindFirst，这个函数的特性在6.3节中已进行了介绍。下面是这一功能的实现代码。　


procedure TFMForm.search1Click(Sender: TObject);


var


SearchForm: TSearchForm;


FileAttrForm: TFileAttrForm;


FindIt,path: String;


SearchRec: TSearchRec;


Return: Integer;


begin


SearchForm := TSearchForm.Create(self);


with SearchForm do


begin


SearchFile.text := '';


SearchPath.text := DirectoryOutline.Directory;


if (ShowModal <> idCancel) and


(SearchFile.Text <> '') and (SearchPath.text <> '') then


begin


FindIt := SearchPath.text+'/'+SearchFile.text;


Return := FindFirst(FindIt,faAnyFile,SearchRec);


if Return <> 0 then


FindIt := ''


else


FindIt := ExpandFileName(SearchRec.Name);


end;


if FindIt = '' then


MessageDlg('Cannot find the file in current directory.',


mtWarning, [mbOk], 0)


else


begin


Path := ExtractFilePath(FindIt);


FindIt := ExtractFileName(FindIt);


FileAttrForm := TFileAttrForm.Create(self);


ShowFileAttr(FileAttrForm,FindIt,Path);


end;


end;


end;　


6.4.6.2 显示磁盘信息


　　当用户单击Disk View菜单项时，将弹出一个TDiskViewForm类型的对话框，用来显示当前磁盘的信息


         磁盘信息的获取是在DiskViewForm中DriveEdit编辑框的OnChange事件处理过程中实现的。　


procedure TDiskViewForm.driveEditChange(Sender: TObject);


var


dr: Byte;


Free,Total: LongInt;


begin


Free := DiskFree(0);


Total := DiskSize(0);


FreeSpace.text := IntToStr(Free)+ ' bytes.';


TotalSpace.text := IntToStr(Total) + ' bytes.';


end;


　　DiskFree、DiskSize带参数为0表示当前驱动器。读者可以很容易把它改成按用户输入显示磁盘信息的情况。


　　DiskViewForm中的三个编辑框设计时都令ReadOnly为True。　


6.4.6.3 改变显示文件的类型　


　　改变显示文件的类型事实上是设置FileList的Mask属性。我们利用一个标准的InputBox输入文件的匹配字符串。而后利用Update方法更新FileList。　


procedure TFMForm.Viewtype1Click(Sender: TObject);


var


FileMask: String;


begin


FileMask := InputBox('File type','Input File type For View :',FileList.Mask);


If FileMask = '' then FileMask := '*.*';


FileList.Mask := FileMask;


FileList.Update;


CreateCaption;


end;


　　其中的CreateCaption私有过程将在(6.4.8)中进行介绍。　


6.4.7 目录管理功能的实现　


　　在子窗口的Directory菜单中，提供了目录管理功能：


　　● Create Directory ：创建一个子目录


　　● Delete Directory ：删除一个空的子目录


　　● Change Directory ：改变当前目录　


6.4.7.1 创建目录　


　　创建目录时首先弹出一个TNewDir类型的对话框


对话框中要求用户输入目录名。如果用户不输入路径，则缺省认定为当前目录的子目录：　


　　Dir := ExpandFileName(DirName.Text)；　


　　而后调用MkDir函数。在目录创建过程中关闭了I/O错误检测，出错不产生异常而是把IOResult设置为非零值。通过检查IOResult是否为0可以确定创建是否成功。


程序清单如下：　


procedure TFMForm.CreateDirectory1Click(Sender: TObject);


var


NewDir: TNewDir;


Dir: String;


begin


{$I-}


NewDir := TNewDir.Create(self);


with NewDir do


begin


CurrentDir.Caption := DirectoryOutline.Directory;


if (ShowModal <> idCancel) and (DirName.Text <> '') then


Dir := ExpandFileName(DirName.text);


end;


MkDir(Dir);


if IOResult <> 0 then


MessageDlg('Cannot Create directory', mtWarning, [mbOk], 0);


end;


　　但不幸的是目录创建后我们却无法从当前目录树中看到。必须移到另一个驱动器而后再返回，创建的目录才是可见的。在后边我们将提供一种解决方法。　


6.4.7.2 删除目录　


　　在实现目录删除过程中，远不如创建目录那么顺利。碰到的问题是:


　　1.RmDir不允许删除当前目录。但为了操作方便，我们要求删除的恰恰是当前目录；


　　2.目录删除后调用Refresh方法或Update方法并不能使该目录从屏幕显示中去除。因而当用户试图进入该目录时会导致系统崩溃。


　　对第一个问题，我们的解决办法是把当前目录转换到其父目录。假如读者记得目录也被操作系统作为一种特殊的文件对待的话，那么就不会对下面的语句感到奇怪了：　


　　path := DirectoryOutline.Directory;


　　Directoryoutlin.Directory := ExpandFilePath(Path);


　　而后调用RmDir过程：　


RmDir(Path)；


　


　　第二个问题的解决却颇为费神。因为DirectoryOutline是Delphi提供的示例部件，没有Help文件支持。通过试验发现：只有当DirectoryOutline的Drive属性改变时，才重新从相应驱动器读取目录。而且它基本上是只读的，除非清除( Clear) 它，象Add、Delete这些方法对它都是无效的。


　　我曾经考虑过一个笨拙的方法，那就是先改变当前驱动器而后再改回来。但这种方法一方面速度无法忍受，另一方面当只存在一个驱动器可用时会导致系统崩溃。


　　正当我一筹莫展时，突然想到：DirectoryOutline是一个Sample部件，Delphi 提供了它的源代码。而当我分析了它的源代码后，我知道应该做什么了，那就是为DirectoryOutline增添一个Reset方法!　


6.7.3 为部件增添一个方法　


　　严格地说，我们所做的工作属于创建一个新部件。但因为我们有源代码，所以不必从DirectoryOutline继承而是直接修改它。这样我们可以省去与创建部件有关的许多繁琐工作。对创建新部件感兴趣的读者可阅读本书第三编的有关章节。


　　在Delphi IDE中打开DirectoryOutline的源文件后：


1.把库单元名改为DirPlus，类名改为TDirectoryOutlinePlus，表明这是DirectoryOutline的增强版。而后存入另一个目录中；


　 2.添加一个公有方法Reset。这一方法的作用是重新读取当前驱动器的目录。程序清单如下。　


procedure TDirectoryOutlinePlus.Reset;


begin


ChDir(FDrive + ':');


GetDir(0, FDirectory);


FDirectory := ForceCase(FDirectory);


if not (csLoading in ComponentState) then BuildTree;


end;


　　读者也许被这段代码弄糊涂了。由于篇幅所限，而且涉及到许多自定义部件开发的内容，我们也不准备去详细解释它。假如读者想彻底搞懂它，我建议先看一下本书第三编有关自定义部件开发的内容，而后再对照原DirectoryOutline的源代码进行分析。


　　3.编译成一个库文件DirPlus.tpu;


4.把DirPlus加入部件的Samples页中。


　　如何添加一个部件见第三编有关章节的介绍。


　　当增强的目录树准备好以后，必须修改我们的子窗口设计，但却不必亲自修改源代码。


　　1.删除子窗口中的TDirectoryOutline类部件DirectoryOutline。此时FileList占据了整个客户区；


　　2.把FileList的Align属改为None，并留出左边的空白供放部件用；


　　3.在窗口左部加入TDirectoryOutlinPlus类的部件DirectoryOutline；


4.把DirectoryOutline的Align属性改为Left，FileList的Align属性还原为Client；


5.在DirectoryOutline的事件OnChange列表中选取DirectoryOutlineChange，即原DirectoryOutline的处理过程。


　　以上工作的最终目标是实现目录创建、删除后屏幕的正确显示。这只需要调用DirectoryOutline的Reset方法即可。


目录删除过程的实现代码如下。　


procedure TFMForm.DeleteDirectory1Click(Sender: TObject);


var


path: String;


k: Integer;


begin


{$I-}


path := DirectoryOutline.Directory;


DirectoryOutline.Directory := ExtractFilePath(Path);


if MessageDlg('Delete ' + path + '?', mtConfirmation,[mbYes, mbNo], 0) = idYes then


RmDir(path);


if IOResult <> 0 then


MessageDlg(' Cannot remove directory! The path might not'+


'exist,non-empty or is the current logged directory.',mtWarning,[mbOk], 0)


else


DirectoryOutline.Reset;


end;


修改后的目录创建过程如下。　


procedure TFMForm.CreateDirectory1Click(Sender: TObject);


var


NewDir: TNewDir;


Dir: String;


begin


{$I-}


NewDir := TNewDir.Create(self);


with NewDir do


begin


CurrentDir.Caption := DirectoryOutline.Directory;


if (ShowModal <> idCancel) and (DirName.Text <> '') then


Dir := ExpandFileName(DirName.text);


end;


MkDir(Dir);


if IOResult <> 0 then


MessageDlg('Cannot Create directory', mtWarning, [mbOk], 0)


else


DirectoryOutline.Reset;


end;


　　当完成了这些工作，把程序重新编译、运行后，可以发现我们所希望实现的功能完全实现了！同时，我们有了一个更好的目录树部件。　


6.4.7.4 改变当前目录　


　　改变当前目录的实现非常简单，只要修改DirectoryOutline的Directory属性。但需注意的是：当改变后目录所在驱动器也发生变化时应相应修改DriveTabSet的当前值。由于驱动器名与DriveTabSet的索引属性TabIndex之间并没有确定的对应关系，因而需要通过一个循环进行查找匹配。


Change Directory的菜单事件处理过程是FileChange，即与文件的移动、拷贝、更名共用一个事件处理过程。详细情况请读者参看(6.4.5.3)中的介绍。


改变当前目录的实现如下。　


procedure TFMForm.ChangeDirectory(Todir: String);


var


i: Integer;


begin


{$I-}


ChDir(ToDir);


if IOResult <> 0 then


MessageDlg('Cannot find directory', mtWarning, [mbOk], 0)


else


begin


with DirectoryOutline do


begin


Directory := ToDir;


Refresh;


if DriveTabSet.Tabs[DriveTabSet.TabIndex][1]<>drive then


for I := 1 to 25 do


if DriveTabSet.Tabs[i][1] = drive then


begin


DriveTabSet.TabIndex := i;


Exit;


end;


end;


end;


end;


6.4.8 一些问题的处理　


6.4.8.1 子窗口的标题　


　　Windows的文件管理器是我们设计的楷模，在子窗口显示标题上也不例外。我们把当前目录加上文件的类型作为子窗口的标题。


过程CreateCaption用于生成子窗口的标题。　


procedure TFMForm.CreateCaption;


var


Cap: String;


begin


Cap := DirectoryOutline.Directory;


Cap := cap+'/'+FileList.mask;


Caption := Cap;


end;　


         当前目录或文件显示类型发生变化时改变子窗口的标题。如DirectoryOutline的Change事件处理过程和ViewType菜单项的Click事件处理过程就调用了该过程。　


6.4.8.2 状态条的显示　


　　状态条用于显示当前目录和当前选中文件。它们的值在DirectoryOutline 和FileList的Change事件处理过程中修改。


　　DirectoryOutline和FileList最终的Change事件处理过程如下：　


procedure TFMForm.DirectoryOutlineChange(Sender: TObject);


begin


CreateCaption;


FileList.clear;


FileList.Directory := DirectoryOutline.Directory;


FileList.Update;


FileManager.DirectoryPanel.Caption := DirectoryOutline.Directory;


end;


procedure TFMForm.FileListChange(Sender: TObject);


begin


with FileList do


begin


if (ItemIndex >= 0) and (Not HasAttr(FileName,faDirectory)) then


begin


TheFileName := FileName;


FileManager.FilePanel.Caption :=


Format('%s, %d bytes', [TheFileName, GetFileSize(TheFileName)]);


end


else


FileManager.FilePanel.Caption := '';


end;


end;　


6.4.8.3 版本信息　


　　当用户单击主窗口的Help|About菜单项时将弹出一个About对话框，用于显示版本信息（如图6.13）。


　　这一对话框是用Delphi提供的模板做的。


6.4.8.4 菜单项的变灰与使能　


　　File菜单中定义的文件管理功能只有当活动焦点在FileList(即有当前选中文件)时才起作用。否则所有菜单项应变灰，以免导致系统崩溃。


　　这一功能在File菜单的Click事件处理过程中实现。这一点并不很容易被人想到，希望读者能从中受到启发。　


procedure TFMForm.File1Click(Sender: TObject);


var


FileSelected: Boolean;


begin


FileSelected := FileList.ItemIndex >= 0;


Open1.Enabled := FileSelected;


Delete1.Enabled := FileSelected;


Copy1.Enabled := FileSelected;


Move1.Enabled := FileSelected;


Rename1.Enabled := FileSelected;


Properties1.Enabled := FileSelected;


end;


　　判断是否有文件被选中是通过检测ItemIndex属性是否大于等于0来实现的。


　　 FileSelected := FileList.ItemIndex >= 0；　


6.4.8.5 可重用的文件处理模块　


　　库单元fmxutils是一个代码库，提供了若干文件处理模块。这些模块除在本程序中使用外，读者可以在其它应用程序中直接调用，而且不必重新编译，只要在Uses子句中包含即可。从中我们可以体会到，Delphi 以库单元为中心的程序组织方式提供了一种较完善的代码重用机制。　


6.4.9 小结　


　　文件管理器是一个较为综合的例程，使用到了绝大部分以文件名、文件句柄以及其它参数(除文件变量)为操作对象的文件管理过程/函数，同时也提供了一些程序设计开发的思想。我们的介绍是以程序功能模块来组织的，我建议读者在学习并试图自己建立这一程序时采用同样的方法。(6.4.8)中的内容或许是一开始就应了解的，但其它完全可以按顺序逐步地扩充，最后得到一个完整的程序。这一例程在后边的拖放操作和异常处理等章节中还要用到。读者可以以此为基础进一步完善它，使它真正成为一个完全实用的程序。


　　文件管理是在开发一个高级的Windows程序中不可避免的要涉及到的问题。本章介绍的思路和方法将为读者成为一个熟练的程序员奠定基础。


 


 


 


二．一些文件操作函数


//判断文件是否存在 FileExists
//判断文件夹是否存在 DirectoryExists
//删除文件 DeleteFile; Windows.DeleteFile
//删除文件夹 RemoveDir; RemoveDirectory
//获取当前文件夹 GetCurrentDir
//设置当前文件夹 SetCurrentDir; ChDir; SetCurrentDirectory
//获取指定驱动器的当前路径名 GetDir
//文件改名 RenameFile
//建立文件夹 CreateDir; CreateDirectory; ForceDirectories
//删除空文件夹 RemoveDir; RemoveDirectory
//建立新文件 FileCreate
//获取当前文件的版本号 GetFileVersion
//获取磁盘空间 DiskSize; DiskFree
//搜索文件 FindFirst; FindNext; FindClose
//读取与设置文件属性 FileGetAttr; FileSetAttr
//获取文件的创建时间 FileAge; FileDateToDateTime


Delphi代码


//判断文件是否存在 FileExists   


var  


  f: string;   


begin  


  f := 'c:"temp"test.txt';   


  if not FileExists(f) then  


  begin  


   //如果文件不存在   


  end;   


end;   


  


--------------------------------------------------------------------------------   


  


  


//判断文件夹是否存在 DirectoryExists   


var  


  dir: string;   


begin  


  dir := 'c:"temp';   


  if not DirectoryExists(dir) then  


  begin  


   //如果文件夹不存在   


  end;   


end;   


  


--------------------------------------------------------------------------------   


  


  


//删除文件 DeleteFile; Windows.DeleteFile   


var  


  f: string;   


begin  


  f := 'c:"temp"test.txt';   


//DeleteFile(f);  //返回 Boolean   


  


//或者用系统API:   


  Windows.DeleteFile(PChar(f)); //返回 Boolean   


end;   


  


--------------------------------------------------------------------------------   


  


  


//删除文件夹 RemoveDir; RemoveDirectory   


var  


  dir: string;   


begin  


  dir := 'c:"temp';   


  RemoveDir(dir); //返回 Boolean   


  


//或者用系统 API:   


  RemoveDirectory(PChar(dir)); //返回 Boolean   


end;   


  


--------------------------------------------------------------------------------   


  


  


//获取当前文件夹 GetCurrentDir   


var  


  dir: string;   


begin  


  dir := GetCurrentDir;   


  ShowMessage(dir); //C:"Projects   


end;   


  


--------------------------------------------------------------------------------   


  


  


//设置当前文件夹 SetCurrentDir; ChDir; SetCurrentDirectory   


var  


  dir: string;   


begin  


  dir := 'c:"temp';   


  if SetCurrentDir(dir) then  


    ShowMessage(GetCurrentDir); //c:"temp   


  


//或者   


  ChDir(dir); //无返回值   


  


//也可以使用API:   


  SetCurrentDirectory(PChar(Dir)); //返回 Boolean   


end;   


  


--------------------------------------------------------------------------------   


  


  


//获取指定驱动器的当前路径名 GetDir   


var  


  dir: string;   


  b: Byte;   


begin  


  b := 0;   


  GetDir(b,dir);   


  ShowMessage(dir); //   


  


//第一个参数: 1、2、3、4...分别对应: A、B、C、D...   


//0 是缺省驱动器   


end;   


  


--------------------------------------------------------------------------------   


  


  


//文件改名 RenameFile   


var  


  OldName,NewName: string;   


begin  


  OldName := 'c:"temp"Old.txt';   


  NewName := 'c:"temp"New.txt';   


  


  if RenameFile(OldName,NewName) then  


    ShowMessage('改名成功!');   


  


//也可以:   


  SetCurrentDir('c:"temp');   


  OldName := 'Old.txt';   


  NewName := 'New.txt';   


 


  if RenameFile(OldName,NewName) then  


    ShowMessage('改名成功!');   


  


//也可以:   


  SetCurrentDir('c:"temp');   


  OldName := 'Old.txt';   


  NewName := 'New.txt';   


  


  if RenameFile(OldName,NewName) then  


    ShowMessage('改名成功!');   


end;   


  


--------------------------------------------------------------------------------   


  


  


//建立文件夹 CreateDir; CreateDirectory; ForceDirectories   


var  


  dir: string;   


begin  


  dir := 'c:"temp"delphi';   


  if not DirectoryExists(dir) then  


    CreateDir(dir); //返回 Boolean   


  


//也可以直接用API:   


  CreateDirectory(PChar(dir),nil); //返回 Boolean   


  


//如果缺少上层目录将自动补齐:   


  dir := 'c:"temp"CodeGear"Delphi"2007"万一';   


  ForceDirectories(dir); //返回 Boolean   


end;   


  


--------------------------------------------------------------------------------   


  


  


//删除空文件夹 RemoveDir; RemoveDirectory   


var  


  dir: string;   


begin  


  dir := 'c:"temp"delphi';   


  RemoveDir(dir); //返回 Boolean   


  


//也可以直接用API:   


  RemoveDirectory(PChar(dir)); //返回 Boolean   


end;   


  


--------------------------------------------------------------------------------   


  


  


//建立新文件 FileCreate   


var  


  FileName: string;   


  i: Integer;   


begin  


  FileName := 'c:"temp"test.dat';   


  i := FileCreate(FileName);   


  


  if i>0 then  


    ShowMessage('新文件的句柄是: ' + IntToStr(i))   


  else  


    ShowMessage('创建失败!');   


end;   


  


--------------------------------------------------------------------------------   


  


  


//获取当前文件的版本号 GetFileVersion   


var  


  s: string;   


  i: Integer;   


begin  


  s := 'C:"WINDOWS"notepad.exe';   


  i := GetFileVersion(s); //如果没有版本号返回 -1   


  ShowMessage(IntToStr(i)); //327681 这是当前记事本的版本号(还应该再转换一下)   


end;   


  


--------------------------------------------------------------------------------   


  


  


//获取磁盘空间 DiskSize; DiskFree   


var  


  r: Real;   


  s: string;   


begin  


  r := DiskSize(3); //获取C:总空间, 单位是字节   


  r := r/1024/1024/1024;   


  Str(r:0:2,s); //格式为保留两位小数的字符串   


  s := 'C盘总空间是: ' + s + ' GB';   


  ShowMessage(s); //xx.xx GB   


  


  r := DiskFree(3); //获取C:可用空间   


  r := r/1024/1024/1024;   


  Str(r:0:2,s);   


  s := 'C盘可用空间是: ' + s + ' GB';   


  ShowMessage(s); //xx.xx GB   


end;   


  


//查找一个文件 FileSearch   


var  


  FileName,Dir,s: string;   


begin  


  FileName := 'notepad.exe';   


  Dir := 'c:"windows';   


  s := FileSearch(FileName,Dir);   


  


  if s<>'' then  


    ShowMessage(s) //c:"windows"notepad.exe   


  else  


    ShowMessage('没找到');   


end;   


  


--------------------------------------------------------------------------------   


  


  


//搜索文件 FindFirst; FindNext; FindClose   


var  


  sr: TSearchRec;    //定义 TSearchRec 结构变量   


  Attr: Integer;     //文件属性   


  s: string;         //要搜索的内容   


  List: TStringList; //存放搜索结果   


begin  


  s := 'c:"windows"*.txt';   


  Attr := faAnyFile;             //文件属性值faAnyFile表示是所有文件   


  List := TStringList.Create;    //List建立   


  


  if FindFirst(s,Attr,sr)=0 then //开始搜索,并给 sr 赋予信息, 返回0表示找到第一个   


  begin  


    repeat                       //如果有第一个就继续找   


      List.Add(sr.Name);         //用List记下结果   


    until(FindNext(sr)<>0);      //因为sr已经有了搜索信息, FindNext只要这一个参数, 返回0表示找到   


  end;   


  FindClose(sr);                 //需要结束搜索, 搜索是内含句柄的   


  


  ShowMessage(List.Text);        //显示搜索结果   


  List.Free;                     //释放List   


  


//更多注释:   


//TSearchRec 结构是内涵文件大小、名称、属性与时间等信息   


//TSearchRec 中的属性是一个整数值, 可能的值有:   


//faReadOnly  1   只读文件   


//faHidden    2   隐藏文件   


//faSysFile   4   系统文件   


//faVolumeID  8   卷标文件   


//faDirectory 16  目录文件   


//faArchive   32  归档文件   


//faSymLink   64  链接文件   


//faAnyFile   63  任意文件   


  


//s 的值也可以使用?通配符,好像只支持7个?, 如果没有条件就是*, 譬如: C:"*   


//实际使用中还应该在 repeat 中提些条件, 譬如判断如果是文件夹就递归搜索等等   


end;   


  


--------------------------------------------------------------------------------   


  


  


//读取与设置文件属性 FileGetAttr; FileSetAttr   


var  


  FileName: string;   


  Attr: Integer; //属性值是一个整数   


begin  


  FileName := 'c:"temp"Test.txt';   


  Attr := FileGetAttr(FileName);   


  ShowMessage(IntToStr(Attr)); //32, 存档文件   


  


//设置为隐藏和只读文件:   


  Attr := FILE_ATTRIBUTE_READONLY or FILE_ATTRIBUTE_HIDDEN;   


  if FileSetAttr(FileName,Attr)=0 then //返回0表示成功   


    ShowMessage('设置成功!');      


//属性可选值(有些用不着):   


//FILE_ATTRIBUTE_READONLY = 1; 只读   


//FILE_ATTRIBUTE_HIDDEN = 2; 隐藏   


//FILE_ATTRIBUTE_SYSTEM = 4; 系统   


//FILE_ATTRIBUTE_DIRECTORY = 16   


//FILE_ATTRIBUTE_ARCHIVE = 32; 存档   


//FILE_ATTRIBUTE_DEVICE = 64   


//FILE_ATTRIBUTE_NORMAL = 128; 一般   


//FILE_ATTRIBUTE_TEMPORARY = 256   


//FILE_ATTRIBUTE_SPARSE_FILE = 512   


//FILE_ATTRIBUTE_REPARSE_POINT = 1204   


//FILE_ATTRIBUTE_COMPRESSED = 2048; 压缩   


//FILE_ATTRIBUTE_OFFLINE = 4096   


//FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = 8192; 不被索引   


//FILE_ATTRIBUTE_ENCRYPTED = 16384   


end;   


  


--------------------------------------------------------------------------------   


  


  


//获取文件的创建时间 FileAge; FileDateToDateTime   


var  


  FileName: string;   


  ti: Integer;   


  dt: TDateTime;   


begin  


  FileName := 'c:"temp"Test.txt';   


  ti := FileAge(FileName);   


  ShowMessage(IntToStr(ti)); //返回: 931951472, 需要转换   


  


  dt := FileDateToDateTime(ti); //转换   


  ShowMessage(DateTimeToStr(dt)); //2007-12-12 14:27:32   


end;  


 


 
二． 数据库
1.跨服务器查询：
SELECT   *
FROM      OPENDATASOURCE(
         'SQLOLEDB',
         'Data Source=192.168.1.7;User ID=pp;Password=zxp2006.'
         ).ERP_MTDTEST.dbo.PURTB
WHERE  TB001+TB002  IN 
(


SELECT  TA001+TA002  FROM  PURTA   WHERE  TA001+TA002    NOT  IN
(SELECT TB001+TB002   FROM  PURTB)  
  
)
 
6.交差表：
　declare @sql varchar(8000)
　　
　　set @sql = 'select name,'
　　
　　select @sql = @sql + 'sum(case subject when '''+subject+'''
　　
　　then source else 0 end) as '''+subject+''','
　　
　　from (select distinct subject from test) as a
　　
　　select @sql = left(@sql,len(@sql)-1) + ' from test group by name'
　　
　　exec(@sql)
 
 
7. 取出给定部门的所有下属部门：
 alter   procedure GetAllDomn
@DepId varchar(10)
as
 
 
create table #temp(
DepId varchar(10),
PDepId  varchar(10)
)
 
select  depid ,pdeptid  into #temp from dept where pdeptid= @deptid
 
declare @i int
 
set @i=1
 
while @i<=5
begin
 
select b.deptid,b.pdeptid
into #temp1
from #temp a
inner join dept b on a.deptid= b.pdeptid
where b.delptid not in (select deptid from  #dept)
 
select #temp1.*   into #temp from  #temp1
delete from #temp1
 
set @i=@i+1
 
end
 
 
select * from #temp
 
 
drop table #dept
drop table #temp1
 
go
 
 
 
5. BOM表(原创)
--   sp_GetDetailMaterial 'MHWJ00026C','*','1'
CREATE  proc sp_GetDetailMaterial
@PRONO  VARCHAR(30),
@CK varchar(10),
@SH  VARCHAR(1) --是否计损耗
as
 
 
CREATE TABLE #BOMTEMP
(
MD001 VARCHAR(30),
MD003  VARCHAR(30)
)
 
/*
CREATE TABLE #BOMT1
(
MD001 VARCHAR(30),
MD003  VARCHAR(30)
)
*/
declare
@LEVEL int
 
 
insert INTO #BOMTEMP  select MD001,MD003 FROM BOMMD
WHERE MD001=@PRONO
 
--SELECT * INTO #BOMTEMP FROM @BOM1
 
set @LEVEL=1
WHILE @LEVEL<10
BEGIN
SELECT A.MD001,A.MD003
INTO #BOM1
FROM BOMMD A
INNER JOIN #BOMTEMP B ON A.MD001=B.MD003
WHERE A.MD003 NOT IN (SELECT MD003 FROM #BOMTEMP)
   
 IF @@ROWCOUNT<1 
 BREAK
 
insert INTO #BOMTEMP SELECT *  FROM #BOM1
 
 DELETE FROM #BOM1 
 DROP TABLE #BOM1
SET @LEVEL= @LEVEL+1
END
 
PRINT(@LEVEL)
 
IF @CK='*'
SELECT  B.MB001,MB002,MB003,MB004,MB017,C.MD009,
(case  when @SH='1' THEN  C.MD006/C.MD007*(1+C.MD008)
ELSE C.MD006/C.MD007*(1+0) END 
) AS AQTY
FROM #BOMTEMP A
INNER JOIN INVMB B ON A.MD003=MB001
INNER JOIN  BOMMD C ON C.MD001=A.MD001 AND A.MD003=C.MD003
WHERE  B.MB109='Y'
 
ELSE
 
SELECT  B.MB001,MB002,MB003,MB004,@CK AS MB017 ,C.MD009,
(case  when @SH='1' THEN  C.MD006/C.MD007*(1+C.MD008)
ELSE C.MD006/C.MD007*(1+0) END 
) AS AQTY
FROM #BOMTEMP A
INNER JOIN INVMB B ON A.MD003=MB001
INNER JOIN  BOMMD C ON C.MD001=A.MD001 AND A.MD003=C.MD003
WHERE  B.MB109='Y'
DROP TABLE #BOMTEMP
 
GO
 
 
8 Delphi三层架构的一种方法
2008年09月13日 星期六 23:08
Delphi三层架构的一种方法
理解：把服务端数据取回客户端，在客户端操作（如添加）完毕后，传到服务器端统一更新。
         需在客户端选取回表信息（结构，内容）。
前题：
       scktsrvr.exe（delphi安装的程序目录里有， 需启动）
       midas.dll（windows系统目录里有此文件，从新注册方法调用：regsvr32.exe）
过程：
       服务器端：新建立 New->other->Multitier->Remote Data Module
                     做数据链接。例如：用控件TADoConnection
                     建立函数 View->Type Library
                     在生成的 Interface 里建立 Method；
                     例如：
--------------------------------------------------------------------------------------------------------------------------
                             名称：ExecSQL
                             Parameter：Name         Type           Modifier
                                             SQL             BSTR           [in]                 输入类型字符型
                                             result           VARIANT*   [out,retval]     输出类型，结果
--------------------------------------------------------------------------------------------------------------------------
                     方法举例：
Code
--------------------------------------------------------------------------------------
function TRDM.ExecSQL(const SQL: WideString): OleVariant;
var
   adoqrytem:TAdoQuery;
   prvtem:TDataSetProvider;
begin
   adoqrytem:=TAdoQuery.create(self);           //创建临时adoquery
   adoqrytem.connection:=conn;
    
   prvtem:=TDataSetProvider.create(self);       //创建临时datasetprovider
   prvtem.DataSet:=adoqrytem;
   adoqrytem.Close;             //执行sql
   adoqrytem.sql.clear;
   adoqrytem.sql.text:= SQL;
   adoqrytem.open;
   result:=prvtem.data;
   adoqrytem.free;
   prvtem.free;
end;
-----------------------------------------------------------------------------------------
     客户端：
               建立链接 用控件DataSnap->SocketConnection
               调用方法：
               例   SocketConnection1.AppServer.方法名称
                     ClienTDataSet1.Data := SocketConnection1.AppServer.ExecSQL('select …… ');
------------------------------------------------------------------------------------------
补充说明：
客户端ClientDataSet控件取回表的内容，在客户端本机操作（添加、修改、删除），在保存时，传递整个ClientDataSet表，例如：
cdsTemp:TClientDataSet;
……
if
   ClientDM.scktconn.AppServer.UpdatePub_Depart(username,cdsTemp.Delta,Msg) = 0 then








在使用DataModel窗体存放数据库控件的程序中,应注意：
1、如果在其他窗体中调用DataModel中的控件必须在先引用Datemodel的单元，在implementation下面加入以下语句


uses 


     DataModel的单元名称;


2、必须改变窗体的创建顺序，datamodel窗体必须先于引用该窗体控件的窗体创建
三层结构


应用层：
一、需要三个数据控件：
Adoconnect         
AdoQuery
DataSetProvider


二、联接顺序：
SQL数据库<--Adoconnect<--Adoquery<--DataSetProvider


三、属性设置：
Adoconnect：     1、ConnectionString
                 2、Connected
Adoquery:         1、connection
                 //2、Active
DataSetProvider: 1、DataSet
                 2、option.poAllowCommand:=true
四、其他
1、运行SocketServer并开端口
2、数据模块使用远程数据模块


客户端：
一、基本控件
SocketConnection
ClientDataSet
DataSoure
DBGrid


二、联接顺序：
应用层<--SocketConnection<--ClientDataSet<--DataSoure<--DBGrid


三、属性设置：
SocketConnection: 1、Adrress
                   2、ServerName
                   3、Port
                   4、connected
ClientDataSet：   1、RemoteServer
                   2、CommandText
                   3、ProviderName
                   4、Active
DataSoure：       1、DataSet
DBGrid：           1、DataSoure


四、其他




一、先关闭记录集后执数据库操作语句
   rs.close
   sqlstr="insert into abc(a,b,c) values("a","b","c")"
   rs.open sqlstr,conn
   rs.update
   rs.colose
二、在可能发生出错的数据库操作做错误捕捉，如：open,update,delete等
   rs.close
   sqlstr="insert into abc(a,b,c) values("a","b","c")"
   on error resume next  
   rs.open sqlstr,conn
   if err then
   msgbox(err.Description)
   msgbox(cstr(err.number))
   rs.update
   rs.colose