I want to convert a String to a byte array, the code looks like the following:
procedure StringToByteArray(const s : String; var tmp: array of Byte);
var
i : integer;
begin
For i:=1 to Length(s) do
begin
tmp[i-1] := Ord(s[i]);
end;
end;
s[i] here is the i'th String element (= char at pos i) and I'm saving its numerical value to tmp.
This works for some characters, but not for all, for example:
Ord('•') returns Dec(149), which is what I expect.
But in my procedure Ord(s[i]) returns Dec(8226) for the same character!
Edit1: I think the defect lies in my other function "ByteArrayToStr"
When converting ...
tmp:= 149 // tmp is of type byte
Log('experiment: ' + Chr(tmp)); // prints "•"
Log('experiment2 ' + IntToStr(Ord(Chr(tmp)))); // prints 149
... back and forth, this seems to work.
But using the same conversion in the following function won't do it:
function ByteArrayToStr( a : array of Byte ) : String;
var
S:String;
I:integer;
begin
S:='';
For I:=0 to Length(a) -1 do
begin
tmp := Chr(a[I]) ; // for a[I] equals 149 this will get me "?" instead of "•"
S:=S+tmp;
end;
Result:=S;
end;
To make it clear: ByteArrayToStr does not convert Ord(149) to "•" as expected, and therefore StringToByteArray won't work later on
You need to turn your parameters into AnsiString type. By doing so, you can write functions like this:
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
OutputDir=userdocs:Inno Setup Examples Output
[Code]
procedure StringToByteArray(const S: AnsiString; out ByteArray: array of Byte);
var
I: Integer;
begin
SetArrayLength(ByteArray, Length(S));
for I := 1 to Length(S) do
ByteArray[I - 1] := Ord(S[I]);
end;
function ByteArrayToString(const ByteArray: array of Byte): AnsiString;
var
I: Integer;
begin
SetLength(Result, GetArrayLength(ByteArray));
for I := 1 to GetArrayLength(ByteArray) do
Result[I] := Chr(ByteArray[I - 1]);
end;
procedure InitializeWizard;
var
S: AnsiString;
ByteArray: array of Byte;
begin
S := '•';
StringToByteArray(S, ByteArray);
MsgBox(IntToStr(ByteArray[0]), mbInformation, MB_OK);
S := '';
S := ByteArrayToString(ByteArray);
MsgBox(S, mbInformation, MB_OK);
end;
Related
I'm trying to sort a string grid filled with scores and strings like so:
via a sorted string list which is sorted by single columns from the grid called SUB 1, SUB 2, FINAL, TOTAL respectively (all these columns work except FINAL) and I'm not getting the results I need in the FINAL column.
I'm trying to get the column sorted like so, for example :
24
20
12
5
DNF
EXE
WE
but I'm getting this result instead (the result I do not want):
DNF
EXE
WE
24
20
12
5
In what way could I change my code to sort the grid as I want to sort it?
My code:
function Compare2(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
//comparer for custom sort used in SortLTSGrid
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] < List[Index2] then
Result := 1
else
Result := -1;
end;
procedure TfrmPuntehou.SortLTSGrid(var grid: TStringGrid; columntotal: Integer);
var
TheList : TStringList;
i,l,iCount,m:integer;
const
separator = ',';
const
arrCodes:array[1..10] of string = ('DNF','DNS','WD','WE','DNA','OD','RD','EXR','EXE','PP');
begin
//sorts grid largest to smallest according to one column
//get grid row amount
iCount:=grid.RowCount - 1;
//create and fill the string list
TheList := TStringList.Create;
//fill the list
for i := 1 to (iCount) do
begin
for l := 1 to Length(arrCodes) do
begin
if grid.Rows[i].Strings[columntotal] = arrCodes[l] then
begin
TheList.Add('0'+separator+grid.Rows[i].Text);
end;
end;
TheList.Add(grid.Rows[i].Strings[columntotal]+separator+grid.Rows[i].Text);
end;
//try block to sort and write all strings in the list to the grid correctly
try
TheList.CustomSort(Compare2);
for i:= 1 to (iCount) do
begin
grid.Rows[i].Text := TheList.Strings[(i-1)] ;
end;
//fill the row numbers
for m := 1 to iCount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
finally
TheList.Free;
end;
end;
You can use two different lists to store items, and two different sorting functions (because you want to sort them in different direction; numbers will be ordered as decreasing and strings will be ordered as ascending) to sort lists. Sort the lists separately, and than merge them.
Please consider #David Heffernan's performance warning.
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
slStrings, slNumbers:TStringList;
test:string;
function CompareForNumbers(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
val1, val2:Integer;
begin
val1 := StrToInt(List[Index1]);
val2 := StrToInt(List[Index2]);
if val1 = val2 then
Result := 0
else if val1 < val2 then
Result := 1
else
Result := -1;
end;
function CompareForStrings(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] > List[Index2] then
Result := 1
else
Result := -1;
end;
begin
slStrings := TStringList.Create();
slNumbers := TStringList.Create();
try
slStrings.Add('EXE');
slStrings.Add('WE');
slStrings.Add('DNF');
slNumbers.Add('5');
slNumbers.Add('20');
slNumbers.Add('24');
slNumbers.Add('12');
slNumbers.CustomSort(CompareForNumbers);
slStrings.CustomSort(CompareForStrings);
slNumbers.AddStrings(slStrings);
Writeln(slNumbers.Text);
Readln(test);
finally
slStrings.Free();
slNumbers.Free();
end;
end.
To use single list to handle #David Heffernan's performance warning, i've write this;
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
slStrings:TStringList;
test:string;
function Compare(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
val1, val2:Integer;
val1integer, val2integer:Boolean;
begin
val1integer := TryStrToInt(List[Index1], val1);
val2integer := TryStrToInt(List[Index2], val2);
if val1integer and val2integer then
begin
if val1 = val2 then
Result := 0
else if val1 < val2 then
Result := 1
else
Result := -1;
end
else if (not val1integer) And (not val2integer) then
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] > List[Index2] then
Result := 1
else
Result := -1;
end
else
begin
if val1integer then
Result := -1
else
Result := 1;
end;
end;
begin
slStrings := TStringList.Create();
try
slStrings.Add('EXE');
slStrings.Add('5');
slStrings.Add('WE');
slStrings.Add('20');
slStrings.Add('DNF');
slStrings.Add('24');
slStrings.Add('12');
slStrings.Add('A');
slStrings.Add('6');
slStrings.Add('E');
slStrings.Add('B');
slStrings.Add('4');
slStrings.Add('T');
slStrings.Add('444');
slStrings.CustomSort(Compare);
Writeln(slStrings.Text);
Readln(test);
finally
slStrings.Free();
end;
end.
I believe you want to sort times by shortest to longest first, then all text alphabetically (although that is arguable).
I would not modify the texts in the way that you do. Instead I would simply modify the comparer function and pass the texts 'as is'.
To test it I used a TMemo, but the principle applies to the tables - just copy the appropriate column to the string list.
function Compare2(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
i1IsNumeric, i2IsNumeric : boolean;
i1, i2 : integer;
begin
//comparer for custom sort used in SortLTSGrid
i1IsNumeric := TryStrToInt( List[Index1], i1 );
i2IsNumeric := TryStrToInt( List[Index2], i2 );
if i1IsNumeric and (not i2IsNumeric) then
begin
Result := -1;
end
else if i2IsNumeric and (not i1IsNumeric) then
begin
Result := 1;
end
else if i1IsNumeric then
begin
Result := Sign( i1-i2);
end
else
begin
Result := CompareStr( List[Index1], List[Index2] );
end;
end;
Here is my test routine using a memo
procedure TForm4.Button1Click(Sender: TObject);
var
iList : TStringList;
begin
iList := TStringList.Create;
try
iList.Assign( Memo1.Lines );
iList.CustomSort( Compare2 );
Memo1.Lines.Assign( iList );
finally
iList.Free;
end;
end;
Your routine would be more like (although this I have not tested)
procedure TfrmPuntehou.SortLTSGrid(var grid: TStringGrid; columntotal: Integer);
var
TheList : TStringList;
i,l,iCount,m:integer;
const
separator = ',';
const
arrCodes:array[1..10] of string = ('DNF','DNS','WD','WE','DNA','OD','RD','EXR','EXE','PP');
begin
//sorts grid largest to smallest according to one column
//get grid row amount
iCount:=grid.RowCount - 1;
//create and fill the string list
TheList := TStringList.Create;
//fill the list
for i := 1 to (iCount) do
begin
TheList.Add(grid.Rows[i].Text);
end;
//try block to sort and write all strings in the list to the grid correctly
try
TheList.CustomSort(Compare2);
for i:= 1 to (iCount) do
begin
grid.Rows[i].Text := TheList.Strings[(i-1)] ;
end;
//fill the row numbers
for m := 1 to iCount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
finally
TheList.Free;
end;
end;
So i'm working on this pascal application which has a menu where you can do multiple things.
After entering an album (which is what my program does) and trying to edit it by writing over the current album I get an error as shown in the image.
There have been no errors when compiling except the warning:
(100,9) Warning: Function result variable does not seem to initialized
Here is my code:
program MusicPlayer;
uses TerminalUserInput;
type
// You should have a track record
TrackRec = record
name: String;
location: String;
end;
type TrackArray = array of TrackRec;
GenreType = (Pop, Rap, Rock, Classic);
AlbumRec = Record
name: String;
genre: GenreType;
location: array of TrackRec; // this and track should be track: array of TrackRec
numberOfTracks: Integer;
tracks: TrackArray;
end;
type AlbumArray = array of AlbumRec; // this should be an array of AlbumRec
function ReadGenre(prompt: String): GenreType;
var
option: Integer;
begin
WriteLn('Press 1 for Pop');
WriteLn('Press 2 for Rap');
WriteLn('Press 3 for Rock');
WriteLn('Press 4 for Classic');
option := ReadInteger(prompt);
while (option<1) or (option>3) do
begin
WriteLn('Please enter a number between 1-4');
option := ReadInteger(prompt);
end;
case option of
1: result := Pop;
2: result := Rap;
3: result := Rock;
else
result := Classic;
end;
end;
function CheckLength(prompt: string): Integer;
var
i: Integer;
begin
i := ReadInteger(prompt);
while (i < 0) or (i > 20) do
begin
WriteLn('Please enter a number between 1-20');
i := ReadInteger(prompt);
end;
result := i;
end;
function ReadTracks(count: Integer): TrackArray;
var
i: Integer;
begin
setLength(result, count);
for i := 0 to High(result) do
begin
result[i].name := ReadString('Track Name: ');
result[i].location := ReadString('Track Location: ');
end;
end;
function ReadAlbum(): AlbumRec;
begin
result.name := ReadString('What is the name of the album?');
result.genre := ReadGenre('What is the genre of the album?');
result.numberOfTracks := CheckLength('How many tracks are in the album?');
result.tracks := ReadTracks(result.numberOfTracks);
end;
function ReadAlbums(count: Integer): AlbumArray;
var
i: Integer;
begin
SetLength(result, count);
for i := 0 to High(result) do
begin
result[i] := ReadAlbum();
end;
end;
function ChangeAlbum(count: Integer): AlbumArray;
var
i: Integer;
begin
for i := count to count do
begin
result[i] := ReadAlbum();
end;
end;
procedure PrintAlbum(count: Integer; album: array of AlbumRec);
var
i: Integer;
begin
if count = 1 then
begin
for i := 0 to High(album) do
begin
WriteLn('Album Number: ', i);
WriteLn('Album name is: ', album[i].name);
WriteLn('Album genre is: ', album[i].genre);
end
end;
for i := 1 to count - 1 do
begin
WriteLn('Album name is: ', album[i].name);
WriteLn('Album genre is: ', album[i].genre);
end;
end;
procedure PrintTrack(tracks: TrackArray);
var
i: Integer;
begin
i := ReadInteger('Which track number do you wish to play?');
i := i - 1;
WriteLn('Now playing track: ', tracks[i].name);
WriteLn('Track location: ', tracks[i].location);
end;
function CheckIfFinished(): Boolean;
var answer: String;
begin
WriteLn('Do you want to enter another set of tracks? ');
ReadLn(answer);
LowerCase(answer);
case answer of
'no': result := true;
'n': result := true;
'x': result := true;
else
result := false;
end;
end;
procedure Main();
var
i, count, select, change: Integer;
albums: AlbumArray;
begin
WriteLn('Please select an option: ');
WriteLn('-------------------------');
WriteLn('1. Read Albums');
WriteLn('2. Display Albums');
WriteLn('3. Select an Album');
WriteLn('4. Update an Album');
WriteLn('5. Exit');
WriteLn('-------------------------');
repeat
i := ReadInteger('Your Option:');
case i of
1:
begin
count := ReadInteger('How many albums: ');
albums := ReadAlbums(count);
end;
2:
begin
WriteLn('1. Display All Albums');
WriteLn('2. Display All Albums by Genre');
select := ReadInteger('Your Option: ');
if i = 1 then
begin
PrintAlbum(select, albums);
end;
// if i = 2 then
// WriteLn('1. Pop');
// WriteLn('2. Rap');
// WriteLn('3. Rock');
// WriteLn('4. Classic');
// albums := ReadAlbums(count);
end;
3:
begin
select := ReadInteger('Which album would you like to play? ');
PrintAlbum(select, albums);
PrintTrack(albums[select-1].tracks);
end;
4:
begin
change := ReadInteger('Which album would you like to edit?');
albums := ChangeAlbum(change);
end;
end;
until i = 5;
end;
begin
Main();
end.
The function that the warning refers to, on line 100, is
function ChangeAlbum(count: Integer): AlbumArray;
var
i: Integer;
begin
for i := count to count do
begin
result[i] := ReadAlbum();
end;
end;
The warning says:
Warning: Function result variable does not seem to initialized
And indeed the result variable has not been initialized.
The design of the function is wrong though. You are trying to modify an existing element in an array. You should not be returning a new array. The function is not necessary though. You should simply remove it. Then you need to look at the one place where you call the function.
change := ReadInteger('Which album would you like to edit?');
albums := ChangeAlbum(change);
You should instead code that like this:
change := ReadInteger('Which album would you like to edit?');
albums[change] := ReadAlbum();
I've not checked anything else in your program. I would not be surprised if there are other problems. I've just tried to address the specific question that you asked.
I have e-mail subject lines and I want to find ticket references in them it could be the TT ref is like 12345678. One subject line (string) can have multiple 8 digit numbers!
I have been using the below code but it is merely stripping out the first 8 digits then doing a check if that is 8 char long:
function StripNumbers(const aString: string): string;
var
C: char;
begin
Result := '';
for C in aString do
begin
if CharInSet(C, ['0'..'9']) then
begin
Result := Result + C;
end;
end;
end;
Example:
my string variable is
subject := "yada yada XF12345678 blabla XF87654321 duh XF11.223344"
function GetTTRefs(subject) should result "12345678;87654321;"
Thank you for answers.
function GotTTRefs(Subject:string;Digits:Byte):string;
var
i:integer;
TT:string;
begin
i:=1;
while i <= Length(Subject)-Digits+1 do
begin
if Subject[i] in ['1'..'9'] then
begin
TT:=Copy(Subject,i,Digits);
if (StrToQWordDef(TT, 0) <> 0) then
Result:=Result+TT+';';
end;
inc(i);
end;
end;
I have to write a program in Pascal which checks whether a word is a palindrome.
For example:
if I input "abba" then write 'TRUE'
input 'abb a' then write 'TRUE'
input 'abca' write 'FALSE'
I wrote this:
program palindromek;
var i,j,delka,pul:integer;
str:string;
function palindrom(slovo:string):boolean;
const mezera=32;
begin
delka:=length(str);
if (delka mod 2) = 0 then pul:=delka div 2
else pul:=(delka-1) div 2;
for i:=1 to delka do
begin
if (ord(slovo[i])>=ord('a')) and (ord(slovo[i])<=ord('z')) then
begin
if (delka>=4)and(delka<=100) then
begin
if (length(str) mod 2) = 0 then {slovo se sudym poctem pismen}
begin
for j:=1 to pul do
begin
if slovo[j]=slovo[length(str)-j+1]
then palindrom:=true else palindrom:=false
end
end else
begin
for j:=1 to pul do
begin
if slovo[j]=slovo[length(str)-j+1]
then palindrom:=true else palindrom:=false
end
end
end else if slovo[1]=slovo[delka]
then palindrom:=true else palindrom:=false
end
end;
end;
begin
readln(str);
writeln(palindrom(str));
end.
but it has to ignore spaces. Do you have any idea please?
To remove all spaces, you can use function like this:
procedure RemoveSpacesInplace(var s: string);
var
i, SpaceCount: Integer;
begin
SpaceCount := 0;
for i := 1 to Length(s) do
if s[i] = ' ' then
Inc(SpaceCount)
else
s[i - SpaceCount] := s[i];
SetLength(s, Length(s) - SpaceCount);
end;
You can modify it for other non-letter chars.
Note that your logic for odd and even length is excessive. Try to simplify it.
You can use the functions StringReplace and ReverseString for your task.
program palindromek;
uses SysUtils, StrUtils;
var
str:string;
function palindrom(slovo:string):boolean;
begin
slovo := StringReplace(slovo, ' ', '', [rfReplaceAll]);
Result := slovo = ReverseString(slovo)
end;
begin
readln(str);
writeln(palindrom(str));
readln;
end.
If you are not allowed to use SysUtils and StrUtils then you can manually reverse your string and then compare if the original string and the reversed string are equal.
This would look something like this: (not tested!)
function palindrom(slovo:string):boolean;
var slovofor: string;
slovorev: string;
i: integer;
begin
for i:= length(slovo) downto 1 do begin
if slovo[i] <> ' ' then begin
slovofor := slovofor + slovo[length(slovo)-i+1];
slovorev := slovorev + slovo[i];
end;
end;
writeln(slovofor);
Result := slovofor = slovorev
end;
I am using this function and need reverse one. Its converting HEX (unicode) string to unicode (WideString). I need reverse function to convert it back, i.e. Widestring back to HEX (unicode).
function _ConvertHexToWideString(AHex: AnsiString): WideString;
var wBinaryStream: TMemoryStream;
begin
try
wBinaryStream := TMemoryStream.Create;
try
wBinaryStream.Size := Length(AHex) div 2;
if wBinaryStream.Size > 0 then
HexToBin(PAnsiChar(AHex), wBinaryStream.Memory, wBinaryStream.Size);
except
end;
SetString(Result,
PWideChar(wBinaryStream.Memory),
wBinaryStream.Size div SizeOf(WideChar));
finally
FreeAndNil(wBinaryStream);
end;
end;
You simply do the opposite, using BinToHex() instead, eg:
function _ConvertWideStringToHex(AStr: WideString): AnsiString;
var
wBinaryStream: TMemoryStream;
iBufSize: Integer;
begin
try
wBinaryStream := TMemoryStream.Create;
try
iBufSize := Length(AStr) * SizeOf(WideChar);
wBinaryStream.Size := iBufSize * 2;
if iBufSize > 0 then
BinToHex(PAnsiChar(Pointer(AStr)), PAnsiChar(wBinaryStream.Memory), iBufSize);
except
end;
SetString(Result,
PAnsiChar(wBinaryStream.Memory),
wBinaryStream.Size div SizeOf(AnsiChar));
finally
FreeAndNil(wBinaryStream);
end;
end;
Which can be simplified to this:
function _ConvertWideStringToHex(AStr: WideString): AnsiString;
var
iBufSize: Integer;
begin
iBufSize := Length(AStr) * SizeOf(WideChar);
if iBufSize > 0 then begin
SetLength(Result, iBufSize * 2);
BinToHex(PAnsiChar(Pointer(AStr)), PAnsiChar(Result), iBufSize);
end else
Result := '';
end;