Pointer auf Record aus Funktion freigeben

[Sko]

Hallo,

ich bastel grad sowas wie VoiceOverlay, das ist ein Programm was in Spielen die Namen derjenigen anzeigt, die im Teamspeak grade sprechen, nur das mein Programm das ganze auf dem Desktop anzeigt, da ich oft nebenbei noch im Internet surfe. Dank dem Beispielen die beim Teamspeak-Client dabei sind ist das auch nicht sonderlich schwer.
Also hab ich einen Timer in mein Programm gebaut der jede Sekunde prüft ob jemand spricht. Allerdings kann ich im Tastmanager sehen das das Programm jede Sekunde 4 Bytes mehr Speicher benutzt. Ich glaub das das an der Funktion liegt, die die Daten über den Benutzer ausliest. Hier mal meine Timer-Prozedur:

Delphi-Quellcode:

procedure TMainForm.PopupTimerTimer(Sender: TObject);
var
  IDs : Array[0..1023] of Integer;
  Records : Integer;
  i: integer;
  PopupForm: TPopupForm;
  PlayerInfo: TtsrPlayerInfo;
begin
  Records := 1024;
  if tsrGetSpeakers( @IDs, @records) <> 0 then exit;
  if Records > 0 then
  for i :=0 to Records-1 do
  begin
    tsrGetPlayerInfoByID(IDs[i], @PlayerInfo); //<-liest Bemutzerinfos aus
    with TPopupForm.Create(Application) do
    begin
      LName.Caption := PlayerInfo.NickName;
      Top := round(Screen.DesktopHeight/2) - (19*(i + 1));
      Left := Screen.DesktopWidth - 150;
      FormStyle := fsStayOnTop;
      Show;
    end;
  end;
end;
//Beschreibung von tsrGetPlayerInfoByID aus der Unit TsRemoteImport:
//##############################################################################
//#
//#  Function tsrGetPlayerInfoByID( PlayerID: Integer;
//#                                 tsrPlayerInfo : PtsrPlayerInfo): Integer;
//#
//#  Description:
//#    Get the Info on the player specified by PlayerID.
//#
//#  Input:
//#    PlayerID: The ID of the player you want the info from
//#    tsrPlayerInfo: This is the pointer to a TtsrPlayerInfo record
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#    if result = 0 then tsrPlayerInfo is filled with the player info.
//#
//##############################################################################

TtsrPlayerInfo ist ein packed record und sieht so aus:

Delphi-Quellcode:

  TtsrPlayerInfo = packed record
    PlayerID  : Integer;
    ChannelID : Integer;
    NickName  : Array [0..29] of Char;
    PlayerChannelPrivileges : Integer;
    PlayerPrivileges : Integer;
    PlayerFlags : Integer;
  end;

Wie kann ich verhindern das jede Sekunde neuer Speicher belegt wird?

Ich hoffe ihr könnt mir helfen.

[ste_ett]

Delphi-Quellcode:

with TPopupForm.Create(Application) do

Der Teil hier wird nicht freigegeben. :)

Delphi-Quellcode:

with TPopupForm.Create(Application) do

...

Free;

[Sko]

Oh, das hab ich vergessen zu erwähnen, auf PopupForm ist ein Timer der sie wieder freigibt

Delphi-Quellcode:

unit Popup;

interface

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

type
  TPopupForm = class(TForm)
    LName: TLabel;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  PopupForm: TPopupForm;

implementation

{$R *.dfm}

procedure TPopupForm.Timer1Timer(Sender: TObject);
begin
  Self.Free;
end;

end.

Und in einer anderen Prozedur, die ebenfalls eine ähnliche Funktion verwendet, habe ich das gleiche Problem.

[ste_ett]

Zeig mal mehr Code, vor allem die Variablen-Deklaration.

Wenn du mit dem code aus Post #1 eine Instanz der Klasse erstellst, kannst du die nicht per Timer freigeben.
Es gibt die Instanz ausserhalb der Prozedur nicht.

[Sko]

Ok, hier mal komplett:
HauptFenster

Delphi-Quellcode:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XPMan, TSRemoteImport, ExtCtrls, JvComponent,
  JvTrayIcon;

type
  TMainForm = class(TForm)
    XPManifest1: TXPManifest;
    GroupBox1: TGroupBox;
    LStatus: TLabel;
    Button1: TButton;
    Button2: TButton;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    LIP: TLabel;
    LChannels: TLabel;
    LUser: TLabel;
    LProgStatus: TLabel;
    GroupBox3: TGroupBox;
    LAktChannel: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    LAnzUserChannel: TLabel;
    Label6: TLabel;
    LCodec: TLabel;
    Tray: TJvTrayIcon;
    Label7: TLabel;
    LNick: TLabel;
    PopupTimer: TTimer;
    Label8: TLabel;
    LserverName: TLabel;
    Label9: TLabel;
    LServerLabel: TLabel;
    Label10: TLabel;
    LMaxUser: TLabel;
    Button3: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure PopupTimerTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation

uses Popup;

{$R *.dfm}
Function DisplayResult( Res: Integer ) : Boolean;
Var
  ErrorMessage: array[0..1023] of Char;
begin
  if res=0 then Result := True
  else
  begin
    tsrGetLastError(@ErrorMessage, SizeOf(ErrorMessage));
    ShowMessage(ErrorMessage);
    Result := False;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  LProgStatus.Caption := 'Initialisiere Remote-Lib...';
  case InitTSRemoteLibrary(true) of
    0 : LProgStatus.Caption := 'Remote-Lib geladen';
    -1: LProgStatus.Caption := 'Remote-Lib bereits initialisiert';
    -2: LProgStatus.Caption := 'Fehler beim Laden der Remote-Lib';
    -3: LProgStatus.Caption := 'interner Funktionsfehler';
  end;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CloseTsRemoteLibrary;
end;

procedure TMainForm.PopupTimerTimer(Sender: TObject);
var
  IDs : Array[0..1023] of Integer;
  Records : Integer;
  i: integer;
  PopupForm: TPopupForm;
  PlayerInfo: TtsrPlayerInfo;
begin
  Records := 1024;
  if tsrGetSpeakers( @IDs, @records) <> 0 then exit;
  if Records > 0 then
  for i :=0 to Records-1 do
  begin
    tsrGetPlayerInfoByID(IDs[i], @PlayerInfo);
    with TPopupForm.Create(Application) do
    begin
      LName.Caption := PlayerInfo.NickName;
      Top := round(Screen.DesktopHeight/2) - (19*(i + 1));
      Left := Screen.DesktopWidth - 150;
      FormStyle := fsStayOnTop;
      Show;
    end;
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);   //<--hier gibts das gleiche Problem, allerdings wird hier keine Form erstellt
var
  ServerInfo: TtsrServerInfo;
  UserInfo:  TtsrUserInfo;
begin
    if tsrGetServerInfo(@ServerInfo) <> 0 then
    begin
      LStatus.Caption := 'nicht verbunden';
      LStatus.Font.Color := clblack;
      LIP.Caption := '-';
      LServerName.Caption := '-';
      LChannels.Caption := '-';
      LUser.Caption := '-';
      exit;
    end
    else
    begin
      LStatus.Caption := 'verbunden';
      LStatus.Font.Color := clgreen;
      LIP.Caption := ServerInfo.ServerIp;
      LServerName.Caption := ServerInfo.ServerName;
      LServerLabel.Caption := ServerInfo.ServerPlatform;
      LChannels.Caption := IntToStr(ServerInfo.ChannelCount);
      LUser.Caption := IntToStr(ServerInfo.PlayerCount);
      LMaxUser.Caption := IntToStr(ServerInfo.ServerMaxUsers);
    end;
    if tsrGetUserInfo(@UserInfo) <> 0 then
    begin
      LNick.Caption := '-';
      LAktChannel.Caption := '-';
      LAnzUserChannel.Caption := '-';
      LCodec.Caption := '-';
      exit;
    end
    else
    begin
      LNick.Caption := UserInfo.Player.NickName;
      LAktChannel.Caption := UserInfo.Channel.Name;
      LAnzUserChannel.Caption := IntToStr(UserInfo.Channel.PlayerCountInChannel);
      case UserInfo.Channel.Codec of
         0: LCodec.Caption := 'CELP 5.1 Kbit';
         1: LCodec.Caption := 'CELP 6.4 Kbit';
         2: LCodec.Caption := 'GSM 14.8 Kbit';
         3: LCodec.Caption := 'GSM 16.4 Kbit';
         4: LCodec.Caption := 'CELP Windows 5.2 Kbit';
         5: LCodec.Caption := 'Speex 3.4 Kbit';
         6: LCodec.Caption := 'Speex 5.2 Kbit';
         7: LCodec.Caption := 'Speex 7.2 Kbit';
         8: LCodec.Caption := 'Speex 9.3 Kbit';
         9: LCodec.Caption := 'Speex 12.3 Kbit';
        10: LCodec.Caption := 'Speex 16.3 Kbit';
        11: LCodec.Caption := 'Speex 19.5 Kbit';
        12: LCodec.Caption := 'Speex 25.9 Kbit';
      end;
    end;
end;
procedure TMainForm.Button3Click(Sender: TObject);
begin
  if Button3.Caption = 'Aktivieren' then
  begin
    PopupTimer.Enabled := true;
    Button3.Caption := 'Deaktivieren';
  end
  else
  begin
    PopupTimer.Enabled := false;
    Button3.Caption := 'Aktivieren';
  end;
end;

end.

Und die Import-Unit für die DLL ist im Anhang.

[MStoll]

Zitat:

Zitat von ste_ett

Zeig mal mehr Code, vor allem die Variablen-Deklaration.

Wenn du mit dem code aus Post #1 eine Instanz der Klasse erstellst, kannst du die nicht per Timer freigeben.
Es gibt die Instanz ausserhalb der Prozedur nicht.

Da hast du zwar Recht, aber wenn ich das richtig verstanden habe, gibt die Klasse (ein Formular!) sich per Timer (auf diesem Formular) selbst frei.

Gruß Michael

[Sko]

Ja, der Timer ist ja auf dem erstellten Formular und gibt dieses mit Self.Free frei. Oder geht das so nicht?

[SirThornberry]

@Sko: Könntest du bitte dem Beitrag einen aussagekräftigen Titel geben so wie es auch in den Verhaltensregeln der DP steht denen du bei der Anmeldung zugestimmt hast. Dein Betreff deutet lediglich an das es in fernster Weise um Pointer geht und da kann es um Objecte, Listen, dynamiches Anfordern von Speicher, dereferenzieren etc. gehen. Der Titel sagt also so gut wie nichts aus.

[Sko]

Entschuldigung :oops: . Ich habs versucht zu ändern, allerdings weis ich nicht so richtig wie ich´s ausdrücken sollte.
Ich weis das der Speicherzuwachs von den folgenden Funktionen kommt:

Delphi-Quellcode:

tsrGetPlayerInfoByID(IDs[i], @PlayerInfo);
tsrGetUserInfo(@UserInfo);
tsrGetServerInfo(@ServerInfo);

Allerdings kann ich diese Pointer nicht einfach freigeben, da sie jede Sekunde gebraucht werden.

[SirThornberry]

das du nicht genau weißt wie du es ausdrücken sollst ist ok/normal da du ja eben noch an der Lösung des Problems bist. Aber man sieht das du dir jetzt Gedanken gemacht hast und der Betreff deutet darauf hin worum es geht. Perfekt :thumb:

[Christian Seehase]

Moin Sko,

ich würde den Timer zu Beginn der OnTimer-Routine ab-, und nach der Abarbeitung wieder einschalten. (so ähnlich hab' ich das heute doch schon 'mal geschrieben :gruebel: ;-))

Delphi-Quellcode:

begin
  PopupTimer.Enabled := false;
  try
    // hier der eigentliche Code für die OnTimer Routine
  finally
    PopupTimer.Enabled := true;
  end;
end;

Damit verhinderst Du, dass die Routine erneut aufgerufen wird, bevor sie abgearbeitet wurde.
Es könnte gut sein, dass die Routine länger als eine Sekunde braucht...

[Sko]

Danke, aber das geht auch nicht, immernoch das gleiche, 4 Byte pro Sekunde mehr.

[Christian Seehase]

Mion Sko,

Du könntest es auch mal mit MemProof versuchen.
Das Programm ist darauf spezialisiert die Ursachen von Speicherlecks zu entdecken.

[SirThornberry]

du erzeugst mit

Delphi-Quellcode:

with TPopupForm.Create(Application) do

bei jedem aufruf des Timerevents ein neues Formular. Gibst du das irgendwo wieder frei?

[Phantom1]

@SirThornberry: er gibt das neue Formular wieder frei in einem Timer von dem neuen Formular. Ich habe das eben mal getestet und es funktioniert wirklich korrekt, sprich der Speicher wird richtig freigegeben.

Die ursache für die 4 Byte liegt in diesem Aufruf:

Delphi-Quellcode:

with TPopupForm.Create(Application) do

ändere diesen mal folgend:

Delphi-Quellcode:

with TPopupForm.Create(nil) do

denn so muss nicht jedesmal die referenz von 4 Byte gespeichert werden, du gibts diese form ja schließlich selbst frei.

mfg

[bernau]

Versuch doch mal statt einem Free ein close

und im OnClose musst du Action=cafree angeben.

Delphi-Quellcode:

procedure TPopupForm.FormClose(Sender:TObject;var Action:TCloseAction);
begin
  action=cafree;
end;

Und die Info von C.Seehase die OnTimer-Routine ab-, einschalten ist m.E. nach auch sehr wichtig.


Gerd

[Sko]

Es geht immernoch nicht, ich hab auch zum testen mal den Teil vom PopupForm erzeugen ausgeklammert, es wird immernoch mehr. Dann kann es nur noch in dem liegen was übrig bleibt, und das sieht so aus:

Delphi-Quellcode:

procedure TMainForm.PopupTimerTimer(Sender: TObject);
var
  IDs : Array[0..1023] of Integer;
  Records : Integer;
  i: integer;
  PopupForm: TPopupForm;
  PlayerInfo: TtsrPlayerInfo;
begin
  Records := 1024;
  if tsrGetSpeakers( @IDs, @records) <> 0 then exit;
  if Records > 0 then
  for i :=0 to Records-1 do
  begin
    tsrGetPlayerInfoByID(IDs[i], @PlayerInfo);
    {with TPopupForm.Create(nil) do
    begin
      LName.Caption := PlayerInfo.NickName + '  ';
      Top := round(Screen.DesktopHeight/2) - (19*(i + 1));
      Left := Screen.DesktopWidth - 125;
      FormStyle := fsStayOnTop;
      Show;
    end; }
  end;
end;

Ich glaube das mit den Pointern was nicht stimmt, allerdings krieg ich (trotz nachschlagen im Pointer-Tut) nicht raus was.

[bernau]

Zitat:

Zitat von Sko

Es geht immernoch nicht, ich hab auch zum testen mal den Teil vom PopupForm erzeugen ausgeklammert, es wird immernoch mehr. Dann kann es nur noch in dem liegen was übrig bleibt, und das sieht so aus:

Delphi-Quellcode:

procedure TMainForm.PopupTimerTimer(Sender: TObject);
var
  IDs : Array[0..1023] of Integer;
  Records : Integer;
  i: integer;
  PopupForm: TPopupForm;
  PlayerInfo: TtsrPlayerInfo;
begin
  Records := 1024;
  if tsrGetSpeakers( @IDs, @records) <> 0 then exit;
  if Records > 0 then
  for i :=0 to Records-1 do
  begin
    tsrGetPlayerInfoByID(IDs[i], @PlayerInfo);
    {with TPopupForm.Create(nil) do
    begin
      LName.Caption := PlayerInfo.NickName + '  ';
      Top := round(Screen.DesktopHeight/2) - (19*(i + 1));
      Left := Screen.DesktopWidth - 125;
      FormStyle := fsStayOnTop;
      Show;
    end; }
  end;
end;

Ich glaube das mit den Pointern was nicht stimmt, allerdings krieg ich (trotz nachschlagen im Pointer-Tut) nicht raus was.

Dann kann es eigenslich nur noch an den Functionen tsrGetPlayerInfoByID oder tsrGetPlayerInfoByID liegen. Oder?

Gerd

[Khabarakh]

Zitat:

Zitat von Christian Seehase

Damit verhinderst Du, dass die Routine erneut aufgerufen wird, bevor sie abgearbeitet wurde.

Kann sie gar nicht, da der VCL-Timer auf Windows-Botschaften und nicht auf Threads basiert (nicht jede Klassenbibliothek hat 3 verschiedene Timer ^^ ).

@Sko: Der Fehler kann wirklich überall liegen, deswegen schließe ich mich Christian Seehase an, versuch es mal mit MemCheck/MemProof. Aber wie hast du es geschafft, dass dein Taskmanager einzelne Bytes anzeigt :gruebel: ?

[Sko]

Ja, das sind Funktionen die einen Pointer auf einen Record als Parameter bekommen und diesen Record dann mit den Daten füllen, in der Import-Unit sieht das so aus:

Delphi-Quellcode:

//##############################################################################
//#
//#  Function tsrGetSpeakers( IDs : PInteger; RecordCount: PInteger): Integer;
//#
//#  Description:
//#    Get ID list of people that are speaking now
//#
//#  Input:
//#    IDs: Buffer to hold atleast RecordCount Integers
//#    RecordCount: How much Integers IDs can hold
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#    if result = 0 then
//#                  IDs: Buffer to RecordCount* Ids of people who are talking
//#                  RecordCount: How Much people are talking
//#
//##############################################################################
Type TtsrGetSpeakers = Function ( IDs : PInteger; RecordCount: PInteger): Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrGetSpeakers : TtsrGetSpeakers;
Const fn_tsrGetSpeakers='tsrGetSpeakers';
//##############################################################################
//#
//#  Function tsrGetPlayerInfoByID( PlayerID: Integer;
//#                                 tsrPlayerInfo : PtsrPlayerInfo): Integer;
//#
//#  Description:
//#    Get the Info on the player specified by PlayerID.
//#
//#  Input:
//#    PlayerID: The ID of the player you want the info from
//#    tsrPlayerInfo: This is the pointer to a TtsrPlayerInfo record
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#    if result = 0 then tsrPlayerInfo is filled with the player info.
//#
//##############################################################################
type TtsrGetPlayerInfoByID = Function ( PlayerID: Integer; tsrPlayerInfo : PtsrPlayerInfo): Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrGetPlayerInfoByID : TtsrGetPlayerInfoByID;
Const fn_tsrGetPlayerInfoByID='tsrGetPlayerInfoByID';

So sieht der Records aus:

Delphi-Quellcode:

Type

  PtsrPlayerInfo = ^TtsrPlayerInfo;
  TtsrPlayerInfo = packed record
    PlayerID  : Integer;
    ChannelID : Integer;
    NickName  : Array [0..29] of Char;
    PlayerChannelPrivileges : Integer;
    PlayerPrivileges : Integer;
    PlayerFlags : Integer;
  end;

Zitat:

Zitat von Khabarakh

Aber wie hast du es geschafft, dass dein Taskmanager einzelne Bytes anzeigt :gruebel: ... ?

:wall: Ach verdammt, das sind ja Kilobyte...peinlich :oops:

[Sko]

So, Problem gelöst, die TSRemote.dll hatte ein Speicherleck. Wer auch mal was damit machen will, sollte diese benutzen.