This question already has answers here:
Delphi: Access Violation at the end of Create() constructor
(2 answers)
Closed 5 years ago.
It fails in this simple example to:
procedure TForm1.Button1Click(Sender: TObject);
var
ts: TStream;
begin
ts.Create; //<---- fails here
ts.Free;
end;
With error:
Project project1 raised exception class 'External: SIGSEGV'.
At address 10000DB38
You are using the wrong code. It should be
procedure TForm1.Button1Click(Sender: TObject);
var
ts: TStream;
begin
ts := TStream.Create; // If Lazarus supports creation of Stream instances.
ts.Free;
end;
Until it is created, your variable ts simply contains junk from previous use of the stack. You have to call the class's constructor to allocate the actual object on the heap and point your ts variable at it.
If Lazarus complains that it can't create an instance of TStream (it may treat it as an abstract class and I don't have Lazarus on this machine to check), try something like this instead:
var
ts: TMemoryStream;
begin
ts := TMemoryStream.Create;
ts.Free;
end;
Instead of TMemoryStream, you could use any other concrete TStream-descendant class.
Was originaly trying this code:
memStream.Create;
But it should be:
memStream := TMemoryStream.Create;
Blah...
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 days ago.
This post was edited and submitted for review 8 days ago and failed to reopen the post:
Original close reason(s) were not resolved
Improve this question
Given an array of pointers where those pointers are to procedures and where they pass a single pointer passed to a procedure, how do you call the passed pointer?
procedure CallPointerProc(Proc : Pointer);
begin
// ???????????
end;
The old DOS method was fairly simple but inline is not available on Windows port so couldn't even convert to ebx,esp, etc..:
inline(
$89/$E3/ {mov bx,sp}
$36/$FF/$1F/ {call dword ptr ss:[bx]}
$83/$C4/$04); {add sp,4}
In general, you should not pass a blank pointer but a type that describes the exact type of subroutine like parameters with their types and return type in case of a function.
Example on how to declares procedure or function types
type
// A procedure with no parameters
TProc = procedure;
// A procedure that expexcts a string
TStringProc = procedure(str: string);
// A function that expects and returns a string
TStringToStringFunc = function(str: string): string;
A function that expects a pointer to a procedure and calls it:
procedure CallPointerProc(Proc : TProc);
begin
Proc();
end;
A function that expects a blank pointer, casts it to a procedure and then calls that:
procedure CallPointerProc(Proc : Pointer);
var
TypedProc: TProc;
begin
TypedProc := TProc(Proc);
TypedProc();
end;
Demo code that works with both definitions of CallPointerProc above. Note that we use the # symbol to get the address of a defined procedure or function.
procedure Demo;
begin
Writeln('Hello World');
end;
begin
CallPointerProc(#Demo);
Readln;
end.
I write a basic Delphi MS-Windows service.
I install it with the /install directove. This works.
In the Windows Services list it exists.
I START it from there. Windows says it started successfully. It shows as running.
But nothing is executed, except the OnCreate and OnDestroy.
It is in fact NOT running, while Windows claims it IS running.
I tried Delpi 10.2 and the latest 10.4.
What is going wrong here? It is the most basic Service possible.
The Log output looks like this:
Create
AfterInstall
Destroy
Create
Destroy
Create
Destroy
program BartServiceTwo;
uses
Vcl.SvcMgr,
Unit1 in 'Unit1.pas' {BartService: TService};
{$R *.RES}
begin
// Windows 2003 Server requires StartServiceCtrlDispatcher to be
// called before CoRegisterClassObject, which can be called indirectly
// by Application.Initialize. TServiceApplication.DelayInitialize allows
// Application.Initialize to be called from TService.Main (after
// StartServiceCtrlDispatcher has been called).
//
// Delayed initialization of the Application object may affect
// events which then occur prior to initialization, such as
// TService.OnCreate. It is only recommended if the ServiceApplication
// registers a class object with OLE and is intended for use with
// Windows 2003 Server.
//
// Application.DelayInitialize := True;
//
if not Application.DelayInitialize or Application.Installing then
Application.Initialize;
Application.CreateForm(TBartService, BartService);
Application.Run;
end.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.SvcMgr;
type
TBartService = class(TService)
procedure ServiceExecute(Sender: TService);
procedure ServiceCreate(Sender: TObject);
procedure ServiceDestroy(Sender: TObject);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceAfterInstall(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
procedure Log(Line:string);
{ Public declarations }
end;
var
BartService: TBartService;
LogFile: text;
Logfilename: string;
implementation
{$R *.dfm}
procedure TBartService.Log(Line:string);
begin
if Logfilename = '' then
begin
Logfilename := 'Log.txt';
Assignfile(LogFile,Logfilename);
end;
try
if FileExists(Logfilename)
then append(LogFile)
else rewrite(LogFile);
writeln(LogFile,line);
Closefile(LogFile);
except
on E:Exception do;
end;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
BartService.Controller(CtrlCode);
end;
function TBartService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TBartService.ServiceAfterInstall(Sender: TService);
begin
Log('AfterInstall');
end;
procedure TBartService.ServiceCreate(Sender: TObject);
begin
Log('Create');
messagebeep(0);
end;
procedure TBartService.ServiceDestroy(Sender: TObject);
begin
Log('Destroy');
end;
procedure TBartService.ServiceExecute(Sender: TService);
begin
Log('ServiceExecute Start. Terminated='+Terminated.ToString(true));
while not Terminated do
begin
try
ServiceThread.ProcessRequests(false);
Log('ServiceExecute');
// messagebeep(0);
sleep(1000);
except
on E:Exception do
begin
Log('ERROR: ServiceExecute: Final: '+E.Message);
end;
end;
end;
Log('ServiceExecute Out of loop.');
end;
procedure TBartService.ServiceStart(Sender: TService; var Started: Boolean);
begin
Log('ServiceStart');
end;
procedure TBartService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
Log('ServiceStop');
end;
end.
I assume that during your debugging you have copy and pasted code into the unit from another project but you have not 'hooked up' the events properly. Bring up the project in Delphi and open the service module. Click on the Events tab in the Object Inspector and my guess is that they are all blank. (View the source of the .dfm and there is likely no OnExecute, OnStop, OnStop, etc events defined)
For example - double click the OnExecute event and I assume the IDE will automatically create a new OnExecute event rather than navigating to your OnExecute event in the unit.
Simply rehook up your events and it will most likely work as expected.
Solved. After using the 'LogMessage() system, I found that the service is in fact running.
But what happened, is that the destination folder of my simple Log file was transfered from the local executable directory to C:\Windows\System32\ and there was all the rest of the Log data... I never expected that :(
Thanks for all help, Bart
I'm trying to use the InitialDir property of TSelectDirectoryDialog:
procedure selectfolder;
begin
SelectDirectoryDialog1.InitialDir := strPath;
If SelectDirectoryDialog1.Execute then begin
Edit1.Text := SelectDirectoryDialog1.FileName;
end;
end;
The first time (with strPath=X) it works fine, the second time I'm using this procedure (with strPath=Y) it doesn't use the new path (Y), but the one I selected previously.
Do I have to call a method, something like SelectDirectoryDialog1."reinitiate" before I set the InitialDir property a second time? Another idea would be to use a different property then InitialDir, but I don't know which one would do the job. Unfortunately the doc page for TSelectDirectoryDialog is currently down, so I don't have a description for the available methods/properties for TSelectDirectoryDialog and the ones I tested to solve my problem.
I got it to work if I create the TSelectDirectoryDialog class instance manually and don't use the one from the Component Palette to create it "on the form". Then I just destroy the instance and create a new one.
procedure TForm1.Button4Click(Sender: TObject);
var SelectDirectoryDialogManual : TSelectDirectoryDialog;
begin
SelectDirectoryDialogManual := TSelectDirectoryDialog.Create(nil);
SelectDirectoryDialogManual.InitialDir := 'C:\Windows';
if SelectDirectoryDialogManual.Execute then ShowMessage(SelectDirectoryDialogManual.FileName);
SelectDirectoryDialogManual.Free;
end;
But how do I do that when I created SelectDirectoryDialog1 using the component Component Palette?
By saving and restoring the value of InitialDir before each invocation of Execute, or doing what #Sertac says in a comment, which works but is less "self-documenting" imo, ymmv.
The code below works fine for me. edInitialDir is a TEdit which saves the most recent directory selected using SelectDirectoryDialog1, which is then used for the next invocation.
procedure TForm1.Button1Click(Sender: TObject);
begin
SelectDirectoryDialog1.InitialDir := edInitialDir.Text;
if SelectDirectoryDialog1.Execute then
Caption := 'executed'
else
Caption := 'not executed';
edInitialDir.Text := SelectDirectoryDialog1.FileName;
end;
Note: All properties of SelectDirectoryDialog1 are the defaults for an instance freshly added from the Component Palette.
Regarding your comment, TSelectDirectoryDialog.Execute calls TWin32WSSelectDirectoryDialog.CreateHandle (see Dialogs.Pas, line 1219). The initial part of this is as follows:
class function TWin32WSSelectDirectoryDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
var
Options : TOpenOptions;
InitialDir : string;
Buffer : PChar;
bi : TBrowseInfo;
iidl : PItemIDList;
biw : TBROWSEINFOW;
Bufferw : PWideChar absolute Buffer;
InitialDirW: widestring;
Title: widestring;
DirName: string;
begin
DirName := '';
InitialDir := TSelectDirectoryDialog(ACommonDialog).FileName;
Options := TSelectDirectoryDialog(ACommonDialog).Options;
if length(InitialDir)=0 then
InitialDir := TSelectDirectoryDialog(ACommonDialog).InitialDir;
if length(InitialDir)>0 then begin
// remove the \ at the end.
if Copy(InitialDir,length(InitialDir),1)=PathDelim then
InitialDir := copy(InitialDir,1, length(InitialDir)-1);
// if it is a rootdirectory, then the InitialDir must have a \ at the end.
if Copy(InitialDir,length(InitialDir),1)=DriveDelim then
InitialDir := InitialDir + PathDelim;
end;
From this you can see that it initially attempts to derive the value of InitialDir from the FileName property and only if that results in an empty string does it attempt to use the stored value of the InitialDir property. This is why the dialog uses the previously-selected directory the next time Execute is invoked, which is exactly what you should be expecting, even if you do not like it. The only way to re-use the initial value of IntialDir from second and subsequent invocations is to restore it before each one.
I am trying to add NSStatusItem in a Delphi application for OSX. Searched for sample code to help me with that but got stuck when defining an interface:
Here is the code:
// Source: https://forums.embarcadero.com/thread.jspa?threadID=108449
unit Unit2;
interface
uses Macapi.ObjectiveC, Macapi.CocoaTypes, Macapi.Foundation, Macapi.AppKit,
Macapi.Helpers, Macapi.ObjcRuntime, System.TypInfo, FMX.Platform, FMX.Platform.Mac;
type
TFMXTrayItem = class(TOCLocal)
private
NSStatItem : NSStatusItem;
public
constructor Create;
destructor Destroy; override;
function GetObjectiveCClass: PTypeInfo; override;
procedure call_mymethod; cdecl;
end;
implementation
constructor TFMXTrayItem.Create;
var
NSContMenu : NSMenu;
NSContItem : NSMenuItem;
NSStatBar : NSStatusBar;
NSImg : NSImage;
AppBundle : NSBundle;
NSpImg: Pointer;
Path: String;
begin
inherited Create;
NSStatBar := TNSStatusBar.Create;
NSStatBar := TNSStatusBar.Wrap(TNSStatusBar.OCClass.systemStatusBar);
NSStatItem:= NSStatBar.statusItemWithLength(NSVariableStatusItemLength);
NSStatItem.setTarget(GetObjectID);
// Create context menu
NSContMenu := TNSMenu.Create;
NSContMenu := TNSMenu.Wrap(NSContMenu.initWithTitle(StrToNSStr('The caption')));
NSContItem:=TNSMenuItem.Create;
NSContItem:=TNSMenuItem.Wrap(NSContItem.initWithTitle(StrToNSStr('1. menuitem'),sel_getUid(PAnsiChar('call_mymethod')),StrToNSStr('')));
NSContItem.setTarget(GetObjectID);
NSContMenu.addItem(NSContItem);
NSContItem.release;
// Add menu
NSStatItem.retain;
NSStatItem.setHighlightMode(true);
NSStatItem.setMenu(NSContMenu);
NSContMenu.release;
// Get path to dir
AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
Path:=AppBundle.bundlePath.UTF8String+'/Contents/yourimage16x16.png';
NSpImg := TNSImage.Alloc.initWithContentsOfFile(StrToNSStr(Path));
// Create Icon
NSImg := TNSImage.Create;
NSImg := TNSImage.Wrap(NSpImg);
NSStatItem.setImage(NSImg);
NSImg.release;
end;
destructor TFMXTrayItem.Destroy;
begin
NSStatItem.release;
inherited;
end;
function TFMXTrayItem.GetObjectiveCClass: PTypeInfo;
begin
Result :=TypeInfo(IFMXTrayItem);
end;
procedure TFMXTrayItem.call_properties;
begin
// your event code of the menu item
end;
end.
Does anyone have any idea on how to declare the IFMXTrayItem interface?
Got it to work like this:
type
IFMXTrayItem = interface(NSObject)
['{7d2e4b38-61d9-4cf4-b78b-5f7c4188e9c0}']
procedure call_mymethod; cdecl;
end;
later edit:
Added a GUID to the interface after reading this:
This GUID is used by the compiler to identify uniquely this interface.
Strictly speaking, you can use an interface without the GUID, but you
can’t get very far using them as much of the RTL and most frameworks
that take advantage of interfaces will require that they have a GUID.
So that is a random GUID I generated but if you use this in your code you should generate your own GUID.
I need to create stored procedure into oracle from delphi with TQuery.
But the SQL.text is difficult to uunderstand.
Is there any way to store direct text as pl/SQL with out quotes?
'create or replace '+
'function WholeTableRecovery(i_tablname IN varchar) return varchar '+
'as '+
Is it possible with resource file
Thanks in advance
Since you are using Delphi 2010 in the tags (I have no Delphi 7 here to test), a comfortable method would be storing the SQLs in separate textfiles, together with a RC file containing the directives for the resource compiler.
The RC files will contain the names of the resource you want to use together with the filenames containing the SQLs you want to store. The content for the example would look like this:
My_First_Speaking_ResourceName RCDATA "MyFirstSQL.sql"
My_Second_Speaking_ResourceName RCDATA "MySecondSQL.sql"
There is no need to call BRCC32 directly if you include the resource containing RC and resulting RES :
{$R 'MySQLResources.res' 'resources\MySQLResources.rc'}
You might wrap the usage of TResourceStream for your convenience, the way shown in the example would use Strings you might also work with the stream directly as mentioned by TLama MyQuery.SQL.LoadFromStream(rs);
implementation
{$R *.dfm}
{$R 'MySQLResources.res' 'resources\MySQLResources.rc'}
function LoadSqlResource(resourceName: string): string;
var
rs: TResourceStream;
sl: TStringList;
s : string;
begin
sl := TStringList.Create;
try
rs := TResourceStream.Create(hinstance, resourceName, RT_RCDATA);
try
rs.Position := 0;
sl.LoadFromStream(rs);
Result := sl.Text;
finally
rs.Free;
end;
finally
sl.Free;
end;
end;
procedure CallOneSql(Q:TADOQuery;ResourceName:String);
begin
Q.SQL.Text := LoadSqlResource('My_First_Speaking_ResourceName');
Q.ExecSQL;
end;
With a call like CallOneSql(MyQuery,'My_First_Speaking_ResourceName');
Make sure to create the project, not just compile if you made changes on the RC or the SQL files.