转载的
DELPHI并口编程范例
{Writen by Cat Software}
unit FileTransfer;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, Buttons, ExtCtrls, FileCtrl, ComCtrls;
const
BlockSize = 64512; {64510 bytes of data + 2 bytes checksum
this block could be much bigger but the next
implementation
will be in DMA in stead of programmed IO and DMA
blocks are
limited to 64Kb
besides the dos version also has a limitted
blocksize and t
his
way the 2 versions could be compatible}
type
TFloatFormat = (ffGeneral);
FileType = ARRAY[0..BlockSize-1] of byte;
TForm1 = class(TForm)
Edit1: TEdit;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
DriveComboBox1: TDriveComboBox;
Bevel1: TBevel;
Send: TBitBtn;
Receive1: TBitBtn;
Close: TBitBtn;
Bevel2: TBevel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label14: TLabel;
Label15: TLabel;
ProgressBar1: TProgressBar;
ComboBox2: TComboBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label13: TLabel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Bevel3: TBevel;
ProgressBar2: TProgressBar;
procedure CloseClick(Sender: TObject);
procedure FileListBox1Click(Sender: TObject);
procedure SendClick(Sender: TObject);
procedure Receive1Click(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure InitialisePort;
procedure ResetPort;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
LPTnAddress, ECRAddress, DCRAddress, DSRAddress, ecpDFifoAddress,
cnfgAAddress,
cnfgBAddress: word;
Size, RealBlockSize, ThisBlockSize: integer;
LengthOfName, NumberOfBlocks: integer;
Implement: (EightBit, SixteenBit, ThirtytwoBit);
fname: string;
AttrByte: integer;
NameString: string[255];
f: file;
FileData: FileType;
CSCOk,Error, ImplementationNr: byte;
NoFile, ImplementTest: Boolean;
{$R *.DFM}
Procedure TForm1.ResetPort;
begin
Label12.Show;
ProgressBar1.Position:=0;
ASM
mov dx,ECRAddress
mov al,$04 {SPP mode,FIFO will be reset when going to ECP mode}
out dx,al
mov al,$74 {ECP mode, FIFO reset}
out dx,al
mov dx,DCRAddress
mov al,$08; {reset control lines}
out dx,al
end;
Exit;
end;
Procedure TForm1.InitialisePort;
begin
ASM {initialisation}
mov ax,LPTnAddress
inc ax
mov [DSRAddress],ax {LPTnAddress + $001, Device Status Register}
inc ax
mov [DCRAddress],ax {LPTnAddress + $002, Device Control Register}
add ax,$3FE
mov [ecpDFifoAddress],ax {LPTnAddress + $400, ECP data FIFO}
mov [cnfgAAddress],ax {LPTnAddress + $400, Configuration Register
A}
inc ax
mov [cnfgBAddress],ax {LPTnAddress + $401, Configuration Register
B}
inc ax
mov [ECRAddress],ax {LPTnAddress + $402, Extended Control
Register}
mov dx,ECRAddress
mov al,$04 {SPP mode,FIFO will be reset when going to ECP mode}
out dx,al
mov al,$F4 {configuration A mode, get type of port (8, 16 or 32 bit)}
out dx,al
mov dx,cnfgAAddress {get the implementation number which corresponds
with the
type of the port}
in al,dx
and al,$70
shr al,4
mov [ImplementationNr],al
mov dx,ECRAddress
mov al,$74 {ECP mode, no IRQ of nFault, no DMA and no service IRQ}
out dx,al
end;
IF ImplementationNr=0 THEN
Begin
Implement:=SixteenBit;
Label15.Caption:='16-bit implementation';
ImplementTest:=true;
end;
IF ImplementationNr=1 THEN
Begin
Implement:=EightBit;
Label15.Caption:='8-bit implementation';
ImplementTest:=true;
end;
IF ImplementationNr=2 THEN
Begin
Implement:=SixteenBit; {32-bit implementation never found, does it
exist?}
Label15.Caption:='32-bit implementation, 16-bit used';
ImplementTest:=true;
end;
IF ImplementationNr>2 THEN
Begin
Label15.Caption:='Not a valid ECP port';
ImplementTest:=false;
end;
end;
Procedure ReceiveCheckSumCheck;
Begin
ASM
mov ecx,$00FFFFFF {load time-out counter}
mov dx,ECRAddress
@fifoNotEmpty: {wait for empty FIFO, this kind of polling is
frequently us
ed in the program}
in al,dx
test al,$01 {test FIFO-full bit}
jnz @fifoEmpty
dec ecx {time-out counter}
jnz @fifoNotEmpty
mov [Error],1 {time-out occured}
jmp @end
@fifoEmpty:
mov dx,DCRAddress {Request for result of check sum}
mov al,$00 {Selectln low, results in nFault high for
receiver}
out dx,al
mov ecx,$00FFFFFF
mov dx,DSRAddress
@WaitForAck: {Waits till receiver is done with checksum}
in al,dx
test al,$08 {nFault high, comes from nSelectLn low}
jnz @GotAcknowledge
dec ecx
jnz @WaitForAck
mov [Error],1
jmp @end
@GotAcknowledge: {gets checksum result: PError, comes from nInit}
and al,$20
shr al,4
mov [CSCOk],al
mov dx,ECRAddress {reset FIFO}
mov al,$14
out dx,al
mov al,$74
out dx,al
mov dx,DCRAddress {send acknowledge, reset control lines}
mov al,$08; {nSelectln high, results in nFault low for
receiver}
out dx,al
@end:
end;
end;
Procedure SendCheckSumCheck;
Begin
ASM
mov ecx,$00FFFFFF
mov dx,DSRAddress
@WaitSend: {waiting for sender to request checksum result}
in al,dx
test al,$08 {wait for nFault to be high (nSelectln is set low)}
jnz @SendCheckSum
dec ecx
jnz @WaitSend
mov [Error],1
jmp @end
@SendCheckSum:
mov dx,ECRAddress {reset FIFO BEFORE ReceiveCheckSumCheck resets
his FIFO
}
mov al,$14 {else some bytes may get lost during reseting}
out dx,al
mov al,$74
out dx,al
mov dx,DCRAddress {send checksum result: nInit, results in PError}
mov al,CSCOk
shl al,2
out dx,al
mov dx,DSRAddress
mov ecx,$00FFFFFF
@WaitReceive: {wait for acknowledge of sender}
in al,dx
test al,$08 {wait for nFault to be low (nSelectln is set high)}
jz @GotAcknowledge
dec ecx
jnz @WaitReceive
mov [Error],1
jmp @end
@GotAcknowledge:
mov dx,DCRAddress {reset control lines}
mov al,$28
out dx,al
@end:
end;
end;
Procedure ReceiveSynchronisation; {basicly the same as
ReceiveCheckSumCheck}
Begin
ASM
mov ecx,$1FFFFFFF {large timeout counter to give enough time to
click the
button}
mov dx,DSRAddress
@WaitSend: {waiting for sender to request synchro}
in al,dx
test al,$08 {wait for nFault to be high (nSelectln is set low)}
jnz @GotRequest
dec ecx
jnz @WaitSend
mov [Error],1
jmp @end
@GotRequest:
mov dx,ECRAddress {reset FIFO}
mov al,$14
out dx,al
mov dx,ECRAddress
mov al,$74
out dx,al
mov dx,DCRAddress {send acknowledge}
mov al,$00
out dx,al
mov ecx,$00FFFFFF
mov dx,DSRAddress
@WaitReceive: {wait for acknowledge of sender}
in al,dx
test al,$08 {wait for nFault to be low (nSelectln is set high)}
jz @GotAcknowledge
dec ecx
jnz @WaitReceive
mov [Error],1
jmp @end
@GotAcknowledge:
mov dx,DCRAddress {reset controllines, read}
mov al,$28
out dx,al
@end:
end;
end;
Procedure SendSynchronisation; {basicly the same as SendCheckSumCheck}
Begin
ASM
mov dx,DCRAddress {Request for result of check sum}
mov al,$00 {Selectln low, results in nFault high for
receiver}
out dx,al
mov ecx,$1FFFFFFF
mov dx,DSRAddress
@WaitForAck: {Waits till receiver send acknowledge}
in al,dx
test al,$08 {nFault high, comes from nSelectLn low}
jnz @GotAcknowledge
dec ecx
jnz @WaitForAck
mov [Error],1
jmp @end
@GotAcknowledge:
mov dx,ECRAddress {reset FIFO}
mov al,$14
out dx,al
mov al,$74
out dx,al
mov dx,DCRAddress {send acknowledge, reset control lines, write}
mov al,$08; {nSelectln high, results in nFault low for
receiver}
out dx,al
@end:
end;
end;
procedure TForm1.CloseClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.FileListBox1Click(Sender: TObject); {procedure to change
the att
ribute of a file}
begin
NoFile:=FALSE;
AttrByte:=0;
Edit1.Text:=ExtractRelativePath(ExtractFileDir(FileListBox1.FileName)+'/',
File
ListBox1.FileName);
Edit1.OEMConvert:=TRUE;
fname:=Edit1.Text;
NameString:=Edit1.Text;
AttrByte:=FileGetAttr(fname);
AssignFile(f,fname);
reset(f);
CloseFile(f);
IF (IOResult <> 0) OR (fname = '') THEN
Begin
Label12.Caption:='File not found!';
NoFile:=TRUE;
end
ELSE
Begin
Label12.Caption:=fname + ' selected';
Label12.Update;
end;
If AttrByte AND faReadOnly = faReadOnly
then
CheckBox1.Checked:=True
else
CheckBox1.Checked:=False;
If AttrByte AND faHidden = faHidden
then
CheckBox2.Checked:=True
else
CheckBox2.Checked:=False;
If AttrByte AND faSysFile = faSysFile
then
CheckBox3.Checked:=True
else
CheckBox3.Checked:=False;
If AttrByte AND faArchive = faArchive
then
CheckBox4.Checked:=True
else
CheckBox4.Checked:=False;
end;
procedure TForm1.SendClick(Sender: TObject); {procedure to send a file}
var
Time1, Time2, BlockTime1, BlockTime2, BlockTransferRate, TransferRate:
Double;
Tel, BlockCount: Integer;
begin
Label6.Caption:=''; {clear the messages}
Label8.Caption:='';
Label10.Caption:='';
Label12.Caption:='';
Label18.Caption:='';
Label19.Caption:='';
Label20.Caption:='';
Label6.Update;
Label8.Update;
Label10.Update;
Label12.Update;
Label18.Update;
Label19.Update;
Label20.Update;
BlockTime1:=0;
BlockTime2:=0;
IF NOT ImplementTest THEN
Begin
Label12.Caption:='No valid port selected!';
Exit;
End;
IF NoFile THEN
Begin
Label12.Caption:='No valid file selected!';
Exit;
End;
NameString:=Edit1.Text;
LengthOfName:=ByteToCharLen(NameString, 254)+1;
AssignFile(f,NameString);
reset(f,1);
IF (IOResult <> 0) OR (fname = '') THEN
Begin
Label12.Caption:='File not found!';
ResetPort;
end;
Label18.Caption:=NameString;
Label19.Caption:=IntToStr(BlockSize);
Label18.Update;
Label19.Update;
SendSynchronisation; {wait for receiver to be ready}
IF Error=1 THEN
Begin
Label12.Caption:='01 ECP timeout, data transfer is aborted';
ResetPort;
end;
Time1:=Now;
Size:=FileSize(f);
NumberOfBlocks:=Size DIV (BlockSize-2);
IF (Size MOD (BlockSize-2))<>0 THEN NumberOfBLocks:=NumberOfBlocks+1;
Label6.Caption:=IntToStr(NumberOfBlocks);
Label8.Caption:=IntToStr(Size);
Label6.Update;
LAbel8.Update;
Error:=0;
ASM
mov ecx,$0FFFFFFF
mov dx,ECRAddress
@fifoNotEMPTY_SendBlockSize: {wait for FIFO to be empty (should be)
and repor
t stall}
in al,dx
test al,$01
jnz @fifoEMPTY_SendBlockSize
dec ecx
jnz @fifoNotEMPTY_SendBlockSize
mov [Error],1
jmp @end
@fifoEMPTY_SendBlockSize:
mov dx,ecpDFifoAddress
mov eax,Size {loads eax with Size}
out dx,al {send low byte of low word}
mov al,ah
out dx,al {send high byte of low word}
shr eax,16 {move high word to low word}
out dx,al {send low byte high word}
mov al,ah
out dx,al {send low byte high word}
mov eax,LengthOfName {load eax with length of the filename}
mov [Tel],eax {load loop counter with length}
out dx,al {send length of the filename}
lea ebx,NameString {get address of string containing filename}
@LoopSendName: {return of loop 'Tel'}
mov ecx,$000FFFFF
mov dx,ECRAddress
@fifoFULL_SendName: {wait for FIFO to be empty and report stall}
in al,dx
test al,$02
jz @fifoNotFULL_SendName
dec ecx
jnz @fifoFULL_SendName
mov [Error],1
jmp @end
@fifoNotFULL_SendName: {transmit data}
mov dx,ecpDFifoAddress
mov al,[ebx] {move byte of NameString in al}
out dx,al {send it}
inc ebx {point at next byte}
dec [Tel]
cmp [Tel],0
jnz @LoopSendName {until Tel=0}
mov eax,$05
add eax,LengthOfName {compute the number of bytes send}
cmp al,$0F {lower than 16?}
jnb @16BytesSend
mov cl,$10 {compute number of bytes to reach a block of 16
bytes}
sub cl,al
@FillFIFO: {send some extra bytes to fill a FIFO = 16
bytes}
out dx,al
dec cl
jnz @FillFIFO
jmp @end
@16BytesSend:
test al,$01 {number of bytes send odd or even?}
jz @end
out dx,al {send extra byte to support 16 bit FIFO}
@end:
end;
IF Error=1 THEN
Begin
Label12.Caption:='02 ECP timeout, data transfer is aborted';
ResetPort;
end;
SendSynchronisation; {second synchro to clear FIFO}
ProgressBar1.Max:=NumberOfBlocks;
ProgressBar1.Step:=1;
Case Implement OF {different implementation for 8 bit and 16 bit ECP
ports}
EightBit:
Begin
FOR BlockCount:=1 TO NumberOfBlocks DO
Begin
BlockRead(f,FileData,BlockSize-2,RealBlockSize); {read
blocksize-2 by
tes of file at once}
IF BlockCount=1 THEN BlockTime1:=Now; {used to compute block
transfer
rate}
REPEAT
ASM
lea ebx,FileData {get address of data to be send}
xor ax,ax
mov ecx,RealBlockSize {load ecx with RealBlockSize}
@ChecksumLoop: {compute checksum by xor-ing with the
byte and r
otate the word to left}
xor al,[ebx]
rol ax,1
inc ebx
dec ecx
jnz @CheckSumLoop
mov [ebx],ax {store checksum after data block}
mov edx,RealBlockSize {load edx with RealBlockSize}
inc edx {last 2 bytes are checksum}
inc edx
mov eax,edx
shr edx,4 {get RealBlockSize div 16}
and eax,$0F {is block divideble by 16?}
cmp eax,0
jz @BlockDivideble16
inc edx {if not: increse number of 16 byte
blocks by 1}
@BlockDivideble16:
mov [Tel],edx {load the loopcounter 'Tel'}
lea ebx,FileData {get address of data to be send}
@LoopSendData: {return}
mov ecx,$00FFFFFF
mov dx,ECRAddress
@fifoNotEMPTY_SendData: {wait for FIFO to be empty and
report s
tall}
in al,dx
test al,$01
jnz @fifoEMPTY_SendData
dec ecx
jnz @fifoNotEMPTY_SendData
mov [Error],1
jmp @end
@fifoEMPTY_SendData: {transmit data in a burst of 16
bytes}
mov cl,$10 {loads loopcounter with 16}
mov dx,ecpDFifoAddress
@Loop16Bytes: {return of loop}
mov al,[ebx] {send a byte of the data}
out dx,al
inc ebx
dec cl
jnz @Loop16Bytes {until 16 bytes are send}
dec [Tel]
cmp [Tel],0
jnz @LoopSendData {until Tel=0}
@end:
end;
IF Error=1 THEN
Begin
Label12.Caption:='03 ECP timeout, data transfer
aborted';
ResetPort;
end;
ReceiveCheckSumCheck;
IF Error=1 THEN
Begin
Label12.Caption:='04 ECP timeout, data transfer is
aborted';
ResetPort;
end;
IF CSCOk=0 THEN
Begin
Label12.Caption:='Checksum error on
block'+IntToStr(BlockCount)
;
Label12.update;
end;
UNTIL CSCOk<>0;
ProgressBar1.StepIt;
IF BlockCount=1 THEN BlockTime2:=Now; {used to compute block
transfer
rate}
End;
End;
SixteenBit: {basicly the same as 8 bit but instead of sending a byte,
send a
word}
Begin
FOR BlockCount:=1 TO NumberOfBlocks DO
Begin
BlockRead(f,FileData,BlockSize-2,RealBlockSize);
IF BlockCount=1 THEN BlockTime1:=Now;
REPEAT
ASM
lea ebx,FileData {compute checksum}
xor ax,ax
mov ecx,RealBlockSize
@ChecksumLoop:
xor al,[ebx]
rol ax,1
inc ebx
dec ecx
jnz @CheckSumLoop
mov [ebx],ax
mov edx,RealBlockSize {determine number of 16 byte blocks}
inc edx
inc edx
mov eax,edx
shr edx,4
and eax,$0F
cmp eax,0
jz @BlockDivideble16
inc edx
@BlockDivideble16:
mov [Tel],edx {load the loopcounter 'Tel'}
lea ebx,FileData {get address of FileData}
@LoopSendData: {return}
mov ecx,$00FFFFFF
mov dx,ECRAddress
@fifoNotEMPTY_SendData: {wait for FIFO to be empty and
report s
tall}
in al,dx
test al,$01
jnz @fifoEMPTY_SendData
dec ecx
jnz @fifoNotEMPTY_SendData
mov [Error],1
jmp @end
@fifoEMPTY_SendData: {transmit data in a burst of 16
bytes}
mov cl,$08 {loads loopcounter with 8, 8 times 2 bytes
is????}
mov dx,ecpDFifoAddress
@Loop16Bytes: {return}
mov ax,[ebx]
out dx,ax
inc ebx
inc ebx
dec cl
jnz @Loop16Bytes {until 16 bytes are send}
dec [Tel]
cmp [Tel],0
jnz @LoopSendData {until Tel=0}
@end:
end;
IF Error=1 THEN
Begin
Label12.Caption:='03 ECP timeout, data transfer
aborted';
ResetPort;
end;
ReceiveCheckSumCheck; {receives the checksum copmparing
result}
IF Error=1 THEN
Begin
Label12.Caption:='04 ECP timeout, data transfer is
aborted';
ResetPort;
end;
IF CSCOk=0 THEN
Begin
Label12.Caption:='Checksum error on
block'+IntToStr(BlockCount)
;
Label12.Show;
end;
UNTIL CSCOk<>0;
ProgressBar1.StepIt;
IF BlockCount=1 THEN BlockTime2:=Now;
End;
End;
End;
ProgressBar1.Position:=0;
CloseFile(f);
Time2:=Now;
TransferRate:=Size/((Time2-Time1)*24*3600*1024);
IF BlockTime1<>BlockTime2 THEN
BlockTransferRate:=BlockSize/((BlockTime2-BlockT
ime1)*24*3600*1024)
ELSE BlockTransferRate:=0;
Label10.Caption:=FloatToStrF(TransferRate,FFfixed,5,2);
Label12.Caption:='Data transmitted';
Label20.Caption:=FloatToStrF(BlockTransferRate,FFfixed,6,2);
end;
procedure TForm1.Receive1Click(Sender: TObject); {procedure to receive a
file}
Var
Tel, BlockCount: Integer;
begin
Label6.Caption:='';
Label8.Caption:='';
Label10.Caption:='';
Label12.Caption:='';
Label18.Caption:='';
Label19.Caption:='';
Label20.Caption:='';
Label6.Update;
Label8.Update;
Label10.Update;
Label12.Update;
Label18.Update;
Label19.Update;
Label20.Update;
IF NOT ImplementTest THEN
Begin
Label12.Caption:='No valid port selected!';
ResetPort;
End;
NameString:='';
Error:=0;
ReceiveSynchronisation; {waits for sender to be ready}
IF Error=1 THEN
Begin
Label12.Caption:='01 ECP timeout, data transfer aborted';
ResetPort;
end;
ASM {virtualy the same as in SendClick, but 'in' instead of 'out'}
mov ecx,$00FFFFFF
mov dx,ECRAddress
@fifoNotFULL_ReceiveBlockSize: {wait for FIFO to be empty and report
stall}
in al,dx
test al,$02
jnz @fifoFULL_ReceiveBlockSize
dec ecx
jnz @fifoNotFULL_ReceiveBlockSize
mov [Error],1
jmp @end
@fifoFULL_ReceiveBlockSize: {receive the size of the file}
xor ebx,ebx
mov dx,ecpDFifoAddress
in al,dx
mov bl,al {receive first 2 bytes}
in al,dx
mov bh,al
shl ebx,16
in al,dx {receive next 2 bytes}
mov bl,al
in al,dx
mov bh,al
rol ebx,16
mov [Size],ebx {store ebx into Size}
xor eax,eax
in al,dx
mov [Tel],eax {get legnth of the filename}
lea ebx,NameString {get address of string containing length of
filename}
@LoopReceiveName:
mov ecx,$00FFFFFF
mov dx,ECRAddress
@fifoEMPTY_ReceiveName: {wait for FIFO to be not empty and report
stall}
in al,dx
test al,$01
jz @fifoNotEMPTY_ReceiveName
dec ecx
jnz @fifoEMPTY_ReceiveName
mov [Error],1
jmp @end
@fifoNotEMPTY_ReceiveName: {receive a byte of the filename}
mov dx,ecpDFifoAddress
in al,dx
mov [ebx],al
inc ebx
dec [Tel]
cmp [Tel],0
jnz @LoopReceiveName {until Tel=0}
test ah,1
jz @end
in al,dx {receive extra byte to support 16bit ECP ports}
@end:
end;
IF Error=1 THEN
Begin
Label12.Caption:='02 ECP timeout, data transfer aborted';
ResetPort;
end;
ReceiveSynchronisation; {clears the FIFO}
AssignFile(f,NameString);
Rewrite(f,1);
NumberOfBlocks:=Size DIV (BlockSize-2);
RealBlockSize:=Size-NumberOfblocks*(BlockSize-2); {computes size last
block}
IF RealBlockSize<>0 THEN NumberOfBlocks:=NumberOfBlocks+1;
Label6.Caption:=IntToStr(NumberOfBlocks);
Label8.Caption:=IntToStr(Size);
Label18.Caption:=NameString;
Label19.Caption:=IntToStr(BlockSize);
Label6.Update;
Label8.Update;
Label18.Update;
Label19.Update;
ProgressBar1.Max:=NumberOfBlocks;
ProgressBar1.Step:=1;
Case Implement OF {different implementation for 8 bit and 16 bit ECP
ports}
EightBit:
Begin
FOR BlockCount:=1 TO NumberOfBlocks DO
Begin
IF BLockCount=NumberOfBlocks THEN
ThisBlockSize:=RealBlockSize+2
ELSE ThisBlockSize:=BlockSize;
{sounds s
tupid but it's an old variable}
REPEAT
CSCOk:=1;
ASM
mov edx,ThisBlockSize {load edx with ThisBlockSize}
mov eax,edx
shr edx,4 {get ThisBlockSize div 16}
and eax,$0F {is block divideble by 16?}
cmp eax,0
jz @BlockDivideble16
inc edx {if not: increse number of 16 byte
blocks by 1}
@BlockDivideble16:
mov [Tel],edx {load the loopcounter 'Tel'}
lea ebx,FileData {get Address of FileData}
dec ebx {explanation further}
@LoopReceiveData: {return}
mov ecx,$00FFFFFF
mov dx,ECRAddress
@fifoNotFULL_ReceiveData: {wait for full FIFO and report
stall}
in al,dx
test al,$02
jnz @fifoFULL_ReceiveData
dec ecx
jnz @fifoNotFULL_ReceiveData
mov [Error],1
jmp @end
@fifoFULL_ReceiveData: {receive data in a burst of 16
bytes}
mov cl,$10 {loads loopcounter with 16}
mov dx,ecpDFifoAddress
@Loop16Bytes: {return}
inc ebx {due to pipeline hazzards, the inc is
put befo
re the in instruction}
in al,dx
mov [ebx],al
dec cl
jnz @Loop16Bytes {until 16 bytes are send}
dec [Tel]
cmp [Tel],0
jnz @LoopReceiveData {until Tel=0}
lea ebx,FileData {computes checksum, the same as in
sending a fil
e}
xor ax,ax
mov ecx,ThisBlockSize
dec ecx
dec ecx
@ChecksumLoop:
xor al,[ebx]
rol ax,1
inc ebx
dec ecx
jnz @CheckSumLoop
mov cx,[ebx] {load cx with cheacksum}
cmp ax,cx {is the computed checksum the same?}
je @end
mov [CSCOk],0 {no it is not}
@end:
end;
IF Error=1 THEN
Begin
Label12.Caption:='03 ECP timeout, data transfer
aborted';
ResetPort;
end;
SendCheckSumCheck; {sends the checksum comparing result}
IF Error=1 THEN
Begin
Label12.Caption:='04 ECP timeout, data transfer
aborted';
ResetPort;
end;
IF CSCOk=0 THEN
begin
Label12.Caption:='Checksum error on block
'+IntToStr(BlockCount
);
Label12.Update;
end;
UNTIL CSCOk<>0;
ProgressBar1.StepIt;
BlockWrite(f,FileData,ThisBlockSize-2);
end;
End;
SixteenBit: {again it is almost the same as 8 bit receive}
Begin
FOR BlockCount:=1 TO NumberOfBlocks DO
Begin
IF BLockCount=NumberOfBlocks THEN
ThisBlockSize:=RealBlockSize+2
ELSE ThisBlockSize:=BlockSize;
{sounds s
tupid but it's an old variable}
REPEAT
CSCOk:=1;
ASM
mov edx,ThisBlockSize {determine number of 16 byte blocks}
mov eax,edx
shr edx,4
and eax,$0F
cmp eax,0
jz @BlockDivideble16
inc edx
@BlockDivideble16:
mov [Tel],edx
lea ebx,FileData {get Address of FileData}
dec ebx {minus 2, 16 bit}
dec ebx
@LoopSendData: {return}
mov ecx,$00FFFFFF
mov dx,ECRAddress
@fifoNotFULL_ReceiveData: {wait for full FIFO and report
stall}
in al,dx
test al,$02
jnz @fifoFULL_ReceiveData
dec ecx
jnz @fifoNotFULL_ReceiveData
mov [Error],1
jmp @end
@fifoFULL_ReceiveData: {receive data in a burst of 16
bytes}
mov cl,$08
mov dx,ecpDFifoAddress
@Loop16Bytes:
inc ebx
inc ebx
in ax,dx
mov [ebx],ax
dec cl
jnz @Loop16Bytes
dec [Tel]
cmp [Tel],0
jnz @LoopSendData {until Tel=0}
lea ebx,FileData {computes checksum}
xor ax,ax
mov ecx,ThisBlockSize
dec ecx
dec ecx
@ChecksumLoop:
xor al,[ebx]
rol ax,1
inc ebx
dec ecx
jnz @CheckSumLoop
mov cx,[ebx] {load cx with cheacksum}
cmp ax,cx {is the computed checksum the same?}
je @end
mov [CSCOk],0 {it is not}
@end:
end;
IF Error=1 THEN
Begin
Label12.Caption:='03 ECP timeout, data transfer
aborted';
ResetPort;
end;
SendCheckSumCheck; {send the checksum compare result}
IF Error=1 THEN
Begin
Label12.Caption:='04 ECP timeout, data transfer
aborted';
ResetPort;
end;
IF CSCOk=0 THEN
begin
Label12.Caption:='Checksum error on block
'+IntToStr(BlockCount
);
Label12.Update;
end;
UNTIL CSCOk<>0;
ProgressBar1.StepIt;
BlockWrite(f,FileData,ThisBlockSize-2);
End;
End;
End;
ProgressBar1.Position:=0;
CloseFile(f);
Label12.Caption:='Data received';
End;
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
IF ComboBox2.ItemIndex=0 THEN
begin
LPTnAddress:=$278;
InitialisePort;
end;
IF ComboBox2.ItemIndex=1 THEN
begin
LPTnAddress:=$378;
InitialisePort;
end;
IF ComboBox2.ItemIndex=2 THEN
begin
LPTnAddress:=$3BC;
InitialisePort;
end;
IF ComboBox2.ItemIndex=-1 THEN ImplementTest:=FALSE;
end;
End.