formsetup.frm

用来打电话的程序

         Top             =   720
         Width           =   1455
      End
      Begin VB.Label Labelport 
         Alignment       =   2  'Center
         Caption         =   "卡号："
         Height          =   255
         Index           =   7
         Left            =   120
         TabIndex        =   19
         Top             =   1200
         Width           =   735
      End
      Begin VB.Label Labelport 
         Alignment       =   2  'Center
         Caption         =   "卡名："
         Height          =   255
         Index           =   6
         Left            =   120
         TabIndex        =   17
         Top             =   360
         Width           =   735
      End
   End
End
Attribute VB_Name = "formsetup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ming1(0 To 200), phone1(0 To 200), str1(0 To 200), phoneline1, m
Dim cardname(1 To 200), cardnumber(1 To 200), cardlines As Integer
Private Sub add(filename As String, content As String)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfile(filename)
     Set ts = f.openastextstream(ForAppending, TristateUseDefault)
    ts.writeline content
    ts.Close
End Sub
Private Sub removeline(filename As String, content As String)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts, str2(200), mark
        Open filename For Input As #3
            i = 0
                Do Until EOF(3)
                Line Input #3, str2(i)
                    s = str2(i) + Chr(13) + Chr(10)
                    i = i + 1
                 lines = i
                 If str2(i) = content Then mark = i
                 Loop
        Close #3
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfile(filename)
    Set ts = f.openastextstream(ForWriting, TristateUseDefault)
    
    For i = mark To lines
    str2(i) = str2(i + 1)
    Next
    For i = 0 To lines - 2
    ts.writeline str2(i)
    Next
    ts.Close
End Sub
Private Sub readphonebook()
        Dim str1(200)
        Open "phonebook.txt" For Input As #3
        i = 0
            Do Until EOF(3)
            Line Input #3, str1(i)
            If str1(i) = Null Then Exit Sub
                s = str1(i) + Chr(10)
                i = i + 1
             phoneline1 = i
            Loop
            '从数组中分出姓名与电话号
    Close #3
            For i = 0 To phoneline1 - 1
            ming1(i) = Mid(str1(i), 1, InStr(1, str1(i), ",", vbTextCompare) - 1)
            phone1(i) = Mid(str1(i), InStr(1, str1(i), ",", vbTextCompare) + 1, Len(str1(i)) - InStr(1, str1(i), ",", vbTextCompare))
            Next
End Sub
Private Sub readbook(filenameS As String, arg2(), arg3(), booklines As Integer)
Dim arg1(1 To 200)
Open filenameS For Input As #3
            i = 1
            Do Until EOF(3)
            Line Input #3, arg1(i)
            If arg1(i) = Null Then Exit Sub
                s = arg1(i) + Chr(10)
                booklines = i
                i = i + 1
            Loop
    Close #3
            For i = 1 To booklines
            arg2(i) = Mid(arg1(i), 1, InStr(1, arg1(i), ",", vbTextCompare) - 1)
            arg3(i) = Mid(arg1(i), InStr(1, arg1(i), ",", vbTextCompare) + 1, Len(arg1(i)) - InStr(1, arg1(i), ",", vbTextCompare))
            Next
End Sub



Private Sub Checkcard_Click()
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fs, f, ts
Set fs = CreateObject("Scripting.FileSystemObject")
    If Checkcard.Value = Checked Then
    Set f = fs.openTextFile("usingcard.txt", ForWriting, False)
    f.writeline combocard(4).Text
    f.Close
    Else
    removeline "usingcard.txt", combocard(4).Text
    End If
End Sub

Private Sub Commandok_Click(Index As Integer)
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f, ts
Select Case Index
Case 0
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.FileExists("system.txt") Then
    Set f = fs.CreateTextFile("system.txt", False, False)
    f.writeline 3
    f.writeline "9600,N,8,1"
    f.Close
    End If
    Set f = fs.getfile("system.txt")
     Set ts = f.openastextstream(ForWriting, TristateUseDefault)
    ts.writeline comboport(0).Text
    ts.writeline comboport(1).Text + "," + comboport(2).Text + "," + comboport(3).Text + "," + comboport(4).Text
    ts.Close
    formsetup.Hide
Case 1
formsetup.Hide
Case 2
            If combocard(0).Text = "" Or combocard(1).Text = "" Then MsgBox "请正确输入卡名和电话卡号码", vbOKOnly, "注意": Exit Sub
            readbook "cardbook.txt", cardname(), cardnumber(), cardlines
            For i = 1 To cardlines
            If cardname(i) = combocard(0).Text And cardnumber(i) = combocard(1).Text Then
            MsgBox "卡号已经存在，您确定要添加么？", vbYesNo, "请确认"
            Exit Sub
            End If
            Next
            add "cardbook.txt", combocard(0).Text + "," + combocard(1).Text
            combocard(0).AddItem combocard(0).Text, cardlines
            combocard(1).AddItem combocard(1).Text, cardlines
            combocard(4).AddItem combocard(1).Text, cardlines
          
Case 3
            removeline "cardbook.txt", combocard(0).Text + "," + combocard(1).Text
            readbook "cardbook.txt", cardname(), cardnumber(), cardlines
            If cardlines = 0 Then MsgBox "已无卡号记录", vbOKOnly, "提示": Exit Sub
            combocard(0).RemoveItem cardlines
            combocard(1).RemoveItem cardlines
            combocard(4).RemoveItem cardlines
           If cardlines = 0 Then
           combocard(0).Text = ""
            combocard(1).Text = ""
            combocard(4).Text = ""
            Else
            combocard(0).Text = cardname(cardlines)
            combocard(1).Text = cardnumber(cardlines)
            combocard(4).Text = cardnumber(cardlines)
            End If
Case 4
        If combocard(0).Text = "" Or combocard(1).Text = "" Then MsgBox "请正确输入姓名和电话号码", vbOKOnly, "注意": Exit Sub
        readphonebook
            For i = 0 To phoneline1 - 1
            If combocard(2).Text = ming1(i) And combocard(3).Text = phone1(i) Then
            t = MsgBox("联系人已经存在，您确定要添加么？", vbYesNo, "请确认")
            If t Then
            Exit For
            Else: Exit Sub
            End If
            End If
            Next
        add "phonebook.txt", combocard(2).Text + "," + combocard(3).Text
        readphonebook
            For i = 0 To phoneline1 - 1
            combocard(2).AddItem ming1(i), i
            combocard(3).AddItem phone1(i), i
            Next
          
Case 5
        readphonebook
        Do Until combocard(2).Text = ming1(i) Or i = 200
        line2 = i
        i = i + 1
        Loop
        If phone1(line2) = combocard(3).Text Then
        removeline "phonebook.txt", ming1(line2) + "," + phone1(line2)
        Else
        removeline "phonebook.txt", ming1(line2) + "," + phone1(line2)
        add "phonebook.txt", combocard(2).Text + "," + combocard(3).Text
        End If
        readphonebook
            For i = 0 To phoneline1 - 1
            combocard(2).AddItem ming1(i), i
            combocard(3).AddItem phone1(i), i
            Next
End Select

          
End Sub

Private Sub Form_Load()
    
  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts(1), cardstate
    Dim com(15)
For i = 0 To 15
com(i) = "com" & i + 1
comboport(0).AddItem i, i
Next
comboport(0).Text = 7
comboport(1).AddItem 75, 0
comboport(1).AddItem 110, 1
comboport(1).AddItem 134, 2
comboport(1).AddItem 150, 3
comboport(1).AddItem 300, 4
comboport(1).AddItem 600, 5
comboport(1).AddItem 1200, 6
comboport(1).AddItem 1800, 7
comboport(1).AddItem 2400, 8
comboport(1).AddItem 4800, 9
comboport(1).AddItem 9600, 10
comboport(1).AddItem 14400, 11
comboport(1).AddItem 19200, 12
comboport(1).AddItem 38400, 13
comboport(1).AddItem 57600, 14
comboport(1).AddItem 115200, 15
comboport(1).AddItem 128000, 16
comboport(1).Text = 9600
comboport(3).AddItem 4, 0
comboport(3).AddItem 5, 1
comboport(3).AddItem 6, 2
comboport(3).AddItem 7, 3
comboport(3).AddItem 8, 4
comboport(3).Text = 8
comboport(2).AddItem "E", 0
comboport(2).AddItem "O", 1
comboport(2).AddItem "N", 2
comboport(2).AddItem "M", 3
comboport(2).AddItem "S", 4
comboport(2).Text = "N"
comboport(4).AddItem 1, 0
comboport(4).AddItem 1.5, 1
comboport(4).AddItem 2, 2
comboport(4).Text = 1
comboport(5).AddItem "xon/xoff", 0
comboport(5).AddItem "hardware", 1
comboport(5).AddItem "none", 2
comboport(5).Text = "none"
            readphonebook
            For i = 0 To phoneline1 - 1
            combocard(2).AddItem ming1(i), i
            combocard(3).AddItem phone1(i), i
            Next
             Set fs = CreateObject("Scripting.FileSystemObject")
            If Not fs.FileExists("CARDBOOK.txt") Then
            Set f = fs.CreateTextFile("CARDBOOK.txt", False, False)
            f.Close
            End If
            readbook "cardbook.txt", cardname(), cardnumber(), cardlines
            For i = 1 To cardlines
            combocard(0).AddItem cardname(i), i - 1
            combocard(1).AddItem cardnumber(i), i - 1
            combocard(4).AddItem cardnumber(i), i - 1
            Next
    Open "usingcard.txt" For Input As #1
     If Not EOF(1) Then
        Line Input #1, cardstate
        If cardstate = "" Then
        Checkcard.Value = Unchecked
        combocard(4).Text = ""
        Else
        Checkcard.Value = Checked
        combocard(4).Text = cardstate
        End If
    Close #1
    End If
End Sub