PregMatch()

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Domino
Beiträge: 22
Registriert: 21.12.2015 21:28
Computerausstattung: Centrino 2x2GHz, GeForce Graka
Linux 3.16

PregMatch()

Beitrag von Domino »

Nachbildung von PHPs preg_match():

Code: Alles auswählen

Dim Teile.s(3)
Dim Auflosung.s(30)
Declare.l PregMatch(Pattern.s, String.s, Array Arr.s(1))
Teile(0) = "480x360"
Teile(1) = "640x480 [SAR 16:11]"
Teile(2) = "852x640 [DAR 320:121]"
Teile(3) = "1136x852 [SAR 16:11 DAR 320:121]"

For i=0 To 3
  Debug PregMatch("(\d+)x(\d+)( \[(SAR \d+:\d+)?\s?(DAR \d+:\d+)?\])?", Teile(i), Auflosung())
  Debug ""
Next i

;{ PregMatch()
;PregMatch() ist eine Nachbildung von PHPs preg_match() für die sogenannten regulären Ausdrücke,
;englisch „regular expressions“ oder kurz REGEX. Die Argumente Flags und Offset der PHP-Vorlage
;werden dabei noch nicht unterstützt. PregMatch prüft einen Text per Suchmuster auf Übereinstim-
;mungen und übernimmt diese in ein Feld. Enthält das Suchmuster einen Fehler, wird 0 zurückgegeben.
;Nicht vergessen: Die PCRE-Lizenz in den Quelltext kopieren!
Procedure.l PregMatch(Pattern.s, String.s, Array Arr.s(1))
  If CreateRegularExpression(0, Pattern)
    If ExamineRegularExpression(0, String)
      Debug "Count: "+CountRegularExpressionGroups(0)
      NextRegularExpressionMatch(0)   ; genau 1x durchlaufen
      For i=1 To CountRegularExpressionGroups(0)
        Arr(i) = RegularExpressionGroup(0, i)
        Debug "Group "+i+": "+RegularExpressionGroup(0, i)
      Next i
    EndIf
    FreeRegularExpression(0)
    ProcedureReturn 1
  Else
    Debug RegularExpressionError()
    ProcedureReturn 0
  EndIf
EndProcedure
;}
Centrino 2x2GHz, GeForce Graka, mehrere Linux Mint u.a. mit Mate, Linux 3.16
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: PregMatch()

Beitrag von Sicro »

Wird in CodeArchiv unter Strings/PHP_PregMatch.pbi in abgewandelter Form aufgenommen:

Code: Alles auswählen

;{ PregMatch()
;PregMatch() ist eine Nachbildung von PHPs preg_match() für die sogenannten regulären Ausdrücke,
;englisch „regular expressions“ oder kurz REGEX. Die Argumente Flags und Offset der PHP-Vorlage
;werden dabei noch nicht unterstützt. PregMatch prüft einen Text per Suchmuster auf Übereinstim-
;mungen und übernimmt diese in ein Feld. Enthält das Suchmuster einen Fehler, wird 0 zurückgegeben.
;Nicht vergessen: Die PCRE-Lizenz in den Quelltext kopieren!
Procedure PregMatch(Pattern$, String$, Array Output$(1))
  Protected RegEx, Count, i
  
  RegEx = CreateRegularExpression(#PB_Any, Pattern$)
  If RegEx
    If ExamineRegularExpression(RegEx, String$)
      NextRegularExpressionMatch(RegEx) ; genau 1x durchlaufen
      Count = CountRegularExpressionGroups(RegEx)
      ReDim Output$(Count - 1)
      For i = 1 To Count
        Output$(i - 1) = RegularExpressionGroup(RegEx, i)
      Next
    EndIf
    FreeRegularExpression(RegEx)
    ProcedureReturn Count - 1
  Else
    ProcedureReturn -1
  EndIf
EndProcedure
;}

;-Example
CompilerIf #PB_Compiler_IsMainFile
  Define i, c, Count
  
  Dim Teile$(3)
  Dim Auflosung$(0)
  
  Teile$(0) = "480x360"
  Teile$(1) = "640x480 [SAR 16:11]"
  Teile$(2) = "852x640 [DAR 320:121]"
  Teile$(3) = "1136x852 [SAR 16:11 DAR 320:121]"
  
  For i = 0 To 3
    Count = PregMatch("(\d+)x(\d+)[ ]*(\[(SAR \d+:\d+)?\s?(DAR \d+:\d+)?\])?", Teile$(i), Auflosung$())
    For c = 0 To Count
      Debug Str(i) + ": " + Auflosung$(c)
    Next
  Next
CompilerEndIf
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Antworten