form2.frm

图形显示程序试验实时数据的存贮和曲线的回放图形显示程序试验实时数据的存贮和曲线的回放

VERSION 5.00
Begin VB.Form Form2 
   Caption         =   "产品参数设定"
   ClientHeight    =   5610
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8925
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5610
   ScaleWidth      =   8925
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      Height          =   2655
      Left            =   1800
      TabIndex        =   2
      Top             =   1320
      Width           =   5295
      Begin VB.TextBox Text2 
         Height          =   615
         Left            =   2520
         TabIndex        =   4
         Top             =   1560
         Width           =   1935
      End
      Begin VB.TextBox Text1 
         Height          =   615
         Left            =   2520
         TabIndex        =   3
         Top             =   480
         Width           =   1935
      End
      Begin VB.Label Label2 
         Caption         =   "产品批次"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   735
         Left            =   360
         TabIndex        =   6
         Top             =   1560
         Width           =   1575
      End
      Begin VB.Label Label1 
         Caption         =   "线缆型号"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   360
         TabIndex        =   5
         Top             =   480
         Width           =   1335
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   735
      Left            =   5280
      TabIndex        =   1
      Top             =   4320
      Width           =   1815
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   735
      Left            =   480
      TabIndex        =   0
      Top             =   4320
      Width           =   1695
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "产品参数设定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1920
      TabIndex        =   7
      Top             =   480
      Width           =   4935
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Path As String
Dim LineNameFolder As String
Dim LineNumFile As String
Dim fso As FileSystemObject


Private Sub Command1_Click()
Path = "c:"
LineNameFolder = Text1.Text   '要创建的文件夹名称（线缆型号）
LineNumFile = Text2.Text & ".dat" '要创建的新的批次文件

LineNameFolderX = LineNameFolder
LineNumFileX = LineNumFile

Dim ErrorS1 As String
Dim ErrorS2 As String
Dim ErrorS3 As String

'有重名文件夹的提示
ErrorS1 = "该型号文件夹已经存在" & vbCr & vbLf & "将在这个文件夹下生成新的文件"
'有重名文件的提示
ErrorS2 = "该型号文件夹已经存在" & vbCr & vbLf & "该批次文件已经存在" & vbCr & vbLf & "请输入不同的批次"

'有重名的文件夹并且在该文件夹下有重名的文件
ErrorS3 = "该批次文件已经存在" & vbCr & vbLf & " 请输入不同的批次"


'有重名的文件夹
If JudgeFolderExsit(Path, LineNameFolder) = False Then
     CreatNewFolder Path, LineNameFolder
     CreatNewFile Path, LineNameFolder, LineNumFile
     NewCreatFile = Path & "\" & LineNameFolder & "\" & LineNumFile '保存新建文件的完整路径
     
   Exit Sub
  
   
End If

'有重名的型号文件夹 分两种情况进行讨论
If JudgeFolderExsit(Path, LineNameFolder) = True Then
    '1.没有重名的文件
   If JudgeFileExsit(Path, LineNameFolder, LineNumFile) = False Then
     MsgBox ErrorS1, vbOKOnly, "输入提示" '错误提示
     CreatNewFile Path & "\", LineNameFolder, LineNumFile
     
    NewCreatFile = Path & "\" & LineNameFolder & "\" & LineNumFile '保存新建文件的完整路径

    Exit Sub
    End If
    '2. 并且有重名的文件
    If JudgeFileExsit(Path, LineNameFolder, LineNumFile) = True Then
        MsgBox ErrorS2, vbOKOnly, "输入提示" '错误提示
        Text2.SelStart = 0                   '选中已经输入的字符
        Text2.SelLength = Len(Text2.Text)
        Text2.SetFocus
    Exit Sub
     End If
End If
End Sub

Private Sub Command2_Click()
Unload Me
End Sub
Private Function JudgeFolderExsit(Path As String, FolderName As String) As Boolean
 Dim fso As FileSystemObject
 Dim PathAndFolderName  As String
 
 Set fso = New FileSystemObject
 PathAndFolderName = Path & "\" & FolderName
 
If fso.FolderExists(PathAndFolderName) Then
    JudgeFolderExsit = True
Else
JudgeFolderExsit = False
End If
Set fso = Nothing

End Function

Private Function JudgeFileExsit(Path As String, FolderName As String, FileName As String) As Boolean
Dim fso As FileSystemObject
 Dim PathAndFolderName  As String
 Dim PathFolderFileName  As String
 
 PathAndFolderName = Path & "\" & FolderName
PathFolderFileName = PathAndFolderName & "\" & FileName

Set fso = New FileSystemObject
 If fso.FileExists(PathFolderFileName) Then
 JudgeFileExsit = True
 Else
 JudgeFileExsit = False
 End If
 
 Set fso = Nothing
 
End Function

Private Sub CreatNewFolder(Path As String, FolderName As String)
Dim fso As FileSystemObject
Dim fol As Folder
Set fso = New FileSystemObject
Dim PathAndFolderName  As String

PathAndFolderName = Path & "\" & FolderName

Set fol = fso.CreateFolder(PathAndFolderName)
If fol <> "" Then

     MsgBox "创建文件夹成功"
 Else
 MsgBox "创建文件失败"
End If
Set fso = Nothing

End Sub
Private Sub CreatNewFile(Path As String, FolderName As String, FileName As String)
Dim fso As FileSystemObject
Dim fol As Folder
Dim fil As File

Set fso = New FileSystemObject
Dim PathAndFolderName  As String
Dim PathFolderFileName  As String
 
PathAndFolderName = Path & "\" & FolderName
PathFolderFileName = PathAndFolderName & "\" & FileName
Set fol = fso.GetFolder(PathAndFolderName)

fol.CreateTextFile (FileName)
Set fil = fso.GetFile(PathFolderFileName)

    If fil <> "" Then
     MsgBox "创建文件成功"
     Else
     MsgBox "创建文件失败请重试"
    End If
    Set fso = Nothing
    
End Sub