各种Delphi搜索文件的代码

分类：File 阅读 (1,878) Add comments

3月 122013

转载请注明原文地址：http://bcoder.com/delphi/delphi-file/various-delphi-code-to-search-files

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  function FindFlatFileInParentDir(curPath, sFile: string): string;
  function FindFlatFile(curPath, sFile: string): string;

implementation

{$R *.dfm}

function FindFlatFileInParentDir(curPath, sFile: string): string;
var
  pntPath: string;
  FilePath: string;
  I: Integer;
begin
  pntPath := curPath;

  While true do begin
    FilePath := FindFlatFile(pntPath, sFile);
    if FilePath <> '' then begin
      Result := FilePath;
      Break;
    end else begin
      if Length(pntPath) <= 3 then Break;

      if RightStr(pntPath, 1) = '' then
        Delete(pntPath, length(pntPath), 1);

      for I := Length(pntPath) downto 1 do begin
        if pntPath[I] = '' then begin
          Delete(pntPath, I, Length(pntPath));
          Break;
        end;
      end;
    end;
  end;
end;

function FindFlatFile(curPath, sFile: string): string;
var
  sRec: TSearchRec;
  sRetCode: Integer;
  sPath: string;
begin
  FillChar(sRec, SizeOf(sRec), #0);
  sPath := curPath;
  if RightStr(sPath, 1) <> '' then
    sPath := sPath + '';
  sRetCode := FindFirst(sPath + '*.*', faAnyFile, sRec);
  While sRetCode = 0 do begin
    if (sRec.Attr and not faDirectory = 0) and (sRec.Name <> '.') and (sRec.Name <> '..') then
      Result := FindFlatFile(sPath + sRec.Name, sFile)
    else begin
      if AnsiEndsText(sRec.Name, sFile) then begin
        Result := sPath + sRec.Name ;
        Break;
      end else begin

      end;
    end;

    sRetCode := FindNext(sRec);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := FindFlatFileInParentDir(Edit1.Text, Edit2.Text);
end;

end.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, StrUtils;

type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

function FindFlatFileInParentDir(curPath, sFile: string): string;

function FindFlatFile(curPath, sFile: string): string;

implementation

{$R *.dfm}

function FindFlatFileInParentDir(curPath, sFile: string): string;

var

pntPath: string;

FilePath: string;

I: Integer;

begin

pntPath := curPath;

While true do begin

FilePath := FindFlatFile(pntPath, sFile);

if FilePath <> '' then begin

Result := FilePath;

Break;

end else begin

if Length(pntPath) <= 3 then Break;

if RightStr(pntPath, 1) = '' then

Delete(pntPath, length(pntPath), 1);

for I := Length(pntPath) downto 1 do begin

if pntPath[I] = '' then begin

Delete(pntPath, I, Length(pntPath));

Break;

end;

function FindFlatFile(curPath, sFile: string): string;

var

sRec: TSearchRec;

sRetCode: Integer;

sPath: string;

begin

FillChar(sRec, SizeOf(sRec), #0);

sPath := curPath;

if RightStr(sPath, 1) <> '' then

sPath := sPath + '';

sRetCode := FindFirst(sPath + '*.*', faAnyFile, sRec);

While sRetCode = 0 do begin

if (sRec.Attr and not faDirectory = 0) and (sRec.Name <> '.') and (sRec.Name <> '..') then

Result := FindFlatFile(sPath + sRec.Name, sFile)

else begin

if AnsiEndsText(sRec.Name, sFile) then begin

Result := sPath + sRec.Name ;

Break;

end else begin

end;

sRetCode := FindNext(sRec);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Caption := FindFlatFileInParentDir(Edit1.Text, Edit2.Text);

end;

end.

打赏

Leave a Reply Cancel reply