Private Const ANYSIZE_ARRAY = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2

Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const EWX_POWEROFF = 8

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private Type LUID
LowPart As Long
HighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Private Const FO_MOVE = &H1
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_RENAME = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SILENT = &H4
Private Const FOF_NOERRORUI = &H400
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
hwnd  As Long
wFunc  As Long
pFrom  As String
pTo  As String
fFlags  As Integer
fAnyOperationsAborted  As Long
hNameMappings  As Long
lpszProgressTitle  As String
End Type

Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const PROCESS_QUERY_INformATION = &H400
Private Const STILL_ACTIVE = &H103
Dim pidNotepad As Long
Dim hProcess As Long

Dim WinDir As String
Dim SystemDrive As String
Const D As Long = 10
Const P As Long = 4
Const L As Long = 24

Private Sub Combo1_Click()
  Cmp1
End Sub

Private Sub Combo4_Click()
  Cmp2
End Sub

Private Sub Command1_Click()
  Shell WinDir & "\explorer.exe  ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}", vbNormalFocus
End Sub

Private Sub Command2_Click()
  Dim flag As Long
  flag = MsgBox("确认要重启计算机吗?", vbYesNo, "Easy Ghost")
  If flag = vbYes Then
    Call RebootPC
  End If
End Sub

Private Sub Command3_Click()
  Dim flag As Long
  flag = MsgBox("确认要关闭计算机吗?", vbYesNo, "Easy Ghost")
  If flag = vbYes Then
    Call ShutDownPC
  End If
End Sub

Private Sub Command4_Click()
  CommonDialog1.CancelError = True
  On Error GoTo ErrHandler
  CommonDialog1.Flags = cdlOFNHideReadOnly
  CommonDialog1.Filter = "所有程序 (*.*)|*.*|Ghost 镜像文件 (*.gho)|*.gho"
  CommonDialog1.FilterIndex = 2
  CommonDialog1.ShowSave
  Text1.Text = CommonDialog1.FileName
  Exit Sub
ErrHandler:
  Exit Sub
End Sub

Private Sub Command5_Click()
  Dim DrvS As String, DrvD As String
  Dim FilePath As String
  Dim Compress As String
  Dim CRC As String
  Dim flag As Long
  Dim t As Integer
  t = test
  Select Case Command5.Caption
    Case "开始备份"
      If t <> 0 Then
        'MsgBox Str$(t)
        MsgBox "备份所需文件已被破坏,请勿删除C盘下" & Chr(34) & "SKEG" & Chr(34) & "文件夹以及该文件夹内的任何文件,请重新运行本程序进行修复!", vbOKOnly, "Easy Ghost"
        Exit Sub
      End If
      If Combo1.Text = "" Then
        MsgBox "请选择要备份的分区.", vbOKOnly, "Easy Ghost"
        Exit Sub
      Else
        DrvS = P_to_S(Mid(Combo1.Text, 5, 1))
      End If
      If Text1.Text = "" Then
        MsgBox "请填写保存备份的位置.", vbOKOnly, "Easy Ghost"
        Exit Sub
      Else
        Text1.Text = LTrim(Text1.Text)
        DrvD = P_to_S(Left(Text1.Text, 1))
        FilePath = Mid(Text1.Text, 3, Len(Text1.Text))
        FilePath = DrvD & FilePath
      End If
      If Combo2.Text = "" Then
        MsgBox "请选择要适用的Ghost的版本.", vbOKOnly, "Easy Ghost"
        Exit Sub
      Else
        If Dir("C:" & "\SKEG\GHOST.exe") <> "" Then
          Kill "C:" & "\SKEG\GHOST.exe"
        End If
        Select Case Combo2.Text
          Case "Ghost8.3"
            FileCopy "C:" & "\SKEG\GHOST83.exe", "C:" & "\SKEG\GHOST.exe"
          Case "Ghost11.0"
            FileCopy "C:" & "\SKEG\GHOST11.exe", "C:" & "\SKEG\GHOST.exe"
        End Select
      End If
      If Combo3.Text = "" Then
        MsgBox "请选择适当的压缩率.", vbOKOnly, "Easy Ghost"
        Exit Sub
      Else
        Select Case Combo3.Text
          Case "快速压缩"
            Compress = " -z1"
          Case "高压缩"
            Compress = " -z2"
          Case "极限压缩"
            Compress = " -z9"
        End Select
      End If
      Call Prepare
      Open "C:" & "\SKEG\Ghost.bat" For Output As #1
      Print #1, "cls"
      Print #1, "@echo off"
      Print #1, "xmsman -c>nul"
      Print #1, "Ghost.exe -nousb -clone,mode=pdump,src=" & DrvS & ",dst=" & FilePath & " -sure -fro -rb" & Compress
      Close #1
      flag = MsgBox("分区备份已准备完毕,重启计算机即会开始执行备份,是否现在重启计算机?", vbYesNo, "Easy Ghost")
      If flag = vbYes Then
        RebootPC
      End If
   
    Case "开始还原"
      If t <> 0 Then
        'MsgBox Str$(t)
        MsgBox "备份所需文件已被破坏,请勿删除C盘下" & Chr(34) & "SKEG" & Chr(34) & "文件夹以及该文件夹内的任何文件,请重新运行本程序进行修复!", vbOKOnly, "Easy Ghost"
        Exit Sub
      End If
      If Text2.Text = "" Then
        MsgBox "请填写读取备份的位置.", vbOKOnly, "Easy Ghost"
        Exit Sub
      Else
        Text2.Text = LTrim(Text2.Text)
        DrvS = P_to_S(Left(Text2.Text, 1))
        FilePath = Mid(Text2.Text, 3, Len(Text2.Text))
        FilePath = DrvS & FilePath
      End If
      If Combo4.Text = "" Then
        MsgBox "请选择要恢复的分区.", vbOKOnly, "Easy Ghost"
        Exit Sub
      Else
        DrvD = P_to_S(Mid(Combo4.Text, 5, 1))
      End If
      If Combo5.Text = "" Then
        MsgBox "请选择要适用的Ghost的版本.", vbOKOnly, "Easy Ghost"
        Exit Sub
      Else
        If Dir("C:" & "\SKEG\GHOST.exe") <> "" Then
          Kill "C:" & "\SKEG\GHOST.exe"
        End If
        Select Case Combo5.Text
          Case "Ghost8.3"
            FileCopy "C:" & "\SKEG\GHOST83.exe", "C:" & "\SKEG\GHOST.exe"
          Case "Ghost11.0"
            FileCopy "C:" & "\SKEG\GHOST11.exe", "C:" & "\SKEG\GHOST.exe"
        End Select
      End If
      If Check1.Value = 1 Then
        CRC = " -crcignore"
      Else
        CRC = ""
      End If
      Call Prepare
      Open "C:" & "\SKEG\Ghost.bat" For Output As #1
      Print #1, "cls"
      Print #1, "@echo off"
      Print #1, "xmsman -c>nul"
      Print #1, "Ghost.exe -nousb -clone,mode=pload,src=" & FilePath & ":1,dst=" & DrvD & CRC & " -sure -rb "
      Close #1
      flag = MsgBox("分区恢复已准备完毕,重启计算机即会开始执行恢复,是否现在重启计算机?", vbYesNo, "Easy Ghost")
      If flag = vbYes Then
        RebootPC
      End If
   
    Case "退出"
      goEnd
   
  End Select
End Sub

Private Sub Command6_Click()
  CommonDialog2.CancelError = True
  On Error GoTo ErrHandler
  CommonDialog2.Flags = cdlOFNHideReadOnly
  CommonDialog2.Filter = "所有程序 (*.*)|*.*|Ghost 镜像文件 (*.gho)|*.gho"
  CommonDialog2.FilterIndex = 2
  CommonDialog2.ShowOpen
  Text2.Text = CommonDialog2.FileName
  Exit Sub
ErrHandler:
  Exit Sub
End Sub

Private Sub Form_Load()
  Dim Partition(24) As String, Sector(24) As String
  Dim i As Integer
  WinDir = Environ("windir")
  SystemDrive = Environ("systemdrive")
  Call Move_to_Center
  If LostSD = 1 Then
    MsgBox "您的操作系统可能为Windows Vista，或者您的C盘并非您的系统引导分区,这种情况下不适合使用本软件,抱歉!", vbOKOnly, "Easy Ghost"
    goEnd
  End If
  For i = 1 To 24
    Partition(i) = "NA"
  Next
  Call Ghost_Info
  Call P_S(Partition(), Sector())
  Call Compressibility_Info
  For i = 1 To 24
  '  Debug.Print Partition(i) & Sector(i)
    If Partition(i) <> "NA" Then
      Combo1.AddItem "分区: " & Partition(i) & "  (" & "扇区: " & Sector(i) & ")", i - 1
      Combo4.AddItem "分区: " & Partition(i) & "  (" & "扇区: " & Sector(i) & ")", i - 1
    Else
      Exit For
    End If
  Next
End Sub

Public Function Scan(DP() As String) As String
  Dim s As String
  Dim i As Integer, j As Integer, k As Integer
  For i = 0 To D
    For j = 0 To P
      For k = 0 To L
        DP(i, j, k) = "NA"
      Next k
    Next j
  Next i
  s = ""
  i = 0
  j = 0
  k = 0
  ComputerName = "."
  Set wmiServices = GetObject _
          ("winmgmts:{impersonationLevel=Impersonate}!//" & ComputerName)
  Set wmiDiskDrives = wmiServices.ExecQuery _
                  ("SELECT  Caption,  DeviceID  FROM  Win32_DiskDrive")
  For Each wmiDiskDrive In wmiDiskDrives
          s = s & wmiDiskDrive.Caption & "  (" & wmiDiskDrive.DeviceID & ")"
          s = s & Chr(13) & Chr(10)
          i = i + 1
          strEscapedDeviceID = Replace(wmiDiskDrive.DeviceID, "\", "\\", 1, -1, vbTextCompare)
          Set wmiDiskPartitions = wmiServices.ExecQuery _
                  ("ASSOCIATORS  OF  {Win32_DiskDrive.DeviceID=""" & _
                          strEscapedDeviceID & """}  WHERE  AssocClass  =  Win32_DiskDriveToDiskPartition")
          For Each wmiDiskPartition In wmiDiskPartitions
                  s = s & Chr(13) & Chr(10) & wmiDiskPartition.DeviceID
                  j = j + 1
                  Set wmiLogicalDisks = wmiServices.ExecQuery _
                          ("ASSOCIATORS  OF  {Win32_DiskPartition.DeviceID=""" & _
                                  wmiDiskPartition.DeviceID & """}  WHERE  AssocClass  =  Win32_LogicalDiskToPartition")
                  For Each wmiLogicalDisk In wmiLogicalDisks
                          s = s & Chr(13) & Chr(10) & wmiLogicalDisk.DeviceID
                          k = k + 1
                          DP(i, j, k) = Left(wmiLogicalDisk.DeviceID, 1)
                  Next
                  s = s & Chr(13) & Chr(10)
                  DP(i, j, 0) = Str(k)
                  k = 0
          Next
          DP(i, 0, 0) = Str(j)
          j = 0
          s = s & Chr(13) & Chr(10)
  Next
  DP(0, 0, 0) = Str(i)
  Scan = s
End Function

Private Function Part_Sec(DP() As String, Partition() As String, Sector() As String) As String
  Dim i As Integer, j As Integer, k As Integer
  Dim m As Integer
  Dim s As String
  Dim an As Integer, bn As Integer
  an = 1
  bn = 1
  s = ""
  m = 1
  For i = 1 To Val(DP(0, 0, 0))
    s = s & "Disk" & Str(i) & Chr(13) & Chr(10)
    For j = 1 To Val(DP(i, 0, 0))
      s = s & "Partition" & Str(j) & Chr(13) & Chr(10)
      For k = 1 To Val(DP(i, j, 0))
        s = s & DP(i, j, k) & "  " & Str(i) & ":" & Str(m) & Chr(13) & Chr(10)
        Partition(an) = DP(i, j, k)
        Sector(bn) = LTrim(Str(i)) & ":" & LTrim(Str(m))
        an = an + 1
        bn = bn + 1
        m = m + 1
      Next k
    Next j
    m = 1
  Next i
  Part_Sec = s
End Function

Private Sub P_S(Partition() As String, Sector() As String)
  Dim DP(D, P, L) As String
  Dim Info1 As String, Info2 As String
  Info1 = Scan(DP())
  'Debug.Print Info1
  Info2 = Part_Sec(DP(), Partition(), Sector())
  'Debug.Print Info2
End Sub


Private Sub Form_Unload(Cancel As Integer)
  goEnd
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
  Select Case SSTab1.Tab
    Case 0
      Command5.Caption = "开始备份"
    Case 1
      Command5.Caption = "开始还原"
    Case 2, 3
      Command5.Caption = "退出"
  End Select
End Sub


Public Sub Ghost_Info()
  Dim Ghost(2) As String
  Dim i As Integer
  Dim j As Integer
  Ghost(1) = "Ghost8.3"
  Ghost(2) = "Ghost11.0"
  j = 2
  For i = 1 To j
    Combo2.AddItem Ghost(i), i - 1
    Combo5.AddItem Ghost(j + 1 - i), i - 1
  Next i
End Sub

Public Sub Compressibility_Info()
  Combo3.AddItem "快速压缩", 0
  Combo3.AddItem "高压缩", 1
  Combo3.AddItem "极限压缩", 2
End Sub

Public Function P_to_S(Part As String) As String
  Dim Partition(24) As String, Sector(24) As String
  Dim i As Integer
  Part = UCase(Part)
  Call P_S(Partition(), Sector())
  For i = 1 To 24
    If Partition(i) = Part Then
      P_to_S = Sector(i)
      Exit For
    End If
  Next
End Function

Private Sub EnableShutDown()
  Dim hProc As Long
  Dim hToken As Long
  Dim mLUID As LUID
  Dim mPriv As TOKEN_PRIVILEGES
  Dim mNewPriv As TOKEN_PRIVILEGES
  hProc = GetCurrentProcess()
  OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
  LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
  mPriv.PrivilegeCount = 1
  mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
  mPriv.Privileges(0).pLuid = mLUID
  AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub

Public Sub RebootPC()
  Dim ret As Long
  Dim Flags As Long
  Flags = EWX_REBOOT + EWX_FORCE
  Call EnableShutDown
  ExitWindowsEx Flags, 0
End Sub

Public Sub ShutDownPC()
  Dim ret As Long
  Dim Flags As Long
  Flags = EWX_SHUTDOWN
  Flags = Flags + EWX_FORCE
  Call EnableShutDown
  ExitWindowsEx Flags, 0
End Sub

Private Function KillPath(ByVal sPath As String) As Boolean
  On Error Resume Next
  Dim udtPath  As SHFILEOPSTRUCT
  udtPath.hwnd = 0
  udtPath.wFunc = FO_DELETE
  udtPath.pFrom = sPath
  udtPath.pTo = ""
  udtPath.fFlags = FOF_NOCONFIRMATION Or FOF_SILENT Or FOF_NOERRORUI
  KillPath = Not CBool(SHFileOperation(udtPath))
End Function

Private Sub Cmp1()
  Dim Drv1 As String, Drv2 As String
  Dim a(24) As String, b(24) As String
  Dim i As Integer, flag As Integer
  If Combo1.Text <> "" And Text1.Text <> "" Then
    Drv1 = Mid(Combo1.Text, 5, 1)
    Drv2 = Left(Text1.Text, 1)
    If UCase(Drv1) = UCase$(Drv2) Then
      MsgBox "将要进行备份的分区与要保存此备份的分区不能相同！", vbOKOnly, "Easy Ghost"
      Combo1.Text = ""
      Text1.Text = ""
      Exit Sub
    End If
    P_S a(), b()
    flag = 0
    For i = 1 To 24
      If UCase(Drv2) = a(i) Then
        flag = 1
        Exit For
      End If
    Next
    If flag = 0 Then
      MsgBox "保存备份的驱动器非硬盘，请选择硬盘上的分区来存储备份！", vbOKOnly, "Easy Ghost"
      Combo1.Text = ""
      Text1.Text = ""
      Exit Sub
    End If
  End If
End Sub

Private Sub Cmp2()
  Dim Drv1 As String, Drv2 As String
  Dim a(24) As String, b(24) As String
  Dim i As Integer, flag As Integer
  If Combo4.Text <> "" And Text2.Text <> "" Then
    Drv1 = Mid(Combo4.Text, 5, 1)
    Drv2 = Left(Text2.Text, 1)
    If UCase(Drv1) = UCase$(Drv2) Then
      MsgBox "将要执行恢复的分区与保存此备份的分区不能相同！", vbOKOnly, "Easy Ghost"
      Combo4.Text = ""
      Text2.Text = ""
      Exit Sub
    End If
    P_S a(), b()
    flag = 0
    For i = 1 To 24
      If UCase(Drv2) = a(i) Then
        flag = 1
        Exit For
      End If
    Next
    If flag = 0 Then
      MsgBox "要执行恢复的驱动器非硬盘，请选择硬盘上的分区来执行恢复！", vbOKOnly, "Easy Ghost"
      Combo4.Text = ""
      Text2.Text = ""
      Exit Sub
    End If
  End If
End Sub
Private Sub Text1_Change()
  Cmp1
End Sub

Private Sub Text2_Change()
  Cmp2
End Sub

Private Function test() As Integer
  Dim FileName(7) As String
  Dim i As Integer
  FileName(1) = "C:" & "\SKEG\" & "GHOST11.EXE"
  FileName(2) = "C:" & "\SKEG\" & "GHOST83.EXE"
  FileName(3) = "C:" & "\SKEG\" & "memdisk.gz"
  FileName(4) = "C:" & "\SKEG\" & "menu.lst"
  FileName(5) = "C:" & "\SKEG\" & "SKEG.img"
  FileName(6) = "C:" & "\boot_SK.ini"
  FileName(7) = "C:" & "\grldr"
  If Dir("C:" & "\SKEG", vbDirectory) = "" Then
    test = 10
    Exit Function
  End If
  For i = 1 To 7
    If Dir(FileName(i)) = "" Then
      test = i
      Exit Function
    End If
  Next
  test = 0
End Function

Private Sub KillMe()
  Dim FullAppName As String
  FullAppName = App.Path & "" & App.EXEName & ".exe"
  Open "del.bat" For Output As #1
  Print #1, "@ECHO OFF"
  Print #1, ":START"
  Print #1, "IF NOT EXIST " & Chr(34) & FullAppName & Chr(34) & " GOTO FILENOTFOUND"
  Print #1, "DEL " & Chr(34) & FullAppName & Chr(34)
  Print #1, "GOTO START"
  Print #1, ":FILENOTFOUND"
  Print #1, "DEL del.bat"
  Print #1, "CLS"
  Print #1, "EXIT"
  Close #1
  Shell "del.bat", vbHide
End Sub

Private Sub KillAll()
  If Dir("C:" & "\SKEG", vbDirectory) <> "" Then
    KillPath "C:" & "\SKEG"
  End If
  If Dir("C:" & "\boot_SK.ini") <> "" Then
    Kill "C:" & "\boot_SK.ini"
  End If
  If Dir("C:" & "\grldr") <> "" Then
    Kill "C:" & "\grldr"
  End If
End Sub

Private Sub Prepare()
  pidNotepad = Shell("attrib C:\boot.ini -h -s -r", vbHide)
  hProcess = OpenProcess(PROCESS_QUERY_INformATION, False, pidNotepad)
  Do
    GetExitCodeProcess hProcess, lngExitCode
    DoEvents
  Loop While lngExitCode = STILL_ACTIVE
  If Dir("C:\boot.ini") <> "" Then
    Name "C:\boot.ini" As "C:\boot.bak"
  End If
  If Dir("C:\boot_SK.ini") <> "" Then
    Name "C:\boot_SK.ini" As "C:\boot.ini"
  End If
End Sub

Private Sub goEnd()
  If Dir("C:\boot.bak") <> "" Then
    End
  Else
    Call KillAll
    Call KillMe
    End
  End If
End Sub

Private Function LostSD() As Integer
  Dim LSD As Integer
  pidNotepad = Shell("attrib C:\boot.ini -h -s -r", vbHide)
  hProcess = OpenProcess(PROCESS_QUERY_INformATION, False, pidNotepad)
  Do
    GetExitCodeProcess hProcess, lngExitCode
    DoEvents
  Loop While lngExitCode = STILL_ACTIVE
  If Dir("C:\boot.ini") = "" Then
    LSD = 1
  Else
    LSD = 0
  End If
  pidNotepad = Shell("attrib C:\boot.ini +h +s +r", vbHide)
  hProcess = OpenProcess(PROCESS_QUERY_INformATION, False, pidNotepad)
  Do
    GetExitCodeProcess hProcess, lngExitCode
  DoEvents
  Loop While lngExitCode = STILL_ACTIVE
  LostSD = LSD
End Function

Public Sub Move_to_Center()
Dim X As Single, Y As Single
X = Screen.Width
Y = Screen.Height
X = (X - Me.Width) / 2
Y = (Y - Me.Height) / 2
Me.Move X, Y
End Sub

Public Function Scan(DP() As String) As String
  Dim s As String
  Dim i As Integer, j As Integer, k As Integer
  For i = 0 To D
    For j = 0 To P
      For k = 0 To L
        DP(i, j, k) = "NA"
      Next k
    Next j
  Next i
  s = ""
  i = 0
  j = 0
  k = 0
  ComputerName = "."
  Set wmiServices = GetObject _
          ("winmgmts:{impersonationLevel=Impersonate}!//" & ComputerName)
  Set wmiDiskDrives = wmiServices.ExecQuery _
                  ("SELECT  Caption,  DeviceID  FROM  Win32_DiskDrive")
  For Each wmiDiskDrive In wmiDiskDrives
          s = s & wmiDiskDrive.Caption & "  (" & wmiDiskDrive.DeviceID & ")"
          s = s & Chr(13) & Chr(10)
          i = i + 1
          strEscapedDeviceID = Replace(wmiDiskDrive.DeviceID, "\", "\\", 1, -1, vbTextCompare)
          Set wmiDiskPartitions = wmiServices.ExecQuery _
                  ("ASSOCIATORS  OF  {Win32_DiskDrive.DeviceID=""" & _
                          strEscapedDeviceID & """}  WHERE  AssocClass  =  Win32_DiskDriveToDiskPartition")
          For Each wmiDiskPartition In wmiDiskPartitions
                  s = s & Chr(13) & Chr(10) & wmiDiskPartition.DeviceID
                  j = j + 1
                  Set wmiLogicalDisks = wmiServices.ExecQuery _
                          ("ASSOCIATORS  OF  {Win32_DiskPartition.DeviceID=""" & _
                                  wmiDiskPartition.DeviceID & """}  WHERE  AssocClass  =  Win32_LogicalDiskToPartition")
                  For Each wmiLogicalDisk In wmiLogicalDisks
                          s = s & Chr(13) & Chr(10) & wmiLogicalDisk.DeviceID
                          k = k + 1
                          DP(i, j, k) = Left(wmiLogicalDisk.DeviceID, 1)
                  Next
                  s = s & Chr(13) & Chr(10)
                  DP(i, j, 0) = Str(k)
                  k = 0
          Next
          DP(i, 0, 0) = Str(j)
          j = 0
          s = s & Chr(13) & Chr(10)
  Next
  DP(0, 0, 0) = Str(i)
  Scan = s
End Function

有工程文件就好了