Visual Basic 技巧库
第 9 部分 (81-90)
取得计算机名 取得计算机名 声明: Declare Function GetComputerName
Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As
Long) As Long 例子: Public Function MachineName() As String Dim sBuffer
As String * 255 If GetComputerName(sBuffer, 255&) <> 0
Then MachineName = Left$(sBuffer, InStr(sBuffer, vbNullChar) -
1 Else MachineName = "(未知)" End If End Function
取得控件绝对Top值 Public Function AbsoluteTop(ctlContl As
Control) As Single Dim wrkContl As Control Dim wrkTopPos As Single
' On Error GoTo AbsoluteTopError ' 初始 Set wrkContl =
ctlContl wrkTopPos = 0 ' 循环 Do If (wrkContl.Container.Name =
ctlContl.Parent.Name) Then Exit Do wrkTopPos = wrkTopPos + wrkContl.Top '
计算位置 Set wrkContl = wrkContl.Container ' 下个控件 Loop
AbsoluteTop = wrkTopPos + ctlContl.Parent.Top Exit
Function ' AbsoluteTopError: AbsoluteTop = ctlContl.Top +
ctlContl.Parent.Top Exit Function End Function
取得临时文件名 取得临时文件名 98-6-30 声明: Public Const MAX_PATH =
260
Public Declare Function GetTempFileName Lib "kernel32" Alias
"GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String,
ByVal wUnique As Long, ByVal lpTempFileName As String) As Long Public Declare
Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As
Long, ByVal lpBuffer As String) As Long
代码: Public Function GetTempFile() As String Dim lngRet As
Long Dim strBuffer As String, strTempPath As String
'初始化 buffer strBuffer = String$(MAX_PATH, 0)
'取得临时路径 lngRet = GetTempPath(Len(strBuffer), strBuffer)
'0 错误 If lngRet = 0 Then Exit Function
'去掉尾中的 null strTempPath = Left$(strBuffer, lngRet)
'初始化 buffer strBuffer = String$(MAX_PATH, 0)
'取得临时文件名 lngRet = GetTempFileName(strTempPath, "tmp", 0&,
strBuffer)
If lngRet = 0 Then Exit Function
lngRet = InStr(1, strBuffer, Chr(0)) If lngRet > 0
Then GetTempFile = Left$(strBuffer, lngRet - 1) Else GetTempFile =
strBuffer End If End Function
取得文件的扩展名 取得文件的扩展名 98-6-06 Function
GetExtension(Filename As String) Dim PthPos, ExtPos As Integer
For i = Len(Filename) To 1 Step -1 ' Go from the Length of the filename,
to the first character by 1. If Mid(Filename, i, 1) = "." Then ' If the
current position is '.' then... ExtPos = i ' ...Change the ExtPos to the
number. For j = Len(Filename) To 1 Step -1 ' Do the Same... If
Mid(Filename, j, 1) = "\" Then ' ...but for '\'. PthPos = j ' Change the
PthPos to the number. Exit For ' Since we found it, don't search any
more. End If Next j Exit For ' Since we found it, don't search any
more. End If Next i
If PthPos > ExtPos Then Exit Function ' No extension. Else If
ExtPos = 0 Then Exit Function ' If there is not extension, then exit
sub. GetExtension = Mid(Filename, ExtPos + 1, Len(Filename) - ExtPos)
'Messagebox the Extension End If
End Function 使用: FileExt = GetExtension("c:\windows\vb\vb.exe")
取得下个自动生成的
ID 取得下个自动生成的 ID 98-8-20 在许多数据库里我们使用了自动增加的 ID, 能取得下个自动产生的 ID,
意味着在数据增加后, 不再需要使用 LastModified 属性和 bookmarks。 With
Data1.Recordset .AddNew MsgBox !ID
'下个自动生成的 ID .CancelUpdate End With
取得应用所在的目录 取得应用所在的目录 98-7-04 使用 App.Path
可以得到应用所在的目录。不过得注意,当在根目录下时,Path 的返回值最右字符为 “\” ,如“c:\”,而如果不在根目录,则最右字符非
“\”,如“c:\vb5”。所以在使用 Path 做连接时,应使用以下的代码:
Dim FileName as string Dim fullpath As String If Right(App.Path, 1)
= "\" Then fullpath = App.Path + FileName Else fullpath = App.Path +
"\" + FileName End If 或者: pth$ = app.Path & IIf(Len(app.Path) >
3, "\", "")
缺省值和可选参数 缺省值和可选参数 VB5 加强了函数参数方面,可用以下的代码实现参数缺省:
Property Get Value(Optional index As Long = 1) ... End
Property 也可使用另一个方法(慢):
Property Get Value(Optional index As Long) If IsMissing(index) Then
index = 1 ... End Property
确定 TextBox
有几行 确定 TextBox 有几行 98-8-11 声明: Public Declare Function
SendMessageLong Lib _ "user32" Alias "SendMessageA" (ByVal hwnd As Long, _ ByVal
wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As
Long Public Const EM_GETLINECOUNT = &HBA 使用: lineCount =
SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
确定当前系统启动状态 008 确定当前 WIN95 的启动状态
98-8-11 定义: Public Declare Function GetSystemMetrics Lib "user32"
(ByVal nIndex As Long) As Long Public Const SM_CLEANBOOT = 67
使用: Select Case GetSystemMetrics(SM_CLEANBOOT) Case 1: MsgBox
"在安全模式。" Case 2: MsgBox "在带网络环境的安全模式。" Case Else:
MsgBox "正常模式。" End Select
确定是 WINDOWS
的可执行文件 确定是 WINDOWS 的可执行文件 98-6-17 在文件的第 24 字节,如果为40h,就是 Windows
的可执行文件。
Function WinExe (ByVal Exe As String) As Integer Dim fh As
Integer Dim t As String * 1 fh = FreeFile Open Exe For Binary As
#fh Get fh, 25, t Close #fh WinExe = (Asc(t) = &H40&) End
Function
|