VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.UserControl ChainCopy 
   Alignable       =   -1  'True
   BackStyle       =   0  'Transparent
   ClientHeight    =   1215
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4335
   MaskColor       =   &H00000000&
   ScaleHeight     =   81
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   289
   Begin Synapsis.MaskImage mImgStatus 
      Height          =   240
      Index           =   2
      Left            =   360
      TabIndex        =   20
      Top             =   765
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   423
      Picture         =   "ChainCopy.ctx":0000
      MaskPicture     =   "ChainCopy.ctx":0352
   End
   Begin Synapsis.MaskImage mImgStatus 
      Height          =   240
      Index           =   1
      Left            =   270
      TabIndex        =   19
      Top             =   765
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   423
      Picture         =   "ChainCopy.ctx":06A4
      MaskPicture     =   "ChainCopy.ctx":09F6
   End
   Begin Synapsis.MaskImage mImgStatus 
      Height          =   240
      Index           =   0
      Left            =   180
      TabIndex        =   18
      Top             =   765
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   423
      Picture         =   "ChainCopy.ctx":0D48
      MaskPicture     =   "ChainCopy.ctx":109A
   End
   Begin Synapsis.MaskImage mImgDeco 
      Height          =   510
      Index           =   0
      Left            =   90
      TabIndex        =   15
      Top             =   540
      Width           =   375
      _ExtentX        =   661
      _ExtentY        =   900
      Picture         =   "ChainCopy.ctx":13EC
      MaskPicture     =   "ChainCopy.ctx":1D3E
   End
   Begin VB.PictureBox Picture1 
      Height          =   915
      Left            =   0
      ScaleHeight     =   57
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   285
      TabIndex        =   9
      Top             =   1305
      Visible         =   0   'False
      Width           =   4335
      Begin VB.PictureBox picStat 
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   2
         Left            =   1170
         Picture         =   "ChainCopy.ctx":2690
         ScaleHeight     =   240
         ScaleWidth      =   240
         TabIndex        =   14
         Top             =   0
         Width           =   240
      End
      Begin VB.PictureBox picStat 
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   3
         Left            =   1440
         Picture         =   "ChainCopy.ctx":29D2
         ScaleHeight     =   240
         ScaleWidth      =   240
         TabIndex        =   13
         Top             =   0
         Width           =   240
      End
      Begin VB.PictureBox picStat 
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   4
         Left            =   1710
         Picture         =   "ChainCopy.ctx":2D14
         ScaleHeight     =   240
         ScaleWidth      =   240
         TabIndex        =   12
         Top             =   0
         Width           =   240
      End
      Begin VB.PictureBox picMain 
         BorderStyle     =   0  'None
         Height          =   480
         Left            =   2520
         Picture         =   "ChainCopy.ctx":3056
         ScaleHeight     =   480
         ScaleWidth      =   360
         TabIndex        =   10
         Top             =   45
         Width           =   360
      End
      Begin VB.PictureBox picStat 
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   1
         Left            =   900
         Picture         =   "ChainCopy.ctx":3998
         ScaleHeight     =   240
         ScaleWidth      =   240
         TabIndex        =   11
         Top             =   0
         Width           =   240
      End
      Begin VB.Timer tmrRefreshData 
         Left            =   450
         Top             =   0
      End
      Begin MSWinsockLib.Winsock wskIn 
         Left            =   0
         Top             =   0
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         LocalPort       =   11000
      End
      Begin MSWinsockLib.Winsock wskOut 
         Left            =   0
         Top             =   450
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         LocalPort       =   11001
      End
   End
   Begin MSComctlLib.ProgressBar pgbIn 
      Height          =   60
      Left            =   855
      TabIndex        =   3
      Top             =   810
      Width           =   870
      _ExtentX        =   1535
      _ExtentY        =   106
      _Version        =   393216
      Appearance      =   0
      Scrolling       =   1
   End
   Begin MSComctlLib.ProgressBar pgbOut 
      Height          =   60
      Left            =   2610
      TabIndex        =   4
      Top             =   810
      Width           =   735
      _ExtentX        =   1296
      _ExtentY        =   106
      _Version        =   393216
      Appearance      =   0
      Scrolling       =   1
   End
   Begin Synapsis.MaskImage mImgDeco 
      Height          =   510
      Index           =   1
      Left            =   2025
      TabIndex        =   16
      Top             =   540
      Width           =   375
      _ExtentX        =   661
      _ExtentY        =   900
      Picture         =   "ChainCopy.ctx":3CDA
      MaskPicture     =   "ChainCopy.ctx":462C
   End
   Begin Synapsis.MaskImage mImgDeco 
      Height          =   510
      Index           =   2
      Left            =   3960
      TabIndex        =   17
      Top             =   540
      Width           =   375
      _ExtentX        =   661
      _ExtentY        =   900
      Picture         =   "ChainCopy.ctx":4F7E
      MaskPicture     =   "ChainCopy.ctx":58D0
   End
   Begin VB.Label lblDir 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   " 888.888.888.888 "
      BeginProperty Font 
         Name            =   "Small Fonts"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   165
      Left            =   45
      TabIndex        =   21
      Top             =   0
      Width           =   1050
   End
   Begin VB.Label lblFile 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   "Just a File Test.exe"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   195
      Left            =   45
      TabIndex        =   8
      Top             =   135
      Width           =   1620
   End
   Begin VB.Label lblDecoMem 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   "1.44MB"
      BeginProperty Font 
         Name            =   "Small Fonts"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   165
      Index           =   0
      Left            =   90
      TabIndex        =   7
      Top             =   1035
      Width           =   495
   End
   Begin VB.Label lblDecoMem 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   "0B"
      BeginProperty Font 
         Name            =   "Small Fonts"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   165
      Index           =   1
      Left            =   2070
      TabIndex        =   6
      Top             =   1035
      Width           =   180
   End
   Begin VB.Label lblDecoMem 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   "0B"
      BeginProperty Font 
         Name            =   "Small Fonts"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   165
      Index           =   2
      Left            =   4095
      TabIndex        =   5
      Top             =   1035
      Width           =   180
   End
   Begin VB.Label lblDecoIP 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   " 888.888.888.888 "
      BeginProperty Font 
         Name            =   "Small Fonts"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   165
      Index           =   2
      Left            =   3180
      TabIndex        =   2
      Top             =   360
      Width           =   1050
   End
   Begin VB.Label lblDecoIP 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   " 888.888.888.888 "
      BeginProperty Font 
         Name            =   "Small Fonts"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   165
      Index           =   1
      Left            =   1635
      TabIndex        =   1
      Top             =   360
      Width           =   1050
   End
   Begin VB.Label lblDecoIP 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      Caption         =   " 888.888.888.888 "
      BeginProperty Font 
         Name            =   "Small Fonts"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   165
      Index           =   0
      Left            =   90
      TabIndex        =   0
      Top             =   360
      Width           =   1050
   End
   Begin VB.Image imgDeco 
      Height          =   45
      Index           =   1
      Left            =   2655
      Picture         =   "ChainCopy.ctx":6222
      Top             =   765
      Width           =   8400
   End
   Begin VB.Image imgDeco 
      Height          =   45
      Index           =   0
      Left            =   855
      Picture         =   "ChainCopy.ctx":7614
      Top             =   765
      Width           =   8400
   End
End
Attribute VB_Name = "ChainCopy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Const def_CommScript = ""
Const def_OutboundError = 0
Const def_LocalError = 0

Event Resize()
Event TransferStart()
Event TransferEnd()

    Enum uTransferMode
    Idle = 0
    Origin = 1
    Destiny = 2
    Node = 3
    Gateway = 4
    End Enum

    Private Type uProcFile
    DestinyPath As String
    Name As String
    Path As String
    Size As Currency
    Ipaddress As String
    Port As Long
    End Type

    Private Type uCompAppLocalTypeDataBag
    PhysicalFileID As Long
    LocalError As String
    LocalFile As uProcFile
    LocalMode As uTransferMode
    LocalReady As Boolean
    InboundFile As uProcFile
    InboundMode As uTransferMode
    InboundReady As Boolean
    InboundStream As String
    InboundLastTick As Long
    OutboundError As String
    OutboundFile As uProcFile
    OutboundMode As uTransferMode
    OutboundReady As Boolean
    OutboundStream As String
    OutboundLastTick As Long
    OutboundSendComplete As Boolean
    CommScript As String
    InstanceIdentifier As String
    Tick As Long
    Errors As Long
    OptionalFileName As String
    End Type

Private CompData As uCompAppLocalTypeDataBag
'Default Property Values:
Const m_def_Transparent = 1
'Property Variables:
Dim m_Transparent As Boolean
Private Sub UserControl_Initialize()
On Error Resume Next
Call CheckStatus
UserControl.wskIn.Bind
UserControl.wskIn.Listen
End Sub
Private Sub UserControl_Resize()
On Error Resume Next

RaiseEvent Resize

Dim uBaseDistance As Long, uColor As OLE_COLOR

    With UserControl
    .Height = 1215
    uColor = .Parent.BackColor
    
        If UserControl.BackStyle = 0 Then
        .lblDir.BackColor = uColor
        .lblFile.BackColor = uColor
        .lblDecoIP(0).BackColor = uColor
        .lblDecoIP(1).BackColor = uColor
        .lblDecoIP(2).BackColor = uColor
        .lblDecoMem(0).BackColor = uColor
        .lblDecoMem(1).BackColor = uColor
        .lblDecoMem(2).BackColor = uColor
        End If
    
    .lblFile.Left = 0
    .lblDir.Left = 0
    
    uBaseDistance = .ScaleWidth / 50

    .mImgDeco(0).Left = 0
    .lblDecoIP(0).Left = 0
    .lblDecoMem(0).Left = 0
    .mImgStatus(0).Top = (.mImgDeco(0).Top + .mImgDeco(0).Height) - .mImgStatus(0).Height
    .mImgStatus(0).Left = (.mImgDeco(0).Left + .mImgDeco(0).Width) - .mImgStatus(0).Width
    
    .mImgDeco(1).Left = (.ScaleWidth - .mImgDeco(1).Width) / 2
    .lblDecoIP(1).Left = (.ScaleWidth - .lblDecoIP(1).Width) / 2
    .lblDecoMem(1).Left = (.ScaleWidth - .lblDecoMem(1).Width) / 2
    .mImgStatus(1).Top = .mImgStatus(0).Top
    .mImgStatus(1).Left = (.mImgDeco(1).Left + .mImgDeco(1).Width) - .mImgStatus(1).Width
    
    .mImgDeco(2).Left = .ScaleWidth - .mImgDeco(2).Width
    .lblDecoIP(2).Left = .ScaleWidth - .lblDecoIP(2).Width
    .lblDecoMem(2).Left = .ScaleWidth - .lblDecoMem(2).Width
    .mImgStatus(2).Top = .mImgStatus(0).Top
    .mImgStatus(2).Left = (.mImgDeco(2).Left + .mImgDeco(2).Width) - .mImgStatus(2).Width
    
    .imgDeco(0).Left = .mImgDeco(0).Width + uBaseDistance / 2
    .imgDeco(0).Width = (.mImgDeco(1).Left - .imgDeco(0).Left) - uBaseDistance
    
    .imgDeco(1).Left = .mImgDeco(1).Left + .mImgDeco(1).Width + uBaseDistance / 2
    .imgDeco(1).Width = (.mImgDeco(2).Left - .imgDeco(1).Left) - uBaseDistance
    
    .pgbIn.Left = .imgDeco(0).Left
    .pgbIn.Width = .imgDeco(0).Width
    
    .pgbOut.Left = .imgDeco(1).Left
    .pgbOut.Width = .imgDeco(1).Width
    End With
    
End Sub
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
On Error GoTo ppgForeColorErr 'EHCG.UID.ppgForeColor

    ForeColor = lblDecoIP(0).ForeColor

Exit Property
ppgForeColorErr:
Err.Raise Err.number, Err.Source, "ppg.ForeColor:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
On Error GoTo pplForeColorErr 'EHCG.UID.pplForeColor

    lblDecoIP(0).ForeColor() = New_ForeColor
    lblDir.ForeColor = lblDecoIP(0).ForeColor
    lblFile.ForeColor = lblDecoIP(0).ForeColor
    lblDecoIP(1).ForeColor = lblDecoIP(0).ForeColor
    lblDecoIP(2).ForeColor = lblDecoIP(0).ForeColor
    lblDecoMem(0).ForeColor = lblDecoIP(0).ForeColor
    lblDecoMem(1).ForeColor = lblDecoIP(0).ForeColor
    lblDecoMem(2).ForeColor = lblDecoIP(0).ForeColor
    PropertyChanged "ForeColor"

Exit Property
pplForeColorErr:
Err.Raise Err.number, Err.Source, "ppl.ForeColor:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Get CommScript() As String
On Error GoTo ppgCommScriptErr 'EHCG.UID.ppgCommScript

    CommScript = CompData.CommScript

Exit Property
ppgCommScriptErr:
Err.Raise Err.number, Err.Source, "ppg.CommScript:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Let CommScript(ByVal New_CommScript As String)
On Error GoTo pplCommScriptErr 'EHCG.UID.pplCommScript

    CompData.CommScript = New_CommScript
    PropertyChanged "CommScript"

Exit Property
pplCommScriptErr:
Err.Raise Err.number, Err.Source, "ppl.CommScript:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Get OutboundError() As String
On Error GoTo ppgOutboundErrorErr 'EHCG.UID.ppgOutboundError

    OutboundError = CompData.OutboundError

Exit Property
ppgOutboundErrorErr:
Err.Raise Err.number, Err.Source, "ppg.OutboundError:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Let OutboundError(ByVal New_OutboundError As String)
On Error GoTo pplOutboundErrorErr 'EHCG.UID.pplOutboundError

    CompData.OutboundError = New_OutboundError
    PropertyChanged "OutboundError"

Exit Property
pplOutboundErrorErr:
Err.Raise Err.number, Err.Source, "ppl.OutboundError:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Get LocalError() As String
On Error GoTo ppgLocalErrorErr 'EHCG.UID.ppgLocalError

    LocalError = CompData.LocalError

Exit Property
ppgLocalErrorErr:
Err.Raise Err.number, Err.Source, "ppg.LocalError:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Let LocalError(ByVal New_LocalError As String)
On Error GoTo pplLocalErrorErr 'EHCG.UID.pplLocalError

    CompData.LocalError = New_LocalError
    PropertyChanged "LocalError"

Exit Property
pplLocalErrorErr:
Err.Raise Err.number, Err.Source, "ppl.LocalError:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Get InboundPort() As Long
Attribute InboundPort.VB_Description = "Returns/Sets the port used on the local computer"
On Error GoTo ppgInboundPortErr 'EHCG.UID.ppgInboundPort

    InboundPort = wskIn.LocalPort

Exit Property
ppgInboundPortErr:
Err.Raise Err.number, Err.Source, "ppg.InboundPort:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Let InboundPort(ByVal New_InboundPort As Long)
On Error GoTo pplInboundPortErr 'EHCG.UID.pplInboundPort

    wskIn.Close
    wskIn.LocalPort = New_InboundPort
    wskIn.Bind
    wskIn.Listen
    PropertyChanged "InboundPort"

Exit Property
pplInboundPortErr:
Err.Raise Err.number, Err.Source, "ppl.InboundPort:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Get RemotePort() As Long
Attribute RemotePort.VB_Description = "Returns/Sets the port to be connected to on the remote computer"
On Error GoTo ppgRemotePortErr 'EHCG.UID.ppgRemotePort

    RemotePort = wskOut.RemotePort

Exit Property
ppgRemotePortErr:
Err.Raise Err.number, Err.Source, "ppg.RemotePort:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Let RemotePort(ByVal New_RemotePort As Long)
On Error GoTo pplRemotePortErr 'EHCG.UID.pplRemotePort

    wskOut.RemotePort() = New_RemotePort
    PropertyChanged "RemotePort"

Exit Property
pplRemotePortErr:
Err.Raise Err.number, Err.Source, "ppl.RemotePort:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Property Get RemoteIP() As String
On Error GoTo ppgRemoteIPErr 'EHCG.UID.ppgRemoteIP

    RemoteIP = wskOut.RemoteHost

Exit Property
ppgRemoteIPErr:
Err.Raise Err.number, Err.Source, "ppg.RemoteIP:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Property
Public Function TransferFile(ByVal uFile As String, ByVal DestinyPath As String, ByVal DestinyIPScript As String, Optional uChunkSize As Long = 2 ^ 18, Optional NewFileName As String, Optional MaintainConnection As Boolean = False) As Boolean
On Error GoTo pfTransferFileErr 'EHCG.UID.pfTransferFile

Dim uFSO As New FileSystemObject, uTempFile As File, uTS As TextStream
Dim uTemp As String, uTemp1 As String, uTemp2 As String, uTemp3 As String, uTempRest As String
Dim uSent As Currency, uAS As String

    If Not uFSO.FileExists(uFile) Then Exit Function
    
    If CompData.LocalMode <> Idle Then Exit Function

CompData.OptionalFileName = NewFileName

Set uTempFile = uFSO.GetFile(uFile)

    With CompData.LocalFile
    .Name = uTempFile.Name
    .Size = uTempFile.Size
    .Path = uFile
    .DestinyPath = DestinyPath
    UserControl.lblFile = .Name
    UserControl.lblDir = .Path
    
    CompData.InboundFile.Name = .Name
    CompData.InboundFile.Size = .Size
    lblDecoMem(0) = ShortMemText(.Size)
    lblDecoMem(1) = ShortMemText(.Size)
    CompData.InboundFile.Path = .DestinyPath
    CompData.InboundFile.DestinyPath = .DestinyPath
    End With

DestinyIPScript = StripLine(DestinyIPScript, "|", uTempRest)

    If Right$(uTempRest, 1) = "|" Then
    uTempRest = Left$(uTempRest, Len(uTempRest) - 1)
    End If


uTemp1 = ParseDataBlock(uTempRest, 0, ":")
uTemp2 = ParseDataBlock(uTempRest, 1, ":")
uTemp3 = ParseDataBlock(uTempRest, 2, ":")

    If uTemp3 = "" Then
    uTemp3 = uTemp2: uTemp2 = uTemp1: uTemp1 = "D"
    End If

CompData.OutboundFile.Ipaddress = uTemp2
CompData.OutboundFile.Port = IIf(uTemp3 = "", 11000, uTemp3)

CompData.CommScript = "-O|" & uTemp1 & IIf(DestinyIPScript <> "", "|", "") & DestinyIPScript
CompData.LocalMode = Origin
CompData.OutboundMode = String2SCode(uTemp1)
CompData.LocalFile.Ipaddress = wskIn.LocalHostName

CheckStatus

Call OutboundSendHeader

CompData.Tick = GetTickCount()

    Do While Not CompData.OutboundReady
    DoEvents

        If (GetTickCount() - CompData.Tick) > 5000 Then 'Woops. Problemas. 5 segs sem nada.
        wskIn.Close
        wskIn.Listen
        wskOut.Close
        ChangeMode Idle
        Exit Function
        End If

    Loop

Call CheckStatus

RaiseEvent TransferStart

    If wskOut.RemoteHost <> "" Then CompData.OutboundFile.Ipaddress = wskOut.RemoteHost

Set uTS = uTempFile.OpenAsTextStream(ForReading)
pgbOut.Min = 0
pgbOut.Max = 100
pgbOut.Value = 0

    Do

        If uTS.AtEndOfStream Then Exit Do

    uAS = uTS.Read(uChunkSize)
    CompData.OutboundSendComplete = False
    UserControl.wskOut.SendData uAS
    CompData.Tick = GetTickCount()
    
        Do While Not CompData.OutboundSendComplete
        DoEvents
    
            If (GetTickCount() - CompData.Tick) > 10000 Then 'Woops. Problemas. 10 segs sem nada.
            wskIn.Close
            wskIn.Listen
            wskOut.Close
            ChangeMode Idle
            Exit Function
            End If
    
        Loop
    
    uSent = uSent + Len(uAS)
    lblDecoMem(2) = ShortMemText(uSent)
    pgbOut.Value = Int((uSent / CompData.InboundFile.Size) * 100)
    DoEvents

    Loop

CompData.Tick = GetTickCount()

    Do While Not CompData.OutboundMode = Idle
    DoEvents

        If (GetTickCount() - CompData.Tick) > 5000 Then 'Woops. Problemas. 5 segs sem nada.
        wskIn.Close
        wskIn.Listen
        wskOut.Close
        ChangeMode Idle
        Exit Function
        End If

    Loop

ChangeMode Idle

    If Not MaintainConnection Then
    wskIn.Close
    wskOut.Close
    End If

RaiseEvent TransferEnd

Exit Function
pfTransferFileErr:
ErrH , "pf.TransferFile:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf & ""

End Function
Private Sub UserControl_InitProperties()
On Error GoTo psUserControl_InitPropertiesErr 'EHCG.UID.psUserControl_InitProperties

    CompData.CommScript = def_CommScript
    CompData.OutboundError = def_OutboundError
    CompData.LocalError = def_LocalError

Exit Sub
psUserControl_InitPropertiesErr:
Err.Raise Err.number, Err.Source, "ps.UserControl_InitProperties:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

    m_Transparent = m_def_Transparent
End Sub
Private Sub ErrH(Optional PName As String, Optional SPlace As String, Optional Ent As Integer, Optional ShowWindow As Boolean = True)
Dim lMsg As String

If PName = "" Then PName = App.ProductName & " code library"

CompData.Errors = CompData.Errors + 1
    
lMsg = ""

lMsg = "Um erro foi detectado pelo sistema e não gerenciado, e a atenção do usuário é requerida para que a manutenção do procedimento seja realizada." & vbCrLf & vbCrLf & _
 "Módulo " & Chr$(34) & PName & Chr$(34) & ", procedimento " & Chr$(34) & SPlace & Chr$(34) & ";" & vbCrLf & _
 "Código de erro " & Err.number & ", " & Chr$(34) & Err.Description & IIf(Right$(Err.Description, 1) = ".", "", ".") & Chr$(34) & vbCrLf & vbCrLf & _
 "Fonte do código de erro: " & Err.Source & "." & vbCrLf & vbCrLf & vbCrLf & _
 "Anote este Valores para fins de reparo no sistema, e contacte o suporte a este produto."

SysLog "Erro em " & Chr$(34) & PName & Chr$(34) & ", procedure " & _
Chr$(34) & SPlace & Chr$(34) & ": Código " & Err.number & ", " & Chr$(34) & Err.Description & _
IIf(Right$(Err.Description, 1) = ".", "", ".") & " - Fonte: " & Err.Source & "."

If ShowWindow Then

    If MsgBox(lMsg, vbMsgBoxHelpButton & vbOKCancel, "Módulo de tratamento de erros: " & App.Title, Err.HelpFile, Err.HelpContext) = vbCancel Then
    Stop
    End If
    
End If
    
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
On Error Resume Next

    lblDecoIP(0).ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
    lblDir.ForeColor = lblDecoIP(0).ForeColor
    lblFile.ForeColor = lblDecoIP(0).ForeColor
    lblDecoIP(1).ForeColor = lblDecoIP(0).ForeColor
    lblDecoIP(2).ForeColor = lblDecoIP(0).ForeColor
    lblDecoMem(0).ForeColor = lblDecoIP(0).ForeColor
    lblDecoMem(1).ForeColor = lblDecoIP(0).ForeColor
    lblDecoMem(2).ForeColor = lblDecoIP(0).ForeColor
    CompData.CommScript = PropBag.ReadProperty("CommScript", def_CommScript)
    CompData.OutboundError = PropBag.ReadProperty("OutboundError", def_OutboundError)
    CompData.LocalError = PropBag.ReadProperty("LocalError", def_LocalError)
    wskIn.Close
    wskIn.LocalPort = PropBag.ReadProperty("InboundPort", 0)
    wskIn.Bind
    wskIn.Listen
    wskOut.RemotePort = PropBag.ReadProperty("RemotePort", 0)
    m_Transparent = PropBag.ReadProperty("Transparent", m_def_Transparent)
    UserControl.BackStyle = (Not m_Transparent) * -1
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
    
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
On Error GoTo psUserControl_WritePropertiesErr 'EHCG.UID.psUserControl_WriteProperties

    Call PropBag.WriteProperty("ForeColor", lblDecoIP(0).ForeColor, &H80000008)
    Call PropBag.WriteProperty("CommScript", CompData.CommScript, def_CommScript)
    Call PropBag.WriteProperty("OutboundError", CompData.OutboundError, def_OutboundError)
    Call PropBag.WriteProperty("LocalError", CompData.LocalError, def_LocalError)
    Call PropBag.WriteProperty("InboundPort", wskIn.LocalPort, 0)
    Call PropBag.WriteProperty("RemotePort", wskOut.RemotePort, 0)
    Call PropBag.WriteProperty("Transparent", m_Transparent, m_def_Transparent)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H80000005)

Exit Sub
psUserControl_WritePropertiesErr:
Err.Raise Err.number, Err.Source, "ps.UserControl_WriteProperties:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext
End Sub
Private Sub CheckStatus()
On Error GoTo psCheckStatusErr 'EHCG.UID.psCheckStatus

Dim bIn As Boolean, bLocal As Boolean, bRemote As Boolean

    With UserControl

        Select Case CompData.InboundMode
        Case uTransferMode.Node, uTransferMode.Gateway, uTransferMode.Origin
        bIn = True
        Set .mImgStatus(0).Picture = picStat(CompData.InboundMode).Picture

        Case Else
        bIn = False

        End Select


        Select Case CompData.LocalMode
        Case uTransferMode.Destiny, uTransferMode.Gateway, uTransferMode.Node, uTransferMode.Origin
        bLocal = True
        Set .mImgStatus(1).Picture = picStat(CompData.LocalMode).Picture

        Case Else
        bLocal = False

        End Select


        Select Case CompData.OutboundMode
        Case uTransferMode.Destiny, uTransferMode.Gateway, uTransferMode.Node
        bRemote = True
        Set .mImgStatus(2).Picture = picStat(CompData.OutboundMode).Picture

        Case Else
        bRemote = False

        End Select

    .mImgDeco(0).Visible = bIn
    .mImgStatus(0).Visible = bIn
    .imgDeco(0).Visible = bIn
    .lblDecoIP(0).Visible = bIn
    .lblDecoMem(0).Visible = bIn
    .lblDecoMem(0) = ShortMemText(CompData.InboundFile.Size)
    .lblDecoIP(0) = CompData.InboundFile.Ipaddress

    .pgbIn.Visible = bIn

    .mImgStatus(1).Visible = bLocal
    .lblDecoIP(1).Visible = bLocal
    .lblDecoMem(1).Visible = bLocal
    .lblFile.Visible = bLocal
    .lblDir.Visible = bLocal
    .lblDecoMem(1) = ShortMemText(CompData.LocalFile.Size)
    .lblDecoIP(1) = CompData.LocalFile.Ipaddress

    .mImgDeco(2).Visible = bRemote
    .mImgStatus(2).Visible = bRemote
    .imgDeco(1).Visible = bRemote
    .lblDecoIP(2).Visible = bRemote
    .lblDecoMem(2).Visible = bRemote
    .pgbOut.Visible = bRemote
    .lblDecoMem(2) = ShortMemText(CompData.OutboundFile.Size)
    .lblDecoIP(2) = CompData.OutboundFile.Ipaddress

    End With

Exit Sub
psCheckStatusErr:
Err.Raise Err.number, Err.Source, "ps.CheckStatus:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Sub wskIn_Close()
On Error GoTo pswskIn_CloseErr 'EHCG.UID.pswskIn_Close

wskIn.Close
wskIn.Bind
wskIn.Listen
wskOut.Close

Exit Sub
pswskIn_CloseErr:
ErrH , "ps.wskIn_Close:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf & ""

End Sub
Private Sub wskIn_ConnectionRequest(ByVal requestID As Long)
On Error GoTo pswskIn_ConnectionRequestErr 'EHCG.UID.pswskIn_ConnectionRequest

wskIn.Close
wskIn.Accept requestID

Exit Sub
pswskIn_ConnectionRequestErr:
ErrH , "ps.wskIn_ConnectionRequest:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf & ""

End Sub
Private Sub wskIn_DataArrival(ByVal bytesTotal As Long)
On Error GoTo pswskIn_DataArrivalErr 'EHCG.UID.pswskIn_DataArrival

Dim uInput As String
wskIn.GetData uInput, , bytesTotal
CompData.InboundStream = CompData.InboundStream & uInput

Call ProccessInput

Exit Sub
pswskIn_DataArrivalErr:
ErrH , "ps.wskIn_DataArrival:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf & ""

End Sub
Private Sub wskOut_Close()
On Error GoTo pswskOut_CloseErr 'EHCG.UID.pswskOut_Close

wskOut.Close
CompData.OutboundMode = Idle

Exit Sub
pswskOut_CloseErr:
ErrH , "ps.wskOut_Close:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf & ""

End Sub
Private Sub wskOut_DataArrival(ByVal bytesTotal As Long)
On Error GoTo pswskOut_DataArrivalErr 'EHCG.UID.pswskOut_DataArrival

Dim uInput As String
wskOut.GetData uInput, , bytesTotal
CompData.OutboundStream = CompData.OutboundStream & uInput
Call ProccessOutput

Exit Sub
pswskOut_DataArrivalErr:
ErrH , "ps.wskOut_DataArrival:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf & ""

End Sub
Private Sub ProccessInput()
On Error GoTo psProccessInputErr 'EHCG.UID.psProccessInput

Dim uTmp As String, uTS As TextStream

    If CompData.LocalReady = False Then
    CompData.InboundFile.Ipaddress = IIf(wskIn.RemoteHost <> "", wskIn.RemoteHost, wskIn.RemoteHostIP)
    CompData.LocalFile.Ipaddress = wskIn.LocalHostName

        Do

            If InStr(CompData.InboundStream, vbCrLf) = 0 Then
            Exit Do
            End If

        CompData.InboundStream = StripLine(CompData.InboundStream, vbCrLf, uTmp)
        Call ProccessInputHeader(uTmp)

        Loop

    Else

        If CompData.LocalFile.Size < CompData.InboundFile.Size Then
        CompData.LocalFile.Size = CompData.LocalFile.Size + Len(CompData.InboundStream)
        UserControl.pgbIn.Value = Int((CompData.LocalFile.Size / CompData.InboundFile.Size) * 100)
        lblDecoMem(1) = ShortMemText(CompData.LocalFile.Size)

            If CompData.InboundMode = Gateway Then
            lblDecoMem(0) = ShortMemText(CompData.LocalFile.Size)
            End If

            If CompData.LocalMode = Node Or CompData.LocalMode = Destiny Then
            Print #CompData.PhysicalFileID, CompData.InboundStream;

            End If

            If CompData.LocalMode = Gateway Or CompData.LocalMode = Node Then
            'CompData.OutboundSendComplete = False
            'CompData.Tick = GetTickCount()
            OutboundSend CompData.InboundStream
            
            '    Do While Not CompData.OutboundSendComplete
            '    DoEvents
            
            '        If (GetTickCount() - CompData.Tick) > 10000 Then 'Woops. Problemas. 10 segs sem nada.
            '        wskIn.Close
            '        wskIn.Listen
            '        wskOut.Close
            '        ChangeMode Idle
            '        Exit Sub
            '        End If
            
            '    Loop
            
            UserControl.pgbOut.Value = Int((CompData.LocalFile.Size / CompData.InboundFile.Size) * 100)
            lblDecoMem(2) = ShortMemText(CompData.LocalFile.Size)


            End If

        CompData.InboundStream = ""

        End If

        If CompData.LocalFile.Size = CompData.InboundFile.Size Then

            If CompData.LocalMode = Destiny Then
            ChangeMode Idle 'Pois é. Cópia terminada, é só fechar o canal.

            Else

            CompData.Tick = GetTickCount()

                Do While Not CompData.OutboundMode = Idle 'Esperando o nó remoto retornar ao estado Idle.
                DoEvents

                    If (GetTickCount() - CompData.Tick) > 30000 Then 'Woops. Problemas. 30 segs sem nada.
                    wskIn.Close
                    wskIn.Listen
                    wskOut.Close
                    ChangeMode Idle
                    Exit Sub
                    End If

                Loop

            RaiseEvent TransferEnd

            ChangeMode Idle 'Ok, o nó remoto retornou um status OK. Presto! Vamos fechar o nosso, também.

            End If


        End If

    End If

Exit Sub
psProccessInputErr:
Err.Raise Err.number, Err.Source, "ps.ProccessInput:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Sub ProccessOutput()
On Error GoTo psProccessOutputErr 'EHCG.UID.psProccessOutput

Dim uTmp As String

If InStr(CompData.OutboundStream, vbCrLf) = 0 Then
Exit Sub
End If

CompData.OutboundStream = StripLine(CompData.OutboundStream, vbCrLf, uTmp)

    If Not CompData.OutboundReady Then
    CompData.OutboundReady = True

    Else
    CompData.OutboundReady = False
    CompData.OutboundMode = Idle

        With CompData.OutboundFile
        .DestinyPath = ""
        .Ipaddress = ""
        .Name = ""
        .Path = ""
        .Port = 0
        .Size = 0
        End With

    End If

Exit Sub
psProccessOutputErr:
Err.Raise Err.number, Err.Source, "ps.ProccessOutput:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Sub ChangeMode(ByVal uMode As uTransferMode)
'On Error GoTo psChangeModeErr 'EHCG.UID.psChangeMode
On Error Resume Next

    Select Case uMode
    Case uTransferMode.Idle

        If CompData.LocalMode <> Idle Then

            If CompData.LocalMode = Destiny Or CompData.LocalMode = Node Then
            Close #CompData.PhysicalFileID
            End If

            If CompData.LocalMode <> Origin Then
            InboundSend "OK" & vbCrLf
            'UserControl.wskIn.Close
            End If

        Call ClearVars

        'UserControl.wskIn.Close
        UserControl.wskIn.Bind
        UserControl.wskIn.Listen
        End If

    End Select

CheckStatus

Exit Sub
psChangeModeErr:
Err.Raise Err.number, Err.Source, "ps.ChangeMode:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Sub ProccessInputHeader(ByVal uText As String)
On Error GoTo psProccessInputHeaderErr 'EHCG.UID.psProccessInputHeader

Dim uTmp As String, uTmp2 As String
Dim uParm1 As String, uParm2 As String, uParm3 As String, uFSO As New FileSystemObject

uText = StripLine(uText, ":", uTmp)

    Select Case UCase(uTmp)
    Case "FILE:"

        With CompData.InboundFile
        .Name = ParseDataBlock(uText, 0, "|")
        .Path = ParseDataBlock(uText, 1, "|")
        .Size = ParseDataBlock(uText, 2, "|")
        End With

    CompData.LocalFile.Name = CompData.InboundFile.Name
    CompData.LocalFile.Path = CompData.InboundFile.Path

    Case "CONNSTRING:"

    uTmp = StripLine(uText, "|", uTmp2)
    If Right$(uTmp, 1) = "|" Then uTmp = Left$(uTmp, Len(uTmp) - 1)
    uTmp2 = Left$(uTmp2, Len(uTmp2) - 1)

        If Left$(uTmp2, 1) = "-" Then 'Opa - informação do nó antigo. Vamos ver do que se trata.
        uTmp2 = Right$(uTmp2, 1)
        CompData.InboundMode = String2SCode(uTmp2)
        uTmp = StripLine(uTmp, "|", uTmp2)

            If Right$(uTmp, 1) = "|" Then uTmp = Left$(uTmp, Len(uTmp) - 1)

        uTmp2 = Left$(uTmp2, Len(uTmp2) - 1)
        End If


        If Len(uTmp2) = 1 Then 'Identificação do estado do próprio nó. Tratando...
        CompData.LocalMode = String2SCode(uTmp2)
        uTmp = StripLine(uTmp, "|", uTmp2)

            If Right$(uTmp, 1) = "|" Then uTmp = Left$(uTmp, Len(uTmp) - 1)

        uTmp2 = Left$(uTmp2, Len(uTmp2) - 1)
        End If


        If uTmp2 = "" Then 'Não tem ninguém mais na fila; Este é o ponto final.

        Else
        uParm1 = ParseDataBlock(uTmp2, 0, ":")
        uParm2 = ParseDataBlock(uTmp2, 1, ":")
        uParm3 = ParseDataBlock(uTmp2, 2, ":")

        CompData.OutboundMode = String2SCode(uParm1)
        CompData.OutboundFile.Ipaddress = uParm2
        CompData.OutboundFile.Port = uParm3

        CompData.OutboundFile.Name = CompData.InboundFile.Name
        CompData.OutboundFile.Path = CompData.InboundFile.Path

        uTmp2 = Right$(uTmp2, Len(uTmp2) - Len(uParm1 & ":" & uParm2 & ":" & uParm3))

            If Left$(uTmp2, 1) = "|" Then uTmp2 = Right$(uTmp2, Len(uTmp2) - 1)

        CompData.CommScript = "-" & SCode2String(CompData.LocalMode) & "|" & SCode2String(CompData.OutboundMode) & "|" & uTmp

        End If

    End Select


    If Not ((CompData.LocalMode <> uTransferMode.Idle) And (CompData.InboundFile.Name <> "")) Then 'Dados do cabeçalho ainda incompletos. Esperar o próximo lote.
    Exit Sub
    End If

    CheckStatus

'Neste momento, temos todos os dados necessários: Script de conexão e descrição do arquivo. Vamos para o próximo passo: Conexão (caso
'   necessária) com o Outbound e aviso que estamos prontos.

    If CompData.LocalMode = Destiny Or CompData.LocalMode = Node Then
        If Not uFSO.FolderExists(CompData.LocalFile.Path) Then CreateFolder CompData.LocalFile.Path
    CompData.PhysicalFileID = FreeFile()
    
        If uFSO.FileExists(CompData.LocalFile.Path & "\" & CompData.LocalFile.Name) Then
        uFSO.DeleteFile CompData.LocalFile.Path & "\" & CompData.LocalFile.Name, True
        End If
    
    Open CompData.LocalFile.Path & "\" & CompData.LocalFile.Name For Output As CompData.PhysicalFileID
    End If

lblFile = CompData.LocalFile.Name
lblDir = CompData.LocalFile.Path

    With UserControl.pgbIn
    .Min = 0
    .Max = 100
    .Value = 0
    End With

    With UserControl.pgbOut
    .Min = 0
    .Max = 100
    .Value = 0
    End With

    If (CompData.OutboundMode <> uTransferMode.Idle) Then 'Mandar o material para o próximo nó.
    Call OutboundSendHeader

    CompData.Tick = GetTickCount()

        Do While Not CompData.OutboundReady
        DoEvents

            If (GetTickCount() - CompData.Tick) > 5000 Then 'Woops. Problemas. 5 segs sem nada.
            wskIn.Close
            wskIn.Listen
            wskOut.Close
            ChangeMode Idle
            Exit Sub
            End If

        Loop

    End If

'Pronto. O link final já disse que está tudo bem, e que ele pode receber. Vamos liberar o trânsito.

CompData.LocalReady = True

RaiseEvent TransferStart
CheckStatus

InboundSend "OK" & vbCrLf

Exit Sub
psProccessInputHeaderErr:
Err.Raise Err.number, Err.Source, "ps.ProccessInputHeader:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Function SCode2String(ByVal uMode As uTransferMode) As String
On Error GoTo pfSCode2StringErr 'EHCG.UID.pfSCode2String

    Select Case uMode
    Case uTransferMode.Destiny: SCode2String = "D"
    Case uTransferMode.Gateway: SCode2String = "G"
    Case uTransferMode.Node: SCode2String = "N"
    Case uTransferMode.Origin: SCode2String = "O"
    End Select

Exit Function
pfSCode2StringErr:
Err.Raise Err.number, Err.Source, "pf.SCode2String:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Function
Private Function String2SCode(ByVal uMode As String) As uTransferMode
On Error GoTo pfString2SCodeErr 'EHCG.UID.pfString2SCode

    Select Case UCase(uMode)
    Case "G": String2SCode = Gateway
    Case "N": String2SCode = Node
    Case "D": String2SCode = Destiny
    Case "O": String2SCode = Origin
    End Select

Exit Function
pfString2SCodeErr:
Err.Raise Err.number, Err.Source, "pf.String2SCode:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Function
Private Sub OutboundSend(uParm As String)
On Error GoTo psOutboundSendErr 'EHCG.UID.psOutboundSend

CheckOutboundConnection
UserControl.wskOut.SendData uParm

Exit Sub
psOutboundSendErr:
Err.Raise Err.number, Err.Source, "ps.OutboundSend:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Sub InboundSend(uParm As String)
On Error Resume Next

UserControl.wskIn.SendData uParm

End Sub
Private Sub OutboundSendHeader()
On Error GoTo psOutboundSendHeaderErr 'EHCG.UID.psOutboundSendHeader

Call CheckOutboundConnection

OutboundSend "FILE:" & IIf(CompData.OptionalFileName <> "", CompData.OptionalFileName, CompData.InboundFile.Name) & "|" & CompData.InboundFile.Path & "|" & CompData.InboundFile.Size & vbCrLf
OutboundSend "CONNSTRING:" & CompData.CommScript & vbCrLf

Exit Sub
psOutboundSendHeaderErr:
Err.Raise Err.number, Err.Source, "ps.OutboundSendHeader:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Sub CheckOutboundConnection()
On Error GoTo psCheckOutboundConnectionErr 'EHCG.UID.psCheckOutboundConnection

    With UserControl.wskOut

        If .State <> 7 Then
        .Close
        Randomize
        .LocalPort = Rnd(1) * 65535
        .RemoteHost = CompData.OutboundFile.Ipaddress
        .RemotePort = CompData.OutboundFile.Port
        .Connect
        End If

    CompData.Tick = GetTickCount()

        Do While .State <> 7 'Esperando conectar...
        DoEvents

            If (GetTickCount() - CompData.Tick) > 5000 Then 'Woops. Problemas. 5 segs sem nada.
            wskIn.Close
            wskIn.Listen
            wskOut.Close
            ChangeMode Idle
            Exit Sub
            End If

        Loop

    End With

Exit Sub
psCheckOutboundConnectionErr:
Err.Raise Err.number, Err.Source, "ps.CheckOutboundConnection:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Sub SysLog(ByVal M)
On Error GoTo 0

Dim N As Long
N = FreeFile()
Open CompData.InstanceIdentifier & ".txt" For Append As #N
Print #N, Now(), M
Close #N

End Sub
Private Sub InitializeInstanceIdentifier()
On Error GoTo sInitializeInstanceIdentifierErr 'EHCG.UID.sInitializeInstanceIdentifier

CompData.InstanceIdentifier = App.ProductName & "-" & Year(Now) & "." & Right$("0" & Month(Now), 2) & "." & Right$("0" & Day(Now), 2) & "." & Right$("0" & Hour(Now), 2) & Right$("0" & Minute(Now), 2)

Exit Sub
sInitializeInstanceIdentifierErr:
Err.Raise Err.number, Err.Source, "s.InitializeInstanceIdentifier:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Function StripLine(ByVal OldText As String, Optional uChar As String, Optional StrippedLine As String, Optional IntrinsicSearch As String) As String
On Error GoTo fStripLineErr 'EHCG.UID.fStripLine

StrippedLine = ""

Dim uRes As Integer, Pointer As Long, uOutput As String
Dim ubAddedChar As Boolean

    If IntrinsicSearch <> "" Then
    Pointer = InStr(OldText, IntrinsicSearch)

        If Pointer = 0 Then
        StripLine = OldText
        Exit Function
        End If

    End If

    If uChar = "" Then
    OldText = Replace(OldText, Chr$(13), Chr$(10))
    uChar = Chr$(10)
    End If

    If Right$(OldText, 1) <> uChar Then
    OldText = OldText & uChar
    ubAddedChar = True
    End If

uRes = InStr(IIf(Pointer = 0, 1, Pointer), OldText, uChar)

    If uRes Then

        If Pointer <> 0 Then
        Pointer = Pointer - InStr(StrReverse(Left$(OldText, Pointer - 1)), uChar) - 1
        uOutput = Left$(OldText, Pointer)
        End If

        If Right$(uOutput, 1) <> uChar And Pointer <> 0 Then Add uOutput, uChar

    Add uOutput, Right$(OldText, Len(OldText) - uRes)

    StrippedLine = Mid$(OldText, IIf(Pointer <> 0, Pointer + 1, 1), uRes - Pointer)
    StrippedLine = Replace(StrippedLine, Chr$(10), "")
    StrippedLine = Replace(StrippedLine, Chr$(13), "")

    Else
    StrippedLine = OldText

    End If

   If Left$(uOutput, 1) = Chr$(13) Or Left$(uOutput, 1) = Chr$(10) Then
   uOutput = Right$(uOutput, Len(uOutput) - 1)
   End If


    If ubAddedChar Then

        If Right$(uOutput, Len(uChar)) = uChar Then
        uOutput = Left$(uOutput, Len(uOutput) - Len(uChar))
        ubAddedChar = False
        End If

    End If

StripLine = uOutput

Exit Function
fStripLineErr:
Err.Raise Err.number, Err.Source, "f.StripLine:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Function
Private Function ParseDataBlock(ByVal DATABlock As String, ByVal Index As Integer, Optional Char As String) As String
On Error GoTo ParseDataBlock_Err

Dim Counter As Integer, Mark1 As Integer, Mark2 As Integer, intBuffer As Integer, strBuffer As String

If Char = "" Then Char = Chr$(0)

    For Counter = 0 To Index
    intBuffer = InStr(Mid$(DATABlock, Mark2 + 1), Char)
    
        If intBuffer > 0 Then
        Mark2 = Mark2 + intBuffer + Len(Char) - 1
        strBuffer = Mid$(DATABlock, Mark1 + 1, (Mark2 - Mark1) - 1 - (Len(Char) - 1))
        Mark1 = Mark2

        Else
        strBuffer = Mid$(DATABlock, Mark1 + 1)
        Mark1 = Mark1 + Len(strBuffer)
        
        End If
            
    Next Counter

ParseDataBlock = strBuffer

Exit Function
ParseDataBlock_Err:
ErrH App.ProductName & " code library", "Function ParseDataBlock"
Exit Function
End Function
Private Sub Add(ByRef ParmA As Variant, ByVal ParmB As Variant, Optional Inverse As Boolean = False)
On Error GoTo sAddErr 'EHCG.UID.sAdd

    If Inverse Then
    ParmA = ParmB + ParmA

    Else
    ParmA = ParmA + ParmB

    End If

Exit Sub
sAddErr:
Err.Raise Err.number, Err.Source, "s.Add:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Sub
Private Function CreateFolder(ByVal uPath As String)
On Error GoTo pfCreateFolderErr 'EHCG.UID.pfCreateFolder

Dim uTmp As String, uFSO As New FileSystemObject, uCounter As Byte, uTmp2 As String

    Do

        If uTmp <> "" Then uTmp = uTmp & "\"

    uTmp2 = ParseDataBlock(uPath, uCounter, "\")

        If uTmp2 = "" Then Exit Do

    uTmp = uTmp & uTmp2

        If InStr(uTmp, "\") <> 0 Then

            If Not uFSO.FolderExists(uTmp) Then uFSO.CreateFolder uTmp

        End If

    uCounter = uCounter + 1
    Loop

Exit Function
pfCreateFolderErr:
Err.Raise Err.number, Err.Source, "pf.CreateFolder:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext

End Function
Private Sub ClearVars()
On Error GoTo psClearVarsErr 'EHCG.UID.psClearVars

    With CompData
    .CommScript = ""
    .InboundMode = Idle
    .InboundReady = False
    .InboundStream = ""
    .InstanceIdentifier = ""
    .LocalError = ""
    .LocalMode = Idle
    .LocalReady = False
    .OutboundError = ""
    .OutboundMode = Idle
    .OutboundReady = False
    .OutboundStream = ""
    .PhysicalFileID = 0
    End With

    With CompData.InboundFile
    .DestinyPath = ""
    .Ipaddress = ""
    .Name = ""
    .Path = ""
    .Port = 0
    .Size = 0
    End With

    With CompData.LocalFile
    .DestinyPath = ""
    .Ipaddress = ""
    .Name = ""
    .Path = ""
    .Port = 0
    .Size = 0
    End With

    With CompData.OutboundFile
    .DestinyPath = ""
    .Ipaddress = ""
    .Name = ""
    .Path = ""
    .Port = 0
    .Size = 0
    End With

Exit Sub
psClearVarsErr:
Err.Raise Err.number, Err.Source, "ps.ClearVars:" & vbCrLf & "Error: " & Err.number & vbCrLf & "Description: " & Err.Description & vbCrLf, Err.HelpFile, Err.HelpContext
End Sub
Public Property Get Transparent() As Boolean
Transparent = m_Transparent
End Property
Public Property Let Transparent(ByVal New_Transparent As Boolean)
    m_Transparent = New_Transparent
    PropertyChanged "Transparent"
    UserControl.BackStyle = (Not m_Transparent) * -1
End Property
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property
Private Sub wskOut_SendComplete()
CompData.OutboundSendComplete = True
End Sub
Public Sub SyncDir(ByVal uFolder As String, uFolderBase As String, uDestinyFolder As String, uConnectionScript As String)
Dim uFSO As New FileSystemObject, uDir As Folder, uFile As File, uSetDir As Folder, uResetDir As Folder

    If Not uFSO.FolderExists(uFolder) Then Exit Sub
    If Not uFSO.FolderExists(uFolderBase) Then Exit Sub

Set uSetDir = uFSO.GetFolder(uFolder)
Set uResetDir = uFSO.GetFolder(uFolderBase)

    For Each uDir In uSetDir.SubFolders
    SyncDir uDir.Path, uFolderBase, uDestinyFolder, uConnectionScript
    Next uDir
    
    For Each uFile In uSetDir.Files
    TransferFile uFile.Path, uDestinyFolder & Right$(uSetDir.Path, Len(uSetDir.Path) - Len(uResetDir.Path)), uConnectionScript, , , True
    Next uFile

End Sub

