I assume that it is possible to get the complete path of the unit (not just the name) at runtime, since when I generate an error, Delphi already has this stored information:
try
Assert (False, '#');
except
on E: EAssertionFailed from
begin
ShowMessage (E.Message); // this show me the path
end;
end;
Would anyone know if there is any function that returns me the path of a specific unit, or something similar?
The complete path of the unit as it was on the machine that compiled the project is only possible using Assert. However personally I don't find that information incredibly useful unless you have many units with the same name in different folders or lost control over your source repository and and library paths in effect when compiling.
To get the unit name you can turn on map file or debug information (aka TD32) and do the following:
Use the FileByLevel function from JclDebug - in your case with the default value (0).
The level parameter tells the function how many calls it look up the callstack. If you put that method into a FormCreate of a VCL form for example and pass 1 it will give you Vcl.Forms.pas as the event handler was called from there.
I hesitate to write this answer as it shows a really dirty hack to get the unit name making use of the Assert compiler magic shown above.
Use the following unit:
unit UnitNameHack;
interface
const
cUnitNameSentinel = '$$$sentinel$$$';
var
HackUnitname: string = '';
implementation
var
OrgAssertErrorProc: TAssertErrorProc = nil;
procedure MyAssertErrorProc(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
begin
if Message = cUnitNameSentinel then begin
HackUnitname:= Filename;
end
else begin
OrgAssertErrorProc(Message, Filename, LineNumber, ErrorAddr);
end;
end;
initialization
OrgAssertErrorProc := AssertErrorProc;
AssertErrorProc := MyAssertErrorProc;
finalization
AssertErrorProc := OrgAssertErrorProc;
end.
Now whenever you need the unit name call
Assert(False, cUnitNameSentinel);
and retrieve the unit name from HackUnitname.
Note that you cannot wrap the Assert call and reading HackUnitName into a function, not even if inlined.
You've said, something similar. I see that it might have been in a different context, but anyway, for objects you can inspect UnitName or UnitScope to get the name of the module where the object instance was declared, without the module path (which is not valuable information anyway).
Based on Uwe Raabe's answer:
// directly after the implementation uses:
var
ThisUnit: string = '<unknown>';
procedure MyAssertErrorProc(const Message, Filename: string; LineNumber: Integer; ErrorAddr: Pointer);
begin
ThisUnit := Filename;
end;
procedure InitThisUnit;
var
OrgAssertErrorProc: TAssertErrorProc;
begin
OrgAssertErrorProc := AssertErrorProc;
try
AssertErrorProc := MyAssertErrorProc;
Assert(False);
finally
AssertErrorProc := OrgAssertErrorProc;
end;
end;
// [...]
// call InitThisUnit in the initialization section
initialization
InitThisUnit;
end.
It's still a hack, but a bit more elegant. ;-)
Related
We would like to share an ADOConnection across a DLL boundary (Delphi to Delphi at the moment, though could also be C# to Delphi in the near future).
As we would like the flexibility to call the DLL from c# in future, we were hoping to be able to define the DLL call using _Connection as a parameter. Something like:
procedure DoStuff (ADOConnection: _Connection)
var
InnerConnection: TADOConnection;
begin
InnerConnection := TADOConnection.create(nil);
try
InnerConnection.ConnectionObject := ADOConnection;
DoMoreStuff(InnerConnection);
finally
InnerConnection.free;
end;
end;
Unfortunately, the TADOConnection destructor code closes the connection passed into it, which is an unwanted side-effect. Adding
InnerConnection.ConnectionObject := nil
prior to the free doesn't do anything, as it's caught by
if Assigned(Value) = nil
in TADOConnection.SetConnectionObject, which results in the call not doing anything.
Is there a better way of achieving this? Passing the connection string is an alternative, but would mean that we would have to deal with username/password issues and encryption across the boundary. Passing the TADOConnection is another option, but that prevents calling from other languages.
Edit: For clarity, the Username/Password of the original TADOConnection object is set using the .Open routine, so these details aren't in the connection string (in fact, the wrong username is usually stored, as it's the name used to 'test connection' in the MS UDL editor)
You can try this way:
type TInit_StFattDLL = procedure( var DataBase:TAdoConnection);
var Init_StFattDLL:TInit_StFattDll;
The caller is:
Function ConnectDll():Boolean;
var
handleDll:THandle;
begin
handleDll := LoadLibrary('mydll.DLL');
#Init_StFattDLL := GetProcAddress(handleDll , 'myConnectFunction');
if #Init_StFattDLL <> nil then
begin
Init_StFattDLL(ADOConnection1);
result:=true;
end
else
result:=false;
end;
into the the dll put the following:
in the project file put the exports:
Exports myConnectFunction;
global section:
var Database:TAdoConnection;
the exported procedure is the following:
procedure myConnectFunction( var MyDataBase:TAdoConnection);export;
begin
Database:=MyDataBase;
end
Is it possible, and if so how would you go about implementing your own clipboard?
By this I mean be able to Copy and Paste anything to and from it just like the Windows clipboard does, but without actually interfering with the system clipboard.
To give a better idea this is what I tried:
uses
ClipBrd;
...
procedure TMainForm.actCopyExecute(Sender: TObject);
var
MyClipboard: TClipboard;
begin
MyClipboard := TClipboard.Create;
try
MyClipboard.AsText := 'Copy this text';
finally
MyClipboard.Free;
end;
end;
That works in that it will copy the string "Copy this text" to the clipboard, but it overwrites whatever was on the Windows clipboard.
The above must just create an instance of the Windows clipboard, not actually creating your own.
Note that the custom clipboard could hold any data not just plain text. It should work just the same as the Windows clipboard, but without interfering with it (losing whatever was on it).
How could this be achieved?
Thanks.
Your question is confusing; you say you want to do it without affecting the system clipboard, but then (from your own comment to your question) you seem to be wanting to implement something like MS Office's Paste Special.
If it's the first, as others have said you can't do that using the TClipboard wrapper; you have to implement your own, and passing information between applications will be very difficult.
If it's the second, you do this by using the Windows API RegisterClipboardFormat to define your own format.
type
TForm1=class(TForm)
YourCustomFormat: Word;
procedure FormCreate(Sender: TObject);
end;
implementation
constructor TForm1.FormCreate(Sender: TObject);
begin
YourCustomFormat := RegisterClipboardFormat('Your Custom Format Name');
end;
To put info into the clipboard in a custom format, you have to use GlobalAlloc and GlobalLock to allocate and lock a global memory block, copy your data into that block, unlock the block using GlobalUnlock, use TClipboard.SetAsHandle to transfer the memory block into the clipboard. You then need to then call GlobalFree to free the memory block.
To retrieve things in your custom format, you do basically the same thing with a couple of steps reversed. You use GlobalAlloc/GlobalLock as before, use TClipboard.GetAsHandle to retrieve the clipboard's content, copy it into a local variable, and then call GlobalFree.
Here's an old example of putting a custom format (in this case, RTF text) into the clipboard - it's from a newsgroup post by Dr. Peter Below of TeamB. (The code and formatting are his from the original post; I've not tested it or even compiled it.) Reversing the process to get it back out should be clear from my instructions on what to change above, and I leave that to you to work out. :)
procedure TForm1.BtnSetRTFClick(Sender: TObject);
Const
testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}';
testtext2: PChar = '{\rtf1\ansi'+
'\deff4\deflang1033{\fonttbl{\f4\froman\fcharset0\fprq2 Times New Roman;}}'
+'\pard\plain 12{\ul 44444}}';
flap: Boolean = False;
Var
MemHandle: THandle;
rtfstring: PChar;
begin
If flap Then
rtfstring := testtext2
Else
rtfstring := testtext;
flap := not flap;
MemHandle := GlobalAlloc( GHND or GMEM_SHARE, StrLen(rtfstring)+1 );
If MemHandle <> 0 Then Begin
try
StrCopy( GlobalLock( MemHandle ), rtfstring );
GlobalUnlock( MemHandle );
With Clipboard Do Begin
Open;
try
AsText := '1244444';
SetAsHandle( CF_RTF, MemHandle );
finally
Close;
end;
End;
Finally
GlobalFree( MemHandle );
End;
End
Else
MessageDlg('Global Alloc failed!',
mtError, [mbOK], 0 );
end;
You should define your own custom Clipboard. It may look something like this:
type
TMyCustomClipboard = class
private
FStream: TMemoryStream;
function GetAsText: string;
procedure SetAsText(const Value: string);
...
public
constructor Create;
destructor Destroy; override;
procedure Clear;
property AsText: string read GetAsText write SetAsText;
procedure AsAnyThing: AnyType read GetAsAnyThing write AsAnyThing;
...
end;
Then you can use FStream as custom clipboard container. You can store (Copy) any data inside that stream and use(Paste) it when you need it. You just need to write some Get/Set methods for your data types.
TClipboard is a class incapsulating system clipboard, so you can't use it to instantiate another copy of a clipboard. You should implement your own class, representing a universal buffer with setters and getters.
You cannot. You can have an internal memory buffer that you move data into and out of, you can call it "copy" and "paste" if you want, but don't put it in the user interface that way, or you'll just confuse your users. There is only one system clipboard, and you cannot put data in it without affecting other programs. If your next thought is to save the clipboard, overwrite with your stuff, then restore the original contents, don't bother.
I have a DLL which exectues some code at its entry point, i.e.
procedure MainDLL(Reason: Integer);
begin
{ ... Code here ... }
end;
begin
DLLProc := #MainDLL;
end.
Now, I would like to pass some values to the DLL's entry point from an external application. I have tried creating a hidden window inside the DLL, like that:
const
WM_JAJCO = WM_USER + 1024;
type
TWnd = class(TObject)
class procedure DLLWndProc(var Msg: TMessage);
end;
{ ... }
class procedure TWnd.DLLWndProc(var Msg: TMessage);
var
Tmp: DWORD;
begin
if (Msg.Msg = WM_JAJCO) then
begin
PNewHandle := Msg.LParam;
CreateThread(nil, 0, #Starter, nil, 0, Tmp);
Msg.Result := 0;
end else
Msg.Result := DefWindowProc(MyHnd, Msg.Msg, Msg.WParam, Msg.LParam);
end;
// in the entry point
MyHnd := AllocateHWND(TWnd.DLLWndProc);
Then, after I initialize the DLL in the caller application, I use:
SendMessage(FindWindow('TPUtilWindow', nil), WM_USER + 1024, 0, wi.WndHandle);
Application.ProcessMessages();
But the window created inside the DLL does not seem to receive the message. Do you happen to know why?
If that's a bad method and you have a different solution, please let me know.
You shouldn't be using DLLMain for this. Just export your own init function and call it manually.
That's a rather tortuous approach. You are supposed to do as little as possible in the DllMain function. The canonical solution is to create a dedicated function to perform initialization. Arrange for the host app to call the initialization function before calling anything else.
The most likely reason your version fails is that there are a lot of windows with that class name. Every window created by AllocHwnd has that class name. FindWindow probably just finds the wrong one.
On the other hand, you mention in passing in a comment that this DLL is injected! In that case you can make your method work by using a unique class name or giving the window a unique title so that you can find it.
Finally the call to ProcessMessages looks to be gratuitous.
First make sure that the injected DLL really does create your window handle. WinSight or Spy++ should help you there. Once you know the window really does exist make sure FindWindow find your window handle and not another one with the same class name. IIRC, even the Delphi IDE itself creates window handles using this class name.
I feel like this should be easy, but google is totally failing me at the moment. I want to open a file, or create it if it doesn't exist, and write to it.
The following
AssignFile(logFile, 'Test.txt');
Append(logFile);
throws an error on the second line when the file doesn't exist yet, which I assume is expected. But I'm really failing at finding out how to a) test if the file exists and b) create it when needed.
FYI, working in Delphi XE.
You can use the FileExists function and then use Append if exist or Rewrite if not.
AssignFile(logFile, 'Test.txt');
if FileExists('test.txt') then
Append(logFile)
else
Rewrite(logFile);
//do your stuff
CloseFile(logFile);
Any solution that uses FileExists to choose how to open the file has a race condition. If the file's existence changes between the time you test it and the time you attempt to open the file, your program will fail. Delphi doesn't provide any way to solve that problem with its native file I/O routines.
If your Delphi version is new enough to offer it, you can use the TFile.Open with the fmOpenOrCreate open mode, which does exactly what you want; it returns a TFileStream.
Otherwise, you can use the Windows API function CreateFile to open your file instead. Set the dwCreationDisposition parameter to OPEN_ALWAYS, which tells it to create the file if it doesn't already exist.
You should be using TFileStream instead. Here's a sample that will create a file if it doesn't exist, or write to it if it does:
var
FS: TFileStream;
sOut: string;
i: Integer;
Flags: Word;
begin
Flags := fmOpenReadWrite;
if not FileExists('D:\Temp\Junkfile.txt') then
Flags := Flags or fmCreate;
FS := TFileStream.Create('D:\Temp\Junkfile.txt', Flags);
try
FS.Position := FS.Size; // Will be 0 if file created, end of text if not
sOut := 'This is test line %d'#13#10;
for i := 1 to 10 do
begin
sOut := Format(sOut, [i]);
FS.Write(sOut[1], Length(sOut) * SizeOf(Char));
end;
finally
FS.Free;
end;
end;
If you are just doing something simple, the IOUtils Unit is a lot easier. It has a lot of utilities for writing to files.
e.g.
procedure WriteAllText(const Path: string; const Contents: string);
overload; static;
Creates a new file, writes the specified string to the file, and then
closes the file. If the target file already exists, it is overwritten.
You can also use the load/save feature in a TStringList to solve your problem.
This might be a bad solution, because the whole file will be loaded into memory, modified in memory and then saved to back to disk. (As opposed to your solution where you just write directly to the file). It's obviously a bad solution for multiuser situations.
But this approach is OK for smaller files, and it is easy to work with and easy understand.
const
FileName = 'test.txt';
var
strList: TStringList;
begin
strList := TStringList.Create;
try
if FileExists(FileName) then
strList.LoadFromFile(FileName);
strList.Add('My new line');
strList.SaveToFile(FileName);
finally
strList.Free;
end;
end;
I have included the PascalScript engine into my software. My user now wants to write a whole set of scripts for this engine, and would like to know if it is possible to include other Scripts by an include or uses commmand.
What he wants to do is write one script that holds all kinds of constants/variables and another that does the logic. In the end he wants to include the constants into his logic script.
I hope this was clear enough to understand.
I found out, heres how how do to it:
The UsePreprocessor Property of the PascalScript compiler needs to be set to true. If so you can now use the following preprocessor command:
{$I filename.txt}
Also you need to implement the OnNeedFile Event of the compiler with something like the following example that I found on the net:
function TForm1.ceNeedFile(Sender: TObject; const OrginFileName: String;
var FileName, Output: String): Boolean;
var
path: string;
f: TFileStream;
begin
Path := ExtractFilePath(ParamStr(0)) + FileName;
try
F := TFileStream.Create(Path, fmOpenRead or fmShareDenyWrite);
except
Result := false;
exit;
end;
try
SetLength(Output, f.Size);
f.Read(Output[1], Length(Output));
finally
f.Free;
end;
Result := True;
end;
(Please fix your question title)
I'm not entirely sure but afaik Pascalscript has no "file" concept. You could simply concat both parts before passing them to the interpreter, or have a small preprocessor look for the {$I } include statements and look the code to insert up.
If you set the conditional define to PS_USESSUPPORT
and in the OnFindUnknownFile event you have to load the pas-file content
into the output string.
Then you can use "Uses XYZ;".