vb_dos.frm

VB6 Consol Window Demo

                        Print "文件已移动成功!"
                Else
                        Print "文件未找到."
                        GoTo DosPrompt
                    End If
                    
            ElseIf Left$(CmdStr, 6) = "NU2EN " Then          '//* NU2EN  * //
                    ParStr = Right$(CmdStr, Len(CmdStr) - 6)
                    Print "数字:"; Val(ParStr); "翻译成英文是:"; NU2EN.ToWords(ParStr)
                    
            ElseIf Left$(CmdStr, 3) = "RD " Then             '//* RD    * //
                    DirN = Right$(CmdStr, Len(CmdStr) - 3)
                    If Dir$(DirN, vbDirectory) <> "" Then
                        RmDir DirN                                 '删除目录
                        Print "目录"; DirN; "已删除."
                Else
                        Print "目录"; DirN; "不存在"
                    End If
                    
            ElseIf Left$(CmdStr, 6) = "RMDIR " Then           '//* RmDir * //
                    DirN = Right$(CmdStr, Len(CmdStr) - 6)
                    If Dir$(DirN, vbDirectory) <> "" Then
                        RmDir DirN                                  '删除目录
                        Print "目录"; DirN; "已删除."
                Else
                        Print "目录"; DirN; "不存在"
                    End If
                    
            ElseIf Left$(CmdStr, 16) = "SETATTRREADONLY " Then '//* SETATTRREADONLY *//
                    FileN = Right$(CmdStr, Len(CmdStr) - 16)
                    If Dir$(FileN) = "" Then
                        Print "文件未找到."
                        GoTo DosPrompt
                    End If
                    SetAttr FileN, vbReadOnly                       '将文件设为只读
                    
            ElseIf Left$(CmdStr, 14) = "SETATTRHIDDEN " Then   '// * SETATTRHIDDEN * //
                    FileN = Right$(CmdStr, Len(CmdStr) - 14)
                    If Dir$(FileN) = "" Then
                        Print "文件未找到."
                        GoTo DosPrompt
                    End If
                    SetAttr FileN, vbHidden                         '将文件设为隐藏
                    
            ElseIf Left$(CmdStr, 14) = "SETATTRSYSTEM " Then   '// * SETATTRSYSTEM *//
                    FileN = Right$(CmdStr, Len(CmdStr) - 14)
                    If Dir$(FileN) = "" Then
                        Print "文件未找到."
                        GoTo DosPrompt
                    End If
                    SetAttr FileN, vbSystem                         '将文件设为系统
                    
            ElseIf Left$(CmdStr, 5) = "TYPE " Then             '//* TYPE  *//
                    FileN = Right$(CmdStr, Len(CmdStr) - 5)
                    If Dir$(FileN) = "" Then
                        Print "文件未找到."
                        GoTo DosPrompt
                    End If
                    Open FileN For Input As #1                      '显示文件内容
                    Do Until EOF(1) = -1
                        Line Input #1, tmpStr
                        Print tmpStr
                    Loop
                    Close #1
            Else                                               '结束命令处理
                    Print "错误的命令或文件名."
                End If
        End Select
        '/=====================/
        '/*执行完命令回到提示符*/
        '/====================/
DosPrompt:
        CmdStr = ""
        Print CurDir$ & ">";
    Else                                         '//*如果不是回车则继续输入*//
        CmdStr = CmdStr & Chr(keyascii)
    End If
    Exit Sub                                     '退出子程式
    
ErrHandel:                                           '错误处理,显示错误代码
    Close                                        '关闭可能已打开但因出错未来得及关闭的文件
    j = Me.ForeColor                             '记忆旧的色彩
    Me.ForeColor = QBColor(12)                   '显示红色的错误提示
    Print "命令未完成! 错误代码:"; Err; "错误信息:"; Error
    Me.ForeColor = j                             '恢复色彩
    GoTo DosPrompt
    
End Sub
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：Form_Load
'+----+----+--- 参数： 无
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub Form_Load()
    On Error Resume Next
    Me.Hide
    If App.PrevInstance Then                     '防止系统重复运行
        MsgBox "VB_DOS系统已运行!", vbOKOnly, "错误"
        End
    End If
    Set NU2EN = New CNU2EN                       '初始化类模块
    Me.ScaleMode = 4                             '设定工作模式为字符
    Label1.Height = 1                            '初始化光标
    Label1.Width = 0
    Me.ForeColor = QBColor(10)                   '设定光标与前景色彩
    For i = 1 To Me.Width / 120                  '初始化窗体
        Me.Show
        Me.Refresh
        Me.Width = 120 * i
        Me.Height = 90 * i
        Me.Left = Screen.Width / 2 - Me.Width / 2
        Me.Top = Screen.Height / 2 - Me.Height / 2
        DoEvents
    Next i
    Me.Caption = Me.Caption & "Ver" & GetAppVer & " Written by ZHB - http://yxbasic.51.net"
    Print
    Print "红兵Visual BASIC 编程成果 VB Dos Ver" & GetAppVer
    Print "   Copyright(C) 2001-2006 ZHB"
    Print
    Print CurDir$ & ">";                         '显示提示符
    Label1.Visible = True
    Timer1.Enabled = True                        '显示光标
End Sub
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：Form_Unload
'+----+----+--- 参数：Cancel 为Integer)       '退出窗体时执行 // 不过在窗体为最大化时失型
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub Form_Unload(Cancel As Integer)       '退出窗体时执行 // 不过在窗体为最大化时失效
    Call ExitPrg
End Sub
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：Timer1_Timer
'+----+----+--- 参数：) 为                   '形成光标闪型
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub Timer1_Timer()                       '形成光标闪烁
    Static Flag As Boolean
    If Flag = False Then
        Label1.BackColor = vbBlack
        Flag = True
    Else
        Label1.BackColor = vbWhite
        Flag = False
    End If
    Label1.Move CurrentX, CurrentY
End Sub
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：FileList
'+----+----+--- 参数：) 为                       '列出当前目录下所有的文型
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub FileList()                           '列出当前目录下所有的文件
    
    Dim MyPath As String                           '定义本子程式内所要用的变量
    Dim MyName As String
    Dim TotalSize As Long
    
    '确定是否为根目录
    If Mid$(CurDir$, Len(CurDir), 1) = "\" Then
        MyPath = CurDir$
    Else
        MyPath = CurDir$ & "\"
    End If
    '列出当前目录文件
    MyName = Dir(MyPath, vbNormal)
    i = 0
    TotalSize = 0
    Print "在目录" & App.Path & "下"
    Print String$(64, "-")
    Do While MyName <> ""
        '计算文件个数并输出
        i = i + 1
        TotalSize = TotalSize + FileLen(MyName)
        Print Space(2) & MyName & Space(48 - Len(MyName)) & FileLen(MyName) & "个字节"
        MyName = Dir            '---^这里令输入格式更整齐
    Loop
    Print String$(64, "-")
    Print "共" & i & "个文件,占用空间" & TotalSize & "个字节"
End Sub
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：ExitPrg
'+----+----+--- 参数：) 为      '退出效果处理型
'+----+----+--- 参数：渐缩小  类型不确定
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub ExitPrg()          '退出效果处理,逐渐缩小式
    On Error Resume Next
    For i = Me.Width / 120 To 1 Step -1
        Me.Show
        Me.Refresh
        Me.Width = 120 * i
        Me.Height = 90 * i
        Me.Left = Screen.Width / 2 - Me.Width / 2
        Me.Top = Screen.Height / 2 - Me.Height / 2
        DoEvents
    Next i
    End
End Sub
    '取得系统版本
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：GetOSVersion
'+----+----+--- 参数： 无
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub GetOSVersion()
    ExeName = App.ExeName & ".exe"
    Print "系统版本:"; Trim$(GetAppVer)
    Print "系统核心:"; ExeName
    Print "编译时间:"; FileDateTime(ExeName)
End Sub
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：GetWeekName
'+----+----+--- 参数： 无
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub GetWeekName()
    
    Dim WeekName As String      '定义本子程式内所要用的变量
    
    Select Case Weekday(Now) - 1
            '-1是因为星期天是第一天
        Case 0
            WeekName = "天"
        Case 1
            WeekName = "一"
        Case 2
            WeekName = "二"
        Case 3
            WeekName = "三"
        Case 4
            WeekName = "四"
        Case 5
            WeekName = "五"
        Case 6
            WeekName = "六"
    End Select
    Print "今天是星期" & WeekName
End Sub
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：GetDriveList
'+----+----+--- 参数：) 为'显示当前驱动器数型
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Private Sub GetDriveList()    '显示当前驱动器数目
    Print "当前系统的有:"
    For i = 0 To Drive1.ListCount
        Print Drive1.List(i)
    Next i
    Print "共" & i - 1 & "个可用的驱动器"
End Sub
    '取得文件属性信息
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 函数名称：GetAttrInfo
'+----+----+--- 参数：VarInt 为Integer型
'As String'+----+----+--- 返回类型：As String
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Function GetAttrInfo(VarInt As Integer) As String
    Select Case VarInt
        Case 0
            GetAttrInfo = "普通文件"
        Case 1
            GetAttrInfo = "只读文件"
        Case 2
            GetAttrInfo = "隐藏文件"
        Case 3                            '=> 1+2
            GetAttrInfo = "只读/隐藏文件"
        Case 4
            GetAttrInfo = "系统文件"
        Case 5                            '=> 1+4
            GetAttrInfo = "只读/系统文件"
        Case 6                            '=> 2+4
            GetAttrInfo = "隐藏/系统文件"
        Case 7                            '=> 1+2+4
            GetAttrInfo = "只读/隐藏/系统文件"
        Case 8
            GetAttrInfo = "目录"
        Case Else
            GetAttrInfo = "存档"
    End Select
End Function
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 函数名称：GetAppVer
'+----+----+--- 参数： 无
'As String                                                   '取得程式版本'+----+----+--- 返回类型：As String                                                   '取得程式版本
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Function GetAppVer() As String                                                   '取得程式版本
    
    Dim Maj As String       '定义本子程式内所要用的变量
    Dim Min As String
    Dim Rev As String
    
    Maj = Str$(App.Major)                                                          '主修版本不变，次修与修订版本补0
    Min = String$(2 - Len(Trim$(Str$(App.Minor))), "0") + Trim$(Str$(App.Minor))
    Rev = String$(4 - Len(Trim$(Str$(App.Revision))), "0") + Trim$(Str$(App.Revision))
    GetAppVer = Maj & "." & Min & "." & Rev
End Function
    
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
'+----+----+--- 过程名称：Disp99TAB
'+----+----+--- 参数：) 为                                                              '显示九九乘法型
'+----+----+----+----+----+----+----+----+----+----+----+----+----+
Sub Disp99TAB()                                                                  '显示九九乘法表
    
    Dim a As Integer           '定义本子程式内所要用的变量
    Dim b As Integer
    Dim c As Integer
    
    Print , "--- 九九乘法表 ---"
    For a = 1 To 9
        For b = 1 To 9
            Print a; "*"; b; "="; a * b,
        Next b
        Print
    Next a
    Print
End Sub