Hej Henning,
jeg lavede dette komponent til D3, og det virker fint med D6,
Dette komponent kan finde filerne til dig. Bare søg på stien og *.exe
unit FindFile;
interface
{
Findfile 1.00
This source code is copyright Primeware 1997.
}
uses
Forms, Windows, SysUtils, Classes;
type
TFindFile = class(TComponent)
private
{ Private declarations }
FPath : String;
FFile : String;
protected
{ Protected declarations }
public
Procedure Execute(Var Filelist : TStringList; FindList : TStringList;
Var Started : Boolean);
Procedure Abort(Var Filelist : TStringList; FindList : TStringList);
published
Property RunPath : String Read FPath Write FPath;
Property FileName : String Read FFile Write FFile;
end;
procedure Register;
implementation
Var FAbort : Boolean;
Procedure Search(Path : String; Var Dir : String; FindFileName: String;
Var Filelist : TStringList; FindList : TStringList);
Var
Loop : Integer;
Sr : Tsearchrec;
Label TheEnd;
Begin
For Loop:=0 To FindList.Count-1 Do
If FindFirst(Path+Dir+'\'+FindList[Loop],FaArchive,Sr)=0 Then
Repeat
FileList.Add(Path+Dir+'\'+Sr.Name);
Application.Processmessages;
Until (FindNext(Sr)<>0) or (FAbort);
If FindFirst(Path+Dir+'\*.*',FaAnyFile+FaHidden+FaSysFile+FaArchive+
FaDirectory,Sr)=0 Then
Repeat
Application.Processmessages;
If (Sr.Attr And FaDirectory<>0) And (Sr.Name<>'..')
And (Sr.Name<>'.') Then
Begin
If FAbort Then
Begin
Path:='Z:\';
Dir:='';
FillChar(Sr,SizeOf(Sr),#0);
End
Else
Begin
If Dir<>'' Then
Dir:='\'+Dir+'\'+Sr.Name
Else
Dir:='\'+Dir+Sr.Name;
If Dir[2]='\' Then Delete(Dir,1,1);
End;
Search(Path,Dir,FindFileName, Filelist, FindList);
If Pos('\',Dir)>0 Then
Begin
While Dir[Length(Dir)]<>'\' Do
Delete(Dir,Length(Dir),1);
Delete(Dir,Length(Dir),1);
End
Else
Dir:='';
End;
Until (FindNext(Sr)<>0) or (FAbort);
End;
Procedure TFindFile.Abort(Var Filelist : TStringList; FindList :
TStringList);
Var
Tmp1 : String;
Begin
Tmp1:='C';
FAbort:=True;
Search('',Tmp1,'',FileList, FindList);
End;
Procedure TFindFile.Execute(Var Filelist : TStringList; FindList :
TStringList;
Var Started : Boolean);
Var
Tmp, Tmp1 : String;
Begin
If Started=False Then
Begin
FAbort:=False;
Started:=True;
End;
Tmp1:='';
Tmp:=FPath;
If Tmp[Length(Tmp)]='\' Then Delete(Tmp,Length(Tmp),1);
If FAbort=False Then
Search(Tmp,Tmp1,FileName, Filelist, FindList);
End;
procedure Register;
begin
RegisterComponents('Primeware', [TFindFile]);
end;
end.
Dette her kan du bruge til at starte programmet:
Procedure ExeDK(Filename, Param, Path, Progname : String);
Var
Pc1 : Pchar;
TmpB : integer;
Begin
TmpB:=Shellexecute(0,nil,Pchar(Filename),Pchar(Param),PChar(Path),Sw_Show);
If TmpB=SE_ERR_NOASSOC Then
Begin
Getmem(Pc,256);
GetMem(Pc1,256);
GetWindowsDirectory(Pc,Max_Path);
GetSystemDirectory(pc1,Max_path);
ExeDK(Pc+'\rundll32.exe',Pc1+'\shell32.dll,OpenAs_RunDLL
'+Filename,'',Progname);
FreeMem(Pc,256);
Freemem(Pc1,256);
End;
Case TmpB of
0:
MessageBox(0,'Ikke nok hukommelse',PChar(Progname),
Mb_Taskmodal+MB_ICONSTOP+Mb_Ok);
ERROR_FILE_NOT_FOUND:
MessageBox(0,'Filen blev ikke fundet',PChar(Progname),
Mb_Taskmodal+MB_ICONSTOP+Mb_Ok);
ERROR_PATH_NOT_FOUND:
MessageBox(0,'Stien blev ikke fundet',PChar(Progname),
Mb_Taskmodal+MB_ICONSTOP+Mb_Ok);
ERROR_BAD_FORMAT:
MessageBox(0,'Fejl i filen',PChar(Progname),
Mb_Taskmodal+MB_ICONSTOP+Mb_Ok);
SE_ERR_ACCESSDENIED:
MessageBox(0,'Adgang til filen nægtet af operativsystemet',
Pchar(Progname),Mb_Taskmodal+MB_ICONSTOP+Mb_Ok);
SE_ERR_ASSOCINCOMPLETE:
MessageBox(0,'Associaseringen af filen er forkert!',
Pchar(Progname),Mb_Taskmodal+MB_ICONSTOP+Mb_Ok);
SE_ERR_DLLNOTFOUND:
MessageBox(0,'DLL filen blev ikke fundet',PChar(Progname),
Mb_Taskmodal+MB_ICONSTOP+Mb_Ok);
SE_ERR_OOM:
MessageBox(0,'Ikke hukommelse til at færdiggøre operationen',
Pchar(Progname), Mb_Taskmodal+MB_ICONSTOP+Mb_Ok);
SE_ERR_SHARE:
MessageBox(0,'Delingsfejl',PChar(Progname),
Mb_Taskmodal+MB_ICONSTOP+Mb_Ok); End;
End;
"Henning Madsen" <henning.k.madsen@teliamail.dk> wrote in message
news:3d26ee11$0$400$d40e179e@nntp01.dk.telia.net...
> Jeg har en sti der ser således ud D:\Egne Programmer\Komponenter\Eksempler
>
> I mappen Eksempler er der flere undermapper som hver især indeholder et
> komplet Delphi program inklusive EXE filen.
> Er det mugligt at skrive navnene på disse undermapper ud i en ListBox og
ved
> klik på en af disse at køre EXE programmet ??
> Det med at starte programmet fra ListBox tror jeg selv jeg kan klare ?
> Men hjælp til det andet vel være kærkommen.
>
> På forhånd tak
>
> --
> ----
> Med venlig hilsen
> Henning Madsen
>
>
>
|