Programming Tool Box/SIMS_2.iso/code/cdspy/parse.frm

Text File | 1995-02-27 | 7KB | 235 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Parse Directory"
   ClientHeight    =   2985
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   5295
   Height          =   3390
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   2985
   ScaleWidth      =   5295
   Top             =   1140
   Width           =   5415
   Begin CommandButton Command1
      Caption         =   "single"
      Height          =   375
      Left            =   4230
      TabIndex        =   5
      Top             =   2430
      Width           =   735
   End
   Begin DriveListBox Drive1
      Height          =   315
      Left            =   270
      TabIndex        =   2
      Top             =   180
      Width           =   2085
   End
   Begin FileListBox File1
      Height          =   1590
      Left            =   2520
      Pattern         =   "*.TXT;*.FRM;*.BAS"
      TabIndex        =   1
      Top             =   630
      Width           =   1995
   End
   Begin DirListBox Dir1
      Height          =   1605
      Left            =   270
      TabIndex        =   0
      Top             =   630
      Width           =   2085
   End
   Begin CommandButton Btn_Ende
      Caption         =   "Ende"
      Height          =   375
      Left            =   990
      TabIndex        =   4
      Top             =   2430
      Visible         =   0   'False
      Width           =   3075
   End
   Begin CommandButton Parse
      Caption         =   "Parse"
      Height          =   375
      Left            =   990
      TabIndex        =   3
      Top             =   2430
      Width           =   3075
   End
End
Option Explicit
Dim closing%

Sub Btn_Ende_Click ()
  closing% = True
  Beep
  Beep
  Beep
  Beep
  Btn_Ende.Visible = False
End Sub

Sub Command1_Click ()
  Dim i%, fh%, zeile$, db As database, ds As dynaset
  Dim j%
  ChDrive drive1.Drive
  ChDir dir1.Path
  Me.Refresh
  If Not FM_exists("WORTE.YZX") And (file1.ListCount > 0) Then
    PM_ShellAndWait ("XCOPY C:\TEMP\WORTE.MDB")

    Set db = OpenDatabase("WORTE.MDB")
    Set ds = db.CreateDynaset("T_Worte")
    db.BeginTrans
      For i% = 0 To file1.ListCount - 1
        file1.ListIndex = i%
        DoEvents
        If file1 <> "CDINFO.TXT" And file1.ListCount > 0 Then
          fh% = FreeFile
          Open file1 For Input As fh%
          Do While Not EOF(fh%)
            Line Input #fh%, zeile$
            Dim ii%, zch%, l%
            Dim wort$
            zeile$ = LCase(zeile$)
            For ii% = 1 To Len(zeile$)
              DoEvents
              zch% = Asc(Mid$(zeile$, ii%, 1))
              If zch% >= 97 And zch% <= 122 Or zch% = 228 Or zch% = 246 Or zch% = 252 Then
                wort$ = wort$ + Chr$(zch%)
                l% = l% + 1
              Else
                If Trim(wort$) <> "" And l% > 2 Then
                  ' Wort anzuhΣngen versuchen
                  If l% < 36 Then
                    ds.AddNew
                    ds!wort = wort$
                    ds!filename = file1
                    On Error Resume Next
                    ds.Update
                    Err = 0
                    On Error GoTo 0
                  End If
                  wort$ = ""
                  l% = 0
                Else
                  wort$ = ""
                  l% = 0
                End If
              End If
            Next ii%
          Loop
          Close fh%
        End If
      Next i%
    db.CommitTrans
    If ds.RecordCount > 0 Then
      fh% = FreeFile
      Open "WORTE.YZX" For Output As fh%
      ds.MoveFirst
      Do While Not ds.EOF
        Print #fh%, ds!wort; ","; ds!filename
        ds.MoveNext
      Loop
      Close
    End If
    ds.Close
    db.Close
    Kill "WORTE.MDB"
    Kill "WORTE.LDB"
  End If
  MsgBox "Geparsed"
End Sub

Sub Dir1_Change ()
  file1.Path = dir1.Path
End Sub

Sub Drive1_Change ()
  dir1.Path = drive1.Drive
End Sub

Sub Parse_Click ()
  Dim i%, fh%, zeile$, db As database, ds As dynaset
  Dim j%
  PM_ListSubDirs "N:\SORTED", GM_DBAll()
  drive1.Drive = GM_DBAll(1).Verzeichnis$
  Btn_Ende.Visible = True
  For j% = 1 To UBound(GM_DBAll)
    If closing% Then Exit For
    dir1.Path = GM_DBAll(j%).Verzeichnis$
    Me.Refresh
    ChDrive drive1.Drive
    ChDir dir1.Path
    Me.Refresh
    If Not FM_exists("WORTE.YZX") And (file1.ListCount > 0) Then
      PM_ShellAndWait ("XCOPY C:\TEMP\WORTE.MDB")

      Set db = OpenDatabase("WORTE.MDB")
      Set ds = db.CreateDynaset("T_Worte")
      db.BeginTrans
        For i% = 0 To file1.ListCount - 1
          file1.ListIndex = i%
          DoEvents
          If file1 <> "CDINFO.TXT" And file1.ListCount > 0 Then
            fh% = FreeFile
            Open file1 For Input As fh%
            Do While Not EOF(fh%)
              Line Input #fh%, zeile$
              Dim ii%, zch%, l%
              Dim wort$
              zeile$ = LCase(zeile$)
              For ii% = 1 To Len(zeile$)
                DoEvents
                zch% = Asc(Mid$(zeile$, ii%, 1))
                If zch% >= 97 And zch% <= 122 Or zch% = 228 Or zch% = 246 Or zch% = 252 Then
                  wort$ = wort$ + Chr$(zch%)
                  l% = l% + 1
                Else
                  If Trim(wort$) <> "" And l% > 2 Then
                    If l% < 36 Then
                      ' Wort anzuhΣngen versuchen
                      ds.AddNew
                      ds!wort = wort$
                      ds!filename = file1
                      On Error Resume Next
                      ds.Update
                      Err = 0
                      On Error GoTo 0
                    End If
                    wort$ = ""
                    l% = 0
                  Else
                    wort$ = ""
                    l% = 0
                  End If
                End If
              Next ii%
            Loop
            Close fh%
          End If
        Next i%
      db.CommitTrans
      If ds.RecordCount > 0 Then
        fh% = FreeFile
        Open "WORTE.YZX" For Output As fh%
        ds.MoveFirst
        Do While Not ds.EOF
          Print #fh%, ds!wort; ","; ds!filename
          ds.MoveNext
        Loop
        Close
      End If
      ds.Close
      db.Close
      Kill "WORTE.MDB"
      Kill "WORTE.LDB"
    End If
  Next j%
  MsgBox "Parsing fertig"
End Sub