I used to use this function to convert hex string to string in Delphi 6 :
const
testSign = '207F8060287F585054505357FFD55861';
function Hex2Dec(const data: string): byte;
var
nH1, nH2: byte;
begin
if data[1] in ['0' .. '9'] then
nH1 := strtoint(data[1])
else
nH1 := 9 + ord(data[1]) - 64;
if data[2] in ['0' .. '9'] then
nH2 := strtoint(data[2])
else
nH2 := 9 + ord(data[2]) - 64;
Result := nH1 * 16 + nH2;
end;
function HexStrToStr(const HexStr: string): string;
var
BufStr: string;
LenHex: Integer;
x, y: Integer;
begin
LenHex := Length(HexStr) div 2;
x := 1;
y := 0;
while y <> LenHex do
begin
Inc(y);
BufStr := BufStr + Chr(Hex2Dec(HexStr[x] + HexStr[x + 1]));
Inc(x, 2);
end;
Result := BufStr;
end;
Now I want to use the function with Delphi 2010.
const
testSign: AnsiString = '207F8060287F585054505357FFD55861';
function Hex2Dec(const data: ansistring): byte;
var
nH1, nH2: byte;
begin
if data[1] in ['0' .. '9'] then
nH1 := strtoint(data[1])
else
nH1 := 9 + ord(data[1]) - 64;
if data[2] in ['0' .. '9'] then
nH2 := strtoint(data[2])
else
nH2 := 9 + ord(data[2]) - 64;
Result := nH1 * 16 + nH2;
end;
function HexStrToStr(const HexStr: ansistring): ansistring;
var
BufStr: ansistring;
LenHex: Integer;
x, y: Integer;
begin
LenHex := Length(HexStr) div 2;
x := 1;
y := 0;
while y <> LenHex do
begin
Inc(y);
BufStr := BufStr + Chr(Hex2Dec(HexStr[x] + HexStr[x + 1]));
Inc(x, 2);
end;
Result := BufStr;
end;
Output from first code in D6 :
' '#$7F'€`('#$7F'XPTPSWÿÕXa'
Output from second code in D2010 :
' '#$7F#$0080'`('#$7F'XPTPSWÿÕXa'
How do I fix the code in D2010 so it can produces same result like D6?
Besides the solutions others provided, you can also make use of the built-in function:
function HexStrToStr(const HexStr: string): string;
var
tmp: AnsiString;
begin
Assert(not Odd(Length(HexStr)), 'HexToStr input length must be an even number');
SetLength(tmp, Length(HexStr) div 2);
HexToBin(PWideChar(HexStr), #tmp[1], Length(tmp));
result := tmp;
end;
This implementation assumes that the hex-encoded string has been an Ansistring in the first place. For flexibility I suggest to use TBytes instead.
Related
I have a following function to generate random passwords:
function GeneratePassword(ALength: Integer; Mode: TPasswordMode): string;
const
cLower = 'abcdefghijklmnopqrstuvwxyz';
cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cNumbers = '0123456789';
cExtra = '_.';
var
i : Integer;
S : string;
iM: BYTE;
begin
if Mode = [] then Exit;
i := 0;
Randomize;
while (i < ALength) do
begin
iM := RANDOM(4);
case iM of
0: if (pmLower in Mode) then begin
S := S + cLower[1+RANDOM(Length(cLower))];
Inc(i);
end;
1: if (pmUpper in Mode) then begin
S := S + cUpper[1+RANDOM(Length(cUpper))];
Inc(i);
end;
2: if (pmNumbers in Mode) then begin
S := S + cNumbers[1+RANDOM(Length(cNumbers))];
Inc(i);
end;
3: if (pmExtra in Mode) then begin
S := S + cExtra[1+RANDOM(Length(cExtra))];
Inc(i);
end;
end;
end;
Result := S;
end;
How to make this function so that a capital letter and a special character appear only once, but always? Sometimes there is no capital letter or special character when I'm generating passwords.
To be sure to have one special char and one uppercase you can do that :
function GeneratePassword(ALength: Integer; Mode: TPasswordModes): string;
const
cLower = 'abcdefghijklmnopqrstuvwxyz';
cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cNumbers = '0123456789';
cExtra = '_.';
var
iM: Byte;
i: integer;
begin
if Mode = [] then Exit;
Result := '';
i := 0;
if pmUpper in Mode then
Inc(i);
if pmExtra in Mode then
Inc(i);
// add lower case and/or number
while Result.Length < (ALength - i) do
begin
iM := Random(2);
case iM of
0: if (pmLower in Mode) then begin
Result := Result + cLower[1 + Random(Length(cLower))];
end;
1: if (pmNumbers in Mode) then begin
Result := Result + cNumbers[1 + Random(Length(cNumbers))];
end;
end;
end;
// add uppercase and/or extra
if i > 0 then
begin
if pmUpper in Mode then
Result := Result.Insert(1 + Random(Length(Result)), cUpper[1 + Random(Length(cUpper))]);
if pmExtra in Mode then
Result := Result.Insert(1 + Random(Length(Result)), cExtra[1 + Random(Length(cExtra))]);
end;
end;
type
TPasswordMode = (pmLower, pmUpper, pmNumbers, pmExtra);
TPasswordModes = set of TPasswordMode;
implementation
function GeneratePassword(ALength: Integer; Mode: TPasswordModes): string;
const
cLower = 'abcdefghijklmnopqrstuvwxyz';
cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cNumbers = '0123456789';
cExtra = '_.';
var
i : Integer;
S : string;
iM: BYTE;
begin
if Mode = [] then Exit;
i := 0;
Randomize;
while (i < ALength) do
begin
iM := RANDOM(4);
case iM of
0: if (pmLower in Mode) then begin
S := S + cLower[1+RANDOM(Length(cLower))];
Inc(i);
end;
1: if (pmUpper in Mode) then begin
S := S + cUpper[1+RANDOM(Length(cUpper))];
Inc(i);
Mode := Mode - [pmUpper]; // This I added
end;
2: if (pmNumbers in Mode) then begin
S := S + cNumbers[1+RANDOM(Length(cNumbers))];
Inc(i);
end;
3: if (pmExtra in Mode) then begin
S := S + cExtra[1+RANDOM(Length(cExtra))];
Inc(i);
Mode := Mode - [pmExtra]; // This I added
end;
end;
end;
Result := S;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GeneratePassword(10,[pmLower,pmUpper,pmNumbers,pmExtra]));
end;
This is not a complete solution but with this you will at least remove Upper and Extra from the requirements as soon as they get taken. You now check in the end if they ever were ever added if required and then add them if so required.
Edit:
I was in a hurry when I typed the above. You just need to check in the end if the generated password contains an Upper and Extra character. If not, you still need to add them as that was one of your requirements.
Here is example that first makes sure all extra modes are filled and the rest. It prefills Result with spaces and then replaces with random chars until all spaces are replaced.
function GetRandomEmptyPos(const aStr: string): integer; inline;
begin
// find random empty position
repeat
Result := Random(Length(aStr)) + 1;
until aStr[Result] = ' ';
end;
function GeneratePassword2(aLength: Integer; aModes: TPasswordModes): string;
const
cLower = 'abcdefghijklmnopqrstuvwxyz';
cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cNumbers = '0123456789';
cExtra = '_.';
var
i,vPos: integer;
vMode: TPasswordMode;
begin
if (aLength = 0) or (aModes = []) then Exit;
Randomize;
// Prefill Result with empty spaces
Result := StringOfChar(' ', aLength);
// Add extra characters at random places
for vMode in aModes do
begin
vPos := GetRandomEmptyPos(Result);
case vMode of
pmLower: Result[vPos] := cLower[Random(Length(cLower)) + 1];
pmUpper: Result[vPos] := cUpper[Random(Length(cUpper)) + 1];
pmNumbers: Result[vPos] := cNumbers[Random(Length(cNumbers)) + 1];
pmExtra: Result[vPos] := cExtra[Random(Length(cExtra)) + 1];
end;
end;
// Add random char on emtpy spaces
for i := 1 to Result.Length do
if Result[i] = ' ' then
Result[i] := String(cLower + cNumbers)[Random(Length(cLower) + Length(cNumbers)) + 1];
end;
unrefined code but maybe it can be useful ...
function RandomPassword(PLen: Integer): string;
var
strBase: string;
strUpper: string;
strSpecial: string;
strRecombine: string;
begin
strRecombine:='';
Result := '';
Randomize;
//string with all possible chars
strBase := 'abcdefghijklmnopqrstuvwxyz1234567890';
strUpper:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
strSpecial:='#!_';
// Start Random
strRecombine:= strUpper[Random(Length(strUpper)) + 1];
Result:=strRecombine;
strRecombine:= strSpecial[Random(Length(strSpecial))+1];
repeat
Result := Result + strBase[Random(Length(strBase)) + 1];
until (Length(Result) = PLen);
RandomRange(2, Length(strBase));
Result[RandomRange(2, PLen)]:=strRecombine[1];
//result:=Result+strRecombine;
end;
Have some old code (written by someone else) that I need to fix to work with Unicode strings in Delphi 10.1. EDIT: I've narrowed my question down to the following: code below fails with unicode strings. Suggestions?
//global variable:
var
UpCaseLookup : array[ 1..255 ] of char;
// ---- Knuth, Morris, Pratt:
type
failure = array[1..255] of word;
procedure PrepareUpcaseLookup;
var
S : string; //was shortstring;
i : integer;
begin
for i := 1 to 255 do
begin
S := ToUpper( chr(i) ); //was AnsiUpperCase
UpCaseLookup[i] := S[1]
end
end;
function PosKnuthMorrisPratt(Pattern, Text: string): Integer;
var
Prefix: array of Integer;
i, k: Integer;
begin
Result := 0;
if (Pattern = '') or (Text = '') then
Exit;
Pattern := UpperCase(Pattern); // case-insensitive
Text := UpperCase(Text);
// Buld prefix function array
SetLength(Prefix, Length(Pattern) + 1);
Prefix[1] := 0;
k := 0;
for i := 2 to Length(Pattern) do begin
while (k > 0) and (Pattern[k + 1] <> Pattern[i]) do
k := Prefix[k];
if Pattern[k + 1] = Pattern[i] then
Inc(k);
Prefix[i] := k;
end;
k := 0;
for i := 1 to Length(Text) do begin
while (k > 0) and (Pattern[k + 1] <> Text[i]) do
k := Prefix[k];
if Pattern[k + 1] = Text[i] then
Inc(k);
if k = Length(Pattern) then
Exit(i + 1 - Length(Pattern));
end;
end;
begin
Memo1.Lines.Add(IntToStr(PosKnuthMorrisPratt('abaBc', 'ggabagabAbccsab')));
Memo1.Lines.Add(IntToStr(PosKnuthMorrisPratt('ab', 'ggagbc')));
Hi I am trying to generate three random characters using a function in Delphi, the code is this:
function generate(cantidad: integer): string;
const
letras_mi = 'abcdefghijklmnopqrstuvwxyz';
const
letras_ma = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
const
numeros = '0123456789';
var
finalr: string;
begin
finalr := '';
finalr := finalr + IntToStr(Random(Length(letras_mi)) + 1);
finalr := finalr + IntToStr(Random(Length(letras_ma)) + 1);
finalr := finalr + IntToStr(Random(Length(numeros)) + 1);
Result := finalr;
end;
the problem is that things like 20142 me back when I'm actually waiting 3 characters constant random variables.
Your code is converting integer index values to strings. Note that your only reference to your constants is to take their length. You return indices rather than characters.
You could fix your code by using the integer indices you generate to reference elements within your string constants. Mason and Ken showed how to do that.
Personally I would do away with the constants and write
Chr(ord('a') + Random(26))
and
Chr(ord('A') + Random(26))
and
Chr(ord('0') + Random(10))
The ordinal values of these characters were designed way back when to allow such code.
You're adding the result of Random to your finalr, not the random letter from the constants.
Try something like this instead - it uses the return of Random as the index into the string constant characters:
function generate(cantidad: integer): string;
const
letras_mi = 'abcdefghijklmnopqrstuvwxyz';
letras_ma = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
numeros = '0123456789';
begin
Result := '';
Result := Result + letras_mi[Random(Length(letras_mi)) + 1];
Result := Result + letras_ma[Random(Length(letras_ma)) + 1];
Result := Result + numeros[Random(Length(numeros)) + 1];
end;
Let's look at what your code is doing, as a compiler sees it:
IntToStr(Random(Length(letras_mi)) + 1)
Call IntToStr on the result of:
Call Random on the result of:
Add
Length(letras_mi)
1
IntToStr takes a number (such as 5) and turns it into a string (such as '5'). What you want to do is use the random value to index into your array, like so:
letras_mi[Random(Length(letras_mi)) + 1]
function RandomString(const ALength: Integer): String;
var
i: Integer;
LCharType: Integer;
begin
Result := '';
for i := 1 to ALength do
begin
LCharType := Random(3);
case LCharType of
0: Result := Result + Chr(ord('a') + Random(26));
1: Result := Result + Chr(ord('A') + Random(26));
2: Result := Result + Chr(ord('0') + Random(10));
end;
end;
end;
This will generate random strings that looks like words.
function GenerateRandomWord(CONST Len: Integer=16; StartWithVowel: Boolean= FALSE): string;
CONST
sVowels: string= 'AEIOUY';
sConson: string= 'BCDFGHJKLMNPQRSTVWXZ';
VAR
i: Integer;
B: Boolean;
begin
B:= StartWithVowel;
SetLength(Result, Len);
for i:= 1 to len DO
begin
if B
then Result[i]:= sVowels[Random(Length(sVowels)) + 1]
else Result[i]:= sConson[Random(Length(sConson)) + 1];
B:= NOT B;
end;
end;
So, use it like this: GenerateRandomWord(3);
const
Alphabetdown = 'abcdefghijklmnopqrstuvwxyz' ;
procedure TForm1.Button1Click(Sender: TObject);
var
sGeneratedAccNo : string ;
begin
sGeneratedAccNo := sGeneratedAccNo + Alphabetdown[Random(Length(Alphabetdown) + 1)] ;
showMessage(sGeneratedAccNo) ;
Faster way would be avoiding re-allocation of memory time and again.
function generate(cantidad: integer): string;
const
letras_mi = 'abcdefghijklmnopqrstuvwxyz';
numeros = '0123456789';
begin
SetLength(Result, 3); // only alloc memory once
Result[1] := letras_mi[Random(Length(letras_mi)) + 1];
Result[2] := UpCase(letras_mi[Random(Length(letras_mi)) + 1]);
Result[3] := numeros[Random(Length(numeros)) + 1];
end;
http://docwiki.embarcadero.com/Libraries/XE2/en/System.UpCase
http://www.freepascal.org/docs-html/rtl/system/upcase.html
And sometimes even slightly faster would be using local variable to avoid few extra UniqueString calls for var-parameter Result.
http://docwiki.embarcadero.com/Libraries/XE2/en/System.UniqueString
http://www.freepascal.org/docs-html/rtl/system/uniquestring.html
However timings or CPU-level code check should be made for one's specific compiler version and options to see what difference this actually makes, if any.
function generate(cantidad: integer): string;
const
letras_mi = 'abcdefghijklmnopqrstuvwxyz';
numeros = '0123456789';
var local: string;
begin
SetLength(local, 3); // only alloc memory once
local[1] := letras_mi[Random(Length(letras_mi)) + 1];
local[2] := UpCase(letras_mi[Random(Length(letras_mi)) + 1]);
local[3] := numeros[Random(Length(numeros)) + 1];
Result := local;
end;
PS. Ord-based approach is also better here than picking a char from array/string, but that is independent issue. Also i'd be wary to use Chr function with Delphi 2009 or newer, it would only work uniform on #0..#127 values. Explicitly declared typecasts like AnsiChar(i) and WideChar(i) might be more stable substitute in cause one day you would need letters outside 7-bit subrange, like eña and other European-specific ones.
function generate(cantidad: integer): string;
const
letras_mi = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
var i:integer;
begin
Result := '';
for I := 1 to cantidad do
Result := Result + letras_mi[Random(Length(letras_mi)) + 1];
end;
function generateNum(cantidad: integer): string;
const
letras_mi = '0123456789';
var i:integer;
begin
Result := '';
for I := 1 to cantidad do
Result := Result + letras_mi[Random(Length(letras_mi)) + 1];
end;
I want to insert a char into every possible position of s string except start and end.
e.g.
abc
I want to have
a-bc
ab-c
a-b-c
Below is my test, but not correct:
procedure TForm1.Button2Click(Sender: TObject);
var
start, i,j,k,position,loop: integer;
laststart,lastend:integer;
c,item,stem:string;
str, prefix:string;
begin
str:='abcd';
memo1.clear;
memo1.Lines.Add(str);
laststart:=0;
lastend:=memo1.lines.count-1;
position:=0;
prefix:='';
loop:=0;
while loop<=length(str)-1 do
begin
for j:= laststart to lastend do
begin
item:=memo1.lines[j];
for k:=length(item) downto 1 do
begin
if item[k]='-' then
begin
position:=j;
break;
end;
end; //for k
prefix:=copy(item,1,position);
stem:=copy(item,position+1, length(item));
for start:=1 to length(stem)-1 do
begin
c:=prefix+copy(stem,1,start)+'-'+
copy(stem, start+1,length(stem));
memo1.lines.add(c);
end;
end; //for j
laststart:=lastend+1;
lastend:=memo1.Lines.Count-1;
inc(loop);
end; //end while
end;
it outputs:
abcd
a-bcd
ab-cd
abc-d
a--bcd // not correct
a-b-cd
a-bc-d
ab--cd //incorrect
ab-c-d
abc--d //incorrect
a--bc-d //incorrect
I feel the maximum possible breaks is lenth(str)-1, abc->most possible is insert 2 '-' (twice). Is this correct?
And are there other faster ways to do it?
Thanks a lot.
Recursive version.
procedure InsertSymbols(s: string; c: Char; Position: Integer = 1);
var
i: Integer;
begin
Memo1.Lines.Add(s);
for i := Position to Length(s) - 1 do
InsertSymbols(Copy(s, 1, i) + c + Copy(s, i + 1, Length(s) - i), c, i + 2);
end;
begin
InsertSymbols('Test', '-');
end;
This works:
procedure TForm4.Button1Click(Sender: TObject);
var
S: string;
N: integer;
Marker: cardinal;
MaxMarker: cardinal;
Str: string;
i: Integer;
begin
S := Edit1.Text;
N := length(S);
Marker := 0;
MaxMarker := 1 shl (N - 1) - 1;
Memo1.Clear;
Memo1.Lines.BeginUpdate;
for Marker := 0 to MaxMarker do
begin
Str := S[1];
for i := 2 to N do
begin
if (Marker shr (N-i)) and 1 <> 0 then
Str := Str + '-';
Str := Str + S[i];
end;
Memo1.Lines.Add(Str);
end;
Memo1.Lines.EndUpdate;
end;
As you can see, it works by using binary representation of numbers:
t e s t
0 0 0
0 0 1
0 1 0
0 1 1
1 0 0
1 0 1
1 1 0
1 1 1
Why all the difficult solutions?
Just copy the string to a new one char by char, add hyphens in between, except for the last one.
I needed to separate a string to use as a serial number and here is the code:
Function GetDashedKey(Key: string): string
const
PartSize = 7;
var
Indx: Integer;
dashedKey : string;
begin
repeat
if Trim(dashedKey)<>'' then
dashedKey := dashedKey + ' - ';
if Length(Key) < PartSize then
begin
dashedKey := dashedKey + Key;
Key := '';
end
else
begin
dashedKey := dashedKey + Copy(Key, 1, PartSize);
Key := Copy(Key, PartSize + 1, Length(Key)-1);
end;
until Trim(Key) = '';
Result := dashedKey;
end;
I want to loop through all the files in a given directory and return their version number and exe name. I have tried digging into the shell to see if I can pull this off, however I have not been able to find a solution. Any tips would be appreciated.
This does it:
Drop a TMemo and a TButton on your form and do
type
TVerInfo = packed record
vMajor, vMinor, vRelease, vBuild: word;
end;
function GetFileVerNumbers(const FileName: string): TVerInfo;
var
len, dummy: cardinal;
verdata: pointer;
verstruct: pointer;
const
InvalidVersion: TVerInfo = (vMajor: 0; vMinor: 0; vRelease: 0; vBuild: 0);
begin
len := GetFileVersionInfoSize(PWideChar(FileName), dummy);
if len = 0 then
Exit(InvalidVersion);
GetMem(verdata, len);
try
GetFileVersionInfo(PWideChar(FileName), 0, len, verdata);
VerQueryValue(verdata, '\', verstruct, dummy);
result.vMajor := HiWord(TVSFixedFileInfo(verstruct^).dwFileVersionMS);
result.vMinor := LoWord(TVSFixedFileInfo(verstruct^).dwFileVersionMS);
result.vRelease := HiWord(TVSFixedFileInfo(verstruct^).dwFileVersionLS);
result.vBuild := LoWord(TVSFixedFileInfo(verstruct^).dwFileVersionLS);
finally
FreeMem(verdata);
end;
end;
function GetFileVer(const FileName: string): string;
begin
with GetFileVerNumbers(FileName) do
result := IntToStr(vMajor) + '.' +
IntToStr(vMinor) + '.' + IntToStr(vRelease) + '.' +
IntToStr(vBuild);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
path = 'C:\WINDOWS';
var
SR: TSearchRec;
begin
Memo1.Clear;
if FindFirst(IncludeTrailingBackslash(path) + '*.exe', faAnyFile, SR) = 0 then
try
repeat
Memo1.Lines.Add(SR.Name + #9 +
GetFileVer(IncludeTrailingBackslash(path) + SR.Name));
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
end;