Thema: Delphi Regex und "ENTER"

Einzelnen Beitrag anzeigen

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, 23: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