看高手怎么优化这个程序,使运行速度提高

bgft2008 2008-11-07 09:38:01
Unit_SearchDir.pas 部分

unit Unit_SearchDir;

interface

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

procedure FindFile(DirName:string;var FileList:TStrings; IncSubDir:boolean=True);
procedure delay(msec:integer);

type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
ListBox1: TListBox;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure delay(msec:integer);
var
FirstTickCount : real;
begin
FirstTickCount := GetTickCount();
FirstTickCount := FirstTickCount + msec;
While FirstTickCount > GetTickCount() do
Application.HandleMessage;
end;

procedure FindFile(DirName:string;var FileList:TStrings; IncSubDir:boolean=True);
var
DS:TSearchRec;
i,p,j:integer;
Path:string;
DirList:TStrings;
F: TFileStream;
buff: array[0..100] of char;
NotNul: boolean;
begin
i := 0;
DirName := ExcludeTrailingPathDelimiter(DirName);
DirList := TStringList.Create;
DirList.Add(DirName);
while i < DirList.Count do
begin
Path := DirList.Strings[i] + '\';
if FindFirst(Path + '*.*', faAnyFile, Ds) = 0 then
repeat
if (Ds.Attr and faDirectory) = 0 then
begin
F:=TFileStream.Create(Path+Ds.Name,fmOpenRead);
F.Position:=0;
F.Read(buff,100);
NotNul:=False;
for j:=0 to 99 do
begin
if (buff[j]<>#00) then
begin
NotNul:=True;
break;
end;
end;
if not NotNul then FileList.Add(Path + Ds.Name);
F.Free;
end
else
if IncSubDir and (Ds.Name[1] <> '.') then DirList.Add(Path + Ds.Name);
until FindNext(Ds) <> 0;
Inc(i);
p := i * 100 div DirList.Count;
if p > Form1.ProgressBar1.Position then
Form1.ProgressBar1.Position := p;
FindClose(Ds);
end;

DirList.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
FileList:TStrings;
Dir: string;
begin
if SelectDirectory('请选择检测路径','/',Dir)=true then
begin
Listbox1.Items.Clear;
Button1.Enabled:=False;
FileList := TStringList.Create;
ProgressBar1.Position:=0;
FindFile(Dir, FileList, true);
if FileList.Count=0 then Listbox1.Items.Add('NO DUMMY FILES!!!')
else Listbox1.Items.AddStrings(FileList);
FileList.Free;
Button1.Enabled:=true;
end;
end;

end.

...全文
105 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
SonicX 2008-11-07
  • 打赏
  • 举报
回复
没看出啥问题
procedure delay(msec:integer); 过程没有用到
fangsp 2008-11-07
  • 打赏
  • 举报
回复
这段代码写得挺好的啊
bgft2008 2008-11-07
  • 打赏
  • 举报
回复
Project1.dpr 部分


program Project1;

uses
Forms,
Unit_SearchDir in 'Unit_SearchDir.pas' {Form1};

{$R *.res}

begin
Application.Initialize;
Application.Title := '光盘垃圾文件检测';
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

bgft2008 2008-11-07
  • 打赏
  • 举报
回复
Unit_SearchDir.dfm 部分


object Form1: TForm1
Left = 337
Top = 188
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = #26816#27979#20809#30424#22403#22334#25991#20214
ClientHeight = 239
ClientWidth = 418
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 12
object Label1: TLabel
Left = 24
Top = 208
Width = 48
Height = 12
Caption = #26816#27979#36827#31243
end
object Button1: TButton
Left = 152
Top = 166
Width = 107
Height = 25
Caption = #26816#27979#22403#22334#25991#20214
TabOrder = 0
OnClick = Button1Click
end
object ProgressBar1: TProgressBar
Left = 80
Top = 205
Width = 305
Height = 16
TabOrder = 1
end
object ListBox1: TListBox
Left = 24
Top = 16
Width = 361
Height = 137
ItemHeight = 12
TabOrder = 2
end
end

16,742

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 语言基础/算法/系统设计
社区管理员
  • 语言基础/算法/系统设计社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧