sd.txt

//按柱面和磁道来读取磁盘数据,要求 Public Function ReadDisk(ByVal Cylinders As Long, ByVal Tracks As Long, db() As

    bResult = DeviceIoControl(hDisk, FSCTL_UNLOCK_VOLUME, ByVal 0&, 0, ByVal 0&, 0, dwOutBytes, ByVal 0&)
    UnlockVolume = bResult
End Function
'Public Function DismountVolume() As Boolean
'    '// 将卷卸下,使系统重新辨识磁盘，等效于重新插盘
'    Dim dwOutBytes As Long
'    Dim bResult As Boolean
'
'    bResult = DeviceIoControl(hDisk, FSCTL_DISMOUNT_VOLUME, ByVal 0&, 0, ByVal 0&, 0, dwOutBytes, ByVal 0&)
'    DismountVolume = bResult
'End Function
'//按柱面和磁道来读取磁盘数据,要求
'Public Function ReadDisk(ByVal Cylinders As Long, ByVal Tracks As Long, db() As Byte) As Boolean
'
'    Dim iPos As Long
'    Dim lRead As Long
'
'    iPos = Cylinders * Tracks * lBufferSize
'    If SeekAbsolute(0, iPos) Then
'        ReadDisk = ReadBytes(lBufferSize, db(), lRead)
'    End If
'End Function

'----------------------------------------------
' Procedure  : ReadDiskbySector
' Auther     : WangWeiSheng
' Input      : lStartSector    要读的扇区起始位置
' Input      : lNumReadSector  要读多少个扇区
' Input      : db()            存放读出的数据的数组
' OutPut     : Boolean         读出是否成功
' Purpose    : 把一个文件直接从磁盘上读出,按扇区地址来读磁盘数据，这样不会出错
'----------------------------------------------
  '//
Public Function ReadDiskbySector(db() As Byte, ByVal lStartSector As Double, ByVal lNumReadSector As Long) As Boolean
  
    Dim lPosLow As Long               '位置的低32位
    Dim lPosHigh As Long              '位置的高32位
    Dim lRead As Long                 '实际读出的字节数
    Dim dStartPos As Double           '由扇区计算出的绝对起始位位置
    Dim lReadBytes As Long            '由扇区计算出的要读出的字节数
    dStartPos = lStartSector * 512
    lReadBytes = lNumReadSector * 512
    lPosHigh = Int(dStartPos / OFFSET_4)
    lPosLow = UnsignedToLong(dStartPos - lPosHigh * OFFSET_4)

    If SeekAbsolute(lPosHigh, lPosLow) Then
        ReadDiskbySector = ReadBytes(lReadBytes, db(), lRead)
    End If
End Function
'----------------------------------------------
' Procedure  : WriteDiskbySector
' Auther     : WangWeiSheng
' Input      : lStartSector    要写的扇区起始位置
' Input      : lNumReadSector  要写入多少个扇区
' Input      : db()            存有写入数据的数组
' OutPut     : Boolean         写入是否成功
' Purpose    : 把数据写入磁盘,按扇区地址来写入磁盘数据，这样不会出错
'----------------------------------------------
  '//
Public Function WriteDiskbySector(db() As Byte, ByVal lStartSector As Double, ByVal lNumWriteSector As Long) As Boolean
  
    Dim lPosLow As Long               '位置的低32位
    Dim lPosHigh As Long              '位置的高32位
    Dim dStartPos As Double           '由扇区计算出的绝对起始位位置
    Dim lWriteBytes As Long           '由扇区计算出的要写入的字节数
    
    dStartPos = lStartSector * 512
    lWriteBytes = lNumWriteSector * 512
    lPosHigh = Int(dStartPos / OFFSET_4)
    lPosLow = UnsignedToLong(dStartPos - lPosHigh * OFFSET_4)
    
    Stop
    If SeekAbsolute(lPosHigh, lPosLow) Then
        Stop
        WriteDiskbySector = WriteBytes(lWriteBytes, db())
    End If
End Function
  '//按绝对地址来读磁盘数据，要求绝对地址满足512字节的倍数，否则会出错
Public Function ReadDiskbyPos(db() As Byte, ByVal dStartPos As Double, ByVal lReadBytes As Long) As Boolean
  
    Dim lPosLow As Long
    Dim lPosHigh As Long
    Dim lRead As Long
    lPosHigh = Int(dStartPos / OFFSET_4)
    lPosLow = UnsignedToLong(dStartPos - lPosHigh * OFFSET_4)
'    iPos = Cylinders * Tracks * lBufferSize
'    lBufferSize = lReadBytes
    If SeekAbsolute(lPosHigh, lPosLow) Then
        ReadDiskbyPos = ReadBytes(lReadBytes, db(), lRead)
    End If
End Function
'//按绝对地址来写磁盘数据，要求绝对地址满足512字节的倍数，否则会出错
Public Function WriteDiskbyPos(ByVal dStartPos As Double, ByVal lWriteBytes As Long, db() As Byte) As Boolean

    Dim lPosLow As Long
    Dim lPosHigh As Long
    Dim lWrite As Long
    lPosHigh = Int(dStartPos / OFFSET_4)
    lPosLow = UnsignedToLong(dStartPos - lPosHigh * OFFSET_4)
    
    If SeekAbsolute(lPosHigh, lPosLow) Then
        WriteDiskbyPos = WriteBytes(lWriteBytes, db())
    End If
End Function
Public Function UnsignedToLong(Value As Double) As Long
        If Value < 0 Or Value >= OFFSET_4 Then Error 6
        If Value <= MAXINT_4 Then
          UnsignedToLong = Value
        Else
          UnsignedToLong = Value - OFFSET_4
        End If
      End Function
'Public Function WriteDisk(ByVal Cylinders As Long, ByVal Tracks As Long, db() As Byte) As Boolean
'    '//按柱面和磁道来写磁盘数据
'    Dim iPos As Long
'    Dim lRead As Long
'
'    iPos = Cylinders * Tracks * lBufferSize
'
'    If SeekAbsolute(0, iPos) Then
'        WriteDisk = WriteBytes(lBufferSize, db())
'    End If
'End Function
'/////////////////////////////////////////////////////////////////////////////////////
'//file system

Private Function SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long) As Boolean
'//seek file查找文件定读写位置
'//Notice: when you set LowPos=5, the read/write will begin with the 6th(LowPos+1) byte
LowPos = SetFilePointer(hDisk, LowPos, VarPtr(HighPos), FILE_BEGIN)
If LowPos = -1 Then
  SeekAbsolute = (Err.LastDllError = ERROR_SUCCESS)
Else
  SeekAbsolute = True
End If
End Function
Private Function ReadBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte, ByRef ActuallyReadByte As Long) As Boolean
'//read data to array
Dim RetVal As Long
RetVal = ReadFile(hDisk, DataBytes(0), ByteCount, ActuallyReadByte, 0)
'ActuallyReadByte =>> if the bytesRead=0 mean EOF
ReadBytes = Not (RetVal = 0)

End Function

Private Function WriteBytes(ByVal ByteCount As Long, ByRef DataBytes() As Byte) As Boolean
'//write data from array
Dim RetVal As Long
Dim BytesToWrite As Long
Dim BytesWritten As Long

RetVal = WriteFile(hDisk, DataBytes(0), ByteCount, BytesWritten, 0)

WriteBytes = Not (RetVal = 0)
End Function

Public Function SynBrowseForFolder(ByVal lngwHandle As Long, ByVal strTitle As String) As String
On Error Resume Next
        
    Dim BI    As BROWSEINFO
     Dim lPid  As Long
     Dim sPath As String
     Dim iPos  As Integer
    
     Dim lPidlRoot As ITEMIDLIST
     Call SHGetFolderLocation(lngwHandle, CSIDL_DESKTOP, 0&, 0&, lPidlRoot)
     
     'Fill in the required members for the browse
     With BI
        .hOwner = lngwHandle
       .pidlRoot = lPidlRoot.mkid.cb '0&
       .pszDisplayName = Space$(MAX_PATH)
       .lpszTitle = strTitle
       .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE Or BIF_STATUSTEXT Or BIF_EDITBOX Or BIF_VALIDATE     '  '这个参数就是有一个新建文件夹按钮
     End With
    
     'show the browse dialog
     lPid = SHBrowseForFolder(BI)
     Dim flName As String
     If InStr(1, Trim(BI.pszDisplayName), "?") Then
        flName = ""
    Else
        If lPid <> 0 Then
          'got a pidl .. but is it valid?
          sPath = Space$(MAX_PATH)
          If SHGetPathFromIDList(ByVal lPid, ByVal sPath) Then
            'valid, so get the share path
            iPos = InStr(sPath, Chr$(0))
            flName = Left$(sPath, iPos - 1)
            If Len(flName) = 3 Then
                flName = Left(flName, 2)
            End If
          End If
        Else
          'a server selected...add \\ because it's a unc path
          flName = "\\" & Trim(BI.pszDisplayName)
          If flName = "\\" Then
             flName = ""
          End If
        End If
    End If
    SynBrowseForFolder = flName
    Call CoTaskMemFree(lPid)
End Function


Function GetDlgRtnFileName(ByVal iAction As Integer, vOpenFile As OPENFILENAME, ByVal hWndOw As Long, ByVal sFilter As String, _
                           ByVal sTitle As String, ByVal DefExt As String, ByVal InitFileName As String) As String '用API函数获得打开对话框和保存对话框返回的文件名

         Dim lReturn As Long
         
         vOpenFile.lStructSize = Len(vOpenFile)
         vOpenFile.hwndOwner = hWndOw 'Form1.hwnd
         vOpenFile.hInstance = App.hInstance

         vOpenFile.lpstrFilter = sFilter
         vOpenFile.nFilterIndex = 1
         If iAction = 2 Then
            vOpenFile.lpstrFile = InitFileName & String((257 - Len(InitFileName)), 0)
         Else
            vOpenFile.lpstrFile = String(257, 0)
         End If
         vOpenFile.nMaxFile = Len(vOpenFile.lpstrFile) - 1
         vOpenFile.lpstrFileTitle = vOpenFile.lpstrFile
         vOpenFile.nMaxFileTitle = vOpenFile.nMaxFile
         vOpenFile.lpstrInitialDir = "C:\"
         vOpenFile.lpstrTitle = sTitle '"使用对话框API而不是控件" '"Use the Comdlg API not the OCX"
         vOpenFile.flags = 2
         vOpenFile.lpstrDefExt = DefExt
         Select Case iAction
                Case DLG_SHOWOPEN
                     lReturn = GetOpenFileName(vOpenFile)
                Case DLG_SHOWSAVE
                     lReturn = GetSaveFileName(vOpenFile)
                Case Else   'unknown action
                     Exit Function
         End Select

         If lReturn = 0 Then
            GetDlgRtnFileName = "Cancel" 'MsgBox "用户按下Cancel按钮" '"The User pressed the Cancel Button"
         Else
            GetDlgRtnFileName = Trim(Left(vOpenFile.lpstrFile, InStr(1, vOpenFile.lpstrFile, Chr$(0), vbBinaryCompare) - 1))

         End If
End Function

' Sub Create_File(FileName As String, ArrayByte() As Byte, lWriteNum As Long)
'
'Dim i As Long ', j As Long
'Dim Pointer As Long                           '返回写入文件的指针位置
'Dim fHandle As Long                           '文件被打开的句柄
'Dim fSuccess As Long                          '函数返回量
'Dim lBytesWritten As Long                     '接收实际写入的字节数
'
'Dim lStr As Long
'
' '以下一句为创建一个文件
'fHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, _
'                         FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) '
'
'If fHandle <> INVALID_HANDLE_VALUE Then                         '打开成功开始处理
'   Pointer = SetFilePointer(fHandle, 0, 0, FILE_END)            '设置写入位置'FILE_BEGIN
'
''       lStr = oList.GetTextLen(i)
'
'   fSuccess = WriteFile(fHandle, ArrayByte(0), lWriteNum, lBytesWritten, 0)
'   fSuccess = FlushFileBuffers(fHandle)
'   SetEndOfFile fHandle
'   fSuccess = CloseHandle(fHandle)
'
'End If
'
' End Sub

 Public Function getPrivileges(hhToken As Long, ByVal sPrivilegeName As String) As Boolean
         Dim hProcessID As Long         ' Handle to your sample
                                        ' process you are going to
                                        ' terminate.
         Dim hProcess As Long           ' Handle to your current process
                                        ' (Term02.exe).
         Dim hToken As Long             ' Handle to your process token.
         Dim lPrivilege As Long         ' Privilege to enable/disable
         Dim iPrivilegeflag As Boolean  ' Flag whether to enable/disable
                                        ' the privilege of concern.
         Dim lResult As Long            ' Result call of various APIs.

         getPrivileges = False
         'hProcessID = ApplicationPID

         ' get our current process handle
         hProcess = GetCurrentProcess


         lResult = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or _
                                   TOKEN_QUERY, hToken)


         If (lResult = 0) Then