Problem bei TStringlist Freigabe

[Master of the Wind]

Warum sollte der das tun?, Entweder zeigt er nirgendwo hin also NIL oder er zeigt auf ein Glied. Oder kann es sein das Delphi so "blöd" ist und zwei sachen den selben Zeiger gibt, das geht doch ne. Ne das kann ich mir nicht vorstellen.

[Angel4585]

Naja man kann den Zeigern ja selber irgendwelche Adressen zuweisen, falls du das machst wärs schon möglich das du ne stringlist erwischt.In dem Fall ist aber nicht Delphi schuld, sondern du.

[Master of the Wind]

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...

[Master of the Wind]

Bitte helft mir, das Problem besteht leider immernoch. Ich weiß es ist viel Code, aber bitte bitte...

[Khabarakh]

Hast du es schon mit aktivierter Bereichsprüfung probiert, wie ich oben geschrieben habe?

[Master of the Wind]

hmm wie geht das genau?

[Airblader]

Ich hab meinen Fehler gefunden!

Schau mal, ob du was ähnliches im Code hast.

Ich hatte es so:

Delphi-Quellcode:

SetLength(array, ZAHL);

for i:=0 to ZAHL do
  array[i] := ...;

Nu so und es geht:

Delphi-Quellcode:

for i:=0 to Zahl do
begin
  SetLength(array, length(array)+1);
end;

Also es war vllt. nur ein Index zu wenig erzeugt... (wenn ich auch nich verstehe, warum keine AV kam)

Und wenn ich es nun so wie bei Methode 1 richtig machen will:

SetLength(array, ZAHL + 1); air

[Khabarakh]

Zitat von Airblader:

Also es war vllt. nur ein Index zu wenig erzeugt... (wenn ich auch nich verstehe, warum keine AV kam)

Solange du im Speicherbereich deiner Anwendung bleibst, ist es Windows ziemlich egal, was du treibst.
Du bist jetzt schon der zweite in dieser Woche, der ewig nach einem Fehler sucht, weil er sein Projekt einfach nicht richtig zum Debuggen einstellt .

@Master of Wind: Um zu schauen, ob du der dritte bist : Projekt -> Optionen -> Compiler -> Bereichsprüfung
Danach am Besten das ganze Projekt neu kompilieren lassen.