⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 filetransfer.pas

📁 带源程序的免费软件 通过ECP端口在两台电脑间高速传送文件的程序。速度可达到600K/S.
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  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 report 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 bytes of file at once}
            IF BlockCount=1 THEN BlockTime1:=Now; {used to compute block transferrate}
            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 rotate 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 stall}
                    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 transferrate}
        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 stall}
                    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;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -