moduleapi.bas

磁盘FAT扇区数据读写操作 Ver 1.20(更新版)

          '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
                                 
            CloseHandle (hToken)
            getPrivileges = False
            Exit Function

         End If

'         lResult = SetPrivilege(hToken, SE_DEBUG_NAME, True)
         lResult = SetPrivilege(hToken, sPrivilegeName, True)
         If (lResult = False) Then

            CloseHandle (hToken)
            getPrivileges = False
            Exit Function

         End If
         getPrivileges = True
         hhToken = hToken
      End Function
Public Function SetPrivilege(ByVal hToken As Long, ByVal Privilege As String, _
                                    ByVal bSetFlag As Boolean) As Boolean

         Dim TP As TOKEN_PRIVILEGES          ' Used in getting the current
                                             ' token privileges
         Dim TPPrevious As TOKEN_PRIVILEGES  ' Used in setting the new
                                             ' token privileges
         Dim Luid As Luid                    ' Stores the Local Unique
                                             ' Identifier - refer to MSDN
         Dim cbPrevious As Long              ' Previous size of the
                                             ' TOKEN_PRIVILEGES structure
         Dim lResult As Long                 ' Result of various API calls

         ' Grab the size of the TOKEN_PRIVILEGES structure,
         ' used in making the API calls.
         cbPrevious = Len(TP)

         ' Grab the LUID for the request privilege.
         lResult = LookupPrivilegeValue("", Privilege, Luid)

         ' If LoopupPrivilegeValue fails, the return result will be zero.
         ' Test to make sure that the call succeeded.
         If (lResult = 0) Then
            SetPrivilege = False
         End If

         ' Set up basic information for a call.
         ' You want to retrieve the current privileges
         ' of the token under concern before you can modify them.
         TP.PrivilegeCount = 1
         TP.Privileges(0).pLuid = Luid
         TP.Privileges(0).Attributes = 0
         SetPrivilege = lResult

         ' You need to acquire the current privileges first
         lResult = AdjustTokenPrivileges(hToken, False, TP, Len(TP), _
                                        TPPrevious, cbPrevious)

         ' If AdjustTokenPrivileges fails, the return result is zero,
         ' test for success.
         If (lResult = 0) Then
            SetPrivilege = False
         End If

         ' Now you can set the token privilege information
         ' to what the user is requesting.
         TPPrevious.PrivilegeCount = 1
         TPPrevious.Privileges(0).pLuid = Luid

         ' either enable or disable the privilege,
         ' depending on what the user wants.
         Select Case bSetFlag
            Case True: TPPrevious.Privileges(0).Attributes = _
                       TPPrevious.Privileges(0).Attributes Or _
                       (SE_PRIVILEGE_ENABLED)
            Case False: TPPrevious.Privileges(0).Attributes = _
                        TPPrevious.Privileges(0).Attributes Xor _
                        (SE_PRIVILEGE_ENABLED And _
                        TPPrevious.Privileges(0).Attributes)
         End Select

         ' Call adjust the token privilege information.
         lResult = AdjustTokenPrivileges(hToken, False, TPPrevious, _
                                        Len(TPPrevious), TP, cbPrevious)

         ' Determine your final result of this function.
         If (lResult = 0) Then
            ' You were not able to set the privilege on this token.
            SetPrivilege = False
         Else
            ' You managed to modify the token privilege
            SetPrivilege = True
         End If

      End Function
'----------------------------------------------
' Procedure  : GetCheckSum
' Auther     : WangWeiSheng
' Input      : FileName       输入短文件名字节数组
' Input      : Xx             输入一个偏移量
' OutPut     : Byte           返回计算出的校验值
' Purpose    : 计算短文件名的校验值
'----------------------------------------------
Public Function GetCheckSum(FileName() As Byte, Xx As Integer) As Byte
Dim i As Integer
Dim Sum As Integer
Dim CheckSum As Byte

For i = 0 To 10
   Sum = (RightRotAByte(CheckSum) + FileName(Xx + i))
    CheckSum = Sum And &HFF
Next
GetCheckSum = CheckSum
End Function
'----------------------------------------------
' Procedure  : RightRotAByte
' Auther     : WangWeiSheng
' Input      : CheckSum       输入要右移的数（一个字节）
' OutPut     : Integer        返回右移后的数
' Purpose    : 循环右移一个byte
'----------------------------------------------
Public Function RightRotAByte(ByVal CheckSum As Byte) As Integer
Dim TempByte As Byte
Dim Sng As Byte
Sng = IIf((CheckSum And &H1), &H80, &H0)
TempByte = CheckSum And &H3
CheckSum = (CheckSum And &HFC) / 2
RightRotAByte = Sng Or CheckSum Or (((TempByte And 2) = 2) And 1)
End Function