如何用VB6 检测文件是否存在

本来很简单,一般人baidu过都会,基本用的都是Dir这个命令,我原来也是。

但后面实际运行出现了点问题,偶尔会出现错误,查了一下人家解释为“DIR 函数在调用无权限的目录以及文件时会产生错误”。

发现原来有缺陷,想用On Error这样来屏蔽又有点不甘心,然后google了一下,发现又是英文网站解决了,请到下面原文去看:

http://www.vbforums.com/showthread.php?349990-Classic-VB-How-can-I-check-if-a-file-exists

人家那叫头脑风暴,一个人提出,n个人提出不同的实现方法。

最后我选择了一种变成模块的方式,支持“*”通配符,以下是代码,也是抄的:

模块代码:

'In a standard Module
Option Explicit
 
Public Const MAX_PATH                   As Long = 260
Private Const ERROR_NO_MORE_FILES       As Long = 18&
Private Const FILE_ATTRIBUTE_NORMAL     As Long = &H80
 
Private Type FILETIME
    dwLowDateTime   As Long
    dwHighDateTime  As Long
End Type
 
Private Type WIN32_FIND_DATA
    dwFileAttributes    As Long
    ftCreationTime      As FILETIME
    ftLastAccessTime    As FILETIME
    ftLastWriteTime     As FILETIME
    nFileSizeHigh       As Long
    nFileSizeLow        As Long
    dwReserved0         As Long
    dwReserved1         As Long
    cFileName           As String * MAX_PATH
    cAlternate          As String * 14
End Type
 
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
                ByVal lpFileName As String, _
                lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" ( _
                ByVal hFindFile As Long) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
                ByVal hFindFile As Long, _
                lpFindFileData As WIN32_FIND_DATA) As Long
 
Public Function FileExists(ByVal sFile As String) As Boolean
    Dim lpFindFileData  As WIN32_FIND_DATA
    Dim lFileHandle     As Long
    Dim lRet            As Long
    Dim sTemp           As String
    Dim sFileExtension  As String
    Dim sFileName       As String
    Dim sFileData()     As String
    Dim sFileToCompare  As String
    
    If IsDirectory(sFile) = True Then
        sFile = AddSlash(sFile) & "*.*"
    End If
    
    If InStr(sFile, ".") > 0 Then
        sFileToCompare = GetFileTitle(sFile)
        sFileData = Split(sFileToCompare, ".")
        sFileName = sFileData(0)
        sFileExtension = sFileData(1)
    Else
        Exit Function
    End If
    
    ' get a file handle
    lFileHandle = FindFirstFile(sFile, lpFindFileData)
    If lFileHandle <> -1 Then
        If sFileName = "*" Or sFileExtension = "*" Then
            FileExists = True
        Else
            Do Until lRet = ERROR_NO_MORE_FILES
                ' if it is a file
                If (lpFindFileData.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = vbNormal Then
                    sTemp = StrConv(RemoveNull(lpFindFileData.cFileName), vbProperCase)
                    
                    'remove LCase$ if you want the search to be case sensitive
                    If LCase$(sTemp) = LCase$(sFileToCompare) Then
                        FileExists = True ' file found
                        Exit Do
                    End If
                End If
                'based on the file handle iterate through all files and dirs
                lRet = FindNextFile(lFileHandle, lpFindFileData)
                If lRet = 0 Then Exit Do
            Loop
        End If
    End If
    
    ' close the file handle
    lRet = FindClose(lFileHandle)
End Function
 
Private Function IsDirectory(ByVal sFile As String) As Boolean
    On Error Resume Next
    IsDirectory = ((GetAttr(sFile) And vbDirectory) = vbDirectory)
End Function
 
Private Function RemoveNull(ByVal strString As String) As String
    Dim intZeroPos As Integer
 
    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        RemoveNull = Left$(strString, intZeroPos - 1)
    Else
        RemoveNull = strString
    End If
End Function
 
Public Function GetFileTitle(ByVal sFileName As String) As String
    GetFileTitle = Right$(sFileName, Len(sFileName) - InStrRev(sFileName, "\"))
End Function
 
Public Function AddSlash(ByVal strDirectory As String) As String
    If InStrRev(strDirectory, "\") <> Len(strDirectory) Then
        strDirectory = strDirectory + "\"
    End If
    AddSlash = strDirectory
End Function

然后使用的时候像这样使用:

'specific file
If FileExists("C:\WINDOWS\system32\progman.exe") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If
 
'check existence of folder
If FileExists("C:\Program Files") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If
 
'wildcard search1
If FileExists("C:\WINDOWS\system32\pschdprf.*") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If
 
'wildcard search2
If FileExists("C:\WINDOWS\system32\*.dll") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If
 
'wildcard search3
If FileExists("C:\WINDOWS\*.*") Then
    MsgBox "Existing!"
Else
    MsgBox "Not Existing!"
End If

挺好用的,无权限的目录或文件不会报错,大家试试看吧。

STM32 仿真检测

目的与引用的文章开始那段类似(地址:http://blog.csdn.net/billy145533/article/details/49706783):
“出于调试的目的,在仿真的时候经常要改变程序的逻辑以方便测试,不幸的是,我是一个不甚严谨的人,每次测试完,一些改动忘记改回去就发布了,经常被测试退回。
于是,我想到是否能利用stm32中的特殊寄存器判断是否在调试状态,如果是,引入我需要测试的部分,否则自动跳过,这样发布就不会出现发布调试版本的问题。有人会说,测试用debug,发布使用release,我比较懒,不想切来切去。 ”

但是可惜,这篇文章到最后貌似也没有非常明确地提到如何使用,所以只能最后祭出大杀招:google+英文关键字搜索。

果然很快就从 https://community.st.com/thread/36036-how-to-check-at-runtime-if-a-debugger-is-connected 这里找到这里:

https://community.st.com/thread/25890?commentID=69875#comment-69875

然后核心就是一句话:

debugDetect = ( CoreDebug->DHCSR & CoreDebug_DHCSR_C_DEBUGEN_Msk );

果然还是英文搜索比较靠谱。

如果想仔细研究,可以看看寄存器的详细定义:
http://infocenter.arm.com/help/index.jsp?topic=/com.arm.doc.ddi0337e/CEGCJAHJ.html

去伪存精——VB6上真实可用的UTF-8编码URLencode函数

首先,要扫盲一下,什么是URLencode,网上搜索一下规则就可以知道:

1。字母,数字,连字符不变。
2。空格转换成加号。
3。其他所有的字符转换成用百分号表示,后跟字符的两位十六进制编码。

关于UTF-8与GB2312和GBK的关系就不详说了,就只是网页编码,这次我们需要的是根据UTF-8来进行编码。
通常在网上传输参数时有用,因为如果字符串中包含“&”或"%"这些字符,就会被错误解释整串字符,所以需要重新编码再解码。
如果在VB上想实现,百度搜搜一堆,但实际没有一个可用,真的,没有一个可用!
先说说搜索出来最多的,是这个:

Public Function UTF8_URLEncoding(szInput)
    Dim wch, uch, szRet
    Dim x
    Dim nAsc, nAsc2, nAsc3
    If szInput = "" Then
        UTF8_URLEncoding = szInput
        Exit Function
    End If
    For x = 1 To Len(szInput)
        wch = Mid(szInput, x, 1)
        nAsc = AscW(wch)
       
        If nAsc < 0 Then nAsc = nAsc + 65536
       
        If (nAsc And &HFF80) = 0 Then
            szRet = szRet & wch
        Else
            If (nAsc And &HF000) = 0 Then
                uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            Else
                uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
                Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
                Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
    UTF8_URLEncoding = szRet
End Function

但实际出处应该在这里:
http://blog.csdn.net/xiaoyao961/article/details/6764029
因为还带了非常重要的注释,而且人家明明写得很清楚:
“VB源码函数UTF8Encode UTF8编码,原内容中有URLENCODE内容的不作更改”
根据分析源码,作者的意思应该是对中文进行URLencode,对其他字符不处理,譬如"%",空格,“&”这些都是不处理的。
当然,我们还搜索到另外一个函数,出处在这里:
http://blog.csdn.net/bibbykwan/article/details/6041969
源码:

Public Function URLEncode(ByVal strParameter As String) As String

Dim s As String
Dim I As Integer
Dim intValue As Integer

Dim TmpData() As Byte

    s = ""
    TmpData = StrConv(strParameter, vbFromUnicode)
    For I = 0 To UBound(TmpData)
      intValue = TmpData(I)
      If (intValue >= 48 And intValue <= 57) Or _         (intValue >= 65 And intValue <= 90) Or _         (intValue >= 97 And intValue <= 122) Then
        s = s & Chr(intValue)
      ElseIf intValue = 32 Then
        s = s & "+"
      Else
        s = s & "%" & Hex(intValue)
      End If
    Next I
    URLEncode = s

End Function

其实我更喜欢另外一个更加简单的,其实是一样的:

Public Function URLEncode(ByRef Text As String) As String
    Const Hex = "0123456789ABCDEF"
    Dim lngA As Long, lngChar As Long
    URLEncode = Text
    For lngA = LenB(URLEncode) - 1 To 1 Step -2
        lngChar = Asc(MidB$(URLEncode, lngA, 2))
        Select Case lngChar
            Case 48 To 57, 65 To 90, 97 To 122
            Case 32
                MidB$(URLEncode, lngA, 2) = "+"
            Case Else
                URLEncode = LeftB$(URLEncode, lngA - 1) & "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1) & MidB$(URLEncode, lngA + 2)
        End Select
    Next lngA
End Function

分析源码可以得知,该函数仅对空格、"%"这些字符进行处理,如果是中文的话,得不到想要的结果。
好吧,既然如此,只能够自己修改了,把2个不足的地方互相弥补一下,得出以下真实可用的函数:

'UTF-8 URL编码
Public Function UTF8_URLEncoding(szInput)
    Dim uch, szRet
    Dim wch As String
    Dim x
    Dim nAsc, nAsc2, nAsc3
    If szInput = "" Then
        UTF8_URLEncoding = szInput
        Exit Function
    End If
    For x = 1 To Len(szInput)
        wch = Mid(szInput, x, 1)
        nAsc = AscW(wch)
       
        If nAsc < 0 Then nAsc = nAsc + 65536
       
        If (nAsc And &HFF80) = 0 Then
            szRet = szRet & URLEncode(wch)
        Else
            If (nAsc And &HF000) = 0 Then
                uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            Else
                uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
                Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
                Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
    UTF8_URLEncoding = szRet
End Function

Public Function URLEncode(ByRef Text As String) As String
    Const Hex = "0123456789ABCDEF"
    Dim lngA As Long, lngChar As Long
    URLEncode = Text
    For lngA = LenB(URLEncode) - 1 To 1 Step -2
        lngChar = Asc(MidB$(URLEncode, lngA, 2))
        Select Case lngChar
            Case 48 To 57, 65 To 90, 97 To 122
            Case 32
                MidB$(URLEncode, lngA, 2) = "+"
            Case Else
                URLEncode = LeftB$(URLEncode, lngA - 1) & "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1) & MidB$(URLEncode, lngA + 2)
        End Select
    Next lngA
End Function

只要调用UTF8_URLEncoding()这个函数就可以得出真实的结果了,测试如下:
debug.print UTF8_URLEncoding("1+1%&测试")的结果为:
1%2B1%25%26%E6%B5%8B%E8%AF%95

总结:现在的开发总浮于表面,通常网上找到就马上拿来用了,是不是真的可用也没实际测试。特别是这个URLencode,因为一般如果只包含中文,是看不出问题的,只有当含有%和空格这些特殊符号才出问题。
不过现在用VB6的也很少了,如果是VB.net就一个函数搞定。

 

后记,百度知道上面的那个,经测试是GB2312的,可用,也放着留存吧,代码如下:
http://zhidao.baidu.com/link?url=eHXKcsGEuhSMRhearWqQgcyuJEoLNFRuDOU0mog-du6wuy0PZHkzeBcez2lKfeRlamPxVccLRWWFC17STrlRdAoiXSKxW-_6AnwutBe5uL3

'编码函数
Public Function URLEncode(ByRef strURL As String) As String
Dim I As Long
Dim tempStr As String
For I = 1 To Len(strURL)
If Asc(Mid(strURL, I, 1)) < 0 Then
    tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, I, 1)))), 2)
    tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, I, 1)))), Len(CStr(Hex(Asc(Mid(strURL, I, 1))))) - 2) & tempStr
    URLEncode = URLEncode & tempStr
ElseIf (Asc(Mid(strURL, I, 1)) >= 65 And Asc(Mid(strURL, I, 1)) <= 90) Or (Asc(Mid(strURL, I, 1)) >= 97 And Asc(Mid(strURL, I, 1)) <= 122) Then
    URLEncode = URLEncode & Mid(strURL, I, 1)
Else
    URLEncode = URLEncode & "%" & Hex(Asc(Mid(strURL, I, 1)))
End If
Next
End Function
 
'解码函数
Public Function URLDecode(ByRef strURL As String) As String 
Dim I As Long 
 
If InStr(strURL, "%") = 0 Then URLDecode = strURL: Exit Function 
 
For I = 1 To Len(strURL) 
If Mid(strURL, I, 1) = "%" Then 
If Val("&H" & Mid(strURL, I + 1, 2)) > 127 Then 
URLDecode = URLDecode & Chr(Val("&H" & Mid(strURL, I + 1, 2) & Mid(strURL, I + 4, 2))) 
I = I + 5 
Else 
URLDecode = URLDecode & Chr(Val("&H" & Mid(strURL, I + 1, 2))) 
I = I + 2 
End If 
Else 
URLDecode = URLDecode & Mid(strURL, I, 1) 
End If 
Next 
End Function

信用卡手续费换算为贷款年利率

最近因为结婚买房子、筹办婚礼等花了不少的钱,信用卡都快刷爆了,账单2万多,银行发信息过来说可以分期还款,12期,每期手续费为总额的0.67% 。粗算一下0.67% × 12= 8.04 % ,貌似也不高嘛,就办了。
但前几天某个很会算的同事给我揭示了信用卡分期付款手续费的秘密,我在网上查了一下,果然:
如何计算实际的年利率,在网上可以查到利用excel的rate公式,就拿我这个例子,12期,如果按总贷款额为20000,总共要给银行归还20000*(1+0.0067*12)=21608, 则每月应该银行交21608/12=1800.67 。利用rate公式则为rate(12,-1800.67,20000) (12即12期,-1800.67为每期要缴数,要为负,20000为贷款额),在excel里马上可以算出为1.204% ,这个是月利率,换为年利率则再乘以12,为14.45% !!!
是不是觉得非常不可思议?为了验证这个利率的准确性,我们可以到新浪的房贷计算器上面去计算:
http://finance.sina.com.cn/calc/house_loan.html
选择商业贷款,金额2万元,期限1年,利率直接输入14.45%,选择“等额本息”,点“计算”,结果马上就可以出来了,可以看到每月偿还本息为1799.98,即等同于1800.67了,可以确认该利率无误了。
所以在这里提醒一下各位,别被这个看起来很低的“手续费”给蒙蔽了!
网上换算的网页可以给大家推荐一个:
http://www.masterhsiao.com.tw/Rate/Rate.htm

C语言与VB定义变量类型的差异

因本人开始从事的就是C语言的开发,所以对于C语言还是比较熟悉的,在定义变量时,同时定义几个变量可以这样定义:

unsigned int x,y,z;

这样就可以把x,y,z都定义为无符号整型的数据类型。

但当我想把类似的方法放到VB时,以为这样定义:

Dim x,y,z as integer

就可以把x,y,z都定义为整型。

但实际我发现错了,经过我的跟踪调试发现,这样的定义只是把z给定义为整型了,x与y则被定义为可变类型variant

网上搜索了一下证实了我自己的想法。

正确的定义方法应为:

Dim x as integer , y as integer , z as integer

不能偷懒,希望对某些从C语言编程出身的网友会有所帮助。

[转]分享:如何删除被占用的串口号

如果一直使用串口调试的网友肯定知道,如果你使用的是USB转串口的设备,而且还用过USBHUB转的话,那前面的串口基本已经占完了,新设备的端口号可能就要从几十开始,有时候有些调试软件不支持开那么高的串口号,很麻烦。

后来我从网上搜到了如何删掉这些多余被占用的串口号的方法,特意与大家分享一下:

通过删除注册表中的一个数值项来清除这些配置:在“运行”对话框中输入 “regedit”进入注册表;然后进入 HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control \COM Name Arbiter这时我们可以找到该数值项:ComDB,它的值代表目前使用中的串口端号。比如1d,它的二进制:0001 1101,则从右往左数代表第1,3,4,5端口被占用。这样我们只需要把ComDB这个数据项删除,关闭注册表(不用重启电脑)即可。

避免VLOOKUP函数返回#N/A错误的方法

适用对象,已经会使用VLOOKUP函数的人群。

很简单,这样就可以了,sample:

EXCEL 2007版本:

=IFERROR(VLOOKUP(D3,A1:B61,2,),"无对应值")

EXCEL 2003版本:

=IF(ISNA(VLOOKUP(D3,A1:B61,2,)),"无对应值",VLOOKUP(D3,A1:B61,2,))

“无对应值”可以改成空的“”或者其他,自由发挥。

"我叫MT"符文数据(可复制版本)

不知道为什么,现在网上的攻略、数据,虽然作者是先做到excel里的,但最后只以截图形式发布,很不方便。
今天我就把"我叫MT"这个游戏的符文数据重新做出,变成可复制的文本信息,希望大家有用吧。

红色1级 红色2级 红色3级 红色4级 红色5级
攻击 100 236 511 1030 1932
生命 307 720 1561 3145 5902
暴击 7 16 35 71 133
韧性 8 18 40 80 151
命中 7 17 37 74 140
闪避 6 14 30 60 114
物抗 17 41 89 180 337
法抗 16 37 81 163 305
绿色1级 绿色2级 绿色3级 绿色4级 绿色5级
攻击 33 78 170 343 644
生命 102 240 520 1048 1967
暴击 21 49 106 213 400
韧性 24 55 120 242 454
命中 7 17 37 74 140
闪避 6 14 30 60 114
物抗 52 123 268 540 1012
法抗 16 37 81 163 305
蓝色1级 蓝色2级 蓝色3级 蓝色4级 蓝色5级
攻击 33 78 170 343 644
生命 102 240 520 1048 1967
暴击 7 16 35 71 133
韧性 8 18 40 80 151
命中 22 51 111 224 420
闪避 18 42 90 182 842
物抗 17 41 89 180 337
法抗 48 112 243 489 917
这里用红色标记的是该颜色的最强属性,可以看出红色只有2项属性最强,绿色和蓝色都有3项最强属性。由于同等级同颜色同种符文禁止镶嵌多颗,而游戏中我们每种颜色的孔洞有6个!(这里暂不计算“暂未开放”的孔洞)

这里按照全数值最大来计算符文属性

红色:3级攻击、4级攻击、5级攻击、3级生命、4级生命、5级生命

绿色:4级暴击、5级暴击、4级韧性、5级韧性、4级物抗、5级物抗

蓝色:4级命中、5级命中、4级闪避、5级闪避、4级法抗、5级法抗

我叫MT最强符文预计获得属性:

攻击 3473,生命 10608,暴击 613,韧性 696,命中 644,闪避 524,物抗 1552,法抗 1406

[转]c:\windows\sytem32\ieframe.dll\1未找到'的解决方法

C:\windows\sytem32\ieframe.dll\1未找到'的解决方法

这几天我的VB一直不能加载ieframe.dll,一加载就说c:\windows\sytem32\ieframe.dll\1找不到,然后就出错了。一直没有搞明白,今天终于在网上找到了解决的办法,原因是由于ie7.0的bug引起的。
这个ieframe.dll是vb中WebBrowser 调用的控件,当你用vb再次打开你的工程之后,
就可以发现以前的WebBrowser 控件没有了。而且再次加载也是不能的了。

现贴上来与大家共同分享,我想如果你安装了IE7.0浏览器可能很多都会遇到这样的问题的,值得收藏。

把以下内容做成一个注册表文件IE7.reg,导入注册表即可:

Windows Registry Editor Version 5.00
[HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}]
[HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1]
@="Microsoft Internet Controls"
[HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1\0]
[HKEY_CLASSES_ROOT\TypeLib\{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}\1.1\0\win32]
@="C:\\WINDOWS\\system32\\ieframe.dll"

好了,当你已经导入 注册表后,再按下面的方法,就可以加载Microsoft Internet Controls了:

在工具箱中点击鼠标右键→选中“ 部件” → 复选Microsoft InternetControls → 然后点击“ 确定” 键即可。
这样在工具箱中即可看到WebBrowser控件,在窗体中新建一个WebBrowser控件即可!

附我自己做好的reg文件:

ieframe.dll.IE7.reg

真特么搞笑,我的chrome竟然阻止我访问google.com

只能上图了:

snap0037