Am 14.07.2011 20:39, schrieb Mattias Gaertner:
On Thu, 14 Jul 2011 19:53:24 +0200 John Landmesser<[email protected]> wrote:Hi Mattias, all troubles are gone since i realized after ages that i have a corrupted component icon.lrs. Some experiences i made: Lazarus IDE is frozen for this compiler directive: {$I findfile1_icon.lrs} in the actual opened unit and lazarus tells in a message box if i compile the package "findfile1_icon.lrs doesn't look like a ascii(!!!) file" "Yes, lazarus i now know its not looking like a ascii file, its a corrupted lazarus resource containing a bitmap. " Why does the IDE freezes in this situation?Can you send me this file?
See attachment ...I used the new compiled lazres.exe from lazarus to produce this resource file and tfindfile.png ( = convertet bitmap using irfanview.exe )
But i used lazres.exe today again and the result is ok, so just look for the freezing IDE , i suggest.
By the way /lazarus/examples/lazresexplorer/ -> error if you try to open a perfect *.lrs
Access violation. Press OK to ignore and risk data corruption. Press Cancel to kill the program.
Should this app be able to show the image in *.lrs ?
<<attachment: Tfindfile.png>>
findfile1.lrs
Description: Binary data
unit findfile1;
{$mode objfpc}{$H+}
// FindFile version 1.0.1
//
// Copyright (C) September 1997 Walter Dorawa
//
// Everyone is free to use this code as they wish, but
// if you use it commercially then I wouldn't mind a
// little something.
//
// Please submit suggestions, bugs, or any improvements to
// [email protected]
//
// Improvements: 10-21-97
// Attributes property TotalFile
// Abort property TotalSpace
// OnNewPath event TotalDir
//
// thanks to: Howard Harvey, Jim Keatley and Dale Derix
// for suggestions and code improvements
//
interface
uses
// error: FileNotFound 'LResources' -> findfile1 aus Package, Settings, Path usw löchen !!
Classes, SysUtils, LResources, FileUtil (* , Forms, Controls, Graphics, Dialogs *);
//Classes, SysUtils;
type
TAttrOption = (ffReadOnly, ffHidden, ffSystem, ffVolumeID, ffDirectory, ffArchive);
TAttrOptions = set of TAttrOption;
TNewPathEvent = procedure(Sender: TObject; NewPath: string; var Abort: boolean) of object;
TFindFile = class(TComponent)
private
{ Private declarations }
FAbort:boolean;
FTotalSpace:longint;
FTotalDir:longint;
FTotalFile:longint;
FAttribs:TAttrOptions;
FDirectory:string;
FRecurse:boolean;
FFilter :string;
FFiles: TStrings;
FBeforeExecute: TNotifyEvent;
FAfterExecute: TNotifyEvent;
FOnNewPath: TNewPathEvent;
procedure SearchCurrentDirectory(Directory:string);
procedure SearchRecursive(Directory:string);
function FindSubDirectory(strDirs:TStringList; Directory:string):Boolean;
{* 3 Fuktionen aus Rx StrUtils.pas *}
function DelBSpace(const S: string): string;
function Copy2Symb(const S: string; Symb: Char): string;
function Copy2SymbDel(var S: string; Symb: Char): string;
protected
{ Protected declarations }
procedure SetFiles(Value: TStrings);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Execute; dynamic;
property TotalSpace: longint read FTotalSpace write FTotalSpace;
property TotalDir: longint read FTotalDir write FTotalDir;
property TotalFile: longint read FTotalFile write FTotalFile;
property Abort: boolean read FAbort write FAbort default False;
published
{ Published declarations }
property Recurse: boolean read FRecurse write FRecurse default False;
property Directory: string read FDirectory write FDirectory;
property Filter: string read FFilter write FFilter;
property Files: TStrings read FFiles write SetFiles;
property Attributes: TAttrOptions read FAttribs write FAttribs
default [ffReadOnly, ffHidden, ffSystem, ffArchive];
property BeforeExecute: TNotifyEvent read FBeforeExecute write FBeforeExecute;
property AfterExecute: TNotifyEvent read FAfterExecute write FAfterExecute;
property OnNewPath: TNewPathEvent read FOnNewPath write FOnNewPath;
end;
procedure Register;
//===================================================================================
//===================================================================================
implementation
procedure Register;
begin
{$I findfile1.lrs}
RegisterComponents('Misc', [TFindFile]);
end;
const
{$IFDEF MSWINDOWS}
DefaultFilter = '*.*';
{$ENDIF}
{$IFDEF LINUX}
DefaultFilter = '*';
{$ENDIF}
var
Attribs:integer;
constructor TFindFile.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFilter:=DefaultFilter;
FAttribs:=[ffReadOnly, ffHidden, ffSystem, ffArchive];
FFiles:=TStringList.Create;
end;
destructor TFindFile.Destroy;
begin
FFiles.Free;
inherited Destroy;
end;
procedure TFindFile.SetFiles(Value: TStrings);
begin
FFiles.Assign(Value);
end;
procedure TFindFile.Execute;
begin
Attribs:=0;
{$IFDEF MSWINDOWS}
if ffReadOnly in Attributes then Attribs:=Attribs+faReadOnly;
if ffHidden in Attributes then Attribs:=Attribs+faHidden;
if ffSystem in Attributes then Attribs:=Attribs+faSysFile;
if ffVolumeID in Attributes then Attribs:=Attribs+faVolumeID;
if ffDirectory in Attributes then Attribs:=Attribs+faDirectory;
if ffArchive in Attributes then Attribs:=Attribs+faArchive;
{$ENDIF}
{$IFDEF LINUX}
//if ffReadOnly in Attributes then Attribs:=Attribs+faReadOnly;
//if ffHidden in Attributes then Attribs:=Attribs+faHidden;
//if ffSystem in Attributes then Attribs:=Attribs+faSysFile;
//if ffVolumeID in Attributes then Attribs:=Attribs+faVolumeID;
if ffDirectory in Attributes then Attribs:=Attribs+faDirectory;
//if ffArchive in Attributes then Attribs:=Attribs+faArchive;
{$ENDIF}
FFiles.Clear;
FTotalSpace:=0;
FTotalDir:=0;
FTotalFile:=0;
if Assigned(FBeforeExecute) then FBeforeExecute(Self);
if Length(FDirectory)<>0 then
if FRecurse then SearchRecursive(FDirectory)
else SearchCurrentDirectory(FDirectory);
if Assigned(FAfterExecute) then FAfterExecute(Self);
end;
{* Die nächsten 3 Funktionen = Kopien aus Rx StrUtils *}
function TFindFile.DelBSpace(const S: string): string;
var
I, L: Integer;
begin
L := Length(S);
I := 1;
while (I <= L) and (S[I] = ' ') do Inc(I);
Result := Copy(S, I, MaxInt);
end;
function TFindFile.Copy2Symb(const S: string; Symb: Char): string;
var
P: Integer;
begin
P := Pos(Symb, S);
if P = 0 then P := Length(S) + 1;
Result := Copy(S, 1, P - 1);
end;
function TFindFile.Copy2SymbDel(var S: string; Symb: Char): string;
begin
Result := Copy2Symb(S, Symb);
S := DelBSpace(Copy(S, Length(Result) + 1, Length(S)));
end;
procedure TFindFile.SearchCurrentDirectory(Directory:string);
var
i:integer;
srchRec:TSearchRec;
JFilter,JFilterList : string;
Jdel : Char;
begin
if Directory[Length(Directory)]<>PathDelim then Directory := Directory +PathDelim;
if Assigned(FOnNewPath) then FOnNewPath(Self,Directory,FAbort);
if FAbort then Exit;
{* von mir ergänzt: Filterliste duch ';' getrennt bearbeiten
Z.B.: '*.pas;*.dfm' *}
JDel := ';';
JFilterList := FFilter;
if JFilterList[Length(JFilterList)]<>JDel then JFilterList := JFilterList+JDel;
JFilter := Copy2SymbDel(JFilterList, JDel);
while JFilter <> '' do
begin
i:=FindFirstUTF8(Directory + JFilter,Attribs,srchRec); { *Converted from FindFirst* }
while i=0 do
begin
if (srchRec.Name<>'.') and (srchRec.Name<>'..') then
begin
FFiles.Add(Directory+srchRec.Name);
case srchRec.Attr of
faDirectory: Inc(FTotalDir);
else Inc(FTotalFile);
end;
FTotalSpace:=FTotalSpace+srchRec.Size;
end;
i:=FindNextUTF8(srchRec); { *Converted from FindNext* }
end;
{* FEHLER in Copy2SymbDel?!. Die Funktion lässt das Trennzeichen zu Beginn
der JFilterList stehen, also z.B.: ';*.pas;*.dfm' statt : '*.pas;*.dfm'
Deshalb meine Korrektur: *}
JFilterList := copy(JFilterList,2,MaxInt);
JFilter := Copy2SymbDel(JFilterList, JDel);
end;
FindCloseUTF8(srchRec); { *Converted from FindClose* }
end;
procedure TFindFile.SearchRecursive(Directory:string);
var
strDirs:TStringList;
begin
strDirs:=TStringList.Create;
try
if Directory[Length(Directory)]<>PathDelim then Directory := Directory +PathDelim;
strDirs.Clear;
strDirs.Add(Directory);
while strDirs.Count<>0 do
begin
FindSubDirectory(strDirs,strDirs.Strings[0]);
SearchCurrentDirectory(strDirs.Strings[0]);
strDirs.Delete(0);
if FAbort then Exit;
end;
finally
strDirs.Free;
end;
end;
function TFindFile.FindSubDirectory(strDirs:TStringList; Directory:string):Boolean;
var
i:integer;
srchRec:TSearchRec;
begin
Result:=True;
if Directory[Length(Directory)]<>PathDelim then Directory :=Directory +PathDelim;
i:=FindFirstUTF8(Directory+'*',faAnyFile,srchRec); { *Converted from FindFirst* }
//i:=FindFirst(Directory+'.',faAnyFile,srchRec);
while i=0 do
begin
if ((srchRec.Attr
and faDirectory)>0)
and (srchRec.Name<>'.')
and (srchRec.Name<>'..') then
begin
strDirs.Add(Directory+srchRec.Name);
end;
i:=FindNextUTF8(srchRec); { *Converted from FindNext* }
end;
FindCloseUTF8(srchRec); { *Converted from FindClose* }
end;
initialization
//{$I findfile1_icon.lrs}
end.
-- _______________________________________________ Lazarus mailing list [email protected] http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
