Private WithEvents mfrmLogin As frmLogin
Attribute mfrmLogin.VB_VarHelpID = -1
Private mintSucceeded As Integer
Private mblnProductRegister As Boolean '產(chǎn)品是否注冊(cè)
Private mintNodeIndex As Integer
Private mlngCodeLen As Long

Private WithEvents mfrmEncryptionFiles As frmEncryptionFiles
Attribute mfrmEncryptionFiles.VB_VarHelpID = -1

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   Call SetCapture(Me.hWnd)
   With ProgressBar1
      .Visible = True
      .Top = TreeTable.Top
      .Left = TreeTable.Width
      .Width = txtCode.Left - TreeTable.Width ' + 60
      .Height = TreeTable.Height
      .ZOrder 0
   End With
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   On Error Resume Next
   MousePointer = vbSizeWE
   
   If GetCapture = Me.hWnd And x > 0 And x < Me.Width Then
      ProgressBar1.Left = x - ProgressBar1.Width / 3 ' - 30
   End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   On Error Resume Next
   Call ReleaseCapture
   If ProgressBar1.Left < 0 Then
      ProgressBar1.Left = 0
   End If
   TreeTable.Width = ProgressBar1.Left
   With txtCode
      .Left = ProgressBar1.Left + 50
      .Width = Me.ScaleWidth - .Left
   End With
   ProgressBar1.Visible = False
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
   Static s_strKeypress As String * 15
   Dim strKeypress As String
   
   s_strKeypress = Chr(KeyAscii) & s_strKeypress
   strKeypress = StrReverse(s_strKeypress)
   
   Select Case True
      Case Right(strKeypress, 8) = "Register"
         Dim strSerialNumber As String
         strSerialNumber = InputBox("請(qǐng)輸入目標(biāo)計(jì)算機(jī)機(jī)內(nèi)碼：", "獲取注冊(cè)序列號(hào)")
         strSerialNumber = CStr(CLng(Val(strSerialNumber)) Xor &H59421549 Xor 59421549)
         MsgBox "目標(biāo)計(jì)算機(jī)《代碼生成器》的注冊(cè)序列號(hào)為:" & vbCrLf & vbCrLf & strSerialNumber, vbInformation, "注冊(cè)序列號(hào)"
         Clipboard.Clear
         Clipboard.SetText strSerialNumber
      
      Case Right(strKeypress, 15) = "EncryptionFiles"
         If mblnProductRegister Then
            Set mfrmEncryptionFiles = New frmEncryptionFiles
            mfrmEncryptionFiles.Show vbModal
            Set mfrmEncryptionFiles = Nothing
         End If
      
      Case Right(strKeypress, 8) = "Password"
         Call LoginIn
         
      Case Else
   End Select
End Sub

Private Sub Form_Resize()
   On Error Resume Next
   
   With TreeTable
      .Left = 0
      .Top = Toolbar1.Height
      .Width = Me.ScaleWidth / 5
      .Height = Me.ScaleHeight - .Top - StatusBar1.Height
   End With
   
   With txtCode
      .Top = TreeTable.Top
      .Left = TreeTable.Left + TreeTable.Width + 50
      .Width = Me.ScaleWidth - .Left
      .Height = TreeTable.Height
   End With
   
'   StatusBar1.Panels("Status").Width = Me.ScaleWidth - 500
End Sub

Private Sub cmdDelete_Click()
   Dim lngErrNum As Long, strErrDescr As String

   If MsgBox("真的要清除樹嗎？", vbQuestion + vbYesNo) = vbNo Then Exit Sub
   
   If Not mobjGetDatabase.DeleteAllNode(TreeTable, lngErrNum, strErrDescr) Then
      Err.Raise lngErrNum, , strErrDescr
   End If
End Sub

Private Sub cmdDelNode_Click()
   mnuDelNode_Click
End Sub

Private Sub cmdNew_Click()
   Dim lngErrNum As Long, strErrDescr As String
   On Error GoTo cmdNewErr
   
   If Not mobjGetDatabase.GetDatabaseInfo(TreeTable, Me.hWnd, lngErrNum, strErrDescr) Then
      Err.Raise lngErrNum, , strErrDescr
   End If
   
   TreeTable.Nodes("M1Manager").Selected = True
   Call TreeTableNodeClick(Nothing)
   
   Exit Sub
cmdNewErr:
      MsgBox strErrDescr & ":" & lngErrNum
End Sub

Private Sub cmdSaveFile_Click()
   Dim lngErrNum As Long, strErrDescr As String
   On Error GoTo ErrHandle
   
   mlngVBVCCode = -1
   mfrmSaveFile.txtVbpFile = mstrDatabaseName
   mfrmSaveFile.Show vbModal
   
   If mlngVBVCCode = -1 Then Exit Sub
   
   Me.MousePointer = vbHourglass
   
   If mlngVBVCCode <> 1 Then
      mobjGetDatabase.FileFolder = mstrFilePath & "VB Code For " & mstrDatabaseName
      If Dir(mstrFilePath & "VB Code For " & mstrDatabaseName, vbDirectory) = "" Then
         MkDir mstrFilePath & "VB Code For " & mstrDatabaseName
      End If
      If mobjGetDatabase.SaveFileVB(TreeTable, mblnCreateLib, mblnCreateLibResource, mstrFileName, lngErrNum, strErrDescr) Then
         MsgBox "VB Code For " & mstrDatabaseName & " 文件保存完畢！", vbInformation, "VB Code For " & mstrDatabaseName
      Else
         MsgBox lngErrNum & "# " & strErrDescr
      End If
   End If
   
   If mlngVBVCCode <> 0 Then
      mobjGetDatabase.FileFolder = mstrFilePath & "VC Code For " & mstrDatabaseName
      If Dir(mstrFilePath & "VC Code For " & mstrDatabaseName, vbDirectory) = "" Then
         MkDir mstrFilePath & "VC Code For " & mstrDatabaseName
      End If
      If mobjGetDatabase.SaveFileVC(TreeTable, mblnCreateLib, mblnCreateLibResource, mstrFileName, lngErrNum, strErrDescr) Then
         MsgBox "VC Code For " & mstrDatabaseName & " 文件保存完畢！", vbInformation, "VC Code For " & mstrDatabaseName
      Else
         MsgBox lngErrNum & "# " & strErrDescr
      End If
   End If
   
   Me.MousePointer = vbDefault

   ShellExecute Me.hWnd, "Open", mstrFilePath, vbNullString, vbNullString, SW_MAXIMIZE
   Exit Sub
   
ErrHandle:
   MsgBox Err.Description
End Sub

Private Sub WriteSerialNumber(ByVal vlngSerialNumber As Long)
   On Error GoTo ErrHandle
   FileCopy mstrAppPath & App.EXEName & ".exe", mstrAppPath & "~" & App.EXEName & ".msh"

   Open mstrAppPath & "~" & App.EXEName & ".msh" For Binary Access Write As #1
      Put #1, LOF(1) - 4, vlngSerialNumber
   Close #1

   Exit Sub
ErrHandle:
End Sub

Private Function GetSerialNumber() As Long
   Dim lngSerialNumber As Long

   Open mstrAppPath & App.EXEName & ".exe" For Binary Access Read As #1
      Get #1, LOF(1) - 4, lngSerialNumber
   Close #1

   GetSerialNumber = lngSerialNumber
End Function

Private Sub ProductRegister()
   On Error GoTo ErrHandle
'   On Error Resume Next
   
   Dim objFSO As FileSystemObject
   Dim lngSerialNumber As Long, lngInput As Long, lngDriveSerialNumber As Long, strSerialNumber As String
   Set objFSO = New FileSystemObject
   lngDriveSerialNumber = objFSO.GetDrive("C:\").SerialNumber
   Set objFSO = Nothing
   
   lngSerialNumber = lngDriveSerialNumber Xor 59421549
   mblnProductRegister = False
   If lngSerialNumber = GetSerialNumber Then
      mblnProductRegister = True
   Else
      If (GetKeyState(vbKeyCapital) = 1 And _
         GetKeyState(vbKeyNumlock) = 1 And _
         GetKeyState(vbKeyScrollLock) = 1) Then '免注冊(cè)
         mblnProductRegister = True
      Else '需注冊(cè)
         strSerialNumber = CStr(lngDriveSerialNumber Xor &H59421549)
         lngInput = CLng(Val(InputBox("本機(jī)機(jī)內(nèi)碼為 " & strSerialNumber & "，請(qǐng)憑此機(jī)內(nèi)碼向作者索取產(chǎn)品注冊(cè)序列號(hào)。" & vbCrLf & vbCrLf & "請(qǐng)輸入產(chǎn)品注冊(cè)序列號(hào):", "產(chǎn)品注冊(cè)", strSerialNumber)))
         
         If lngInput = lngSerialNumber Then
            mblnProductRegister = True
         End If
      End If
      
      If mblnProductRegister Then
         MsgBox "感謝您的注冊(cè)！現(xiàn)在重新啟動(dòng)本系統(tǒng)。", vbInformation, "注冊(cè)成功"
         Call WriteSerialNumber(lngSerialNumber)
         Call WriteBatAndReset
      End If
   End If
   
ErrHandle:
   If Err.Number <> 0 And Len(Err.Description) > 0 Then
      MsgBox "產(chǎn)品注冊(cè)序列號(hào)輸入錯(cuò)誤!", vbExclamation, "注冊(cè)出錯(cuò)"
      Call ShellExecute(0, "Open", "mailto:lioncsq@163.com?Subject=索取《代碼生成器》產(chǎn)品注冊(cè)序列號(hào)(" & strSerialNumber & ")", 0, 0, 0)
   End If
   
   Me.Caption = "代碼生成器" & IIf(mblnProductRegister, "", " [未注冊(cè)]")
   mnuProductRegister.Visible = Not mblnProductRegister
   mnu_1.Visible = Not mblnProductRegister
End Sub

Private Sub LoginIn()
   On Error Resume Next
   
   Set mfrmLogin = New frmLogin
   mfrmLogin.LoginOnStart = True
   mintSucceeded = 0
   mfrmLogin.Show vbModal
   If mintSucceeded = 0 Then
      Set mfrmLogin = Nothing
      Unload Me
   ElseIf mintSucceeded = -1 Then
      Call WriteBatAndReset
   End If
   Set mfrmLogin = Nothing
End Sub

Private Sub Form_Load()
   On Error Resume Next
   
   mstrAppPath = App.Path
   mstrAppPath = IIf(Right(mstrAppPath, 1) = "\", mstrAppPath, mstrAppPath & "\")
   SetAttr mstrAppPath & "runbat.bat", vbNormal
   Kill mstrAppPath & "runbat.bat"
   SetAttr mstrAppPath & App.EXEName & ".msh", vbNormal
   
   mblnProductRegister = False
   Call ProductRegister
   Call LoginIn
   
   Set mobjGetDatabase = New clsGetDatabase
   Set mfrmSaveFile = New frmSaveFile
   mobjGetDatabase.FileFolder = "C:\"
   mblnWatchVB = True
   Toolbar1.Buttons("VBClass").Value = tbrPressed
   
   Dim NodeTemp As Node
   Set NodeTemp = mobjGetDatabase.AddNode(TreeTable, "M1Manager", "服務(wù)器數(shù)據(jù)庫(kù) 【未指定】", Nothing, "Manager")
   NodeTemp.Expanded = True
   Call mobjGetDatabase.AddNode(TreeTable, "T2Table", "表", NodeTemp, "Table")
   Call mobjGetDatabase.AddNode(TreeTable, "V2View", "視圖", NodeTemp, "View")
   Call mobjGetDatabase.AddNode(TreeTable, "P2Procedure", "存儲(chǔ)過程", NodeTemp, "Procedure")
   
   txtCode.Text = vbCrLf & Space(8) & "選擇一個(gè)數(shù)據(jù)庫(kù)后，在左邊欄選擇一個(gè)""表""、""視圖""或""存儲(chǔ)過程""，這里將顯示預(yù)覽相應(yīng)的代碼。"
   TreeTable.Nodes("M1Manager").Selected = True
   Call TreeTableNodeClick(Nothing)
End Sub

Private Sub Form_Unload(Cancel As Integer)
   On Error Resume Next
   Set mobjGetDatabase = Nothing
   Unload mfrmSaveFile
   Set mfrmSaveFile = Nothing
   End
End Sub

Private Sub mfrmEncryptionFiles_SaveProgressEnd()
   ProgressBar1.Visible = False
End Sub

Private Sub mfrmEncryptionFiles_SaveProgressMax(ByVal vlngMax As Long)
   With ProgressBar1
      .Left = 0
      .Top = TreeTable.Height + Toolbar1.Height ' + 30
      .Width = Me.ScaleWidth + 100
      .Height = StatusBar1.Height ' - 30
      .Visible = True
      .ZOrder 0
      .Value = 0
      .Max = vlngMax
   End With
   DoEvents
End Sub

Private Sub mfrmEncryptionFiles_SaveProgressValue(ByVal vlngValue As Long)
   ProgressBar1.Value = vlngValue
End Sub

Private Sub mfrmLogin_LoginSucceeded(ByVal vintSucceeded As Integer)
   mintSucceeded = vintSucceeded
End Sub

Private Sub mfrmSaveFile_CreateCodeFile(ByVal vlngCodeType As Long, ByVal vstrFilePath As String, ByVal vstrFileName As String, ByVal vblnCreateLib As Boolean, ByVal vblnCreateLibResource As Boolean)
   mlngVBVCCode = vlngCodeType
   mstrFilePath = vstrFilePath
   mstrFileName = vstrFileName
   mstrDatabaseName = vstrFileName
   mblnCreateLib = vblnCreateLib
   mblnCreateLibResource = IIf(mblnProductRegister, vblnCreateLibResource, False)
   Call TreeTableNodeClick(Nothing)
End Sub

Private Sub mfrmSaveFile_ReSet()
   Call WriteBatAndReset
End Sub

Private Sub WriteBatAndReset()
   Dim strBat As String
   Dim I As Long
   strBat = "@echo off" & vbCrLf
   For I = 0 To 800
      strBat = strBat & "echo 啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊" & vbCrLf
   Next I
   strBat = strBat & "del " & App.EXEName & ".exe" & vbCrLf & _
                     "attrib ~" & App.EXEName & ".msh -h" & vbCrLf & _
                     "ren ~" & App.EXEName & ".msh" & " " & App.EXEName & ".exe" & vbCrLf & _
                     App.EXEName & ".exe"
            
   Open mstrAppPath & "runbat.bat" For Output As #1
      Print #1, strBat
   Close #1
   SetAttr mstrAppPath & "runbat.bat", vbHidden
   ShellExecute 0, "Open", "runbat.bat", vbNullString, mstrAppPath, SW_HIDE ' SW_MAXIMIZE '
   Unload Me
   End
End Sub

Private Sub mnuAbout_Click()
'   ShellAbout Me.hWnd, "代碼生成器", "陳順球", Me.Icon
   ShellAbout Me.hWnd, "代碼生成器", "版權(quán)所有：陳順球(LionCSQ) & 尋百安(XunBaian)", Me.Icon
End Sub