Just learning some OpenGL with delphi and trying something simple but not getting a result, I belive i should get a dark green form. But when i run this i get nothing. No errors either. maybe missing something?
unit First1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls,OpenGL, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm2 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
GLContext : HGLRC;
ErrorCode: GLenum;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
var
pfd: TPixelFormatDescriptor;
FormatIndex: integer;
begin
fillchar(pfd,SizeOf(pfd),0);
with pfd do
begin
nSize := SizeOf(pfd);
nVersion := 1; {The current version of the desccriptor is 1}
dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
iPixelType := PFD_TYPE_RGBA;
cColorBits := 24; {support 24-bit color}
cDepthBits := 32; {depth of z-axis}
iLayerType := PFD_MAIN_PLANE;
end; {with}
FormatIndex := ChoosePixelFormat(Canvas.Handle,#pfd);
SetPixelFormat(Canvas.Handle,FormatIndex,#pfd);
GLContext := wglCreateContext(Canvas.Handle);
wglMakeCurrent(Canvas.Handle,GLContext);
end; {FormCreate}
procedure TForm2.FormDestroy(Sender: TObject);
begin
wglMakeCurrent(Canvas.Handle,0);
wglDeleteContext(GLContext);
end;
procedure TForm2.FormPaint(Sender: TObject);
begin
{background}
glClearColor(0.0,0.4,0.0,0.0);
glClear(GL_COLOR_BUFFER_BIT);
{error checking}
errorCode := glGetError;
if errorCode<>GL_NO_ERROR then
raise Exception.Create('Error in Paint'#13+
gluErrorString(errorCode));
end;
end.
Since you request a single buffered context, you must call glFinish at the end of the rendering code, to commit your drawing commands to the implementation. However I strongly suggest you switch to using a double buffered context and instead of glFinish-ing you issue a wglSwapBuffers which implies a finish.
Related
I need to play and loop a WAV audio track from resources.
I found an answer to a similar question here: https://stackoverflow.com/a/47960211/19160533
But when I paste it into my code, it says this:
My resources look like this (don't mind the name of the project):
The code I pasted into my project is:
procedure TForm1.FormShow(Sender: TObject);
begin
PlaySound(BG, 0, SND_RESOURCE or SND_ASYNC);
end;
And the whole thing looks like this:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls, Unit2, Unit3, Unit4, Unit5,
Vcl.MPlayer, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
MediaPlayer1: TMediaPlayer;
Button1: TButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure MediaPlayer1Enter(Sender: TObject);
procedure MediaPlayer1Notify(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
begin
PlaySound(BG, 0, SND_RESOURCE or SND_ASYNC);
end;
Maybe I need to include some library or something else? I'm new to Delphi.
To use PlaySound() in Delphi, you simply need to add the Winapi.MMSystem unit to your uses clause.
But, since you also have a TMediaPlayer in your project, you could use that instead of PlaySound(), which would have the extra benefit of giving you more control over the playback (pausing/resuming, skipping, etc).
TMediaPlayer does not natively support playing WAV audio from a resource, but it can be done with a little extra coding.
Internally, TMediaPlayer uses MCI via the mciSendCommand() function. According to Microsoft (HOWTO: Use MCI to Play AVI/WAVE Files from Memory), you can setup MCI to play WAV audio from memory (such as a resource) by installing a custom IO callback, and then specifying that callback when opening the player device. Fortunately, the callback is triggered by file extension, hence this approach is compatible with the TMediaPlayer.FileName property.
So, you should be able to write an IO callback function with a custom file extension (for example, .RES for resource), and have that callback load the WAV resource and read its data, and then you would set MediaPlayer1.DeviceType to dtWaveAudio and MediaPlayer1.FileName to a filename ending with the custom extension. The rest is handled by the OS for you, and you can then use MediaPlayer1 to control the playback as needed.
For example (untested, might need some tweaking):
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls, Unit2, Unit3, Unit4, Unit5,
Vcl.MPlayer, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
MediaPlayer1: TMediaPlayer;
Button1: TButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure MediaPlayer1Enter(Sender: TObject);
procedure MediaPlayer1Notify(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Winapi.MMSystem;
{$R *.dfm}
function MAKEFOURCC(ch0, ch1, ch2, ch3: BYTE): FOURCC;
begin
Result := DWORD(ch0) or (DWORD(ch1) shl 8) or (DWORD(ch2) shl 16) or (DWORD(ch3) shl 24);
end;
function MyResourceIOProc(lpMMIOInfo: PMMIOInfo; uMessage: UINT; lParam1, lParam2: LPARAM): LRESULT; stdcall;
var
Res: TResourceStream;
function GetResourceStream: TResourceStream;
begin
Move(lpMMIOInfo.adwInfo, Result, SizeOf(TResourceStream));
end;
procedure SetResourceStream(Stream: TResourceStream);
begin
Move(Stream, lpMMIOInfo.adwInfo, SizeOf(TResourceStream));
end;
begin
case uMessage of
MMIOM_OPEN: begin
try
Res := TResourceStream.Create(HInstance, ChangeFileExt(PChar(lParam1), ''), 'WAVE');
except
SetResourceStream(nil);
Exit(MMIOM_CANNOTOPEN);
end;
SetResourceStream(Res);
lpMMIOInfo.lDiskOffset := 0;
Exit(MMSYSERR_NOERROR);
end;
MMIOM_CLOSE: begin
Res := GetResourceStream;
SetResourceStream(nil);
Res.Free;
Exit(MMSYSERR_NOERROR);
end;
MMIOM_READ: begin
Res := GetResourceStream;
Move((PByte(Res.Memory) + lpMMIOInfo.lDiskOffset)^, Pointer(lParam1)^, lParam2);
Inc(lpMMIOInfo.lDiskOffset, lParam2);
Exit(lParam2);
end;
MMIOM_SEEK: begin
case lParam2 of
SEEK_SET: begin
lpMMIOInfo.lDiskOffset := lParam1;
end;
SEEK_CUR: begin
Inc(lpMMIOInfo.lDiskOffset, lParam1);
end;
SEEK_END: begin
Res := GetResourceStream;
lpMMIOInfo.lDiskOffset := Res.Size - 1 - lParam1;
end;
end;
Exit(lpMMIOInfo.lDiskOffset);
end;
else
Exit(MMSYSERR_NOERROR);
end;
end;
var
ccRES: FOURCC;
procedure TForm1.FormCreate(Sender: TObject);
begin
ccRES := MAKEFOURCC(Ord('R'), Ord('E'), Ord('S'), Ord(' '));
mmioInstallIOProc(ccRES, TFNMMIOProc(MyResourceIOProc), MMIO_INSTALLPROC or MMIO_GLOBALPROC);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
mmioInstallIOProc(ccRES, nil, MMIO_REMOVEPROC);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
MediaPlayer1.FileName := 'BG.RES+';
MediaPlayer1.Open;
MediaPlayer1.Play;
end;
I'm trying to modify the text being pasted inside a TEdit descendant.
When the user paste some text, I want to replace all 'X' chars with an 'Y', without modifying the actual clipboard text content.
I've intercepted the WM_PASTE message, but I'm not aware about any "clean" way to change the text that's being pasted into the control.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TMyEdit = class(Vcl.StdCtrls.TEdit)
private
procedure WMPaste(var Msg: TWMPaste); message WM_PASTE;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Clipbrd;
procedure TMyEdit.WMPaste(var Msg: TWMPaste);
begin
inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Edt : TMyEdit;
begin
Edt := TMyEdit.Create(Self);
Edt.Top := 10;
Edt.Left := 10;
Edt.Parent := Self;
end;
end.
The only working way I've found is to temporarly replace the clipboard content, but I'm looking for a cleaner solution (if there's one...).
procedure TMyEdit.WMPaste(var Msg: TWMPaste);
var
PrevClipboardText : string;
begin
if(IsClipboardFormatAvailable(CF_TEXT)) then
begin
PrevClipboardText := Clipboard.AsText;
try
Clipboard.AsText := StringReplace(Clipboard.AsText, 'X', 'Y', [rfReplaceAll]);
inherited;
finally
Clipboard.AsText := PrevClipboardText;
end;
end else
begin
inherited;
end;
end;
Why not do the obvious thing?
procedure TEdit.WMPaste(var Msg: TWMPaste);
begin
SelText := F(Clipboard.AsText);
end;
where F is your string-transforming function.
Hi guys I have an Error that appeared and that I cant get rid off..
I added 2 custom procedures to my delphi code and I read that you can hit crtl+shift+c to autogenerate the functions, which I did.
However my problem now is that I didnt need the autogenerated stuff thats why I deleted it after executing the command. Now my code does not work anymore because of this error I am getting:
E2029 Declaration expected but end of file found
Expected INITIALIZATION but recieved the end of file at line 520(520:1)
How can I fixx my code? Removing or adding a 'end' at the end of the file does not help me. Is there a way to find out where something is missing in my code? (I could post my delphi code but its 500lines long I dont think that makes sense.
Update Code:
unit Benutzerverwaltung_U;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls,
Vcl.StdCtrls,
Vcl.WinXCtrls, Vcl.CheckLst, System.Actions, Vcl.ActnList, Vcl.Menus,
System.StrUtils,
Data.DB, Vcl.Grids, Vcl.DBGrids, Vcl.DBCtrls, FireDAC.Stan.Intf,
FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Comp.DataSet,
FireDAC.Comp.Client;
type
TForm1 = class(TForm)
other buttons and so on...
procedure SwapValues(var Zahl1, Zahl2: Integer); //new
procedure SelectionSort(Sender: TObject); // new
procedure Button11Click(Sender: TObject); //new
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
workerModel: record
VorName: string[40];
NachName: string[40];
Age: Integer;
Schließen: string[30];
Admin: TToggleSwitchState;
DatenSehen: TToggleSwitchState;
Gender: string[20];
end;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses Sonderrechte_U, CheckedItem_U, Unit1, BenutzerEdit_u;
procedure TForm1.SwapValues(var Zahl1, Zahl2: Integer);
var
h: Integer;
begin
h := Zahl1;
Zahl1 := Zahl2;
Zahl2 := h;
end;
procedure TForm1.SelectionSort(Sender: TObject);
var
i, j, min: Integer;
var
sortArray, Data: Array of string;
begin
for i := 1 to Form1.ListBox1.Items.Count - 1 do
// i muss wahrscheinlich 0 sein?
begin
min := i;
for j := i + 1 to Form1.ListBox1.Items.Count do
if (Data[j] < Data[min]) then
min := j;
SwapValues(i, min);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
try
Form2.ShowModal;
finally
Form2.Free;
end;
end;
// more code
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
l: Integer;
t: String;
begin
with ListBox1 do
begin
Canvas.FillRect(Rect);
t := Items[Index];
l := Rect.Right - Canvas.TextWidth(t) - 1;
Canvas.TextOut(l, Rect.Top, t);
end;
end;
procedure TForm1.SearchBox1Change(Sender: TObject);
var
i: Integer;
begin
// SearchBox1.Parent := ListBox1;
ListBox1.Items.BeginUpdate;
try
for i := 0 to ListBox1.Items.Count - 1 do
ListBox1.Selected[i] := ContainsText(ListBox1.Items[i], SearchBox1.Text);
finally
ListBox1.Items.EndUpdate;
end;
// end;
// this is the end of the file
A Delphi unit must end with
end.
(notice the full stop).
Below I have some code. What I want to happen is when a button is pressed it creates, or closes, a MIDI connection depending on the state of an existing connection.
But, when attempting to close the MIDI handle I get an error response code 5, which means an invalid handle to a MIDI device has been passed to midiInClose.
I'm not sure why this is happening by my guess is scope issues? I just can't figure out how to resolve this. Should the hMidiIn be defined as a class variable within the form?
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.UITypes, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
MMSystem, uMIDI;
type
TForm2 = class(TForm)
MidiInputCombo: TComboBox;
Label1: TLabel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
IsConnected: Boolean = False;
SelectedMidiInputID: Integer = 0;
hMidiIn: PHMIDIIN;
implementation
{$R *.dfm}
procedure MidiInProc(hmi: PHMIDIIN; wMsg: UINT; dwInstance: DWORD_PTR; dwParam1: DWORD_PTR; dwParam2: DWORD_PTR); stdcall;
begin
// Do something
end;
procedure TForm2.Button1Click(Sender: TObject);
var
MidiInCloseResult: Integer;
begin
if IsConnected then
begin
MidiInCloseResult := midiInClose(hMidiIn^);
if MidiInCloseResult = MMSYSERR_NOERROR then
begin
IsConnected := False;
Button1.Caption := 'Connect';
end
else
MessageDlg('Response: ' + IntToStr(MidiInCloseResult), mtInformation, [mbOk], 0, mbOk);
end
else
if midiInOpen(#hMidiIn, SelectedMidiInputID, DWORD_PTR(#MidiInProc), 0, CALLBACK_FUNCTION) = MMSYSERR_NOERROR then
begin
IsConnected := True;
Button1.Caption := 'Disconnect';
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
var
I: Integer;
DevCount: Integer;
Pmic: MIDIINCAPS;
begin
DevCount := MidiInputDeviceCount();
if DevCount > 0 then
for I := 0 to DevCount do
midiInGetDevCaps(I, #Pmic, SizeOf(pmic));
MidiInputCombo.Items.Add(Pmic.szPname);
MidiInputCombo.ItemIndex := SelectedMidiInputID;
end;
end.
I have created a simple DataSnap client/server application with the wizard in Delphi XE8 using the echostring and reversestring sample methods. When I put "ReportMemoryLeaksOnShutdown := True" in the Server dpr and call the echostring and/or reversestring methods from the client the result is good but when I close the server application (after closing the client) I always get 2 or more unknown memory leaks. Is this a known bug which I can't find on the internet or is there a solution?
Server code:
unit ServerMethodsUnit;
interface
uses System.SysUtils, System.Classes, System.Json,
Datasnap.DSServer, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter;
type
{$METHODINFO ON}
TServerMethods = class(TDataModule)
private
{ Private declarations }
public
{ Public declarations }
function EchoString(Value: string): string;
function ReverseString(Value: string): string;
end;
{$METHODINFO OFF}
implementation
{%CLASSGROUP 'FMX.Controls.TControl'}
{$R *.dfm}
uses System.StrUtils;
function TServerMethods.EchoString(Value: string): string;
begin
Result := Value;
end;
function TServerMethods.ReverseString(Value: string): string;
begin
Result := System.StrUtils.ReverseString(Value);
end;
end.
dfm
object ServerContainer: TServerContainer
OldCreateOrder = False
Height = 271
Width = 415
object DSServer1: TDSServer
Left = 96
Top = 11
end
object DSTCPServerTransport1: TDSTCPServerTransport
Server = DSServer1
Filters = <>
Left = 96
Top = 73
end
object DSServerClass1: TDSServerClass
OnGetClass = DSServerClass1GetClass
Server = DSServer1
Left = 200
Top = 11
end
end
dfm project file
program DataSnap_Server;
uses
FMX.Forms,
Web.WebReq,
IdHTTPWebBrokerBridge,
ServerMainForm in 'ServerMainForm.pas' {Form2},
ServerMethodsUnit in 'ServerMethodsUnit.pas' {ServerMethods: TDataModule},
ServerContainerUnit in 'ServerContainerUnit.pas' {ServerContainer: TDataModule};
{$R *.res}
begin
ReportMemoryLeaksOnShutdown := True;
Application.Initialize;
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TServerContainer, ServerContainer);
Application.Run;
end.
client side code generated source
//
// Created by the DataSnap proxy generator.
// 14-5-2015 22:45:56
//
unit ClientClassesUnit;
interface
uses System.JSON, Data.DBXCommon, Data.DBXClient, Data.DBXDataSnap, Data.DBXJSON, Datasnap.DSProxy, System.Classes, System.SysUtils, Data.DB, Data.SqlExpr, Data.DBXDBReaders, Data.DBXCDSReaders, Data.DBXJSONReflect;
type
TServerMethodsClient = class(TDSAdminClient)
private
FEchoStringCommand: TDBXCommand;
FReverseStringCommand: TDBXCommand;
public
constructor Create(ADBXConnection: TDBXConnection); overload;
constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
destructor Destroy; override;
function EchoString(Value: string): string;
function ReverseString(Value: string): string;
end;
implementation
function TServerMethodsClient.EchoString(Value: string): string;
begin
if FEchoStringCommand = nil then
begin
FEchoStringCommand := FDBXConnection.CreateCommand;
FEchoStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FEchoStringCommand.Text := 'TServerMethods.EchoString';
FEchoStringCommand.Prepare;
end;
FEchoStringCommand.Parameters[0].Value.SetWideString(Value);
FEchoStringCommand.ExecuteUpdate;
Result := FEchoStringCommand.Parameters[1].Value.GetWideString;
end;
function TServerMethodsClient.ReverseString(Value: string): string;
begin
if FReverseStringCommand = nil then
begin
FReverseStringCommand := FDBXConnection.CreateCommand;
FReverseStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
FReverseStringCommand.Text := 'TServerMethods.ReverseString';
FReverseStringCommand.Prepare;
end;
FReverseStringCommand.Parameters[0].Value.SetWideString(Value);
FReverseStringCommand.ExecuteUpdate;
Result := FReverseStringCommand.Parameters[1].Value.GetWideString;
end;
constructor TServerMethodsClient.Create(ADBXConnection: TDBXConnection);
begin
inherited Create(ADBXConnection);
end;
constructor TServerMethodsClient.Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean);
begin
inherited Create(ADBXConnection, AInstanceOwner);
end;
destructor TServerMethodsClient.Destroy;
begin
FEchoStringCommand.DisposeOf;
FReverseStringCommand.DisposeOf;
inherited;
end;
end.
Own source
unit ClientMainForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
ClientModuleUnit;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := ClientModule.ServerMethodsClient.EchoString(Edit1.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Label1.Caption := ClientModule.ServerMethodsClient.ReverseString(Edit1.Text);
end;
end.
Memory leak looks like always exist, or, we doing something wrong.
What I checked:
I move all server app code into the one unit.
I try server app without FMX - with VCL.
I try to create TDSServer, TDSTCPServerTransport, TDSServerClass in runtime with parents Self and Nil.
I try with TServerMethod class owner TPersistance and TComponent (Delphi help says to use it).
I try with compiled server app as 32 bit and 64 bit application in Delphi XE7 Update 1 and in Delphi XE8.
EurekaLog 7.2.2 cannot catch details about memory leak also.
For avoid catching Access Violation by EurekaLog need to use DSServer1.Stop before exit.
As we could see Access Violation when you using EurekaLog happens there
Basically it's in
System.TObject.InheritsFrom(???)
System._IsClass($64AE4E0,TDSServerTransport)
Datasnap.DSCommonServer.TDSCustomServer.StopTransports
Datasnap.DSCommonServer.TDSCustomServer.Stop
Datasnap.DSServer.TDSServer.Stop
Datasnap.DSServer.TDSServer.Destroy
System.TObject.Free
System.Classes.TComponent.DestroyComponents
System.Classes.TComponent.Destroy
System.Classes.TDataModule.Destroy
System.TObject.Free
System.Classes.TComponent.DestroyComponents
FMX.Forms.DoneApplication
System.SysUtils.DoExitProc
System._Halt0
:00408da8 TObject.InheritsFrom + $8
Server app:
unit ufmMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Datasnap.DSServer, Datasnap.DSTCPServerTransport, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter, Datasnap.DSCommonServer,
IPPeerServer;
type
{$METHODINFO ON}
TServerMethods = class(TComponent)
private
{ Private declarations }
public
{ Public declarations }
function EchoString(Value: string): string;
end;
{$METHODINFO OFF}
TfmMain = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
DSServer1: TDSServer;
DSTCPServerTransport1: TDSTCPServerTransport;
DSServerClass1: TDSServerClass;
procedure DSServerClass1GetClass(DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
end;
var
fmMain: TfmMain;
implementation
{$R *.dfm}
uses System.StrUtils;
function TServerMethods.EchoString(Value: string): string;
begin
Result := Value;
end;
procedure TfmMain.DSServerClass1GetClass(DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
PersistentClass := TServerMethods;
end;
procedure TfmMain.FormCreate(Sender: TObject);
begin
DSServer1 := TDSServer.Create(nil);
DSServer1.Name := 'DSServer1';
DSServer1.AutoStart := False;
DSTCPServerTransport1 := TDSTCPServerTransport.Create(nil);
DSTCPServerTransport1.Server := DSServer1;
DSServerClass1 := TDSServerClass.Create(nil);
DSServerClass1.Server := DSServer1;
DSServerClass1.OnGetClass := DSServerClass1GetClass;
DSServer1.Start;
end;
procedure TfmMain.FormDestroy(Sender: TObject);
begin
DSServer1.Stop;
DSServerClass1.Free;
DSTCPServerTransport1.Free;
DSServer1.Free;
end;
end.
I guess it is a known bug for XE8 by now, I think it's pretty serious, at least serious enough for us NOT to use XE8 before Embarcadero has given us an answer on what's going on.
We had a similar issue in XE2, as far as I remember it was on heavy callbacks.
This Eurekalog doesn't tell me much, it looks like deep inside datasnap, sorry I don't know how to make the log more readable.
EDIT:
I reported this issue to Embarcadero and got this response today:
//
Hi Henrik,
Part of the memory leaks are due to a bug in the System.Collections.Generics.pas, we are looking at releasing a fix this issue in very near future.
brgds
Roy.
//
Thought you might wanna know :)