Attribute VB_Name = "module"

Private Const dir_column As Long = 1
Private Const modifiedDir_column As Long = 2
Private Const fileName_column As Long = 3
Private Const fullpath_column As Long = 4

Private Const MacroTmpFolder As String = "\ttl"
Private Const MacroFile As String = "connect_server.ttl"
Private Const MacroIncludeFile As String = "inc_env.ttl"
Private Const WorkPath As String = "inc_env.ttl"
Private Const TermMacro As String = "\ttpmacro.exe"

Private TermPath As String
Private TxtFile As Variant

Public Function GetSkString(ByVal inmoji As String) As String
    GetSkString = "'" & inmoji & "'"
End Function
Sub TeraTerm_Click()
    Dim firstAddress, tmpaddress As String

    Dim envFlag As Boolean
    Dim iRow As Integer
    Dim firstAddress As String
    Dim MacroFolder As String
    Dim ServerName As String
    Dim ConnectServer As String
    Dim UserId As String
    Dim PassWord As String
    Dim HomePath As String
    
    Dim CodeType As String
    Dim LogFlag As String
    
    Dim FSO As filesystemobject
    Dim c As Range
    
    envFlag = False
    TermPath = ThisWorkbook.ActiveSheet.Cells(1, 1).Value
    With ThisWorkbook.ActiveSheet
        Set c = .UsedRange.Columns(1).Find(what:=.Cells(4, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                If Not c Is Nothing And c.Row > 14 Then
                    tmpaddress = c.Address
                    iRow = c.Row
                    envFlag = True
                    Exit Do
                End If
                Set c = .UsedRange.Columns(1).FindNext(c)
            Loop Until c.Address = firstAddress
        End If
        If envFlag Then
            ServerName = .Cells(iRow, 2).Value
            ConnectServer = .Cells(iRow, 3).Value
            UserId = .Cells(iRow, 4).Value
            PassWord = .Cells(iRow, 4).Value
            If Len(Trim(.Cells(iRow, 6).Value)) > 0 Then
                HomePath = .Cells(iRow, 6).Value
            Else
                HomePath = ""
            End If
        Else
            Call MsgBox("要连接的服务器设定有错误", vbOKOnly + vbExclamation)
            Exit Sub
        End If
    End With
    If ThisWorkbook.ActiveSheet.Cells(4, 2).Value = "SJIS" Then
        CodeType = "1"
    Else
        CodeType = "0"
    End If
    If ThisWorkbook.ActiveSheet.Cells(4, 3).Value = "○输出log" Then
        LogFlag = "1"
    Else
        LogFlag = "0"
    End If
    
    
    Set FSO = New filesystemobject
    MacroFolder = ThisWorkbook.Path & MacroTmpFolder
    If Not FSO.folderexists(MacroFolder) Then
        FSO.crestefolder MacroFolder
    End If
    
    MacroFolder = ThisWorkbook.Path & MacroTmpFolder
    Set TxtFile = FSO.createtextfile(MacroFolder & "\" & MacroIncludeFile, True)
    TxtFile.Writeline "server_name=" & GetSkString(ServerName)
    TxtFile.Writeline "server_addr=" & GetSkString(ConnectServer)
    TxtFile.Writeline "user_id=" & GetSkString(UserId)
    TxtFile.Writeline "pass_word=" & GetSkString(PassWord)
    TxtFile.Writeline "code_flag=" & CodeType
    TxtFile.Writeline "log_flag=" & LogFlag
    TxtFile.Writeline "home_dir=" & GetSkString(HomePath)
    TxtFile.Close
    
    Set TxtFile = FSO.createtextfile(MacroFolder & "\" & MacroFile, True)
    TxtFile.Writeline "include " & GetSkString(MacroIncludeFile)
    
    
    
    
    
    
    
    
    
    
    


End Sub









Public Sub setCellStyle(Row As Long, column As Long, Optional Font_Size As Integer = 12, Optional Borders_Weight As Integer = 2, Optional Color_Index As Integer = -1)
    ThisWorkbook.ActiveSheet.Cells(Row, column).NumberFormatLocal = "@"
    ThisWorkbook.ActiveSheet.Cells(Row, column).Font.Name = "宋体"
    ThisWorkbook.ActiveSheet.Cells(Row, column).Font.Size = Font_Size
    ThisWorkbook.ActiveSheet.Cells(Row, column).Borders.Weight = Borders_Weight
    ThisWorkbook.ActiveSheet.Cells(Row, column).Borders.Color = RGB(0, 0, 0)
    If Color_Index > -1 Then
        ThisWorkbook.ActiveSheet.Cells(Row, column).Interior.ColorIndex = Color_Index
    End If
End Sub


Public Function CreateListFile(strRootPath As String, strFileNamePattern As String, strList() As String) As Long

    Dim objFso As Object
    Dim objFile As Object
    Dim strFileList() As String
    Dim i, j, k As Long
    
    Set objFso = Nothing
    Set objFso = CreateObject("Scripting.Filesystemobject")
    
    i = 0
    Erase strList()
    
    For Each objFile In objFso.GetFolder(strRootPath).Files
        
        DoEvents
        
        'file name like pattern
        If objFile.Name Like strFileNamePattern Then
        
            'place to list buffer
            ReDim Preserve strList(i)
            
            strList(i) = objFile.Name
            
            i = i + 1
            
        End If
        
    Next
    
    For Each objfolder In objFso.GetFolder(strRootPath).subfolders
    
        DoEvents
        
        If Not objfolder.Attributes And (vbHidden) Then
            j = CreateListFile(strRootPath & "\" & objfolder.Name, strFileNamePattern, strFileList)
            For k = 0 To j - 1
                ReDim Preserve strList(i)
                strList(i) = objfolder.Name & "\" & strFileList(k)
                i = i + 1
            Next k
        End If
    Next
    
    CreateListFile = i
    
    Set objFile = Nothing
    Set objFso = Nothing
    
End Function


Public Function getFileColumn(startRow As Long, strFilePath As String, strFileName As String) As Long

    Dim wkBooks As Object
    Dim c As Range
    Dim iRow As Integer
    Dim relese_number As String
    Dim FilePath As String
    Dim FileDir As String
    Dim modifiedFileDir As String
    Dim FileName As String
    Dim env As String
    
    Application.ScreenUpdating = False
    Application.ShowWindowsInTaskbar = False
    Application.DisplayAlerts = False
    
    FilePath = strFileName
    idx1 = InStrRev(FilePath, "\")
    
    If idx1 > 0 Then
        FileDir = Mid(FilePath, 1, idx1 - 1)
        FileName = Mid(FilePath, idx1 + 1)
    Else
        FileDir = ""
        FileName = Mid(FilePath, 1)
    End If
    modifiedFileDir = Replace(FileDir, "\", "/")
    
    ThisWorkbook.ActiveSheet.Cells(startRow, dir_column).Value = FileDir
    ThisWorkbook.ActiveSheet.Cells(startRow, modifiedDir_column).Value = modifiedFileDir
    ThisWorkbook.ActiveSheet.Cells(startRow, fileName_column).Value = FileName
    Call setCellStyle(startRow, dir_column)
    Call setCellStyle(startRow, modifiedDir_column)
    Call setCellStyle(startRow, fileName_column)
    startRow = startRow + 1
    
    getFileColumn = startRow
    
    Application.ScreenUpdating = True
    Application.ShowWindowsInTaskbar = True
    Application.DisplayAlerts = True
  
End Function

Sub get_filelist()

    Dim strFileList() As String
    Dim iStartRow As Long
    Dim rootPath As String
    Dim j, k As Long
    Dim iRow As Long
    
    rootPath = ThisWorkbook.Path
    iStartRow = 1
    Call setCellStyle(iStartRow, dir_column, 15, 3, 10)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, dir_column).Value = "目录"
    
    Call setCellStyle(iStartRow, modifiedDir_column, 15, 3, 10)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, modifiedDir_column).Value = "变换后目录"
    
    Call setCellStyle(iStartRow, fileName_column, 15, 3, 10)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, fileName_column).Value = "文件名"
    iStartRow = iStartRow + 1
    
    Call setCellStyle(iStartRow, dir_column, 15, 3, 23)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, dir_column).Value = "\"
    
    Call setCellStyle(iStartRow, modifiedDir_column, 15, 3, 23)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, modifiedDir_column).Value = "/"
    
    Call setCellStyle(iStartRow, fileName_column, 15, 3, 23)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, fileName_column).Value = ""
    iStartRow = iStartRow + 1

    j = CreateListFile(rootPath, "*" & ".*", strFileList)
    For k = 0 To j - 1
        iStartRow = getFileColumn(iStartRow, rootPath, strFileList(k))
    Next k
    
    Call MsgBox("读取完毕", vbOKOnly + vbExclamation)
    
End Sub

Public Sub setFullPath(startRow As Long, flagRow As Long, column1 As Long, column2 As Long)
    Dim iRow As Long
    With ThisWorkbook.ActiveSheet
        For iRow = startRow To .UsedRange.Row + .UsedRange.Rows.Count - 1
            If Len(Trim(.Cells(iRow, column1).Value)) = 0 Then
                GoTo next_for
            End If
            Call setCellStyle(iRow, column2)
            .Cells(iRow, column2).Value = .Cells(iRow, column2).Value & .Cells(iRow, column1).Value & .Cells(flagRow, column1).Value
next_for:
        Next
    End With

End Sub


Sub fullpath_Click()
    Dim iColumn As Integer
    Dim c As Range
    
    With ThisWorkbook.ActiveSheet
        For iRow = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1
            .Cells(iRow, fullpath_column).Value = ""
        Next
    End With

    Call setCellStyle(1, fullpath_column, 15, 3, 23)
    ThisWorkbook.ActiveSheet.Cells(1, fullpath_column).Value = "全目录"

    With ThisWorkbook.Worksheets("setting")
        For iColumn = 1 To .UsedRange.column + .UsedRange.Columns.Count - 1
            If Len(Trim(.Cells(1, iColumn).Value)) = 0 Then
                Exit For
            End If
            
            Set c = ThisWorkbook.ActiveSheet.UsedRange.Rows(1).Find(what:=.Cells(1, iColumn).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                Call setFullPath(3, 2, c.column, fullpath_column)
            End If
            
        Next
    End With

End Sub