Hi, attached Delphi unit containes TFindFile and a register procedure.
I can add findfile1 to the uses clause of a project and then i can TFileFind.Create ...use it ... no probs.
But if i put findfile1.pas to a new or existing package i can compile the package but i cannot install it to lazarus IDE.
Error -> findfile1.pas not found, what ever i do with the package settings! Any idea what i'm missing?
unit findfile1; // 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 Classes, SysUtils, {$IFDEF MSWINDOWS} Dialogs; {$ENDIF} {$IFDEF LINUX} Dialogs; {$ENDIF} 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 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:=FindFirst(Directory + JFilter,Attribs,srchRec); 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:=FindNext(srchRec); 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; FindClose(srchRec); 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:=FindFirst(Directory+'*',faAnyFile,srchRec); //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:=FindNext(srchRec); end; FindClose(srchRec); end; procedure Register; begin RegisterComponents('SelfMade', [TFindFile]); end; end.
-- _______________________________________________ Lazarus mailing list [email protected] http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
