| VB 源码 | VC 源码 | ASP源码 | JSP源码 | PHP源码 | CGI源码 | FLASH源码 | 素材模板 | C 源程序 | 站长工具 | 站长教程 |

VB技术

ASP技术
PHP技术
JSP技术
VB技术
.NET技术

本类阅读TOP10

·利用shell编程实现DOS风格的Linux命令行
·新手必学:windows网络编程经典入门
·通过连接实例解读TCP/IP协议
·JAVA生成JPG缩略图
·一组VB实用小程序
·VB解决Unicode文本转换的问题
·用VB制作屏幕保护程序
·Visual Basic开发应用程序答疑
·用VB6实现中英文文本的私钥加密
·用VB学做“黑客”程序

站内搜索

VB下几个有用的函数

'————————(1)————————————
  '获得指定ini文件中某个节下面的所有键值 TrueZq,,需要下面的API声明
  'Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  '返回一个字符串数组
  '调用举例:
  'Dim arrClass() As String
  'arrClass = GetInfoSection("class", "d:\type.ini")


  Public Function GetInfoSection(strSection As String, strIniFile As String) As String()
    Dim strReturn As String * 32767
    Dim strTmp As String
    Dim nStart As Integer, nEnd As Integer, i As Integer
    Dim sArray() As String

 

    Call GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)

    strTmp = strReturn
    i = 1
    Do While strTmp <> ""
      nStart = nEnd + 1
      nEnd = InStr(nStart, strReturn, vbNullChar)
      strTmp = Mid$(strReturn, nStart, nEnd - nStart)
      If Len(strTmp) > 0 Then
        ReDim Preserve sArray(1 To i)
        sArray(i) = strTmp
        i = i + 1
      End If

    Loop
    GetInfoSection = sArray
  End Function

  '————————(2)————————————
  '作用:去掉字符串中的首尾空格、所有无效字符
  '测试用例
  'Dim strRes As String
  'Dim strSour As String
  '
  'strSour = " " & vbNullChar & vbNullChar & " ab cd" & vbNullChar
  'strRes = zqTrim(strSour)
  'MsgBox " 长度=" & Len(strSour) & "值=111" & strRes & "222"
  Public Function zqTrim(ByVal strSour As String) As String
    Dim strTmp As String
    Dim nLen As Integer
    Dim i As Integer, j As Integer
    Dim strNow As String, strValid() As String, strNew As String
    'strNow 当前字符
    'strValid 有效字符
    'strNew 最后生成的新字符

    strTmp = Trim$(strSour)
    nLen = Len(strTmp)
    If nLen < 1 Then
      zqTrim = ""
      Exit Function
    End If
    j = 0
    For i = 1 To nLen
      strNow = Mid(strTmp, i, 1) '每次读取一个字符
      'MsgBox Asc(strNow)
      If strNow <> vbNullChar And Asc(strNow) <> 9 Then '如果有效,则存入有效数组
        ReDim Preserve strValid(j)
        strValid(j) = strNow
        j = j + 1
      End If

    Next i

    strNew = Join(strValid, "") '将所有有效字符连接起来
    zqTrim = Trim$(strNew) '去掉字符串中的首尾空格
  End Function


  '————————(3)————————————
  '检查文件是否存在,存在返回 TRUE,否则返回FALSE
  Public Function CheckFileExist(strFile As String) As Boolean

    If Dir(strFile, vbDirectory) <> "" Then
      CheckFileExist = True
    Else
      CheckFileExist = False
    End If
  End Function

  '————————(4)————————————
  '获得指定ini文件中某个节下面某个子键的键值,需要下面的API声明
  'Public Declare Function GetPrivateProfileString Lib "kernel32" Alias _
  '  "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
  '  ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString _
  '  As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  '返回一个字符串
  '调用举例:
  'Dim strRun As String
  'strRun = GetiniValue("Windows","Run", "C:\Windows\Win.ini")

  Public Function GetiniValue(ByVal lpKeyName As String, ByVal strName As String, ByVal strIniFile As String) As String
    Dim strTmp As String * 255

    Call GetPrivateProfileString(lpKeyName, strName, "", _
        strTmp, Len(strTmp), strIniFile)
    GetiniValue = Left$(strTmp, InStr(strTmp, vbNullChar) - 1)

  End Function

  '————————(5)————————————
  '获得Windows目录 ,需要下面的API声明
  'Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  '返回一个字符串,如“C:\Windows”、“C:\Winnt”
  '调用举例:
  'Dim strWindir As String
  'strWindir = GetWinDir()
  Private Function GetWinDir()
    Dim windir As String * 100
    Call GetWindowsDirectory(windir, 100)
    GetWinDir = Left$(windir, InStr(windir, vbNullChar) - 1)

  End Function

  '————————(6)————————————
  '获得Windows系统目录,需要下面的API声明
  'Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  '返回一个字符串,如“C:\Windows\System”、“C:\Winnt\System32”
  '调用举例:
  'Dim strSysDir As String
  'strSysDir = GetSystemDir()
  Private Function GetSystemDir()
    Dim strSysDir As String * 100
    Call GetSystemDirectory(strSysDir, 100)
    GetSystemDir = Left$(strSysDir, InStr(strSysDir, vbNullChar) - 1)

  End Function




相关文章
  • 精通PHP的十大要点
  • VB解决Unicode文本转换的问题
  • 一个基于WEB的QQ程序
  • 使用xmlhttp查询域名是否被注的小程序
  • 用VB6实现中英文文本的私钥加密
  • 一组VB实用小程序
  • 用VB编写异步多线程下载程序
  • 屏保程序模板化完整源代码
  • VB中实现窗体自动隐藏
  • 用VB编写网络监控软件
  • VB到底为我们做了什么?
  • 键盘幽灵VB版
  • 用VB编写定时关闭计算机的程序
  • 用MCI命令做一个播放器
  • 使用VB在WIN2000下截获IP数据包
  • VB中字符串中文的问题
  • 用VB制作屏幕保护程序
  • VB枚举主机IP
  • 用VB编写一个弹出菜单类
  • 自己的IE——用VB制作浏览器
  • 相关软件

  • VBScript编辑器源码  
  • 字体观察器FontViewer源码  
  • 自动壁纸更换器源码[第二部分]  
  • 自动壁纸更换器源码[第一部分]  
  • WINDOWS 3.0终端程序的C源码  
  • 一个取得 CPU 信息的程序源码  
  • 广告窗口终结者源码  
  • 下载整个网站程序ssnag与源码  
  • CGI邮件程序源码  
  • ISAPI留言簿源码  



  • 月光软件源码下载编程文档电脑教程网站优化网址导航网络文学游戏天地生活休闲写作范文安妮宝贝站内搜索
    电脑技术编程开发网络专区谈天说地情感世界游戏元素分类游戏热门游戏体育运动手机专区业余爱好影视沙龙
    音乐天地数码广场教育园地科学大观古今纵横谈股论金人文艺术医学保健动漫图酷二手专区地方风情各行各业

    月光软件站·版权所有