Maya崩溃文件查看器实用小工具发布

Mainfrm.frm

VERSION 5.00
Begin VB.Form Mainfrm 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Maya崩溃文件查看器"
   ClientHeight    =   4890
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   5805
   BeginProperty Font 
      Name            =   "微软雅黑"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Mainfrm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4890
   ScaleWidth      =   5805
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton OpenLastCrashBtn 
      Caption         =   "打开最后崩溃文件"
      Height          =   495
      Left            =   3720
      TabIndex        =   11
      Top             =   2880
      Width           =   1935
   End
   Begin VB.CommandButton OpenSelectBtn 
      Caption         =   "打开选中(默认版本)"
      Height          =   495
      Left            =   3720
      TabIndex        =   10
      Top             =   3480
      Width           =   1935
   End
   Begin VB.CommandButton CopyBtn 
      Caption         =   "复制选中到指定目录"
      Height          =   495
      Left            =   3720
      TabIndex        =   2
      Top             =   4080
      Width           =   1935
   End
   Begin VB.CommandButton RefreshBtn 
      Caption         =   "刷新"
      Height          =   375
      Left            =   3720
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.FileListBox File1 
      Height          =   4425
      Left            =   120
      Pattern         =   "*.ma"
      TabIndex        =   0
      Top             =   120
      Width           =   3375
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "@千渔软件"
      ForeColor       =   &H00808080&
      Height          =   255
      Left            =   120
      TabIndex        =   9
      Top             =   4560
      Width           =   900
   End
   Begin VB.Label MayaVersion 
      AutoSize        =   -1  'True
      Caption         =   "--"
      Height          =   255
      Left            =   3840
      TabIndex        =   8
      Top             =   2400
      Width           =   150
   End
   Begin VB.Label FileSize 
      AutoSize        =   -1  'True
      Caption         =   "--"
      Height          =   255
      Left            =   3840
      TabIndex        =   7
      Top             =   1680
      Width           =   150
   End
   Begin VB.Label CrashTime 
      AutoSize        =   -1  'True
      Caption         =   "--"
      Height          =   255
      Left            =   3840
      TabIndex        =   6
      Top             =   960
      Width           =   150
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "Maya版本"
      Height          =   255
      Left            =   3720
      TabIndex        =   5
      Top             =   2040
      Width           =   840
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "文档大小"
      Height          =   255
      Left            =   3720
      TabIndex        =   4
      Top             =   1320
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "崩溃时间"
      Height          =   255
      Left            =   3720
      TabIndex        =   3
      Top             =   600
      Width           =   720
   End
End
Attribute VB_Name = "Mainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim SelectPath As String
Dim SelectName As String

Private Sub CopyBtn_Click()
    If Dir(SelectPath) <> "" Then
        Dim filepath As String
        filepath = GetDialog("Save", "选择Maya文件", SelectName, "Maya文档", ".ma")
        If filepath <> "" Then
            FileCopy SelectPath, filepath
            MsgBox "复制完成"
        End If
    End If
End Sub

Private Sub File1_Click()
    Dim fileNames() As String
    Dim filename As String
    filename = File1.filename
    SelectName = filename
    On Error Resume Next
    SelectPath = Environ("TMP") & "\" & filename
    If Dir(SelectPath) = "" Then Exit Sub
    'CrashTime
    fileNames = Split(filename, ".")
    Dim Tcrashtime As String
    Tcrashtime = Left(fileNames(1), 4) & "/" & Mid(fileNames(1), 3, 2) _
    & "/" & Right(fileNames(1), 2) _
    & "  " & Left(fileNames(2), 2) & ":" & Right(fileNames(2), 2)
    CrashTime.Caption = Tcrashtime
    'DocumentSize
    FileSize.Caption = Int(FileLen(SelectPath) / 1024) & "kb"
    'MayaVersion
    Open SelectPath For Input As #1
    Dim Textline As String
    Dim position As Integer
    Do While Not EOF(1)
        Input #1, Textline
        position = InStr(1, Textline, "requires maya ")
        If position <> 0 Then
            Dim tString As String
            tString = Mid(Textline, position, 20)
            MayaVersion.Caption = Mid(tString, InStr(1, tString, Chr(34)) + 1, 4)
            Exit Do
        End If
    Loop
    Close #1
End Sub

Private Sub Form_Load()
    File1.Path = Environ("TMP")
End Sub

Private Sub Label1_Click()
    ShellExecute 0, "OPEN", "http://www.imxqy.com", 0, 0, 0
End Sub

Private Sub OpenLastCrashBtn_Click()
    If Dir(SelectPath) <> "" Then Shell "cmd /c start " & File1.List(File1.ListCount - 1), 0
End Sub

Private Sub OpenSelectBtn_Click()
    If Dir(SelectPath) <> "" Then Shell "cmd /c start " & SelectPath, 0
End Sub

Attribute VB_Name = "FileDialog"
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function SaveINI Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Public Function GetDialog(ByVal sMethod As String, ByVal sTitle As String, ByVal sFileName As String, ByVal jieshao As String, ByVal houzhui As String) As String
    On Error GoTo myError
    Dim rtn As Long, pos As Integer
    Dim file As OPENFILENAME
    file.lStructSize = Len(file)
    file.hInstance = App.hInstance
    file.lpstrFile = sFileName & String$(255 - Len(sFileName), 0)
    file.nMaxFile = 255
    file.lpstrFileTitle = String$(255, 0)
    file.nMaxFileTitle = 255
    file.lpstrInitialDir = ""
    file.lpstrFilter = jieshao
    file.lpstrTitle = sTitle
    If UCase(sMethod) = "OPEN" Then
        file.flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST
        rtn = GetOpenFileName(file)
    Else
        file.lpstrDefExt = houzhui
        file.flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST + OFN_OVERWRITEPROMPT
        rtn = GetSaveFileName(file)
    End If
    If rtn > 0 Then
        pos = InStr(file.lpstrFile, Chr$(0))
        If pos > 0 Then
            GetDialog = Left$(file.lpstrFile, pos - 1)
        End If
    End If
    Exit Function
myError:
    MsgBox "操作失败！", vbCritical + vbOKOnly, APP_NAME
End Function