Keywords: VB create shared access Author: Dong Jun containing Originally, I made the post http://search.9cbs.net/Expert/topic/2440/2440801.xml?temp=6.267726E-03 thank rainstormmaster, harbor and power Help Since Win9X is different from Winnt, it is more troublesome to set the shared method. It is naturally shell and then uses Net Share and NET Use to create a connection, and finally use the console command to make COPY and DELETE (see COPY //192.168. 5.11 / d $ / *. * D: /) It is very simple to implement, including WinAPI Open Read ... all support this way of access. This article does not make a detailed discussion (this relatively simple) discussed herein How to use pure code and the API to achieve shared creation and access. The relevant part of interest can be packaged into class, simple in the next time. General steps: 1 Establish a shared 2 establishment of the connection between 3 buildings Directory, read and write file operations 4 Turn off connection 1 How to set up sharing This is the module I quote others, (Sorry, the name of the original author is not I deleted, BAS is not there). Option expedition
'2000 Use the API to achieve directory sharing and delete sharing
'Shared type Private Const STYPE_ALL As Long = -1Private Const STYPE_DISKTREE As Long = 0Private Const STYPE_PRINTQ As Long = 1Private Const STYPE_DEVICE As Long = 2Private Const STYPE_IPC As Long = 3Private Const STYPE_SPECIAL As Long = & H80000000
'Authority Private Const ACCESS_READ As Long = & H1Private Const ACCESS_WRITE As Long = & H2Private Const ACCESS_CREATE As Long = & H4Private Const ACCESS_EXEC As Long = & H8Private Const ACCESS_DELETE As Long = & H10Private Const ACCESS_ATRIB As Long = & H20Private Const ACCESS_PERM As Long = & H40Private Const ACCESS_ALL As Long = Access_read or _ access_create or _ access_exec or _ access_delete or _ access_atrib or _ access_pers
'Sharing information Private Type SHARE_INFO_2 shi2_netname As Long' share name shi2_type As Long 'type shi2_remark As Long' Remarks shi2_permissions As Long 'rights shi2_max_uses As Long' largest user shi2_current_uses As Long 'shi2_path As Long' path shi2_passwd As Long 'password End Type' set shared Private Declare Function NetShareAdd Lib "netapi32" _ (ByVal ServerName As Long, _ ByVal level As Long, _ buf As Any, _ parmerr As Long) As Long 'delete shared Private Declare Function NetShareDel Lib "netapi32.dll" _ ( Byval Servername As Long, _ Byval ShareName As Long, _ Byval DWORD AS Long AS LONG
'Set Share (returns 0 for the success of)' Parameters: 'sServer computer name' sSharePath to be shared path 'share name sShareName displayed' sShareRemark Remarks' sSharePw password Private Function ShareAdd (sServer As String, _ sSharePath As String, _ sShareName As String , _ sShareRemark as String, _ sSharePw as String) as Long Dim lngServer as Long Dim lngNetname as Long Dim lngPath as Long Dim lngRemark as Long Dim lngPw as Long Dim parmerr as Long Dim si2 as SHARE_INFO_2 lngServer = StrPtr (sServer) 'transfected into address lngNetname = StrPtr (sShareName) lngPath = StrPtr (sSharePath) 'If there remark information If Len (sShareRemark)> 0 Then lngRemark = StrPtr (sShareRemark) End If' if password If Len (sSharePw)> 0 Then lngPw = StrPtr ( SSHAREPW) EndiffW) Endiff 'Initialization Sharing Information with Si2 .shi2_NetName = LNGNETNAME .SHI2_PATH = LNGPATH .SHI2_REMARK = SNGREMARK .SHI2_TYPE = STYPE_DISKTREE .shi2_permissions = access_all .shi2_max_uses = -1 .shi2_passwd = lngpw end with 'Set sharing (username, sharing type, sharing information,) shareadd = netshareadd (LNGServer, _ 2, _ Si2, _ paramerr) End function' delete sharing ( Returns 0 to success) 'parameter:' sServer computer name 'ssharename Shared Name Private Function Delshare (SSERVER AS STRING, _ SSHARENAME AS STRING) AS Long Dim LNGSERVER AS long' computer name Dim LNGNETNAME AS long 'shared name
LNGSERVER = STRPTR (SSERVER) 'Transfer LNGNETNAME = Strptr (SSHARENAME)' Delete Sharing Delshare = Netsharedel (LNGServer, LNGNetName, 0)
End function (thanks source code provider) Different from Win98 and Win2000, the response code is different. The following is the shared folder Option Explicit for Win9X's establishment of access passwords in 98.
Private const Nerr_suCcess as long = 0 &
'Share typesPrivate Const STYPE_ALL As Long = -1' note: my constPrivate Const STYPE_DISKTREE As Long = 0Private Const STYPE_PRINTQ As Long = 1Private Const STYPE_DEVICE As Long = 2Private Const STYPE_IPC As Long = 3Private Const STYPE_SPECIAL As Long = & H80000000
'FlagsPrivate Const SHI50F_RDONLY = & H1Private Const SHI50F_FULL = & H2Private Const SHI50F_DEPENDSON = SHI50F_RDONLY SHI50F_FULLPrivate Const SHI50F_ACCESSMASK = SHI50F_RDONLY SHI50F_FULLPrivate Const SHI50F_PERSIST = & H100' Partage persistantPrivate Const SHI50F_SYSTEM = & H200 'Partage cach?
'Permissions (Win ME / NT / 2000 / XP) Private Const ACCESS_READ As Long = & H1Private Const ACCESS_WRITE As Long = & H2Private Const ACCESS_CREATE As Long = & H4Private Const ACCESS_EXEC As Long = & H8Private Const ACCESS_DELETE As Long = & H10Private Const ACCESS_ATRIB As Long = & H20Private Const Access_pers,
'Win 9xPrivate Type SHARE_INFO_50 shi50_netname (0 To 12) As Byte' LM20_NNLEN 1 shi50_type As Byte 'EShareType shi50_flags As Integer shi50_remark As Long shi50_Path As Long shi50_rw_password (0 To 8) As Byte' SHPWLEN 1 shi50_ro_password (0 To 8) As byte 'SHPWLEN 1End Type' Quelle systeme d'exploitationPrivate Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128End Type
Private Declare Function NetShareAdd95 Lib "SVRAPI" Alias "NetShareAdd" (ByVal servername As String, ByVal level As Integer, ByVal buf As Long, ByVal cbBuffer As Integer) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any , lpvsource as any, byval cbcopy as long
Private Sub Cmdcreateshare_Click () DIM LNGSUCCESS AS Long 'Create The Share
'To add the corresponding textbox lngSuccess = ShareAdd (UCase (txtComputerName.Text), UCase (txtLocalPath.Text), UCase (txtShareName.Text), txtShareDesc.Text)' lngSuccess = ShareAdd (txtComputerName.Text, txtLocalPath.Text, txtShareName .Text, txtShareDesc.Text, txtSharePassRo.Text, txtSharePassRw.Text) Select Case lngSuccess Case 0: 'share created successfully Case 2118' share name already exists, then change to change the share name, I just make it a 1 lngSuccess = ShareAdd ( UCase (txtComputerName.Text), UCase (txtLocalPath.Text), UCase (txtShareName.Text) "1", txtShareDesc.Text) Case Else: MsgBox "Create error number" & lngSuccess, vbCritical, "error" End Select
End Sub
Private Function ShareAdd (sServer As String, sSharePath As String, sShareName As String, sShareRemark As String) As LongDim si50 As SHARE_INFO_50 Dim iErrParam As Integer Dim lpszPath () As Byte Dim lpszRemark () As Byte Dim intFlags As Integer
intFlags = SHI50F_FULL Or SHI50F_PERSIST 'mode normal le partage est visible sur la machine' flags = SHI50F_FULL Or SHI50F_PERSIST Or SHI50F_SYSTEM 'mode syst Peng e partage invisiblelpszPath = StrConv (sSharePath, vbFromUnicode) & vbNullCharlpszRemark = StrConv (sShareRemark, vbFromUnicode) & vbNullChar
With si50 StrToByte sShareName, VarPtr (.shi50_netname (0)) .shi50_type = STYPE_DISKTREE .shi50_remark = VarPtr (lpszRemark (0)) .shi50_Path = VarPtr (lpszPath (0)) StrToByte "", VarPtr (.shi50_ro_password (0)) StrToByte "", Varptr (.shi50_rw_password (0)) .shi50_flags = intflagsend with
Shareadd = netshareadd95 ("", 50, byval varptr (Si50), lenb (Si50)) End Function
Private Sub StrToByte (strInput As String, ByVal lpByteArray As Long) Dim lpszInput () As Byte lpszInput = StrConv (strInput, vbFromUnicode) & vbNullChar CopyMemory ByVal lpByteArray, lpszInput (0), UBound (lpszInput) End Sub2 next step is to connect the remote shared Connecting Windows For shared access is such a (notified) A Deconstimate whether the remote shared is password (GUEST is allowed) b Deconstrate whether the remote shared password is consistent with the current account, or whether it is an empty password C with a username password Connection, and record this password, it is convenient to use D if you need to map the network drive, then map a disk manager can take advantage of the NET USE command, but Win98 is different from win2000, NET USE is different, the following is the code implementation ===== =========== the following code into the module Option Explicit Const WN_Success = & H0 Const WN_Not_Supported = & H1 Const WN_Net_Error = & H2 Const WN_Bad_Pointer = & H4 Const WN_Bad_NetName = & H32 Const WN_Bad_Password = & H6 Const WN_Bad_Localname = & H33 Const WN_Access_Denied = & H7 Const WN_Out_Of_Memory = & HB Const WN_Already_Connected = & H34 Public ErrorNum As Long Public ErrorMsg As String Public rc As Long Private Const ERROR_NO_CONNECTION = 8 Private Const ERROR_NO_DISCONNECT = 9 Private Type NETRESOURCE dwScope As Long dwType A s Long dwDisplayType As Long dwUsage As Long lpLocalName As String lpRemoteName As String lpComment As String lpProvider As String End Type Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String , ByVal dwFlags As Long) As Long Const NO_ERROR = 0 Const CONNECT_UPDATE_PROFILE = & H1 Const RESOURCETYPE_DISK = & H1 Const RESOURCETYPE_PRINT = &
H2 Const RESOURCETYPE_ANY = & H0 Const RESOURCE_GLOBALNET = & H2 Const RESOURCEDISPLAYTYPE_SHARE = & H3 Const RESOURCEUSAGE_CONNECTABLE = & H1Public Function ConnectUserPassword (sDrive As String, sService As String, Optional sUser As String = "", Optional sPassword As String = "") As Boolean Dim NETR As NETRESOURCE Dim errInfo As Long With NETR .dwScope = RESOURCE_GLOBALNET .dwType = RESOURCETYPE_DISK .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE .dwUsage = RESOURCEUSAGE_CONNECTABLE .lpRemoteName = sDrive .lpLocalName = sService End With errInfo = WNetAddConnection2 (NETR, sPassword, sUser, CONNECT_UPDATE_PROFILE) ConnectUserPassword = errInfo = NO_ERROR End Function
================ Call connectUserpassword ("// ServerName", "Password", "Username")
Equivalent to Net Use // ServerName Password / User: UserName3 file Operation Windows supports the direct operation of the //192.168.5.1/ shared name / file, it is obvious, such as using the API to operate FSO. This example is the use FSO operation, no different with the local .//1 list the contents of sharedir: first reference to the Microsoft Scripting Runtime form a treeview, a listbox: Option ExplicitDim FSO As New FileSystemObjectPrivate Sub Form_Load () Dim mfolder As Folder Set mfolder = Fso.getFolder ("// 192.168.2.1/guo") DIM Mnode As Node Set Mnode = Me.TreeView1.nodes.add (,, Mfolder.Path, Mfolder.path) Dim A As File for Each A in mfolder.files Me.List1.AddItem a.Name Next Dim subfolder As Folder For Each subfolder In mfolder.SubFolders Me.TreeView1.Nodes.Add mnode, tvwChild, subfolder.Path, subfolder.Name Next Set subfolder = Nothing Set a = Nothing Set mfolder = Nothingend Subprivate Sub Form_Unload (Cancel AS Integer) Set Fso = Nothingend Sub
Private Sub TreeView1_NodeClick (ByVal Node As MSComctlLib.Node) On Error Resume Next Dim mfolder As Folder Set mfolder = FSO.GetFolder (Node.Key) Dim a As File List1.Clear For Each a In mfolder.Files Me.List1.AddItem a .Name Next Dim subfolder As Folder For Each subfolder In mfolder.SubFolders Me.TreeView1.Nodes.Add Node, tvwChild, subfolder.Path, subfolder.Name Next Set subfolder = Nothing Set a = Nothing Set mfolder = NothingEnd Sub sometimes due FSO Disabled by administrators (most viruses use FSO), so they are ready to prepare, and they are general ways. Use ready-made examples: 'Create a form with a command button (Command1), A List Box List1) 'and four text Boxes (Text1, Text2, Text3 and text4).' Type in the first textbox a startingpath like c: / (here you enter the path to the shared folder, such as: // ns / mytest Try) ' and in the second textbox you put a pattern like *. * or * .txtPrivate Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindNextFile Lib "k ernel32 "Alias" FindNextFileA "(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function GetFileAttributes Lib" kernel32 "Alias" GetFileAttributesA "(ByVal lpFileName As String) As LongPrivate Declare Function FindClose Lib" kernel32 "(ByVal hFindFile As Long) As long
Const MAX_PATH = 260Const MAXDWORD = & HFFFFConst INVALID_HANDLE_VALUE = -1Const FILE_ATTRIBUTE_ARCHIVE = & H20Const FILE_ATTRIBUTE_DIRECTORY = & H10Const FILE_ATTRIBUTE_HIDDEN = & H2Const FILE_ATTRIBUTE_NORMAL = & H80Const FILE_ATTRIBUTE_READONLY = & H1Const FILE_ATTRIBUTE_SYSTEM = & H4Const FILE_ATTRIBUTE_TEMPORARY = & H100Private Type FILETIME dwLowDateTime As Long dwHighDateTime As LongEnd Type
Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14End TypeFunction StripNulls (OriginalStr As String) As String If (InStr ( Originalstr, Chr (0))> 0) Then OriginalStr = Left (OriginalStr, Instr (OriginalStr, Chr (0)) - 1) end if stripnulls = OriginalStrend Function
Function Findfilesapi (Path As String, Searchstr AS String, Filecount As Integer, Dircount As Integer "KPD-Team 1999 'E-mail: kpdteam@allapi.net
Dim FileName As String 'Walking filename variable ... Dim DirName As String' SubDirectory Name Dim dirNames () As String 'Buffer for directory name entries Dim nDir As Integer' Number of directories in this path Dim I As Integer 'For-loop counter ... DIM HSEARCH AS Long 'Search Handle Dim WFD AS WIN32_FIND_DATA DIM CONTEGER IF Right (Path, 1) <> "/" THEN PATH = PATH & "/"' Search for Subdirector. Ndir = 0 redim dirnames (NDIR ) Cont = True hSearch = FindFirstFile (path & "*", WFD) If hSearch <> INVALID_HANDLE_VALUE Then Do While Cont DirName = stripNulls (WFD.cFileName) 'Ignore the current and encompassing directories. If (DirName <> ".") And (DirName <> "..") Then 'Check for directory with bitwise comparison. If GetFileAttributes (path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then dirNames (nDir) = DirName DirCount = DirCount 1 nDir = nDir 1 ReDim Preserve dirNames (nDir) End If End If Cont = FindNextFile (hSearch, WFD) 'Get next subdirectory. Loop Cont = FindClose (hSearch) End If' Walk through this directory and sum file sizes. HSearch = FindFirstFile (path & SearchStr, WFD) Cont = True if HSearch <> invalid_handle_value damnulls (wfd.cfilename) IF (FileName <> ") and (filename <>". ") THEN FINDFILESAPI =
FindFilesAPI (WFD.nFileSizeHigh * MAXDWORD) WFD.nFileSizeLow FileCount = FileCount 1 List1.AddItem path & FileName End If Cont = FindNextFile (hSearch, WFD) 'Get next file Wend Cont = FindClose (hSearch) End If' If there Are Sub-Directories ... if Ndir> 0 Then 'Recursively Walk Into the the ... for i = 0 to ndir - 1 FindFilesAPI = FindFilesAPI FindFilesapi (Path & Dirnames (i) & "/", Searchstr, FileCount, Dircount ) Next I End IfEnd FunctionSub Command1_Click () Dim SearchPath As String, findStr As String Dim FileSize As Long Dim NumFiles As Integer, NumDirs As Integer Screen.MousePointer = vbHourglass List1.Clear List1.Visible = False SearchPath = Text1.Text findStr = Text2 .Text FileSize = FindFilesAPI (SearchPath, Findstr, Numfiles, Numdirs) Text3.text = Numfiles & "Files Found IN" & NUMDIRS 1 & "Director" text4.text = "Size of Files f OUND Under "& searchPath &" = "& format (FileSize," ####, ###, ## 0 ") &" bytes "screen.mousepointer = vbdefault list1.visible = trueend sub copy example // 2. Copy the files under Sharedir to local //3, how to achieve progress control like Windows
A button on the form, a ProgressBar: Option Explicit '// 192.168.2.1/guo/123.rarPublic Function CopyFile (Src As String, Dst As String, mProgressBar As ProgressBar) As Single Dim BTest As Single, FSize As Single Dim F1 As Integer, F2 As Integer Dim sArray () As Byte Dim buff As Integer Const BUFSIZE = 1024 buff = 1024 F1 = FreeFile Open Src For Binary Access Read As F1 F2 = FreeFile Open Dst For Binary As F2 FSize = LOF (F1) BTest = Fsize - LOF (F2) Redim Sarray (bufsize) AS BYTE DO if btest It is necessary to point out the premise of successful operation of the above code is that the access type of the shared folder is "complete". If your shared folder is "read-only", you need to run when you run, change its access type For "complete". Since you already know: How to share a folder, I will not be more than it. In fact, accessing an access type "complete" shared folder, and accessing the local files Nothing 4 Disconnect this relatively simple ... There are two ways' ============ ================================= Option ExplicitPrivate Const RESOURCETYPE_DISK = & H1Private Const RESOURCETYPE_ANY = & H0Private Const RESOURCETYPE_PRINT = & H2Private Const RESOURCETYPE_UNKNOWN = & HFFFFPrivate Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As LongPrivate Declare Function WNetDisconnectDialog Lib "mpr.dll" (ByVal hWnd As Long, ByVal dwType As Long) As long Public Function DisconnectNetworkDialog () AS Long DisconnectNetworkDialog = WNETDISCONNECTDIALOGOG (0 &, ResourceType_Disk) End Function PRIVATE SUB Command1_Click () 'First Method Call DisconnectNetworkDialogend Sub PRIVATE SUB Command2_Click () 'Second Method Call WnetCancelConnection2 ("// 10.0.0.1/Temp", 1, true) End Sub Summary: It can now be said that there is still some small problems, such as listing the list of files, sometimes overflow. I will find the way I think I just want to ask how to connect who knows the sharing of enthusiastic RainStormMaster even 98. Thank you again for the help of RainStormMaster. Summary: In fact, go back to see, the answer to this question is not difficult. I think it is too complicated. I didn't expect simple FindfirstFile, FindNextFile solved my problem. There is also a remote file access to it. It can be directly Open ... It should be this sentence: "I don't do it, I only can't think of" There is also a way of using MPR.dll provided by the Power Harbor. It turns out that only the map network driver, and it is not thought that no mapping can also be connected. Another "I didn't expect." I suggest that you have tried it when you encounter problems. Maybe it is successful, ^ o ^
