Does anyone know a 100% clone of the C/C++ printf for Delphi?
Yes, I know the System.Format function, but it handles things a little different.
For example if you want to format 3 to "003" you need "%03d" in C, but "%.3d" in Delphi.
I have an application written in Delphi which has to be able to format numbers using C format strings, so do you know a snippet/library for that?
Thanks in advance!
You could use the wsprintf() function from Windows.pas. Unfortunately this function is not declared correctly in the Windows.pas so here is a redeclaration:
function wsprintf(Output: PChar; Format: PChar): Integer; cdecl; varargs;
external user32 name {$IFDEF UNICODE}'wsprintfW'{$ELSE}'wsprintfA'{$ENDIF};
procedure TForm1.FormCreate(Sender: TObject);
var
S: String;
begin
SetLength(S, 1024); // wsprintf can work only with max. 1024 characters
SetLength(S, wsprintf(PChar(S), '%s %03d', 'Hallo', 3));
end;
If you want to let the function look more Delphi friendly to the user, you could use the following:
function _FormatC(const Format: string): string; cdecl;
const
StackSlotSize = SizeOf(Pointer);
var
Args: va_list;
Buffer: array[0..1024] of Char;
begin
// va_start(Args, Format)
Args := va_list(PAnsiChar(#Format) + ((SizeOf(Format) + StackSlotSize - 1) and not (StackSlotSize - 1)));
SetString(Result, Buffer, wvsprintf(Buffer, PChar(Format), Args));
end;
const // allows us to use "varargs" in Delphi
FormatC: function(const Format: string): string; cdecl varargs = _FormatC;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(FormatC('%s %03d', 'Hallo', 3));
end;
It's not recommended to use (ws)printf since they are prone to buffer overflow, it would be better to use the safe variants (eg StringCchPrintF). It is already declared in the Jedi Apilib (JwaStrSafe).
Well, I just found this one:
function sprintf(S: PAnsiChar; const Format: PAnsiChar): Integer;
cdecl; varargs; external 'msvcrt.dll';
It simply uses the original sprintf function from msvcrt.dll which can then be used like that:
procedure TForm1.Button1Click(Sender: TObject);
var s: AnsiString;
begin
SetLength(s, 99);
sprintf(PAnsiChar(s), '%d - %d', 1, 2);
ShowMessage(S);
end;
I don't know if this is the best solution because it needs this external dll and you have to set the string's length manually which makes it prone to buffer overflows, but at least it works... Any better ideas?
more clean approach without unnecessary type casting
function sprintf(CharBuf: PChar; const Format: PAnsiChar): Integer;
cdecl; varargs; external 'msvcrt.dll';
procedure TForm1.Button1Click(Sender: TObject);
var CharBuf: PChar;
begin
CharBuf:=StrAlloc (99);
sprintf(CharBuf, 'two numbers %d - %d', 1, 2);
ShowMessage(CharBuf);
StrDispose(CharBuf);
end;
If you happen to cross compile for Windows CE App. use coredll.dll instead of msvcrt.dll
Related
Nowadays with Sydney, is there any RTL function to remove accents from a char (é becomes e for exemple) in a String? I know this question was already asked in the past but I would like to know if the answers are still accurate with Sydney - I would especially love to find a function that work on all platforms (the one I use right now works only through WideString and Windows API).
Found and modified an implementation that uses NormalizeString() from this article:
How to use NormalizeString function in delphi?
This works for me in Delphi 10.3 Rio (include System.Character in your uses clause):
function NormalizeString(NormForm: NORM_FORM; lpSrcString: LPCWSTR; cwSrcLength: Integer; lpDstString: LPWSTR; cwDstLength: Integer): Integer; stdcall; external 'C:\WINDOWS\system32\normaliz.dll';
function NormalizeText(Str: string): string;
var
nLength: integer;
c: char;
i: integer;
temp: string;
CatStr:string;
begin
nLength := NormalizeString(NormalizationD, PChar(Str), Length(Str), nil, 0);
SetLength(temp, nLength);
nLength := NormalizeString(NormalizationD, PChar(Str), Length(Str), PChar(temp), nLength);
SetLength(temp, nLength);
CatStr:='';
for i := 1 to length(temp) do
begin
c:=temp[i];
if (TCharacter.GetUnicodeCategory(c) <> TUnicodeCategory.ucNonSpacingMark) and
(TCharacter.GetUnicodeCategory(c) <> TUnicodeCategory.ucCombiningMark) then
CatStr:=CatStr+c;
end;
result:=CatStr;
end;
I want know if is possible hook a callback function for example like EnumWindowsProc() using inline hook approach? and if yes, could provide a code snippet (example) please?
Thank you.
EDITION:
EnumWindowsProc is a callback implemented in other app. I not call it inside my app.
And i want hook EnumWindowsProc in this other app, by dll injection.
You have to handle EnumWindows at first, then you have to replace pointer to original EnumWindowsProc to yourself.
My example is valid fow win32
unit Patch;
interface
procedure PatchEnumWindows(Patch: Boolean);
implementation
uses SysUtils, SyncObjs, Windows;
const
INSTR_SIZE = 6;
var
OldEnumWindows: array [0..INSTR_SIZE-1] of Byte;
EnumWindowsPatched: Boolean = False;
function PatchedEnumWindows(EnumWindowsProc: Pointer; Param: Pointer); stdcall;
begin
// You have to replace original EnumWindowsProc to yourself
end;
procedure ApiRedirect(OrigFunction, NewFunction: Pointer; var Old);
const
TEMP_JMP: array[0..INSTR_SIZE-1] of Byte = ($E9,$90,$90,$90,$90,$C3);
var
JmpSize: DWORD;
JMP: array [0..INSTR_SIZE-1] of Byte;
OldProtect: DWORD;
begin
Move(TEMP_JMP, JMP, INSTR_SIZE);
JmpSize := DWORD(NewFunction) - DWORD(OrigFunction) - 5;
if not VirtualProtect(LPVOID(OrigFunction), INSTR_SIZE, PAGE_EXECUTE_READWRITE, OldProtect) then
raise Exception.CreateFmt('%s', [SysErrorMessage(GetLastError)]);
Move(OrigFunction^, Old, INSTR_SIZE);
Move(JmpSize, JMP[1], 4);
Move(JMP, OrigFunction^, INSTR_SIZE);
VirtualProtect(LPVOID(OrigFunction), INSTR_SIZE, OldProtect, nil);
end;
procedure PatchEnumWindows(Patch: Boolean);
var
OrigEnumWindows: Pointer;
begin
if Patch <> EnumWindowsProcPatched then begin
OrigEnumWindows := GetProcAddress(GetModuleHandle('user32.dll'), 'EnumWindows');
if Patch then begin
ApiRedirect(OrigEnumWindows, #PatchedEnumWindows, OldEnumWindows);
end
else begin
Move(OldEnumWindows, OrigEnumWindows, INSTR_SIZE);
end;
EnumWindowsPatched := Patch;
end;
end;
end.
I have scowered the net trying to find an example of a function, how to hash text with Sha1 and DCPcrypt.
I have the below example. Seems to pop up the whole time.
But it returns chinese characters every time. Please assist in corecting the function.
function TForm1.EncryptThis(aString : string) : string;
var
Cipher: TDCP_cast256;
KeyStr: string;
begin
KeyStr:= '';
Cipher:= TDCP_cast256.Create(Self);
Cipher.InitStr(KeyStr,TDCP_sha1);
result := Cipher.EncryptString(aString);
Cipher.Burn;
Cipher.Free;
end;
UPDATE:
Using the links and info belowe, I built these functions. But as I said, This does not make alot of sense to me. So please excuse the ignorance.
THe code however does not work. Its output is: 3F3F3F3F3F3F3F3F3F3F00000000000000000000 whereas it should be 40bd001563085fc35165329ea1ff5c5ecbdbbeef since i told the program to has 123.
Please help.
function CalcDigest(text: string): string;
var
x: TDCP_hash;
begin
x := TDCP_sha1.Create(nil);
try
x.Init;
x.UpdateStr(text);
SetLength(Result, x.GetHashSize div 8);
x.Final(Result[1]);
finally
x.Free;
end;
end;
function String2Hex(const Buffer: Ansistring): string;
begin
SetLength(result, 2*Length(Buffer));
BinToHex(#Buffer[1], PWideChar(#result[1]), Length(Buffer));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
memo2.Lines.Add(String2Hex(CalcDigest(memo1.Lines.Strings[0])));
end;
Judging by this, you can do it this way:
function CalcDigest(text: string): string;
var
x: TDCP_hash;
begin
x := TDCP_sha1.Create(nil);
try
x.Init;
x.UpdateStr(text);
SetLength(Result, x.GetHashSize div 8);
x.Final(Result[1]);
finally
x.Free;
end;
end;
You may want to encode the hash before printing, because the output is binary. See for example this question.
I am not very familiar with DCPCrypt. You can also use other libraries.
1) Indy - usually included in Delphi
function SHA1Text(const s: string): string;
begin
with TIdHashSHA1.Create do
try
Result:=LowerCase(HashStringAsHex(s));
finally
Free;
end;
end;
2) Wolfgang Ehrhardt's libraries (fastest as far as I know) from
http://www.wolfgang-ehrhardt.de/crchash_en.html
function SHA1Text(const s: string): string;
var
Context: THashContext;
SHA1Digest: TSHA1Digest;
begin
SHA1Init(Context);
SHA1Update(Context, pChar(s), length(s));
SHA1Final(Context, SHA1Digest);
Result:=HexStr(#SHA1Digest, SizeOf(SHA1Digest));
end;
NOTE: it is from Delphi 7. You will need to update it if you use unicode Delphi.
suppose i have a unit like this
unit sample;
interface
function Test1:Integer;
procedure Test2;
implementation
function Test1:Integer;
begin
result:=0;
end;
procedure Test2;
begin
end;
end.
Is possible enumerate all the procedures and functions of the unit sample in runtime?
No. RTTI is not generated for standalone methods. Hopefully this will be fixed in a later version, (they'd probably need a TRttiUnit type to do that,) but for now it's not available.
You could extract that information from some kind of debug info (TD32, Map file, Jdbg, etc.) using JCL and their great JclDebug.pas.
Try this:
uses
JclDebug;
type
TProc = record
name: string;
addr: Pointer;
end;
TProcArray = array of TProc;
TMapLoader = class
private
FModule: Cardinal;
FProcs: TProcArray;
FMapFileName: string;
FUnitName: string;
procedure HandleOnPublicsByValue(Sender: TObject; const Address: TJclMapAddress; const Name: string);
public
constructor Create(const AFileName: string; AModule: Cardinal; const AUnitName: string);
procedure Scan();
property Procs: TProcArray read FProcs;
end;
constructor TMapLoader.Create(const AFileName: string; AModule: Cardinal; const AUnitName: string);
begin
inherited Create;
FMapFileName := AFileName;
FModule := AModule;
FUnitName := AUnitName;
end;
procedure TMapLoader.HandleOnPublicsByValue(Sender: TObject; const Address: TJclMapAddress; const Name: string);
var
l: Integer;
begin
if Pos(FUnitName + '.', Name) = 1 then
begin
l := Length(FProcs);
SetLength(FProcs, l + 1);
FProcs[l].name := Name;
FProcs[l].addr := Pointer(Address.Offset + FModule + $1000);
end;
end;
procedure TMapLoader.Scan();
var
parser: TJclMapParser;
begin
parser := TJclMapParser.Create(FMapFileName, FModule);
try
parser.OnPublicsByValue := HandleOnPublicsByValue;
parser.Parse;
finally
parser.Free;
end;
end;
I don't think so.
That is a compile-time config, it's used so as the compiler knows which function name is being called or not. As far as I know, there is nothing at runtime which comes close to listing these functions.
Delphi's excellent runtime features come from RTTI, you might want to see what it offers in relation to this. But as I said, I don't think it's possible (know that I've delved in RTTI for quite some time...).
Edit: Oh and by the way, after compilation, functions lose their human-readable names (to addresses). There are some tables which pinpoint those names to addresses, most notably, RTTI and the Debug info.
Are there any wide-string manipulation implementations out there?
function WideUpperCase(const S: WideString): WideString;
function WidePos(Substr: WideString; S: WideString): Integer;
function StringReplaceW(const S, OldPattern, NewPattern: WideString;
Flags: TReplaceFlags): WideString;
etc
The JEDI project includes JclUnicode.pas, which has WideUpperCase and WidePos, but not StringReplace. The SysUtils.pas StringReplace code isn't very complicated, so you could easily just copy that and replace string with WideString, AnsiPos with WidePos, and AnsiUpperCase with WideUpperCase and get something functional, if slow.
I generally import the "Microsoft VBScript Regular Expression 5.5" type library and use IRegExp objects.
OP Edit
i like this answer, and i went ahead and wrote a StringReplaceW function using RegEx:
function StringReplaceW(const S, OldPattern, NewPattern: WideString; Flags: TReplaceFlags): WideString;
var
objRegExp: OleVariant;
Pattern: WideString;
i: Integer;
begin
{
Convert the OldPattern string into a series of unicode points to match
\uxxxx\uxxxx\uxxxx
\uxxxx Matches the ASCII character expressed by the UNICODE xxxx.
"\u00A3" matches "£".
}
Pattern := '';
for i := 1 to Length(OldPattern) do
Pattern := Pattern+'\u'+IntToHex(Ord(OldPattern[i]), 4);
objRegExp := CreateOleObject('VBScript.RegExp');
try
objRegExp.Pattern := Pattern;
objRegExp.IgnoreCase := (rfIgnoreCase in Flags);
objRegExp.Global := (rfReplaceAll in Flags);
Result := objRegExp.Replace(S, NewPattern);
finally
objRegExp := Null;
end;
end;
The TntControls has a set of Wide-version functions.