BlackFeather'S Blog

PowerBasic是BASIC语言的一种编译器，编译出来的EXE或者DLL结构非常紧凑，执行速度跟C不相上下。编译出来的DLL也是标准DLL，不需要像VB那样拖着一个笨重的库文件。通常PowerBASIC 编译的代码在性能上比VB 编译的代码好3到23 倍， 产生的可执行文件比VB生成的可执行文件小4 到40 倍。我的很多很多工程里用的DLL都是由这个编译的。至于语法，和VB基本一致，所以上手很容易。最爽的是powerbasic里面有指针，变量指针还是函数指针都可以只用，所以能很容易的从C的代码翻译成powerbasic可编译的代码。

这里我贴出来一下powerbasic里面常用的函数，方便大家写代码（我下的时候就是一个本文，我也没有整理，直接贴出来吧，大家用哪个函数就复制哪个Function吧。。。）：

Type PROCESSENTRY32
    dwSize   As Long
    cntUsage   As Long
    th32ProcessID   As Long
    th32DefaultHeapID   As Long
    th32ModuleID   As Long
    cntThreads   As Long
    th32ParentProcessID   As Long
    pcPriClassBase   As Long
    dwFlags   As Long
    szExeFile   As String * 260
End Type

Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Declare Function Process32First Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Declare Function Process32Next Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

'#If Not %Def(%WINAPI)

 Declare Function Read_File(ByVal FileName As String) As String   '读入一个文本文件

 Declare Function Write_File(ByVal SaveFile As String ,ByVal Str As String) As Long   '写入一个文本文件

 Declare Function ComputerName() As String   '获取计算机名称

 Declare Function AppPath As String      '取执行文件自身运行目录的函数

 Declare Function AppExe As String      '取执行文件自身名称

 Declare Function GetWindowClass(ByVal Hwnd As Long) As String      '获取窗口类名

 Declare Function GetWindowName(ByVal Hwnd As Long) As String      '获取窗口名称

 Declare Function GetIniStr(ByVal IniFileName As String, ByVal SectionName As String, ByVal KeyWord As String) As String     '读取INI配置项函数

 Declare Function SetIniStr(ByVal IniFileName As String, ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String) As Long       '设置INI配置项函数

 Declare Function MkDirs(ByVal PathIn As String) As Long     '建立多级目录

 Declare Function GetActive(ByVal ClassName As String,ByVal Title As String) As Long         '等到指定窗体是否为活动窗体

 Declare Function FileExists(ByVal FileName As String) As Long       '判断文件是否存在

 Declare Function GetMemText(ByVal hProcess As Long, ByVal laddress As Long) As String       '获取某内存地址内容

 Declare Function UpdateProcessPrivilege(ByVal hProcess As Long,ByVal lpPrivilegeName As String) As Long     '进程权限提升

 Declare Function GetProcId(ByVal TTitle As String,ByVal TClass As String) As Long       '获取进程PID

 Declare Function DoFirstSearch(ByVal myHandle As Long, s As String,ByVal lName As String) As Long       '内存搜索模块

 Declare Function SmtpSendMail(ByVal SmtpHost As String, ByVal EmailFrom As String, ByVal EmailUser As String, ByVal EmailPass As String, ByVal EmailTo As String, ByVal Subject As String, Message As String) As Long   '邮件发送

 Declare Function DllInject( DLLFile As String ,  Pid As Long) As Long       'DLL注入函数

 Declare Function CheckWebFile(ByVal Str As String,ByVal FileName As String) As Long    '验证某个网页

 Declare Function SetTime(ByVal nIDEvent As Long , ByVal uElapse As Long , ByVal lpTimerFunc As Long) As Long        '时间控制器

 Declare Function ScanProcess(ByVal ProcessName As String) As Long   '获取某进程的PID

 Declare Function Encode_BASE64(InBuf As String, ByVal nGroups As Long, OutBuf As String) As Long        'BASE64加密函数

 Declare Function Decode_Base64(ByVal InBuf As Dword, OutBuf As String) As Long      'BASE64解密函数

 '''''''''''''''''''''''''''''''''''''''''读入一个文本文件'''''''''''''''''''''''''''''''''''''''''''''''''
 Function Read_File(ByVal FileName As String) As String         '读入一个文本文件
  Dim sA As String
  Open FileName For Binary As #1
  sA = Space$(Lof(1)) '用空格填充sA变量
  Get #1, , sA '用Get语句获取文件全部内容
  Close #1
  Function = sA
 End Function

 '''''''''''''''''''''''''''''''''''''''''写入一个文本文件'''''''''''''''''''''''''''''''''''''''''''''''''
 Function Write_File(ByVal SaveFile As String ,ByVal Str As String) As Long       '写入一个文本文件
  Open SaveFile For Output As #1 ' 打开输出文件。
  Print #1,str
  Close #1
 End Function

 '''''''''''''''''''''''''''''''''''''''''获取计算机名称'''''''''''''''''''''''''''''''''''''''''''''''''
 Function ComputerName() As String
  %MAX_COMPUTERNAME_LENGTH = 15
  Dim RetCode     As Long
  Dim lpBuffer    As Asciiz * %MAX_COMPUTERNAME_LENGTH + 1
  Dim nSize       As Long
  nSize = %MAX_COMPUTERNAME_LENGTH + 1
  RetCode = GetComputerName(lpBuffer,nSize)
  Function = Trim$(lpBuffer)
 End Function

 '''''''''''''''''''''''''''''''''''''''取执行文件自身运行目录的函数'''''''''''''''''''''''''''''''''''''''
 Function AppPath As String
  Dim CmdLine As Asciiz Ptr
  'Dim AppExe      As String
  Dim i           As Integer
  Dim Temp        As String
  CmdLine = GetCommandLine()
  Temp = Parse$(@CmdLine , 1)
  For i% = Len(Temp) To 1 Step -1
   If Right$(Mid$(Temp, 1, i%), 1) = "\" Then Exit For
  Next i%
  AppPath = Mid$(Temp, 1, i%)
  'AppExe  = Mid$(Temp, i% + 1)
 End Function

 '''''''''''''''''''''''''''''''''''''''取执行文件自身运行文件的函数'''''''''''''''''''''''''''''''''''''''
 Function AppExe As String
  Dim CmdLine As Asciiz Ptr
  'Dim AppExe      As String
  Dim i           As Integer
  Dim Temp        As String
  CmdLine = GetCommandLine()
  Temp = Parse$(@CmdLine , 1)
  For i% = Len(Temp) To 1 Step -1
   If Right$(Mid$(Temp, 1, i%), 1) = "\" Then Exit For
  Next i%
  'AppPath = Mid$(Temp, 1, i%)
  AppExe  = Mid$(Temp, i% + 1)
 End Function

 ''''''''''''''''''''''''''''''''''''''''''''''''''获取窗口类名'''''''''''''''''''''''''''''''''''''''''''''''''
 Function GetWindowClass(ByVal Hwnd As Long) As String      '获取窗口类名
  Dim MaxText As String
  Maxtext=Space$(255)
  GetClassName(Hwnd,ByVal StrPtr(Maxtext),Len(Maxtext)+1)
  Function = Maxtext
 End Function

 ''''''''''''''''''''''''''''''''''''''''''''获取窗口名称''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function GetWindowName(ByVal Hwnd As Long) As String      '获取窗口名称
  Dim MaxText As String
  Maxtext=Space$(255)
  GetWindowText(Hwnd,ByVal StrPtr(Maxtext),Len(Maxtext)+1)
  Function = Maxtext
 End Function

 '返回指定路径，指定小节，指定关键字的值(字串)
 ''''''''''''''''''''''''''''''''''''''''''''读取INI配置项函数'''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function GetIniStr(ByVal IniFileName As String, _
        ByVal SectionName As String, _
        ByVal KeyWord As String) As String
  Dim ResultString As String
  ResultString=Space$(144)
  Dim Temp As Integer
  Dim s As String
  Dim i  As Integer
  Temp = GetPrivateProfileString(ByVal StrPtr(SectionName), _
            ByVal StrPtr(KeyWord), "", _
            ByVal StrPtr(ResultString), 144, _
            ByVal StrPtr(IniFileName))'    检索关键词的值
  If Temp > 0 Then '关键词的值不为空
   s = ""
   For i = 1 To 144
    If Asc(Mid$(ResultString, i, 1)) = 0 Then
     Exit For
    Else
     s = s & Mid$(ResultString, i, 1)
    End If
   Next
  Else
   s = ""
  End If
  Function = Trim$(s)
 End Function

 '设置指定路径，指定小节，指定关键字的值(字串)
 ''''''''''''''''''''''''''''''''''''''''''''设置INI配置项函数'''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function SetIniStr(ByVal IniFileName As String, _
        ByVal SectionName As String, _
        ByVal KeyWord As String, _
        ByVal ValStr As String) As Long
  Function = WritePrivateProfileString(ByVal StrPtr(SectionName), _
            ByVal StrPtr(KeyWord), _
            ByVal StrPtr(ValStr), _
            ByVal StrPtr(IniFileName))
 End Function

 '''''''''''''''''''''''''''''''''''''''''''建立多级目录的函数'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function MkDirs(ByVal PathIn As String) As Long
  Dim nPos As Long
  MkDirs = 0 '先假设成功
  If Right$(PathIn, 1) <> "\" Then PathIn = PathIn + "\"
  nPos = InStr(1, PathIn, "\")
  Do While nPos > 0
   If Dir$(Left$(PathIn, nPos), 16) = "" Then
    On Error GoTo Failed_
    MkDir Left$(PathIn, nPos)
    On Error GoTo 0
   End If
    nPos = InStr(nPos + 1, PathIn, "\")
  Loop
   Exit Function
 Failed_:
  MkDirs = -1
 End Function

 ''''''''''''''''''''''''''''''''''''''''''判断文件是否存在'''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function FileExists(ByVal FileName As String) As Long
  Dim f%
    'On Error Resume Next
    f% = FreeFile
    Open FileName For Input As #f%
    Close #f%
    FileExists% = (Err <> 0)
 End Function

 '''''''''''''''''''''''''''''''''''''''''等到指定窗体是否为活动窗体''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 Function GetActive(ByVal ClassName As String,ByVal Title As String) As Long         '等到指定窗体是否为活动窗体
  Dim GetAW As Long
  GetAW=GetActiveWindow()
  If GetWindowClass(GetAW)=ClassName And GetWindowName(GetAW)=Title Then
     Function = GetAW
    Else
     Function = 0
  End If
 End Function

 '''''''''''''''''''''''''''''''''''''''内存读取文本'''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function GetMemText(ByVal hProcess As Long, ByVal laddress As Long) As String
  Dim Msg(0 To 256) As Byte '* 256
  Dim Dst As String
  Local i As Integer
  ReadProcessMemory(hProcess,laddress,Msg(0),256,0&)
  For i = 0 To 256
   If msg(i) <> 0 Then
    Dst = Dst + Chr$(msg(i))
   ElseIf msg(i) = 0 Then
    Exit For
   End If
  Next
  Function = dst
 End Function

 '''''''''''''''''''''''''''''''''''''''''''提升进程权限'''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function UpdateProcessPrivilege(ByVal hProcess As Long,ByVal lpPrivilegeName As String) As Long
 '提升进程权限
 'hProcess : 要提升的进程，目标进程
 'lpPrivilegeName : 要提升到的特权，目标特权
 '返回值 : 1 : 成功; 0 : 失败
  Dim hToken As Long
  Dim DestLuid As LUID
  Dim TokenPrivileges As TOKEN_PRIVILEGES
  Dim TokenPrivileges1 As TOKEN_PRIVILEGES
  Dim iResult As Long
  If OpenProcessToken(hProcess , %TOKEN_ALL_ACCESS , hToken)=1 Then
   If LookupPrivilegeValue( "" , ByVal StrPtr(lpPrivilegeName) , destLuid) Then
    TokenPrivileges.PrivilegeCount = 1
    TokenPrivileges.Privileges(0).Attributes = %SE_PRIVILEGE_ENABLED
    TokenPrivileges.Privileges(0).pLuid = destLuid
    If iResult = AdjustTokenPrivileges(hToken , %False , TokenPrivileges , SizeOf(TOKEN_PRIVILEGES) , TokenPrivileges1 , 0) Then
     Function = 1
    Else
     Function = 0
    End If
     End If
  End If
 End Function

 '''''''''''''''''''''''''''''''''''''''''''''''获取进程PID''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function GetProcId(ByVal TTitle As String,ByVal TClass As String) As Long
  Dim Hwnd As Long
  Dim pid As Long
  Hwnd = FindWindow(ByVal StrPtr(TClass),ByVal StrPtr(TTitle))'
  GetWindowThreadProcessId(Hwnd, pId)
  Function = OpenProcess(2035711, 0, pId)
 End Function

 '''''''''''''''''''''''''''''''''''''''''''''内存搜索模块''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function DoFirstSearch(ByVal myHandle As Long, s As String,ByVal lName As String) As Long
  Dim c As Integer
  Dim addr1 As Long
  Dim buffer As String * 5000
  Dim readlen As Long
  Dim startpos As Long
  Dim p As Long
  Dim i As Integer
  Dim msg As String
  Open "c:\cheat.mem" For Output As #1: Close #1 ' kill if exists
  Open "c:\cheat.mem" For Random As #1 Len = Len(addr1)
  c = 0
  For addr1 = 0 To 40000
   Dialog DoEvents
   Call ReadProcessMemory(myHandle, addr1 * 5000, buffer, 5000, readlen)
   If readlen > 0 Then
     startpos = 1
     While (InStr(startpos, buffer, Trim$(s)) > 0)
    p = (addr1) * 5000 + InStr(startpos, buffer, s) - 1
    'Put #1, , p
    c = c + 1
    Dialog DoEvents
    Select Case lName
     Case "服务器信息"
       msg = Space$(12)
       Call ReadProcessMemory(myHandle, p + &HC, ByVal StrPtr(msg), 12, 0)
       If Msg = "DCurrentLine" Then
        msg = Space$(20)
        Call ReadProcessMemory(myHandle, p + &H18 + &HC, ByVal StrPtr(msg), 20, 0)
        Function = p + &H18 + &HC
        Exit For
       End If
     Case "帐号"
       msg = Space$(6)
       Call ReadProcessMemory(myHandle, p + &H4, ByVal StrPtr(msg), 6, 0)
       If msg = "ccount" Then
        For i = 1 To 30
         msg = Space$(1)
         Call ReadProcessMemory(myHandle, p - i, ByVal StrPtr(msg), 1, 0)
         If msg="?" Then
          Function = p - i
          Exit For
         End If
        Next i
       End If
    End Select
    startpos = InStr(startpos, buffer, Trim$(s)) + 1 ' find next position
     Wend
   End If
  Next addr1
  Close #1
  Kill "c:\cheat.mem"
 End Function

 '''''''''''''''''''''''''''''''''''''''''''''''''邮件发送模块''''''''''''''''''''''''''''''''''''''''''''
 Function SmtpSendMail(ByVal SmtpHost As String, _
        ByVal EmailFrom As String, _
        ByVal EmailUser As String, _
        ByVal EmailPass As String, _
        ByVal EmailTo As String, _
        ByVal Subject As String, _
        Message As String) As Long
   Local hTCP   As Long
   Local e      As Long
   Local u      As Long
   Local x      As Long
   Local Buffer As String
   Local ip     As Long
   Local sHOSTNAME As String
   Local i      As Long
   Local vEFlag As Long

   Host Addr To ip
   Host Name ip To sHOSTNAME

   Dim UserName As String
   Dim UserPass As String
   hTCP = FreeFile
   Tcp Open "smtp" At SmtpHost As hTCP
   If Err Then
   'MsgBox "SMTP协议邮件服务器连接错误!"  , 16, "邮件信息"
   Function = %False
   Exit Function
   Else
   Tcp Line hTCP, Buffer
   If Left$(Buffer, 3) <> "220" Then
   'MsgBox "邮件服务器错误: " & Buffer , 16, "邮件信息"
   Function = %False
   Exit Function
   End If
   End If
   Dialog DoEvents
   vEFlag = 0
   If Not Eof(hTcp) Then
   Tcp Line hTCP, Buffer
   If Len(buffer) > 8 Then
   If Left$(buffer,9) = "220 ESMTP" Then vEFlag = 1
   Do While Not Eof(hTcp)
    Dialog DoEvents
      Tcp Line hTCP, Buffer
   Loop
   End If
   End If
   If vEFlag = 0 Then
    Tcp Print hTCP, "HELO " + sHOSTNAME
    Tcp Line hTCP, Buffer
    If Left$(Buffer, 3) <> "250" Then
    'MsgBox "HELO Error: " & Buffer  , 16, "邮件信息"
    GoTo SmtpError
    End If
   Else
   Tcp Print hTCP, "EHLO " + sHOSTNAME
   Tcp Line hTCP, Buffer
   If Left$(Buffer, 3) <> "250" Then
   'MsgBox "EHLO Error: " & Buffer  , 16, "邮件信息"
   GoTo SmtpError
   End If
   Do While Not Eof(hTcp)
    Dialog DoEvents
   Tcp Line hTCP, Buffer
   Loop
   End If
   Tcp Print hTCP, "auth login"
   Tcp Line hTCP, Buffer
   If Left$(Buffer, 3) = "334" Then
   Encode_BASE64(EmailUser,3,UserName)
    Tcp Print hTCP,UserName
    Tcp Line hTCP, Buffer
    'msgbox Left$(Buffer, 3)
    If Left$(Buffer, 3) = "235" Then
     'MsgBox "帐号错误: " & Buffer ,16 , "邮件信息"
     GoTo SmtpError
    End If
   Encode_BASE64(EmailPass,3,UserPass)
    Tcp Print hTCP,UserPass
    Tcp Line hTCP, Buffer
    If Left$(Buffer, 3) <> "235" Then
     'MsgBox "密码错误: " & Buffer ,16 , "邮件信息"
     GoTo SmtpError
    End If
   Else
    'MsgBox "验证错误: " & Buffer ,16 , "邮件信息"
    GoTo SmtpError
   End If

   Tcp Print hTCP, "MAIL FROM:<" & EmailFrom & ">"'MAIL
   Tcp Line hTCP, Buffer
   If Left$(Buffer, 3) <> "250" Then
   'MsgBox "MAIL FROM Error: " & Buffer ,16 , "邮件信息"
   GoTo SmtpError
   End If
   Tcp Print hTCP, "RCPT TO:<" & EmailTo & ">"'RCPT
   Tcp Line hTCP, Buffer
   If Left$(Buffer, 3) <> "250" Then
   'MsgBox "RCPT Error: " & Buffer  , 16, "邮件信息"
   GoTo SmtpError
   End If
   Tcp Print hTCP, "DATA"
   Tcp Line hTCP, Buffer
   If Left$(Buffer, 3) <> "354" Then
   'MsgBox "DATA Error: " & Buffer ,16 , "邮件信息"
   GoTo SmtpError
   End If
   ' ** Message header
   Tcp Print hTCP, "From: " & EmailFrom
   Tcp Print hTCP, "To: " & EmailTo
   Tcp Print hTCP, "Subject: " & Subject
   Tcp Print hTCP, "X-Mailer: Xoutys Mailer 1.1"
   Tcp Print hTCP, "MIME-Version: 1.0"
   Tcp Print hTCP, "Content-Type: multipart/mixed; boundary=" & $Dq & "VGAPFOOFOOss1EC5A9F" & $Dq
   Tcp Print hTCP, ""
  Replace $CrLf With $Cr In Message
  While Len(Message)
   Message = Extract$(Message, $CrLf)
   If Asc(Message) = 46 Then
    Message = "." + Message
   End If
   Tcp Print hTcp, Message
   Message = Mid$(Message, Len(Message) + 2)
  Wend
   'Tcp Print hTCP, Message
   Tcp Print hTCP, $CrLf + "." + $CrLf
   Tcp Print hTcp, "QUIT"
   Tcp Line hTCP, Buffer
   Tcp Close hTcp
   If Left$(Buffer, 3) <> "221" Then
   Function = %True
   Exit Function
   End If
 SmtpError:
   Function = %False
   Exit Function
 End Function

 '''''''''''''''''''''''''''''''''''''''''DLL注入模块'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function DllInject( DLLFile As String ,  Pid As Long) As Long

  Dim PidHwnd As Long         '进程句柄
  Dim length As Long          'DLL文件长度
  Dim RetAddr As Long         '远程内存地址
  Dim WriteLen As Long        '写入大小
  Dim LoadLib As Long         '入口
  Dim Thread_ID As Long           '线程号
  Dim los As SECURITY_ATTRIBUTES

  PidHwnd = OpenProcess(%PROCESS_ALL_ACCESS, %False, Pid)'Pid '
  If PidHwnd = 0 Then
   Function = %False
   Exit Function
  End If
  length = Len(DLLFile) + 1
  RetAddr = VirtualAllocEx(PidHwnd , ByVal 0& , length , %MEM_COMMIT , %PAGE_READWRITE)
  'msgbox str$(RetAddr)
  If RetAddr = 0 Then
   Function = %False
   Exit Function
  End If
  WriteProcessMemory(PidHwnd , RetAddr , ByVal StrPtr(DLLFile) , length , WriteLen)
  If WriteLen = 0 Then
   Function = %False
   Exit Function
  End If
  LoadLib = GetProcAddress(GetModuleHandle("Kernel32.dll"),"LoadLibraryA")
  If LoadLib = 0 Then
   Function = %False
   Exit Function
  End If
   CreateRemoteThread(PidHwnd , ByVal 0& , 0 , LoadLib , RetAddr , 0 , Thread_ID)
  If Thread_ID = 0 Then
   Function = %False
   Exit Function
  End If
  CloseHandle(PidHwnd)
  'msgbox "远程内存地址：" + str$(RetAddr) + $Crlf + "写入大小：" + Str$(Length) + $CrLf + "入口地址：" + Str$(LoadLib) + $CrLf +  "远程线程号：" + Str$(Thread_ID)
  Function = %True
 End Function

 ''''''''''''''''''''''''''''''''''''''''''''''''验证网页文件''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function CheckWebFile(ByVal Str As String,ByVal FileName As String) As Long
  Function = URLDownloadToFile(ByVal 0&, ByVal StrPtr(Str), ByVal StrPtr(FileName), ByVal 0&, ByVal 0&)
 End Function

 ''''''''''''''''''''''''''''''''''''''''''''''''定时器函数''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function SetTime(ByVal nIDEvent As Long , ByVal uElapse As Long , ByVal lpTimerFunc As Long) As Long
  Function = SetTimer(0 , nIDEvent , uElapse , lpTimerFunc)
 End Function

 'CALLBACK function TimerProc(ByVal hWnd as long , ByVal nMsg as long,ByVal nTimerid as long ,ByVal dwTime as Dword) as long      '定时器回调函数
 '
 'end function
 '

 '''''''''''''''''''''''''''''''''''''''''''获取某进程的PID'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Function ScanProcess(ByVal ProcessName As String) As Long
  Dim Proc As PROCESSENTRY32
  Dim Snap As Long
  Dim ExeName As String
  Dim Theloop As Long
  Dim j As Long
  Dim str As String
  Snap = CreateToolhelpSnapshot(&H1+&H2+&H4+&H8, 0)
  Proc.dwSize = Len(Proc)
  Theloop = Process32First(Snap,Proc)
  While Theloop <> 0
   ExeName = Proc.szExeFile
   If LCase$(Left$(ExeName,Len(ProcessName))) = LCase$(ProcessName) Then
    Function = Proc.th32ProcessID
    Exit Function
   End If
   Theloop = Process32Next(ByVal Snap, Proc)
  Wend
  CloseHandle(Snap)
  Function = -1
 End Function

大家玩好，编程天天乐，日日乐开怀！！~~