unit CountThread;
interface
uses
Classes, SysUtils, Dialogs, Math;
type
TCountThread = class(TThread)
private
FFileName: string;
FFileSize: Int64;
FOnStartCount: TNotifyEvent;
FOnProcess: TNotifyEvent;
FOnEndCount: TNotifyEvent;
FSumBit: Int64;
FBlockCount: Integer;
function CountBits(B: Byte): Integer;
protected
procedure Execute;override;
public
property FileName: string read FFileName write FFileName;
property FileSize: Int64 read FFileSize write FFileSize;
property BlockCount: Integer read FBlockCount write FBlockCount;
property SumBit: Int64 read FSumBit write FSumBit;
property OnStartCount: TNotifyEvent read FOnStartCount write FOnStartCount;
property OnProgress: TNotifyEvent read FOnProcess write FOnProcess;
property OnEndCount: TNotifyEvent read FOnEndCount write FOnEndCount;
end;
implementation
const
BlockSize = 102400;
{ TCountThread }
function TCountThread.CountBits(B: Byte): Integer;
begin
Result := 0;
while b<>0 do begin
if Odd(B) then Inc(Result);
b := b shr 1;
end;
end;
procedure TCountThread.Execute;
var
s: TStream;
i, rc: Integer;
str: array[1..BlockSize] of byte;
begin
inherited;
FSumBit := 0;
s := TFileStream.Create(FFileName, fmOpenRead);
FFileSize := s.Size;
FBlockCount := Ceil(FFileSize / BlockSize);
FOnStartCount(Self);
while FBlockCount > 0 do begin
rc := s.Read(str, BlockSize);
for i := 1 to rc do begin
FSumBit := FSumBit + CountBits(str[i]);
end;
FOnProcess(Self);
Dec(FBlockCount);
end;
FOnEndCount(Self);
FreeAndNil(s);
end;
end.
interface
uses
Classes, SysUtils, Dialogs, Math;
type
TCountThread = class(TThread)
private
FFileName: string;
FFileSize: Int64;
FOnStartCount: TNotifyEvent;
FOnProcess: TNotifyEvent;
FOnEndCount: TNotifyEvent;
FSumBit: Int64;
FBlockCount: Integer;
function CountBits(B: Byte): Integer;
protected
procedure Execute;override;
public
property FileName: string read FFileName write FFileName;
property FileSize: Int64 read FFileSize write FFileSize;
property BlockCount: Integer read FBlockCount write FBlockCount;
property SumBit: Int64 read FSumBit write FSumBit;
property OnStartCount: TNotifyEvent read FOnStartCount write FOnStartCount;
property OnProgress: TNotifyEvent read FOnProcess write FOnProcess;
property OnEndCount: TNotifyEvent read FOnEndCount write FOnEndCount;
end;
implementation
const
BlockSize = 102400;
{ TCountThread }
function TCountThread.CountBits(B: Byte): Integer;
begin
Result := 0;
while b<>0 do begin
if Odd(B) then Inc(Result);
b := b shr 1;
end;
end;
procedure TCountThread.Execute;
var
s: TStream;
i, rc: Integer;
str: array[1..BlockSize] of byte;
begin
inherited;
FSumBit := 0;
s := TFileStream.Create(FFileName, fmOpenRead);
FFileSize := s.Size;
FBlockCount := Ceil(FFileSize / BlockSize);
FOnStartCount(Self);
while FBlockCount > 0 do begin
rc := s.Read(str, BlockSize);
for i := 1 to rc do begin
FSumBit := FSumBit + CountBits(str[i]);
end;
FOnProcess(Self);
Dec(FBlockCount);
end;
FOnEndCount(Self);
FreeAndNil(s);
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CountThread, ComCtrls, DateUtils;
type
TForm1 = class(TForm)
btn1: TButton;
mmo1: TMemo;
dlgOpen1: TOpenDialog;
pb1: TProgressBar;
procedure btn1Click(Sender: TObject);
private
th: TCountThread;
StartTime: TDateTime;
procedure OnProcess(Sender: TObject);
procedure OnStartCount(Sender: TObject);
procedure OnEndCount(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
begin
if dlgOpen1.Execute then begin
StartTime := Now;
th := TCountThread.Create(True);
th.FileName := dlgOpen1.FileName;
th.OnProgress := OnProcess;
th.OnStartCount := OnStartCount;
th.OnEndCount := OnEndCount;
th.Resume;
end;
end;
procedure TForm1.OnEndCount(Sender: TObject);
begin
mmo1.Lines.Add(Format('个数:%d, 耗时:%fms,文件名:%s, 文件大小: %d', [TCountThread(Sender).SumBit, MilliSecondSpan(Now, StartTime), dlgOpen1.FileName, TCountThread(Sender).FileSize]));
end;
procedure TForm1.OnProcess(Sender: TObject);
begin
pb1.Position := pb1.Position + 1;
end;
procedure TForm1.OnStartCount(Sender: TObject);
begin
pb1.Max := TCountThread(Sender).BlockCount;
pb1.Position := 0;
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CountThread, ComCtrls, DateUtils;
type
TForm1 = class(TForm)
btn1: TButton;
mmo1: TMemo;
dlgOpen1: TOpenDialog;
pb1: TProgressBar;
procedure btn1Click(Sender: TObject);
private
th: TCountThread;
StartTime: TDateTime;
procedure OnProcess(Sender: TObject);
procedure OnStartCount(Sender: TObject);
procedure OnEndCount(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
begin
if dlgOpen1.Execute then begin
StartTime := Now;
th := TCountThread.Create(True);
th.FileName := dlgOpen1.FileName;
th.OnProgress := OnProcess;
th.OnStartCount := OnStartCount;
th.OnEndCount := OnEndCount;
th.Resume;
end;
end;
procedure TForm1.OnEndCount(Sender: TObject);
begin
mmo1.Lines.Add(Format('个数:%d, 耗时:%fms,文件名:%s, 文件大小: %d', [TCountThread(Sender).SumBit, MilliSecondSpan(Now, StartTime), dlgOpen1.FileName, TCountThread(Sender).FileSize]));
end;
procedure TForm1.OnProcess(Sender: TObject);
begin
pb1.Position := pb1.Position + 1;
end;
procedure TForm1.OnStartCount(Sender: TObject);
begin
pb1.Max := TCountThread(Sender).BlockCount;
pb1.Position := 0;
end;
end.