感谢lvxq兄热心而详细的解答！我已经基本明白GetCommTimeOuts的用法了，昨天晚上没
睡觉就研究这个问题！然后用这个方案优化了一下我的程序，不过还是不管用。“死读”
问题是没有了，不过“超时”时长仍然比计算出来的长很多很多，比如我用
我自定义的SetTimeOutDefault()这个函数设置超时为30毫秒，但是超时还是超过5分钟
左右，还是没起作用啊，我把全部源代码、DFM帖出来，大家用Delphi编译一下一起研究
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
pb: TProgressBar;
FLabelStatus: TLabel;
lbl_Total: TLabel;
edt_IntervalTimeOut: TEdit;
UpDown1: TUpDown;
Label1: TLabel;
od1: TOpenDialog;
sd1: TSaveDialog;
Button2: TButton;
Label2: TLabel;
edt_Mul: TEdit;
UpDown2: TUpDown;
lbl_PercentBefore: TLabel;
lbl_Percent: TLabel;
lbl_Bad: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure edt_MulKeyPress(Sender: TObject;
var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
bBreak: Boolean;
function ByteToM(ByteCount: integer): Real;
//得到文件大小，单位为字节，失败则返回$FFFFFFFF
function MyGetFileSize(HFile: THANDLE): DWORD;
implementation
uses Math;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
fIn, fOut:THANDLE;
Buf: array [0..63] of char;
//nRead : PDWORD;
nRead, nTotalRead,nWrite: LongWord;
TimeOut: COMMTIMEOUTS;
bResult: boolean;
VCDFileSize: DWORD;
nBadBlock: integer;
//坏块个数
procedure StopReadImmediate();
begin
//completed immediately read disk!!
TimeOut.ReadIntervalTimeout:= MAXDWORD;//StrToInt(edt_IntervalTimeOut.Text);
TimeOut.ReadTotalTimeoutMultiplier:= 0;//StrToInt(edt_Mul.Text);
TimeOut.ReadTotalTimeoutConstant:= 0;
SetCommTimeouts(fIn, TimeOut);
end;
procedure SetTimeOutDefault();
begin
//Set time out
TimeOut.ReadIntervalTimeout:= 0;//StrToInt(edt_IntervalTimeOut.Text);
TimeOut.ReadTotalTimeoutMultiplier:= 0;//StrToInt(edt_Mul.Text);
TimeOut.ReadTotalTimeoutConstant:= StrToInt(edt_Mul.Text);
SetCommTimeouts(fIn, TimeOut);
end;
begin
//错误处理
try
StrToInt(edt_IntervalTimeOut.text);
StrToInt(edt_Mul.text);
except
MessageDlg('超时设置有误！',mtWarning, [mbOK], 0);
exit;
end;
//打开文件
if od1.Execute then
begin
fIn:= CreateFile(PChar(od1.FileName), GENERIC_READ ,
FILE_SHARE_READ , nil, //security
OPEN_EXISTING ,
FILE_ATTRIBUTE_ARCHIVE or
FILE_ATTRIBUTE_COMPRESSED or
FILE_ATTRIBUTE_HIDDEN or
FILE_ATTRIBUTE_NORMAL or
FILE_ATTRIBUTE_OFFLINE or
FILE_ATTRIBUTE_READONLY or
FILE_ATTRIBUTE_SYSTEM or
FILE_ATTRIBUTE_TEMPORARY,
0);
if fIn = INVALID_HANDLE_VALUE then
begin
MessageDlg('打开文件失败！',mtError, [mbOK], 0);
exit;
end;
VCDFileSize:= MyGetFileSize(fIn);
if VCDFileSize = 0 then
begin
MessageDlg('VCD文件长度为零，无法处理！',mtError, [mbOK], 0);
exit;
end;
lbl_Total.Caption:= 'VCD文件总长：' + FloatToStr(ByteToM(VCDFileSize)) + ' M';
nTotalRead:= 0;
pb.Min:= 0;
pb.Max:= Round(ByteToM(VCDFileSize));
bBreak:= False;
//Out file
sd1.DefaultExt:= od1.DefaultExt;
sd1.Filter:= od1.Filter;
if sd1.Execute then
begin
fOut:= CreateFile(PChar(sd1.FileName), GENERIC_WRITE ,
0 , nil, //security
CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL , 0);
if fOut = INVALID_HANDLE_VALUE then
begin
MessageDlg('创建文件失败！',mtError, [mbOK], 0);
exit;
end;
nBadBlock:= 0;
lbl_Bad.Visible:= False;
lbl_Percent.Caption:= '0%';
lbl_Percent.Visible:= true;
lbl_PercentBefore.Visible:= true;
SetTimeOutDefault();
//begin
read vcd.
try
try
repeat
bResult:= ReadFile(fIn, Buf, SizeOf(Buf), nRead, nil);
if bBreak then
break;
if bResult and (nRead <> 0) then
WriteFile(fOut, Buf, SizeOf(Buf), nWrite, nil)
else
begin
//Stop read disk first;
StopReadImmediate();
//Restore time out settings;
SetTimeOutDefault();
inc(nBadBlock);
lbl_Bad.Caption:= '发现 '
+ IntToStr(nBadBlock) + ' 个坏块';
if not lbl_Bad.Visible then
lbl_Bad.Visible:= true;
end;
nTotalRead:= nTotalRead + nRead;
FLabelStatus.Caption:= '已经截取了：【'
+ IntToStr(nTotalRead) + '】个字节（'
+ FloatToStr(nTotalRead / Power(2,20)) + 'MB）';
//Show read progress
pb.Position:= Round(ByteToM(nTotalRead));
lbl_Percent.Caption:=
IntToStr(Round(nTotalRead / VCDFileSize * 100)) + '%';
Application.ProcessMessages;
if bBreak then
break;
until bResult and (nRead = 0);
//End of file
finally
CloseHandle(fIn);
CloseHandle(fOut);
end;
MessageDlg('VCD 截取成功！',mtInformation, [mbOK], 0);
except
MessageDlg('VCD 截取失败！',mtError, [mbOK], 0);
end;
end;
//save dialog
end;
//Open dialog
end;
function ByteToM(ByteCount: integer): Real;
begin
Result:= ByteCount / Power(2, 20);
end;
function MyGetFileSize(HFile: THANDLE): DWORD;
var
dwSizeLow, dwSizeHigh, dwError: DWORD;
begin
Result:= $FFFFFFFF;
dwSizeLow := GetFileSize (hFile, @dwSizeHigh) ;
// If we failed ...
if (dwSizeLow = $FFFFFFFF) then
begin
dwError := GetLastError();
if dwError <> NO_ERROR then
begin
// Deal with that failure.
MessageDlg('读取文件大小时发生错误，错误代号为：' + IntToStr(dwError)
,mtError, [mbOK], 0);
exit;
end;
end;
// End of error handler.
Result:= dwSizeLow or (dwSizeHigh shl 32);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
bBreak:= true;
end;
procedure TForm1.edt_MulKeyPress(Sender: TObject;
var Key: Char);
begin
if not (Key in ['0'..'9']) then
Key:= #0;
end;
end.
－－－DFM－－－
object FLabelStatus: TLabel
Left = 16
Top = 80
Width = 60
Height = 12
Caption = '读取状态：'
end
object lbl_Total: TLabel
Left = 16
Top = 56
Width = 84
Height = 12
Caption = 'VCD 文件总长：'
end
object Label1: TLabel
Left = 215
Top = 45
Width = 204
Height = 12
Caption = '读两个字节之间超时 毫秒'
Visible = False
end
object Label2: TLabel
Left = 215
Top = 21
Width = 192
Height = 12
Caption = '总超时 秒'
end
object lbl_PercentBefore: TLabel
Left = 192
Top = 128
Width = 48
Height = 12
Caption = '已截取：'
Visible = False
end
object lbl_Percent: TLabel
Left = 248
Top = 128
Width = 12
Height = 12
Caption = '0%'
Visible = False
end
object lbl_Bad: TLabel
Left = 336
Top = 78
Width = 91
Height = 14
Caption = '发现 0 个坏块'
Color = clRed
Font.Charset = GB2312_CHARSET
Font.Color = clYellow
Font.Height = -14
Font.Name = '宋体'
Font.Style = []
ParentColor = False
ParentFont = False
Visible = False
end
object Button1: TButton
Left = 16
Top = 16
Width = 75
Height = 25
Caption = '截取VCD'
TabOrder = 0
OnClick = Button1Click
end
object pb: TProgressBar
Left = 16
Top = 104
Width = 441
Height = 16
Min = 0
Max = 100
TabOrder = 1
end
object edt_IntervalTimeOut: TEdit
Left = 333
Top = 40
Width = 39
Height = 20
MaxLength = 1
TabOrder = 2
Text = '5'
Visible = False
OnKeyPress = edt_MulKeyPress
end
object UpDown1: TUpDown
Left = 372
Top = 40
Width = 16
Height = 20
Associate = edt_IntervalTimeOut
Min = 0
Max = 20
Position = 5
TabOrder = 3
Thousands = False
Visible = False
Wrap = False
end
object Button2: TButton
Left = 120
Top = 16
Width = 75
Height = 25
Caption = '终止'
TabOrder = 4
OnClick = Button2Click
end
object edt_Mul: TEdit
Left = 333
Top = 18
Width = 39
Height = 20
MaxLength = 2
TabOrder = 5
Text = '30'
OnKeyPress = edt_MulKeyPress
end
object UpDown2: TUpDown
Left = 372
Top = 18
Width = 15
Height = 20
Associate = edt_Mul
Min = 0
Max = 50
Position = 30
TabOrder = 6
Thousands = False
Wrap = False
end
object od1: TOpenDialog
DefaultExt = 'dat'
Filter =
'所有VCD文件(*.dat;*.mpg;*.mpeg;*.avi;*.asf;*.rm;*.ram;*.mpa)|*.d' +
'at;*.mpg;*.mpeg;*.avi;*.asf;*.rm;*.ram;*.mpa|数字音频文件(*.dat)' +
'|*.dat|电影剪切(*.mpg;*.mpeg;*.mpa)|*.mpg;*.mpeg;*.mpa|Real 格式' +
'电影(*.rm;*.ram)|*.rm;*.ram|微软电影格式(*.asf;*.avi)|*.asf;*.av' +
'i|所有文件(*.*)|*.*'
Left = 144
Top = 64
end
object sd1: TSaveDialog
DefaultExt = 'dat'
Left = 272
Top = 64
end
