| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1240 人关注过本帖
标题:vb的几个过程语句需要解释
取消只看楼主 加入收藏
粘土
Rank: 1
等 级:新手上路
帖 子:15
专家分:0
注 册:2009-9-4
结帖率:80%
收藏
已结贴  问题点数:20 回复次数:4 
vb的几个过程语句需要解释
这个帖子以前发过,但问题没彻底解决,我把实在不清楚的理了一下,并加注了标示,更有针对性.为了热心的回帖者更好的解答,将有关的代码全部帖上.走过路过的都来回一下,一个字:急!
'代替指定的串
'从一个源串(rStr)中寻找到 子串(vSource),然后用目标串(vDes)代替子串(vSource)
Private Sub subReplaceStr(ByRef rStr As String, ByVal vSource As String, _
    ByVal vDes As String)
   
    Dim i As Integer
   
    On Error Resume Next
    If Len(vSource) = 0 Or Len(rStr) = 0 Then Exit Sub
    i = 1
    i = InStr(i, rStr, vSource)
    Do While i > 0
        rStr = Left(rStr, i - 1) & vDes & Right(rStr, Len(rStr) - i - Len(vSource) + 1)
        i = InStr(i + Len(vDes), rStr, vSource)
        DoEvents: DoEvents: DoEvents
    Loop
End Sub
 


'解释参数
'参数存储在para.dat中
Private Sub subPara(ByVal vStr As String)
    Dim tCmd As String
    Dim tStr As String
    Dim i As Long
    Dim j As Long
   
    On Error Resume Next
    If vStr = "" Then Exit Sub
    If Right(vStr, 2) = vbCrLf Then vStr = Left(vStr, Len(vStr) - 2)
   
    tCmd = vStr
   
    j = 1: i = InStr(j, tCmd, ",")
    Do While i > 0
        tStr = Mid$(tCmd, j, i - j)
        funCmdLine tStr
        j = i + 1: i = InStr(j, tCmd, ",")
    Loop
    tStr = Right(tCmd, Len(tCmd) - j + 1)
    funCmdLine tStr
End Sub

'解释命令行参数  vStr:传递来的参数,一般为Command

Private Function funCmdLine(ByVal vStr As String) As Byte
    Dim i As Integer
    Dim tLeft As String                        
    On Error GoTo ErrPos
    funCmdLine = 0
    DoEvents: DoEvents: DoEvents: DoEvents
vStr = Trim(vStr)           ': subReplaceStr vStr, vbTab, ""         
    If vStr = "" Then Exit Function            
   
    i = InStr(vStr, "=")
    If i > 0 Then tLeft = Left(vStr, i - 1): vStr = Right(vStr, Len(vStr) - i) Else tLeft = vStr: vStr = ""
    tLeft = Trim(tLeft): vStr = Trim(vStr)
   
    Select Case LCase(tLeft)               
    Case "txtsfile": txtSFile.Text = vStr
    Case "txtdfile": txtDFile.Text = vStr
    End Select
   
    Exit Function
ErrPos:
    subDealError "funCmdLine," & vStr & ",Code:" & Err & ";Descr:" & Error
End Function

'快速读入文本文件

Private Function funReadFile(ByVal vFileName As String) As String
    Dim tFileNum As Long
    Dim tF As String
    Dim tL As Long
    Dim tByte() As Byte
   
    On Error GoTo DealError
    funReadFile = "": tF = ""
    If Dir(vFileName) = "" Then
        subDealError "不能找到 " & vFileName & " !"
        Exit Function
    End If
   
    tL = FileLen(vFileName): ReDim tByte(1 To tL)
   
    tFileNum = FreeFile
    Open vFileName For Binary Access Read As tFileNum   (Binary Access Read 方式打开文件方式没见过,表示什么意思?)
    Get tFileNum, , tByte
    Close tFileNum: DoEvents
    tF = StrConv(tByte, vbUnicode)                        (此函数不懂,不知道有什么作用?)
    funReadFile = tF
    Exit Function
DealError:
    'MsgBox "注意:读文件" & vFileName & "出错,不能取得相关信息!", 48     
    subDealError "ReadFile " & vFileName & ",Code:" & Err & ",Descr:" & Error    (Err和Error 是什么东西?)
    On Error Resume Next
    Close tFileNum
End Function

'统一处理错误,记入日志文件

Private Sub subDealError(ByVal vStr As String)
    Dim tStr As String
    Static sI As Integer
   
    On Error Resume Next
    If Len(vStr) > 0 Then
        lblNote.Caption = vStr: DoEvents
        sI = sI + 1
        mError = mError & CStr(Now) & "," & vStr & vbCrLf
    End If

    If (sI = 50 Or Len(vStr) = 0) And Len(mError) > 0 Then
        tStr = App.Path & "\log.txt"
        subSaveTextFile mError, tStr, True
        mError = "": sI = 0
    End If
End Sub


'窗体载入部分的代码
Private Sub Form_Load()
    Dim tStr As String
    Dim tB(-7 To 14) As Byte
    Dim i As Integer
   
    On Error Resume Next
    m_FXJ_PRP3_RecBytes = 36
   
   
    '取系统参数
    tB(-7) = 33: tB(-6) = 61:  tB(-5) = 36: tB(-4) = 46: tB(-3) = 45: tB(-2) = 46: tB(-1) = 54: tB(0) = 32
    tB(1) = 88: tB(2) = 89: tB(3) = 90: tB(4) = 50
    tB(5) = 92: tB(6) = 89: tB(7) = 91: tB(8) = 87: tB(9) = 76: tB(10) = 85
    tB(11) = 57: tB(12) = 90: tB(13) = 82: tB(14) = 98
   
    tStr = ""
    For i = -7 To 14:        tStr = tStr & Chr$(tB(i) - i):   Next
    lblWStock.Caption = tStr
   
    tStr = ""
    For i = 1 To 14:        tStr = tStr & Chr$(tB(i) - i):   Next
    lblWStock.Tag = tStr                                                (lblWStock是Label ,Tag是表示他的属性吗,是什么含义?)
   
    '解释存储的参数
    tStr = App.Path & "\wsPara.dat"
    If Dir(tStr) <> "" Then
        tStr = funReadFile(tStr)
        subPara tStr
    End If
   
    tStr = Command                                                    (Command是什么?)
    If Len(tStr) > 0 Then
        subPara tStr
    End If
End Sub


'程序退出时的代码
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)      (这是个什么过程,Cancel 和 UnloadMode 变量有什么含义)
    Dim tStr As String
    Dim i As Integer
   
    On Error Resume Next
   
    If cmdExit.Enabled Then
        If Len(Command) = 0 Then    '带参数启动不存储参数
            tStr = "txtSFile=" & txtSFile.Text & ",txtDFile=" & txtDFile.Text
            subSaveTextFile tStr, App.Path & "\wsPara.dat", False
        End If
        
        subDealError ""         '强制保存日志文件
        End
    Else
        Cancel = 1
    End If
End Sub
'统一存储文本文件
'  2001/03/21
Private Sub subSaveTextFile(ByRef rStr As String, ByRef rFileName As String, ByVal vAppend As Boolean)
    Dim tFileNum As Long
    Dim i As Long
    Dim tC As Byte
    Dim tPos As Long
   
    Dim tRnd As Integer
    Dim tErrDescr As String
   
    On Error GoTo ErrPos
    tC = 1
    tFileNum = FreeFile
    If vAppend Then
        If Dir(rFileName) = "" Then tPos = 1 Else tPos = FileLen(rFileName) + 1
    Else
        If Dir(rFileName) <> "" Then
            Kill rFileName: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
            DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
        End If
        If Dir(rFileName) <> "" Then            '延时,等待删除
            For i = 1 To 10000: DoEvents: DoEvents: DoEvents: DoEvents: Next
        End If
        tPos = 1
    End If
    Open rFileName For Binary Access Write Lock Write As tFileNum
    DoEvents: DoEvents: DoEvents

    Put #tFileNum, tPos, rStr
    DoEvents: DoEvents: DoEvents
   
    Close tFileNum
    DoEvents: DoEvents: DoEvents
    Exit Sub
ErrPos:
    i = Err: tErrDescr = Error
    On Error Resume Next
    If i = 70 Then          'Code: 70,Descr:拒绝的权限
        '经实际测试,12000次下述循环需要时间为2秒左右
        Randomize:  tRnd = Int((3000 * Rnd) + 3000)         '3000-6000
        For i = 0 To tRnd: DoEvents: DoEvents: DoEvents: Next     '延时,以保证另外一个程序结束存盘后释放文件写锁
        tC = tC + 1
        If tC < 30 Then Resume
    End If
    tC = tC - 1
    mError = mError & CStr(Now) & ",SaveTextFile:" & rFileName & ", Resume:" & CStr(tC) & ", Code: " & CStr(i) & ",Descr:" & tErrDescr & vbCrLf
    Close tFileNum
End Sub
搜索更多相关主题的帖子: 语句 解释 
2009-09-09 10:48
粘土
Rank: 1
等 级:新手上路
帖 子:15
专家分:0
注 册:2009-9-4
收藏
得分:0 
回复 楼主 粘土
为了不让沉下去,自己先回复
2009-09-09 11:47
粘土
Rank: 1
等 级:新手上路
帖 子:15
专家分:0
注 册:2009-9-4
收藏
得分:0 
回复 楼主 粘土
怎么就没有人回帖呢
2009-09-09 14:27
粘土
Rank: 1
等 级:新手上路
帖 子:15
专家分:0
注 册:2009-9-4
收藏
得分:0 
2009-09-09 14:29
粘土
Rank: 1
等 级:新手上路
帖 子:15
专家分:0
注 册:2009-9-4
收藏
得分:0 
回复 5楼 天作被子地作床
多谢!
2009-09-10 16:27
快速回复:vb的几个过程语句需要解释
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.014089 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved