I am trying to use MultiByteToWideChar but i get 'undeclared identifier' . Where is it declared ? which 'uses' ?
I am using Embarcadero Delphi XE8.
The MultiByteToWideChar Windows API function (Win32/Win64) is defined in Delphi or FreePascal in the Windows unit; just add Windows or Winapi.Windows to the uses clause.
You may wish to use wrapper function written in Delphi to convert RawByteString (or AnsiString) to UnicodeString and vice versa, rather than calling the MultiByteToWideChar directly. Calling it directly may be prone to errors due to incorrect calculation of the lengths of the underlying buffers.
Please note that Delphi RawByteString or AnsiString have a property to store the Windows code page value, and it is set by the SetCodePage() call in the code below. The code uses explicit types, PAnsiChar vs PWideChar and RawByteString vs UnicodeString to avoid ambiguity.
uses
Windows;
const
CP_UNICODE_LE = 1200;
function StringToWideStringCP(const S: RawByteString; CP: Integer): UnicodeString;
var
P: PAnsiChar;
pw: PWideChar;
I, J: Integer;
begin
Result := '';
if S = '' then
Exit;
if CP = CP_UTF8 then
begin
// UTF8
Result := UTF8ToUnicodeString(S);
Exit;
end;
P := #S[1];
I := MultiByteToWideChar(CP, 0, P, Length(S), nil, 0);
if I <= 0 then
Exit;
SetLength(Result, I);
pw := #Result[1];
J := MultiByteToWideChar(CP, 0, P, Length(S), pw, I);
if I <> J then
SetLength(Result, Min(I, J));
end;
function WideStringToStringCP(const w: UnicodeString; CP: Integer)
: RawByteString;
var
P: PWideChar;
I, J: Integer;
begin
Result := '';
if w = '' then
Exit;
case CP of
CP_UTF8:
begin
// UTF8
Result := UTF8Encode(w);
Exit;
end;
CP_UNICODE_LE:
begin
// Unicode codepage
CP := CP_ACP;
end;
end;
P := #w[1];
I := WideCharToMultibyte(CP, 0, P, Length(w), nil, 0, nil, nil);
if I <= 0 then
Exit;
SetLength(Result, I);
J := WideCharToMultibyte(CP, 0, P, Length(w), #Result[1], I, nil, nil);
if I <> J then
SetLength(Result, Min(I, J));
SetCodePage(Result, CP, False);
end;
It is a Windows API function, so if you want to call it you must use Winapi.Windows.
If you write cross platform code then call UnicodeFromLocaleChars instead.
Related
I need a wildcard that would match only numbers. I tried FileExistsWildcard function from How to test using wildcards whether a file exists in Inno Setup:
FileExistsWildcard(ExpandConstant('{app}\sav[1-9]'))
But Pascal Script obviously doesn't work that way. Is there such a wildcard or should I write a custom function or something?
P.S. Is there a wildcard matching list for Inno Setup at all?
The #TLama's FileExistsWildcard function internally uses Inno Setup FindFirst function, which in turn internally uses Windows FindFirstFile function.
And Windows supports only * and ? in its wildcards. The range/set pattern [a-z] is *nix thing only.
So it's not a Pascal (Script) limitation. It's a Windows limitation.
Implementing a generic matching function that supports all of ?, * and [a-z] is not easy.
I've tried to implement a matching function that is compatible with Windows matching (FindFirstFile) but supports a set pattern (including range set).
I was not identify exact rules how Windows treat . in the mask and the filename. So my matching function does not behave exactly the same in that respect. Otherwise, I believe, it is identical. And it supports [abc] set pattern as well as range set pattern [a-z], or any combination like [_0-9a-z].
function MatchesMaskEx(Mask: string; FileName: string): Boolean;
var
MaskI: Integer;
MaskC: Char;
FileNameI: Integer;
FileNameI2: Integer;
P: Integer;
Mask2: string;
EOSMatched: Boolean;
begin
Mask := LowerCase(Mask);
FileName := LowerCase(FileName);
MaskI := 1;
FileNameI := 1;
Result := True;
EOSMatched := False;
while (MaskI <= Length(Mask)) and Result do
begin
MaskC := Mask[MaskI];
if MaskC = '?' then
begin
{ noop, ? matches anything, even beyond end-of-string }
Inc(FileNameI);
end
else
if MaskC = '[' then
begin
if FileNameI > Length(FileName) then
begin
Result := False;
end
else
begin
P := Pos(']', Copy(Mask, MaskI + 1, Length(Mask) - MaskI));
if P = 0 then
begin
{ unclosed set - no match }
Result := False;
end
else
begin
Result := False;
P := P + MaskI;
Inc(MaskI);
while (MaskI < P) and (not Result) do
begin
MaskC := Mask[MaskI];
{ is it range (A-Z) ? }
if (MaskI + 2 < P) and (Mask[MaskI + 1] = '-') then
begin
MaskI := MaskI + 2;
end;
{ matching the range (or pseudo range A-A) }
if (MaskC <= FileName[FileNameI]) and
(FileName[FileNameI] <= Mask[MaskI]) then
begin
Inc(FileNameI);
Result := True;
MaskI := P - 1;
end;
Inc(MaskI);
end;
end;
end;
end
else
if MaskC = '*' then
begin
Mask2 := Copy(Mask, MaskI + 1, Length(Mask) - MaskI);
Result := False;
{ Find if the rest of the mask can match any remaining part }
{ of the filename => recursion }
for FileNameI2 := FileNameI to Length(FileName) + 1 do
begin
if MatchesMaskEx(
Mask2, Copy(FileName, FileNameI2, Length(FileName) - FileNameI2 + 1)) then
begin
Result := True;
MaskI := Length(Mask);
FileNameI := Length(FileName) + 1;
break;
end;
end;
end
else
begin
if (FileNameI <= Length(FileName)) and (FileName[FileNameI] = MaskC) then
begin
Inc(FileNameI);
end
else
begin
{ The dot can match EOS too, but only once }
if (MaskC = '.') and (FileNameI > Length(FileName)) and (not EOSMatched) then
begin
EOSMatched := True;
end
else
begin
Result := False;
end;
end;
end;
Inc(MaskI);
end;
if Result and (FileNameI <= Length(FileName)) then
begin
Result := False;
end;
end;
Use it like:
function FileExistsEx(Path: string): Boolean;
var
FindRec: TFindRec;
Mask: string;
begin
if FindFirst(AddBackslash(ExtractFilePath(Path)) + '*', FindRec) then
begin
Mask := ExtractFileName(Path);
try
repeat
if (FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0) and
MatchesMaskEx(Mask, FindRec.Name) then
begin
Result := True;
Exit;
end;
until not FindNext(FindRec);
finally
FindClose(FindRec);
end;
end;
Result := False;
end;
For your specific needs, you can also use a simple ad-hoc function like:
function SpecialFileExists(Path: string): Boolean;
var
FindRec: TFindRec;
begin
if FindFirst(AddBackslash(Path) + '*', FindRec) then
begin
try
repeat
if (Length(FindRec.Name) = 4) and
(Copy(FindRec.Name, 1, 3) = 'sav') and
(FindRec.Name[4] >= '0') and (FindRec.Name[4] <= '9') then
begin
Result := True;
Exit;
end;
until not FindNext(FindRec);
finally
FindClose(FindRec);
end;
end;
Result := False;
end;
Use it like:
SpecialFileExists(ExpandConstant('{app}'))
What's the most efficient way to replace every third character of the same type in a string?
I have a string like this:
str := 'c1'#9'c2'#9'c3'#9'c4'#9'c5'#9'c6'#9'
I want to replace every third #9 by #13#10, so that i get:
str1 := 'c1'#9'c2'#9'c3'#13#10'c4'#9'c5'#9'c6'#13#10'
I would do this in this way:
i:=0;
newStr:='';
lastPos := Pos(str,#9);
while lastPos > 0 do begin
if i mod 3 = 2 then begin
newStr := newStr + Copy(str,1,lastPos-1) + #13#10;
end else begin
newStr := newStr + Copy(str,1,lastPos);
end;
str := Copy(str,lastPos+1,MaxInt);
i := i + 1;
lastPos := Pos(str,#9);
end;
newStr := Copy(str,1,MaxInt);
But thats a lot of copying. Is there a string manipulation function to do this?
I think the problem as stated doesn't match the code you provided. Is every third character a #9? If so, do you want to change every third appearance of #9 for #13#10?
If so, I would do it this way:
function test(str: string): string;
var
i, c, l: integer;
begin
l := Length(str);
SetLength(Result, l + l div 9);
c := 1;
for i := 1 to l do
begin
if (i mod 9 = 0) and (i > 0) then
begin
Result[c] := #13;
Inc(c);
Result[c] := #10;
end
else
Result[c] := str[i];
Inc(c);
end;
end;
I actually have no idea if this function performs well. But given that the constraints aren't clear, I guess so.
If the position of the #9 character is unknown then this solution won't work at all.
Edit: as David points out, this is not nearly equivalent to the original code posted. This seems to work, but it requires two passes on the original string. The thing is, to know if its more efficient or not we need to know more about the input and context.
function OccurrencesOfChar(const S: string; const C: char): integer;
var
i: integer;
begin
result := 0;
for i := 1 to Length(S) do
if S[i] = C then
inc(result);
end;
function Test(str: string): string;
var
len, n, C, i: integer;
begin
C := 1;
len := Length(str);
n := OccurrencesOfChar(str, #9);
SetLength(result, len + n div 3);
n := 1;
for i := 1 to len do
begin
if str[i] = #9 then
begin
if n mod 3 = 0 then
begin
result[C] := #13;
inc(C);
result[C] := #10;
end
else
result[C] := #9;
Inc(n);
end
else
result[C] := str[i];
inc(C);
end;
end;
I expect this question will be closed, but just for fun, that would be my proposal.
Function Replace(const Instr:String;Re:Char;const ReWith:String):String;
var
i,o,cnt,l:Integer;
begin
cnt:=0;
o:=0;
SetLength(Result,Length(Instr)*Length(ReWith));// just for security
for I := 1 to Length(Instr) do
begin
if Instr[i]=Re then inc(cnt);
if cnt=3 then
begin
for l := 1 to Length(ReWith) do
begin
inc(o);
Result[o] := ReWith[l];
end;
cnt := 0;
end
else
begin
inc(o);
Result[o] := Instr[i];
end;
end;
SetLength(Result,o);
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
Edit2.Text := Replace(Edit1.Text,'A','xxx')
end;
I would probably do something like this (coded in the browser). It only needs one string resize and should have less movement of data around. I exit when I have made the last replacement or if it didn't need any:
procedure ReplaceXChar(var aStringToReplace: string; const aIteration:
Integer; const aChar: Char; const aReplacement: string);
var
replaceCount: Integer;
cntr: Integer;
outputCntr: Integer;
lengthToReplace: Integer;
begin
// Find the number to replace
replaceCount := 0;
for cntr := 1 to Length(aStringToReplace) do
begin
if aStringToReplace[cntr] = aChar then
Inc(replaceCount);
end;
if replaceCount >= aIteration then
begin
// Now replace them
lengthToReplace := Length(aReplacement);
cntr := Length(aStringToReplace);
SetLength(aStringToReplace, cntr +
(replaceCount div aIteration) * (lengthToReplace - 1));
outputCntr := Length(aStringToReplace);
repeat
if aStringToReplace[cntr] = aChar then
begin
if (replaceCount mod aIteration) = 0 then
begin
Dec(outputCntr, lengthToReplace);
Move(aReplacement[1], aStringToReplace[outputCntr+1],
lengthToReplace * SizeOf(Char));
end
else
begin
aStringToReplace[outputCntr] := aStringToReplace[cntr];
Dec(outputCntr);
end;
Dec(replaceCount);
end
else
begin
aStringToReplace[outputCntr] := aStringToReplace[cntr];
Dec(outputCntr);
end;
Dec(cntr);
until replaceCount = 0;
end;
end;
Usage would be like this:
var
myString: String;
begin
myString := 'c1'#9'c2'#9'c3'#9'c4'#9'c5'#9'c6'#9;
ReplaceXChar(myString, 3, #9, #13#10);
ShowMessage(myString);
end;
Something strange happens when I try to pass strings from the Lines of a TMemo control to an array of PChar. At the end of the routine, the last string in the array is duplicated. I was able to replicate this in this simple code:
procedure Test;
var
i: smallint;
arr: array of PAnsiChar;
strarr: array[0..1] of string;
begin
SetLength(arr, 2);
strarr[0] := 'abbb';
strarr[1] := 'baaa';
for i := 0 to Length(strarr) do
arr[i] := PAnsiChar(AnsiString(strarr[i]));
end;
If I run this procedure step by step, I can see arr[0] = 'abbb' however, at the end of the rutine, both values, arr[0] and arr[1] equal to baaa. I guess it has something to do with the typecast.
Can anyone see what is wrong ?
There are two problems with your code:
Your loop is exceeding the upper bound of the array. It needs to use for i := 0 to Length(strarr)-1 do or for i := 0 to High(strarr) do instead.
More importantly, when you type-cast an AnsiString to a PAnsiChar, it returns a pointer to the AnsiString's internal data if the AnsiString is not empty. You are type-casting a UnicodeString to an AnsiString and grabbing a pointer into it, so the compiler has to use a compiler-generated local variable for the AnsiString data. In other words, your code is effectively doing the same thing as the following:
procedure Test;
var
i: smallint;
arr: array of PAnsiChar;
strarr: array[0..1] of string;
compiler_temp: AnsiString;
begin
SetLength(arr, 2);
strarr[0] := 'abbb';
strarr[1] := 'baaa';
for i := 0 to Length(strarr) do
begin
compiler_temp := AnsiString(strarr[i]);
arr[i] := PAnsiChar(compiler_temp);
end;
end;
Depending on how the memory for compiler_temp gets managed by the RTL memory manager at run-time, it is certainly possible for arr[0] and arr[1] to end up pointing at the same physical memory block in this situation.
If you want an array of PAnsiChar values then you need to start with an array of Ansi data for them to point at:
procedure Test;
var
i: Integer;
arr: array of PAnsiChar;
strarr: array[0..1] of AnsiString;
begin
SetLength(arr, 2);
strarr[0] := 'abbb';
strarr[1] := 'baaa';
for i := 0 to Length(strarr)-1 do
arr[i] := PAnsiChar(strarr[i]);
end;
I'm writing a small PE file analyzer and I have to read the contents of the PE file. I'm doing this via the ReadFile function, as shown below:
function TMainForm.GetPEData(var filename: string) : boolean;
var
hFile: DWORD;
IDH: TImageDosHeader;
INH: TImageNtHeaders;
ISH: TImageSectionHeader;
dwRead: DWORD;
szBuff: array[0..7] of Char;
i: WORD;
PE: TPEFile;
begin
Result := False;
PE := TPeFile.Create;
if PE.LoadFromFile (filename) then
Form2.edEntryPoint.Text := IntToHex(PE.RvaToFileOffset(PE.AddressOfEntryPoint), 8);
SplashScreen.sLabel1.Caption := 'PE File Loaded';
hFile := CreateFile(PChar(filename), GENERIC_READ,
FILE_SHARE_WRITE, nil,
OPEN_EXISTING, 0, 0);
if hFile <> INVALID_HANDLE_VALUE then
begin
SetFilePointer(hFile, 0, nil, FILE_BEGIN);
SplashScreen.sLabel1.Caption := 'Reading DOS File Headers...';
ReadFile(hFile, IDH, 64, dwRead, nil);
if IDH.e_magic = IMAGE_DOS_SIGNATURE then
begin
SetFilePointer(hFile, IDH._lfanew, nil, FILE_BEGIN);
SplashScreen.sLabel1.Caption := 'Reading NT File Headers...';
//Here is where the UI freezes while the file is read...
ReadFile(hFile, INH, 248, dwRead, nil);
if INH.Signature = IMAGE_NT_SIGNATURE then
begin
Form2.edImageBase.Text := IntToHex(INH.OptionalHeader.ImageBase, 8);
Form2.edSizeOfImage.Text := IntToHex(INH.OptionalHeader.SizeOfImage, 8);
Form2.edLinkerVersion.Text := IntToStr(INH.OptionalHeader.MajorLinkerVersion) + '.' +
IntToStr(INH.OptionalHeader.MinorLinkerVersion);
Form2.edFileAlignment.Text := IntToHex(INH.OptionalHeader.FileAlignment, 8);
Form2.edSectionAlignment.Text := IntToHex(INH.OptionalHeader.SectionAlignment, 8);
Form2.edSubSystem.Text := IntToHex(INH.OptionalHeader.Subsystem, 4);
Form2.edEPFilestamp.Text := IntToStr(INH.FileHeader.TimeDateStamp);
Form2.edFileType.Text := GetPEFileType(PE.ImageNtHeaders.Signature);
for i := 0 to INH.FileHeader.NumberOfSections - 1 do
begin
SetFilePointer(hFile, IDH._lfanew + 248 + i * 40, nil, FILE_BEGIN);
ReadFile(hFile, ISH, 40, dwRead, nil);
CopyMemory(#szBuff[0], #ISH.Name[0], 8);
with Form2.sListView1.Items.Add do
begin
Caption := ShortString(szBuff);
SubItems.Add(IntToHex(ISH.VirtualAddress, 8));
SubItems.Add(IntToHex(ISH.Misc.VirtualSize, 8));
SubItems.Add(IntToHex(ISH.PointerToRawData, 8));
SubItems.Add(IntToHex(ISH.SizeOfRawData, 8));
SubItems.Add(IntToHex(ISH.Characteristics, 8));
end;
end;
end;
end;
CloseHandle(hFile);
Result := True;
end;
end;
The bad thing is that, depending on the size of the file, I noticed that the ReadFile would often lag - and it happens synchronously. In the meantime, the UI freezes and looks horribly wrong to the user, who would be tempted to terminate it. I have considered threading, but I just want to see if there is any way I can use ReadFile in asynchronous mode. If there isn't, I'll jump to threading, even if I'll have a lot to modify in my code.
Thank you in advance.
In this cases I always read the whole file to the memory also I use the TFileStream class for easier manipulation.
It is simpler to have the whole file in memory and PE files are usually small.
type
TSections = array [0..0] of TImageSectionHeader;
PSections = ^TSections;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
FS : TFileStream;
fisier : PImageDosHeader;
INH : PImageNtHeaders;
ISH : PSections;
i : Word;
begin
FS := TFileStream.Create('fisierul_tau.exe',fmOpenRead);
GetMem(fisier,FS.size); //Aloci memorie pentru fisier
FS.Read(fisier^,FS.Size); // Il citesti;
FS.Free;
INH := PImageNtHeaders(DWORD(fisier) + DWORD(fisier^._lfanew));
ISH := PSections(DWORD(INH) + SizeOf(TImageNtHeaders));
for i := 0 to INH^.FileHeader.NumberOfSections - 1 do
begin
ShowMessage(PAnsiChar(#ISH[i].Name[0]));
end;
end;
The ReadFile function reads data from a file, and starts at the
position that the file pointer indicates. You can use this function
for both synchronous and asynchronous operations.
It is possible to use ReadFile asynchronously but depending on your UI this may not be the best solution. Do you want your users to do anything while they're waiting for the PE file to load?
If you want your users to wait but have confidence that your program didn't freeze you could add a progress bar or just update your SplashScreen.
for i := 0 to INH.FileHeader.NumberOfSections - 1 do
begin
SplashScreen.sLabel1.Caption := 'Reading section ' + IntToStr(i) + ' of ' + IntToStr(INH.FileHeader.NumberOfSections);
SplashScreen.sLabel1.Update; // see Ken Whites comment
// Application.ProcessMessages;
...
end
Is there a way to exclude blank strings from the dynamic array resulting of the SplitString function (Delphi XE, StrUtils), without having to iterate through the array?
If not, can anyone suggest the most efficient way to do it? Right now I'm doing it like this:
function SplitStringNoEmpty(myString : string; myDelimiters : string):TStringDynArray;
var
words_array_pre : TStringDynArray;
words_array_pos : TStringDynArray;
array_length : Integer;
actual_length : Integer;
current_word : string;
procedure AddElement(const Str: string);
begin
words_array_pos[actual_length]:= Str;
inc(actual_length);
end;
begin
words_array_pre:= SplitString(myString, whitespaceNewLineCharacterSet + punctuationCharacterSet);
array_length:= Length(words_array_pre);
if (array_length >0) then
begin
actual_length:= 0;
SetLength(words_array_pos, array_length);
for current_word in words_array_pre do
begin
if (current_word <> '') then
AddElement(current_word);
end;
SetLength(words_array_pos, actual_length);
result:= words_array_pos;
end
else
result:= words_array_pre;
end;
You can write your own implementation of the SplitString function ignoring the empty strings.
Check this sample
function SplitString2(const S, Delimiters: string): TStringDynArray;
var
LIndex, SIndex, FIndex, LMax, LPos: Integer;
foo : string;
begin
Result := nil;
if S <> '' then
begin
LPos := 0;
LMax := 0;
SIndex := 1;
for LIndex := 1 to Length(S) do
if IsDelimiter(Delimiters, S, LIndex) then Inc(LMax);
SetLength(Result, LMax + 1);
repeat
FIndex := FindDelimiter(Delimiters, S, SIndex);
if FIndex <> 0 then
begin
foo:= Copy(S, SIndex, FIndex - SIndex);
if foo<>'' then
begin
Result[LPos] := foo;
Inc(LPos);
end;
SIndex := FIndex + 1;
end;
until (LPos = LMax) or (FIndex=0);
if LPos<LMax then
SetLength(Result, LPos + 1);
foo:=Copy(S, SIndex, Length(S) - SIndex + 1);
if foo<>'' then
Result[LMax] := foo
else
SetLength(Result, LPos);
end;
end;
It's impossible to remove certain elements of an array without iterating over the array — how else would you know which elements to remove? The improvements to make to your code are to remove the need to allocate an extra array. You can cull the original array in-place:
function SplitStringNoEmpty(const s, delimiters: string): TStringDynArray;
var
Src, Dest: Integer;
begin
Result := SplitString(s, delimiters);
if Length(Result) <> 0 then begin
// Push all non-empty values to front of array
Dest := 0;
for Src := 0 to High(Result) do
if Result[Src] <> '' then begin
if Src <> Dest then
Result[Dest] := Result[Src];
Inc(Dest);
end;
// Remove excess from end of array
SetLength(Result, Dest);
end;
end;