AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Regex und "ENTER"

Ein Thema von Chefx · begonnen am 2. Aug 2009 · letzter Beitrag vom 3. Aug 2009
 
Chefx

Registriert seit: 13. Jun 2009
Ort: Radebeul
241 Beiträge
 
Turbo Delphi für Win32
 
#6

Re: Regex und "ENTER"

  Alt 2. Aug 2009, 22:23
Also mein Projekt

Ich hab mir ans ziel gesetzt ein Syntax Highlighter für Websprachen zu entwickeln.
Hab jetzt zurzeit folgendes Konzept mir ausgedacht:
  • Bestimmte muster mit Regex suchen (in verschiedene Arrays speichern)
  • dann die verschiedenen Arrays fehlerfrei als rtf ausgeben
  • die RTF wird durch RTF-Code erstellt und dann in Das Richedit geladen
das funktioniert super bloß das mit den neuen zeilen funktioniert noch nicht richtig!

Hier mal mein Projekt(Werde das wenn es fertig ist veröffentlich):
Delphi-Quellcode:
unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type arrayf = array of array[0..1] of string;

type
  TForm3 = class(TForm)
    Button1: TButton;
    RichEdit1: TRichEdit;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure RichEdit1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

uses perlregex;

{$R *.dfm}

procedure PatchINT3;
var
  NOP : Byte;
  NTDLL: THandle;
  BytesWritten: DWORD;
  Address: Pointer;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then Exit;
  NTDLL := GetModuleHandle('NTDLL.DLL');
  if NTDLL = 0 then Exit;
  Address := GetProcAddress(NTDLL, 'DbgBreakPoint');
  if Address = nil then Exit;
  try
    if Char(Address^) <> #$CC then Exit;

    NOP := $90;
    if WriteProcessMemory(GetCurrentProcess, Address, @NOP, 1, BytesWritten) and
      (BytesWritten = 1) then
      FlushInstructionCache(GetCurrentProcess, Address, 1);
  except
    //Do not panic if you see an EAccessViolation here, it is perfectly harmless!
    on EAccessViolation do ;
    else raise;
  end;
end;

function anzeige(code:arrayf):string;
var
  i:integer;
begin
result:='';
for i := low(code) to high(code) do
      result := result + code[i,0] + '|' + code[i,1] + ',';
end;

function searchregex(subj, expr: string; mode:integer = 0):arrayf;
var
  regexMachine: TPerlRegEx;
  index:integer;
begin
  SetLength(result,0); //Array initialisieren
  index:=0;
  regexMachine := TPerlRegEx.Create(nil);
  try
    regexMachine.RegEx := expr;
    regexMachine.Subject := subj;
    regexMachine.Options := regexMachine.Options + [preUnGreedy];
    if regexMachine.Match then
    begin
      repeat
        setlength(result, Length(result) + 1); // Treffer um neu gefundenen erweitern
        result[Length(result) - 1,0] := regexMachine.SubExpressions[mode];
        if mode = 0 then index := 1;
        result[Length(result) - 1,1] := inttostr(regexMachine.MatchedExpressionOffset - index);// Neue Treffer in das code Array eintragen
        if (strtoint(result[length(result) - 1,1]) = 1) and (mode = 2) then result[length(result) - 1,1] := '0';
      until not regexMachine.MatchAgain; // und weitersuchen. Abbruch, wenn kein Treffer mehr
    end;
  finally
    regexMachine.free;
  end;
end;

function rtflinkcompiler(array1,array2,array3:arrayf):string;
var i,l,p,a1,a2,a3:integer;
begin
l:=length(array1) + length(array2) + length(array3);
a1:=0;
a2:=0;
a3:=0;
p:=0;
result:='{\rtf {\fonttbl{\f0\fcharset0 Courier New;}}{\colortbl ;\red0\green0\blue128;\red128\green0\blue;}\f0\fs18';
for i:=0 to l do begin
      if (a1 < length(array1)) and (p = strtoint(array1[a1,1])) then
    begin
      result:=result+'\cf1\b'+array1[a1,0]+'\b0\cf0 ';
      p:=p+length(array1[a1,0]);
      a1:=a1+1;
    end;
    if (a2 < length(array2)) and (p = strtoint(array2[a2,1])) then
    begin
      result:=result+array2[a2,0];
      p:=p+length(array2[a2,0]);
      a2:=a2+1;
    end;
    if (a3 < length(array3)) and (p = strtoint(array3[a3,1])) then
    begin
      result:=result+'\par'+#13+#10;
      p:=p+2;
      a3:=a3+1;
    end;
  end;

result:=result+'\par\f1}';
end;

function streamRE(text:string;RE:Trichedit):boolean;
var
  ms: TMemoryStream;
  strl:tstringlist;
begin
  strl:=Tstringlist.Create;
  try
    strl.Text:=text;
    ms := TMemoryStream.Create;
    try
      strl.SaveToStream(ms);
      ms.Position :=0;
      RE.Lines.LoadFromStream(ms);
    finally
    ms.Free;
    end;
  finally
  strl.Free;
  end;
end;



procedure TForm3.Button1Click(Sender: TObject);
var html,php,space1,space2:arrayf; cursorpos:integer; str:string;
begin

cursorpos:=richedit1.SelStart;
html:=searchregex(richedit1.Text,'(<)(?<contents>[^>]*)(>|$)');
//php:=searchregex(richedit1.Text,'<?(?<contents>[^>]*)(\?>|$)');
space1:=searchregex(richedit1.Text,'(^|>|'#13#10')(?<contents>[^<]*?)($|<|'#13#10')',2);
space2:=searchregex(richedit1.Text,'('#13#10')*');
edit1.Text:=anzeige(html);
edit1.Text:=edit1.Text+anzeige(space1);
edit1.Text:=edit1.Text+anzeige(space2);
str:=rtflinkcompiler(html,space1,space2);
memo1.Text:=str;
streamRE(str,form3.Richedit1);
richedit1.SelStart:=cursorpos;
end;


procedure TForm3.RichEdit1Change(Sender: TObject);
var html,space1,space2:arrayf; cursorpos:integer; str:string;
begin

cursorpos:=richedit1.SelStart;
html:=searchregex(richedit1.Text,'(<)(?<contents>[^>]*)(>|$)');
space1:=searchregex(richedit1.Text,'(>|^|'#13#10')(?<contents>[^<]*)(<|$|'#13#10')',2);
space2:=searchregex(richedit1.Text,'('#13#10')*');
edit1.Text:=anzeige(html);
edit1.Text:=edit1.Text+anzeige(space1);
edit1.Text:=edit1.Text+anzeige(space2);
str:=rtflinkcompiler(html,space1,space2);
memo1.Text:=str;
streamRE(str,form3.Richedit1);
richedit1.SelStart:=cursorpos;

end;

initialization

// nur wenn ein Debugger vorhanden, den Patch ausführen
if DebugHook<>0 then
   PatchINT3;
end.

Aber wo liegt mein Fehler?
Angehängte Dateien
Dateityp: zip regex_750.zip (550,2 KB, 2x aufgerufen)
ein Sprichwort für Programmierer:
"Viele wege fürn zur EXE, aber ob sie funktioniert ist die andere Frage."
schau mal bei www.xlite.de.tc vorbei
  Mit Zitat antworten Zitat
 

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:50 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz