求救！谢谢！读写文件问题？

根据你的要求，我觉得用ini文件或数据库比较好处理

ini文件不就是和text文件一样吗？详细解释下好吗？谢谢！

Open d:\a.txt For Output As #1
        with aqueue
           Print #1,"Id:" & .id &"|Mobile:" &.Mobile &"|Context:" &.Coontext
        end with
    Close #1

在VB应用程序中使用INI文件的一点体会　
摘要：结合实例介绍了在VB中调用Windows API函数操作初始化文件的方法和优点．关键词：VB Windows API INI文件一、INI文件概述Windows INI文件,可解释为Windows初始化文件。它是一种专门用来保存应用程序初始化信息和运行环境信息的文本文件。例如Windows 3.1中两个著名的INI文件win.ini和system.ini就在Windows启动时定义了Windows环境中鼠标响应速度、使用的外壳(shell)程序等设置。Windows系统附带的许多应用程序也都有自己的INI文件,例如控制面板的INI 文件为control.ini,它也同样定义了控制面板的有关设置。ini文件是一种文本文件,它可以通过Notepad等文本编辑器进行编辑。ini文件具有特定的格式。一个INI文件是由若干个段(section)组成的,每个段中包含若干关键字(key)及相应的值(value)。段的格式如下:[SectionName]KeyName=Value其中SectionName和KeyName分别是段名和关键字名,Value为关键字对应的设定值。需要加以注意的是:(1)段名必须加以"["和"]",且"["必须在屏幕的第一列;(2)关键字名也必须从屏幕的第一列开始书写,且后面必须紧跟"=";(3)可以对文件加以注释,每行注释须以";"开头。在Windows中,可以通过手工编辑INI 文件来改变应用程序设置。如要想将Windows的外壳程序改为文件管理器,则可将system.ini中[boot]段下的"shell=progman.exe"改为"shell=winfile.exe"。有些设置也可以直接在应用程序界面上更改,但实际上也是通过修改INI文件来保存这些修改的。　二、在VB中操作INI文件的几个Windows API函数在开发应用程序时,我们可以创建应用程序自己的INI文件,通过INI文件保存应用程序的一些运行环境信息,然后在程序中读取INI文件中的设置信息并据以处理。一旦程序的运行环境需要变更,则可以通过直接修改INI文件或在程序中提供专门的界面间接地修改INI文件来保证程序的可用性。VB(Visual Basic)语言是近年来十分流行的一种面向对象的编程语言,但VB本身并不提供操纵INI文件的函数。所幸的是, VB支持DLL(Dynamic Link Library)的调用。(一个DLL事实上就是一个可供其它支持DLL调用的应用程序调用的外部函数集。)DLL中的函数称为API(应用编程接口,Application Programming Interface)函数。我们可以通过调用相应的API函数来实现操纵INI文件的功能。下面列出了相关的API函数及其说明。在使用这些函数之前,必须首先在VB的模块文件(.bas)中用Declare语句对它们进行声明。　三、实例分析下面就笔者参加天津财经学院教学办公自动化(OA)系统开发的实践介绍一下具体的实现方法。假定项目文件为man.mak,对应的INI文件为man.ini,其部分内容如下:　[数据库]文件名=\\DEC_LX5120\DB\OA.mdb[开户银行]类型数=3B1=中国人民银行B2=中国农业银行B3=中国工商银行　1. 在程序启动时(执行SUB MAIN()和SUB FORM_LOAD()),从man.ini文件中读取相应的值并进行以后的操作。其中SUB MAIN()中的有关代码如下:　Dim DbName as String*255 '数据库名Dim n as Integer'得到INI文件名,INIfileName为一全局变量INIfileName=App.Path&"\"&app.ExeName&".ini"'从man.ini中读取数据库文件名n=GetPrivateProfileString("数据库","文件名","",DbName,Len(DbName),INIfileName)DbName=Left(DbName,n)'打开数据库,Db为一全局变量Set Db=OpenDatabase(DbName)在FORM_LOAD()过程中,读取了man.ini中有关的内容并加入相应的组合框(Combo Box)列表中。这里只给出对"[开户银行]"段的相应操作,代码如下:Dim BankCount as Integer '银行类型数Dim BankName as String*255 '银行名Dim i as Integer,n as Integer'读取原有银行类型数BankCount=GetPrivateProfileInt("开户银行","类型数",0,INIfileName)'读取银行名并加入到组合框cmbBank中For I=1 to BankCountn=GetPrivateProfileString("开户银行","B"&i,BankName,Len(BankName),INIfileName)BankName=Left(BankName,n)cmbBank.AddItem BankNameNext I　2. 在程序中提供了一个专用维护界面,该界面通过操作INI文件的相应内容来实现相应的修改。　'下面代码实现数据库路径的修改Dim n as Integer'txtDbName.Text对应新的数据库文件名If txtDbName.Text="" ThenMsgBox "数据库文件名不能为空!",MB_ICONSTOP,App.TitletxtDbName.SetFocusExit SubElse'修改数据库文件名n=WritePrivateProfileString("数据库","文件名",txtDbName.Text,INIfileName)End If　'下面代码往组合框"开户银行"中增加一个新银行Dim NewBank as String '新银行名Dim BankCount as Integer '银行类型数Dim I as Integer,n as Integer'输入新银行名NewBank=InputBox("增加开户银行。",App.Title,"")If NewBank="" ThenMsgBox "银行名不能为空!",MB_ICONSTOP,App.TitleExit SubElse'判断输入的银行名是否已存在于列表中For I=0 to cmbBank.ListCount-1If NewBank=cmbBank.List(i) Then'存在则终止MsgBox NewBank&"已存在于列表中!",MB_ICONSTOP,App.Title)Exit SubEnd IfNext I'读取原银行类型数BankCount=GetPriVateProfileInt("开户银行","类型数",0,INIfileName)'将银行类型数增1BankCount=BankCount+1 n=WritePrivateProfileString("开户银行","类型数",Str(BankCount),INIfileName)'将新银行名写入INI文件中n=WritePrivateProfileString("开户银行","B"&BankCount,NewBank,INIfileName)End If　四、结论综上所述,在实际的VB应用程序开发中,适当地利用INI文件,可以很好地改善程序的可维护性和可用性。尤其在数据库访问中使用INI文件可使用户在数据库路径改变时免去修改原代码之苦。在实际开发中,若结合一定的维护界面,也可使应用程序容易维护,增强友好性。

huayuxing(huayuxing) ：怎么加？帮写点代码呀。
第一种方法：
Dim fso As New FileSystemObject, fil As File, ts As TextStream
        Set fil = fso.GetFile(PathName + FileName)

    Set ts = fil.OpenAsTextStream(ForWriting)
    ts.WriteLine (SentMobile + "  " + CStr(Now()))
    ts.close
第二种办法
Open PathName + FileName For Output As #1
      Write #1, SentMobile, Now(), Chr(10) + Chr(13)'这chr（10）+chr（13）写不进去help！！！！！！
close #1

每次写入一条都是会自动换行的
Private Sub Command1_Click()   '////////写入////////

     strtxt = "ID:" & queue.id & "|Mobile:" & queue.mobile & "|Context:" & queue.context & " " & Date & " " & Time

     Print #1, strtxt
End SubPrivate Sub Form_Load()
    Open "d:\test.txt" For Output Access Write Lock Write As #1
End Sub

楼上的嘿呀大哥，我怎么不可以呢？？
发一个做好的例子到我的mail里面来[email protected]
thank you

yoki(小马哥--鬓微霜，又何妨) 大哥，首先谢谢你，
我的程序不能做成ini格式呀。因为这不是开始就可以先设置好的呀。。
如果用数据库来实现也不是不可以，但是当时考虑就是用队列来实现的
所以暂时不考虑数据库的方式。。
另外，你这么说我也想起一个问题了就是我现在想写一个初始化文件。里面全是const类型的变量。。程序一加载就开始加载这些变量，请问这些变量应该写到什么里面？模块还是类？还是？？谢谢！

另小弟再问个问题，就是在txt中如何删除一行数据？？请大哥们帮帮忙哦。。

参考:
Option ExplicitPublic Type ClassRecord
   ClassName As Integer               ' 记录班级代号
   BookMax As Integer                 ' 记录科目的最大数
   'BookIcoID(1 To 16) As Integer     ' 记录科目图标代号与科目按钮INDEX对应
   ClssBookID(1 To 16) As Boolean      ' 记录科目代号与科目按钮INDEX对应
End Type
'----------------------------------------------------
'操作:
'
'1.在年级科目选择中,生成6个班级按钮,16个科目按钮
'2.在展开时,1 到科目最大数的安钮为可见,余下的不可见.
'3.在关闭时,全部科目按钮不可见.
'4.在访问数据库时,与按钮的标签有关,与其它无关.
'5.将文件记录成一个随机文件,在系统启动时加载
'--------------------------------------------------------------------------------Public Type UserSetup
       UserID As Integer          '用户ID号，即记录号
       UserLogName As String * 12 '用户登录系统的名称
       UserLogPass As String * 12 '用户登录密码
       UserLogExp As String * 255 '用户说明
       UserFnName As String * 60  '用户自设的字体名称
       UserFnSize As Integer
       UserBkColor As Long        '用户设定的背影色
       UserFnColor As Long        '用户设置的字体颜色
       UserPWidth As Long         '用户上课时的屏幕宽度
End TypePublic ScoClass(1 To 7) As ClassRecord
Public UserLogSetup As UserSetup '最大用户数量为500
Public UserClBo As UserSetup
''写一条记录到文件 [文件名文件记录号  记录]
Public Function WritClass(FileName As String, RecoID As Integer, RecoCla As ClassRecord)
  Dim FileID As Integer
  FileID = FreeFile
  Open FileName For Random As #FileID Len = Len(RecoCla)
       Put #FileID, RecoID, RecoCla
  Close #FileID
End Function'从文件读一条记录 [文件名记录号] =>返回一个记录
Public Function ReadClass(FileName As String, RecoID As Integer) As ClassRecord
  Dim RecoCla As ClassRecord
  Dim FileID As Integer
  FileID = FreeFile
  Open FileName For Random Access Read As #FileID Len = Len(RecoCla)
       Get #FileID, RecoID, RecoCla
  Close #FileID
  ReadClass = RecoCla
End Function'追加记录 [文件名  记录] =>记录号
Public Function AddRecord(FileName As String, RecoCla As ClassRecord) As Integer
  Dim AddId As Integer
  Dim FileID As Integer
  FileID = FreeFile
  Open FileName For Random As #FileID Len = Len(RecoCla)
       AddId = LOF(FileID) / Len(RecoCla) + 1
       Put #FileID, AddId, RecoCla
  Close #FileID
  AddRecord = AddId
End Function

上面的大哥，我还想问几个问题，第一个就是我一开始需要将我的文本文件的目录初始化，请问应该如何做？另外我还想删除txt中一条存在的数据，请问howto？谢谢

首先先谢谢各位大哥们的帮助，大体上的问题我都自己想办法解决了。
可能效率不是很好。但是最起码是解决了。现将方法贴出，供大家参考。
1，对用户自定义变量的封装
模块内MddefData:
Public Type Queue
         Id As Integer          '用作在现存的队列中相同手机发送的业务票数标志
         Mobile As Integer      '用作手机号
         Context As String      '用作接收数据内容
         Next As Integer        '用作指针场
End Type
类模块：Private aqueue As Queue
Private max As Integer
Private top1 As Integer '定义指向队头的指针变量
Private bottom As Integer '定义指向队尾的指针变量
Private bool As Boolean '解决个人消息发送两遍
Public count As Integer '用作对客户无返回的队列中有几个消息
Private i As Integer '用作循环使用
Private A() As QueuePublic Function CallInQueue(ByVal StrQueue As String) As Boolean
    Dim s As Queue
    s = StrToQueue(StrQueue)
    CallInQueue = InQueue(s)
End Function
Public Function CallOutQueue() As String
    aqueue = outQueue()
    CallOutQueue = QueueToStr(aqueue)
End Function
'实现作者：
'实现日期：
'功能：入队操作
'参数：传入一个普通消息结构
'返回：
Private Function InQueue(aqueue As Queue) As Boolean
    'aQueue.Id = 1
    If max = 0 And count = 0 Then                 '为了防止队列出现下溢初始化第一个元素
        ReDim Preserve A(max) As Queue
        A(0).Next = 0
        A(0).Mobile = aqueue.Mobile
        A(0).Id = aqueue.Id
        A(0).Context = aqueue.Context
        count = 1
        InQueue = True
    Else
        bool = True '解决个人消息发送两遍
        If count = max + 1 Then  '表示队列为满
            For i = 0 To max
                If A(i).Mobile = aqueue.Mobile _
                And Trim(A(i).Context) = Trim(aqueue.Context) Then
                '_And A(i).Id = aQueue.Id _Then                    bool = False

                                InQueue = False
                                MsgBox ("结果正在返回中，请发送其他的信息？")

                    Exit For
                    Exit Function
                ElseIf A(i).Mobile = aqueue.Mobile Then
                    aqueue.Id = aqueue.Id + 1
                End If
            Next i
            If bool = True Then     'inQueue
                max = max + 1

                ReDim Preserve A(max) As Queue

                A(top1).Next = max
                top1 = max
                A(top1).Mobile = aqueue.Mobile
                A(top1).Context = aqueue.Context
                A(top1).Id = aqueue.Id
                count = count + 1
                InQueue = True
            End If
        Else                            '表示队列不满还有空间
            For i = 0 To max
                If (i >= bottom And i <= A(top1).Next) Or (A(top1).Next <= i <= bottom) Then
                    If A(i).Mobile = aqueue.Mobile And Trim(A(i).Context) = Trim(aqueue.Context) Then
                        bool = False
                                InQueue = False
                                MsgBox ("结果正在返回中，请发送其他的信息？")
                        Exit For

                    ElseIf A(i).Mobile = aqueue.Mobile Then
                       aqueue.Id = aqueue.Id + 1
                    End If
                End If
            Next i
            If bool = True Then     'inQueue
                count = count + 1
                If top1 > bottom And top1 < max Then
                    A(top1 - 1).Next = top1
                    A(top1).Mobile = aqueue.Mobile
                    A(top1).Context = aqueue.Context
                    A(top1).Id = aqueue.Id
                    top1 = top1 + 1
                ElseIf top1 = max Then
                    If count = max + 1 Then             ' insert the last queuea(max)
                        A(top1 - 1).Next = top1
                        A(top1).Mobile = aqueue.Mobile
                        A(top1).Context = aqueue.Context
                        A(top1).Id = aqueue.Id
                            'top1 = a(top1).Next
                    Else
                        top1 = A(top1).Next             'insert a(0)
                        A(top1).Mobile = aqueue.Mobile
                        A(top1).Context = aqueue.Context
                        A(top1).Id = aqueue.Id
                        top1 = top1 + 1
                    End If
                ElseIf (bottom > top1) And (top1 > 0) Then
                    A(top1 - 1).Next = top1
                    A(top1).Mobile = aqueue.Mobile
                    A(top1).Context = aqueue.Context
                    A(top1).Id = aqueue.Id
                    top1 = top1 + 1
                ElseIf top1 = 0 Then
                    A(top1).Mobile = aqueue.Mobile
                    A(top1).Context = aqueue.Context
                    A(top1).Id = aqueue.Id
                    top1 = top1 + 1
                End If
                InQueue = True
            End If
        End If
    End If
End Function
'实现作者：
'实现日期：
'功能：出队操作
'参数：
'返回：传出一个普通消息结构
Private Function outQueue() As Queue
    Dim ProcQueue As Queue
    Dim temp
    If max = 0 Then
        If count = 1 Then
            bottom = A(bottom).Next   'bottom指针后移，为元素出队作准备
            ProcQueue.Next = bottom
            ProcQueue.Mobile = A(bottom).Mobile
            ProcQueue.Id = A(bottom).Id
            ProcQueue.Context = A(bottom).Context
            outQueue = ProcQueue

            Debug.Print "出队,b, i", bottom, A(bottom).Mobile, A(bottom).Id, A(bottom).Context            temp = InitQueue(A(bottom))
            count = count - 1
        Else
            Debug.Print "队空"
             top1 = 0
             bottom = 0
        End If

     Else
         If count = 1 Then
            Dim n

            ProcQueue.Next = A(bottom).Next
            ProcQueue.Mobile = A(bottom).Mobile
            ProcQueue.Id = A(bottom).Id
            ProcQueue.Context = A(bottom).Context
            outQueue = ProcQueue

            Debug.Print "出队,b, i", bottom, A(bottom).Mobile, A(bottom).Id, A(bottom).Context

            count = count - 1
            n = A(bottom).Next
            temp = InitQueue(A(bottom))
            A(bottom).Next = n
            top1 = 0
            bottom = 0
         Else
             If count = 0 Then    'bottom = top1队空

                Debug.Print "队空"

                top1 = 0
                bottom = 0
                A(top1).Next = 0
                A(bottom).Next = 0
            Else

                Dim k

                ProcQueue.Next = bottom
                ProcQueue.Mobile = A(bottom).Mobile
                ProcQueue.Id = A(bottom).Id
                ProcQueue.Context = A(bottom).Context
                outQueue = ProcQueue

                Debug.Print "出队,b, i", bottom, A(bottom).Mobile, A(bottom).Id, A(bottom).Context

                k = bottom
                bottom = A(bottom).Next   'bottom指针后移，为元素出队作准备
                temp = InitQueue(A(k))
                count = count - 1

            End If
         End If
    End If
    Set temp = Nothing
End Function

'实现作者：
'实现日期：
'功能：出列后将该元素初始化
'参数：传如一个消息结构
'返回：
Private Function InitQueue(tt As Queue)
    tt.Context = ""
    tt.Id = 0
    tt.Mobile = 0
    tt.Next = 0
End Function
'实现作者：
'实现日期：
'功能：change a Queue as a string
'参数：传入一个队列
'返回：用";"号连接起来的一个字符串
Private Function QueueToStr(tt As Queue) As String
    Dim s As String
    s = s + ""
    s = s + "Id:" + CStr(tt.Id) + "|"
    s = s + "Mobile:" + CStr(tt.Mobile) + "|"
    s = s + "Context:" + tt.Context
    QueueToStr = s
End Function
'实现作者：
'实现日期：
'功能：change a string as a Queue
'参数：传入一个字符串
'返回：用"|"号连接起来的一个字符串
Private Function StrToQueue(ByVal StrQueue As String) As Queue
    Dim d As Queue
    Dim splitArr() As String

        splitArr = Split(Trim(StrQueue), "|")
       If UBound(splitArr) < 2 Then
            MsgBox ("传入的格式有误！")
            Exit Function
        ElseIf (Left(Trim(splitArr(0)), 3) <> "Id:") Or (Left(Trim(splitArr(1)), 7) <> "Mobile:") Or (Left(Trim(splitArr(2)), 8) <> "Context:") Then
             MsgBox ("传入的Id,Mobile,Context格式有误！")
             Exit Function
        'ElseIf IsNumeric(Mid(Trim(splitArr(0)), 4, Len(Trim(splitArr(0))))) Or IsNumeric(Trim(Mid(splitArr(1)), 8, Len(Trim(splitArr(1))))) Then
        '    MsgBox ("传入的Id,Mobile内容错误！")
        '    Exit Function
        Else
            StrToQueue.Id = CInt(Mid(Trim(splitArr(0)), 4, Len(Trim(splitArr(0)))))
            StrToQueue.Mobile = CInt(Mid(Trim(splitArr(1)), 8, Len(Trim(splitArr(1)))))
            StrToQueue.Context = Mid(Trim(splitArr(2)), 9, Len(Trim(splitArr(2))))
            'StrToQueue = d
        End If

End Function

对文本文件操作的封装：读，写，删除其中一行的操作
CLSFunTxt
'实现作者：
'实现日期：
'功能：一行一行的读文本文件中数据
'参数：
'返回：返回出一个字符串数组
Public Function ReadTxt(ByVal PathName As String, ByVal TxtName As String, Optional ByVal pCreateFile As Boolean = False, Optional ByVal pFileNumber As Integer = 0) As String()
    '
    Dim tOutStrings() As String

    Dim tFileNumber As Integer
    Dim tFileNumberSet As Boolean

    Dim tEnter As String
    Dim tLoopExit As Boolean

    Dim tIndex As Long

    Dim tReadString As String
    'Dim splitArr() As String
    '检验文件是否存在
    If Not (IfCreateTxt(PathName, TxtName)) Then Exit Function

    '如果没有设置文件号则自动分配一个
    tFileNumberSet = pFileNumber > 0
    tFileNumber = (CInt(FreeFile) And Not tFileNumberSet) + pFileNumber

    tLoopExit = False
    tEnter = Chr(13) & Chr(10)

    Open Trim(PathName) + Trim(TxtName) For Input As #tFileNumber
      'If Not EOF(tFileNumber) Then
      'Do Until tLoopExit
        Do While Not EOF(tFileNumber)
          Line Input #tFileNumber, tReadString

          ReDim Preserve tOutStrings(tIndex)
         ' splitArr = Split(tReadString, "|")
         ' tOutStrings(tIndex).Id = CInt(Mid(splitArr(0), 4, Len(splitArr(0))))
         ' tOutStrings(tIndex).Mobile = CInt(Mid(splitArr(1), 8, Len(splitArr(1))))
         ' tOutStrings(tIndex).Context = Mid(splitArr(2), 9, Len(splitArr(2)))
          tOutStrings(tIndex) = tReadString
          tIndex = tIndex + 1
         ' tLoopExit = EOF(tFileNumber)

        Loop
      'End If
    Close #tFileNumber

    ReadTxt = tOutStrings
End Function'实现作者：
'实现日期：
'功能：判断是否存在txt，如果不存在则生成
'参数：传入需要生成文件的名字
'返回：Public Function IfCreateTxt(ByVal PathName As String, ByVal FileName As String) As Boolean
    Dim fso
    If Dir(Trim(PathName) + Trim(FileName)) = "" Then
        If MsgBox("文本文件不存在，是否生成文件？", vbOKCancel, 确认框) = vbOK Then


            Set fso = CreateObject("Scripting.FileSystemObject")
            fso.CreateTextFile (PathName + FileName)
           IfCreateTxt = True
           MsgBox ("生成文件" + PathName + FileName + "成功!")
        End If
    Else
        IfCreateTxt = True
    End If
End Function
'实现作者：
'实现日期：
'功能：将队列写入指定的文本文档中,将接受到的字符串按格式写入文本文件
'参数：
'返回：
Public Function WriteTxt(ByVal SentMobile As String, ByVal PathName As String, ByVal FileName As String)


    Dim fso As New FileSystemObject, fil As File, ts As TextStream
        Set fil = fso.GetFile(PathName + FileName)

    Set ts = fil.OpenAsTextStream(ForWriting)
        ts.WriteLine (SentMobile)
    ts.Close
End Function
'实现作者：
'实现日期：
'功能：根据socket接收的字符串来删除文本中的这条队列消息
'参数：传入需接收的文字的名字
'返回：
Public Function DelTxt(ByVal RecQueue As String, ByVal PathName As String, ByVal FileName As String)
    Dim arr() As String
    Dim i, j As Integer, TxtStr As String
    Dim temp
On Error GoTo ErrorPro
    temp = ReadTxt(PathName, FileName)

    For i = 0 To UBound(temp)
        If Trim(temp(i)) = Left(Trim(RecQueue), Len(Trim(temp(i)))) Then
            j = j - 1
        Else
            ReDim Preserve arr(j)
            arr(j) = Trim(temp(i))
        End If
        j = j + 1
    Next i
    TxtStr = Join(arr, vbCrLf)
    'TxtStr =TxtStr +
    temp = WriteTxt(TxtStr, PathName, FileName)
    Set temp = Nothing
ErrorPro:
        MsgBox ("文件" + PathName + FileName + "为空！！")
End Function'实现作者：
'实现日期：
'功能：在TXT中判断Q.id是否存在
'参数：传入需接收的文件的名字,文件名
'返回：如果存在则取出该列值，否则返回Q.Id = 0
Public Function ReadTxtId(QueueStr As String, ByVal PathName As String, ByVal FileName As String) As Integer
    Dim i As Integer
    Dim tOutStrings() As String
    Dim bool As Boolean
    tOutStrings = ReadTxt(PathName, FileName)

    For i = 0 To UBound(tOutStrings)

        If Trim(tOutStrings(i)) = Trim(QueueStr) Then
            bool = True
            Exit For
            'ReadTxtId = 0
        End If
    Next i
    If bool <> True Then
        ReadTxtId = 0
    End If
End Function

2，公有变量的声明
Global Const PathName = "c:\ "
Global Const ComputerName = "xutingyu"
Global Const RemotePort = 1000
Global Const FileNameN = "tidy.txt"
Global Const FileNameQ = "Quick.txt"
Global Const FileNameR = "Reply.txt"

主窗体调用：
Dim temp
Private objNFunQueue As New ClsFunQueue
Private objRFunQueue As New ClsFunQueue
Private objQFunQueue As New ClsFunQueue
Private objFunTxt As New ClsFunTxt
Private Sub Command1_Click()End SubPrivate Sub Form_Load()

    sckClient.RemoteHost = ComputerName
    sckClient.RemotePort = RemotePort
        On Error GoTo ErrorPro
        sckClient.Connect   'confirm the server is opened
        Exit Sub
ErrorPro:
        MsgBox "服务器未开或网络出错！"
        End
End Sub

Private Sub sckClient_Close() '   Dim i As Integer
'   Dim l As Queue

    MsgBox "服务器通道已关闭！"

   ' For i = 0 To count
   '  l = outQueue()
   ' temp = WriteTxt(l)
   ' Next i

End SubPrivate Sub sckClient_Connect()
    Dim bool1, bool2, bool3 As Boolean
    Dim linshiN, linshiQ, linshiR
    Dim i As Integer
    Dim j, k, m
    'linshiR = objFunTxt.ReadTxt("c:\", "tidy.txt")
    'linshiN = objFunTxt.ReadTxt("c:\", "Normal.txt")
    'linshiQ = objFunTxt.ReadTxt("c:\", "Quick.txt")
    MsgBox "连接成功！"
    If (objFunTxt.IfCreateTxt(PathName, FileNameN) = False) Or (objFunTxt.IfCreateTxt(PathName, FileNameR) = False) _
    Or (objFunTxt.IfCreateTxt(PathName, FileNameQ) = False) Then
        Exit Sub
    Else
        j = objFunTxt.ReadTxt(PathName, FileNameN)
        k = objFunTxt.ReadTxt(PathName, FileNameR)
        m = objFunTxt.ReadTxt(PathName, FileNameQ)
    On Error GoTo ErrorPro
            For i = 0 To UBound(j)
                linshiN = j(i)
                bool1 = True
                'MsgBox (CStr(linshiR))
                temp = objNFunQueue.CallInQueue(linshiN)
                If temp = False Then Exit For
                'Debug.Print "pbInQueue", PbInQueue.Next, PbInQueue.Id, PbInQueue.Mobile, PbInQueue.Context
            Next i            For i = 0 To UBound(k)
                linshiR = k(i)
                bool2 = True
                temp = objRFunQueue.CallInQueue(linshiR)
                If temp = False Then Exit For
                'Debug.Print "pbInQueue", PbInQueue.Next, PbInQueue.Id, PbInQueue.Mobile, PbInQueue.Context
            Next i            For i = 0 To UBound(m)
                linshiQ = m(i)
                bool3 = True
                temp = objQFunQueue.CallInQueue(linshiQ)
                If temp = False Then Exit For
                'Debug.Print "pbInQueue", PbInQueue.Next, PbInQueue.Id, PbInQueue.Mobile, PbInQueue.Context
            Next i

    End If
ErrorPro:
        If bool1 <> True Then
            MsgBox ("文件" + PathName + FileNameN + "为空，读入失败")
        ElseIf bool2 <> True Then
            MsgBox ("文件" + PathName + FileNameR + "为空，读入失败")
        ElseIf bool3 <> True Then
            MsgBox ("文件" + PathName + FileNameQ + "为空，读入失败！")
        End If
End SubPrivate Sub sckClient_DataArrival(ByVal bytesTotal As Long)    'Dim RecData As Queue
    Dim f As String
    Dim StrTxt As String
    Dim linshi
    sckClient.GetData f
    f = f & "|" & Time
    lstReceive.AddItem f    '将这条消息发送到客户
    'if need reply this information,then sent this information to another queue
    'at the same time,create another txt for it

    temp = objFunTxt.DelTxt(f, PathName, FileNameN)
    'If t(3) = "Channel0" Then ' if right(s, 1) = "R"

        linshi = objFunTxt.ReadTxt(PathName, FileNameR)

        StrTxt = Join(linshi, vbCrLf)
        StrTxt = StrTxt & vbCrLf & f
        temp = objFunTxt.WriteTxt(StrTxt, PathName, FileNameR)
        temp = objRFunQueue.CallInQueue(f)
    'End If
    ' if t(3) = "q" then
    '   temp = objFunTxt.WriteTxt(s, "C:\", "Quick.TXT")
    '   RecData.Id = CInt(Mid(splitArr(0), 4, Len(splitArr(0))))
    '    RecData.Mobile = CInt(Mid(splitArr(1), 8, Len(splitArr(1))))
    '    RecData.Context = Mid(splitArr(2), 9, Len(splitArr(2)))
    '    PbInQueue = RecData
    '    temp = objRFunQueue.CallInQueue()
    ' endif
End SubPrivate Sub sckClient_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)    sckClient.Close
    MsgBox "服务器未开或网络出错！"
End SubPrivate Sub Timer1_Timer()
    Dim q As String
    Dim temp
    If objQFunQueue.count > 0 Then        If objFunTxt.IfCreateTxt(PathName, FileNameQ) = False Then
            Exit Sub
        End If

        q = objQFunQueue.CallOutQueue()

        temp = objFunTxt.WriteTxt(q, PathName, FileNameQ)
        sckClient.SendData q

    ElseIf objRFunQueue.count > 0 Then

        If objFunTxt.IfCreateTxt(PathName, FileNameR) = False Then
            Exit Sub
        End If

        q = objRFunQueue.CallOutQueue()

        temp = objFunTxt.WriteTxt(q, PathName, FileNameR)
        sckClient.SendData q

    ElseIf objNFunQueue.count > 0 Then

        If objFunTxt.IfCreateTxt(PathName, FileNameN) = False Then
            Exit Sub
        End If

        q = objNFunQueue.CallOutQueue()

        temp = objFunTxt.WriteTxt(q, PathName, FileNameN)
        sckClient.SendData q

    End If
    Set temp = Nothing
End Sub

小弟初次用vb，而且手上没有msdn。花了不少时间来找这些，特意发出一些基本点的代码，帮助刚学vb的人。希望对你们有所帮助。
上面大概实现了这些功能，写一个自定义队列。用来先进先出。
同时写文本，实现追加，删除，其中一行的信息，同时判断一行中的信息。
这里我想和大家交流下，就是我现在写文本的时候是否需要开一个线程来实现？
据说vb对开线程很不安全？
另有谁有vb可以调用发手机短信的控件吗？小弟急用。请大家帮忙哦。谢谢！！
请发到[email protected],重谢！

这两天发现上面代码问题多多。不过小弟刚进入门心中也感觉挺舒服的。。
希望大家帮帮我呀
我现在需要接收手机发过来的信息，然后用 socket发到另一个服务器中，需要能和服务器交互，请问在什么地方需要使用线程？还是另有它招，，，请大侠帮忙。。谢谢哦。你们不会看到一个刚学vb的人夭折吧help me ！！thank you！！

气死了。妈的转行做vb.net了。

调试易

求救！谢谢！读写文件问题？

解决方案 »