I'm porting program from Delphi 2009 to XE4 and got problem with LockBox encryption. Encrypt/decrypt unit is using just one component:
interface
function Encrypt(aStr: String): String;
function Decrypt(aStr: String): String;
function NeedEncrypt(): Boolean;
implementation
uses
windows,
strUtils,
LbClass;
var
LbRijndael: TLbRijndael;
localNeedEncrypt: Boolean;
function NeedEncrypt(): Boolean;
begin
Result := localNeedEncrypt;
localNeedEncrypt := False;
end;
function Encrypt(aStr: AnsiString): AnsiString;
begin
Result := aStr;
if RightStr(aStr, 2) = '==' then
Exit;
Result := LbRijndael.EncryptString(aStr);
end;
function Decrypt(aStr: AnsiString): AnsiString;
begin
Result := aStr;
if RightStr(aStr, 2) = '==' then
Result := LbRijndael.DecryptString(aStr)
else
localNeedEncrypt := True;
end;
initialization
LbRijndael := TLbRijndael.Create(nil);
LbRijndael.GenerateKey('KEYABC');
LbRijndael.CipherMode := cmECB;
LbRijndael.KeySize := ks128;
end.
As I understood there is no LockBox2 for Delphi XE4.
Can I use LockBox3 for this purpose? If yes, can I use just needed units without installation into Delphi (this was done with LockBox2)?
Whilst the LB2 and LB3 APIs are very different, you should be able to port this code across without too much difficulty. As you are creating the components dynamically at runtime, you shouldn't need to install the packages into your IDE, providing your library path is set to include the LB3 source.
Related
I have this function to check if a string is a regular expression and it works fine :
function IsValidRegEx(aString: string): Boolean;
var
aReg : TRegEx;
begin
Result := False;
if Trim(aString) = '' then
begin
Exit;
end;
try
aReg := TRegEx.Create(aString);
if aReg.IsMatch('asdf') then
begin
end;
Result := True;
except
end;
end;
the problem is it always raise a debugger exception notification if string value is false. I want to eliminate that notification. There is an option to ignore that exception in the notification itself but I don't want it. As much as possible it would be the codes that will adjust.
If you want to use this approach, then you can't avoid exceptions being raised by the Delphi regex library. You'd need to dig down to the PCRE library that Delphi uses to implement its regex library. For instance:
{$APPTYPE CONSOLE}
uses
System.RegularExpressionsAPI;
function IsValidRegEx(const Value: UTF8String): Boolean;
var
CharTable: Pointer;
Options: Integer;
Pattern: Pointer;
Error: PAnsiChar;
ErrorOffset: Integer;
begin
CharTable := pcre_maketables;
Options := PCRE_UTF8 or PCRE_NEWLINE_ANY;
Pattern := pcre_compile(PAnsiChar(Value), Options, #Error, #ErrorOffset, CharTable);
Result := Assigned(Pattern);
pcre_dispose(Pattern, nil, CharTable);
end;
begin
Writeln(IsValidRegEx('*'));
Writeln(IsValidRegEx('.*'));
Readln;
end.
Note that I have written this with Delphi XE7, as I don't have access to XE2. If this code doesn't compile, then it should not be too hard to study the source code for the Delphi regex library to work out how to achieve the same in XE2.
I have a DLL that was provided by a 3rd party company and when called from Delphi 2007, it worked perfectly fine. The following code is a sample of how the DLL was used in Delphi 2007:
Procedure XC_eXpressLink(hHandle: Hwnd; Parameters: pChar; Result: pChar); stdcall; external 'XCClient.dll';
Here is how the procedure was called:
procedure TForm1.Button1Click(Sender: TObject);
var Result: array[0..2000] of char;
sParams: String;
begin
sParams := RemoveCRLF(memoParameters.Text); //Remove TMemo CR/LF
XC_eXpressLink(Handle, pChar(sParams), Result);
memoResults.Text := String(Result);
end;
I'm not sure what the DLL was compiled in, but I'm assuming it is expecting ansi and not unicode. After converting the code to ansi in Delphi XE5, the code is now as follows:
Procedure XC_eXpressLink(hHandle: Hwnd; Parameters: pAnsiChar; Result: pAnsiChar); stdcall; external 'XCClient.dll';
and
procedure TForm1.Button1Click(Sender: TObject);
var Result: array[0..2000] of Ansichar;
sParams: AnsiString;
begin
sParams := RemoveCRLF(memoParameters.Text); //Remove TMemo CR/LF
XC_eXpressLink(Handle, pAnsiChar(sParams), Result);
memoResults.Text := AnsiString(Result);
end;
memoParameters is a TMemo on the form which provides the parameters for the dll procedure. The RemoveCRLF is a function that removes any carriage returns and line feeds from memoParameters. MemoResults is another TMemo on the form that provides the return results of the dll procedure.
I'm getting access violations when the changed code is run in Delphi XE5. Since I changed all the parameters to use ansi, shouldn't the dll be getting the same parameter format as before? Am I doing something wrong? Will I be able to get this older compiled DLL to work in Delphi XE5?
I contacted the company, OpenEdge, which supplies the dll for X-Charge (for credit card integration). To resolve the problem, the Handle must have a value of 0 and you have to add /IGNOREHANDLEPARAMETER to the parameters list that is sent to the dll. Note, this parameter will only work with the full version XC8.1.1.6.exe installation or later.
procedure TForm1.Button1Click(Sender: TObject);
var Result: array[0..2000] of Ansichar;
sParams: AnsiString;
begin
sParams := RemoveCRLF(memoParameters.Text); //Remove TMemo CR/LF
XC_eXpressLink(0, pAnsiChar(sParams), Result);
memoResults.Text := AnsiString(Result);
end;
In a common Delphi pattern, i am passing a value as an untyped const to a function:
procedure DoSomething(const Something; SomethingLength: Integer);
begin
//...
end;
In this example, i happen to be passing Windows FORMATETC structure:
procedure Test;
var
omgp: TFormatEtc;
begin
omgp := Default(TFormatEtc);
omgp.cfFormat := RegisterClipboardFormat('CF_PNG');
omgp.ptd := nil;
omgp.dwAspect := DVASPECT_CONTENT or DVASPECT_THUMBNAIL;
omgp.lindex := -1; //all pages
omgp.tymed := TYMED_HGLOBAL;
DoSomething(omgp, SizeOf(omgp));
end;
I need to get the address of this data, so i can pass it to an underlying Windows function something that requires the pointer to the data.
In order to do this, i have always used Pointer(#data):
procedure DoSomething(const Something; SomethingLength: Integer);
begin
SomethingThatNeedsAPointer(Pointer(#Something));
end;
Until this one API call, in one particular case, is failing (it's returning the wrong values). For no particular reason, I happened to look closely at the pointer value being passed. When i was checking everythe parameter value in the debugger i noticed something horrifying. I noticed that:
#Something
Pointer(#Something)
return different values.
#Something should already be a pointer
Pointer(#Something) should be a redundant cast
Which way is the right way to get the address of untyped data?
Edit: People went to lunch on something unrelated to the question. I've edited the question so that hopefully people will focus on the question, and not the example.
This is a debugger bug, whereby the debugger is mis-reporting the value of Pointer(#Salt). I can reproduce the fault in XE5, XE6 and XE7, but not in XE4 and XE8. So it seems that this is a defect introduced in XE5 and removed in XE8.
Whenever you see an issue like this, a debugger fault is always a possibility. In this case we can demonstrate that the fault lies in the debugger with this program:
{$APPTYPE CONSOLE}
uses
System.SysUtils;
procedure DoSomething(const Salt; SaltLength: Integer);
begin
Writeln(IntToHex(NativeUInt(Pointer(#Salt)), 8));
Writeln(IntToHex(NativeUInt(#Salt), 8));
end;
procedure Test;
var
salt: AnsiString;
begin
salt := 'salt';
DoSomething(salt[1], Length(salt));
end;
begin
Test;
end.
This program outputs:
007C9BD4
007C9BD4
even though #Salt and Pointer(#Salt) are accorded different values by the debugger.
Note that this program
{$APPTYPE CONSOLE}
procedure DoSomething(const Salt; SaltLength: Integer);
var
i: Integer;
P: PAnsiChar;
begin
P := #Salt;
for i := 0 to SaltLength-1 do
begin
Writeln(P^);
inc(P);
end;
end;
procedure Test;
var
salt: AnsiString;
begin
salt := 'salt';
DoSomething(salt[1], Length(salt));
end;
begin
Test;
end.
outputs:
s
a
l
t
I cannot reproduce your case in XE8.
The debugger shows same address for both #Salt and Pointer(#Salt).
Likewise the output of this test snippet is identical.
I can only assume that what the debugger is telling you is untrue somehow.
(Update: A test in XE7 reproduces the error in the debugger. The outcome of the snippet is the same though.)
program Test;
{$APPTYPE CONSOLE}
procedure Test1(p: Pointer);
begin
WriteLn(Cardinal(p));
end;
procedure Test(const Salt);
begin
Test1(#Salt);
Test1(Pointer(#Salt));
Test1(Addr(Salt));
end;
var
s:AnsiString;
begin
s := 'Test';
Test( s[1]);
ReadLn;
end.
In Delphi XE2, I bumped against a strange formatting difference when formatting Currency. Using Double works as expected.
It looks that when using %F or %N (floating point or numeric) you always get 3 decimal digits, even if you request fewer.
With format '%.1f' a Double value of 3.1415 will become '3.1', but a Currency value of 3.1415 will become '3.142' (assuming en-US locale).
With format '%4.0n' a Double value of 3.1415 will become ' 3', but a Currency value of 3.1415 will become '3.142' (assuming en-US locale).
I wrote the below quick DUnit test case, and will investigate further tomorrow.
This particular project cannot be changed to anything other than Delphi XE2 (big corporates are not flexible in what tools they use), so I'm looking for a solution that solves this in Delphi XE2.
In the mean time: what are your thoughts?
unit TestSysUtilsFormatUnit;
interface
uses
TestFramework, System.SysUtils;
type
TestSysUtilsFormat = class(TTestCase)
strict private
DoublePi: Double;
CurrencyPi: Currency;
FloatFormat: string;
NumericFormat: string;
Expected_Format_F: string;
Expected_Format_N: string;
public
procedure SetUp; override;
procedure TearDown; override;
published
procedure Test_Format_F_Double;
procedure Test_Format_F_Currency;
procedure Test_Format_N_Double;
procedure Test_Format_N_Currency;
end;
implementation
procedure TestSysUtilsFormat.Test_Format_F_Double;
var
ReturnValue: string;
begin
ReturnValue := System.SysUtils.Format(FloatFormat, [DoublePi]);
Self.CheckEqualsString(Expected_Format_F, ReturnValue); // actual '3.1'
end;
procedure TestSysUtilsFormat.Test_Format_F_Currency;
var
ReturnValue: string;
begin
ReturnValue := System.SysUtils.Format(FloatFormat, [CurrencyPi]);
Self.CheckEqualsString(Expected_Format_F, ReturnValue); // actual '3.142'
end;
procedure TestSysUtilsFormat.Test_Format_N_Double;
var
ReturnValue: string;
begin
ReturnValue := System.SysUtils.Format(NumericFormat, [DoublePi]);
Self.CheckEqualsString(Expected_Format_N, ReturnValue); // actual ' 3'
end;
procedure TestSysUtilsFormat.Test_Format_N_Currency;
var
ReturnValue: string;
begin
ReturnValue := System.SysUtils.Format(NumericFormat, [CurrencyPi]);
Self.CheckEqualsString(Expected_Format_N, ReturnValue); // actual '3.142'
end;
procedure TestSysUtilsFormat.SetUp;
begin
DoublePi := 3.1415;
CurrencyPi := 3.1415;
FloatFormat := '%.1f';
Expected_Format_F := '3.1';
NumericFormat := '%4.0n';
Expected_Format_N := ' 3';
end;
procedure TestSysUtilsFormat.TearDown;
begin
end;
initialization
RegisterTest(TestSysUtilsFormat.Suite);
end.
Posting this as an answer on the request of the asker in the comments to the question above.)
I can't reproduce the issue on either XE2 or XE3, with a plain console application. (It was just quicker to set up for me.)
Here's the code I used in it's entirely (on both XE2/XE3):
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
SysUtils;
const
DoublePi: Double = 3.1415;
CurrencyPi: Currency = 3.1415;
FloatFormat = '%.1f';
NumericFormat = '%4.0n';
begin
WriteLn(Format('Double (.1f) : '#9 + FloatFormat, [DoublePi]));
WriteLn(Format('Currency (.1f) : '#9 + FloatFormat, [CurrencyPi]));
WriteLn(Format('Currency (4.0n): '#9 + NumericFormat, [CurrencyPi]));
ReadLn;
end.
Here's the output from the XE2 run (Delphi® XE2 Version 16.0.4429.46931):
:
This was a bug in early Delphi XE 2 versions in these methods:
function WideFormatBuf(var Buffer; BufLen: Cardinal; const Format;
FmtLen: Cardinal; const Args: array of const;
const AFormatSettings: TFormatSettings): Cardinal;
function FormatBuf(var Buffer; BufLen: Cardinal; const Format;
FmtLen: Cardinal; const Args: array of const;
const AFormatSettings: TFormatSettings): Cardinal;
Fails:
Embarcadero® RAD Studio XE2 Version 16.0.4256.43595 (Update 2)
(The odd thing is: that version indicates "no updates available" with starting the "check for updates")
I did not have time to check intermediate versions.
Works:
Embarcadero® RAD Studio XE2 Version 16.0.4429.46931 (Update 4))
Embarcadero® Delphi® XE2 Version 16.0.4504.48759 (Update 4 hotfix 1)
One of the things that XE2 Update 4 (with or without the hotfix) breaks is the creation of a standard (non-IntraWeb) unit test project.
This menu entry is missing: File -> New -> Other -> Unit Test -> Test Project.
As a reminder to myself, this is the skeleton code to quickly get started with the missing Test Project entry:
program UnitTest1;
{
Delphi DUnit Test Project
-------------------------
This project contains the DUnit test framework and the GUI/Console test runners.
Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options
to use the console test runner. Otherwise the GUI test runner will be used by
default.
}
{$IFDEF CONSOLE_TESTRUNNER}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
Forms,
TestFramework,
GUITestRunner,
TextTestRunner;
{$R *.RES}
begin
Application.Initialize;
if IsConsole then
with TextTestRunner.RunRegisteredTests do
Free
else
GUITestRunner.RunRegisteredTests;
end.
I want to be able to determine if a particular unit has been compiled into a Delphi program, e.g. the unit SomeUnitName is part of some of my programs but not of others. I would like to have a function
function IsSomeUnitNameInProgram: boolean;
(which is of course not declared in SomeUnitName because in that case it would always be included) that at runtime returns true, if the unit has been compiled into the program, and false, if not.
My thoughts so far have gone along the lines of using the jcl debug information (compiled from a detailed map file) which I basically add to all my programs to determine this information, but I would prefer it, if jcl were not required.
Adding code to SomeUnitName is not an option.
This is currently for Delphi 2007 but preferably should also work for Delphi XE2.
Any thoughts?
some background on this since #DavidHeffernan asked:
This is not only for one program but for more than 100 different ones. Most of them are used internally but some also get delivered to customers. Since we use quite a few libraries, some bought others under various open source licenses, I wanted to be able to add a "credits" tab to the about box which displays only those libraries actually compiled into the program rather than all of them. Thanks to the answer from TOndrej this works now exactly as I wanted it to:
The code checks for a unit which is always linked if a library is used by the program and if it is there, it adds the library name, the copyright and a link to it to the about box.
Unit names are compiled into the 'PACKAGEINFO' resource where you can look it up:
uses
SysUtils;
type
PUnitInfo = ^TUnitInfo;
TUnitInfo = record
UnitName: string;
Found: PBoolean;
end;
procedure HasUnitProc(const Name: string; NameType: TNameType; Flags: Byte; Param: Pointer);
begin
case NameType of
ntContainsUnit:
with PUnitInfo(Param)^ do
if SameText(Name, UnitName) then
Found^ := True;
end;
end;
function IsUnitCompiledIn(Module: HMODULE; const UnitName: string): Boolean;
var
Info: TUnitInfo;
Flags: Integer;
begin
Result := False;
Info.UnitName := UnitName;
Info.Found := #Result;
GetPackageInfo(Module, #Info, Flags, HasUnitProc);
end;
To do this for the current executable pass it HInstance:
HasActiveX := IsUnitCompiledIn(HInstance, 'ActiveX');
(GetPackageInfo enumerates all units which may be inefficient for executables with many units, in that case you can dissect the implementation in SysUtils and write your own version which stops enumerating when the unit is found.)
This function will return the list of unit names included in an application. Works in Delphi 2010. Not verified for other compilers.
function UnitNames: TStrings;
var
Lib: PLibModule;
DeDupedLibs: TList<cardinal>;
TypeInfo: PPackageTypeInfo;
PInfo: GetPackageInfoTable;
LibInst: Cardinal;
u: Integer;
s: string;
s8: UTF8String;
len: Integer;
P: PByte;
begin
result := TStringList.Create;
DeDupedLibs := TList<cardinal>.Create;
Lib := LibModuleList;
try
while assigned( Lib) do
begin
LibInst := Lib^.Instance;
Typeinfo := Lib^.TypeInfo;
if not assigned( TypeInfo) then
begin
PInfo := GetProcAddress( LibInst, '#GetPackageInfoTable');
if assigned( PInfo) then
TypeInfo := #PInfo^.TypeInfo;
end;
if (not assigned( TypeInfo)) or (DeDupedLibs.IndexOf( LibInst) <> -1) then continue;
DeDupedLibs.Add( LibInst);
P := Pointer( TypeInfo^.UnitNames);
for u := 0 to TypeInfo^.UnitCount - 1 do
begin
len := P^;
SetLength( s8, len);
if len = 0 then Break;
Inc( P, 1);
Move( P^, s8[1], len);
Inc( P, len);
s := UTF8ToString( s8);
if Result.IndexOf( s) = -1 then
Result.Add( s)
end
end
finally
DeDupedLibs.Free
end
end;
Example to use in the was suggested in the question...
function IsSomeUnitNameInProgram: boolean;
var
UnitNamesStrs: TStrings;
begin
UnitNamesStrs := UnitNames;
result := UnitNamesStrs.IndexOf('MyUnitName') <> -1;
UnitNamesStrs.Free
end;