利用Delphi扩充VB函数 |
|
很多编程爱好者对VB、Delphi两种编程工具都十分了解。如何把Delphi的优点为VB所用成为编程者十分感兴起的话题。VB比Delphi 更易学习掌握，但VB函数太少，往满足不了实际应用的要求。 如何利用Delphi来扩充VB函数呢？当然，利用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; file://函数声明 function FileExists(const FileName: string): Boolean; function FileAge(const FileName: string): Integer; function FindFirstFile(lpFileName: PChar; var lpFindFileData: TWIN32FindData): THan dle; 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 end if end if FileAge = -1 End Function 运行程序，VB程序与Delphi程序具有相同的效果。只要变化文件名D的值，D在盘中是否存在就会在对话框中提示是否存在。 以上代码在Windows95/98 中文版 Delphi5.0英文版 VB5.0/6.0中文版下通过。据此原理，还可写出在Delphi中有而VB中无的其它函数来。 |
