frmnew.frm

用XML做专家系统的一个编译器,有说明书,使用简单,有模板

Private Sub Command1_Click()
Select Case SSTab1.Tab
'Files
Case 0:
    Select Case ListView1.SelectedItem.Index
    'xml file
    Case 1:
        NewXMLFile
    'Project file
    Case 2:
        NewPrjFile
    'DTD file
    Case 3:
        NewDtdFile
    'Text file
    Case 4:
        NewTextFile
    End Select

'Projects
Case 1:

End Select
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command4_Click()
Dim BI As BROWSEINFO
  Dim nFolder As Long
  Dim IDL As ITEMIDLIST
  Dim pIdl As Long
  Dim sPath As String
  Dim SHFI As SHFILEINFO
  
  With BI
    ' The dialog's owner window...
    .hOwner = Me.hwnd
     
    ' Set the Browse dialog root folder
    nFolder = GetFolderValue(m_wCurOptIdx)
     
    ' Fill the item id list with the pointer of the selected folder item, rtns 0 on success
    ' ==================================================
    ' If this function fails because the selected folder doesn't exist,
    ' .pidlRoot will be uninitialized & will equal 0 (CSIDL_DESKTOP)
    ' and the root will be the Desktop.
    ' DO NOT specify the CSIDL_ constants for .pidlRoot !!!!
    ' The SHBrowseForFolder() call below will generate a fatal exception
    ' (GPF) if the folder indicated by the CSIDL_ constant does not exist!!
    ' ==================================================
    If SHGetSpecialFolderLocation(ByVal Me.hwnd, ByVal nFolder, IDL) = NOERROR Then
      .pidlRoot = IDL.mkid.cb
    End If
    
    ' Initialize the buffer that rtns the display name of the selected folder
    .pszDisplayName = String$(MAX_PATH, 0)
    
    ' Set the dialog's banner text
    .lpszTitle = "Browsing..."
    
    ' Set the type of folders to display & return
    ' -play with these option constants to see what can be returned
    .ulFlags = BIF_RETURNONLYFSDIRS
    
  End With
  
  ' Clear previous return vals before the
  ' dialog is shown (it might be cancelled)
  
  ' Show the Browse dialog
  pIdl = SHBrowseForFolder(BI)
  
  ' If the dialog was cancelled...
  If pIdl = 0 Then Exit Sub
    
  ' Fill sPath w/ the selected path from the id list
  ' (will rtn False if the id list can't be converted)
  sPath = String$(MAX_PATH, 0)
  SHGetPathFromIDList ByVal pIdl, ByVal sPath

  ' Display the path and the name of the selected folder
  Text2.Text = Left(sPath, InStr(sPath, vbNullChar) - 1)
  
  ' Frees the memory SHBrowseForFolder()
  ' allocated for the pointer to the item id list
  CoTaskMemFree pIdl
End Sub

Private Function GetFolderValue(wIdx As Integer) As Long
' Returns the value of the system folder constant specified by wIdx
' See BrowsDlg.bas for the system folder nFolder values
    
    ' The Desktop
    If wIdx < 2 Then
      GetFolderValue = 0
    
    ' Programs Folder --> Start Menu Folder
    ElseIf wIdx < 12 Then
      GetFolderValue = wIdx
    
    ' Desktop Folder --> ShellNew Folder
    Else   ' wIdx >= 12
      GetFolderValue = wIdx + 4
    End If

End Function

Private Sub Form_Load()
ListView1.View = lvwReport
ListView1.ColumnHeaders.Add , , "", ListView1.Width
ListView1.ListItems.Add 1, , "XML Document", 1, 1
ListView1.ListItems.Add 2, , "XML Project File", 2, 2
ListView1.ListItems.Add 3, , "Document Type Declaration File", 3, 3
ListView1.ListItems.Add 4, , "Text File", 4, 4
Text2.Text = App.path
End Sub

Private Sub NewXMLFile()
Dim str As String
Dim fsoSave As Scripting.FileSystemObject
Set fsoSave = CreateObject("Scripting.FileSystemObject")
If fsoSave.FolderExists(Text2.Text + "\") = False Then
    MsgBox "该路径不存在或不能访问", vbExclamation, "Dest3.0"
    Exit Sub
End If
If Text2.Text = "" Then
    MsgBox "路径为空", vbExclamation, "Dest3.0"
    Exit Sub
End If
fMainForm.LoadNewDoc
If Text1.Text = "" Then
    fMainForm.ActiveForm.Tag = fMainForm.ActiveForm.Caption + ".xml"
    str = Text2.Text + "\" + fMainForm.ActiveForm.Caption + ".xml"
Else
    fMainForm.ActiveForm.Caption = Text2.Text + "\" + Text1.Text + ".xml"
    fMainForm.ActiveForm.Tag = Text1.Text + ".xml"
    str = Text2.Text + "\" + Text1.Text + ".xml"
End If
Open str For Output As #1
Close #1
fMainForm.ActiveForm.Caption = str
Unload Me
End Sub

Private Sub ListView1_DblClick()
Select Case SSTab1.Tab
'Files
Case 0:
    Select Case ListView1.SelectedItem.Index
    'xml file
    Case 1:
        NewXMLFile
    'Project file
    Case 2:
        NewPrjFile
    'DTD file
    Case 3:
        NewDtdFile
    'Text file
    Case 4:
        NewTextFile
    End Select
    
'Projects
Case 1:

End Select
End Sub

Private Sub NewPrjFile()
Dim str As String
Dim fsoSave As Scripting.FileSystemObject
Set fsoSave = CreateObject("Scripting.FileSystemObject")
If fsoSave.FolderExists(Text2.Text + "\") = False Then
    MsgBox "该路径不存在或不能访问", vbExclamation, "Dest3.0"
    Exit Sub
End If
If Text2.Text = "" Then
    MsgBox "路径为空", vbExclamation, "Dest3.0"
    Exit Sub
End If
fMainForm.LoadNewDoc
If Text1.Text = "" Then
    fMainForm.ActiveForm.Tag = fMainForm.ActiveForm.Caption + ".prj"
    str = Text2.Text + "\" + fMainForm.ActiveForm.Caption + ".prj"
Else
    fMainForm.ActiveForm.Caption = Text2.Text + "\" + Text1.Text + ".xml"
    fMainForm.ActiveForm.Tag = Text1.Text + ".prj"
    str = Text2.Text + "\" + Text1.Text + ".prj"
End If
Open str For Output As #1
Close #1
fMainForm.ActiveForm.Caption = str
Unload Me
End Sub

Private Sub NewDtdFile()
Dim str As String
Dim fsoSave As Scripting.FileSystemObject
Set fsoSave = CreateObject("Scripting.FileSystemObject")
If fsoSave.FolderExists(Text2.Text + "\") = False Then
    MsgBox "该路径不存在或不能访问", vbExclamation, "Dest3.0"
    Exit Sub
End If
If Text2.Text = "" Then
    MsgBox "路径为空", vbExclamation, "Dest3.0"
    Exit Sub
End If
fMainForm.LoadNewDoc
If Text1.Text = "" Then
    fMainForm.ActiveForm.Tag = fMainForm.ActiveForm.Caption + ".dtd"
    str = Text2.Text + "\" + fMainForm.ActiveForm.Caption + ".dtd"
Else
    fMainForm.ActiveForm.Caption = Text2.Text + "\" + Text1.Text + ".xml"
    fMainForm.ActiveForm.Tag = Text1.Text + ".dtd"
    str = Text2.Text + "\" + Text1.Text + ".dtd"
End If
Open str For Output As #1
Close #1
fMainForm.ActiveForm.Caption = str
Unload Me
End Sub

Private Sub NewTextFile()
Dim str As String
Dim fsoSave As Scripting.FileSystemObject
Set fsoSave = CreateObject("Scripting.FileSystemObject")
If fsoSave.FolderExists(Text2.Text + "\") = False Then
    MsgBox "该路径不存在或不能访问", vbExclamation, "Dest3.0"
    Exit Sub
End If
If Text2.Text = "" Then
    MsgBox "路径为空", vbExclamation, "Dest3.0"
    Exit Sub
End If
fMainForm.LoadNewDoc
If Text1.Text = "" Then
    fMainForm.ActiveForm.Tag = fMainForm.ActiveForm.Caption + ".txt"
    str = Text2.Text + "\" + fMainForm.ActiveForm.Caption + ".txt"
Else
    fMainForm.ActiveForm.Caption = Text2.Text + "\" + Text1.Text + ".txt"
    fMainForm.ActiveForm.Tag = Text1.Text + ".txt"
    str = Text2.Text + "\" + Text1.Text + ".txt"
End If
Open str For Output As #1
Close #1
fMainForm.ActiveForm.Caption = str
Unload Me
End Sub