|
利用Delphi扩充VB函数可以是直接由Delphi编写动态链接库文件，象Windows API函数那样由VB直接调用，这种方式称为直接调用。本文讲述的是另一种调用方法，即根据Delphi内部函数源代码设计思想，利用Windows API编写VB的函数。
我们知道，Delphi除其它特点外，最大的特点就是开放性：大多Delphi内部函数、控件等都能在...\Source子目录下找到其源代码。仔细分析不难发现，Delphi函数、控件等所用的语句基本是汇编语言、Windows API函数所构成。虽然VB内部函数较少，但仍可用Windows API函数进行扩充。对于大多数编程者来说，直接用Windows API编程难度较大，很多时候只知其一不知其二，用API编写的函数并不完善，缺乏通用性。而Delphi的内部函数源代码毕竟为专家所写，经过长期调试是成功的。
Delphi的函数FileExists意为文件名是否存在，返回为逻辑值，即文件存在时为真，反之为假。下面就以FileExists为例来说明如何利用Delphi的思想来编写VB的FileExists函数，以起到抛砖引玉的作用，其它用Windows API函数写的Delphi函数基本仍可按此原理出VB的函数。
首先进入Delphi，任写一Fileexists函数，鼠标在其上停留片刻，Delphi就会提示该函数出自sysutils.pas中。
新建工程文件名为Project1.dpr,另存为Pfileexists.dpr；去掉Form1窗体的对窗体描述的文本部分（即扩展名为Dfm的相关文件），对Unit1.pas 另存为uFileExists.pas 。
在文件PFileexists.dpr中，只保留Uses 中的Forms和uFileexists.pas,去掉其它引用。在Begin...End 程序体中加入以下代码：
d:='c:\windows\notepad.exe';
if fileexists(d) then application.MessageBox(pchar(d+' is exist'),'提示',
0) else application.MessageBox(pchar(d+' is not exist'),'提示',0);
对uFileexists.pas 文件，去掉Uses的全部引用部分。
编译运行程序，Delphi就会提示函数Fileexists无效（没有声明）。于是在加入...\Source\RTL\SYS\sysutils.pas和....\Source\WIN\windows.pas两文件。在Pfileexists.dpr中去掉对sytutils.pas 和Windows.pas 的引用。
分析、逐步调试，把Windows.pas和sysutils.pas 有关的类型、常量、函数声明、函数执行体等加入ufileexists.pas中。
Pfileexists.dpr源程序代码如下：
program Pfileexists;
uses
Forms,//application.messagebox要用到该声明
uFileexists in 'uFileexists.pas';//调用FileExists函数用得上；
{$R *.RES}
var d:string ;//声明文件名为字符串型；
begin
d:='c:\windows\notepad.ex';
if fileexists(d) then application.MessageBox(pchar(d+' is exist'),'提示',
0) else application.MessageBox(pchar(d+' is not exist'),'提示',0);
end.
uFileexists.pas源程序代码如下：
unit uFileexists;
type DWORD = LongWord;
BOOL = LongBool;
Const//常量取值
MAX_PATH = 260;
INVALID_HANDLE_VALUE = DWORD(-1);
FILE_ATTRIBUTE_DIRECTORY = $00000010;
kernel32 = 'kernel32.dll';//API函数引用的动态链接库名
type//类型
LongRec = packed record
Lo, Hi: Word;
end;
THandle = LongWord;
_FILETIME = record
dwLowDateTime: DWORD;
dwHighDateTime: DWORD;
end;
TFileTime = _FILETIME;
_WIN32_FIND_DATAA = record
dwFileAttributes: DWORD;
ftCreationTime: TFileTime;
ftLastAccessTime: TFileTime;
ftLastWriteTime: TFileTime;
nFileSizeHigh: DWORD;
nFileSizeLow: DWORD;
dwReserved0: DWORD;
dwReserved1: DWORD;
cFileName: array[0..MAX_PATH - 1] of AnsiChar;
cAlternateFileName: array[0..13] of AnsiChar;
end;
TWin32FindDataA = _WIN32_FIND_DATAA;
TWin32FindData = TWin32FindDataA;
//函数声明
function FileExists(const FileName: string): Boolean;
function FileAge(const FileName: string): Integer;
function FindFirstFile(lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle; stdcall;
function FindClose(hFindFile: THandle): BOOL; stdcall;
function FileTimeToLocalFileTime(const lpFileTime: TFileTime; var lpLocalFileTime: TFileTime): BOOL; stdcall;
function FileTimeToDosDateTime(const lpFileTime: TFileTime; var lpFatDate, lpFatTime: Word): BOOL; stdcall;
implementation
function FileExists(const FileName: string): Boolean;
begin
Result := FileAge(FileName) <> -1;
end;
function FileAge(const FileName: string): Integer;
var
Handle: THandle;
FindData: TWin32FindData;
LocalFileTime: TFileTime;
begin
Handle := FindFirstFile(PChar(FileName), FindData);
if Handle <> INVALID_HANDLE_VALUE then
begin
FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
LongRec(Result).Lo) then
end;
end;
Result := -1;
end;
function FindFirstFile; external kernel32 name 'FindFirstFileA';
function FindClose; external kernel32 name 'FindClose';
function FileTimeToLocalFileTime; external kernel32 name 'FileTimeToLocalFileTime';
function FileTimeToDosDateTime; external kernel32 name 'FileTimeToDosDateTime';
end.
仔细分析uFileexists.pas 的代码，不难发现Delphi用了六个函数，其中Fileexists为主函数，FileAge为Delphi写的中间函数，其余四个函数FindFirstFile、 FindClose、 FileTimeToLocalFileTime、 FileTimeToDosDateTime 为Windows API函数。
Delphi中的Result在VB中表述为直接写函数名即可，LongRec类型在VB中无，经实践对LongRec(Result).HI,LongRec(Result).Lo在VB中用FileAge代替即可。
下面是在VB中如何写FileExists函数。
进入VB，新建一工程文件名为工程1.vbp,窗体文件名为Form1.pas，添加名为Module1.bas的模块文件。
在Form1窗体中加入Command按钮，在Click事件中加入以下代码。
Dim D As String
D = "c:\windows\notepa.exe"
If FileExists(D) Then MsgBox D + " is exist" Else MsgBox D + " is not exist"
在模块中用API文本查看器，加入uFileExists.pas中的四个API函数FindFirstFile、 FindClose、 FileTimeToLocalFileTime、 FileTimeToDosDateTime,并加入相应的声明、类型等代码。
Form1.frm的源代码如下：
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3945
ClientLeft = 2325
ClientTop = 1530
ClientWidth = 6420
LinkTopic = "Form1"
ScaleHeight = 3945
ScaleWidth = 6420
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 495
Left = 600
TabIndex = 0
Top = 840
Width = 3135
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
‘以上代码在VB中是不可见的。
Option Explicit
Private Sub Command1_Click()
Dim D As String
D= "c:\windows\notepa.exe"
If FileExists(D) Then MsgBox D + " is exist" Else MsgBox D + " is not exist"
End Sub
Module1.bas的源代码如下：
Attribute VB_Name = "MyModule"‘该段代码在VB中是不可见的。
Option Explicit
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const MAX_PATH = 260
Public Const INVALID_HANDLE_VALUE = -1
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Declare Function FileTimeToDosDateTime Lib "kernel32" (lpFileTime As FILETIME, ByVal lpFatDate As Long, ByVal lpFatTime As Long) As Long
Function FileExists(FileName As String) As Boolean
FileExists = (FileAge(FileName) <> -1)
End Function
Function FileAge(FileName As String) As Integer
Dim di As Long
Dim Handle As Long
Dim FindData As WIN32_FIND_DATA
Dim LocalFileTime As FILETIME
Handle = FindFirstFile(FileName, FindData)
If Handle <> INVALID_HANDLE_VALUE Then
FindClose (Handle)
If (FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
'di = FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime)
' If FileTimeToDosDateTime(LocalFileTime, di, di) = 0 Then
' FileAge = 0
FileTimeToLocalFileTime FindData.ftLastWriteTime, LocalFileTime
If FileTimeToDosDateTime(LocalFileTime, FileAge, FileAge) = 0 Then Exit Function
End If
End If
FileAge = -1
End Function
运行程序，VB程序与Delphi程序具有相同的效果。只要变化文件名D的值，D在盘中是否存在就会在对话框中提示是否存在。
以上代码在Windows95/98 中文版 Delphi5.0英文版 VB5.0/6.0中文版下通过。据此原理，还可写出在Delphi中有而VB中无的其它函数来。
|
