filetransfer.pas

带源程序的免费软件 通过ECP端口在两台电脑间高速传送文件的程序。速度可达到600K/S.

            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-BlockTime1)*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 stupid 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 before 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 file}
                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 stupid 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.