利用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:windowsotepad.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無效（沒有聲明）。于是在加入...SourceRTLSYSsysutils.pas和....SourceWINwindows.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:windowsotepad.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:windowsotepa.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:windowsotepa.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中無的其它函數來。