unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Grids,FileCtrl,JPEG, Buttons;
type
TForm1 = class(TForm)
Panel1: TPanel;
StringGrid1: TStringGrid;
Panel2: TPanel;
Memo1: TMemo;
Image1: TImage;
Button1: TButton;
Edit1: TEdit;
SpeedButton1: TSpeedButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure SpeedButton1Click(Sender: TObject);
procedure StringGrid1DblClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
bStop:Boolean;
function ListAllFiles(Path: String): Integer; stdcall;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
FileSize:LongWord;
FileCount:LongWord;
FolderCount:LongWord;
AllCount:LongWord;
implementation
uses Unit2;
{$R *.DFM}
function TForm1.ListAllFiles(Path:String):Integer;stdcall;
var SearchRec:TSearchRec;
ReValue:Integer;
begin
if Copy(Path,length(Path),1)<>'/' then
Path:=Path+'/';
ReValue:=FindFirst(Path+'*.*',faAnyFile,SearchRec);
while ReValue=0 do
begin
if bStop then
Break;
if SearchRec.Size=0 then
begin
if (SearchRec.Attr and faDirectory)<>0 then //文件夹
begin
if (Trim(SearchRec.Name)<>'.') and (Trim(SearchRec.Name)<>'..') then
begin
Inc(FolderCount);
Inc(AllCount);
StringGrid1.RowCount:=AllCount+1;
StringGrid1.Cells[0,AllCount]:=IntToStr(AllCount);
StringGrid1.Cells[1,AllCount]:='文件夹';
StringGrid1.Cells[2,AllCount]:=Path+SearchRec.Name;
ListAllFiles(Path+SearchRec.Name);
end;
end
else //0长度文件夹
begin
Inc(FileCount);
Inc(AllCount);
StringGrid1.RowCount:=AllCount+1;
StringGrid1.Cells[0,AllCount]:=IntToStr(AllCount);
StringGrid1.Cells[1,AllCount]:='文件';
StringGrid1.Cells[2,AllCount]:=Path+SearchRec.Name;
StringGrid1.Cells[3,AllCount]:=IntToStr(SearchRec.Size);
end;
end
else //普通文件夹
begin
Inc(FileCount);
Inc(AllCount);
StringGrid1.RowCount:=AllCount+1;
StringGrid1.Cells[0,AllCount]:=IntToStr(AllCount);
StringGrid1.Cells[1,AllCount]:='文件';
StringGrid1.Cells[2,AllCount]:=Path+SearchRec.Name;
StringGrid1.Cells[3,AllCount]:=IntToStr(SearchRec.Size);
FileSize:=FileSize+(SearchRec.FindData.nFileSizeLow);
end;
ReValue:=FindNext(SearchRec);
Application.ProcessMessages;
end;
Result:=1;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
bStop:=False;
FileSize:=0;
FileCount:=0;
AllCount:=0;
FolderCount:=0;
StringGrid1.RowCount:=2;
StringGrid1.Cells[0,0]:='序号';
StringGrid1.Cells[1,0]:='类型';
StringGrid1.Cells[2,0]:='名称';
StringGrid1.Cells[3,0]:='大小';
ListAllFiles(Edit1.Text);
StringGrid1.RowCount:=StringGrid1.RowCount+1;
StringGrid1.Cells[1,StringGrid1.RowCount-1]:='合计';
StringGrid1.Cells[2,StringGrid1.RowCount-1]:='文件夹数:'+IntToStr(FolderCount)+'个 '+'文件数:'+IntToStr(FileCount)+'个';
StringGrid1.Cells[3,StringGrid1.RowCount-1]:=IntToStr(FileSize);
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
Var TmpStr:String;
Flags:Word;
begin
if gdFixed in State then
(Sender as TStringGrid).Canvas.Brush.Color:=(Sender as TStringGrid).FixedColor
else
begin
if gdSelected in State then
(Sender as TStringGrid).Canvas.Brush.Color:=clHighlight
else
(Sender as TStringGrid).Canvas.Brush.Color:=(Sender as TStringGrid).Color;
end;
(Sender as TStringGrid).Canvas.FillRect(Rect);
(Sender as TStringGrid).Canvas.Font.Assign((Sender as TStringGrid).Font);
if (Copy((Sender as TStringGrid).Cells[1,ARow],1,6)='文件夹') and (ACol<>0) then
begin
if gdSelected in State then
(Sender as TStringGrid).Canvas.Brush.Color:=clHighlight
else
(Sender as TStringGrid).Canvas.Brush.Color:=clBtnShadow;
(Sender as TStringGrid).Canvas.FillRect(Rect);
if gdSelected in State then
(Sender as TStringGrid).Canvas.Font.Color:=clHighlightText
else
(Sender as TStringGrid).Canvas.Font.Color:=clRed;
(Sender as TStringGrid).Canvas.Font.Style:=(Sender as TStringGrid).Canvas.Font.Style+[fsBold];
TmpStr:=(Sender as TStringGrid).Cells[ACol,ARow];
Flags:=DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE;
if (ACol=0) or (ARow=0) then
Flags:=Flags or DT_CENTER;
DrawText((Sender as TStringGrid).Canvas.Handle,PChar(TmpStr),Length(TmpStr),Rect,Flags);
end else
begin
(Sender as TStringGrid).Canvas.FillRect(Rect);
if gdSelected in State then
(Sender as TStringGrid).Canvas.Font.Color:=clHighlightText
else
(Sender as TStringGrid).Canvas.Font.Color:=clDefault;
TmpStr:=(Sender as TStringGrid).Cells[ACol,ARow];
Flags:=DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE;
if (ACol=3) and (ARow<>0) and (Trim(TmpStr)<>'') then
begin
TmpStr:=TmpStr+'KB';
Flags:=Flags or DT_RIGHT;
end
else if (ACol=0) or (ARow=0) then
Flags:=Flags or DT_CENTER;
DrawText((Sender as TStringGrid).Canvas.Handle,PChar(TmpStr),Length(TmpStr),Rect,Flags);
end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var Mem:TMemoryStream;
Str:String;
i:Integer;
c:Char;
begin
if (ACol=2) and (ARow>0) then
begin
Memo1.Clear;
if (Copy((Sender as TStringGrid).Cells[1,ARow],1,6)='文件夹')
then
Memo1.Text:='<文件夹>'
else if (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.TXT')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.LOG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.BAT')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.PAS')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INI')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INF')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INC')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.PHP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.ASP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.CSS')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.HTM')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.HTML') then
begin
Memo1.Visible:=True;
Image1.Visible:=False;
try
Memo1.Lines.LoadFromFile(StringGrid1.Cells[ACol,ARow]);
except
On E:Exception do
begin
Mem:=TMemoryStream.Create;
try
Mem.LoadFromFile(StringGrid1.Cells[ACol,ARow]);
Str:='';
For i:=0 to Mem.Size-1 do
begin
Mem.Read(C,1);
Str:=Str+c;
if i>=63*1000 then
Break;
end;
if Trim(Str)='' then
Memo1.Text:='<空文件>'
else
Memo1.Text:=Trim(Str);
finally
Mem.Free;
end;
end;
end;
end
else if (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.JPG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.JPEG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.BMP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.ICO') then
begin
try
Image1.Picture.LoadFromFile((Sender as TStringGrid).Cells[2,ARow]);
Image1.Visible:=True;
Memo1.Visible:=False;
Except
On E:Exception do
begin
Memo1.Text:='非标准格式'+ExtractFileExt((Sender as TStringGrid).Cells[2,ARow])+'文件'
+#13#10#13#10+'信息:'+E.Message;
Image1.Visible:=False;
Memo1.Visible:=True;
end;
end;
end
else
begin
Memo1.Text:=ExtractFileExt((Sender as TStringGrid).Cells[2,ARow])+'文件';
Image1.Visible:=False;
Memo1.Visible:=True;
end;
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
Var Dir:String;
begin
Dir:=Edit1.Text;
if SelectDirectory(Dir,[],0) then
Edit1.Text:=Dir;
end;
procedure TForm1.StringGrid1DblClick(Sender: TObject);
Var ARow,ACol:Integer;
Mem:TMemoryStream;
Str:String;
i:Integer;
c:Char;
begin
ARow:=(Sender as TStringGrid).Selection.Top;
ACol:=(Sender as TStringGrid).Selection.Left;
if ACol=2 then
begin
if (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[ACol,ARow]))='.JPG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[ACol,ARow]))='.JPEG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[ACol,ARow]))='.BMP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[ACol,ARow]))='.ICO') then
begin
if Form2=nil then
Form2:=TForm2.Create(Application);
try
Form2.Image1.Picture.LoadFromFile((Sender as TStringGrid).Cells[ACol,ARow]);
Form2.Image1.Visible:=True;
Form2.Memo1.Visible:=False;
Form2.Show;
Except
Form2.Close;
end;
end
else if (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.TXT')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.LOG')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.BAT')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.PAS')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INI')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INF')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.INC')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.PHP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.ASP')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.CSS')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.HTM')
Or (UpperCase(ExtractFileExt((Sender as TStringGrid).Cells[2,ARow]))='.HTML') then
begin
if Form2=nil then
Form2:=TForm2.Create(Application);
Form2.Memo1.Visible:=True;
Form2.Image1.Visible:=False;
try
Form2.Memo1.Lines.LoadFromFile(StringGrid1.Cells[ACol,ARow]);
Form2.Show;
except
On E:Exception do
begin
Mem:=TMemoryStream.Create;
try
Mem.LoadFromFile(StringGrid1.Cells[ACol,ARow]);
Str:='';
For i:=0 to Mem.Size-1 do
begin
Mem.Read(C,1);
Str:=Str+c;
if i>=63*1000 then
Break;
end;
if Trim(Str)='' then
Form2.Memo1.Text:='<空文件>'
else
Form2.Memo1.Text:=Trim(Str);
Form2.Show;
finally
Mem.Free;
end;
end;
end;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
bStop:=True;
end;
end.
我的主页中有完整的源码和可执行文件下载:
http://www.aidelphi.com