VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 利用Delphi扩充VB函数
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:16037, 日期:2001-06-16
利用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中无的其它函数来。