PureBasic Forums - English

Code: Select all

;Original author: Benubi
;Modified by Inf0Byt3
;http://www.purebasic-lounge.de/viewtopic.php?t=2685

#PB_SendFile_ID="PBMGSFLE"
Structure PB_SendFileHeader
      id.b[8]
      dwlength.l
      filename.s{256}
EndStructure
DataSection
    PB_SendFile_ID:
    Data.s #PB_SendFile_ID
    Data.b 0,0,0
EndDataSection


Procedure Callback(dwCookie,tlen,dwlength)
 
 ProcedureReturn 1
 
EndProcedure

Procedure SendNetworkFileEx(ConnectionID,File$,dwCallBack,dwCookie,dwBuffer)     
  
 Protected TEMP.PB_SendFileHeader,tlen,rlen,result,fh,dwLength
 Protected Dim BUFFER.B(0)

 CopyMemory(?PB_SendFile_ID,@TEMP, SizeOf(PB_SendFileHeader))
 fh = ReadFile(#PB_Any,File$)
 If fh<>0
  If dwBuffer <= 0
   dwBuffer = 1500
  EndIf
     
  Dim BUFFER.B(dwBuffer)
  dwLength = Lof(fh)
  TEMP\dwlength = dwLength
  TEMP\filename = GetFilePart(File$)
  If dwLength >= 0
   SendNetworkData(ConnectionID,@TEMP,SizeOf(PB_SendFileHeader))
   
    While tlen < TEMP\dwlength
     If CallFunctionFast(dwCallBack,dwCookie,tlen,TEMP\dwlength) = #False
       CloseFile(fh)
       Dim BUFFER.B(0)
       ProcedureReturn #False
     EndIf
     rlen = dwBuffer
     If rlen + tlen > TEMP\dwLength
      rlen = TEMP\dwLength - tlen
     EndIf
     FileSeek(fh,tlen)
     ReadData(fh,@BUFFER(0),rlen)
     rlen = SendNetworkData(ConnectionID,@BUFFER(0),rlen)
     If rlen > 0
      tlen + rlen
      result = tlen
     Else
      SleepEx_(1,1)               
     EndIf
    Wend
   
   EndIf
   If IsFile(fh)
    CloseFile(fh)
   EndIf
   CallFunctionFast(dwCallBack,dwCookie,tlen,TEMP\dwlength)
  EndIf
 
  Dim BUFFER.b(0)
  ProcedureReturn result
 
EndProcedure

Procedure ReceiveNetworkFileEx(ConnectionID, Path.s, dwCallBack,dwCookie,dwBuffer)
 
 Protected TEMP.PB_SendFileHeader,result
 Protected tlen,fh,rlen
 Protected Dim BUFFER.B(0)
     
 If Path = ""
  Path = GetCurrentDirectory()
 EndIf
 If Right(Path,1) <> "\"
  Path + "\"
 EndIf
 If dwBuffer<=0
   dwBuffer=1500
 EndIf
 Dim BUFFER.B(dwBuffer)
 
 If ReceiveNetworkData(ConnectionID,@TEMP,SizeOf(PB_SendFileHeader))=SizeOf(PB_SendFileHeader)
  If CompareMemory(@TEMP,?PB_SendFile_ID,Len(#PB_SendFile_ID))             
   fh=CreateFile(#PB_Any,Path+TEMP\filename)
   If fh
   
    While tlen<TEMP\dwlength
     If CallFunctionFast(dwCallBack,dwCookie,Loc(fh),TEMP\dwlength)=#False
      Debug "CALLBACK: CANCEL ReceiveNetworkFileEx"
      Break
     EndIf
     rlen=dwBuffer
     If rlen + tlen > TEMP\dwLength
      rlen = TEMP\dwLength - tlen
     EndIf
     rlen=ReceiveNetworkData(ConnectionID,@BUFFER(0),rlen)
     If rlen>0
      tlen + rlen
      WriteData(fh,@BUFFER(0),rlen)
      FlushFileBuffers(fh)
      result = tlen
     Else
      SleepEx_(1,1)
     EndIf
    Wend
   
   Else
    Debug "Bad id!"
   EndIf
  Else
   Debug "error, bad size"
  EndIf
  If IsFile(fh)
   CloseFile(fh)
  EndIf
  CallFunctionFast(dwCallBack,dwCookie,TEMP\dwlength,TEMP\dwlength)
 Else
  Debug "Error, cannot open file"
 EndIf
 
 Dim BUFFER.b(0)
 ProcedureReturn result
 
EndProcedure