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

.

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

.