Runtime error 216/217 beim Beenden

[Unplugged]

Hallo,

ich versuche seit kürzeres mehr dll's zu nutzen. Obwohl die Applikation bis jetzt alles so macht, wie sie es soll, krieg ich beim Beenden des Programmes immer Runtime Errors.

Vielleicht sieht ja jemand von euch nen Fehler ?

Hauptprojekt

Delphi-Quellcode:

unit update;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdHTTP, ExtCtrls, ComCtrls, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdGlobal, ProcUpdate;

type
  Tupdatefrm = class(TForm)
    ListBox1: TListBox;
    ProgressBar1: TProgressBar;
    Panel1: TPanel;
    Label1: TLabel;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    procedure Install;
  end;

var
  updatefrm: Tupdatefrm;
  request: ProcUpdate.TDownload;

implementation

{$R *.dfm}

procedure Tupdatefrm.FormActivate(Sender: TObject);
Var
  test: String;
begin
  test := 'http://sft.darksoft-projects.de/releases/nw/update.php';
  request := GetVersionExt(PChar(test), ListBox1);
end;
end.

Unit ProcUpdate

Delphi-Quellcode:

unit ProcUpdate;

interface

uses ComCtrls, StdCtrls, Windows, SysUtils,
  IdTCPConnection,
  IdBaseComponent,
  IdComponent,
  IdHTTP,
  IdTCPClient,
  Dialogs;

type
  TFiles = record
    size: LongInt;
    fname: PChar;
    version: Integer;
  end;
  TDownload = record
    location: PChar;
    files: array of TFiles;
    name: PChar;
    url: PChar;
    count: Integer;
    lasterror: PChar;
  end;
  TFilesExt = record
    size: LongInt;
    fname: String;
    version: Integer;
  end;
  TDownloadExt = record
    location: String;
    files: array of TFilesExt;
    name: String;
    url: String;
    count: Integer;
    lasterror: String;
  end;

  function GetVersionExt(url: PChar; ListBox1: TListBox): ProcUpdate.TDownload; stdcall; external 'update.dll';

implementation

end.

Source der update.dll

Delphi-Quellcode:

library update;

uses
  Classes,
  ComCtrls,
  Dialogs,
  Forms,
  StdCtrls,
  SysUtils,
  Windows,
  IdTCPConnection,
  IdBaseComponent,
  IdComponent,
  IdHTTP,
  IdTCPClient;

type
  TFiles = record
    size: LongInt;
    fname: PChar;
    version: Integer;
  end;
  TDownload = record
    location: PChar;
    files: array of TFiles;
    name: PChar;
    url: PChar;
    count: Integer;
    lasterror: PChar;
  end;
  TFilesExt = record
    size: LongInt;
    fname: String;
    version: Integer;
  end;
  TDownloadExt = record
    location: String;
    files: array of TFilesExt;
    name: String;
    url: String;
    count: Integer;
    lasterror: String;
  end;

Var
  Status        : TProgressBar;
  Ausgabe       : TLabel;
  Size          : LongInt;

{$R *.res}

function GetVersion(url: PChar; ListBox1: TListBox): TDownload; stdcall; overload;
Var
  start, stop, x: Integer;
  stream, temp: String;
  web: TIdHTTP;
  daten: TDownloadExt;
begin
  daten.url := String(url);

  web := TIdHTTP.Create(nil);
  stream := web.Get(daten.url);       // HTML-Quelltext ( ~ XML )

  temp := stream;
  start := Pos('<count>', temp);
  stop := Pos('</count>', temp);
  temp := Copy(temp, 1, stop - 1);
  Delete(temp, 1, start + 6);
  try
    daten.count := StrToInt(temp);
  except
    ShowMessage('Die Updatepage enthält Fehler');
    Exit;
  end;

  SetLength(daten.files, daten.count);       // Setze Länge des Arrays

  temp := stream;
  start := Pos('<location>', temp);
  stop := Pos('</location>', temp);
  temp := Copy(temp, 1, stop - 1);
  Delete(temp, 1, start + 9);
  daten.location := temp;

  temp := stream;
  start := Pos('<name>', temp);
  stop := Pos('</name>', temp);
  temp := Copy(temp, 1, stop - 1);
  Delete(temp, 1, start + 5);
  daten.name := Trim(temp);

  x := 0;
  repeat
    temp := stream;
    start := Pos('<file>', temp);
    stop := Pos('</file>', temp);
    if ( ( start = 0 ) Or ( x > result.count - 1 ) ) then break;
    Delete(stream, 1, stop + 6);
    temp := Copy(temp, 1, stop - 1);
    Delete(temp, 1, start + 5);
    stop := Pos(',', temp);
    daten.files[x].fname := PChar(Copy(temp, 1, stop - 1));
    Delete(temp, 1, stop);
    try
      daten.files[x].version := StrToInt(Trim(temp));
    except
      daten.files[x].version := -1;
    end;
    try
      web.Head(daten.location + '/' + String(daten.files[x].fname));
      daten.files[x].size := web.Response.ContentLength;
    except
      daten.files[x].size := -1;
    end;
    ListBox1.Items.Append(IntToStr(daten.files[x].size));
    inc(x);
  until ( start = 0 );

  if ( x <= daten.count ) then begin
    // Es fehlen Dateieinträge
    result.lasterror := 'Fehlende Einträge im Script';
  end;

  web.Free;
  ListBox1.Items.Append('Programm : ' + daten.name);
  ListBox1.Items.Append(daten.location);

  result.location := PChar(daten.location);
  result.name := PChar(daten.name);
  result.url := PChar(daten.url);
  result.lasterror := PChar(daten.lasterror);
  result.count := daten.count;
  SetLength(result.files, result.count);
  for x := 0 to daten.count - 1 do begin
    result.files[x].fname := PChar(daten.files[x].fname);
    result.files[x].size := daten.files[x].size;
    result.files[x].version := daten.files[x].version;
  end;
end;

exports
  GetVersion(url: PChar; ListBox1: TListBox) name 'GetVersionExt';

begin
end.

Danke für alle Hinweise!

[MrAlexander]

Zitat von Unplugged:

Source der update.dll

Delphi-Quellcode:

library update;
.
.
function GetVersion(url: PChar; ListBox1: TListBox): TDownload; stdcall; overload;
Var
.
.
begin
  daten.url := String(url);

  web := TIdHTTP.Create(nil);
  .
  .
  try
    daten.count := StrToInt(temp);
  except
    ShowMessage('Die Updatepage enthält Fehler');
    Exit;
  end;
  .
  .
  web.Free;
  .
end;
.
.
begin
end.

Hallo.

Ich hatte bei meiner Ligaverwaltung das gleiche Problem. TEILWEISE lag es wohl daran, daß ich zB
diverse CREATE's nicht freigab.

Hier sehe ich zB in der GetVersion ein web.create mit einem EXIT ohne "web.free".

Bei mir haben die FREE's geholfen ...

mfG aus Wien,
Alex