VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FileTransfer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public FileName As String
Public SenderFN As String
Public RequCommand As String
Public DestPath As String
Public User As String
Public FileSize As Currency
Public ByteCount As Currency
Public tByteCount As Currency
Public PaketSize As Long
Public PeerIP As String
Public PeerPort As Long
Public Speed As Single
Public SendGetMode As Integer
Public State As Integer
Public MaxSpeedUp As Long
Public LastError As String
Public LocalPort As Long
Public DataChanged As Boolean
Public SlowMode As Boolean
Public LocalIP As Double
Public KillAtEnd As Boolean
Public DccID As Integer

Public NoteServer As String
Public NotePort As Long
Public NoteCaption As String
Public NoteCType As String
Public NoteRoom As String

Private Const BUFF_SIZE As Long = 262144
Private Const READ_PACKET_SIZE As Long = 262144
Private PosInFile As Currency
Private TcpipPacketSize As Long

Private SpeedBuffer(7) As Long
Private TimeRefPoint As Single
Private TimePoint As Single
Private LastBC As Currency
Private OFileNumb As Long
Private LastTopCut As Long
Private ProxyState As Integer

Private RBuR As RingBufferClass
Private RBuW As RingBufferClass
Private WithEvents wins As CSocket
Attribute wins.VB_VarHelpID = -1

Public Sub Connect()
  If State > 1 Then Exit Sub
  Set wins = New CSocket
  State = 3
  PosInFile = ByteCount
  'WaitForAccept = False
  SendGetMode = 1
  LastError = ""
  Set RBuR = New RingBufferClass
  RBuR.InitBuffer BUFF_SIZE
  wins.LocalPort = 0
  If SockProxyPortGlob > 0 Then
    wins.Connect SockProxyServerGlob, SockProxyPortGlob
    ProxyState = 1
  Else
    wins.Connect PeerIP, PeerPort
    ProxyState = 0
  End If
  TimePoint = AltTimer + 30
  StartTimer Me, 1000, 1
  RefrDCCFileList Me, True
End Sub

Public Sub OpenPort()
  If State > 1 Then Exit Sub
  Set wins = New CSocket
  State = 2
  SendGetMode = 0
  tByteCount = 0
  PosInFile = ByteCount
  LastError = ""
  Set RBuW = New RingBufferClass
  RBuW.InitBuffer BUFF_SIZE
  Set RBuR = New RingBufferClass
  RBuR.InitBuffer 4
  If StaticDCCPort > 0 Then
    wins.LocalPort = StaticDCCPort
  Else
    StaticDCCPort = 0
  End If
  wins.Listen
  If wins.State = 1 Then wins.LocalPort = 0: wins.Listen
  LocalPort = GetLocalPort(wins.SocketHandle)
  TimePoint = AltTimer + 300
  StartTimer Me, 1000, 1
  RefrDCCFileList Me, True
End Sub

Private Sub Class_Initialize()
  Dim I As Integer
  
  DccID = 1
  Do
    For I = 1 To DCCFileConns.Count
      If DCCFileConns(I).DccID = DccID Then Exit For
    Next
    If I > DCCFileConns.Count Then Exit Do
    DccID = DccID + 1
  Loop
  
  State = 1
  MaxSpeedUp = dccMaxUpSpeed
  PaketSize = dccPaketSize
End Sub

Private Sub Class_Terminate()
  CloseConnection
  If Not AppUnloading Then RemDCCFileList Me
End Sub

Private Sub wins_Closed()
  CloseConnection
End Sub

Private Sub wins_Connected()
  KillTimerByID 1, Me
  State = 4
  If SockProxyPortGlob > 0 Then SendProxyLogin wins, "", PeerIP, PeerPort, SockProxyTypeGlob
  LocalIP = ConvIPtoDouble(GetLocalIP(wins.SocketHandle))
  If SendGetMode = 1 Then
    On Error Resume Next
    If Len(Dir(DestPath + ".dcc")) > 0 And ByteCount = 0 Then Kill DestPath + ".dcc"
    OFileNumb = CreateFile(DestPath + ".dcc", GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ, 0, OPEN_ALWAYS, 0, 0)
    If Err > 0 Then
      LastError = Err.Description
      CloseConnection
    ElseIf OFileNumb = 0 Or OFileNumb = -1 Then
      LastError = mFGetApiErrMsg(Err.LastDllError)
      CloseConnection
    End If
    On Error GoTo 0
  End If
  TimePoint = AltTimer + 180
  StartTimer Me, 30000, 4
  RefrDCCFileList Me, True
  ntScript_Call "Dcc_Connected", CStr(DccID)
End Sub

Public Sub TimerEvent(TimerID As Integer)
  If wins Is Nothing Then Exit Sub
  If TimerID = 1 Then
    If (wins.State <> 2 And wins.State <> 3) Or AltTimeDiff(TimePoint) > 0 Then
      If ByteCount <> FileSize Then
        LastError = TeVal.TimeOut
      End If
      CloseConnection
    Else
      StartTimer Me, 1000, 1
    End If
  ElseIf TimerID = 2 Then
    ReadIncomingData
  ElseIf TimerID = 3 Then
    SendPacketBurst
  ElseIf TimerID = 4 Then
    If AltTimeDiff(TimePoint) > 0 Then
      LastError = TeVal.TimeOut
      CloseConnection
    Else
      StartTimer Me, 30000, 4
    End If
  End If
End Sub

Public Sub CloseConnection()
  KillTimerByID 1, Me
  KillTimerByID 2, Me
  KillTimerByID 3, Me
  KillTimerByID 4, Me
  
  If State = 1 Then Exit Sub
  If wins.State > 1 Then wins.Disconnect
  State = 1
  Speed = 0
  If SendGetMode > 0 Then
    WriteFromRecvBuffer
  End If
  Set wins = Nothing
  If OFileNumb > 0 Then CloseHandle OFileNumb
  If ByteCount > FileSize Then ByteCount = FileSize
  
  Set RBuR = Nothing
  Set RBuW = Nothing
  
  If Not AppUnloading Then RefrDCCFileList Me, True
  If Not DCCFileFrame Is Nothing Then
    If ByteCount = FileSize Then
      If ntScript_Call("Dcc_Complet", CStr(DccID)) Then
        SetAl DCCFileFrame, 4, User, TeVal.DccFinished
      End If
    Else
      If ntScript_Call("Dcc_Error", LastError, CStr(DccID)) Then
        SetAl DCCFileFrame, 4, User, TeVal.DccConnCancel
      End If
    End If
  End If
End Sub

Private Sub wins_ConnectionRequest()
  KillTimerByID 1, Me
  wins.Accept wins
  LocalIP = ConvIPtoDouble(GetLocalIP(wins.SocketHandle))
  PeerIP = wins.RemoteHost
  PeerPort = wins.RemotePort
  ByteCount = tByteCount
  PosInFile = ByteCount
  State = 4
  ProxyState = 0
  OFileNumb = CreateFile(DestPath, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_ALWAYS, 0, 0)
  If OFileNumb = 0 Or OFileNumb = -1 Then
    LastError = mFGetApiErrMsg(Err.LastDllError)
    CloseConnection
  End If
  On Error GoTo 0
  RefrDCCFileList Me, True
  FillLocalSendBuffer
End Sub

Public Sub SetNoteServerPort(CFrame As ChatFrame)
  NoteServer = LCase(CFrame.IrcConn.Server)
  NotePort = CFrame.IrcConn.Port
  NoteCaption = CFrame.IrcConn.Caption
  NoteCType = "IRC://"
  If CFrame.FrameType = cfRoom Then
    NoteRoom = CFrame.Caption
  Else
    NoteRoom = ""
  End If
End Sub

Public Sub RequestFile()
  Dim I As Integer
  Dim I2 As Integer
  Dim I3 As Integer
  Dim LIndex As Integer
  For I = 1 To ChatFrames.Count
    I2 = 0
    If ChatFrames(I).FrameType = cfRoom Then
      If LCase(ChatFrames(I).IrcConn.Server) = NoteServer Then I2 = I2 + 5
      If ChatFrames(I).IrcConn.Port = NotePort Then I2 = I2 + 1
      If ChatFrames(I).IrcConn.Caption = NoteCaption Then I2 = I2 + 2
    End If
    If I2 > I3 Then I3 = I2: LIndex = I
  Next
  If I3 > 4 And State = 1 Then
    OpenPort
    ChatFrames(LIndex).ResendDCCFile User, SenderFN, LocalIP, LocalPort, FileSize
  End If
End Sub

Private Function FillLocalSendBuffer()
  Dim pvLngRet As Long
  Dim outLngRet As Long
  Dim PacketLen As Long
  
  Do While (RBuW.StartDataAdd(READ_PACKET_SIZE) And (PosInFile < FileSize))
    If RBuW.ByteLen + PosInFile > FileSize Then
      PacketLen = FileSize - PosInFile
    Else
      PacketLen = RBuW.ByteLen
    End If
    
    pvLngRet = 0
    outLngRet = extSetFilePointer(OFileNumb, PosInFile)
    If outLngRet Then
      pvLngRet = ReadFile(OFileNumb, RBuW.DataPtr, PacketLen, outLngRet, ByVal 0&)
    End If
    If pvLngRet Then
      PosInFile = PosInFile + PacketLen
      RBuW.DataAdded PacketLen
    Else
      LastError = mFGetApiErrMsg(Err.LastDllError)
      CloseConnection
      Exit Function
    End If
  Loop
End Function

Private Function SendPaket() As Boolean
  Dim I As Long
  Dim I2 As Single
  
  If State < 2 Then Exit Function
  
  If PaketSize = 0 Then
    TcpipPacketSize = 128 + (Speed * 1024) * 0.3
  Else
    TcpipPacketSize = PaketSize
  End If
  
  If RBuW.StartDataRead(TcpipPacketSize) Then
    I = wins.SendDataBin(RBuW.DataPtr, RBuW.ByteLen)
    If I > 0 Then
      RBuW.DataRemove I
      
      If RBuW.UsedBytes < TcpipPacketSize Then FillLocalSendBuffer
      
      SendedBytes = SendedBytes + I
      ByteCount = ByteCount + I
      
      If AltTimeDiff(LastTopCut) < 1 Then
        I2 = AltTimer - TimeRefPoint
        If I2 > 0.0001 Then Speed = (Speed * 5 + ((ByteCount - LastBC) / I2 / 1024) * 5) / 10
        TimeRefPoint = AltTimer
        LastBC = ByteCount
        RefrDCCFileList Me
      Else
        If AltTimeDiff(TimeRefPoint) > 0.2 Then
          I2 = AltTimer - TimeRefPoint
          If I2 > 0.001 Then
            Speed = (ByteCount - LastBC) / I2 / 1024
            I2 = Speed
            For I = 0 To 6
              SpeedBuffer(I) = SpeedBuffer(I + 1)
              I2 = I2 + (SpeedBuffer(I) / 8)
            Next
            If Speed < 10000 Then SpeedBuffer(7) = Speed * 8
            Speed = I2 / 8
          End If
          LastBC = ByteCount
          TimeRefPoint = AltTimer
          RefrDCCFileList Me
        End If
      End If
      SendPaket = True
    Else
      SendPaket = False
    End If
'  Else
'    If ByteCount = FileSize Then
'      CloseConnection
'      If KillAtEnd = True Then On Error Resume Next: Kill DestPath: On Error GoTo 0
'    End If
  End If
End Function

Private Sub SendPacketBurst()
  Dim TimeToWait As Long

  Do While SendPaket
    If SlowMode = True Then
      StartTimer Me, 4000, 3
      Exit Do
    ElseIf Speed * 1.5 > MaxSpeedUp And MaxSpeedUp > 0 Then
      LastTopCut = AltTimer
      TimeToWait = TcpipPacketSize * 1000 / (MaxSpeedUp * 1024)
      If TimeToWait > 1000 Then TimeToWait = 1000
      StartTimer Me, TimeToWait, 3
      Exit Do
    End If
  Loop
End Sub

Private Sub WinS_DataArrival()
  If SlowMode Then
    StartTimer Me, 4000, 2
  Else
    ReadIncomingData
  End If
End Sub

Private Function WriteFromRecvBuffer()
  Dim pvLngRet As Long
  Dim outLngRet As Long
  
  Do While (RBuR.StartDataRead(READ_PACKET_SIZE))
    pvLngRet = 0
    outLngRet = extSetFilePointer(OFileNumb, PosInFile)
    If outLngRet Then
      pvLngRet = WriteFile(OFileNumb, RBuR.DataPtr, RBuR.ByteLen, outLngRet, ByVal 0&)
    End If
    PosInFile = PosInFile + RBuR.ByteLen
    If pvLngRet Then
      RBuR.DataRemove RBuR.ByteLen
    Else
      LastError = mFGetApiErrMsg(Err.LastDllError)
      CloseConnection
      Exit Function
    End If
  Loop
End Function

Private Function ReadIncomingData() As Boolean
  Dim I As Long
  Dim I2 As Single
  
  RBuR.StartDataAdd BUFF_SIZE
  I = wins.ReciveBin(RBuR.DataPtr, RBuR.ByteLen)
  If I > 0 Then
    RBuR.DataAdded I
    RecevedBytes = RecevedBytes + I
    
    'Sockproxy
    If ProxyState = 1 Then
      If RBuR.StartDataRead(8) = 8 Then
        RBuR.DataRemove 8
        ProxyState = 2
      Else
        Exit Function
      End If
    End If
    
    If SendGetMode = 0 Then
      If RBuR.StartDataRead(4) = 4 Then
        If ReadCurrPos = FileSize Then
          CloseConnection
          If KillAtEnd = True Then On Error Resume Next: Kill DestPath: On Error GoTo 0
        End If
      End If
    Else
      ByteCount = ByteCount + I
    
      SendCurrPos
  
      If ByteCount = FileSize Then
        WriteFromRecvBuffer
        If OFileNumb > 0 Then CloseHandle OFileNumb
        
        On Error Resume Next
        If Len(Dir(DestPath)) > 0 Then Kill DestPath
        Name DestPath + ".dcc" As DestPath
        If Err > 0 Then LastError = Err.Description
        On Error GoTo 0
        
        RefrDCCFileList Me, True
        KillTimerByID 4, Me
        TimePoint = AltTimer + 2
        StartTimer Me, 1000, 1
      Else
        If RBuR.UsedBytes + I > RBuR.BufferSize Then WriteFromRecvBuffer
        If AltTimeDiff(TimeRefPoint) > 0.5 Then
          PaketSize = I + 1
          I2 = AltTimer - TimeRefPoint
          If I2 > 0.001 Then
            Speed = (ByteCount - LastBC) / I2 / 1024
            I2 = Speed
            For I = 0 To 6
              SpeedBuffer(I) = SpeedBuffer(I + 1)
              I2 = I2 + (SpeedBuffer(I) / 8)
            Next
            If Speed < 10000 Then SpeedBuffer(7) = Speed * 8
            Speed = I2 / 8
          End If
          TimePoint = AltTimer + 180
          LastBC = ByteCount
          TimeRefPoint = AltTimer
          RefrDCCFileList Me
        End If
      End If
    End If
  End If
End Function

Private Sub SendCurrPos()
      'wins.SendDataBin IntToStr(ByteCount)
      'SendedBytes = SendedBytes + 4
End Sub

Private Function ReadCurrPos() As Currency
  Dim I As Long
  Dim OutSum As Currency
   
  For I = 3 To 0 Step -1
    OutSum = OutSum + RBuR.ReadByte * 256 ^ I
  Next
  ReadCurrPos = OutSum
End Function

Private Sub wins_Error(Error As Long, Description As String)
  If ByteCount < FileSize Then
    LastError = Description
  End If
  CloseConnection
End Sub

Private Sub wins_SendComplete()
  If SendGetMode = 0 Then
    SendPacketBurst
  End If
End Sub
