VB常用函数

ＶＢ简单易学，如果有更多函数可以调用，会让ＶＢ使用起来更加方便．作者收集和自创了一些好用的函数在这里和大家交流一下。

一：很多运算要求输入必须是数字，否则运行程序就会出错，以下是判断字节是否为数字的函数。

Function CheckData(ByVal mydata) As Boolean

For I = 1 To Len(mydata)

If Asc(Mid(mydata, I, 1)) < 48 Or Asc(Mid(mydata, I, 1)) > 57 Then

CheckData = False

Exit For

End If

CheckData = True

Next I

End Function

二：网页下载的中文有多种编码，比如UTF-8、GB2312等等,用以下函数默认读取UTF-8，但是可以通过ReadFile(路径＋文件名, "GB2312")方式读取其它编码的文件。

Public Function ReadFile(ByVal FileName As String, Optional Codify As String = "UTF-8") As String

Dim objStream As Object

Set objStream = CreateObject("ADODB.Stream")

With objStream

.Type = 2

.Mode = 3

.Open

.Charset = Codify '不同编码可以换

.LoadFromFile FileName

ReadFile = .ReadText

.Close

End With

End Function

三：VB经常需要运行外部命令和程序，但是这些程序是否已经运行完毕VB 不好判断，以下函数利用API和SHELL 命令函数判断运行的外部命令和程序是否运行完毕。

1.先在Form1中声明OpenProcess和CloseHandle 这两个Windows API 函数

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal

bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

2.然后编写下面的函数:

Function IsRunning(ByVal ProgramID) As Boolean ' 传入进程标识ID

Dim hProgram As Long '被检测的程序进程句柄

hProgram = OpenProcess(0, False, ProgramID)

If Not hProgram = 0 Then

IsRunning = True

Else

IsRunning = False

End If

CloseHandle hProgram

End Function

3.在Form_Click()中加入代码：

Sub Form_Click()

Dim X

Me.Caption = "开始运行"

X = Shell("NotePad.EXE", 1)

While IsRunning(X)

DoEvents

Wend

Me.Caption = "结束运行"

End Sub

四：当初写这段代码是用于转化COOKIES 用的，因为COOKIES 内含有很多非正常的字符，怀疑在赋值的过程中改变了。所以先转成ASCII 码保存，用的时候在转化回来。

１.将字符转化成ASCII数组形式。

Public Function allasc(ByVal s As String) As Variant

Dim xx() As Long

ReDim xx(1 To Len(s)) As Long

For i = 1 To Len(s)

xx(i) = Asc(Mid(s, i, 1))

Next i

allasc = xx

End Function

２.将ASCII转化回字符形式。

Public Function allchr(ByVal c As Variant) As String

Dim yy As String

allchr = chr(c(1))

For i = 2 To UBound(c)

allchr = allchr & Chr(c(i))

Next i

End Function

五：获得本机计算机名、用户名、IP地址

Private Sub Command1_Click()

Dim aa As String

Dim strLocalIP As String

Dim winIP As Object

aa = aa & "本机电脑名称:" & Environ("computername") & vbCrLf

aa = aa & "本机用户名称:" & Environ("username") & vbCrLf

Set winIP = CreateObject("MSWinsock.Winsock")

strLocalIP = winIP.localip

MsgBox aa & "本机IP:" & strLocalIP

End Sub

六：取得CPU序列号

Private Type OSVERSIONINFO

dwOSVersionInfoSize As Long

dwMajorVersion As Long

dwMinorVersion As Long

dwBuildNumber As Long

dwPlatformId As Long

szCSDVersion As String * 128 ' Maintenance string for PSS usage

End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Const VER_PLATFORM_WIN32_NT = 2

Private Const VER_PLATFORM_WIN32_WINDOWS = 1

Private Const VER_PLATFORM_WIN32s = 0

Private Sub Command1_Click()

Dim len5 As Long, aa As Long

Dim cmprName As String

Dim osver As OSVERSIONINFO

'取得Computer Name

cmprName = String(255, 0)

len5 = 256

aa = GetComputerName(cmprName, len5)

cmprName = Left(cmprName, InStr(1, cmprName, Chr(0)) - 1)

Computer = cmprName '取得CPU端口号

Set CPUs = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_Processor")

For Each mycpu In CPUs

Text1.Text = mycpu.ProcessorId