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;
Related
I need to read some information regarding the monitors connected through the EnumDisplayDevicesA function.
I tried to convert the following example written in c++ to delphi, but I have a problem when I try to read the device name from the PDISPLAY_DEVICEA structure LDeviceName := LDisplayDevice.deviceName; as it only returns Chinese characters.
I think it is a problem related to character encoding but I don't know how to fix it.
My source code:
program Monitor;
{$APPTYPE CONSOLE}
uses
System.SysUtils;
const
user32 = 'user32.dll';
type
LONG = LongInt;
BOOL = LongBool;
PDISPLAY_DEVICE = ^DISPLAY_DEVICE;
LPCSTR = array[0..128 - 1] of WideChar;
PLPCSTR = ^LPCSTR;
//https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-display_devicea
DISPLAY_DEVICE = packed record
cb: Cardinal;
deviceName: array[0..32 - 1] of WideChar;
deviceString: array[0..128 - 1] of WideChar;
stateFlags: Cardinal;
deviceID: array[0..128 - 1] of WideChar;
deviceKey: array[0..128 - 1] of WideChar;
end;
//https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-enumdisplaydevicesa
function EnumDisplayDevicesA(APCSTR: PLPCSTR; iDevNum: Cardinal; PDISPLAY_DEVICEA: PDISPLAY_DEVICE; dwFlags: Cardinal): BOOL; stdcall; external user32;
procedure PrintMonitorNames();
var
LDisplayDevice: DISPLAY_DEVICE;
LDeviceIndex: Integer;
LMonitorIndex: Integer;
LDeviceName: string;
begin
LDisplayDevice.cb := Sizeof(LDisplayDevice);
LDeviceIndex := 0;
while EnumDisplayDevicesA(nil, LDeviceIndex, #LDisplayDevice, 0) do
begin
LDeviceName := LDisplayDevice.deviceName;
Writeln('Device name: ' + LDeviceName);
LMonitorIndex := 0;
while EnumDisplayDevicesA(#LDeviceName, LMonitorIndex, #LDisplayDevice, 0) do
begin
Writeln(StrPas(LDisplayDevice.deviceName) + ' ' + StrPas(LDisplayDevice.deviceString));
Inc(LMonitorIndex);
end;
Inc(LDeviceIndex);
end;
end;
var
LDummy: string;
begin
Writeln('START');
PrintMonitorNames();
Writeln('FINISH');
Readln(LDummy);
end.
You are mixing ANSI and Unicode.
The EnumDisplayDevices function exists in two versions:
EnumDisplayDevicesA which is (legacy) ANSI.
EnumDisplayDevicesW which is Unicode.
You are calling the ANSI version EnumDisplayDevicesA, but are using a Unicode version of DISPLAY_DEVICE. So you need to use EnumDisplayDevicesW instead.
This phenomenon that an API function exists in both W and A versions is present everywhere in the Windows API, so the above remarks are very general.
The fact that you get Chinese text because of this encoding mismatch is also very well known.
Having said all this, you don't need to declare EnumDisplayDevices yourself at all. Everything you need is already present in the Delphi RTL's Windows.pas unit, just like I showed you two days ago:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Winapi.Windows;
begin
var dd, md: TDisplayDevice;
FillChar(dd, SizeOf(dd), 0);
dd.cb := SizeOf(dd);
FillChar(md, SizeOf(md), 0);
md.cb := SizeOf(md);
var i := 0;
while EnumDisplayDevices(nil, i, dd, 0) do
begin
var j := 0;
while EnumDisplayDevices(#dd.DeviceName[0], j, md, 0) do
begin
Writeln(md.DeviceString);
Inc(j);
end;
Inc(i);
end;
Readln;
end.
Notice that MSDN says this:
The winuser.h header defines EnumDisplayDevices as an alias which automatically selects the ANSI or Unicode version of this function based on the definition of the UNICODE preprocessor constant.
The same remarks applies to the Delphi RTL's Windows.pas.
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.
In Delphi XE4 and above, we may write something like:
function TestAnsiCompatible(const aStr: string): Boolean;
begin
end;
string in Delphi XE4 is declared as UnicodeString. It may hold a unicode string.
If we do some type conversion:
function TestAnsiCompatible(const aStr: string): Boolean;
var a: AnsiString;
begin
a := aStr;
Result := a = aStr;
end;
Some compiler warnings should prompt:
[dcc32 Warning]: W1058 Implicit string cast with potential data loss from 'string' to 'AnsiString'
[dcc32 Warning]: W1057 Implicit string cast from 'AnsiString' to 'string'
Is there a much simple and neat way to test if aStr is fully compatible with AnsiString? Or we shall check character by characters:
function TestAnsiCompatible(const aStr: string): Boolean;
var C: Char;
begin
Result := True;
for C in aStr do begin
if C > #127 then begin
Result := False;
Break;
end;
end;
end;
All you have to do is type-cast away the warnings:
function TestAnsiCompatible(const aStr: string): Boolean;
var
a: AnsiString;
begin
a := AnsiString(aStr);
Result := String(a) = aStr;
end;
Which can be simplified to this:
function TestAnsiCompatible(const aStr: string): Boolean;
begin
Result := String(AnsiString(aStr)) = aStr;
end;
I used to check if String(a) = AnsiString(a), until I had a user who had transferred data from one PC to another, and that had a different codepage. Then the data could not be read back properly. Then I changed my definition of "safe" to "string is code page 1252" (as this is the region where most of my users are). Then when reading back my data, I know I have to convert the string back from code page 1252.
function StringIs1252(const S: UnicodeString): Boolean;
// returns True if a string is in codepage 1252 (Western European (Windows))
// Cyrillic is 1251
const
WC_NO_BEST_FIT_CHARS = $00000400;
var
UsedDefaultChar: BOOL; // not Boolean!!
Len: Integer;
begin
if Length(S) = 0 then
Exit(True);
UsedDefaultChar := False;
Len := WideCharToMultiByte(1252, WC_NO_BEST_FIT_CHARS, PWideChar(S), Length(S), nil, 0, nil, #UsedDefaultChar);
if Len <> 0 then
Result := not UsedDefaultchar
else
Result := False;
end;
But if you want to check if your string can safely be converted to ansi - completely independent of the code page that is used when writing or reading, then you should check if all characters are in the range from #0..#127.
I'm trying to have some effective code to get vendor, serial number, and model of a USB drive, using its drive letter. I've searched a lot and found several solutions. But I can not determine which one is the best one.
First one is here. Uses hid.pas from JEDI, but I don't know how to use it with a single drive. Specially, function GetHidDeviceInfo is very interesting but requires symbolic link rather that a drive letter. I tried to invite a symbolic link for the drive letter at no avail.
Second one is here. Uses WMI which doesn't seem very clean. My experience tells me that WMI doesn't work on all PCs. The code doesn't work on my own laptop, saying 'The RPC server is unavailable'.
Please advice me on the best way to achieve my goal. Are other ways around?
Update: I'm posting some sample code, combining the results of comments below.
{$APPTYPE CONSOLE}
uses
Windows, Messages, SysUtils, Variants;
type
PHIDDAttributes = ^THIDDAttributes;
HIDD_ATTRIBUTES = record
Size: ULONG; // size of structure (set before call)
VendorID: Word;
ProductID: Word;
VersionNumber: Word;
//
// Additional fields will be added to the end of this structure.
//
end;
THIDDAttributes = HIDD_ATTRIBUTES;
THIDUSBDeviceInfo = Record { contains interface level information of each device}
SymLink : String;
BufferSize : Word;
Handle : THandle;
VID : DWord;
PID : DWord;
VersionNumber : Word;
ManufacturerString : String;
ProductString : String;
SerialNumberString : String;
end;
function GetVolumeNameForVolumeMountPointW(const lpszVolumeMountPoint: LPCWSTR;
lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall;
external kernel32;
function HidD_GetAttributes(HidDeviceObject: THandle;
var HidAttrs: THIDDAttributes): LongBool; stdcall;external 'hid.dll' name 'HidD_GetAttributes';
function HidD_GetManufacturerString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetManufacturerString';
function HidD_GetProductString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetProductString';
function HidD_GetSerialNumberString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetSerialNumberString';
function GetVolumeName(Name: string): string;
var
Volume: array [0..MAX_PATH] of Char;
begin
FillChar(Volume[0], SizeOf(Volume), 0);
GetVolumeNameForVolumeMountPointW(PChar(Name), #Volume[0], SizeOf(Volume));
Result := Volume;
end;
Function GetHidDeviceInfo( Symlink : PChar) : THIDUSBDeviceInfo;
Var
pstr : pWideChar;
DevHandle : THandle;
HidAttrs : THIDDAttributes;
Begin
FillChar(Result, SizeOf( Result), 0);
Result.SymLink := SymLink+ #0;
GetMem( pstr, 512);
DevHandle := CreateFile( Symlink,
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
0,
0);
If DevHandle <> INVALID_HANDLE_VALUE then
begin
If HidD_GetAttributes( DevHandle,HidAttrs) then
begin
result.VID := HidAttrs.VendorID;
result.PID := HidAttrs.ProductID;
result.VersionNumber := HidAttrs.VersionNumber;
end;
If HidD_GetManufacturerString( DevHandle, pstr, 512) then
Result.ManufacturerString := pStr;
If HidD_GetProductString( DevHandle, pstr, 512) then
Result.ProductString := pStr;
If HidD_GetSerialNumberString( DevHandle, pstr, 512) then
Result.SerialNumberString := pStr;
closeHandle( DevHandle);
end;
FreeMem( pStr);
End;
procedure Main;
var
VolumeName: string;
info: THIDUSBDeviceInfo;
begin
VolumeName:=GetVolumeName('i:\'); //assuming that I: is a USB drive
info:=GetHidDeviceInfo(pchar(VolumeName));
Writeln(info.SerialNumberString);
end;
begin
Main;
Readln;
end.
You can try to obtain SerialNumber of disk (and more information) using WMI.
Usin WMI and the Win32_DiskDrive class, you can get the Serial Number. The documentation say: "Windows Server 2003 and Windows XP: This property is not available."
In Windows Vista,7/8 works fine.
To try if this method is good for you, try this simple demo on clubdelphi ftp(source included and binary included). In Windows 7 you get information like this:
If you can obtain a correct serial, you can use WMI.
Good library for work with WMI is GLibWMI on Sourceforge. Include a specific component (DiskDriveInfo) that you can use with 0 code lines.
See demo.
Regards
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