filetransfer.pas

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

{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 this
                      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 used 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 attribute of a file}
begin
  NoFile:=FALSE;
  AttrByte:=0;
  Edit1.Text:=ExtractRelativePath(ExtractFileDir(FileListBox1.FileName)+'\', FileListBox1.FileName);
  Edit1.OEMConvert:=TRUE;
  fname:=Edit1.Text;
  NameString:=Edit1.Text;
  AttrByte:=FileGetAttr(fname);

  AssignFile(f,fname);