求解关于自由截取文本文件内容的程序!

公司现在需要一个可以自由截取文本文件内容的软件!我想用VB编!
我们现在用VB读写文本文件用的都是filesystemobject,但是我发现FSO里面不能读取指定行数的内容!也许我没找到吧!我知道一个seek可以当作指针来用!但他怎么和FSO一起用呢?我想了一天了!还没想出来!请大虾们帮帮我!我现在做的只能第一次自由截取,后来就无法接着截取了!不知道怎么确定下一个截取时的开始地址!
原始数据:           输出文本1:          输出文本2:
5789528462158700    5789528462158700     5789528462158710
5789528462158701    5789528462158701          .
5789528462158702    5789528462158702          .  
5789528462158703    5789528462158703          .
5789528462158704    5789528462158704          . 
5789528462158705    5789528462158705          .
5789528462158706    5789528462158706          .
5789528462158707    5789528462158707     5789528462158724    
5789528462158708    5789528462158708
5789528462158709    5789528462158709         
5789528462158710     共十行                  共十五行
5789528462158711
5789528462158712
5789528462158713
5789528462158714
5789528462158715
5789528462158716
5789528462158717
5789528462158718
5789528462158719
5789528462158720
5789528462158721
5789528462158722
5789528462158723
5789528462158724
共25行!
不知道我写的清楚不清楚!
求解关于自由截取文本文件内容的程序!

解决方案 »

  1.   

    To luoxi1124(罗希):　　我在这里已经给了回答，去看看吧：　　http://community.csdn.net/Expert/topic/4149/4149381.xml?temp=.8323938　
     
    　　下面我公布以前写的源代码：模块 mGetTextLinesPrivate Const EM_GETLINECOUNT = &HBA
    Private Const EM_GETLINE = &HC4
    Private Const EM_LINEINDEX = &HBB
    Private Const EM_LINELENGTH = &HC1Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)Private Const EM_GETSEL = &HB0
    Private Const EM_LINEFROMCHAR = &HC9'获取文本框内的总行数
    Public Function GetTextBoxLines(ByVal vbTextBox As TextBox) As Long
        Dim ret As Long
        ret = SendMessage(vbTextBox.hwnd, EM_GETLINECOUNT, 0, ByVal 0&)
        If ret >= 1 Then
           GetTextBoxLines = ret - 1
        End If
    End Function'获取文本框内的某行的文本
    Public Function GetLineText(ByVal vbTextBox As TextBox, ByVal lngLine As Long) As String
        Dim ret As String * 4096
        GetLineText = ""
        RtlMoveMemory ByVal ret, 4096, 2
        If lngLine >= 1 Then
            If GetTextBoxLines(vbTextBox) >= lngLine Then
               SendMessage vbTextBox.hwnd, EM_GETLINE, lngLine - 1, ByVal ret
               GetLineText = Left(ret, InStr(ret, Chr(0)) - 1)
            End If
        End If
    End Function'获取光标在文本框中的具体位置（行位置和列位置）
    Public Sub GetTextCaretPos(ByVal vbTextBox As TextBox, ByRef LineNumber As Long, ByRef ColNumber As Long)
        Dim i As Long, j As Long, k As Long
        Dim m As Long, n As Long
        '获取从起始位置到光标所在位置的字符数
        i = SendMessage(vbTextBox.hwnd, EM_GETSEL, m, n)
        If i > 0 Then
           j = i / 2 ^ 16
           LineNumber = SendMessage(vbTextBox.hwnd, EM_LINEFROMCHAR, j, 0) '获取所在行数
           LineNumber = LineNumber + 1
        Else
           LineNumber = 1
        End If
        k = SendMessage(vbTextBox.hwnd, EM_LINEINDEX, -1, 0) '获取所在列数
        If j - k >= 0 Then ColNumber = j - k
        If ColNumber = 0 Then ColNumber = 1
    End Sub
    窗口代码：
    '取光标位置示例：
    Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
        Dim i As Long
        Dim j As Long
        Call GetTextCaretPos(Text1, i, j)
        Label1.Caption = "第 " & i & " 行 第 " & j & " 列"
    End Sub有了这个模块，你先将文件读取到文本框中，就可以随意读取了当然，再改动下，直接取文件，就更加方便了我准备将它写成一个类，目前在准备中，也在参考一个 Linux 的源程序．到时候再公开源代码了
      

  2.   

    嘿嘿~~~看见了~~~ tanaya(唐博士 http://blog.csdn.net/tanaya)你真不错!每个你都回复了!
      

  3.   

    Private Sub Command1_Click()
    CommonDialog1.fileName = ""
    CommonDialog1.InitDir = App.Path
    CommonDialog1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
    CommonDialog1.ShowOpen
    Text1.Text = CommonDialog1.fileName
    CommonDialog1.FilterIndex = 0
    End SubPrivate Sub Command2_Click()
    Dim inputFile As FileSystemObject
    Dim inputText As TextStream
    Dim outputFile As FileSystemObject
    Dim outputText As TextStream
    Dim fileName As String
    Dim M As String
    Dim F As Long
    Dim X As LongIf Text1.Text = "" Then
    MsgBox "请填写源文件路径！", 48
    Exit Sub
    End If
    If Text2.Text = "" Then
    MsgBox "请填写您需要截取的行数！", 48
    Exit Sub
    End If
    If Text3.Text = "" Then
    MsgBox "请填写地区名称！", 48
    Exit Sub
    End If
    fileName = Trim(Text1.Text)
    If fileName = "" Then
    MsgBox "输入信息不完整！", 48
    Exit Sub
    End If
    charPos = findLastChar(fileName, "\")
    fileName = Mid(fileName, charPos + 1)
    charPos = InStr(fileName, ".")
    fileName = Left(fileName, charPos - 1)
    Set inputFile = CreateObject("scripting.filesystemobject")
    Set inputText = inputFile.OpenTextFile(Trim(Text1.Text), ForReading)
    Set outputFile = CreateObject("scripting.filesystemobject")
    Set outputText = outputFile.CreateTextFile(App.Path & "\" & fileName & "_" & Text3.Text & ".txt", True)F = 0
    Do While inputText.AtEndOfLine <> True
    M = inputText.ReadLine
    F = F + 1
    Loop
    Label5.Caption = Str(F)
    inputText.CloseLabel3.Caption = Str(Val(Label3.Caption) + Val(Text2.Text))If Val(Label3.Caption) > Val(Label5.Caption) Then
    MsgBox "现在的文件地址已经超过文件总长度！", 48
    Exit Sub
    End If
    If Val(Text2.Text) > Val(Label5.Caption) Then
    MsgBox "您所填写的截取长度超过了文件的总长度！请核实后再填写！", 48
    Exit Sub
    End IfSet inputText = inputFile.OpenTextFile(Trim(Text1.Text), ForReading)
    For X = 1 To Val(Text2.Text) Step 1
    M = inputText.ReadLine
    outputText.WriteLine (M)
    Next X
    outputText.Close
    Command4.Visible = True
    Command2.Visible = False
    MsgBox "处理完毕！如要继续截取请选择继续截取。想重新开始请选择重新开始！", 48
    End SubPrivate Sub Command3_Click()
    End
    End SubPrivate Sub Command4_Click()
    Dim inputFile As FileSystemObject
    Dim inputText As TextStream
    Dim outputFile As FileSystemObject
    Dim outputText As TextStream
    Dim fileName As StringDim F As Long
    Dim a As String
    Dim Y As LongIf Text1.Text = "" Then
    MsgBox "请填写源文件路径！", 48
    Exit Sub
    End If
    If Text2.Text = "" Then
    MsgBox "请填写您需要截取的行数！", 48
    Exit Sub
    End If
    If Text3.Text = "" Then
    MsgBox "请填写地区名称！", 48
    Exit Sub
    End IffileName = Trim(Text1.Text)
    If fileName = "" Then
    MsgBox "输入信息不完整！", 48
    Exit Sub
    End If
    charPos = findLastChar(fileName, "\")
    fileName = Mid(fileName, charPos + 1)
    charPos = InStr(fileName, ".")
    fileName = Left(fileName, charPos - 1)Label3.Caption = Str(Val(Label3.Caption) + Val(Text2.Text))
    If Val(Label3.Caption) > Val(Label5.Caption) Then
    MsgBox "现在的文件地址已经超过文件总长度！", 48
    Exit Sub
    End If
    If Val(Text2.Text) > Val(Label5.Caption) Then
    MsgBox "您所填写的截取长度超过了文件的总长度！请核实后再填写！", 48
    Exit Sub
    End IfSet inputFile = CreateObject("scripting.filesystemobject")
    Set inputText = inputFile.OpenTextFile(Trim(Text1.Text), ForReading)
    Set outputFile = CreateObject("scripting.filesystemobject")
    Set outputText = outputFile.CreateTextFile(App.Path & "\" & fileName & "_" & Text3.Text & ".txt", True)F = 0
    Do While inputText.AtEndOfLine <> True
    inputText.SkipLineF = F + 1If F = Val(Label3.Caption) - Val(Text2.Text) ThenFor Y = 1 To Val(Text2.Text) Step 1
    a = inputText.ReadLine
    outputText.WriteLine (a)
    Next Y
    Exit DoEnd If
    LoopoutputText.Close
    inputText.Close
    MsgBox "处理完毕~~~~", 48
    End SubPrivate Sub Command5_Click()
    Text1.Text = ""
    Text2.Text = ""
    Label3.Caption = ""
    Label5.Caption = ""
    Text3.Text = ""
    Command4.Visible = False
    Command2.Visible = True
    End Sub
    嘿嘿~~~这是我自己编的~~~也许还不太成熟~~~但已经可以任意截取文本文件的了!
    下面还有一个模块~~~是自动保存的!
    Option Explicit
    Function findLastChar(a As String, b As String) As Integer
    Dim charPos As Integer
    charPos = InStr(a, b)
    Do While charPos <> 0
    findLastChar = charPos
    charPos = InStr(charPos + 1, a, b)
    LoopEnd Function