Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Dateien und Laufwerke

Dateien nach einer Zeichenkette durchsuchen

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Mitgliedhhr 04.09.2020

Die Eingaben können mit 'Ziehen und Ablegen' und 'Kopieren und Einfügen' vorgenommen werden.
Als Pfad kann ein Ordner- oder Dateipfad angegeben werden.

Im Allgemeinen sind Großbuchstaben weniger häufig als Kleinbuchstaben, weshalb Lcase verwendet wird. Damit muss weniger oft umgewandelt werden als mit Ucase.

Mit OemToCharBuff wird der Versuch gemacht, Umlaute in Pfadangaben und ANSI kodierten Dateien richtig zu behandeln.
Mit Unicode-Dateien funktioniert das nicht. Vorsichtshalber sollten in der zu suchenden Zeichenkette nur die Standardzeichen vorkommen.
Das Euro-Zeichen muss in jedem Fall vermieden werden.

Sub lowercase(Byref s As String)
   If Len(s) = 0 Then Exit Sub
   s = Lcase(s,1)
   Dim As Ulong i
   For i = 0 To Len(s)-1
      If s[i] >= 196 Then
         Select Case s[i]
         Case 196      'ANSI code
            s[i] = 228 'Ä -> ä
         Case 214
            s[i] = 246 'Ö -> ö
         Case 220
            s[i] = 252 'Ü -> ü
         End Select
      End If
   Next i
End Sub

#Include "windows.bi" 'OemToCharBuff

Dim As String searchstring,path,file,sample,dsample
Dim As Long result

Print "Zu durchsuchenden Pfad eingeben: ";
Input "",path
path = Trim(path)
OemToCharBuff(path,path,Len(path)) 'AsciiToAnsi

Print "Zu suchende Zeichenkette eingeben: ";
Line Input searchstring
OemToCharBuff(searchstring,searchstring,Len(searchstring)) 'AsciiToAnsi
lowercase(searchstring) ' searchstring = Lcase(searchstring)

Print

Dim As Long maxlen = 100000

Open Pipe "DIR /A:-D /B /S " & Chr(34) & path & Chr(34) For Input As #1
   Do Until Eof(1)
      Line Input #1,file
      OemToCharBuff(file,file,Len(file)) 'AsciiToAnsi
      Open file For Binary Access Read As #2

         If Lof(2) < maxlen Then
            sample = Space(Lof(2))
         Else
            sample = Space(maxlen)
         End If

         dsample = Space(0)

         Do Until Eof(2)
            Get #2,,sample
            lowercase(sample) ' sample = Lcase(sample)
            sample = dsample & sample
            If Instr(sample,searchstring) > 0 Then
               Print Wstr(file)
               result = 1
               Exit Do
            Else
               dsample = Right(sample,Len(searchstring)-1)
            End If
         Loop

      Close #2
   Loop
Close #1

If result = 0 Then Print "Die Zeichenkette wurde nicht gefunden."
Print
Print "Ende mit beliebiger Taste..."

Sleep
End
'findstring.bas

Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 24.08.2020 von Mitgliedhhr angelegt.
  • Die aktuellste Version wurde am 04.09.2020 von Mitgliedhhr gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen