I have built and run the code below as an Android app.
The app works a expected but I get a segemtation fault in the TIdSSLIOhandler when closing down.
Is the Indy components not compatible with FireMonkey?
unit Main;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IdIOHandler,
IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, FMX.Layouts, FMX.Memo,
FMX.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
http: TIdHTTP;
ioSocket: TIdSSLIOHandlerSocketOpenSSL;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
LiServer:string;
procedure DBCom(var retdata: TStringlist);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
procedure TForm1.Button1Click(Sender: TObject);
var m: TMemoryStream;
retdata: TStringList;
i:integer;
begin
m:=TMemoryStream.Create;
//--- init data
retdata:=TStringList.Create;
retdata.Add('F=1');
//--- add data
retdata.Add('Data=1');
//--- send data to server database
DBCom(retdata);
for i := 0 to retdata.Count-1 do
memo1.Lines.Add(retdata[i]);
//--- free allocated resources
retdata.Free;
m.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var m: TMemoryStream;
retdata: TStringList;
i:integer;
begin
m:=TMemoryStream.Create;
//--- init data
retdata:=TStringList.Create;
retdata.Add('F=1');
//--- add data
retdata.Add('Data=A');
//--- send data to server database
DBCom(retdata);
for i := 0 to retdata.Count-1 do
memo1.Lines.Add(retdata[i]);
//--- free allocated resources
retdata.Free;
m.Free;
end;
//============ communication with DB
procedure TForm1.DBCom(var retdata:TStringlist);
var m: TMemoryStream;
errcode,i,msgid,status,id:Integer;
begin
m:=TMemoryStream.Create;
//--- send data to server database
http.Post(LiServer, retdata, m);
m.Position:=0;
retdata.LoadFromStream(m);
//--- free allocated resources
m.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LiServer:='http://server.com/url.php';
end;
end.
The error occurs in this procedure on the SSL_CTX_free(fContext) line.
procedure TIdSSLContext.DestroyContext;
begin
if fContext <> nil then begin
SSL_CTX_free(fContext);
fContext := nil;
end;
end;
#Remy Lebeau had given me the answer I was looking for in the note above.
Related
In Delphi , With below code I can send data to Javascript and it work well , but how can send data from Javascript to Delphi ?
first , I Use below code in Javascript but did not work :
JS_DELPHI._geta() ;
even below code did not work :
TMyExtension._geta() ;
I think my code in Delphi have not some essential code.
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, ceffmx, FMX.Edit , ceflib ,
uCEFBaseRefCounted, uCEFInterfaces, uCEFTypes, uCEFListValue, uCEFBrowser, uCEFFrame, uCEFRequest,
uCEFv8Context, uCEFv8Exception, uCEFv8StackTrace, uCEFDomNode, uCEFProcessMessage, uCEFApplicationCore;
type
TForm1 = class(TForm)
ChromiumFMX1: TChromiumFMX;
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
//这里建议用class 不建议用class(TThread) 不然有些地方要报错
TMyExtension = class(TThread) // or just class, (extension code execute in thread)
public
class function _geta:string;
end;
TCustomRenderProcessHandler = class(TCefRenderProcessHandlerOwn)
protected
procedure OnWebKitInitialized; override;
end;
var
Form1: TForm1;
d : Integer ;
m : TMyExtension ;
CefRenderProcessHandler : TCustomRenderProcessHandler ;
implementation
{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}
{$R *.XLgXhdpiTb.fmx ANDROID}
{$R *.SSW3.fmx ANDROID}
procedure TForm1.Button1Click(Sender: TObject);
begin
ChromiumFMX1.Load('http://localhost/index.html');
Edit1.Text := '555 ';
ShowMessage('hiiiiiiiiiiiiiiiii');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ChromiumFMX1.Browser.MainFrame.ExecuteJavaScript(' d1();',ChromiumFMX1.browser.MainFrame.GetURL, 0);
end;
class function TMyExtension._geta: string;
begin
ShowMessage('dddddddddddddddddddddddd');
Result:='salam';
end;
procedure TCustomRenderProcessHandler.OnWebKitInitialized;
begin
{$IFDEF DELPHI14_UP}
TCefRTTIExtension.Register('JS_DELPHI', TMyExtension);
{$ENDIF}
end;
initialization
CefRemoteDebuggingPort := 9000;
CefRenderProcessHandler := TCustomRenderProcessHandler.Create;
CefBrowserProcessHandler := TCefBrowserProcessHandlerOwn.Create;
end.
end.
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;
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 one Delphi 10.0 Seattle project to FTP some files to a server.
I will do the following:
On Button1 OnClick event, I will calculate something and will make one text file. Edit1 will hold the file name.
On Button2 OnClick event, the last 4 characters of the file name will be deleted. The file will be renamed with the new name. Edit2 will hold the new name and it will be uploaded to one server.
During the file uploading, no button click will work and the Form cannot be closed. I have used one Boolean variable FileToBeTranferred. It is false at Form creation.
I have written the following code:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FileToBeTranferred: boolean;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FileToBeTranferred = false then
begin
//Do some calculation
//Edit1.Text := Output File Name
FileToBeTranferred := true;
end
else
begin
Button1.Click(nil);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if FileToBeTranferred = true then
begin
Edit2.Text := delete(Edit1.Text, (length(Edit1.Text)-4), 4);
//Upload to Server
Button2.Click(self);
end
else
begin
//Upload finished
FileToBeTranferred := false;
Button2.Click(nil);
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if FileToBeTranferred = true then CanClose := false
else CanClose := true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FileToBeTranferred := false;
end;
end.
I am unable to do anything. I am getting too many errors. The errors are as follows:
[dcc32 Error] Unit1.pas(44): E2197 Constant object cannot be passed as var parameter in Edit2.Text := delete(Edit1.Text, (length(Edit1.Text)-4), 4); - for deleting last 4 characters for file rename.
[dcc32 Error] Unit1.pas(47): E2034 Too many actual parameters in Button2.Click(nil); - as FTP is in progress so no more modification to the file is allowed. Button1.Click will not perform anything.
[dcc32 Error] Unit1.pas(47): E2034 Too many actual parameters in Button2.Click(self);- as FTP progress completed so the file is ready to be appended. Button2.Click will not perform its usual work.
What is the solution to this?
The code you have shown is just all kinds of wrong. Not just the syntax errors, but also logic errors. Even if the code compiled, your Button1 click handler will get stuck in an endless recursive loop if FileToBeTranferred is true, and your Button2 click handler will get stuck in an endless recursive loop regardless of FileToBeTranferred.
Try something more like this instead:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
FileToBeTranferred: boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if not FileToBeTranferred then
begin
//Do some calculation
//Edit1.Text := Output File Name
FileToBeTranferred := True;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if FileToBeTranferred then
begin
Edit2.Text := Copy(Edit1.Text, 1, Edit1.GetTextLen-4);
//Upload to Server, wait for completion
FileToBeTranferred := False;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := not FileToBeTranferred;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FileToBeTranferred := False;
end;
end.
That being said, you might consider a different approach. For instance, one that doesn't require the FileToBeTranferred Boolean at all:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Enabled := False;
//Do some calculation
//Edit1.Text := Output File Name
Button2.Enabled := True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Button2.Enabled := False;
Edit2.Text := Copy(Edit1.Text, 1, Edit1.GetTextLen-4);
//Upload to Server
Button1.Enabled := True;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := Button1.Enabled;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Enabled := True;
Button2.Enabled := False;
end;
end.
Or, you could combine the two approaches, by enabling/disabling the TButton objects based on the current value of FileToBeTranferred at any given moment.
You can override the Form's virtual UpdateActions() method:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
protected
procedure UpdateActions; override;
private
{ Private declarations }
FileToBeTranferred: boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
//Do some calculation
//Edit1.Text := Output File Name
FileToBeTranferred := True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Edit2.Text := Copy(Edit1.Text, 1, Edit1.GetTextLen-4);
//Upload to Server, wait for completion
FileToBeTranferred := False;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := not FileToBeTranferred;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FileToBeTranferred := False;
end;
procedure TForm1.UpdateActions;
begin
inherited;
Button1.Enabled := not FileToBeTranferred;
Button2.Enabled := FileToBeTranferred;
end;
end.
Or, you can drop a TActionList on the Form and assign a TAction to each TButton, and then enable/disable the TAction objects in their OnUpdate events:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Math, Vcl.ActnList;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
ActionList1: TActionList;
Action1: TAction;
Action2: TAction;
procedure Action1Update(Sender: TObject);
procedure Action2Update(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FileToBeTranferred : Boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Action1Update(Sender: TObject);
begin
Action1.Enabled := not FileToBeTranferred;
end;
procedure TForm1.Action2Update(Sender: TObject);
begin
Action2.Enabled := FileToBeTranferred;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//Do some calculation
//Edit1.Text := Output File Name
FileToBeTranferred := True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Edit2.Text := Copy(Edit1.Text, 1, Edit1.GetTextLen-4);
//Upload to Server, wait for completion
FileToBeTranferred := False;
end;
end.
I have problem with host application, which loads DLL form and interfaceing some function and properties.
The purpose is load a dll, show name as module name, set connection to ADOTable component and show form with data. Everything is working fine. But after close the host app a host app crashed and I get windows that hostapp.exe stopped working.
I do not know whether it is by freeing library or setting nil for interface.
Do you have any solution? Thanks.
Interface CODE
unit u_baseplugin_intf;
interface
uses Data.Win.ADODB, Data.DB;
type
IBaseModuleInterface = interface
['{060A9C46-B3CF-4BA4-B025-2DC1D9F45076}']
function GetModuleName: Ansistring;stdcall;
procedure SetConn(sConn:TAdoConnection);stdcall;
procedure showF;stdcall;
procedure freeF;stdcall;
property ModuleName: Ansistring read GetModuleName;
property Connection : TAdoConnection write SetConn;
end;
implementation
end.
DLL code
library profileslist;
uses
System.SysUtils,
System.Classes,
u_baseplugin_intf,
u_profileslist in 'u_profileslist.pas' {Form_DLL};
{$R *.res}
function LoadModule:IBaseModuleInterface;stdcall;
begin
result:=TForm_DLL.Create(nil);
end;
exports
LoadModule;
begin
end.
DLL Form code
unit u_profileslist;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls,
u_baseplugin_intf, Data.DB,Data.Win.ADODB;
type
TForm_DLL = class(TForm, IBaseModuleInterface)
DBGrid1: TDBGrid;
ADOTable1: TADOTable;
DataSource1: TDataSource;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
{Interface methods implementation}
function GetModuleName: AnsiString;stdcall;
procedure SetConn(sConn:TAdoConnection);stdcall;
public
{ Public declarations }
{Interface methods implementation}
procedure ShowF;stdcall;
procedure FreeF;stdcall;
end;
var
Form_DLL: TForm_DLL;
implementation
{$R *.dfm}
{Interface methods implementation}
function TForm_DLL.GetModuleName;
begin
Result := 'Profiles list';
end;
procedure TForm_DLL.SetConn(sConn: TAdoConnection);
begin
AdoTable1.Connection:=sConn;
end;
procedure TForm_DLL.ShowF;
begin
ShowModal;
end;
procedure TForm_DLL.FreeF;
begin
FreeAndNil(Form_DLL);
end;
{Form_DLL methods implementation}
procedure TForm_DLL.FormClose(Sender: TObject; var Action: TCloseAction);
begin
AdoTable1.Active:=false;
end;
procedure TForm_DLL.FormShow(Sender: TObject);
begin
AdoTable1.Active:=true;
end;
end.
HOST app code
program hostapp;
uses
Vcl.Forms,
u_hostapp in 'u_hostapp.pas' {Form1},
u_baseplugin_intf in 'u_baseplugin_intf.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Host app FORM code
unit u_hostapp;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
u_baseplugin_intf,
Data.Win.ADODB, Data.DB;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TModuleInterface = function:IBaseModuleInterface; stdcall;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
aModuleIntf : IBaseModuleInterface;
dllHandle : cardinal;
procedure LoadModule( aLibName : pWideChar );
var
lModule : TModuleInterface;
begin
dllHandle := LoadLibrary(aLibName) ;
if dllHandle <> 0 then
begin
#lModule := GetProcAddress(dllHandle, 'LoadModule') ;
if Assigned (lModule) then
aModuleIntf := lModule //call the function
else
begin
ShowMessage('GetModuleIntf not found.') ;
FreeLibrary(dllHandle) ;
end;
end
else
begin
ShowMessage(aLibName+' not found.') ;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
aModuleIntf.Connection:=AdoConnection1;
aModuleIntf.ShowF;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
aModuleIntf.Connection:=nil;
aModuleIntf.freeF;
aModuleIntf:=nil;
FreeLibrary(dllHandle);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadModule('profileslist.dll');
Label1.Caption:=aModuleIntf.ModuleName;
end;
end.
You never assign to Form_DLL. This means that when you call FreeF, you then perform FreeAndNil(Form_DLL). Since Form_DLL is nil, this does nothing, and the form still exists.
Fix that by changing LoadModule:
function LoadModule:IBaseModuleInterface;stdcall;
begin
Assert(not Assigned(Form_DLL));
Form_DLL:=TForm_DLL.Create(nil);
result:=Form_DLL;
end;
Although, I'd probably change the design completely by removing Form_DLL altogether. The host app maintains a reference to the form, on which the call to Free can be made. In other words, remove Form_DLL and implement FreeF like this:
procedure TForm_DLL.FreeF;
begin
Free; // or Destroy
end;
Or even better, use reference counted interfaces on the implementing object and let aModuleIntf:=nil take the form down.