Delphi-PRAXiS - Delphi Problem bei TStringlist Freigabe

Also ich schreib doch mal den ganzen Code rein also hier ist er

Kernelunit:

Delphi-Quellcode:

			unit Kernelunit;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, AppEvnts, typenunit,dglopengl,Inifiles;

type

  PKernel = ^TKernel;

  Tfunc=procedure (data:PKernel);stdcall;

  PFunktionsglied=^TFunktionsglied;

  TFunktionsglied=record

    davor:PFunktionsglied;

    Funktion:cardinal;

    danach:PFunktionsglied;

  end;

  TKonsole=class

    private

      FMsgpos:integer;

      FBGColor:TRGBi;

      Fvisible:boolean;

      Fontsize:byte;

      procedure SetBGColor(BGColor:TRGBi);

      procedure Setmsgpos(msgpos:integer);

      procedure ChangeVisible(visible:boolean);

    public

      keycodes:TInifile;

      Script:TStringlist;

      Msglist:TStringlist;

      keyboardinput:array of word;

      keycount:word;

      Scriptpos:cardinal;

      maxlines:word;

      systemfont:cardinal;

      systempfad:string;

      befehl:string;

      value:Tstrarr;

      translatedkeyarray:string;

      dauer:cardinal;

      change:boolean;

      booted:boolean;

      port:Tviewport;

      constructor create(AOwner:TComponent);

      destructor destroy;override;

      property BGColor:TRGBi read FBGColor write SetBGColor;

      property visible:boolean read Fvisible write ChangeVisible;

      property msgpos:integer read fmsgpos write Setmsgpos;

      procedure Init(port:Tviewport);

      procedure MsgToBuffer();

      procedure addmsg(text:string;color:TRGBi);

      procedure addscript(text:string);

      function TranslateKeyarray():string;

      procedure Keyinterpret(Sender: TObject; var Key: Word;

      Shift: TShiftState);

      procedure makefree;

  end;

  TOpenGL =class

    private

      fdc:Hdc;

      fhrc:hglrc;

      fviewport:TViewport;

      procedure Setdc(dc:hdc);

      procedure Sethrc(hrc:hglrc);

      procedure Setviewport(viewport:TViewport);

    public

      initialized:boolean;

      smartrenderbool:boolean;

      property dc:hdc read fdc write setdc;

      property hrc:hglrc read fhrc write sethrc;

      property viewport:TViewport read fviewport write Setviewport;

      procedure SmartInitialize(Owner:TComponent);

      procedure SmartRender(Owner:TComponent);

      procedure SmartFinalize(Owner:TComponent);

      procedure DestroyDC(Owner:TComponent);

      procedure makefree;

  end;

  TKernel = class(TForm)

    ApplicationEvents1: TApplicationEvents;

    procedure FormKeyDown(Sender: TObject; var Key: Word;

      Shift: TShiftState);

    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);

    procedure FormCreate(Sender: TObject);

  private

    Tempspeicher:Tvars;{ Private-Deklarationen }

  public

    tryclose:boolean;

    Konsole:TKonsole;

    OpenGL:TOpenGL;

    funcnames:TStringlist;

    functions:array of TFunc;

    deletedfunctions:array of cardinal;

    dyndllnames:Tstringlist;

    dyndlls:array of Thandle;{ Public-Deklarationen }

    renderfunctionskette:PFunktionsglied;

    procedure Initmemory();

    procedure Freememory();

    procedure Freedlls();

    function GetMemoryVars():TVars;

    function Registervariable(size:Byte):cardinal;

    procedure Freevariable(address:cardinal);

    procedure Funktionsketteabarbeiten(address:PFunktionsglied);

    procedure freefunktionskette(address:PFunktionsglied);

    function Addfunktionsglied(address:PFunktionsglied;functionindex:cardinal;position:cardinal):cardinal;

    function Delfunktionsglied(address:PFunktionsglied;position:cardinal):boolean;

    function Addfunktion(dll:THandle;name:pansichar):integer;

    function Delfunktion(index:cardinal):boolean;

    procedure beenden();

  end;

var

  Kernel: TKernel;

  procedure interpret(data:PKernel);stdcall;external 'script.dll';

implementation

{$R *.dfm}

procedure TKonsole.SetBGColor(BGColor:TRGBi);

begin

  FBGColor[0]:=BGColor[0];

  FBGColor[1]:=BGColor[1];

  FBGColor[2]:=BGColor[2];

end;

procedure TKonsole.addmsg(text:string;color:TRGBi);

begin

  msglist.Add(inttostr((color[0]*1000000)+(color[1]*1000)+(color[2]))+';'+text);

  msgpos:=msglist.Count-maxlines;

end;

procedure TKonsole.addscript(text:string);

begin

  dauer:=0;

  script.Add(text);

end;

function TKonsole.TranslateKeyarray():string;

var i,code:word;

    precode:byte;

    text:string;

begin

  result:='';

  text:='';

  if length(keyboardinput)>0 then

  begin

     for i:=0 to length(keyboardinput)-1 do

     begin

      code:=keyboardinput[i];

      precode:=code div 1000;

      code:=code mod 1000;

      case precode of

      0 : begin

            text:=keycodes.ReadString('nothing',inttostr(code),'');

          end;                                                                //Nix

      1 : begin

            text:=keycodes.ReadString('shift',inttostr(code),'');

          end;                                                                //Umschalt

      2 : begin

            text:=keycodes.ReadString('alt',inttostr(code),'');

          end;                                                                //Alt

      3 : begin

            text:=keycodes.ReadString('shiftalt',inttostr(code),'');

          end;                                                                //Alt+Umschalt

      5 : begin

            text:=keycodes.ReadString('ctrl',inttostr(code),'');

          end;                                                                //Ctrl

      6 : begin

            text:=keycodes.ReadString('shiftctrl',inttostr(code),'');

          end;                                                                //Umschalt+Ctrl

      7 : begin

            text:=keycodes.ReadString('altctrl',inttostr(code),'');

          end;                                                                //ctrl+Alt

      8 : begin

            text:=keycodes.ReadString('shiftaltctrl',inttostr(code),'');

          end;

      end;                                                                //Umschalt+Alt+Ctrl

        result:=result+text;

        change:=true;

     end;

  end;

end;

constructor TKonsole.create(AOwner:TComponent);

begin

  inherited create;

  systempfad:=extractfiledir((aowner.Owner as TApplication).ExeName);

  Script:=Tstringlist.Create;

  Script.LoadFromFile(systempfad+'\startscript.txt');

  Scriptpos:=0;

  Msglist:=TStringlist.Create;

  Msglist.LoadFromFile(systempfad+'\readme.txt');

  keycodes:=TInifile.Create(systempfad+'\keycodes.ini');

  change:=false;

  booted:=false;

  visible:=false;

  dauer:=0;

  bgcolor:=bgblue;

  fontsize:=20;

  translatedkeyarray:='';

end;

procedure TKonsole.Init(port:Tviewport);

begin

  self.port[0]:=port[0];

  self.port[1]:=port[1];

  self.port[2]:=port[2];

  self.port[3]:=port[3];

  maxlines:=port[3] div fontsize;

  dec(maxlines);

end;

procedure TKonsole.MsgToBuffer();

var line_s,color:string;

    line_b:array of Byte;

    i,j,lines:word;

    icolor:cardinal;

    r,g,b:byte;

begin

  glcolor3f(bgcolor[0]/255,bgcolor[1]/255,bgcolor[2]/255);

  glbegin(gl_quads);

  glvertex3i(port[0],port[1],-1);

  glvertex3i(port[0],port[1]+port[3],-1);

  glvertex3i(port[0]+port[2],port[1]+port[3],-1);

  glvertex3i(port[0]+port[2],port[1],-1);

  glend;

  if msglist.Count>0 then

  begin

    if maxlines>(msglist.Count-msgpos) then lines:=(msglist.Count-msgpos)

                                   else lines:=maxlines;

    for j:=1 to lines do

    begin

    line_s:=msglist.Strings[j+msgpos-1];

    color:=copy(line_s,0,ansipos(';',line_s)-1);

    line_s:=copy(line_s,ansipos(';',line_s)+1,length(line_s));

    if color='' then glcolor3f(0.8,0.8,0.8)

    else

    begin

      icolor:=strtoint(color);

      r:=icolor div(1000000);

      g:=(icolor mod(1000000))div(1000);

      b:=icolor mod(1000);

      glcolor3f(1/255*r,1/255*g,1/255*b);

    end;  

    glrasterpos3i(port[0],port[1]+port[3]-(fontsize*j),-1);

    gllistbase(systemfont);

    setlength(line_b,length(line_s));

    if length(line_b)>80 then setlength(line_b,80);

    if length(line_s)>0 then for i:=1 to length(line_b) do line_b[i-1]:=ord(line_s[i]);

    if length(line_b)>0 then glcalllists(length(line_b),gl_unsigned_byte,line_b);

    end;

  end;

  glcolor3f(1,1,0);

  glrasterpos3i(port[0],port[1],-1);

  gllistbase(systemfont);

  line_s:=translatedkeyarray;

  setlength(line_b,length(line_s));

  if length(line_b)>80 then setlength(line_b,80);

  if length(line_b)>0 then for i:=1 to length(line_b) do line_b[i-1]:=ord(line_s[i]);

  if length(line_b)>0 then glcalllists(length(line_b),gl_unsigned_byte,line_b);

end;

procedure TKonsole.Setmsgpos(msgpos:integer);

begin

  if msgpos>(msglist.Count-maxlines) then msgpos:=msglist.Count-maxlines;

  if msgpos<0 then msgpos:=0;

  fmsgpos:=msgpos;

  change:=true;

end;

procedure TKonsole.ChangeVisible(visible:boolean);

begin

  Fvisible:=visible;

  keycount:=0;

  setlength(keyboardinput,0);

  if visible then msgpos:=msglist.Count;

end;

procedure TKonsole.Keyinterpret(Sender:Tobject;var Key:Word;Shift:TShiftstate);

var modkey:word;

begin

  case key of

  38  : if msgpos>0 then msgpos:=msgpos-1;

  40  : if msgpos<msglist.Count-1 then msgpos:=msgpos+1;

  8   : if high(keyboardinput)>-1 then

        begin

          setlength(keyboardinput,high(keyboardinput));

          dec(keycount);

          translatedkeyarray:=translatekeyarray;

        end;

  13  : begin

          Addmsg(translatedkeyarray,yellow);

          translatedkeyarray:=translatekeyarray;

          addscript(translatedkeyarray);

          keycount:=0;

          setlength(keyboardinput,keycount);

          translatedkeyarray:=translatekeyarray;

         end;

  else  begin

          inc(keycount);

          setlength(keyboardinput,keycount);

          modkey:=key;

          if ssshift in shift then modkey:=modkey+1000;

          if ssalt in shift then modkey:=modkey+2000;

          if ssCtrl in shift then modkey:=modkey+5000;

          keyboardinput[keycount-1]:=modkey;

          translatedkeyarray:=translatekeyarray;

        end;

  end;

end;

destructor TKonsole.destroy;

begin

  if assigned(Msglist) then msglist.Free;    //??????????????????????????

  if assigned(script) then script.Free;

  if assigned(keycodes) then keycodes.Free;

  inherited destroy;

end;

procedure TKonsole.makefree;

begin

end;

{------------------------------------------------------------------------------}

procedure TOpenGL.Setdc(dc:hdc);

begin

  fdc:=dc;

end;

procedure TOpenGL.Sethrc(hrc:hglrc);

begin

  fhrc:=hrc;

end;

procedure TOpenGL.Setviewport(viewport:TViewport);

begin

  fviewport[0]:=viewport[0];

  fviewport[1]:=viewport[1];

  fviewport[2]:=viewport[2];

  fviewport[3]:=viewport[3];

end;

procedure TOpenGL.SmartInitialize(Owner:TComponent);

var Font : HFONT;

begin

  if (Owner is TKernel) then

  begin

    initialized:=true;

    smartrenderbool:=true;

    dc:=getdc((Owner as TKernel).Handle);

    if not InitOpenGL then

    begin

      messagedlg('Konnte OpenGL nicht initialisieren',mterror,[mbok],0);

      initialized:=false;

    end;

    hrc:= CreateRenderingContext(DC,[opDoubleBuffered],32,24,0,0,0,0);

    ActivateRenderingContext(DC,hrc);

    (Owner as TKernel).Konsole.systemfont:=glgenlists(256);

    Font:=CreateFont(16, 0, 0, 0, FW_MEDIUM, 0, 0, 0, ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY, FF_DONTCARE or DEFAULT_PITCH, 'Courier New');

    SelectObject (DC, Font);

    wglUseFontBitmaps (DC, 0, 255, (Owner as TKernel).Konsole.systemfont);

    DeleteObject(font);

  end;

end;

procedure TOpenGL.SmartRender(Owner:TComponent);

begin

  if (Owner is TKernel) then

  begin

  glMatrixMode(GL_PROJECTION);

  glloadidentity;

  glviewport(0,0,(Owner as TKernel).Width,(Owner as TKernel).Height);

  glortho(0,(Owner as TKernel).Width,0,(Owner as TKernel).Height,-1,1);

  glMatrixMode(GL_MODELVIEW);

  glclearcolor(0,0,0,0);

  glclear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glloadidentity;

  gldisable(gl_depth_test);

  gldisable(gl_texture_2d);

  gldisable(gl_blend);

  gldisable(gl_alpha_test);

  gldisable(gl_fog);

  gldisable(gl_lighting);

  if (Owner as TKernel).Konsole.visible then

  begin

    (Owner as Tkernel).Konsole.MsgToBuffer;

    (Owner as Tkernel).Konsole.change:=false;

  end;

  end;

end;

procedure TOpenGL.SmartFinalize(Owner:TComponent);

begin

  if (Owner is TKernel) then

  begin

    swapbuffers((Owner as TKernel).OpenGL.dc);

  end;

end;

procedure TOpengl.DestroyDC(Owner:Tcomponent);

begin

  if Owner is TKernel then

  begin

    gldeletelists((Owner as TKernel).Konsole.systemfont,256);

    initialized:=false;

    smartrenderbool:=false;

    DeactivateRenderingContext;

    DestroyRenderingContext(hrc);

    ReleaseDC((Owner as TKernel).Handle,dc);

  end;

end;

procedure TOpenGL.makefree;

begin

end;

{------------------------------------------------------------------------------}

procedure TKernel.FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  if key=220 then konsole.visible:=not konsole.visible;

  if konsole.visible and Opengl.initialized then Konsole.Keyinterpret(Sender,Key,Shift);

end;

procedure TKernel.ApplicationEvents1Idle(Sender: TObject;

  var Done: Boolean);

begin

  if tryclose then beenden

  else

  begin

  Funktionsketteabarbeiten(renderfunctionskette);

  if Opengl.smartrenderbool then

  begin

    Opengl.SmartRender(self);

    Opengl.SmartFinalize(self);

  end;

  end;

end;

procedure TKernel.FormCreate(Sender: TObject);

var port:Tviewport;

begin

  initmemory;

  tryclose:=false;

  port[2]:=640;

  port[3]:=240;

  if (clientWidth-port[2])>0 then port[0]:=(clientWidth-port[2]) div 2

                             else port[0]:=0;

  port[1]:=100;

  konsole:=TKonsole.Create(self);

  konsole.Init(port);

  OpenGL:=TOpengl.Create;

  Opengl.SmartInitialize(self);

  funcnames:=TStringlist.Create;

  dyndllnames:=Tstringlist.Create;

  setlength(functions,1);

  setlength(deletedfunctions,0);

  functions[high(functions)]:=interpret;

  new(renderfunctionskette);

  renderfunctionskette^.Funktion:=high(functions);

  renderfunctionskette^.danach:=nil;

  funcnames.Add('script.dll;interpret;');

end;

procedure TKernel.beenden();

begin

  Opengl.DestroyDC(self);

  Opengl.makeFree;

  Opengl.Free;

  Konsole.Free;

  freefunktionskette(renderfunctionskette.danach);

  freedlls;

  freememory;

  if assigned(funcnames) then freeandnil(funcnames);

  if assigned(dyndllnames) then freeandnil(dyndllnames);

  self.Close;

end;

procedure TKernel.Initmemory();

begin

  setlength(tempspeicher,0);

end;

procedure Tkernel.Freememory();

var i:integer;

begin

  for i:=0 to high(tempspeicher) do

  begin

    if tempspeicher[i].flag>0 then

    begin

      freemem(tempspeicher[i].address,tempspeicher[i].size);

      finalize(tempspeicher[i]);

    end;

  end;

end;

function Tkernel.GetMemoryVars:Tvars;

begin

  result:=Tempspeicher;

end;

procedure TKernel.Freedlls();

var i:integer;

begin

  for i:=0 to high(dyndlls) do

  begin

    freelibrary(dyndlls[i]);

  end;

end;

function Tkernel.Registervariable(size:Byte):cardinal;

var i:integer;

    found:boolean;

begin

  found:=false;

  if High(tempspeicher)=-1 then

  begin

    setlength(tempspeicher,1);

    getmem(tempspeicher[0].address,size);

    tempspeicher[0].size:=size;

    tempspeicher[0].flag:=1;

    result:=0;

  end

  else

  begin

    for i:=0 to high(tempspeicher) do

    begin

      if Tempspeicher[i].address=nil then

      begin

        getmem(tempspeicher[i].address,size);

        tempspeicher[i].size:=size;

        tempspeicher[i].flag:=1;

        result:=i;

        break;

        found:=true;

      end;

    end;

    if not found then

    begin

      setlength(tempspeicher,length(tempspeicher)+1);

      getmem(tempspeicher[high(tempspeicher)].address,size);

      tempspeicher[high(tempspeicher)].size:=size;

      tempspeicher[high(tempspeicher)].flag:=1;

      result:=high(tempspeicher);

    end;

  end;

end;

procedure TKernel.Freevariable(address:cardinal);

begin

  if address< high(tempspeicher) then

  begin

    freemem(tempspeicher[address].address,tempspeicher[address].size);

    tempspeicher[address].flag:=0;

  end;

end;

procedure TKernel.Funktionsketteabarbeiten(address:PFunktionsglied);

begin

  if assigned(address) then

  begin

    functions[address^.Funktion](@self);

    if not (address^.danach=nil) then Funktionsketteabarbeiten(address^.danach);

  end;  

end;

procedure TKernel.freeFunktionskette(address:PFunktionsglied);

begin

  if assigned(address) then

  begin

    if not (address^.danach=nil) then Funktionsketteabarbeiten(address^.danach);

    dispose(address);

  end;

end;

function TKernel.Addfunktion(dll:THandle;name:PAnsichar):integer;

var i:integer;

begin

  result:=-1;

  if high(deletedfunctions)>-1 then

  begin

    @functions[deletedfunctions[high(deletedfunctions)]]:=getprocaddress(dll,name);

    result:=deletedfunctions[high(deletedfunctions)];

    setlength(deletedfunctions,high(deletedfunctions));

  end;

  if result=-1 then

  begin

    setlength(functions,length(functions)+1);

    setlasterror(0);

    @functions[high(functions)]:=getprocaddress(dll,name);

    i:=getlasterror;

    if i>0 then

    begin

      konsole.addmsg('SYSTEM-ERROR: '+syserrormessage(i),red);

    end;

    if @functions[high(functions)]=nil then setlength(functions,high(functions))

    else result:=high(functions);

  end;

end;

function TKernel.Delfunktion(index:cardinal):boolean;

begin

  result:=false;

  if index<length(functions) then

  begin

    setlength(deletedfunctions,length(deletedfunctions)+1);

    deletedfunctions[high(deletedfunctions)]:=index;

    result:=true;

  end;

end;

function TKernel.Addfunktionsglied(address:PFunktionsglied;functionindex:cardinal;position:cardinal):cardinal;

var i:cardinal;

    glied:PFunktionsglied;

begin

  for i:=0 to position-1 do

  begin

    if not (address.danach=nil) then address:=address^.danach

    else

    begin

      new(glied);

      address^.danach:=glied;

      glied^.Funktion:=functionindex;

      glied^.davor:=address;

      glied^.danach:=nil;

      result:=i;

    end;

  end;

  if not (address.danach=nil) then

  begin

    new(glied);

      glied^.danach:=address^.danach;

      address^.danach:=glied;

      glied^.Funktion:=functionindex;

      glied^.davor:=address;

      address:=glied^.danach;

      address^.davor:=glied;

      result:=position;

  end;

end;

function TKernel.Delfunktionsglied(address:PFunktionsglied;position:cardinal):boolean;

var i:cardinal;

    glied:PFunktionsglied;

    auserhalb:boolean;

begin

  result:=false;

  auserhalb:=false;

  for i:=0 to position-1 do

  begin

    if address.danach=nil then auserhalb:=true;

  end;

  if not auserhalb then

  begin

    glied:=address^.davor;

    glied^.danach:=address^.danach;

    dispose(address);

  end;

end;

end.

Script-dll

Delphi-Quellcode:

			
library Script;

{ Wichtiger Hinweis zur DLL-Speicherverwaltung: ShareMem muss sich in der

  ersten Unit der unit-Klausel der Bibliothek und des Projekts befinden (Projekt-

  Quelltext anzeigen), falls die DLL Prozeduren oder Funktionen exportiert, die

  Strings als Parameter oder Funktionsergebnisse übergeben. Das gilt für alle

  Strings, die von oder an die DLL übergeben werden -- sogar für diejenigen, die

  sich in Records und Klassen befinden. Sharemem ist die Schnittstellen-Unit zur

  Verwaltungs-DLL für gemeinsame Speicherzugriffe, BORLNDMM.DLL.

  Um die Verwendung von BORLNDMM.DLL zu vermeiden, können Sie String-

  Informationen als PChar- oder ShortString-Parameter übergeben. }

uses

  SysUtils,

  Classes,

  Kernelunit,

  Typenunit,

  messages,

  windows,

  AppEvnts;

{$R *.res}

function Semikolontrennung(text:string):Tstrarr;

var i,j:integer;

begin

  setlength(result,1);

  result[0]:=text;

  j:=0;

  repeat

    i:=ansipos(';',result[j]);

    if not (i=0) then

    begin

      inc(j);

      setlength(result,j+1);

      result[j]:=result[j-1];

      result[j-1]:=copy(result[j],0,i-1);

      result[j]:=copy(result[j],i+1,length(result[j]));

    end;

  until i=0;

end;

procedure load(data:PKernel);

var handle:THandle;

    initfunc:TFunc;

begin

  data^.Konsole.addmsg('Lade '+data^.Konsole.value[0],grey);

  setlength(data^.dyndlls,length(data^.dyndlls)+1);

  handle:=LoadLibrary(Pchar(data^.Konsole.systempfad+'/'+data^.Konsole.value[0]));

  if handle<>0 then

  begin

    data^.dyndlls[high(data^.dyndlls)]:=handle;

    @initfunc:=getprocaddress(handle,'init');

    if @initfunc<>nil then

    begin

      initfunc(data);

      data^.dyndllnames.Add(data^.Konsole.value[0]);

      data^.Konsole.addmsg(data^.Konsole.value[0]+' geladen!',green);

    end

    else

    begin

      freelibrary(handle);

      setlength(data^.dyndlls,high(data^.dyndlls));

      data^.Konsole.addmsg('Fehler aufgetreten (Init-Function nicht aufrufbar)'+data^.Konsole.value[0]+' nicht geladen!',red);

    end;

  end

  else

  begin

    setlength(data^.dyndlls,high(data^.dyndlls));

    freelibrary(handle);

    data^.Konsole.addmsg('Fehler aufgetreten '+data^.Konsole.value[0]+' nicht geladen!',red);

  end;

end;

procedure include(data:PKernel);

var pos,i:integer;

    path:ansistring;

begin

  if high(data^.konsole.value)<1 then

  begin

    data^.Konsole.addmsg('Zu wenig Parameter',red);

  end

  else

  begin

    pos:=data^.dyndllnames.IndexOf(data^.Konsole.value[0]);

    if pos>-1 then

    begin

      path:=data^.Konsole.value[1];

      pos:=data^.Addfunktion(data^.dyndlls[pos],@path[1]);

      if pos>-1 then

      begin

        data^.Konsole.addmsg(data^.Konsole.value[1]+' eingegliedert! Index: '+inttostr(pos),green);

        data^.funcnames.Add(data^.Konsole.value[0]+';'+data^.Konsole.value[1]);

      end

      else data^.Konsole.addmsg('Fehler beim Einbinden!'+data^.Konsole.value[1],red);

    end

    else data^.Konsole.addmsg('Unbekannte DLL!',red);

  end;

end;

procedure help(data:PKernel);

var helptext:TStringlist;

    i:integer;

begin

  helptext:=Tstringlist.Create;

  try

    if data^.Konsole.value[0]='' then

    begin

      helptext.LoadFromFile(data^.konsole.systempfad+'\help\default.txt');

      data^.Konsole.addmsg('Hilfe',lgrey);

    end

    else

    begin

      helptext.LoadFromFile(data^.konsole.systempfad+'\help\'+data^.Konsole.value[0]+'.txt');

      data^.Konsole.addmsg('Hilfe für: "'+data^.Konsole.value[0]+'"',lgrey);

    end;

    for i:=0 to helptext.Count-1 do

    begin

      data^.Konsole.addmsg('*  |'+helptext.Strings[i],grey);

    end;

  except

    data^.Konsole.addmsg('Hilfe für nicht verfügbar!',red);

  end;

  helptext.Free;

end;

procedure info(data:PKernel);

var i:integer;

    text:Tstrarr;

    vars:Tvars;

    str:string;

    glied:PFunktionsglied;

begin

  if (data^.Konsole.value[0]='kernel') or (data^.Konsole.value[0]='all') then

  begin

    data^.Konsole.addmsg('-- Kernel --',dred);

    data^.Konsole.addmsg('-Temporärer Speicher Variabeln / Größe |*Index',lred);

    vars:=data^.GetMemoryVars;

    for i:=0 to high(vars) do if vars[i].flag>0 then data^.Konsole.addmsg('*'+inttostr(i)+' '+inttostr(integer(vars[i].address))+'~'+inttostr(integer(vars[i].address)+vars[i].size)+' |> '+inttostr(vars[i].size),lblue);

    data^.Konsole.addmsg('-dynamische DLLs',lred);

    for i:=0 to data^.dyndllnames.Count-1 do

    begin

      data^.Konsole.addmsg(data^.dyndllnames.Strings[i],lblue);

    end;

    data^.Konsole.addmsg('-Funktionen',lred);

    for i:=0 to data^.funcnames.Count-1 do

    begin

      text:=semikolontrennung(data^.funcnames.Strings[i]);

      data^.Konsole.addmsg(text[1],lblue);

      data^.Konsole.addmsg('+ aus '+text[0],dgrey);

    end;

    data^.Konsole.addmsg('-Zuordnungen',lred);

    data^.Konsole.addmsg('--Renderfunktionen',dred);

    glied:=data^.renderfunctionskette;

    repeat

      text:=semikolontrennung(data^.funcnames.Strings[glied^.funktion]);

      data^.Konsole.addmsg(text[1],lblue);

      glied:=glied^.danach;

    until glied=nil;

  end;

  if (data^.Konsole.value[0]='konsole') or (data^.Konsole.value[0]='all') then

  begin

    data^.Konsole.addmsg('-- Konsole --',dred);

    data^.Konsole.addmsg('-Systempfad',lred);

    data^.Konsole.addmsg(data^.Konsole.systempfad,lblue);

    data^.Konsole.addmsg('-Scriptposition/Befehl',lred);

    data^.Konsole.addmsg(inttostr(data^.Konsole.Scriptpos),lblue);

    data^.Konsole.addmsg(data^.Konsole.befehl,lblue);

    str:='';

    for i:=0 to high(data^.Konsole.value) do str:=str+' | '+data^.Konsole.value[i];

    data^.Konsole.addmsg(str,lblue);

    data^.Konsole.addmsg(inttostr(data^.Konsole.dauer),lblue);

    data^.Konsole.addmsg('-Ausgabeport (links,oben,breite,höhe)',lred);

    data^.Konsole.addmsg(inttostr(data^.Konsole.port[0])+' | '+inttostr(data^.Konsole.port[1])+' | '+inttostr(data^.Konsole.port[2])+' | '+inttostr(data^.Konsole.port[3]),lblue);

    data^.Konsole.addmsg('-Hintergrundfarbe (r,g,b)',lred);

    data^.Konsole.addmsg(inttostr(data^.Konsole.bgcolor[0])+' | '+inttostr(data^.Konsole.bgcolor[1])+' | '+inttostr(data^.Konsole.bgcolor[2]),lblue);

  end;

end;

procedure list(data:PKernel);

var datei:TSearchrec;

begin

  if data^.Konsole.value[0]='help' then

  begin

    if findfirst(data^.Konsole.systempfad+'\help\*.txt',faanyfile,datei)=0 then

    begin

      repeat

        data^.Konsole.addmsg(datei.Name,lgrey);

      until not (findnext(datei)=0);

    end;

  end;

  if data^.Konsole.value[0]='script' then

  begin

    if findfirst(data^.Konsole.systempfad+'\script\*.txt',faanyfile,datei)=0 then

    begin

      repeat

        data^.Konsole.addmsg(datei.Name,lgrey);

      until not (findnext(datei)=0);

    end;

  end;

  if data^.Konsole.value[0]='dll' then

  begin

    if findfirst(data^.Konsole.systempfad+'\dll\*.dll',faanyfile,datei)=0 then

    begin

      repeat

        data^.Konsole.addmsg(datei.Name,lgrey);

      until not (findnext(datei)=0);

    end;

  end;

end;

procedure close(data:PKernel);

begin

  data^.Konsole.addmsg('Schließe Konsole',green);

  data^.Konsole.visible:=false;

end;

procedure open(data:PKernel);

begin

  data^.Konsole.addmsg('Öffne Konsole',green);

  data^.Konsole.visible:=true;

end;

procedure exit(data:PKernel);

begin

  data^.Konsole.addmsg('Beende Konsole',green);

  data^.tryclose:=true;

end;

////////////////////////////////////////////////////////////////////////////////

procedure regist(data:Pkernel);

var address:integer;

    size:byte;

begin

  if data^.Konsole.value[0]<>'' then

  begin

    try

      size:=strtoint(data^.Konsole.value[0]);

      if size=0 then

      begin

        data^.Konsole.addmsg('Unzulässige Größenangabe',red);

      end

      else

      begin

        address:=data^.Registervariable(strtoint(data^.Konsole.value[0]));

        data^.Konsole.addmsg('Variable der Größe: '+data^.Konsole.value[0]+' bei '+inttostr(address)+' erstellt',green);

      end;

    except

      data^.Konsole.addmsg('Unzulässige Größenangabe',red);

    end;

  end;

end;

procedure freevar(data:PKernel);

var address:integer;

begin

  if data^.Konsole.value[0]<>'' then

  begin

    try

      address:=strtoint(data^.Konsole.value[0]);

      data^.Freevariable(address);

      data^.Konsole.addmsg('Variable bei: '+inttostr(address)+' freigegeben',green);

    except

      data^.Konsole.addmsg('Unzulässige Adresse!',red);

    end;

  end;

end;

////////////////////////////////////////////////////////////////////////////////

procedure interpret(data:PKernel);stdcall;

var command:string;

    done:boolean;

    text:TStrarr;

    i:integer;

begin

  repeat

    done:=false;

    if (data^.Konsole.Scriptpos<data^.Konsole.Script.Count) and (data^.Konsole.dauer=0) then

    begin

      command:=data^.Konsole.Script.Strings[data^.Konsole.Scriptpos];

      text:=semikolontrennung(command);

      data^.Konsole.befehl:=text[0];

      if high(text)>0 then

      begin

         setlength(data^.Konsole.value,1);

         data^.Konsole.value[0]:=text[1];

         for i:=2 to high(text)-1 do

         begin

           setlength(data^.Konsole.value,i);

           data^.Konsole.value[i-1]:=text[i];

         end;

      end

      else

      begin

        setlength(data^.Konsole.value,1);

        data^.Konsole.value[0]:='';

      end;

      if high(text)>1 then

      begin

        try

          data^.Konsole.dauer:=strtoint(text[high(text)]);

        except

          data^.Konsole.dauer:=1;

          data^.Konsole.addmsg('Keine gültige Tickangabe',red);

        end;

      end

      else data^.Konsole.dauer:=1;

    end;

    if data^.Konsole.Scriptpos<data^.Konsole.Script.Count then

    begin

      if data^.Konsole.befehl='load' then

      begin

        load(data);

        done:=true;

      end;

      if data^.Konsole.befehl='include' then

      begin

        include(data);

        done:=true;

      end;

      if data^.Konsole.befehl='help' then

      begin

        help(data);

        done:=true;

      end;

      if data^.Konsole.befehl='info' then

      begin

        info(data);

        done:=true;

      end;

      if data^.Konsole.befehl='list' then

      begin

        list(data);

        done:=true;

      end;

      if data^.Konsole.befehl='close' then

      begin

        close(data);

        done:=true;

      end;

      if data^.Konsole.befehl='open' then

      begin

        open(data);

        done:=true;

      end;

      if data^.Konsole.befehl='exit' then

      begin

        exit(data);

        done:=true;

      end;

      //////////////////////////////////////////////////////////////////////////

      if data^.Konsole.befehl='regist' then

      begin

        regist(data);

        done:=true;

      end;

      if data^.Konsole.befehl='free' then

      begin

        freevar(data);

        done:=true;

      end;

      //////////////////////////////////////////////////////////////////////////

      if not done then

      begin

        data^.Konsole.dauer:=0;

        data^.Konsole.addmsg('++ Error: Befehl "'+data^.Konsole.befehl+'" unbekannt ++',red);

      end

      else dec(data^.Konsole.dauer);

      if data^.Konsole.dauer=0 then inc(data^.Konsole.Scriptpos);

    end

    else

    begin

      data^.Konsole.befehl:='';

      setlength(data^.Konsole.value,1);

      data^.Konsole.value[0]:='';

      data^.Konsole.dauer:=1;

    end;

  until data^.Konsole.dauer>0;

end;

exports interpret;

begin

end.

Typenunit

Delphi-Quellcode:

			
unit typenunit;

interface

type  PRGBi  =^TRGBi;

      TRGBi  =array[0..2] of Byte;

      TRGBf  =array[0..2] of single;

      TRGBAi =array[0..3] of Byte;

      TRGBAf =array[0..3] of single;

      Tviewport=array[0..3] of word;

      TStrarr=array of string[255];

      TVar=record

        address:pointer;

        size:Byte;

        flag:Byte;

      end;

      TVars=array of TVar;

const white:TRGBi=(255,255,255);

      black:TRGBi=(0,0,0);

      lgrey:TRGBi=(200,200,200);

      grey:TRGBi=(150,150,150);

      dgrey:TRGBi=(100,100,100);

      lred:TRGBi=(255,150,150);

      red:TRGBi=(255,0,0);

      dred:TRGBi=(100,0,0);

      lyellow:TRGBi=(255,255,150);

      yellow:TRGBi=(255,255,0);

      dyellow:TRGBi=(100,100,0);

      lgreen:TRGBi=(150,255,150);

      green:TRGBi=(0,255,0);

      dgreen:TRGBi=(0,100,0);

      lblue:TRGBi=(150,150,255);

      blue:TRGBi=(0,0,255);

      dblue:TRGBi=(0,0,100);

      bgblue:TRGBi=(10,10,50);      

implementation

end.

So, ich hoffe das bringt ein bisschen Licht in die Sache, ich weiß wirklich nicht, woran das liegt...