VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.OCX"
Begin VB.UserControl FTPCopy 
   ClientHeight    =   10230
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15120
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   9.75
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ScaleHeight     =   10230
   ScaleWidth      =   15120
   Begin MSComctlLib.ImageList img_pictList 
      Left            =   5640
      Top             =   9360
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   393216
   End
   Begin VB.Frame frm_frames 
      Caption         =   "Select files that need to be copied from server to your PC"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   9075
      Index           =   1
      Left            =   1305
      TabIndex        =   8
      Tag             =   "Config"
      Top             =   465
      Width           =   12255
      Begin VB.TextBox txt_serverPath 
         Height          =   375
         Left            =   300
         Locked          =   -1  'True
         TabIndex        =   37
         Text            =   "Text1"
         Top             =   8160
         Width           =   4155
      End
      Begin MSComctlLib.ListView lvw_copyFiles 
         Height          =   2655
         Left            =   5040
         TabIndex        =   32
         Top             =   4980
         Width           =   6795
         _ExtentX        =   11986
         _ExtentY        =   4683
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         HideColumnHeaders=   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         NumItems        =   1
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Object.Width           =   11889
         EndProperty
      End
      Begin MSComctlLib.ListView lvw_serverFiles 
         Height          =   5055
         Left            =   240
         TabIndex        =   31
         Top             =   2580
         Width           =   4215
         _ExtentX        =   7435
         _ExtentY        =   8916
         View            =   3
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         FullRowSelect   =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         NumItems        =   2
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Text            =   "File"
            Object.Width           =   4940
         EndProperty
         BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            SubItemIndex    =   1
            Text            =   "Size"
            Object.Width           =   1587
         EndProperty
      End
      Begin VB.TextBox txt_server 
         Height          =   375
         Left            =   240
         Locked          =   -1  'True
         TabIndex        =   30
         Text            =   "Text1"
         Top             =   1560
         Width           =   4215
      End
      Begin VB.DirListBox dir_output 
         Appearance      =   0  'Flat
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1890
         Left            =   5040
         TabIndex        =   21
         Top             =   2520
         Width           =   4335
      End
      Begin VB.TextBox txt_texts 
         BackColor       =   &H00000000&
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   8415
         Left            =   4680
         TabIndex        =   20
         Top             =   420
         Width           =   180
      End
      Begin VB.CommandButton btn_saveConfig 
         Caption         =   "Save Configuration"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   6240
         TabIndex        =   12
         Top             =   7920
         Width           =   2655
      End
      Begin VB.CommandButton btn_exitConfig 
         Caption         =   "Exit Configuration"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   9120
         TabIndex        =   11
         Top             =   7920
         Width           =   2535
      End
      Begin VB.CommandButton btn_help 
         Caption         =   "Help"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   5040
         TabIndex        =   10
         Top             =   7920
         Width           =   735
      End
      Begin VB.DriveListBox drvlistO 
         Appearance      =   0  'Flat
         Height          =   360
         Left            =   5040
         TabIndex        =   9
         Top             =   1560
         Width           =   4095
      End
      Begin VB.Label lb_labels 
         Caption         =   "Server name :"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   8
         Left            =   240
         TabIndex        =   38
         Top             =   1260
         Width           =   1935
      End
      Begin VB.Label lb_labels 
         Caption         =   "Path :"
         Height          =   255
         Index           =   6
         Left            =   240
         TabIndex        =   19
         Top             =   7860
         Width           =   1035
      End
      Begin VB.Label lb_labels 
         Caption         =   "Cubes available for transfer :"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   10
         Left            =   240
         TabIndex        =   18
         Top             =   2100
         Width           =   3795
      End
      Begin VB.Label lb_labels 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Server side"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Index           =   4
         Left            =   240
         TabIndex        =   17
         Top             =   600
         Width           =   4215
      End
      Begin VB.Label lb_labels 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "PC side"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Index           =   5
         Left            =   4980
         TabIndex        =   16
         Top             =   600
         Width           =   7035
      End
      Begin VB.Label lb_labels 
         Caption         =   "Drive :"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   7
         Left            =   4980
         TabIndex        =   15
         Top             =   1200
         Width           =   975
      End
      Begin VB.Label lb_labels 
         Caption         =   "Directory :"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   9
         Left            =   4980
         TabIndex        =   14
         Top             =   2160
         Width           =   1455
      End
      Begin VB.Label lb_labels 
         Caption         =   "Action to be done during each run :"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   11
         Left            =   5040
         TabIndex        =   13
         Top             =   4560
         Width           =   5055
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "Help"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   9075
      Index           =   2
      Left            =   3120
      TabIndex        =   22
      Tag             =   "Help"
      Top             =   1680
      Width           =   12255
      Begin VB.CommandButton btn_exitHelp 
         Caption         =   "Exit help"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Left            =   9060
         TabIndex        =   23
         Top             =   7320
         Width           =   2775
      End
      Begin VB.Label lb_labels 
         Caption         =   $"FTPCopy.ctx":0000
         Height          =   495
         Index           =   12
         Left            =   420
         TabIndex        =   29
         Top             =   600
         Width           =   7935
      End
      Begin VB.Label lb_labels 
         Caption         =   "On the right side, you can select in which local directory, you want to copy cubes"
         Height          =   615
         Index           =   13
         Left            =   420
         TabIndex        =   28
         Top             =   1440
         Width           =   7935
      End
      Begin VB.Label lb_labels 
         Caption         =   "A list at the bottom of the screen, right hand side is showing the actual configuration. "
         Height          =   615
         Index           =   14
         Left            =   420
         TabIndex        =   27
         Top             =   2280
         Width           =   7935
      End
      Begin VB.Label lb_labels 
         Caption         =   $"FTPCopy.ctx":00A0
         Height          =   495
         Index           =   15
         Left            =   420
         TabIndex        =   26
         Top             =   3120
         Width           =   7815
      End
      Begin VB.Label lb_labels 
         Caption         =   "DO NOT FORGET TO RECORD YOUR CONFIGURATION BEFORE EXITING"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   17
         Left            =   420
         TabIndex        =   25
         Top             =   5760
         Width           =   10455
      End
      Begin VB.Label lb_labels 
         Caption         =   "To delete one setting, select the line concerned and drag it to the bin picture."
         Height          =   495
         Index           =   16
         Left            =   420
         TabIndex        =   24
         Top             =   3960
         Width           =   7815
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "Welcome"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   9075
      Index           =   0
      Left            =   3000
      TabIndex        =   0
      Tag             =   "Main"
      Top             =   1200
      Width           =   12255
      Begin VB.CommandButton btn_configure 
         Caption         =   "Configure"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Left            =   480
         TabIndex        =   7
         Top             =   8100
         Width           =   1695
      End
      Begin VB.CommandButton btn_run 
         Caption         =   "Run"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Left            =   2640
         TabIndex        =   6
         Top             =   8100
         Width           =   1695
      End
      Begin VB.CommandButton btn_exit 
         Caption         =   "Exit"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Left            =   10080
         TabIndex        =   5
         Top             =   8100
         Width           =   1695
      End
      Begin VB.Label lb_labels 
         BackStyle       =   0  'Transparent
         Caption         =   "If you want to configure program for what need to be updated locally on each run, click on ""Configure"""
         Height          =   615
         Index           =   1
         Left            =   360
         TabIndex        =   4
         Top             =   2040
         Width           =   7455
      End
      Begin VB.Label lb_labels 
         BackStyle       =   0  'Transparent
         Caption         =   "If you want to update your local PC with up to date cubes according to actual settings, click on ""Run"""
         Height          =   615
         Index           =   2
         Left            =   360
         TabIndex        =   3
         Top             =   3120
         Width           =   7455
      End
      Begin VB.Label lb_labels 
         BackStyle       =   0  'Transparent
         Caption         =   "If you want to know more click on ""Help"""
         Height          =   615
         Index           =   3
         Left            =   360
         TabIndex        =   2
         Top             =   4200
         Width           =   7455
      End
      Begin VB.Label lb_labels 
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "The purpose of this program is to update your local PC with the most up to date PowerPlay cubes stored on your server"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   14.25
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1095
         Index           =   0
         Left            =   300
         TabIndex        =   1
         Top             =   360
         Width           =   11295
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "Run"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   9075
      Index           =   3
      Left            =   480
      TabIndex        =   33
      Tag             =   "Run"
      Top             =   300
      Width           =   12255
      Begin Project1.ArmGrid grd_copyList 
         Height          =   3375
         Left            =   300
         TabIndex        =   49
         Top             =   900
         Width           =   11655
         _ExtentX        =   20558
         _ExtentY        =   5953
      End
      Begin VB.Frame frm_status 
         Caption         =   "Download status "
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1215
         Left            =   240
         TabIndex        =   45
         Top             =   4320
         Width           =   11775
         Begin MSComctlLib.ProgressBar pgb_files 
            Height          =   195
            Left            =   120
            TabIndex        =   46
            Top             =   540
            Width           =   11535
            _ExtentX        =   20346
            _ExtentY        =   344
            _Version        =   393216
            Appearance      =   0
            Min             =   1e-4
         End
         Begin MSComctlLib.ProgressBar pgb_file 
            Height          =   195
            Left            =   120
            TabIndex        =   47
            Top             =   300
            Width           =   11535
            _ExtentX        =   20346
            _ExtentY        =   344
            _Version        =   393216
            Appearance      =   0
            Scrolling       =   1
         End
         Begin VB.Label lb_copyStatus 
            BorderStyle     =   1  'Fixed Single
            Caption         =   "status line"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   48
            Top             =   840
            Width           =   11475
         End
      End
      Begin VB.CommandButton btn_copyAbort 
         Caption         =   "Abort copy"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   3240
         TabIndex        =   41
         Top             =   8160
         Width           =   2775
      End
      Begin VB.ListBox lst_inform 
         Height          =   1980
         ItemData        =   "FTPCopy.ctx":0138
         Left            =   300
         List            =   "FTPCopy.ctx":013A
         TabIndex        =   39
         Top             =   5880
         Width           =   11655
      End
      Begin VB.CommandButton btn_copy 
         Caption         =   "Start copy"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   6180
         TabIndex        =   36
         Top             =   8160
         Width           =   2775
      End
      Begin VB.CommandButton btn_exitRun 
         Caption         =   "Exit Run"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   9.75
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   9180
         TabIndex        =   34
         Top             =   8160
         Width           =   2775
      End
      Begin VB.Label lb_labels 
         BackColor       =   &H80000004&
         Caption         =   "Information :"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   12
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Index           =   18
         Left            =   300
         TabIndex        =   40
         Top             =   5580
         Width           =   1875
      End
      Begin VB.Label lb_labels 
         Caption         =   "Check files to copy:"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   21
         Left            =   180
         TabIndex        =   35
         Top             =   420
         Width           =   3255
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "Message"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   9075
      Index           =   4
      Left            =   240
      TabIndex        =   42
      Tag             =   "Message"
      Top             =   6360
      Width           =   12255
      Begin VB.CommandButton btn_cancelWait 
         Caption         =   "Cancel"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   12
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   615
         Left            =   9060
         TabIndex        =   43
         Top             =   7320
         Width           =   2775
      End
      Begin VB.Label lb_message 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Label1"
         BeginProperty Font 
            Name            =   "Arial Black"
            Size            =   14.25
            Charset         =   0
            Weight          =   900
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         Height          =   555
         Left            =   540
         TabIndex        =   44
         Top             =   660
         Width           =   5415
      End
   End
End
Attribute VB_Name = "FTPCopy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Event quit()
' **************************************************************************************************
' *************************************** EXTERNAL DECLARATIONS ************************************
' **************************************************************************************************
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMiliseconds As Long)
' ***** WSock32 Subroutines and Functions ********
Private Declare Function gethostname Lib "wsock32.dll" (ByVal hostname$, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname& Lib "wsock32.dll" (ByVal hostname$)
Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAData As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy&)
' ***** process Subroutines and Functions ********
Private Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
' **************************************** EXTERNAL DECLARATIONS *************************************




' **************************************************************************************************
' **************************************** TOOL CONSTANTS ******************************************
' **************************************************************************************************
Const SEP1 As String = "®"
Const SEP2 As String = "©"
Const MAXDWORD = &HFFFFFFFF
Const SOCKET_ERROR = -1
Const OK As Boolean = -1
Const KO As Boolean = 0
' WSock32 UDTs
Const WS_VERSION_MAJOR = &H101 \ &H100 And &HFF&
Const MIN_SOCKETS_REQD = 0
'Const WSADESCRIPTION_LEN = 255
'Const WSASYS_STATUS_LEN = 255
Const POWERPLAY_EXE As String = "powerplay.exe"
Const FTP_PASIVE As Boolean = True
Const FTPFILEPATTERN As String = "*.*" + SEP1 + "*.ZIP"
' ***** process CONSTANTS ********
Const PROCESS_QUERY_INFORMATION = 1024
Const PROCESS_VM_READ = 16
Const MAX_PATH = 260
Const WIN95_System_Found = 1
Const WINNT_System_Found = 2
' ****************************************** TOOL CONSTANTS ***************************************




' **************************************************************************************************
' ****************************************** RESOURCE CONSTANTS ************************************
' **************************************************************************************************
Const RES_OPENFOLDER As Long = 102
Const RES_CLOSEFOLDER As Long = 101
Const RES_DOCUMENT As Long = 103
Const RES_UNCHECK As String = "UNCHECK"
Const RES_CHECK As String = "CHECK"
Const RES_CLOCK As String = "CLOCK"
Const RES_CROSS As String = "CROSS"
Const RES_CHECK2 As String = "CHECK2"

' ****************************************** RESOURCE CONSTANTS ************************************



' **************************************************************************************************
' ************************************ USER TYPE DECLARATIONS **************************************
' **************************************************************************************************
' WSock32 UDTs
Private Type Inet_address
    Byte4 As String * 1
    Byte3 As String * 1
    Byte2 As String * 1
    Byte1 As String * 1
End Type

Private Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To 255) As Byte
    szSystemStatus(0 To 128) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

Private Type Hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type
' ***** process TYPES ********
Private Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type

Private Type PROCESS_MEMORY_COUNTERS
    cb As Long
    PageFaultCount As Long
    PeakWorkingSetSize As Long
    WorkingSetSize As Long
    QuotaPeakPagedPoolUsage As Long
    QuotaPagedPoolUsage As Long
    QuotaPeakNonPagedPoolUsage As Long
    QuotaNonPagedPoolUsage As Long
    PagefileUsage As Long
    PeakPagefileUsage As Long
End Type

Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long ' This process
    th32DefaultHeapID As Long
    th32ModuleID As Long ' Associated exe
    cntThreads As Long
    th32ParentProcessID As Long ' This process's parent process
    pcPriClassBase As Long ' Base priority of process threads
    dwFlags As Long
    szExeFile As String * 260 ' MAX_PATH
    End Type
    
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long '1 = Windows 95.
    '2 = Windows NT
    szCSDVersion As String * 128
End Type
' *********************************** USER TYPE DECLARATIONS ***************************************





' **************************************************************************************************
' **************************************** USER DEFINED ERRORS *************************************
' **************************************************************************************************
Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1 ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    CompFncFailed = vbObjectError + 6          ' when component function fail
    loginfailed = vbObjectError + 7          ' when Login fail
    UserCopyAbort = vbObjectError + 8               ' when user click abort copy
    InvalidValue = vbObjectError + 9               ' invalid version, invalid
End Enum
' *************************************** USER DEFINED ERRORS **************************************








' **************************************************************************************************
' *************************************** CONTROL MEMBERS ******************************************
' **************************************************************************************************
Dim ms_activeFace As String         ' active face
Dim ms_ip As String                 ' IP of machine
Dim ms_hostName As String           ' machine name
Dim ms_userLoginName As String      ' login name .. to identify user's local server
Dim ms_U_code As String             ' U_code selected at login
Dim ms_filePattern As String        ' pattern for files to be listed in FTPView window
Dim mb_copyAbort As Boolean         ' Global flag for file transfer operation
Dim ms_copyFile As String           ' Actualy transfering file
Dim mb_runCancel As Boolean         ' Global flag
Dim ms_FTPRoot As String            ' root directory for opened FTP session

#If LIVE = 1 Then
    Dim mo_Db As Object
#Else
    Dim mo_Db As ARMSYSCOMLib.ArmDb
#End If
' *************************************** CONTROL MEMBERS ******************************************



Public Property Let LoginName(as_LoginName As String)
    ms_userLoginName = as_LoginName
End Property

Public Property Get LoginName() As String
    LoginName = ms_userLoginName
End Property

Public Property Let U_Code(as_U_code As String)
    ms_U_code = as_U_code
End Property

Public Property Get U_Code() As String
    U_Code = ms_U_code
End Property

Public Sub Load_A_COM()
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    
'    'version test
'    If Not TestFileVersion("C:\WINDOWS\System32\A_sysCOM.dll", "1.7.1") Then
'        Call Err.Raise(InvalidValue, "TestFileVersion", "Invalid version.")
'    End If
    ' set layout
    Call SetUI
    
    ' Set Db
    Debug.Assert (Not mo_Db Is Nothing)
    
    Set grd_copyList.ArmDb = mo_Db
    
    Call grd_copyList.Load_A_COM

    ms_filePattern = FTPFILEPATTERN

    Call InitImageList(img_pictList)
    Call InitListView(lvw_serverFiles, img_pictList, lvwReport)
    Call InitListView(lvw_copyFiles, , lvwReport)
    
    ' init controls
    Call InitControls
    
    Call UpdateUI("FTPCopy.Main")
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Load_A_Com()")
End Sub

Public Sub Unload_A_COM()
On Error GoTo ErrHandler
    Dim ll_result As Long
    ' abort copy operation
    mb_copyAbort = True
    
    Call grd_copyList.Unload_A_COM
    
    Set grd_copyList.ArmDb = Nothing
    
    Set mo_Db = Nothing
    Exit Sub
ErrHandler:
    Set mo_Db = Nothing
    Call ErrorHandler("Unload_A_Com()")
End Sub

#If LIVE = 1 Then
Public Property Set DB(ByRef ao_DB As Object)
#Else
Public Property Set DB(ByRef ao_DB As ARMSYSCOMLib.ArmDb)
#End If

On Error GoTo ErrHandler

    If Not mo_Db Is Nothing Then Err.Raise ArmErr.CPTAlreadyInitialized
    If ao_DB Is Nothing Then Err.Raise ArmErr.InvalidArgument
    
    Set mo_Db = ao_DB
    
    Exit Property
    
ErrHandler:
    Call ErrorHandler("Db(Set)")
End Property


Private Sub ResetDetail(ByVal as_keyDesc As String)
On Error GoTo ErrHandler
    
    Select Case as_keyDesc
    Case "Main"
        ' ?? no data
    Case "Config"
        Call ResetDetailConfig
    Case "Help"
        ' ?? no data
    Case "Run"
        Call ResetDetailRun
    End Select

    Exit Sub
ErrHandler:
     Call ErrorHandler("ResetDetail()")
End Sub

' as_keyDesc is frame Tag value
Private Sub FillDetail(ByVal as_keyDesc As String)
On Error GoTo ErrHandler
    
    Select Case as_keyDesc
    Case "Main"
        ' ?? no data
    Case "Config"
        Call FillDetailConfig
    Case "Help"
        ' ?? no data
    Case "Run"
        Call FillDetailRun
    End Select
    
    Exit Sub
ErrHandler:
     Call ErrorHandler("FillDetail()")
End Sub

Private Sub ResetDetailConfig()
On Error GoTo ErrHandler
    ' reset server
    txt_server.Text = ""
    txt_serverPath.Text = ""
    
    ' reset server content
    Call lvw_serverFiles.ListItems.Clear
    
    ' clear lst_copyDef
    Call lvw_copyFiles.ListItems.Clear

    Exit Sub
ErrHandler:
     Call ErrorHandler("ResetDetailConfig()")
End Sub

Private Sub FillDetailConfig()
Const selDataReq As String = "EXEC PWP_UserConfig_lst '$LOGIN$'"
On Error GoTo ErrHandler
    Dim ls_req As String
    Dim ll_cursor As Long
    
    
    Call FillServerFiles(lvw_serverFiles, ms_userLoginName, txt_serverPath.Text)
    
    ' fill copy definition from DB
    ls_req = Replace(selDataReq, "$LOGIN$", SQLStr(ms_userLoginName))
    ll_cursor = OpenSQLSafe(mo_Db, ls_req)
    Debug.Assert (ll_cursor <> 0)
    
    If mo_Db.RowCount(ll_cursor) <> 0 Then
        Dim ls_PWPID As String, ls_srcPath As String, ls_destPath As String
        
        mo_Db.First (ll_cursor)
        While Not mo_Db.EOF(ll_cursor)
            ls_PWPID = mo_Db.GetFields(ll_cursor, "PWP_ID")
            ls_srcPath = mo_Db.GetFields(ll_cursor, "Src_path")
            ls_destPath = mo_Db.GetFields(ll_cursor, "Dest_path")
            Call AddCopyItem(lvw_copyFiles, ls_PWPID, ls_srcPath, ls_destPath)
            mo_Db.Next (ll_cursor)
        Wend
    End If
    
    mo_Db.Close (ll_cursor)
    Exit Sub
ErrHandler:
    If ll_cursor <> 0 Then mo_Db.Close (ll_cursor)
    Call ErrorHandler("FillDetailConfig()")
End Sub

Private Sub FillServerFiles(ByVal ao_serverFiles As MSComctlLib.ListView, ByVal as_Username As String, ByVal as_Path As String)
On Error GoTo ErrHandler
    Dim ls_FTPServerName As String, ls_FTPServerIP As String, ls_FTPServerLogin As String, ls_FTPServerPswd As String
    
    ' fill server
    Call GetNativeFTPServer(as_Username, ls_FTPServerIP, ls_FTPServerName, ls_FTPServerLogin, ls_FTPServerPswd)
    If ls_FTPServerIP = "" Then
        ' no FTPServer defined for user
        Call Err.Raise(loginfailed, "", "Local FTP server for " & as_Username & " not defined. Please contact IT service.")
    End If
    
    txt_server.Text = ls_FTPServerName & " (" & ls_FTPServerIP & ")"
    
    Call FTPDir(ao_serverFiles, ls_FTPServerName, ls_FTPServerIP, ls_FTPServerLogin, ls_FTPServerPswd, as_Path)

    Exit Sub
ErrHandler:
    Call ErrorHandler("FillServerFiles()")
End Sub

Private Sub FTPDir(ByVal ao_serverFiles As MSComctlLib.ListView, ByVal as_FTPServerName As String, ByVal as_FTPServerIP As String, ByVal as_ftpServerLogin As String, ByVal as_ftpServerPswd As String, ByVal as_Path As String)
On Error GoTo ErrHandler
    ' fill server content
#If LIVE = 1 Then
    Dim lo_FTP As Object
    Set lo_FTP = CreateObject("ArmSysCOM.ArmFTP")
#Else
    Dim lo_FTP As ARMSYSCOMLib.ArmFTP
    Set lo_FTP = New ARMSYSCOMLib.ArmFTP
#End If
    
    If Not lo_FTP.LogOnToServer(as_FTPServerIP, , as_ftpServerLogin, as_ftpServerPswd) Then
        Call Err.Raise(loginfailed, "", "FTP connection failed. ( Server:" & as_FTPServerName & "[" & as_FTPServerIP & "], login:" & as_ftpServerLogin & ", password:" & as_ftpServerPswd & ")")
        Exit Sub
    End If
    
    ' set ftpRoot extracting from login
    Dim ll_i As Long
    ll_i = InStr(1, as_ftpServerLogin, "/")
    If ll_i <> 0 Then
        ms_FTPRoot = right(as_ftpServerLogin, Len(as_ftpServerLogin) - ll_i) & "\"
    Else
        ms_FTPRoot = ""
    End If
        
    Call LogMessage("FTP connection opened. ( Server:" & as_FTPServerName & "[" & as_FTPServerIP & "], login:" & as_ftpServerLogin & ", password:" & as_ftpServerPswd & ")")
    
    ' set working directory
    If Not lo_FTP.ChangeWorkingDirectory(ms_FTPRoot & as_Path) Then
        Call lo_FTP.LogoffServer
        Set lo_FTP = Nothing
        Call LogMessage("FTP command CWD " & ms_FTPRoot & as_Path & " failed.", "E")
        Exit Sub
    End If
   
    ' list actual directory
    'If Not lo_FTP.List("", FTP_PASIVE) Then
    ' 061102 bugfix - armsyscom version 1.7.7 doesn't support parameter for type of transfer in List method
    If Not lo_FTP.List("") Then
        Call lo_FTP.LogoffServer
        Set lo_FTP = Nothing
        Call LogMessage("FTP command List " & ms_FTPRoot & as_Path & " failed.", "E")
        Exit Sub
    End If
    
    For ll_i = 0 To lo_FTP.ListCount - 1
        Call AddFileItem(ao_serverFiles, lo_FTP, ll_i, as_Path)
    Next
        
    'Close FTP connection
    Call lo_FTP.LogoffServer
    
    If as_Path <> "" Then
        ' go up icon
        Dim ll_Index As Long
        Dim lo_item As MSComctlLib.ListItem
        ll_Index = InStrRev(Left(as_Path, Len(as_Path) - 1), "\")
        If ll_Index <> 0 Then
            Set lo_item = InsertItem(ao_serverFiles, ao_serverFiles.ListItems.Count & "_", "[..]", Join(Array("Dir", Left(as_Path, ll_Index)), SEP1 + SEP2), , , RES_CLOSEFOLDER, vbResBitmap)
        Else
            Set lo_item = InsertItem(ao_serverFiles, ao_serverFiles.ListItems.Count & "_", "[..]", Join(Array("Dir", ""), SEP1 + SEP2), , , RES_CLOSEFOLDER, vbResBitmap)
        End If
        lo_item.SubItems(1) = " "
        
    End If
    
    lo_FTP.LogoffServer
    Set lo_FTP = Nothing

    Exit Sub
ErrHandler:
    lo_FTP.LogoffServer
    Set lo_FTP = Nothing
    
    Call ErrorHandler("FTPDir()")
End Sub


Private Sub GetNativeFTPServer(ByVal as_Username As String, ByRef as_IP As String, ByRef as_Name As String, ByRef as_Login As String, ByRef as_pswd As String)
On Error GoTo ErrHandler
Const selServerReq As String = "PWP_Server_lst '$LOGIN$'"

    Dim ls_req As String
    Dim ll_cursor As Long
    
    ls_req = Replace(selServerReq, "$LOGIN$", SQLStr(as_Username))
    ll_cursor = OpenSQLSafe(mo_Db, ls_req)
    Debug.Assert (ll_cursor <> 0)
    
    If mo_Db.RowCount(ll_cursor) <> 0 Then
        as_Name = mo_Db.GetFields(ll_cursor, "Name")
        as_IP = mo_Db.GetFields(ll_cursor, "IP_Server_Adr")
        as_Login = mo_Db.GetFields(ll_cursor, "Login")
        as_pswd = mo_Db.GetFields(ll_cursor, "Pswd")
    Else
        Call LogMessage("Native FTP server not found. User:" & as_Username & ".", "E")
    End If
    
    mo_Db.Close (ll_cursor)
    
    Exit Sub
ErrHandler:
    If ll_cursor <> 0 Then mo_Db.Close (ll_cursor)
    Call ErrorHandler("GetNativeFTPServer()")
End Sub

Private Sub GetLocalFTPServer(ByVal as_hostIP As String, ByRef as_IP As String, ByRef as_Name As String, ByRef as_Login As String, ByRef as_pswd As String)
On Error GoTo ErrHandler
Const selServerReq As String = "SELECT IP_Server_Adr, Name, Login, Pswd FROM PWP_Server" & vbCrLf & _
                               "WHERE IP_Server_Adr like '$IPMASKED$.%'"

    Dim ls_req As String, ls_IPMasked As String
    Dim ll_cursor As Long
    Dim lsa_IP_parts() As String
    Dim ll_parts As Long
    Dim ll_Index As Long
    Dim lb_serverFound As Boolean
    
    lb_serverFound = False
    lsa_IP_parts = Split(as_hostIP, ".")
    Debug.Assert (UBound(lsa_IP_parts) = 3)         ' 0..3
    ll_parts = UBound(lsa_IP_parts)
    
    Do While ll_parts >= LBound(lsa_IP_parts)
        ls_IPMasked = ""
        For ll_Index = LBound(lsa_IP_parts) To ll_parts
            ls_IPMasked = ls_IPMasked & IIf(ls_IPMasked = "", "", ".") & lsa_IP_parts(ll_Index)
        Next
        
        ls_req = Replace(selServerReq, "$IPMASKED$", ls_IPMasked)
        ll_cursor = OpenSQLSafe(mo_Db, ls_req)
        Debug.Assert (ll_cursor <> 0)
            
        If mo_Db.RowCount(ll_cursor) <> 0 Then
            as_Name = mo_Db.GetFields(ll_cursor, "Name")
            as_IP = mo_Db.GetFields(ll_cursor, "IP_Server_Adr")
            as_Login = mo_Db.GetFields(ll_cursor, "Login")
            as_pswd = mo_Db.GetFields(ll_cursor, "Pswd")
            lb_serverFound = True
            Exit Do
        End If
        
        mo_Db.Close (ll_cursor)
        ll_parts = ll_parts - 1
    Loop
    
    If Not lb_serverFound Then
        Call LogMessage("Local FTP server not found. IP:" & as_hostIP & " Machine name:" & ms_hostName & ".", "E")
    End If
    
    Exit Sub
ErrHandler:
    If ll_cursor <> 0 Then mo_Db.Close (ll_cursor)
    Call ErrorHandler("GetLocalFTPServer()")
End Sub

' Test if proces is running and ask user to close it
' function return false if user click Cancel button
Private Function TestCloseProcess(ByVal as_processName As String) As Boolean
On Error GoTo ErrHandler
    TestCloseProcess = True
    If Not IsProcessRunning(as_processName) Then Exit Function
        
    Dim ll_result As Long
    Dim ls_oldFace As String
    
    ' display message
    lb_message.Caption = "Please close " & as_processName & "."
    
    ls_oldFace = ms_activeFace
    Call UpdateUI("FTPCopy.Message")
    
    ' set cancel flag
    mb_runCancel = False
    ' wait until user close process
    Do While IsProcessRunning(as_processName) And Not mb_runCancel
        ll_result = DoEvents()
        Sleep (100)
    Loop
    
    TestCloseProcess = Not mb_runCancel
    
    ' restore face
    Call UpdateUI(ls_oldFace)

    Exit Function
ErrHandler:
    TestCloseProcess = False
    Call UpdateError(True)
    
    ' restore face
    If ls_oldFace <> "" Then Call UpdateUI(ls_oldFace)
    
    Call UpdateError(False)
    
    Call ErrorHandler("TestCloseProcess()")
End Function

Private Sub btn_cancelWait_Click()
    mb_runCancel = True
End Sub

Private Sub ResetDetailRun()
On Error GoTo ErrHandler
    ' clear inform listbox
    Call lst_inform.Clear
    
    ' clear progress bar
    pgb_files.Value = pgb_files.Min
    pgb_file.Value = pgb_file.Min
    
    Call grd_copyList.ClearGrid

    Exit Sub
ErrHandler:
     Call ErrorHandler("ResetDetailRun()")
End Sub

Private Sub FillDetailRun()
On Error GoTo ErrHandler
    ' fill listView from config table
Const selDataReq As String = "EXEC PWP_UserConfig_lst '$LOGIN$'"
Const selInfoReq As String = "EXEC PWP_Inform_lst"

On Error GoTo ErrHandler
    Dim ls_req As String
    Dim ll_cursor As Long
    Dim ls_FTPServerName As String, ls_FTPServerIP As String, ls_FTPServerLogin As String, ls_FTPServerPswd As String
    
    ' fill copy definition from DB
    ls_req = Replace(selDataReq, "$LOGIN$", SQLStr(ms_userLoginName))
    ll_cursor = OpenSQLSafe(mo_Db, ls_req)
    Debug.Assert (ll_cursor <> 0)
    
    If mo_Db.RowCount(ll_cursor) <> 0 Then
        Dim lo_item As MSComctlLib.ListItem
        Dim ls_PWPID As String, ls_srcPath As String, ls_destPath As String
        Dim lb_Result As Boolean
        
        mo_Db.First (ll_cursor)
        While Not mo_Db.EOF(ll_cursor)
            ls_PWPID = mo_Db.GetFields(ll_cursor, "PWP_ID")
            ls_srcPath = mo_Db.GetFields(ll_cursor, "Src_path")
            ls_destPath = mo_Db.GetFields(ll_cursor, "Dest_path")
            
            Call grd_copyList.AddLine(Array(ls_PWPID, "", ls_srcPath, ls_destPath))
            
            lb_Result = ls_srcPath Like "*YTD*" Or ls_srcPath Like "*YOY*"
            grd_copyList.Data(grd_copyList.Rows - 1, "CHECK") = IIf(lb_Result, RES_UNCHECK, RES_CHECK)
            mo_Db.Next (ll_cursor)
        Wend
    End If
    
    mo_Db.Close (ll_cursor)
    ll_cursor = 0
    
    ' fill informations from table SA_Log since last run of Sales Analysis tool
    ll_cursor = OpenSQLSafe(mo_Db, selInfoReq)
    Debug.Assert (ll_cursor <> 0)
    
    Dim ls_time As String, ls_Text As String
    
    mo_Db.First (ll_cursor)
    While Not mo_Db.EOF(ll_cursor)
        ls_time = mo_Db.GetFields(ll_cursor, "lg_date_time")
        ls_Text = mo_Db.GetFields(ll_cursor, "lg_text")
        lst_inform.AddItem (ls_time & Chr(9) & ": " & ls_Text)
        mo_Db.Next (ll_cursor)
    Wend
    
    mo_Db.Close (ll_cursor)
    ll_cursor = 0

    Exit Sub
ErrHandler:
    If ll_cursor <> 0 Then mo_Db.Close (ll_cursor)
    Call ErrorHandler("FillDetailRun()")
End Sub

Private Sub AddCopyRow(ByVal ao_grid As ArmGrid, ByVal as_PWP_ID As String, ByVal as_srcPath As String, ByVal as_destPath As String)
On Error GoTo ErrHandler
    ao_grid.AddLine (Join(Array(as_PWP_ID, "", as_srcPath, as_destPath)))

    Exit Sub
ErrHandler:
     Call ErrorHandler("AddCopyRow()")
End Sub
Private Function AddCopyItem(ByVal ao_ListView As MSComctlLib.ListView, ByVal as_PWP_ID As String, ByVal as_srcPath As String, ByVal as_destPath As String) As MSComctlLib.ListItem
On Error GoTo ErrHandler
    Dim lo_item As MSComctlLib.ListItem
    
    Set lo_item = InsertItem(ao_ListView, as_PWP_ID & "_", as_destPath, Join(Array(as_PWP_ID, as_srcPath, as_destPath), SEP1 + SEP2))
    Set AddCopyItem = lo_item
    Exit Function
ErrHandler:
     Call ErrorHandler("AddCopyItem()")
End Function

#If LIVE = 1 Then
Private Sub AddFileItem(ByVal ao_listBox As MSComctlLib.ListView, ByRef ao_FTP As Object, ByVal al_i As Long, ByVal as_Path As String)
#Else
Private Sub AddFileItem(ByVal ao_listBox As MSComctlLib.ListView, ByRef ao_FTP As ARMSYSCOMLib.ArmFTP, ByVal al_i As Long, ByVal as_Path As String)
#End If
On Error GoTo ErrHandler
    Dim ls_Name As String
    Dim lo_item As MSComctlLib.ListItem
    
    ls_Name = ao_FTP.ListFileName(al_i)

    If ao_FTP.ListFileSize(al_i) <= 0 Then
        ' directory
        Set lo_item = InsertItem(ao_listBox, ao_listBox.ListItems.Count & "_", _
                        "[" & ls_Name & "]", _
                        Join(Array("Dir", as_Path & ls_Name & "\"), SEP1 + SEP2), _
                        , , RES_CLOSEFOLDER, vbResBitmap)
            lo_item.SubItems(1) = " "
    Else
        ' file
        If TestPattern(ls_Name, ms_filePattern, SEP1) Then          ' only if file match pattern
            Set lo_item = InsertItem(ao_listBox, ao_listBox.ListItems.Count & "_", _
                            ls_Name, _
                            Join(Array("File", ms_FTPRoot & as_Path & ls_Name), SEP1 + SEP2), _
                            , , RES_DOCUMENT, vbResBitmap)
            lo_item.SubItems(1) = ao_FTP.ListFileSize(al_i)
        End If
    End If
    Exit Sub
ErrHandler:
     Call ErrorHandler("AddFileItem()")
End Sub

Private Function TestPattern(ByVal as_str As String, ByVal as_pattArr As String, Optional ByVal as_delim As String = SEP1) As Boolean
On Error GoTo ErrHandler
    Dim lsa_patt() As String
    Dim ll_i As Long
    
    TestPattern = False
    
    lsa_patt = Split(as_pattArr, as_delim)
    
    For ll_i = LBound(lsa_patt) To UBound(lsa_patt)
        If UCase(as_str) Like lsa_patt(ll_i) Then
            TestPattern = True
            Exit For
        End If
    Next

    Exit Function
ErrHandler:
     Call ErrorHandler("TestPattern()")
End Function

' function replace placeholders with active face
Private Function ReplaceFacePlaceholders(ByVal as_face As String) As String
On Error GoTo ErrHandler
    Dim las_faces() As String, ls_retVal As String
    Dim ll_i As Long
    las_faces = Split(as_face, ".")
    ls_retVal = as_face
    For ll_i = 0 To UBound(las_faces) - 1
        ls_retVal = Replace(ls_retVal, "$" & ll_i & "$", las_faces(UBound(las_faces) - ll_i))
    Next ll_i

    ReplaceFacePlaceholders = ls_retVal
    Exit Function
ErrHandler:
     Call ErrorHandler("ReplaceFacePlaceholders()")
End Function

Private Sub SetUI()
On Error GoTo ErrHandler
    Const LEFT_MARGIN As Long = 60
    Const RIGHT_MARGIN As Long = 60
    Const TOP_MARGIN As Long = 60
    Const BOTTOM_MARGIN As Long = 60
    
    Dim lo_ctrl As Object
    
    Dim ll_Left As Long, ll_top As Long, ll_Width As Long, ll_height As Long, ll_top2 As Long
    
    For Each lo_ctrl In frm_frames
        Call lo_ctrl.Move(0, 0)
    Next
    
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("SetUI()")
End Sub

Private Function GetContainedControls(ByVal ao_parent As Object) As Collection
On Error GoTo ErrHandler
    Dim lo_retCollection As New Collection
    Dim lo_Control As Object
    
    For Each lo_Control In Controls
        If Not TypeOf lo_Control.Container Is FTPCopy Then
            If ao_parent.hwnd = lo_Control.Container.hwnd Then
                Call lo_retCollection.Add(lo_Control)
            End If
        End If
    Next
    Set GetContainedControls = lo_retCollection
    Exit Function
ErrHandler:
    Call ErrorHandler("GetContainedControls()")
End Function

' as_Name is first part of Tag definition string
Private Function GetControl(ByVal ao_array As Object, ByVal as_Name As String) As Object
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    For Each lo_ctrl In ao_array
        If GetString(lo_ctrl.Tag, 0) = as_Name Then
            Set GetControl = lo_ctrl
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler("GetControl()")
End Function

' if ll_index is negative value string is indexed backward
Private Function GetString(ByVal as_String As String, ByVal ll_Index As Long, Optional ByVal as_delimiter As String = SEP1 + SEP2) As String
On Error GoTo ErrHandler
    Dim lsa_tmpArray() As String
    lsa_tmpArray = Split(as_String, as_delimiter)
    
    If ll_Index < 0 Then ll_Index = ll_Index + UBound(lsa_tmpArray) + 1    ' backward index
    
    If UBound(lsa_tmpArray) >= ll_Index And LBound(lsa_tmpArray) <= ll_Index Then GetString = lsa_tmpArray(ll_Index)
    
    Exit Function
ErrHandler:
    Call ErrorHandler("GetString()")
End Function

Private Sub InitControls()
On Error GoTo ErrHandler
    Dim hostname As String * 256
    Dim lo_ctrl As Object
    Dim lo_IPAddr As Inet_address
    
    If gethostname(hostname, 256) = SOCKET_ERROR Then
        Dim ll_errnum As Long
        ll_errnum = WSAGetLastError()
        Call Err.Raise(CompFncFailed, "InitControls", "gethostname() failed. error:" & ll_errnum)
        Exit Sub
    Else
        ms_hostName = Left(hostname, InStr(1, hostname, String(1, 0), vbBinaryCompare) - 1)
    End If

    If Not vbGetHostByName(ms_hostName, lo_IPAddr) Then
        Call Err.Raise(CompFncFailed, "InitControls", "vbGetHostByName() failed.")
    End If
    
    ' construct string IP
    ms_ip = CStr(Asc(lo_IPAddr.Byte4)) & "." & CStr(Asc(lo_IPAddr.Byte3)) & "." & CStr(Asc(lo_IPAddr.Byte2)) & "." & CStr(Asc(lo_IPAddr.Byte1))
    
    For Each lo_ctrl In frm_frames
        lo_ctrl.Caption = lo_ctrl & " [" & ms_userLoginName & ":" & ms_hostName & "( IP:" & ms_ip & ")]"
    Next

    ' init grd_copyList
    grd_copyList.UnBound = True
    grd_copyList.FreeSelect = True
    grd_copyList.AllowSort = False
    grd_copyList.MultiSelect = False
    grd_copyList.Title = "Files to copy ..."
    

    If Not grd_copyList.SetColumns(Array( _
      "PWPID®©0®©1®©®©ID", _
      "CHECK®©280®©0®©®©®©BITMAP", _
      "SRCPATH®©0®©0®©®©", _
      "DESTPATH®©9050®©0®©®©File to be copied")) Then
        Call Err.Raise(CompFncFailed, "grd_copyList.SetColumns")
    End If

    Exit Sub
ErrHandler:
    Call ErrorHandler("InitControls()")
End Sub

Private Sub UpdateUI(ByVal as_face As String)
On Error GoTo ErrHandler
    
    ' set active face
    ms_activeFace = ReplaceFacePlaceholders(as_face)
    
    ' apply face
    Dim lo_ctrl As Object
    Dim las_faces() As String, ls_face As Variant, ls_aktFace As String
    las_faces = Split(as_face, ".")
    
    
    For Each ls_face In las_faces
        ls_aktFace = IIf(ls_aktFace = "", ls_face, ls_aktFace & "." & ls_face)
        
        Select Case ls_aktFace
            Case "FTPCopy"
                ' hide all frames
                For Each lo_ctrl In frm_frames
                    lo_ctrl.Visible = False
                Next
            Case "FTPCopy.Main"
                ' we are in Main section
                Set lo_ctrl = GetControl(frm_frames, "Main")
                lo_ctrl.Visible = True
                
            Case "FTPCopy.Config"
                ' we are in Config section
                Set lo_ctrl = GetControl(frm_frames, "Config")
                lo_ctrl.Visible = True
            
            Case "FTPCopy.Help"
                ' we are in Config section
                Set lo_ctrl = GetControl(frm_frames, "Help")
                lo_ctrl.Visible = True
            
            Case "FTPCopy.Message"
                ' we are in Message section
                Set lo_ctrl = GetControl(frm_frames, "Message")
                lo_ctrl.Visible = True
            
            Case "FTPCopy.Run"
                ' we are in Run section
                Set lo_ctrl = GetControl(frm_frames, "Run")
                lo_ctrl.Visible = True
            
                btn_copy.Visible = True
                btn_exitRun.Visible = True
                
                btn_copyAbort.Visible = False
            
            Case "FTPCopy.Run.Execute"
                ' we are in Run section - copying mode
                ' disable all buttons
                btn_copy.Visible = False
                btn_exitRun.Visible = False
                
                ' show abort transfer button
                btn_copyAbort.Visible = True
        End Select
    Next
        
    ' to display face immidiatelly
    UserControl.Refresh
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateUI()")
End Sub

Private Sub btn_configure_Click()
On Error GoTo ErrHandler
    Screen.MousePointer = vbHourglass
    Call ResetDetail("Config")
    Call FillDetail("Config")
    Call UpdateUI("FTPCopy.Config")
    Screen.MousePointer = vbDefault
    Exit Sub
ErrHandler:
    Screen.MousePointer = vbDefault
    Call ErrorMessage("btn_configure_Click()")
End Sub

' start to copy from ftp server into local PC
Private Sub btn_copy_Click()
On Error GoTo ErrHandler
    ' set flag mb_copyAbort
    mb_copyAbort = False
    
    If grd_copyList.Rows = 0 Then Exit Sub
    
    ' get count files to copy
    Dim ll_item As Long
    Dim ll_Count As Long
    Dim lsa_itemToCopy() As String          ' contain key of each checked item
    For ll_item = 0 To grd_copyList.Rows - 1
        If grd_copyList.Data(ll_item, "CHECK") <> RES_UNCHECK Then
            If grd_copyList.Data(ll_item, "CHECK") <> "" Then grd_copyList.Data(CLng(ll_item), "CHECK") = RES_CHECK

            ' add ind
            ll_Count = ll_Count + 1
            'MS REDIMM
            Call SafeRedimPreserve(lsa_itemToCopy, ll_Count - 1)
            'ReDim Preserve lsa_itemToCopy(ll_Count - 1)
            lsa_itemToCopy(UBound(lsa_itemToCopy, 1)) = Join(Array(ll_item, grd_copyList.Data(ll_item, "SRCPATH"), grd_copyList.Data(ll_item, "DESTPATH")), SEP1 + SEP2)
        End If
    Next
    If ll_Count = 0 Then Exit Sub
    
    ' hide copy button
    Call UpdateUI("FTPCopy.Run.Execute")
    
    
    ' first try local server
#If LIVE = 1 Then
    Dim lo_FTP As Object
    Set lo_FTP = CreateObject("ArmSysCOM.ArmFTP")
#Else
    Dim lo_FTP As ARMSYSCOMLib.ArmFTP
    Set lo_FTP = New ARMSYSCOMLib.ArmFTP
#End If
    
    Dim ll_aktFile As Long
    
    ' init progress bar
    ll_aktFile = 0
    pgb_files.Max = ll_Count
    pgb_files.Value = pgb_files.Min
    
    ' get local server connection params
    Dim ls_FTPServerName As String, ls_FTPServerIP As String, ls_FTPServerLogin As String, ls_FTPServerPswd As String
    Call GetLocalFTPServer(ms_ip, ls_FTPServerIP, ls_FTPServerName, ls_FTPServerLogin, ls_FTPServerPswd)
    If ls_FTPServerIP = "" Then
        ' no FTPServer defined for local IP
        Call ShowMessage("No local PWP FTP server found in your network area. ( " & ms_ip & " ). Please contact IT service.")
    Else
        Call ShowMessage("Connectig PWP FTP server. IP:" & ls_FTPServerIP)
        If OpenFTP(lo_FTP, ls_FTPServerIP, ls_FTPServerLogin, ls_FTPServerPswd) Then
            Call ShowMessage("PWP FTP server connected.")
            ' download files from FTP server
            ll_aktFile = DownLoadFiles(lo_FTP, lsa_itemToCopy, ls_FTPServerIP, 0)
            Call lo_FTP.LogoffServer
        Else
            Call ShowMessage("Cannot connect to local PWP FTP Server " & ls_FTPServerIP & ".")
        End If
    End If
    
    If ll_aktFile <> ll_Count Then
        ' get nativ server connection params
        Dim ls_LIP As String
        ls_LIP = ls_FTPServerIP
        ' reset previous values
        ls_FTPServerIP = ""
        ls_FTPServerName = ""
        ls_FTPServerLogin = ""
        ls_FTPServerPswd = ""
        Call GetNativeFTPServer(ms_userLoginName, ls_FTPServerIP, ls_FTPServerName, ls_FTPServerLogin, ls_FTPServerPswd)
        ' if local is diferent from native
        If ls_LIP <> ls_FTPServerIP Then
            If ls_FTPServerIP = "" Then
                ' no FTPServer defined for local IP
                Call ShowMessage("Local FTP server for user " & ms_userLoginName & " not defined. Please contact IT service.")
            Else
                Call ShowMessage("Connectig PWP FTP server. IP:" & ls_FTPServerIP)
                If OpenFTP(lo_FTP, ls_FTPServerIP, ls_FTPServerLogin, ls_FTPServerPswd) Then
                    Call ShowMessage("PWP FTP server connected.")
                    ' download files from FTP server
                    ll_aktFile = DownLoadFiles(lo_FTP, lsa_itemToCopy, ls_FTPServerIP, ll_aktFile)
                    Call lo_FTP.LogoffServer
                Else
                    Call ShowMessage("Cannot connect to local PWP FTP Server " & ls_FTPServerIP & ".")
                End If
            End If
        End If
    End If
    
    Set lo_FTP = Nothing
    
    Call UpdateUI("FTPCopy.Run")

    Exit Sub
ErrHandler:
    'Close FTP connection
    If Not lo_FTP Is Nothing Then
        Call lo_FTP.LogoffServer
        Set lo_FTP = Nothing
    End If
    
    If Err.Number = UserCopyAbort Then
        ' display message
        Call ShowMessage(lb_copyStatus.Caption & " aborted.")
        If ms_copyFile <> "" Then
            ' delete partionaly transfered file
            DeleteFile (ms_copyFile)
            ms_copyFile = ""
        End If
        MsgBox ("Copy canceled.")
    Else
        Call ErrorMessage("btn_copy_Click()")
    End If

    Call UpdateUI("FTPCopy.Run")
    
End Sub


Private Sub btn_copyAbort_Click()
On Error GoTo ErrHandler
    mb_copyAbort = True
    Exit Sub
ErrHandler:
    Call ErrorMessage("btn_copyAbort_Click()")
End Sub

Private Sub ShowMessage(ByVal as_msg As String)
On Error GoTo ErrHandler
    lb_copyStatus.Caption = as_msg
    Call lb_copyStatus.Refresh
    Sleep (100)
    Exit Sub
ErrHandler:
    Call ErrorHandler("ShowMessage()")
End Sub

Private Sub btn_exit_Click()
    ' exit application
  RaiseEvent quit
End Sub

Private Sub btn_exitConfig_Click()
On Error GoTo ErrHandler
    Call UpdateUI("FTPCopy.Main")
    Exit Sub
ErrHandler:
    Call ErrorMessage("btn_exitConfig_Click()")
End Sub

Private Sub btn_exitHelp_Click()
On Error GoTo ErrHandler
    Call UpdateUI("FTPCopy.Config")
    Exit Sub
ErrHandler:
    Call ErrorMessage("btn_exitHelp_Click()")
End Sub

Private Sub btn_exitRun_Click()
On Error GoTo ErrHandler
    Call UpdateUI("FTPCopy.Main")
    Exit Sub
ErrHandler:
    Call ErrorMessage("btn_exitRun_Click()")
End Sub

Private Sub btn_help_Click()
On Error GoTo ErrHandler
    Call UpdateUI("FTPCopy.Help")
    Exit Sub
ErrHandler:
    Call ErrorMessage("btn_help_Click()")
End Sub

Private Sub btn_run_Click()
On Error GoTo ErrHandler
    Screen.MousePointer = vbHourglass
    ' check if powerplay.exe is running
    If Not TestCloseProcess(POWERPLAY_EXE) Then Exit Sub
    Call ResetDetail("Run")
    Call FillDetail("Run")
    Call UpdateUI("FTPCopy.Run")
    Screen.MousePointer = vbDefault
    Exit Sub
ErrHandler:
    Screen.MousePointer = vbDefault
    Call ErrorMessage("btn_run_Click()")
End Sub

' save configuration to DB
Private Sub btn_saveConfig_Click()
Const DeleteReq As String = "DELETE UC FROM PWP_UserConfig UC" & vbCrLf & _
                            "INNER JOIN GEN_Systems_Users SU on SU.U_code = UC.U_code" & vbCrLf & _
                            "WHERE UC.PWP_ID NOT IN ($ITEMS$) AND SU.U_login_name='$LOGIN$'"
Const InsertReq As String = "EXEC PWP_UserConfig_ins '$LOGIN$',$PWP_ID$,'$SRCPATH$','$DESTPATH$'"
Const UpdateReq As String = "EXEC PWP_UserConfig_upd $PWP_ID$,'$SRCPATH$','$DESTPATH$'"
Const tranBegin As String = "BEGIN TRANSACTION SAVE_CONFIG"
Const tranCommit As String = "COMMIT TRANSACTION SAVE_CONFIG"
Const tranRollBack As String = "ROLLBACK TRANSACTION SAVE_CONFIG"

On Error GoTo ErrHandler
    Screen.MousePointer = vbHourglass
    
    ' get IDs of all controls in listview
    Dim ls_allID As String, ls_ID As String, ls_srcPath As String, ls_destPath As String, ls_req As String
    Dim lo_item As MSComctlLib.ListItem
    Dim lb_inTransaction As Boolean
    
    lb_inTransaction = False
    ' start transaction
    Call ExecuteSQLSafe(mo_Db, tranBegin)
    
    lb_inTransaction = True
    ls_allID = "0"    ' to avoid empty brackets in where condition
    For Each lo_item In lvw_copyFiles.ListItems
        ls_ID = GetString(lo_item.Tag, 0)
        ls_srcPath = GetString(lo_item.Tag, 1)
        ls_destPath = GetString(lo_item.Tag, 2)
        
        If Not ls_ID Like "0_*" Then
            ' update action
            ls_allID = ls_allID & "," & ls_ID
            ls_req = Replace(UpdateReq, "$PWP_ID$", ls_ID)
            ls_req = Replace(ls_req, "$SRCPATH$", SQLStr(ls_srcPath))
            ls_req = Replace(ls_req, "$DESTPATH$", SQLStr(ls_destPath))
            
            Call ExecuteSQLSafe(mo_Db, ls_req)
            
            Debug.Assert (mo_Db.SQLRowsAffected = 1)
            
        Else
            ' insert new action
            ls_ID = mo_Db.SQLNextID("PWP_ID")
            If ls_ID = "" Then
                Call Err.Raise(CompFncFailed, "btn_saveConfig_Click", "Cannot generate next ID for PWP_ID.")
            End If
            ls_allID = ls_allID & "," & ls_ID
            ls_req = Replace(InsertReq, "$LOGIN$", SQLStr(ms_userLoginName))
            ls_req = Replace(ls_req, "$PWP_ID$", ls_ID)
            ls_req = Replace(ls_req, "$SRCPATH$", SQLStr(ls_srcPath))
            ls_req = Replace(ls_req, "$DESTPATH$", SQLStr(ls_destPath))
            
            Call ExecuteSQLSafe(mo_Db, ls_req)
            
            Debug.Assert (mo_Db.SQLRowsAffected = 1)
        End If
    Next
    
    ' remove items from DB
    ls_req = Replace(DeleteReq, "$LOGIN$", SQLStr(ms_userLoginName))
    ls_req = Replace(ls_req, "$ITEMS$", ls_allID)
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    ' commit transaction
    Call ExecuteSQLSafe(mo_Db, tranCommit)
    
    lb_inTransaction = False
    Screen.MousePointer = vbDefault
    MsgBox ("Configuration was saved.")
    
    Exit Sub
ErrHandler:
    Screen.MousePointer = vbDefault
    If lb_inTransaction Then
        ' rollback transaction
        If Not mo_Db.ExecuteSQL(tranRollBack) Then
            Call UpdateError(True)
            MsgBox (GetDbError(mo_Db))
            Call UpdateError(False)
        End If
    End If
    Call ErrorMessage("btn_saveConfig_Click()")
End Sub

Private Sub drvlistO_Change()
On Error GoTo ErrHandler
    dir_output.Path = drvlistO.Drive
    Exit Sub
ErrHandler:
    If Err.Number = 68 Then
        MsgBox (Err.Description)
    Else
        Call ErrorMessage("drvlistO_Change()")
    End If
End Sub



Private Sub grd_copyList_Click()
On Error GoTo ErrHandler

'    If grd_copyList.mouseCol = 1 Then
    If grd_copyList.Col = 1 Then
        If grd_copyList.SelectedLine(0, "CHECK") = RES_CHECK Then
            grd_copyList.SelectedLine(0, "CHECK") = RES_UNCHECK
        Else
            grd_copyList.SelectedLine(0, "CHECK") = RES_CHECK
        End If
        grd_copyList.Col = 3
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_copyList_Click()")
End Sub


' remove item from acion list
Private Sub lvw_copyFiles_DblClick()
On Error GoTo ErrHandler
    If lvw_copyFiles.SelectedItem Is Nothing Then Exit Sub
    
    If MsgBox("Delete " & lvw_copyFiles.SelectedItem.Text & " from action list?", vbYesNo) = vbNo Then Exit Sub
    
    lvw_copyFiles.ListItems.Remove (lvw_copyFiles.SelectedItem.Key)
    Exit Sub
ErrHandler:
    Call ErrorMessage("lvw_copyFiles_DblClick()")
End Sub

' add item into action list
Private Sub lvw_serverFiles_DblClick()
On Error GoTo ErrHandler
    If lvw_serverFiles.SelectedItem Is Nothing Then Exit Sub
    Dim ls_Type As String, ls_path As String
    
    ls_Type = GetString(lvw_serverFiles.SelectedItem.Tag, 0)
    ls_path = GetString(lvw_serverFiles.SelectedItem.Tag, 1)
    
    If ls_Type = "Dir" Then
        Screen.MousePointer = vbHourglass
        txt_serverPath = ls_path
        Call lvw_serverFiles.ListItems.Clear
        Call FillServerFiles(lvw_serverFiles, ms_userLoginName, ls_path)
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    Debug.Assert (ls_Type = "File")
    
    ' check if file exists in filelistbox
    Dim lo_item As MSComctlLib.ListItem
    For Each lo_item In lvw_copyFiles.ListItems
        If GetString(lo_item.Tag, 1) = ls_path Then
            MsgBox ("Selected file is already in action list.")
            Exit Sub
        End If
    Next
    ' insert item into lvw_copyFiles
    Call AddCopyItem(lvw_copyFiles, "0_" & lvw_copyFiles.ListItems.Count, ls_path, dir_output.Path & "\" & GetString(Replace(ls_path, "/", "\"), -1, "\"))
    Exit Sub
ErrHandler:
    Screen.MousePointer = vbDefault
    Call ErrorMessage("lvw_serverFiles_DblClick()")
End Sub

' ************************************************************************************
' ******************************* FTP FUNCTIONS **************************************
' ************************************************************************************
#If LIVE = 1 Then
Private Function OpenFTP(ByRef ao_FTP As Object, ByVal as_IP As String, as_Login As String, as_Password As String) As Boolean
#Else
Private Function OpenFTP(ByRef ao_FTP As ARMSYSCOMLib.ArmFTP, ByVal as_IP As String, as_Login As String, as_Password As String) As Boolean
#End If
On Error GoTo ErrHandler
    OpenFTP = False
    
    Call ShowMessage("Connecting \\" & as_IP & " ...")
    If Not ao_FTP.LogOnToServer(as_IP, , as_Login, as_Password) Then
        Call ShowMessage("Connection failed \\" & as_IP)
        Call LogMessage("FTP connection failed. ( Server:" & as_IP & ", login:" & as_Login & ", password:" & as_Password & ")", "E")
        Exit Function
    End If
    
    Call ShowMessage("Connected. \\" & as_IP)
    Call LogMessage("FTP connection opened. ( Server:" & as_IP & ", login:" & as_Login & ", password:" & as_Password & ")")
    
    Dim ll_i As Long
    ll_i = InStr(1, as_Login, "/")
    If ll_i <> 0 Then
        ms_FTPRoot = right(as_Login, Len(as_Login) - ll_i) & "\"
    Else
        ms_FTPRoot = ""
    End If

    OpenFTP = True
    Exit Function
ErrHandler:
    Call ErrorHandler("OpenFTP()")
End Function

#If LIVE = 1 Then
Private Function DownLoadFiles(ByVal ao_FTP As Object, ByRef asa_files As Variant, ByVal as_IP As String, Optional ByVal al_aktFile As Long = 0) As Long
#Else
Private Function DownLoadFiles(ByVal ao_FTP As ARMSYSCOMLib.ArmFTP, ByRef asa_files As Variant, ByVal as_IP As String, Optional ByVal al_aktFile As Long = 0) As Long
#End If
On Error GoTo ErrHandler
Dim ll_i As Long
Dim ls_srcPath As String, ls_destPath As String, ls_index As String
    For ll_i = LBound(asa_files, 1) To UBound(asa_files, 1)
        If asa_files(ll_i) <> "" Then
            ls_index = GetString(asa_files(ll_i), 0)
            Debug.Assert (isNumeric(ls_index))
            ls_srcPath = GetString(asa_files(ll_i), 1)
            ls_destPath = GetString(asa_files(ll_i), 2)
            
            ' set picture
            grd_copyList.Data(CLng(ls_index), "CHECK") = RES_CLOCK
            
            ' try download file
            If DownLoadFile(ao_FTP, as_IP, ls_srcPath, ls_destPath) Then
                al_aktFile = al_aktFile + 1             ' increment counter
                asa_files(ll_i) = ""               ' file downloaded
                
                Call ShowMessage(lb_copyStatus.Caption & " completed.")
    
                pgb_files.Value = al_aktFile            ' set progress bar
                grd_copyList.Data(CLng(ls_index), "CHECK") = RES_CHECK2
            Else
                If ms_copyFile <> "" Then
                    Debug.Assert (ms_copyFile = ls_destPath)
                    ' delete partionaly transfered file
                    DeleteFile (ms_copyFile)
                    ms_copyFile = ""
                End If
                
                Call ShowMessage(lb_copyStatus.Caption & " interupted.")
                grd_copyList.Data(CLng(ls_index), "CHECK") = RES_CROSS
            End If
        End If
    Next
    DownLoadFiles = al_aktFile
    Exit Function
ErrHandler:
    ' abort
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    Dim ll_errNumber As Long
    ls_ErrSource = Err.Source
    ls_errDescription = Err.Description
    ll_errNumber = Err.Number
    
    If isNumeric(ls_index) Then grd_copyList.Data(CLng(ls_index), "CHECK") = RES_CROSS
    Call Err.Raise(ll_errNumber, "DownLoadFiles()" & SEP1 & ls_ErrSource, ls_errDescription)
End Function

#If LIVE = 1 Then
Private Function DownLoadFile(ByVal ao_FTP As Object, ByVal as_serverName As String, ByVal as_src As String, as_dst As String) As Boolean
#Else
Private Function DownLoadFile(ByVal ao_FTP As ARMSYSCOMLib.ArmFTP, ByVal as_serverName As String, ByVal as_src As String, as_dst As String) As Boolean
#End If
On Error GoTo ErrHandler
    Dim ll_BytesTransfered As Long
    Dim ll_BytesTotal As Long
    Dim ll_result As Long
    
    DownLoadFile = False
    pgb_file.Value = pgb_file.Min
    
    ' test if destination directory exists
    Dim ls_dir As String
    
    ls_dir = Left(as_dst, InStrRev(Replace(as_dst, "/", "\"), "\"))
    If Not TestDir(ls_dir) Then
        Call ShowMessage("Folder " & ls_dir & " does not exists.")
        Call LogMessage("Folder " & ls_dir & " does not exists.", "E")
        Exit Function
    End If
    
    Call ShowMessage("Downloading \\" & as_serverName & "\" & as_src & " ...")
    Call LogMessage("FTP file download start. File name:\\" & as_serverName & "\" & as_src & ".", "I")
    
    If Not ao_FTP.DownloadFileAsynch(as_dst, as_src, FTP_PASIVE) Then
        ' TODO : LOG ERROR
        Call LogMessage("FTP file download failed. File name:\\" & as_serverName & "\" & as_src & ".", "E")
        Exit Function
    Else
        ' set global value
        ms_copyFile = as_dst
        ' this most time cost operation of file download
        While ao_FTP.AsynchOperationProgress(ll_BytesTransfered, ll_BytesTotal, ll_result) And Not mb_copyAbort
            If ll_BytesTotal <> 0 Then
                pgb_file.Value = pgb_file.Min + (pgb_file.Max - pgb_file.Min) * ll_BytesTransfered / ll_BytesTotal
            End If
            ll_result = DoEvents()
            Call Sleep(100)
            Debug.Print ll_BytesTransfered & " : " & ll_BytesTotal & " Result: " & ll_result
        Wend
        Debug.Print ll_BytesTransfered & " : " & ll_BytesTotal & " Result: " & ll_result
        
        If ll_BytesTransfered = ll_BytesTotal And Not mb_copyAbort And ll_result <> 0 Then
            ' file transfer successed
            pgb_file.Value = pgb_file.Max
            Call LogMessage("FTP file download finished. File name:\\" & as_serverName & "\" & as_src & ". (" & ll_BytesTotal & " bytes)", "I")
            ' test if it is zipped
            If UCase(as_dst) Like "*.ZIP" Then
                ' decompress file
#If LIVE = 1 Then
                Dim lo_ZIP As Object
                Set lo_ZIP = CreateObject("ArmSysCOM.ArmZip")
#Else
                Dim lo_ZIP As ARMSYSCOMLib.ArmZip
                Set lo_ZIP = New ARMSYSCOMLib.ArmZip
#End If
                
                Call ShowMessage("Decompressing archive " & as_dst & " ...")
                If Not lo_ZIP.DecompressFile(as_dst, ls_dir, True, True) Then
                    ' decompression failed
                    Call LogMessage("ZIP archive decompression failed:\\" & as_serverName & "\" & as_src & ".", "E")
                    Set lo_ZIP = Nothing
                    Exit Function
                End If
                Set lo_ZIP = Nothing
                
                ' delete archive
                DeleteFile (ms_copyFile)
            End If
            ms_copyFile = ""
        Else
            ' transfer interrupted for some reason
            If mb_copyAbort Then
                ' stop download
                Call ao_FTP.AbortAsynch
                
                ' rise exception to cancel download
                Call Err.Raise(UserCopyAbort, "Abort", "Operation aborted.")
            Else
                ' other FTP transfer abort
                
                Call LogMessage("FTP file download interupted. File name:\\" & as_serverName & "\" & as_src & ". (" & ll_BytesTotal & " bytes)", "E")
                Exit Function
            End If
        End If
    End If
    
    DownLoadFile = True
    Exit Function
ErrHandler:
    If Not lo_ZIP Is Nothing Then Set lo_ZIP = Nothing
    Call ErrorHandler("DownLoadFile()")
End Function








' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
Private Sub ExecuteSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_req As String)

    If Not ao_DB.ExecuteSQL(as_req) Then
        Call Err.Raise(CompFncFailed, "ExecuteSQLSafe", "SQL Error: " & GetDbError(ao_DB))
    End If

End Sub

Private Function OpenSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_req As String) As Long

    OpenSQLSafe = ao_DB.OpenSQL(as_req)
    
    If OpenSQLSafe = 0 Then Call Err.Raise(CompFncFailed, "OpenSQLSafe", "SQL Error: " & GetDbError(ao_DB))

End Function

Private Function SQLStr(ByVal as_str As String) As String
    SQLStr = Replace(as_str, "'", "''")
End Function



' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
On Error GoTo ErrHandler
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(mo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("GetDbError()")
End Function
' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
  
    Call Err.Raise(Err.Number, as_Fct & SEP1 & Err.Source, Err.Description)
End Sub

' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    
    Call LogMessage("FTPTool exception raised. Err.Number:" & Err.Number & ", Err.Source:" & ls_ErrSource & ", Err.Description " & ls_errDescription & ".", "E", False)
    Call MsgBox("Error occured, please contact IT" & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, , "Error message: " & as_Fct)
End Sub

Private Sub LogMessage(ByVal as_logMsg As String, Optional ByVal as_logType As String = "I", Optional ab_throwException As Boolean = True)
On Error GoTo ErrHandler
Const InsertReq As String = "INSERT INTO A_Log (U_code, Z_creation_date, Source , Log_type, Log_Msg ) VALUES ($UCODE$, GETDATE(), '$APP$', '$LOGTYPE$', '$MSG$')"
    Dim ls_req As String
    Dim ll_cursor As Long
    
    ls_req = Replace(InsertReq, "$UCODE$", IIf(ms_U_code = "", "0", ms_U_code))
    ls_req = Replace(ls_req, "$APP$", SQLStr(App.ProductName & " " & App.Major & "." & App.Minor & "." & App.Revision))
    ls_req = Replace(ls_req, "$MSG$", SQLStr(as_logMsg))
    ls_req = Replace(ls_req, "$LOGTYPE$", SQLStr(as_logType))
    
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    Exit Sub
ErrHandler:
    If ab_throwException Then Call ErrorHandler("LogMessage()")
End Sub

' procedure save/restore err object
Private Sub UpdateError(Optional ab_saveError As Boolean = False)
Static ls_ErrDesc As String
Static ls_ErrSource As String
Static ll_errnum As Long
    
    If ab_saveError Then
        ls_ErrDesc = Err.Description
        ls_ErrSource = Err.Source
        ll_errnum = Err.Number
    Else
        Err.Description = ls_ErrDesc
        Err.Source = ls_ErrSource
        Err.Number = ll_errnum
    End If
End Sub




' ************************************************************************************
' ************************** LISTVIEW SUPPORT FUNCTIONS ******************************
' ************************************************************************************
Private Function LoadImage(ByVal ao_ImageList As MSComctlLib.ImageList, ByVal al_resIndex As Long, ByVal al_resType As LoadResConstants) As Long
On Error GoTo ErrHandler
    Dim lo_image As MSComctlLib.ListImage
    Set lo_image = ao_ImageList.ListImages.Add(, "_" & al_resIndex, LoadResPicture(al_resIndex, al_resType))
    LoadImage = lo_image.Index
    Exit Function
ErrHandler:
    LoadImage = 0             ' undefined bitmap
    Call ErrorHandler("LoadImage()")
End Function

Private Sub InitListView(ByRef ao_lvw As MSComctlLib.ListView, Optional ByVal ao_imgList As MSComctlLib.ImageList = Nothing, Optional ByVal al_listType As MSComctlLib.ListViewConstants = lvwList)
On Error GoTo ErrHandler
    ao_lvw.HideSelection = False        ' don't hide selection when lostFocus
    ao_lvw.View = al_listType
    ao_lvw.LabelEdit = lvwManual       ' disable edit labels
    ao_lvw.Icons = ao_imgList
    ao_lvw.SmallIcons = ao_imgList
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitListView()")
End Sub

Private Sub InitImageList(ByRef ao_imgList As MSComctlLib.ImageList)
On Error GoTo ErrHandler
    ao_imgList.ImageHeight = 16
    ao_imgList.ImageWidth = 16
    ao_imgList.MaskColor = vbMagenta

    ' at least one image must be loaded to correctly initialize imagelist
    Call LoadImage(ao_imgList, RES_OPENFOLDER, vbResBitmap)
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitImageList()")
End Sub

Private Function InsertItem(ByVal ao_lvw As MSComctlLib.ListView, ByVal as_Key As String, ByVal as_Text As String, ByVal as_Tag As String, Optional ByVal ai_pos As Integer = -1, Optional ByVal al_icon As Long = -1, Optional ByVal al_smallIcon As Long = -1, Optional ByVal al_imageType As LoadResConstants = vbResIcon) As MSComctlLib.ListItem
On Error GoTo ErrHandler
    Dim lo_retItem As MSComctlLib.ListItem
    Set lo_retItem = GetItem(ao_lvw, as_Key)
    If lo_retItem Is Nothing Then
        Set lo_retItem = ao_lvw.ListItems.Add(IIf(ai_pos = -1, ao_lvw.ListItems.Count + 1, ai_pos), _
                                              as_Key, _
                                              as_Text, _
                                              GetImageIndex(ao_lvw.Icons, al_icon, al_imageType), _
                                              GetImageIndex(ao_lvw.SmallIcons, al_smallIcon, al_imageType))
        lo_retItem.Tag = as_Tag
    End If
    Set InsertItem = lo_retItem
    Exit Function
ErrHandler:
    Set InsertItem = Nothing
    Call ErrorHandler("InsertItem()")
End Function

Private Function GetItem(ByVal ao_lvw As MSComctlLib.ListView, ByVal as_Key As String) As MSComctlLib.ListItem
On Error GoTo ErrHandler
    Dim lo_retItem As MSComctlLib.ListItem
    
    Set GetItem = Nothing
    For Each lo_retItem In ao_lvw.ListItems
        If lo_retItem.Key = as_Key Then
            Set GetItem = lo_retItem
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Set GetItem = Nothing
    Call ErrorHandler("GetItem()")
End Function

Private Function GetImageIndex(ByVal ao_ImageList As MSComctlLib.ImageList, ByVal al_resIndex As Long, ByVal al_resType As LoadResConstants) As Variant
On Error GoTo ErrHandler
    If (ao_ImageList Is Nothing) Or (al_resIndex = -1) Then
        GetImageIndex = Empty
        Exit Function
    End If
    
    Dim lo_image As MSComctlLib.ListImage
    For Each lo_image In ao_ImageList.ListImages
        If lo_image.Key = "_" & al_resIndex Then
            GetImageIndex = lo_image.Index
            Exit Function
        End If
    Next
    
    GetImageIndex = LoadImage(ao_ImageList, al_resIndex, al_resType)
    Exit Function
ErrHandler:
    GetImageIndex = Empty
    Call ErrorHandler("GetImageIndex()")
End Function








' ************************************************************************************
' **************************  WSock32 SUPPORT FUNCTIONS ******************************
' ************************************************************************************
Public Function vbWSAStartup() As Boolean
Dim iReturn As Long, sLowByte As String
Dim WSAdata As WSAdata

On Error GoTo Err_vbWSAStartup
    
    ' Subroutine to Initialize WSock32
    iReturn = WSAStartup(&H101, WSAdata)
    If iReturn <> 0 Then    ' If WSock32 error, then tell me about it
        Call Err.Raise(InvalidValue, "vbStartup", "WSock32.dll is not responding!")
    End If
    If LoByte(WSAdata.wVersion) < WS_VERSION_MAJOR Then
        sLowByte = Trim$(Str$(LoByte(WSAdata.wVersion)))
        Call Err.Raise(InvalidValue, "vbStartup", "WinSock Version " & sLowByte & " is not supported ")
    End If
    
    If WSAdata.iMaxSockets < MIN_SOCKETS_REQD Then
        Call Err.Raise(InvalidValue, "vbStartup", "This application requires a minimum of " & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets.")
    End If

'    Dim i As Integer
'    Dim MaxSockets As Long
'    MaxSockets = WSAdata.iMaxSockets
    '  WSAdata.iMaxSockets is an unsigned short, so we have to convert it to a signed long
'    If MaxSockets < 0 Then
'        MaxSockets = 65536 + MaxSockets
'    End If
    
'    Dim MaxUDP As Long
'    MaxUDP = WSAdata.iMaxUdpDg
'    If MaxUDP < 0 Then
'        MaxUDP = 65536 + MaxUDP
'    End If
    '  Process the Winsock Description information
 
'Dim Description As String
'    Description = ""
'    For i = 0 To WSADESCRIPTION_LEN
'        If WSAdata.szDescription(i) = 0 Then Exit For
'        Description = Description + Chr$(WSAdata.szDescription(i))
'    Next i
    '  Process the Winsock Status information
 '   MsgBox "Description : " & Description
'    Status = ""

'    For i = 0 To WSASYS_STATUS_LEN
'        If WSAdata.szSystemStatus(i) = 0 Then Exit For
'        Status = Status + Chr$(WSAdata.szSystemStatus(i))
'    Next i
  '  MsgBox "Status : " & Status
    
    vbWSAStartup = True
    Exit Function

Err_vbWSAStartup:
    vbWSAStartup = False
    Call ErrorHandler("vbWSAStartup()")
    Exit Function
End Function

Private Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
End Function

Public Function vbWSACleanup()
On Error GoTo Err_vbWSACleanup
Dim ll_Return As Long
    ' Subroutine to perform WSACleanup

    ll_Return = WSACleanup()

    If ll_Return <> 0 Then       ' If WSock32 error, then tell me about it.
        Call Err.Raise(InvalidValue, "vbWSACleanup", "WSock32 Error - " & Trim$(Str$(ll_Return)) & " occurred in Cleanup")
    End If
    vbWSACleanup = True
    Exit Function
    
Err_vbWSACleanup:
    vbWSACleanup = False
    Call ErrorHandler("vbWSACleanup()")
End Function

Private Function vbGetHostByName(ByVal ls_Host As String, ByRef lo_IPLong As Inet_address) As Boolean
On Error GoTo Err_vbGetHostByName
    Dim ls_TempHost As String
    Dim ls_zString As String
    Dim ll_PointerToPointer As Long
    Dim lo_Hostent As Hostent
    Dim li_ListAddress As Long
    Dim ll_ListAddr As Long
    'Dim ll As Long

    ls_TempHost = Trim(ls_Host)
    
    ls_zString = String(64, &H0)
    ls_TempHost = ls_TempHost + right$(ls_zString, 64 - Len(ls_TempHost))
    ll_PointerToPointer = gethostbyname(ls_TempHost)
'    MsgBox "gethostbyname :(" & CStr(ll_PointerToPointer) & ")"
    If IsNull(ll_PointerToPointer) Or (ll_PointerToPointer = 0) Then            ' If WSock32 error, then tell me about it
        Call Err.Raise(InvalidValue, "vbWSACleanup", "Winsock Error" & Str$(WSAGetLastError()))
    Else
        'll_PointerToPointer = gethostbyname(ls_TempHost)              ' Get the pointer to the address of the winsock hostent structure
        CopyMemory lo_Hostent, ByVal _
        ll_PointerToPointer, Len(lo_Hostent)                      ' Copy Winsock structure to the VisualBasic structure

        li_ListAddress = lo_Hostent.h_addr_list                   ' Get the ListAddress of the Address List
        CopyMemory ll_ListAddr, ByVal li_ListAddress, 4           ' Copy Winsock structure to the VisualBasic structure
        
        Do While ll_ListAddr <> 0
            CopyMemory lo_IPLong, ByVal ll_ListAddr, 4                ' Get the first list entry from the Address List
            
            li_ListAddress = li_ListAddress + LenB(lo_Hostent.h_addr_list)
            CopyMemory ll_ListAddr, ByVal li_ListAddress, 4           ' Copy Winsock structure to the VisualBasic structure
            
            Debug.Print "IP found: " & CStr(Asc(lo_IPLong.Byte4)) & "." & CStr(Asc(lo_IPLong.Byte3)) & "." & CStr(Asc(lo_IPLong.Byte2)) & "." & CStr(Asc(lo_IPLong.Byte1))
        
        Loop
        
        ' enumerate machine aliases
'        li_ListAddress = lo_Hostent.h_aliases                     ' Get the ListAddress of the Address List
'        CopyMemory ll_ListAddr, ByVal li_ListAddress, 4           ' Copy Winsock structure to the VisualBasic structure
        
'        Do While ll_ListAddr <> 0
'            CopyMemory lo_IPLong, ByVal ll_ListAddr, 4                ' Get the first list entry from the Address List
            
'            li_ListAddress = li_ListAddress + LenB(lo_Hostent.h_aliases)
'            CopyMemory ll_ListAddr, ByVal li_ListAddress, 4           ' Copy Winsock structure to the VisualBasic structure
            
'            Debug.Print "IP found: " & CStr(Asc(lo_IPLong.Byte4)) & "." & CStr(Asc(lo_IPLong.Byte3)) & "." & CStr(Asc(lo_IPLong.Byte2)) & "." & CStr(Asc(lo_IPLong.Byte1))
        
'        Loop
        
        
        
        
        'MsgBox "IPLong :" & Trim$(CStr(Asc(IPLong.Byte4)) + "." + CStr(Asc(IPLong.Byte3)) _
            + "." + CStr(Asc(IPLong.Byte2)) + "." + CStr(Asc(IPLong.Byte1)))
        'MsgBox "Addr : " & ml_Addr
        'IPLong2.Byte1 = Chr(36)
        'IPLong2.Byte2 = Chr(100)
        'IPLong2.Byte3 = Chr(213)
        'IPLong2.Byte4 = Chr(195)
        'MsgBox "IPLong2 :" & Trim$(CStr(Asc(IPLong2.Byte4)) + "." + CStr(Asc(IPLong2.Byte3)) _
            + "." + CStr(Asc(IPLong2.Byte2)) + "." + CStr(Asc(IPLong2.Byte1)))
        'CopyMemory ml_Addr2, IPLong2, 4
        'MsgBox "Addr2 : " & ml_Addr2
        
        vbGetHostByName = True
      
    End If
    Exit Function
    
Err_vbGetHostByName:
    vbGetHostByName = False
    Call ErrorHandler("vbGetHostByName()")
End Function

' **************************  WSock32 SUPPORT FUNCTIONS ******************************








' ************************************************************************************
' **************************  PROCESS SUPPORT FUNCTIONS ******************************
' ************************************************************************************
Public Function GetProcesses(ByVal EXEName As String)

    Dim ll_countOfProcesses As Long
    
    Dim lngLength As Long
    Dim lngProcessID As Long
    Dim strProcessName As String
    Dim lngSnapHwnd As Long
    Dim udtProcEntry As PROCESSENTRY32
    Dim lngCBSize As Long 'Specifies the size, In bytes, of the lpidProcess array
    Dim lngCBSizeReturned As Long 'Receives the number of bytes returned
    Dim lngNumElements As Long
    Dim lngProcessIDs() As Long
    Dim lngCBSize2 As Long
    Dim lngModules(1 To 200) As Long
    Dim lngReturn As Long
    Dim strModuleName As String
    Dim lngSize As Long
    Dim lngHwndProcess As Long
    Dim lngLoop As Long
    Dim b As Long
    Dim c As Long
    Dim e As Long
    Dim d As Long
    Dim pmc As PROCESS_MEMORY_COUNTERS
    Dim lret As Long
    Dim strProcName2 As String
    Dim strProcName As String

    'Turn on Error handler
    On Error GoTo Error_handler
    
    ll_countOfProcesses = 0


    EXEName = UCase$(Trim$(EXEName))
    lngLength = Len(EXEName)

    'ProcessInfo.bolRunning = False

    Select Case getVersion()
        'I'm not bothered about windows 95/98 becasue this class probably wont be used on it anyway.
        Case WIN95_System_Found 'Windows 95/98

        Case WINNT_System_Found 'Windows NT

            lngCBSize = 8 ' Really needs To be 16, but Loop will increment prior to calling API
            lngCBSizeReturned = 96

            Do While lngCBSize <= lngCBSizeReturned
                DoEvents
                'Increment Size
                lngCBSize = lngCBSize * 2
                'Allocate Memory for Array
                ReDim lngProcessIDs(lngCBSize / 4) As Long
                'Get Process ID's
                lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
            Loop

            'Count number of processes returned
            lngNumElements = lngCBSizeReturned / 4
            'Loop thru each process

            For lngLoop = 1 To lngNumElements
            DoEvents

            'Get a handle to the Process and Open
            lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))

            If lngHwndProcess <> 0 Then
                'Get an array of the module handles for the specified process
                lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)

                'If the Module Array is retrieved, Get the ModuleFileName
                If lngReturn <> 0 Then

                    'Buffer with spaces first to allocate memory for byte array
                    strModuleName = Space(MAX_PATH)

                    'Must be set prior to calling API
                    lngSize = 500

                    'Get Process Name
                    lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize)

                    'Remove trailing spaces
                    strProcessName = Left(strModuleName, lngReturn)

                    'Check for Matching Upper case result
                    strProcessName = UCase$(Trim$(strProcessName))

                    strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "\", 0, 0, GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "\") - 1)

                    If strProcName2 = EXEName Then
                        ' increment counter
                        ll_countOfProcesses = ll_countOfProcesses + 1
                        
                        'Get the Site of the Memory Structure
                        pmc.cb = LenB(pmc)

                           lret = GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb)

                            Debug.Print EXEName & "::" & CStr(pmc.WorkingSetSize / 1024)

                    End If
                End If
            End If
            'Close the handle to this process
            lngReturn = CloseHandle(lngHwndProcess)
            DoEvents
        Next

    End Select
    
    GetProcesses = ll_countOfProcesses

IsProcessRunning_Exit:

'Exit early to avoid error handler
Exit Function
Error_handler:
    Call ErrorHandler("GetProcesses()")
End Function


Private Function getVersion() As Long
On Error GoTo ErrHandler

    Dim osinfo As OSVERSIONINFO
    Dim retvalue As Integer

    osinfo.dwOSVersionInfoSize = 148
    osinfo.szCSDVersion = Space$(128)
    retvalue = GetVersionExA(osinfo)
    getVersion = osinfo.dwPlatformId
    Exit Function
ErrHandler:
    Call ErrorHandler("getVersion()")
End Function


Private Function StrZToStr(s As String) As String
On Error GoTo ErrHandler
    StrZToStr = Left$(s, Len(s) - 1)
    Exit Function
ErrHandler:
    Call ErrorHandler("StrZToStr()")
End Function



Public Function GetElement(ByVal strList As String, ByVal strDelimiter As String, ByVal lngNumColumns As Long, ByVal lngRow As Long, ByVal lngColumn As Long) As String
On Error GoTo ErrHandler

    Dim lngCounter As Long

    ' Append delimiter text to the end of the list as a terminator.
    strList = strList & strDelimiter

    ' Calculate the offset for the item required based on the number of columns the list
    ' 'strList' has i.e. 'lngNumColumns' and from which row the element is to be
    ' selected i.e. 'lngRow'.
    lngColumn = IIf(lngRow = 0, lngColumn, (lngRow * lngNumColumns) + lngColumn)

    ' Search for the 'lngColumn' item from the list 'strList'.
    For lngCounter = 0 To lngColumn - 1

        ' Remove each item from the list.
        strList = Mid$(strList, InStr(strList, strDelimiter) + Len(strDelimiter), Len(strList))

        ' If list becomes empty before 'lngColumn' is found then just
        ' return an empty string.
        If Len(strList) = 0 Then
            GetElement = ""
            Exit Function
        End If

    Next lngCounter

    ' Return the sought list element.
    GetElement = Left$(strList, InStr(strList, strDelimiter) - 1)

    Exit Function
ErrHandler:
    Call ErrorHandler("GetElement()")
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function GetNumElements (ByVal strList As String,
'                         ByVal strDelimiter As String)
'                         As Integer
'
'  strList      = The element list.
'  strDelimiter = The delimiter by which the elements in
'                 'strList' are seperated.
'
'  The function returns an integer which is the count of the
'  number of elements in 'strList'.
'
'  Author: Roger Taylor
'
'  Date:26/12/1998
'
'  Additional Information:
'
'  Revision History:
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer
On Error GoTo ErrHandler

    Dim intElementCount As Integer

    ' If no elements in the list 'strList' then just return 0.
    If Len(strList) = 0 Then
        GetNumElements = 0
        Exit Function
    End If

    ' Append delimiter text to the end of the list as a terminator.
    strList = strList & strDelimiter

    ' Count the number of elements in 'strlist'
    While InStr(strList, strDelimiter) > 0
        intElementCount = intElementCount + 1
        strList = Mid$(strList, InStr(strList, strDelimiter) + 1, Len(strList))
    Wend

    ' Return the number of elements in 'strList'.
    GetNumElements = intElementCount

    Exit Function
ErrHandler:
    GetNumElements = 0
    Call ErrorHandler("GetNumElements()")
End Function

Public Function IsProcessRunning(ByVal ls_process As String) As Boolean
On Error GoTo ErrHandler
    Dim ll_countOfProcesses As Long

    ll_countOfProcesses = GetProcesses(ls_process)

    IsProcessRunning = (ll_countOfProcesses <> 0)
    Exit Function
ErrHandler:
    IsProcessRunning = False
    Call ErrorHandler("IsProcessRunning()")
End Function


' **************************  PROCESS SUPPORT FUNCTIONS ******************************

Private Function TestDir(ByVal as_dir As String) As Boolean
On Error GoTo ErrHandler
    TestDir = False
    Dim lo_FSO As Object
    Set lo_FSO = CreateObject("Scripting.FileSystemObject")
    If Not lo_FSO Is Nothing Then
        If Not lo_FSO.FolderExists(as_dir) Then
            Set lo_FSO = Nothing
            Exit Function
        End If
        Set lo_FSO = Nothing
    Else
        Call Err.Raise(CompFncFailed, "CreateObject()", "Cannot create Scripting.FileSystemObject.")
    End If
    TestDir = True
    Exit Function
ErrHandler:
    If Not lo_FSO Is Nothing Then Set lo_FSO = Nothing
    Call ErrorHandler("CleanDirectory()")
End Function


' delete file
Private Sub DeleteFile(ByVal as_filespec As String)
  
On Error GoTo ErrHandler
    Dim lo_FSO As Object
    Set lo_FSO = CreateObject("Scripting.FileSystemObject")
    If Not lo_FSO Is Nothing Then
        If lo_FSO.FileExists(as_filespec) Then
            Call lo_FSO.DeleteFile(as_filespec, True)
        End If
        Set lo_FSO = Nothing
    Else
        Call Err.Raise(CompFncFailed, "CreateObject()", "Cannot create Scripting.FileSystemObject.")
    End If
    
    Exit Sub
    
ErrHandler:
    ' free resources
    If Not lo_FSO Is Nothing Then Set lo_FSO = Nothing
    Call ErrorHandler("DeleteFiles()")
End Sub

Private Function TestFileVersion(ByVal as_file As String, ByVal as_version As String) As Boolean
On Error GoTo ErrHandler
    Dim lo_FSO As Object
    TestFileVersion = False
    Set lo_FSO = CreateObject("Scripting.FileSystemObject")
    If Not lo_FSO Is Nothing Then
        If lo_FSO.FileExists(as_file) Then
            Dim ls_Version As String
            ls_Version = lo_FSO.GetFileVersion(as_file)
            If ls_Version > as_version Then
                TestFileVersion = True
            End If
        End If
        Set lo_FSO = Nothing
    Else
        Call Err.Raise(CompFncFailed, "CreateObject()", "Cannot create Scripting.FileSystemObject.")
    End If
    
    Exit Function
    
ErrHandler:
    ' free resources
    If Not lo_FSO Is Nothing Then Set lo_FSO = Nothing
    Call ErrorHandler("TestFileVersion()")
End Function

'Sub SafeRedimString(ByRef as_Array() As String, al_NumElements As Long)
'
'On Error GoTo ErrHandler
'
'  If al_NumElements = 0 Then
'          ReDim as_Array(-1 To -1)
'  Else
'          ReDim Preserve as_Array(al_NumElements - 1)
'  End If
'  Exit Sub
'ErrHandler:
'    Call ErrorHandler("SafeRedimString()")
'End Sub

