I don't know Delphi and would someone help me to change a small Delhpi script from vmprotect?
function GetRandomSectionName: String;
var I:Integer;
B:Byte;
begin
Result:='';
for I:=1 to 8 do
begin
B:=32+Random(Ord('z')-32);
Result:=Result+Chr(B);
end;
end;
procedure OnAfterSaveFile;
var I:Integer;
begin
with VMProtector.OutputFile do
for I:=0 to Sections.Count-1 do
Sections.Items[I].Name:=GetRandomSectionName;
end;
It should only randomize the sections which is starting with .vmp the rest should stay.
It should only randomize the sections which is starting with .vmp the rest should stay.
Use the System.Pos function to match a substring in a string.
procedure OnAfterSaveFile;
var I:Integer;
begin
with VMProtector.OutputFile do
for I:=0 to Sections.Count-1 do
if Pos('.vmp',Sections.Items[I].Name) = 1 then // Only .vmp sections
Sections.Items[I].Name:=GetRandomSectionName;
end;
Related
I'd like to draw marks in Chart.ChartAfterDraw using Aseries.Marks.DrawItem method. I'm using the following code.
procedure TMyForm.ChartAfterDraw(Sender: TObject);
var
mark : TTextShape;
begin
mark := TTextShape.Create(Chart);
mark.Font := ClickedSeries.Marks.Font;
ClickedSeries.Marks.DrawItem(mark,
clRed,
'pippo',
ClickedSeries.Marks.Positions[ ClickedTask ] );
end;
But as you can see in figure below mark is created fine, in correct position, but its text is not printed.
In debug mod when cursor go past the end of TMyForm.ChartAfterDraw the following message appear.
This sounds like an error occured in Marks.DrawItem method. Unfortunately i'm using TeeChart Lite, so i cant't see where that method fails (if it really fails)
Can you help me? Thank you.
P.s. I'm using XE5
It may be easier to directly draw your texts/marks using Chart1.Canvas.Rectangle() and Chart1.Canvas.TextOut() functions, but here you have an example using Marks.DrawItem() function. Note you had to create and initialize a TSeriesMarkPosition to pass it to the Marks.DrawItem().
uses Series;
type
TShapeAccess=class(TCustomTextShape);
var ClickedSeries: TChartSeries;
ClickedTask: Integer;
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
Chart1.View3D:=false;
for i:=0 to 3 do
with Chart1.AddSeries(TPointSeries) do
FillSampleValues;
end;
procedure TForm1.Chart1Click(Sender: TObject);
var i: Integer;
begin
for i:=0 to Chart1.SeriesCount-1 do
begin
ClickedTask:=Chart1[i].Clicked(Chart1.GetCursorPos.X, Chart1.GetCursorPos.Y);
if ClickedTask>-1 then
begin
ClickedSeries:=Chart1[i];
Break;
end;
end;
Chart1.Draw;
end;
procedure TForm1.Chart1AfterDraw(Sender: TObject);
var
mark : TTextShape;
position: TSeriesMarkPosition;
tmpString: String;
begin
if (ClickedSeries<>nil) and (ClickedTask>-1) and (ClickedTask<ClickedSeries.Count-1) then
begin
tmpString:='pippo';
mark := TTextShape.Create(Chart1);
mark.Text:=tmpString;
mark.Font := ClickedSeries.Marks.Font;
TShapeAccess(mark).CalcBounds(Chart1);
position:=TSeriesMarkPosition.Create;
position.LeftTop.X:=ClickedSeries.CalcXPos(ClickedTask);
position.LeftTop.Y:=ClickedSeries.CalcYPos(ClickedTask);
position.Width:=Chart1.Canvas.TextWidth(tmpString)+2;
position.Height:=Chart1.Canvas.TextHeight(tmpString)+4;
ClickedSeries.Marks.DrawItem(mark, clRed, tmpString, position);
end;
end;
I have an INI file that stores some integers for settings. The section names are stored like this:
[ColorScheme_2]
name=Dark Purple Gradient
BackgroundColor=224
BackgroundBottom=2
BackgroundTop=25
...
[ColorScheme_3]
name=Retro
BackgroundColor=5
BackgroundBottom=21
BackgroundTop=8
...
I need to figure out a way to create new sections, that increment the color scheme number +1 from the highest section number. I have a comboBox that lists out the current colorscheme names, so when a user saves to the INI file, the existing scheme is just overwritten. How can I check the ComboBox text to see if it is an existing section and if not, create a new one with an incremented name? (i.e. from the example code above, ColorScheme_2 and ColorScheme_3 already exist, so the next section to create would be ColorScheme_4).
You can read all sections by using ReadSections method, then iterate returned string list and parse each item in it to store the highest found index value:
uses
IniFiles;
function GetMaxSectionIndex(const AFileName: string): Integer;
var
S: string;
I: Integer;
Index: Integer;
IniFile: TIniFile;
Sections: TStringList;
const
ColorScheme = 'ColorScheme_';
begin
Result := 0;
IniFile := TIniFile.Create(AFileName);
try
Sections := TStringList.Create;
try
IniFile.ReadSections(Sections);
for I := 0 to Sections.Count - 1 do
begin
S := Sections[I];
if Pos(ColorScheme, S) = 1 then
begin
Delete(S, 1, Length(ColorScheme));
if TryStrToInt(S, Index) then
if Index > Result then
Result := Index;
end;
end;
finally
Sections.Free;
end;
finally
IniFile.Free;
end;
end;
And the usage:
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(GetMaxSectionIndex('d:\Config.ini')));
end;
How can I check the ComboBox text to see if it is an existing section and if not, create a new one with an incremented name?
Like this:
const
cPrefix = 'ColorScheme_';
var
Ini: TIniFile;
Sections: TStringList;
SectionName: String;
I, Number, MaxNumber: Integer;
begin
Ini := TIniFile.Create('myfile.ini')
try
SectionName := ComboBox1.Text;
Sections := TStringList.Create;
try
Ini.ReadSections(Sections);
Sections.CaseSensitive := False;
if Sections.IndexOf(SectionName) = -1 then
begin
MaxNumber := 0;
for I := 0 to Sections.Count-1 do
begin
if StartsText(cPrefix, Sections[I]) then
begin
if TryStrToInt(Copy(Sections[I], Length(cPrefix)+1, MaxInt), Number) then
begin
if Number > MaxNumber then
MaxNumber := Number;
end;
end;
end;
SectionName := Format('%s%d', [cPrefix, MaxNumber+1]);
end;
finally
Sections.Free;
end;
// use SectionName as needed...
finally
Ini.Free;
end;
end;
How can I properly free the component once i make it with a loop like this? If I free it like I do now I get some GETMEM.INC exception. I am coming from Indy so i don't really know ICS too much.
Thanks
const
URLs : array[0..3] of string =
(
'http://www.example.com',
'http://www.example.com',
'http://www.example.com',
'http://www.example.com'
) ;
var
Output: array of TStringList;
S: array of TMemoryStream;
Async: array of TSslHttpCli;
implementation
procedure RequestDone(Sender: TObject; RqType: THttpRequest;
ErrCode: Word);
begin
with Sender as TSSLHTTPCLI do begin
S[Tag].Position:=0;
Output[Tag].LoadFromStream(S[Tag]);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
for i := 0 to High(URLS) do begin
S[i]:=TMemoryStream.Create;
Output[i]:=TStringList.Create;
Async[i]:=TSslHttpCli.Create(nil);
Async[i].Tag:=i;
Async[i].FollowRelocation:=true;
Async[i].NoCache:=true;
Async[i].SocketFamily:=sfAny;
Async[i].OnRequestDone:=RequestDone;
Async[i].RcvdStream:=S[i];
Async[i].URL:= URLs[i];
Async[i].MultiThreaded:=true;
Async[i].GetASync;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
i:integer;
begin
for i := 0 to High(URLS) do begin
Output[i].Free;
Async[i].RcvdStream.Free;
Async[i].Free; // << -- EXCEPTION
// S[i].Free;
end;
end;
You never allocate any memory for Result, Asynch, or S. You need to SetLength on each of them before you can put anything into them (or take anything back out).
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
SetLength(Result, Length(URLS));
SetLength(S, Length(URLS));
SetLength(Asynch, Length(URLS));
for i := 0 to High(URLS) do begin
S[i]:=TMemoryStream.Create;
Result[i]:=TStringList.Create;
Async[i]:=TSslHttpCli.Create(nil);
// etc.
end;
end;
BTW, Result is a terrible name for a variable, especially one that's global in scope. It's the return value from a function that's automatically generated by the compiler, and use anywhere but in a function makes your code hard to read. See this, for instance:
var
Result: string = '';
procedure AddToReslt(CharToAdd: Char);
begin
// Many many lines of code
// go in here. Maybe a few loops
// of if statements.
Result := Result + CharToAdd;
end;
function DoSomeMath: Integer;
begin
// Some really complex numeric code, maybe
// calculating the value of `pi` to the 900th
// digit
Result := 2 * 2;
end;
Now quickly - remembering that each of them containss lots of code - which one is a function and which is a procedure?
Ok guys, I've been trying to find out every possible mistake i'm making but I give up... I need help! What I'm writing is an app to manage rentals for my job and when the date is past, my app removes the name from 2 text files. I wrote 3 little functions(procedures) to make this work. Here:
This one loads from dates.dat file and remove the line containing the name of the employee.
procedure remDate(emp: String);/// Removes employee from date file
var
pos1, i: integer;
dateList: TStringList;
begin
dateList:=TStringList.Create;
dateList.LoadFromFile('Data\dates.dat');
for i:=0 to dateList.Count-1 do begin
pos1:=AnsiPos(emp, dateList[i]);
if pos1<>0 then begin
dateList.Delete(i);
dateList.SaveToFile('Data\dates.dat');
end;
end;
dateList.Free;
end; //eo remDate
This one removes the line containing the employee name from the perm.dat file.
procedure remPerm(emp: String);/// Removes employee from perm file
var
pos1, i: integer;
permList: TStringList;
begin
permList:=TStringList.Create;
permList.LoadFromFile('Data\perm.dat');
for i:=0 to permList.Count-1 do begin
pos1:=AnsiPos(emp, permList[i]);
if pos1<>0 then begin
permList.Delete(i);
permList.SaveToFile('Data\perm.dat');
end;
end;
permList.Free;
end; //eo remPerm
This one sticks those together. The isDue is a simple function that compares 2 dates and returns a TRUE if date is today or is past.
procedure updatePerms;
var
empList: TStringList;
i: integer;
begin
empList:=TStringList.Create;
empList.LoadFromFile('Data\employes.dat');
for i:=0 to empList.Count-1 do begin
if isDue(empList[i]) then begin
remDate(empList[i]);
remPerm(empList[i]); (*) Here is where the error points.
end;
end;
empList.Free;
end;
The error I get is when it gets to remPerm in the updatePerms procedure.(*)
I get a EStringList Error, out of bound (#). Figured out with many tries that it only happens when an employee's due date is today. Please comment if you need more info!
Thanks in advance, any help is really appreciated!
The problem is that you are using a for loop. The end point of a for loop is only evaluated once when the loop is entered. At that point you may have 100 items, but once you start deleting there will be less. This will then result in a list index out of bounds error.
The simple fix is to reverse the for loop:
procedure remDate(emp: String);
/// Removes employee from date file
var
pos1, i: integer;
dateList: TStringList;
begin
dateList := TStringList.Create;
dateList.LoadFromFile('Data\dates.dat');
for i := dateList.Count - 1 downto 0 do
begin
pos1 := AnsiPos(emp, dateList[i]);
if pos1 <> 0 then
begin
dateList.Delete(i);
dateList.SaveToFile('Data\dates.dat');
end;
end;
dateList.Free;
end; // eo remDate
This will work if the employee occurs more than once.
However if the employee does only occur once, you can use break to exit from the loop early:
procedure remDate(emp: String);
/// Removes employee from date file
var
pos1, i: integer;
dateList: TStringList;
begin
dateList := TStringList.Create;
dateList.LoadFromFile('Data\dates.dat');
for i := 0 to dateList.Count - 1 do
begin
pos1 := AnsiPos(emp, dateList[i]);
if pos1 <> 0 then
begin
dateList.Delete(i);
dateList.SaveToFile('Data\dates.dat');
Break; // <-- early exit
end;
end;
dateList.Free;
end; // eo remDate
Another solution is to use a while loop.
i would like to make a list of names and then make a random selection but all of them should be called. off course not repeated. delphi code
My suggestion is to make a list of names and then shuffle the name then call it one by one.
i hope this code will work for you.
...
private
{ Private declarations }
FNameList : TStringList;
FNameIndex: Integer;
public
{ Public declarations }
end;
...
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
Randomize;
FNameIndex := 0;
FNameList := Tstringlist.Create;
// FNameList.LoadFromFile('NameList.txt'); or
FNameList.Add('Name 1');
FNameList.Add('Name 2');
FNameList.Add('Name 3');
FNameList.Add('Name 4');
FNameList.Add('Name 5');
FNameList.Add('Name 6');
for i:= 1 to 100 do // shuffle 100 times. its up to you
FNameList.Exchange(Random(FNameList.Count-1), Random(FNameList.Count-1));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FNameList.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FNameIndex < FNameList.Count then
begin
showmessage(FNameList.Strings[FNameIndex]);
inc(FNameIndex);
end else showmessage('Done!');
end;
Well I can not deliver you delphi code but I have quite the same problem here. I am using a list of Names (with addresses) from this website http://de.fakenamegenerator.com.
Maybe it's a little help.
I'm not into delphi, but the algorithm is quite straightforwarded. Just insert names into a List with a random generated index. This way you have a randomly sorted List of names. Then just iterate over it.
Make a copy of the names into List and execute the following:
// assuming list is a stringlist containing the names
while List.Count > 0 do begin
idx := Random(List.Count);
// do something with List[idx]
List.Delete(idx);
end;