进程中自我销毁

Option Explicit

Const NORMAL_PRIORITY_CLASS = &H20
Const REALTIME_PRIORITY_CLASS = &H100
Const THREAD_PRIORITY_NORMAL = 0
Const THREAD_PRIORITY_IDLE = -15
Const IDLE_PRIORITY_CLASS = &H40
Const DETACHED_PROCESS = &H8
Const CREATE_SUSPENDED = &H4
Const THREAD_PRIORITY_TIME_CRITICAL = 15
Const SW_HIDE = 0
Const STARTF_USESHOWWINDOW = &H1

Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type

Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Declare Function GetModuleFileName Lib “kernel32” Alias “GetModuleFileNameA” (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Declare Function GetEnvironmentVariable Lib “kernel32” Alias “GetEnvironmentVariableA” (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetShortPathName Lib “kernel32” Alias “GetShortPathNameA” (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Declare Function GetCurrentProcess Lib “kernel32” () As Long
Declare Function GetCurrentThreadId Lib “kernel32” () As Long
Declare Function SetPriorityClass Lib “kernel32” (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Declare Function SetThreadPriority Lib “kernel32” (ByVal hThread As Long, ByVal nPriority As Long) As Long
Declare Function ResumeThread Lib “kernel32” (ByVal hThread As Long) As Long
Declare Function GetCurrentThread Lib “kernel32” () As Long
Declare Function CreateProcess Lib “kernel32” Alias “CreateProcessA” (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Function DeleteMe() As Boolean
Dim szModule As String
Dim szComspec As String
Dim szParams As String

Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim sa1 As SECURITY_ATTRIBUTES
Dim sa2 As SECURITY_ATTRIBUTES

szModule = String(512, 0)
szComspec = String(512, 0)
szParams = String(512, 0)

‘// get file path names:
If ((GetModuleFileName(0, szModule, 512) <> 0) And (GetShortPathName(szModule, szModule, 512) <> 0) And (GetEnvironmentVariable(“COMSPEC”, szComspec, 512) <> 0)) Then
‘// set command shell parameters
szComspec = Left(szComspec, InStr(szComspec, Chr(0)) – 1)
szModule = Left(szModule, InStr(szModule, Chr(0)) – 1)

szComspec = szComspec & ” /c del ” & szModule
‘下行支持带空格路径
‘szComspec = szComspec & ” /c del ” & “””” & szModule & “”””

‘// set struct members
With si
.cb = Len(si)
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = SW_HIDE
End With
‘// increase resource allocation to program
Call SetPriorityClass(GetCurrentProcess(), REALTIME_PRIORITY_CLASS)
Call SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_TIME_CRITICAL)

‘// invoke command shell
‘Debug.Print CreateProcess(vbNullString, szComspec, sa1, sa2, 0&, CREATE_SUSPENDED Or DETACHED_PROCESS, 0&, vbNullString, si, pi)
If CreateProcess(vbNullString, szComspec, sa1, sa2, 0, CREATE_SUSPENDED Or DETACHED_PROCESS, 0, vbNullString, si, pi) Then
‘// suppress command shell process until program exits
Call SetPriorityClass(pi.hProcess, IDLE_PRIORITY_CLASS)
Call SetThreadPriority(pi.hThread, THREAD_PRIORITY_IDLE)

‘// resume shell process with new low priority
Call ResumeThread(pi.hThread)

‘// everything seemed to work
DeleteMe = True
Exit Function
Else ‘// if error, normalize allocation
Call SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS)
Call SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_NORMAL)
End If
End If
DeleteMe = False
End Function

Public Sub KillMe()
Dim sPath As String
sPath = IIf(Right(App.Path, 1) = “\”, App.Path, App.Path & “\”)
On Error GoTo InIDE
Debug.Print 1 / 0 ‘触发IDE错误,防止删除 VB6.exe
Dim iFile As Integer
iFile = FreeFile
Open sPath & “KillMe.bat” For Output As #iFile
Print #iFile, “:Repeat” & vbCrLf & _
“del “”” & sPath & App.EXEName & “.exe””” & vbCrLf & _
“if exist “”” & sPath & App.EXEName & “.exe””” & ” goto Repeat” & vbCrLf & _
“del %0”
Close #iFile
Shell sPath & “KillMe.bat”, vbHide
InIDE:
End Sub

Public Sub DelMe()
Dim iFileNumber As Integer
On Error Resume Next
If App.LogMode Then
iFileNumber = FreeFile()
Open “del.tmp.vbs” For Output As iFileNumber
SetAttr “del.tmp.vbs”, vbHidden
Print #iFileNumber, “Dim FSO,WMI”
Print #iFileNumber, “Set WMI=GetObject(” & Chr(34) & “winmgmts://.” & Chr(34) & “)”
Print #iFileNumber, “Set FSO=CreateObject(” & Chr(34) & “Scripting.FileSystemObject” & Chr(34) & “)”
Print #iFileNumber, “Do While WMI.ExecQuery(” & Chr(34) & _
“SELECT * FROM WIN32_PROCESS WHERE NAME='” & App.EXEName & “.EXE'” & Chr(34) & “).Count”
Print #iFileNumber, “WScript.Sleep 1”
Print #iFileNumber, “Loop”
Print #iFileNumber, “FSO.DeleteFile ” & Chr(34) & App.Path & “/” & App.EXEName & “.EXE” & Chr(34)
Print #iFileNumber, “FSO.DeleteFile ” & Chr(34) & App.Path & “/del.tmp.vbs” & Chr(34)
Print #iFileNumber, “Set FSO=Nothing”
Print #iFileNumber, “Set WMI=Nothing”
Close #iFileNumber
Shell “WScript.Exe del.tmp.vbs”, vbHide
End If
End Sub

延迟(停滞)进程

Option Explicit
‘与Sleep相比,本模块的 Wait 不占用CPU的时间
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

‘Private Const WAIT_ABANDONED& = &H80&
‘Private Const WAIT_ABANDONED_0& = &H80&
‘Private Const WAIT_FAILED& = -1&
‘Private Const WAIT_IO_COMPLETION& = &HC0&
Private Const WAIT_OBJECT_0& = 0
‘Private Const WAIT_OBJECT_1& = 1
‘Private Const WAIT_TIMEOUT& = &H102&

Private Const INFINITE = &HFFFF
Private Const ERROR_ALREADY_EXISTS = 183&

Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
‘Private Const QS_MOUSE& = (QS_MOUSEMOVE _
Or QS_MOUSEBUTTON)
‘Private Const QS_INPUT& = (QS_MOUSE _
Or QS_KEY)
‘Private Const QS_ALLEVENTS& = (QS_INPUT _
Or QS_POSTMESSAGE _
Or QS_TIMER _
Or QS_PAINT _
Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE _
Or QS_PAINT _
Or QS_TIMER _
Or QS_POSTMESSAGE _
Or QS_MOUSEBUTTON _
Or QS_MOUSEMOVE _
Or QS_HOTKEY _
Or QS_KEY)

Private Declare Function CreateWaitableTimer Lib “kernel32” _
Alias “CreateWaitableTimerA” ( _
ByVal lpSemaphoreAttributes As Long, _
ByVal bManualReset As Long, _
ByVal lpName As String) As Long

‘Private Declare Function OpenWaitableTimer Lib “kernel32” _
Alias “OpenWaitableTimerA” ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal lpName As String) As Long

Private Declare Function SetWaitableTimer Lib “kernel32” ( _
ByVal hTimer As Long, _
lpDueTime As FILETIME, _
ByVal lPeriod As Long, _
ByVal pfnCompletionRoutine As Long, _
ByVal lpArgToCompletionRoutine As Long, _
ByVal fResume As Long) As Long

‘Private Declare Function CancelWaitableTimer Lib “kernel32” ( _
ByVal hTimer As Long)

‘Private Declare Function CloseHandle Lib “kernel32” ( _
ByVal hObject As Long) As Long

‘Private Declare Function WaitForSingleObject Lib “kernel32” ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long

Private Declare Function MsgWaitForMultipleObjects Lib “user32” ( _
ByVal nCount As Long, _
pHandles As Long, _
ByVal fWaitAll As Long, _
ByVal dwMilliseconds As Long, _
ByVal dwWakeMask As Long) As Long

Public Sub Wait(dwMilliseconds As Long)
Dim ft As FILETIME
Dim lBusy As Long
Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim hTimer As Long
hTimer = CreateWaitableTimer(0, True, App.EXEName & “Timer”)
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
‘ If the timer already exists, it does not hurt to open it
‘ as long as the person who is trying to open it has the
‘ proper access rights.
Else
ft.dwLowDateTime = -1
ft.dwHighDateTime = -1
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
End If
‘ Convert the Units to nanoseconds.
dblUnits = CDbl(&H10000) * CDbl(&H10000)
dblDelay = CDbl(dwMilliseconds) * 10000
‘ By setting the high/low time to a negative number, it tells
‘ the Wait (in SetWaitableTimer) to use an offset time as
‘ opposed to a hardcoded time. If it were positive, it would
‘ try to convert the value to GMT.
ft.dwHighDateTime = -CLng(dblDelay / dblUnits) – 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits – _
Fix(dblDelay / dblUnits))
If dblDelayLow < CDbl(&H80000000) Then
‘ &H80000000 is MAX_LONG, so you are just making sure
‘ that you don’t overflow when you try to stick it into
‘ the FILETIME structure.
dblDelayLow = dblUnits + dblDelayLow
ft.dwHighDateTime = ft.dwHighDateTime + 1
End If
ft.dwLowDateTime = CLng(dblDelayLow)
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, False)
Do
‘ QS_ALLINPUT means that MsgWaitForMultipleObjects will
‘ return every time the thread in which it is running gets
‘ a message. If you wanted to handle messages in here you could,
‘ but by calling Doevents you are letting DefWindowProc
‘ do its normal windows message handling—Like DDE, etc.
lBusy = MsgWaitForMultipleObjects(1, hTimer, False, _
INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lBusy = WAIT_OBJECT_0
‘ Close the handles when you are done with them.
CloseHandle hTimer
End Sub

文件系统对象(File System Object)

一、简   

 文件系统对象FSO的英文全称是File System Object ,这种对象模型提出了有别于传统的文件操作语句处理文件和文件夹的方法。通过采用object.method这种在面向对象编程中广泛使用的语法,将一系列操作文件和文件夹的动作通过调用对象本身的属性直接实现。

FSO 对象模型不仅可以象使用传统文件操作语句那样实现文件的创建、改变、移动和删除,而且可以检测是否存在指定的文件夹,如果存在,那么,这个文件夹又位于磁盘上的什么位置。更令人高兴的是FSO 对象模型还可以获取关于文件和文件夹的信息,如名称、创建日期或最近修改日期等以及当前系统中使用的驱动器的信息,如驱动器的种类是CD-ROM还是可移动磁盘,当前磁盘的剩余空间还有多少。而以前要获取这些信息必须通过调用Windows API函数集中的相应函数才能实现。

FSO对象模型包含在Scripting 类型库 (Scrrun.Dll)中,它同时包含了DriveFolderFileFileSystemObjectTextStream五个对象。其中Drive用来收集驱动器的信息,如可用磁盘空间或驱动器的类型;Folder用于创建、删除或移动文件夹,同时可以进行向系统查询文件夹的路径等操作;File的基本操作和Folder基本相同,所不同的是Files的操作主要是针对磁盘上的文件进行的;FileSystemObject是FSO对象模型中最主要对象,它提供了一套完整的可用于创建、删除文件和文件夹,收集驱动器、文件夹、文件相关信息的方法。需要注意的是,FSO对象模型提供的方法是冗余的,也就是说在实际使用中,FSO对象模型中包含的不同对象的不同方法进行的却是同样的操作,而且FileSystemObject对象的方法直接作用于其余对象,所以在后面的文章中并没有单独提到FileSystemObject对象,千万不要以为没有提到就不重要,事实上FileSystemObject对象在整个FSO对象模型中无处不在;最后的TextStream对象则是用来完成对文件的读写操作的。

创建FSO对象模型:

由于FSO对象包含在Scripting 类型库 (Scrrun.Dll)中,所以在使用前首先需要在在工程中引用这个文件,单击“工程”,“引用”,然后在“引用”对话框中选中“Microsoft Scripting Runtime”前的复选框,然后单击“确定”。

要创建FSO对象可以采用两种方法,一种是将一个变量声明为FSO对象类型:Dim fsoTest As New FileSystemObject;另一种是通过CreateObject方法创建一个FSO 对象:Set fsoTest = CreateObject(“Scripting.FileSystemObject”)。在实际使用中具体采用哪种声明方法,可根据个人的使用习惯而定。

完成了FSO对象模型的创建之后,就可以利用创建的对象模型的方法访问下属各个对象的属性来获取所需信息或进行相关操作了

FileSystemObject对象有许多用来操作文件系统的方法和属性。

 二、FileSystemObject中的对象的方法和属性

(一)FSO对象

属性:

1Drives属性

Drives属性是FileSystemObject对象唯一的属性,返回对硬盘驱动器集合(Drives)的引用,是一个只读属性。其语法为:

oFileSysObj.Drives

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。

Drives属性返回的集合中的每个成员都是Drive对象,表示系统中一个可用的驱动器。可以使用For … Next循环迭代系统中所有驱动器,或者使用Drives集合的Item方法读取某个Drive对象(代表系统中的某个驱动器)。

 方法:

1BuildPath方法

其语法为:

oFileSysObj.BuildPath (Path,Name)

其中,oFileSysObj为任何能够返回FileSystemObject对象的对象变量。参数Path必需,指定驱动器或文件夹路径,String类型,可以是绝对路径也可以是相对路径,不一定要包含驱动器名。参数Name必需,指定附加在Path后的文件夹或文件路径,String类型。参数Path或Name都不一定要求是当前已经存在的路径或文件夹。

BuildPath方法通过合并参数Path和文件夹或文件名生成一个字符串,并且在必要的地方加上正确的主机系统路径分隔符。该方法不能检验新的文件夹或文件名的有效性。

与人工合并两个字符串相比,使用BuildPath函数的惟一好处就是它能够选择正确的路径分隔符。

2FileExists方法

FileExists方法用于判断指定的文件是否存在,若存在则返回True。其语法为:

oFileSysObj.FileExists(FileSpec)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象。参数FileSpec必需,代表文件的完整路径,String类型,不能包含有通配符。

如果用户有充分的权限,FileSpec可以是网络路径或共享名,例如:

If ofs.FileExists(“\\TestPath\Test.txt”) Then XXX

3GetFile方法

GetFile方法用来返回一个File对象。其语法为:

oFileSysObj.GetFile (FilePath)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数FilePath必需,指定路径和文件名,String类型。可以是绝对路径或相对路径。如果FilePath是一个共享名或网络路径,GetFile确认该驱动器或共享是File对象创建进程的一部分。如果参数FilePath指定的路径的任何部分不能连接或不存在,就会产生错误。

GetFile方法返回的是File对象,而不是TextStream对象。File对象不是打开的文件,主要是用来完成如复制或移动文件和询问文件的属性之类的方法。尽管不能对File对象进行写或读操作,但可以使用File对象的OpenAsTextStream方法获得TextStream对象。

要获得所需的FilePath字符串,首先应该使用GetAbsolutePathName方法。如果FilePath包含网络驱动器或共享,可以在调用GetFile方法之前用DriveExists方法来检验所需的驱动器是否可用。

因为在FilePath指定的文件不存在时会产生错误,所以应该在调用GetFile之前调用FileExists方法确定文件是否存在。

必须用Set语句将File对象赋给一个局部对象变量。

4GetFileName方法

GetFileName方法返回给定路径的文件名称部分。其语法为:

oFileSysObj.GetFileName (Path)

其中,oFileSysObj表示任何能够返回FileSystemObject对象的对象变量。参数Path必需,指定路径说明,String类型。如果不能从给定的Path确定文件名,则返回一个零长字符串(””)。Path可以为绝对路径或相对路径。

GetFileName方法不能检验Path中是否存在指定的文件。Path可以为网络驱动器或共享。GetFileName本身不具有智能,它认为字符串中不属于驱动器说明的最后部分就是一个文件名,更像是一个字符串处理函数而不是对象处理方法。

5GetFileVersion方法

GetFileVersion方法返回文件的版本。

6CopyFile方法

CopyFile方法用来复制文件,将文件从一个文件夹复制到另一个文件夹。其语法为:

oFileSysObj.CopyFile Source,Destination [,OverwriteFiles]

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Source必需,指定要复制的文件的路径和名称,String类型。参数Destination必需,代表复制文件的目标路径和文件名(可选),String类型。参数OverwriteFiles可选,表示是否覆盖一个现有文件的标志,True表示覆盖,False表示不覆盖,Boolean类型,默认值为True。

参数source中源路径可以是绝对路径或相对路径,源文件名可包含通配符但源路径不能。在参数Destination中不能包含通配符。

如果目标路径或文件设置为只读,则无论OverwriteFiles参数的值如何,都将无法完成CopyFile方法。如果参数OverwriteFiles设置为False且Destination指定的文件已经存在,则会产生一个运行时错误“文件已经存在”。如果在复制多个文件时出现错误,CopyFile方法将立即停止复制操作,该方法不具有撤销错误前文件复制操作的返回功能。如果用户有充分的权限,那么source或destination可以是网络路径或共享名,例如:

CopyFile “\\NTSERV1\RootTest\test.txt”,”C:\RootOne”

CopyFile方法可以复制一个保存在特定文件夹中的文件。如果文件夹本身有包含文件的子文件夹,则使用CopyFile方法不能复制这些文件,应该使用CopyFolder方法。

例如:

7CreateTextFile方法

CreateTextFile方法创建一个新的文件并返回其TextStream对象,其语法为:

oFileSysObj.CreateTextFile Filename [,Overwrite[,Unicode]]

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Filename必需,代表任何有效文件名,String类型。在Filename中不允许使用通配符。Filename可以是相对路径也可以是绝对路径,如果没有指定路径,则使用应用程序的当前驱动器或文件夹作为路径。如果指定的路径不存在,则该方法将失败。

参数Overwrite可选,作为一个标志,指定是否覆盖一个具有相同文件名的现有文件,Boolean类型。默认值为False。

参数Unicode可选,作为一个标志,指明用Unicode格式还是ASCⅡ格式写文件,Boolean类型。如果设置为True,则以Unicode格式创建文件,否则创建一个ASCⅡ文本文件。默认值为False。

只有写操作才能使新创建的文本文件自动打开,如果以后希望读取该文件,则必须选关闭它再以读模式重新打开该文件。

如果参数Filename中指定的路径设置为只读,则不论参数Overwrite的值如保,CreateTextFile方法都将失败。

如果用户有充分的权限,那么参数Filename可以是网络路径或共享名,例如:

CreateTextFile “\\NTSERV1\RootTest\myFile.doc”

必须使用Set语句将TextStream对象赋值给局部对象变量。

8MoveFile方法

MoveFile方法用来移动文件,将文件从一个文件夹移动到另一个文件夹。其语法为:

oFileSysObj.MoveFile source,destination

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数source必需,指定要移动的文件的路径,String类型。参数destination必需,指定文件移动操作中的目标位置的路径,String类型。

如果Source包含通配符或者destination以路径分隔符结尾,则认为destination是一个路径,否则认为destination的最后一部分是文件名。

如果目标文件已经存在,则将出现一个错误。

source可以包含通配符,但只能出现在它的最后一部分中。

destination参数不能包含通配符。

source或destination可以是相对路径或绝对路径,可以是网络路径或共享名。

MoveFile方法在开始操作前先解析source和destination这两个参数。

9DeleteFile方法

DeleteFile方法删除指定的一个或多个文件。其语法为:

oFileSysObj.DeleteFile FileSpec[,Force]

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数FileSpec必需,代表要删除的单个文件或多个文件的名称和路径,String类型,可以在路径的最后部分包含通配符,可以为相对路径或绝对路径。如果在FileSpec中只有文件名,则认为该文件在应用程序的当前驱动器和文件夹中。参数Force可选,如果将其设置为True,则忽略文件的只读标志并删除该文件,Boolean类型,默认值为False。

如果指定要删除的文件已经打开,该方法将失败并出现一个“Permission Denied”错误。如果找不到指定的文件,则该方法失败。

如果在删除多个文件的过程中出现错误,DeleteFile方法将立即停止删除操作,即不能删除余下的文件部分。该方法不具有撤销产生错误前文件删除操作的返回功能。

如果用户有充分的权限,源路径或目标路径可以是网络路径或共享名。例如:

DeleteFile “\\NTSERV1\RootTest\MyFile.doc”

DeleteFile方法永久性地删除文件,并不把这些文件移到回收站中。

10DriveExists方法

DriveExists方法用来判断在本地计算机或者网络上是否存在指定的磁盘,若存在则返回True。其语法为:

oFileSysObj.DriveExists (DriveSpec)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数DriveSpec必需,代表路径或驱动器名,String类型。如果DriveSpec是一个Windows驱动器名,则其后面不需要跟冒号,例如“C”和“C:”是一样的。

DriveExists方法不能返回可移动驱动器的当前状态,要实现这一目的,必须使用指定驱动器的IsReady属性。

如果用户有充分的权限,DriveSpec可以是网络路径或共享名,例如:

If ofs.DriveExists(“\\NTESERV1\d$”) Then

在调用位于某驱动器上一个远程ActiveX服务器中的函数前,最好先使用DriveExists方法检测网络上是否存在该驱动器。

11GetDrive方法

GetDrive方法返回Drive对象,即获得对指定驱动器的Drive对象的引用。其语法为:

oFileSysObj.GetDrive (drivespecifier)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数drivespecifier必需,代表驱动器名、共享名或网络路径,String类型。如果drivespecifier是一个共享名或网络路径,GetDrive确认它是Drive对象创建进程的一部分,否则会产生运行时错误“找不到路径”。如果指定的驱动器没有连接上或者不存在,则会出现运行时错误“设备不可用”。

如果要从路径中导出drivespecifier字符串,应该首先用GetAbsolutePathName来确保驱动器是路径的一部分,然后在调用GetDriveName从全限定路径中提取出驱动器之前,用FolderExists方法检验路径是否有效。

如果driverspecifier是一个网络驱动器或共享,在调用GetDrive方法之前,应该用DriveExists方法检验所需的驱动器是否可用。

必须用Set语句将Drive对象赋给局部对象变量。

12GetDriveName方法

GetDriveName方法返回一个包含硬盘名称或者网络共享名称的字符串。即返回给定路径的驱动器名,如果从给定的路径中不能确定驱动器名,则返回一个零长字符串(””)。其语法为:

oFileSysObj.GetDriveName (Path)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Path必需,指定路径,String类型。

GetDriveName不能检验Path中是否存在指定的驱动器。Path可以是网络驱动器或共享。

13GetExtensionName方法

返回给定路径中文件的扩展名。其语法为:

oFileSysObj.GetExtensionName (Path)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Path必需,表示路径说明,String类型。如果不能确定Path中的扩展名,则返回一个零长字符串。

GetExtensionName方法不能检验Path是否有效,Path可以为网络路径或共享。GetExtensionName没有智能功能,它简单地解析一个字符串,并返回Path最后部分中最后一个点后的文本。

14FolderExists方法

FolderExists方法可以判断指定的文件夹是否存在,若存在则返回True。其语法为:

oFileSysObj.FolderExists(FolderSpec)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数FolderSpec指定文件夹的完整路径,String类型,不能包含通配符。

如果用户有充分的权限,FolderSpec可以是网络路径或共享名,例如:

If ofs.FileExists (“\\NTSERV1\d$\TestPath\”) Then XXX

15GetAbsolutePathName方法

将相对路径转变为一个全限定路径(包括驱动器名),返回一个字符串,包含一个给定的路径说明的绝对路径。其语法为:

oFileSysObj.GetAbsolutePathName (Path)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Path必需,代表路径说明,String类型。

“.”返回当前文件夹的驱动器名和完整路径。“..”返回当前文件夹的父文件夹的驱动器名和路径。“filename”返回当前文件夹中的文件的驱动器名、路径及文件名。

所有相对路径名均以当前文件夹为基准。

如果没有明确地提供驱动器作为Path的一部分,就以当前驱动器作为Path参数中的驱动器。在Path中可以包含任意个通配符。

对于映射网络驱动器和共享而言,这种方法不能返回完整的网络地址,而是返回全限定的本地路径和本地驱动器名。

GetAbsolutePathName不能检验指定路径中是否存在某个给定的文件或文件夹。

16GetBaseName方法

返回路径的最后部分的名称,不包含扩展名。其语法为:

oFileSysObj.GetBaseName (Path)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Path必需,代表路径说明,String类型。Path中最后部分的文件扩展名不包含在返回的字符串中。

GetBaseName方法不能检验Path中是否存在给定的文件或文件夹。GetBaseName方法没有舍去文件扩展名并返回Path的基本名称的智能功能。也就是说,它不能识别路径的最后部分是路径还是文件名。如果最后部分包括一个或多个点“.”,它仅仅删除最后一个占以及该点后的文本。所以如果Path为“.”,GetBaseName方法返回一个空字符串;如果Path为“..”,GetBaseName方法返回“.”。换句话说,它只不过是一个字符串处理函数,而不是一个文件函数。

17GetFolder方法

GetFolder方法返回Folder对象。其语法为:

oFileSysObj.GetFolder (FolderPath)

其中,oFileSysObj代表任何能返回FileSystemObject对象的对象变量。参数FolderPath必需,指定所需文件夹的路径,String类型,可以为相对路径或绝对路径。如果FolderPath是共享名或网络路径,GetFolder确认该驱动器或共享是File对象创建进程的一部分。如果FolderPath的任何部分不能连接或不存在,就会产生一个错误。

要获得所需的Path字符串,首先应该使用GetAbsolutePathName方法。如果FolderPath包含一个网络驱动器或共享,可以在调用GetFolder方法之前使用DriveExists方法确认指定的驱动器是否可用。由于GetFolder方法要求FolderPath是一个有效文件夹的路径,所以应调用FolderExists方法来检验FolderPath是否存在。

必须使用Set语句将Folder对象赋给一个局部对象变量。

18GetParentFolderName方法

返回给定路径中最后部分前的文件夹名,其语法为:

oFileSysObj.GetParentFolderName (Path)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Path必需,指定路径说明,String类型。

如果从Path中不能确定父文件夹名,就返回一个零长字符串(””)。Path可以为相对路径或绝对路径。可以是网络驱动器或共享。

GetParentFolderName方法不能检验Path的某个部分是否存在。

GetParentFolderName方法认为Path中不属于驱动器说明的那部分字符串除了最后一部分外余下的字符串就是父文件夹。除此之外它不做任何其他检测,更像是一个字符串解析和处理例程而不是与对象处理有关的例程。

19GetSpecialFolder方法

GetSpecialFolder方法返回操作系统文件夹路径,其中0代表Windows文件夹,1代表System(系统)文件夹,2代表Temp(临时)文件夹。其语法为:

oFileSysObj.GetSpecialFolder (SpecialFolder)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数SpecialFolder必需,为特殊的文件夹常数,表示三种特殊系统文件夹中其中一个的值。

可以使用Set语句将Folder对象赋给一个局部对象变量,但是如果只对检索特殊的文件夹感兴趣,就可以使用下列语句来实现:

sPath=oFileSys.GetSpecialFolder (iFolderConst)

或:

sPath=oFileSys.GetSpecialFolder (iFolderConst).Path

由于Path属性是Folder对象的缺省属性,所认第一个语句有效。因为不是给一个对象变量赋值,所以赋给sPath的值是缺省的Path属性值,而不是对象引用。

20GetTempName方法

返回系统创建的一个临时文件或文件夹名。其语法为:

oFileSysObj.GetTempName

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。

GetTempName方法不能创建临时文件或文件夹,它仅仅提供一个可用于CreateTextFile方法的文件或文件夹名。

一般来说,不必创建自已的临时文件名。Windows在Windows API中提供了一种算法来创建特殊的临时文件或文件夹名,这样Windows才能识别它们。GetTempName很好地包装了GetTempFilename API函数。

21CreateFolder方法

CreateFolder方法用于在指定的路径下创建一个新文件夹,并返回其Folder对象。其语法为:

oFileSysObj.CreateFolder (Path)

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Path必需,为一个返回要创建的新文件夹名的表达式,String类型。Path指定的路径可以是相对路径也可以是绝对路径,如果没有指定路径则使用当前驱动器和目录作为路径。在新的文件夹名中不能使用通配符。

如果参数Path指定的路径为只读,则CreateFolder方法将失败;如果参数Path指定的文件夹已经存在,就会产生运行时错误“文件已经存在”。如果用户有充分的权限,则参数Path可以指定为网络路径或共享名,例如:

CreateFolder “\\NTSERV1\RootTest\newFolder”

在实际使用时,必须使用Set语句将Folder对象赋给对象变量。

22CopyFolder方法

CopyFolder方法用于复制文件夹,即将一个文件夹的内容(包括其子文件夹)复制到其他位置。其语法为:

oFileSysObj.CopyFolder Source,Destination[,OverwriteFiles]

其中,参数oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Source必需,指定要复制的文件夹的路径和文件夹名,String类型,必须使用通配符或者非路径分隔符来结束。参数Destination必需,指定文件夹复制操作的目标文件夹的路径,String类型。参数OverwriteFiles可选,表示是否被覆盖一个现有文件的标志,True表示覆盖,False表示不覆盖,Boolean类型。

通配符只能在参数Source中使用,但是只能放在最后的组件中。在参数Destination中不能使用通配符。

除非不允许使用通配符,否则就可以把源文件夹中的所有子文件夹和文件都复制到Destination指定的文件夹中,也就是说CopyFolder方法是递归的。

如果参数Destination以一个路径分隔符结束或者参数Source以一个通配符结束,CopyFolder方法就认为参数Source中的指定的文件夹存在于参数Destination中,否则就创建这样一个文件夹。

 如果参数Destination指定的目标路径或任意文件被设置成只读属性,则不论OverwriteFiles的值如何,CopyFolder方法者将失效。

如果OverwriterFiles设置为False,而参数Source指定的源文件夹或任何文件存在于参数Destination中,将产生运行时错误“文件已经存在”。

如果在复制多个文件夹时出现错误,CopyFolder方法立即停止复制操作,不再复制余下要复制的文件。该方法不具有撤销产生错误前文件复制操作的返回功能。

如果用户有充分的权限,source或destination都可以是网络路径或共享名,例如:

CopyFolder “C:\Rootone”,”\\NTSERV1\d$\RootTwo\”

23MoveFolder方法

MoveFolder方法用来移动文件夹,将文件夹及其文件和子文件夹一起从某个位置移动到另一个位置。其语法为:

oFileSysObj.MoveFolder source,destination

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数Source指定要移动的文件夹的路径,String类型。参数destination指定文件夹移动操作中目标位置的路径,String类型。

Source必须以通配符或非路径分隔符结束,可以使用通配符,但必须出现在最后一部分中。destination不能使用通配符。除非不允许使用通配符,否则源文件夹中所有的子文件夹和文件都被复制到destination指定的位置,也就是说MoveFolder方法是递归的。

如果destination用路径分隔符结束或者source用通配符结束,MoveFolder就认为source中指定的文件夹存在于destination中。

Source和destination可以为绝对路径或相对路径,可以为网络路径或共享名。

MoveFile方法在开始操作前先解析source和destination这两个参数。

24DeleteFolder方法

DeleteFolder方法用于删除指定的文件夹及其所有的文件和子文件夹。其语法为:

oFileSysObj.DeleteFolder FileSpec[,Force]

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数FileSpec必需,指定要删除的文件夹的名称和路径,String类型。在参数FileSpec中,可以在路径的最后部分包含通配符,但不能用路径分隔符结束,可以为相对路径或绝对路径。

参数Force可选,Boolean类型,如果设置为True,将忽略文件的只读标志并删除这个文件。默认为False。如果参数Force设置为False并且文件夹中的任意一个文件为只读,则该方法将失败。如果找不到指定的文件夹,则该方法失败。

如果指定的文件夹中有文件已经打开,则不能完成删除操作,且产生一个“Permisson Denied”错误。DeleteFolder方法删除指定文件夹中的所有内容,包括其他文件夹及其内容。

如果在删除多个文件或文件夹时出现错误,DeleteFolder方法将立即停止删除操作,即不能删除余下的文件夹或文件。该方法不具有撤销产生错误前文件夹删除操作的返回功能。

DeleteFolder方法永久性删除文件夹,并不把它们移到回收站中。

如果用户有充分的权限,源路径和目标路径可以是网络路径或共享名,例如:

DeleteFolder “\\RootTest”

25OpenTextFile方法

OpenTextFile方法用于打开(或创建)文本文件以进行读取或写入操作,返回一个TextStream对象。其语法为:

oFileSysObj.OpenTextFile (FileName[,IOMode[,Create[,Format]]])

其中,oFileSysObj代表任何能够返回FileSystemObject对象的对象变量。参数FileName必需,指定要打开的文件的路径和文件名,String类型,FileName的路径部分可为相对路径或绝对路径。参数IOMode可选,指定文件打开模式的一个常数(参见前文的表格),默认设置为ForReading(1)。参数Create可选,一个Boolean型标志,说明如果在给定的路径中找不到文件,是否应该创建该文件。参数Format可选,一个Tristate常数(参见前文的表格),指定打开文件的格式为ASCⅡ或Unicode格式,默认设置为ASCⅡ(False)。

如果另一个进程已经打开了指定文件,该方法将失败,并产生一个“Permission Denied”错误。

要保证OpenTextFile方法成功执行,可以在调用它之前使用GetAbsolutePath和FileExists方法。

IOMode的值只能是一个常量值,例如,下面的方法调用:

lMode=ForReading or ForWritingoFileSys.OpenTextStream(strFileName,lMode) ‘错误

将产生运行时错误“无效的过程调用或参数”。

如果用户有充分的权限,FileName的路径部分可以是网络路径或共享名,例如:

OpenTextFile “\\NTSERV1\d$\RootTwo\myFile.txt”

(二)Drive对象

上面已经提到Drive对象是用来获取当前系统中各个驱动器的信息的。由于Drive对象没有方法,其应用都是通过属性表现出来的,所以我们必须熟悉Drive对象的属性:

AvailableSpace:返回在指定的驱动器或网络共享上的用户可用的空间容量。

DriveLetter :返回某个指定本地驱动器或网络驱动器的字母,这个属性是只读的。

DriveType:返回指定驱动器的磁盘类型。

FileSystem: 返回指定驱动器使用的文件系统类型。

FreeSpace:返回指定驱动器上或共享驱动器可用的磁盘空间,这个属性是只读的。

IsReady:确定指定的驱动器是否准备好。

Path :返回指定文件、文件夹、或驱动器的路径。

RootFolder :返回一个 Folder 对象,该对象表示一个指定驱动器的根文件夹。只读属性。

SerialNumber:返回用于唯一标识磁盘卷标的十进制序列号。

ShareName:返回指定驱动器的网络共享名

TotalSize :以字节为单位,返回驱动器或网络共享的总空间大小。

VolumeName :设置或返回指定驱动器的卷标名。

从上面的属性可以看到Drive对象基本上包含了日常操作所需的全部的驱动器信息,因此在使用中是非常方便的。

(三)Folder对象

在FSO 对象模型中,提供了丰富的有关文件夹操作的方法,这些方法分别是:

FileSystemObject对象中有关文件夹的方法:

CreateFolder :创建一个文件夹 。

DeleteFolder:删除一个文件夹 。

MoveFolder :移动一个文件夹 。

CopyFolder:复制一个文件夹 。

FolderExists: 查找一个文件夹是否在驱动器上 。

GetFolder :获得已有Folder对象的一个实例 。

GetParentFolderName: 找出一个文件夹的父文件夹的名称。

GetSpecialFolder: 找出系统文件夹的路径。

Folder对象的方法:

Delete :创建一个文件夹 。

Move :移动一个文件夹 。

Copy:复制一个文件夹。

Name:检索文件夹的名称。

在此需要强调一点,前面我们曾经提到过FSO对象模型包含的方法是冗余的,所以Folder对象的Delete、Move、Copy方法和FileSystemObject对象的DeleteFolder、MoveFolder、CopyFolder方法实际上是相同的,因此在实际使用中可以任选其中的一种。

(四)File对象和TextStream对象

由于有关File对象的复制,删除,移动等操作和Folder对象类似,所以这部分内容就不再重复。这里主要讲述利用File对象和TextStream对象操作文本文件。

通常对文本文件的操作包括在文本文件中创建数据,在文本文件中添加数据,删除文本文件的数据等操作。这些操作都可以通过File对象和FileSystemObject对象的相关方法完成。不过在使用之前,首先要创建一个文本文件,当然可以通过使用FileSystemObject对象的 CreateTextFile 方法来完成。

Word 函数系列之一

Public Sub ReplaceWord(ByVal vWord As Variant, ByVal sOld As String, ByVal sNew As String)
Const wdReplaceAll = 2
Const wdFindStop = 0
Dim oRange As Object
Set oRange = vWord.Selection.Range
‘先判断是否有选中区域,没有选中则表示整个文档
If oRange.Start = oRange.End Then
Set oRange = vWord.ActiveDocument.Content
End If
With oRange.Find
‘批量查找替换 sOld 为 sNew
bRet = .Execute(FindText:=sOld, replacewith:=sNew, Replace:=wdReplaceAll)
‘Debug.Print bRet
‘Debug.Print oRange.Words.Count
End With
End Sub

Public Sub InsPageNumber(ByVal vWord As Variant) ‘其实是 vDocument
On Error GoTo ERR_PAGENUMBER
‘设置Word文档第一页页码
Dim oRange As Object
Set oRange = vWord.ActiveDocument.Sections(1).Footers(1).Range ‘wdHeaderFooterPrimary = 1
With oRange
.InsertAfter “第”
‘.Font.Size = 14
.Collapse Direction:=0 ‘wdCollapseEnd = 0
‘插入页码域
.Fields.Add Range:=oRange, Type:=-1, Text:=”PAGE * Arabic “, PreserveFormatting:=True ‘wdFieldEmpty = -1
.Expand Unit:=2 ‘wdWord = 2
.InsertAfter “页”
.InsertAfter “共”
.Collapse Direction:=0 ‘wdCollapseEnd = 0
‘插入页数域
.Fields.Add Range:=oRange, Type:=-1, Text:=”NUMPAGES * Arabic “, PreserveFormatting:=True ‘wdFieldEmpty = -1
.Expand Unit:=2 ‘wdWord = 2
.InsertAfter “页”
‘.InsertAfter “YagerSoft”
.ParagraphFormat.Alignment = 2 ‘wdAlignParagraphRight = 2 ‘右对齐
End With
‘隐藏页眉的横线
vWord.ActiveDocument.Sections(1).Headers(1).Range.Borders(-3).Visible = False ‘wdBorderBottom = -3
‘取得页眉的内容
‘Debug.Print vWord.ActiveDocument.Sections(1).Headers(2).Range.Text ‘wdHeaderFooterFirstPage = 2
Set oRange = Nothing
On Error GoTo 0
Exit Sub
ERR_PAGENUMBER:
On Error GoTo 0
End Sub

Public Sub InsPageBreak(ByVal vWord As Variant)
On Error GoTo ERR_BREAK
‘wdPropertyTitle = 1标题
‘wdPropertySubject = 2主题
‘wdPropertyAuthor = 3作者
‘wdPropertyKeywords = 4关键词
‘wdPropertyComments = 5批注
‘wdPropertyTemplate = 6模板
‘wdPropertyLastAuthor = 7上一个作者
‘wdPropertyRevision = 8修订次数
‘wdPropertyAppName = 9应用程序名
‘wdPropertyTimeLastPrinted = 10上次打印时间
‘wdPropertyTimeCreated = 11创建时间
‘wdPropertyTimeLastSaved = 12上次保存时间
‘wdPropertyVBATotalEdit = 13编辑时间总计
‘wdPropertyPages = 14页数
‘wdPropertyWords = 15字数
‘wdPropertyCharacters = 16字符数
‘wdPropertySecurity = 17安全性
‘wdPropertyCategory = 18类别
‘wdPropertyFormat = 19
‘wdPropertyManager = 20经理
‘wdPropertyCompany = 21公司
‘wdPropertyBytes = 22字节数
‘wdPropertyLines = 23行数
‘wdPropertyParas = 24段数(空白文档 BuiltInDocumentProperties(wdPropertyParas) = 0,而 vWord.ActiveDocument.Paragraphs.Count = 1)
‘wdPropertySlides = 25
‘wdPropertyNotes = 26注释
‘wdPropertyHiddenSlides = 27
‘wdPropertyMMClips = 28
‘wdPropertyHyperlinkBase = 29
‘wdPropertyCharsWSpaces = 30字符数(计空格)
If vWord.ActiveDocument.BuiltInDocumentProperties(15) = 0 Then Exit Sub ‘wdPropertyWords = 15
vWord.Selection.EndKey Unit:=6 ‘wdStory = 6 ‘将光标移到最后
vWord.Selection.InsertBreak Type:=7 ‘wdPageBreak = 7 ‘插入分页符
On Error GoTo 0
Exit Sub
ERR_BREAK:
On Error GoTo 0
End Sub

Public Function FindWord(ByVal vWord As Variant, ByVal sData As String) As Boolean
Dim oSelection As Object
Set oSelection = vWord.ActiveDocument.Content
‘利用FIND查找 sData ,从光标之处开始查找,查找到后选中。
With oSelection.Find
‘查找的方向向下
.Forward = True
‘取消在查找或替换操作中所指定文本的文本格式和段落格式
.ClearFormatting
‘查找操作查找仅完整单词,而不是较长单词的一部分的文本
.MatchWholeWord = True
‘查找时不区分大小写
.MatchCase = False
‘到达文档末尾时,继续从文档开头进行搜索
.Wrap = 1 ‘wdFindContinue
‘运行指定的查找操作。如果查找成功,则返回 True
.Execute FindText:=sData
End With
FindWord = oSelection.Find.Execute
End Function

Public Function GetTextSite(ByVal vWord As Variant, ByVal sText As String) As Integer ‘返回 sText 在 vWord 中首次出现的段号
‘耗时过长不宜用
Dim I As Integer, J As Integer
GetTextSite = 0
If vWord Is Nothing Then Exit Function
If vWord.Documents.Count = 0 Then Exit Function
If sText = “” Then Exit Function
For I = 1 To vWord.ActiveDocument.Paragraphs.Count
DoEvents
‘If vWord.ActiveDocument.Paragraphs(I).Range.Text = sText Then
If InStr(1, vWord.ActiveDocument.Paragraphs(I).Range.Text, sText, vbTextCompare) > 0 Then
GetTextSite = I
Exit For
End If
Next I
End Function

字符串函数系列之二

Public Function ReplaceMultiChar(ByVal sData As String, ByVal sChar As String) As String ‘用单字符替换连续字符
sData = Trim(sData)
Dim iBefore, iAfter As Integer
Do
iBefore = Len(sData)
sData = Replace(sData, sChar & sChar, sChar)
iAfter = Len(sData)
Loop Until iBefore = iAfter
ReplaceMultiChar = sData
End Function

Public Function GetExtension(ByVal sName As String) As String ‘扩展名
GetExtension = “”
If InStr(1, sName, “.”, vbTextCompare) = 0 Then Exit Function
Dim TempArray As Variant
TempArray = Split(sName, “.”, -1, vbTextCompare) ‘名字可能会含 .
GetExtension = TempArray(UBound(TempArray)) ‘扩展名
End Function

Public Function GetBare(ByVal sName As String) As String ‘不带扩展名的名
GetBare = “”
If InStr(1, sName, “.”, vbTextCompare) = 0 Then Exit Function
Dim TempArray As Variant
TempArray = Split(sName, “.”, -1, vbTextCompare) ‘名字可能会含 .
ReDim Preserve TempArray(LBound(TempArray) To UBound(TempArray) – 1) ‘去扩展名
GetBare = Join(TempArray, “.”)
End Function

Public Function GetFullName(ByVal sPath As String, ByVal sShortName As String) As String ‘文件全名
‘If Right(sPath, 1) = “\” Then
‘GetFullName = sPath & sShortName
‘Else
‘GetFullName = sPath & “\” & sShortName
‘End If
‘下句等同以上内容
GetFullName = IIf(Right(sPath, 1) = “\” Or Left(sShortName, 1) = “\”, sPath & sShortName, sPath & “\” & sShortName)
GetFullName = ReplaceMultiChar(GetFullName, “\”)
End Function

Public Function GetShortName(ByVal sFullName As String) As String ‘文件短名
If sFullName = “” Then
GetShortName = “”
Else
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
GetShortName = TempArray(UBound(TempArray))
End If
End Function

Public Function GetPath(ByVal sFullName As String) As String ‘文件路径
‘Dim I As Integer
‘For I = Len(sFullName) To 1 Step -1
‘If Mid(sFullName, I, 1) = “\” Then
‘GetPath = Left(sFullName, I – 1)
‘Exit Function
‘End If
‘Next I
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
If LBound(TempArray) = UBound(TempArray) Then ‘短名
GetPath = “”
Else
ReDim Preserve TempArray(LBound(TempArray) To UBound(TempArray) – 1) As String
GetPath = Join(TempArray, “\”)
End If
End Function

Public Function GetShortPath(ByVal sFullName As String) As String ‘文件当前文件夹
Dim TempArray As Variant
TempArray = Split(sFullName, “\”, -1, vbTextCompare)
GetShortPath = TempArray(UBound(TempArray) – 1)
End Function

Public Function DirExist(ByVal sData As String) As Boolean ‘(全名)目录存在
DirExist = False
If Trim(sData) = “” Then Exit Function ‘Dir(“”) 出错, 且无声无息
If Dir(sData, vbDirectory) = “” Then Exit Function ‘不存在
If Not (GetAttr(sData) And vbDirectory) = vbDirectory Then Exit Function ‘是文件
DirExist = True
End Function

Public Function FileExist(ByVal sData As String) As Boolean ‘(全名)文件存在
FileExist = False
If Trim(sData) = “” Then Exit Function ‘Dir(“”) 出错, 且无声无息
If Dir(sData) = “” Then Exit Function ‘不存在
If (GetAttr(sData) And vbDirectory) = vbDirectory Then Exit Function ‘是目录
FileExist = True
End Function