VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDatGrd.ocx"
Begin VB.Form frmFolderCopy 
   Caption         =   "Folder Copy"
   ClientHeight    =   7335
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8400
   LinkTopic       =   "Form1"
   ScaleHeight     =   7335
   ScaleWidth      =   8400
   StartUpPosition =   3  'Windows Default
   Begin MSDataGridLib.DataGrid DataGrid1 
      Bindings        =   "Cmdproc-6.frx":0000
      Height          =   915
      Left            =   300
      TabIndex        =   7
      Top             =   5370
      Width           =   8025
      _ExtentX        =   14155
      _ExtentY        =   1614
      _Version        =   393216
      HeadLines       =   1
      RowHeight       =   15
      FormatLocked    =   -1  'True
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   4
      BeginProperty Column00 
         DataField       =   "HFLD#"
         Caption         =   "HFLD#"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   "HPRD#"
         Caption         =   "HPRD#"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column02 
         DataField       =   "HHEX"
         Caption         =   "HHEX"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column03 
         DataField       =   "HENTD"
         Caption         =   "HENTD"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
            ColumnWidth     =   1275.024
         EndProperty
         BeginProperty Column01 
            ColumnWidth     =   1260.284
         EndProperty
         BeginProperty Column02 
            ColumnWidth     =   3209.953
         EndProperty
         BeginProperty Column03 
            ColumnWidth     =   1590.236
         EndProperty
      EndProperty
   End
   Begin VB.ListBox List2 
      Height          =   1425
      Left            =   300
      TabIndex        =   6
      Top             =   3870
      Width           =   8025
   End
   Begin VB.CommandButton cmdReadFileNames 
      Caption         =   "Read File Names"
      Height          =   345
      Left            =   4620
      TabIndex        =   5
      Top             =   60
      Width           =   3675
   End
   Begin VB.FileListBox File1 
      Height          =   3015
      Left            =   4650
      TabIndex        =   4
      Top             =   450
      Width           =   3645
   End
   Begin VB.ListBox List1 
      Height          =   1815
      Left            =   300
      TabIndex        =   3
      Top             =   1560
      Width           =   4095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Copy Folder"
      Height          =   435
      Left            =   690
      TabIndex        =   2
      Top             =   900
      Width           =   2955
   End
   Begin VB.TextBox pthDst 
      Height          =   285
      Left            =   120
      TabIndex        =   1
      Text            =   "Q:\A\8074932D"
      Top             =   420
      Width           =   4335
   End
   Begin VB.TextBox pthSrc 
      Height          =   285
      Left            =   120
      TabIndex        =   0
      Text            =   "\\fryfs001v\eng\users\FEDUCIA\8074932D"
      Top             =   90
      Width           =   4335
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   330
      Left            =   360
      Top             =   3540
      Visible         =   0   'False
      Width           =   8025
      _ExtentX        =   14155
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   2
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   3
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "DSN=ODBCrms"
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   "ODBCrms"
      OtherAttributes =   ""
      UserName        =   "EGNETLINK"
      Password        =   "DRAWINGS"
      RecordSource    =   "EGSHP1A0"
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
End
Attribute VB_Name = "frmFolderCopy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2006 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH As Long = 260

Private Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
  End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private Type SECURITY_ATTRIBUTES
     nLength As Long
     lpSecurityDescriptor As Long
     bInheritHandle As Long
End Type

Private Declare Function CreateDirectory Lib "kernel32" _
   Alias "CreateDirectoryA" _
  (ByVal lpPathName As String, _
   lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

Private Declare Function CopyFile Lib "kernel32" _
   Alias "CopyFileA" _
  (ByVal lpExistingFileName As String, _
   ByVal lpNewFileName As String, _
   ByVal bFailIfExists As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
  lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" _
      (ByVal hFindFile As Long) As Long
      
Dim fsoMain As FileSystemObject
      

Private Sub cmdReadFileNames_Click()
   cmdReadFileNames.Enabled = False
   
   On Error Resume Next
   pthd$ = pthDst.Text
   'SW00007C
   List2.Clear
   File1.Path = pthd$
   fldr$ = UCase(Mid(pthd$, LastStr(pthd$, "\") + 1))
   Pn$ = UCase(left(fldr$, 7))
   File1.Refresh
   
   If File1.Path = pthd$ Then

      Recname$ = pthd$
      recn# = 0
      retry# = 0
      If (Adodc1.Recordset.RecordCount <> 0) Then Adodc1.Recordset.MoveFirst
      Do While (Not (Adodc1.Recordset.EOF)) And (Adodc1.Recordset.RecordCount <> 0)
      
         rfld$ = UCase(Trim(Adodc1.Recordset![HFLD#]))
         If rfld$ = fldr$ Then
            Adodc1.Recordset.Delete
            Pause (1)
            retry# = retry# + 1
         Else
            recn# = recn# + 1
            Adodc1.Recordset.MoveNext
         End If
         cmdReadFileNames.Caption = "retry=" + Str(retry#) + " - Recnum=" + Str(recn#)
      Loop
      cmdReadFileNames.Caption = "delete complete"
      On Error GoTo 0
      If File1.ListCount > 0 Then
         For ixc = 0 To File1.ListCount - 1
            nw$ = Format(Now, "yyyymmddhhnnss")
            d# = Val(nw$)
            flx$ = File1.List(ixc)
            '
            ' add the record
            List2.AddItem fldr$ + "|" + Pn$ + "|" + nw$ + "|" + flx$
            Adodc1.Recordset.AddNew
            Adodc1.Recordset![HFLD#] = fldr$
            Adodc1.Recordset![HPRD#] = Pn$
            Adodc1.Recordset!HHEX = RPad(flx$, 70)
            Adodc1.Recordset!HENTD = d#
            Adodc1.Recordset.Update
            '
         Next
      End If
   End If
   cmdReadFileNames.Caption = "Read File Names"
   cmdReadFileNames.Enabled = True
         
End Sub

Private Sub Command1_Click()

   Dim sSourcePath As String
   Dim sDestination As String
   Dim sFiles As String
   Dim numCopied As Long
     
  'set the appropriate initializing values
   sSourcePath = pathCheck(pthSrc)
   sDestination = pathCheck(pthDst)
   sFiles = "*.*"
     
  'perform the copy and return the copied file count
   numCopied = 0
   Call Copydir(sSourcePath, sDestination, Rc%)
   numCopied = Rc%
   Call DeleteDir(sSourcePath)
End Sub
Public Sub Copydir(sSourcePath As String, sDestination As String, iRetCd As Integer)

   Dim numCopied, numDeleted As Long
   Dim fsosub As New FileSystemObject
     
  'set the appropriate initializing values
   
   pthDst = pathCheck(sDestination)
   pthSrc = pathCheck(sSourcePath)
   pthDst = left(pthDst, Len(pthDst) - 1)
   pthSrc = left(pthSrc, Len(pthSrc) - 1)
   
   ce = 0: On Error GoTo erretcopy
   
   Call fsosub.CopyFolder(pthSrc, pthDst, True)
   On Error GoTo 0
   '
   'place filenames in folder into the as400
   '
   If ce = 0 Then
      Call cmdReadFileNames_Click
   End If
   
   iRetCd = ce
   Pause (2)
Exit Sub
erretcopy:
   ce = 1
   Resume Next
End Sub
Public Sub KillDir(sSourcePath As String, iRetCd As Integer)

   Dim sFiles As String
   Dim numCopied, numDeleted As Long
     
  'set the appropriate initializing values
   sSourcePath = pathCheck(sSourcePath)
   'MsgBox numCopied & " files copied to " & sDestination
   Call DeleteDir(sSourcePath)
   iRetCd = 0
End Sub
Private Sub DeleteDir(sSourcePath As String)
On Error Resume Next
   Dim fsosub As New FileSystemObject
   pthn$ = pathCheck(sSourcePath)
   pthn$ = left(pthn$, Len(pthn$) - 1)
   Call fsosub.DeleteFolder(pthn$, True)
End Sub