| | | 利用Delphi扩充VB函数 | | 2001-03-19·
·邓世学 ··yesky
| 上一页 1 2 3
下面是在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中无的其它函数来。
上一页 1 2 3 | | | 感谢
访问天极网，如果您觉得该文章涉及版权问题，请看这里！
|
|
