您的位置:寻梦网首页编程乐园VB 编程乐园VB 技巧库
Visual Basic 技巧库
第 9 部分 (81-90)
(1-10) (11-20) (21-30) (31-40) (41-50) (51-60) (61-70) (71-80) (81-90) (91-100) (101-110) (111-120) (121-131)
(81) 取得计算机名
(82) 取得控件绝对Top值
(83) 取得临时文件名
(84) 取得文件的扩展名
(85) 取得下个自动生成的 ID
(86) 取得应用所在的目录
(87) 缺省值和可选参数
(88) 确定 TextBox 有几行
(89) 确定当前系统启动状态
(90) 确定是 WINDOWS 的可执行文件


取得计算机名
取得计算机名
声明:
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