access.frm

不错的一个VB菜单设计 界面和功能都不错

VERSION 5.00
Begin VB.Form frmAccesibility 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Accesibility"
   ClientHeight    =   3195
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   Icon            =   "Access.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   420
      Left            =   1095
      TabIndex        =   0
      Top             =   540
      Width           =   2670
   End
End
Attribute VB_Name = "frmAccesibility"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const REMOTE_NAME_INFO_LEVEL = 2

Private Type REMOTE_NAME_INFO
  lpUniversalName As Long
  lpConnectionName As Long
  lpRemainingPath As Long
  Buffer As String * 255
End Type

Private Type UNIVERSAL_NAME_INFO
  lpUniversalName As String * 255
End Type

Private Declare Function WNetGetUniversalName Lib "mpr" Alias "WNetGetUniversalNameA" (ByVal lpLocalPath As String, ByVal dwInfoLevel As Long, ByRef lpBuffer As Any, ByRef lpBufferSize As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Byte, ByVal lpString2 As Long) As Long


Private Sub Command1_Click()
  Dim strBuffer As REMOTE_NAME_INFO
  Dim lngLen    As Long
  Dim x As Long
  
  lngLen = Len(strBuffer)
  MsgBox PointerToStringW(strBuffer.lpConnectionName)
  MsgBox PointerToStringW(strBuffer.lpRemainingPath)
  MsgBox PointerToStringW(strBuffer.lpUniversalName)
End Sub

Private Function PointerToStringW(ByVal lpStringW As Long) As String
  Dim Buffer() As Byte
  Dim nLen As Long

  If lpStringW Then
    nLen = lstrlenW(lpStringW) * 2
    If nLen Then
      ReDim Buffer(0 To (nLen - 1)) As Byte
      CopyMem Buffer(0), ByVal lpStringW, nLen
'      PointerToStringW = StrZToStr(StrConv(Buffer, vbUnicode))
      PointerToStringW = StrConv(Buffer, vbUnicode)
    End If
  End If
End Function