数据库类的扩展:利用FoxPro创建DBase表的注意细节

[水如烟]

这里需要注意的细节还真不少,只是不知道今天还有多少人使用DBase来存储数据.

[水如烟]

prg文件模板

SET SAFETY OFF;
SET DEBUG OFF;

ON ERROR DO ErrHandle;

#SQL#

QUIT;

PROCEDURE ErrHandle
QUIT

比如创建一个DBase表的prg

SET SAFETY OFF;
SET DEBUG OFF;

ON ERROR DO ErrHandle;

CREATE TABLE "G:\Office\Hello.DBF"(name Character(80), addr Character(30), Salary Numeric(8,2), sex Logical, birthday Date,income Float(10,3));

QUIT;

PROCEDURE ErrHandle
QUIT

[水如烟]

prg的解释程序,我的是FoxPro2.6的两个主要文件:FoxPro.exe,FoxPro.ovl,在后面中,我已改名为FOX.EXE,FOX.OVL

我这的FoxPro2.6,Fox.EXE应该是经过加密处理的.如果将Fox.EXE,Fox.OVL分别内嵌为项目资源,程序运行时将它们释放到磁盘生成相应文件,运行时出错,
说是Fox.Exe与Fox.Ovl不相配.

因此我利用WinRAR.exe将Fox.exe与Fox.ovl压缩成FoxRAR.exe自解压文件.
程序运行时将两个文件解压出来就可了.

Imports System.Security.Permissions
Imports Microsoft.VisualBasic

Namespace LzmTW.Data
    <FileIOPermissionAttribute(SecurityAction.Demand, Unrestricted:=True)> _
    Public Class FoxPro
        Private gPath As String

        '若有错误，则返回错误信息
        Public Shared Function CreateDBaseTable(ByVal sqlForCreateTable As String) As String
            '临时文件夹X:\LzmTWFox为Fox.exe的工作目录
            Dim root As String = IO.Path.GetPathRoot(AppDomain.CurrentDomain.SetupInformation.ApplicationBase)
            Dim tmpPath As String = Microsoft.VisualBasic.FileIO.FileSystem.CombinePath(root, "LzmTWFox")
            If Not IO.Directory.Exists(tmpPath) Then
                IO.Directory.CreateDirectory(tmpPath)
            End If

            Dim result As String = ""

            Dim fox As New FoxPro(tmpPath)
            Try
                result = fox.CreateTable(sqlForCreateTable)
            Catch ex As Exception
                result = ex.Message
            End Try

            Return result
        End Function

        Private ReadOnly Property Path() As String
            Get
                Return gPath
            End Get
        End Property

        Private Sub DeletePath()
            FileIO.FileSystem.DeleteDirectory(Me.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.DeletePermanently, FileIO.UICancelOption.DoNothing)
        End Sub

        Private Sub Execute()
            If Not IO.File.Exists(Me.GetCurentPathFullName(CreatePrg)) Then Return

            uSystem.ConsoleOut.Execute(Me.GetCurentPathFullName(FoxExe), Me.GetCurentPathFullName(CreatePrg), 500, Me.Path)
        End Sub

        Public Function CreateTable(ByVal createSql As String) As String
            Dim result As String = ""

            '创建Create.prg文件
            FoxPro.CreateFile(Me.GetCurentPathFullName(CreatePrg), FoxPro.CreatePrgString(createSql))

            '执行Create.Prg文件
            Me.Execute()

            '检查错误文件,若有错误,返回错误信息
            Dim fileInfo As New IO.FileInfo(Me.GetCurentPathFullName(CreateErr))
            If fileInfo.Exists Then
                Dim reader As IO.StreamReader = fileInfo.OpenText
                result = reader.ReadToEnd
                reader.Dispose()
                reader = Nothing
            End If

            'For Each s As String In IO.Directory.GetFiles(Me.Path)
            '    Console.WriteLine(s)
            'Next

            '删除临时文件夹X:\LzmTWFox
            Me.DeletePath()

            Return result
        End Function

        Sub New(ByVal path As String)
            Me.gPath = path

            '自资源中释放FOX为FoxRar.Exe文件
            Dim Res As System.Resources.ResourceManager = New System.Resources.ResourceManager("Resources", GetType(FoxPro).Assembly)
            Dim bytes As Byte() = CType(Res.GetObject(FOX), Byte())
            FoxPro.CreateFile(Me.GetCurentPathFullName(FoxRarExe), bytes)

            '解压出文件Fox.Exe,Fox.OVL
            uSystem.ConsoleOut.Execute(Me.GetCurentPathFullName(FoxRarExe), "", , Me.Path)

            '删除FoxRar.Exe文件
            IO.File.Delete(Me.GetCurentPathFullName(FoxRarExe))
        End Sub

        Private ReadOnly FOX As String = "FOX"
        Private ReadOnly FoxRarExe As String = "FoxRar.EXE"
        Private ReadOnly FoxExe As String = "FOX.EXE"
        Private ReadOnly CreatePrg As String = "Create.Prg"
        Private ReadOnly CreateErr As String = "Create.Err"


        Private Function GetCurentPathFullName(ByVal fileName As String) As String
            Return Microsoft.VisualBasic.FileIO.FileSystem.CombinePath(Me.Path, fileName)
        End Function

        Private Shared Function CreatePrgString(ByVal SqlForCreateTable As String) As String
            Dim b As New System.Text.StringBuilder
            b.AppendLine("SET SAFETY OFF;")
            b.AppendLine("SET DEBUG OFF;")
            b.AppendLine("")
            b.AppendLine("ON ERROR DO ErrHandle;")
            b.AppendLine("")
            b.AppendLine(SqlForCreateTable & ";")
            b.AppendLine("")
            b.AppendLine("QUIT;")
            b.AppendLine("")
            b.AppendLine("PROCEDURE ErrHandle")
            b.AppendLine("QUIT")

            Return b.ToString
        End Function

        Private Shared Sub CreateFile(ByVal fileName As String, ByVal content As Byte())
            Dim fileInfo As New IO.FileInfo(fileName)
            Dim stream As IO.FileStream = fileInfo.Open(IO.FileMode.Create)
            stream.Write(content, 0, content.Length)
            stream.Flush()
            stream.Dispose()
            stream = Nothing
        End Sub

        Private Shared Sub CreateFile(ByVal fileName As String, ByVal content As String)
            Dim Writer As New IO.StreamWriter(fileName, False)
            Writer.Write(content)
            Writer.Flush()
            Writer.Dispose()
            Writer = Nothing
        End Sub
    End Class
End Namespace

[水如烟]

exe文件的加载类

Namespace LzmTW.uSystem
    Public Class ConsoleOut

        Public Shared Function Execute(ByVal cmd As String, Optional ByVal waitTime As Integer = 500, Optional ByVal workingDirectory As String = "") As String
            Dim result As String = ""
            If String.IsNullOrEmpty(cmd) Then Return result

            Dim Info As ProcessStartInfo = GetStartInfo(cmd, workingDirectory)

            Return Execute(Info, waitTime)
        End Function

        Public Shared Function Execute(ByVal fileName As String, ByVal args As String, Optional ByVal waitTime As Integer = 500, Optional ByVal workingDirectory As String = "") As String
            Dim result As String = ""
            If String.IsNullOrEmpty(fileName) Then Return result

            Dim Info As ProcessStartInfo = GetStartInfo(fileName, args, workingDirectory)

            Return Execute(Info, waitTime)
        End Function

        Private Shared Function Execute(ByVal info As ProcessStartInfo, ByVal waitTime As Integer) As String
            Dim result As String = ""

            Dim process As New Process
            process.StartInfo = info

            Try
                If process.Start Then
                    If waitTime = 0 Then
                        process.WaitForExit()
                    Else
                        process.WaitForExit(waitTime)
                    End If

                    result = process.StandardOutput.ReadToEnd
                End If
            Catch ex As Exception
                result = ex.Message
            Finally
                process.Dispose()
                process = Nothing
            End Try

            Return result
        End Function

        Private Shared Function GetStartInfo(ByVal cmd As String, ByVal WorkingDirectory As String) As ProcessStartInfo
            Return GetStartInfo(System.Environment.GetEnvironmentVariable("ComSpec"), String.Format("/C {0}", cmd), WorkingDirectory)
        End Function

        Private Shared Function GetStartInfo(ByVal fileName As String, ByVal args As String, ByVal WorkingDirectory As String) As ProcessStartInfo
            Dim mStartInfo As New ProcessStartInfo

            With mStartInfo
                .CreateNoWindow = True
                .RedirectStandardOutput = True
                .UseShellExecute = False
                .WorkingDirectory = WorkingDirectory
                .FileName = fileName
                .Arguments = args
            End With

            Return mStartInfo
        End Function
    End Class
End Namespace

[水如烟]

uSystem.ConsoleOut.Execute(Me.GetCurentPathFullName(FoxRarExe), "", , Me.Path)

指定Me.Path是必要的,否则,fox.exe运行时生成的多个临时文件,不会在fox.exe所在的目录创建,而创建在程序即Application所在的目录.

[水如烟]

创建表的示例语句

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim sql As String = "CREATE TABLE ""g:\Office\Hello.DBF""(name Character(80), addr Character(30), Salary Numeric(8,2), sex Logical, birthday Date,income Float(10,3))"
        Dim result As String = LzmTW.Data.FoxPro.CreateDBaseTable(sql)
        Console.WriteLine(result)
    End Sub

如果成功创建,Result为String.Empty,否则,为错误信息.

[水如烟]

FoxPro2.6原是在Dos运行的,因此,文件名需要遵循8.3格式.

        <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
        Public Shared Function GetShortPathName _
        (ByVal longPath As String, _
         <MarshalAs(UnmanagedType.LPTStr)> _
         ByVal ShortPath As System.Text.StringBuilder, _
         <MarshalAs(UnmanagedType.U4)> _
         ByVal bufferSize As Integer) As Integer
        End Function

        Public Shared Function GetShortPathName(ByVal Path As String) As String
            Dim b As New System.Text.StringBuilder(1024)
            Dim result As String
            Dim value As Integer = uSystem.Win32Native.GetShortPathName(Path, b, 1024)
            If value <> 0 Then
                result = b.ToString()
            Else
                Throw New Exception("Failed to return a short path")
            End If

            Return result
        End Function

[水如烟]

例如,如"我的文档"为表的文件夹

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim sql As String = "CREATE TABLE ""{0}\Hello.DBF""(name Character(80), addr Character(30), Salary Numeric(8,2), sex Logical, birthday Date,income Float(10,3))"
        Dim path As String = System.Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
        Dim shortPath As String = LzmTW.Data.Util.GetShortPathName(path)
        Dim result As String = LzmTW.Data.FoxPro.CreateDBaseTable(String.Format(sql, shortPath))
        Console.WriteLine(result)
    End Sub

[水如烟]

ODBC,OLEDB两种连接方式,即
Private Const ConnnectionStringFormat As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties=dBASE IV;User ID=Admin;Password=;"
或
Private Const ConnnectionStringFormat As String = "Driver={{Microsoft dBASE Driver (*.dbf)}};DriverID=277;Dbq={0};"

都允许UNC路径(形如\\computer\sharepath).
但在FoxPro2.6,是不允许的,只能通过映射共享文件为本地的一个驱动器来连接网络资源.

[水如烟]

如何判断Connection的数据源是本地的一个文件夹还是UNC路径,可以通过URI的IsUnc属性来判断.

数据源对两种连接方式,其出处也不相同.
如同是连接到G:\Office

    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
        Dim db As LzmTW.Data.Database

        db = New LzmTW.Data.DBaseOleDbDatabase("g:\office")
        Console.WriteLine(String.Format("DataSource:{0}, Database:{1}", db.DataSource, db.Database))

        db = New LzmTW.Data.DBaseOdbcDatabase("g:\office")
        Console.WriteLine(String.Format("DataSource:{0}, Database:{1}", db.DataSource, db.Database))

    End Sub

结果是:
DataSource:g:\office, Database:
DataSource:DBASE, Database:g:\office

如果已知数据源(路径)
如连接到\\fk-a09-05\Shared,这是一个UNC路径,

    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
        Dim uri As New Uri("\\fk-a09-05\shared")

        Console.WriteLine(uri.IsUnc)

    End Sub

其判断结果当然为True

[水如烟]

如何映射、断开一个网络资源，需用到mpr.dll的有关方法。

Imports System.Runtime.InteropServices

Namespace LzmTW.uSystem
    Friend Class Win32Native
        Private Sub New()
        End Sub

        Public Const CONNECT_UPDATE_PROFILE As Integer = &H1

        Public Enum ResourceScope
            ''' <summary>
            ''' 枚举已连接的资源（忽略dwUsage）
            ''' </summary>
            RESOURCE_CONNECTED = 1
            ''' <summary>
            ''' 枚举所有资源
            ''' </summary>
            RESOURCE_GLOBALNET
            ''' <summary>
            ''' 只枚举永久性连接
            ''' </summary>
            RESOURCE_REMEMBERED
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCE_RECENT
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCE_CONTEXT
        End Enum

        Public Enum ResourceType
            ''' <summary>
            ''' 枚举所有类型的网络资源
            ''' </summary>
            RESOURCETYPE_ANY
            ''' <summary>
            ''' 枚举磁盘资源
            ''' </summary>
            RESOURCETYPE_DISK
            ''' <summary>
            ''' 枚举打印资源
            ''' </summary>
            RESOURCETYPE_PRINT
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCETYPE_RESERVED
        End Enum

        Public Enum ResourceUsage
            ''' <summary>
            ''' 只枚举那些能够连接的资源
            ''' </summary>
            RESOURCEUSAGE_CONNECTABLE = &H1
            ''' <summary>
            ''' 只枚举包含了其他资源的资源
            ''' </summary>
            RESOURCEUSAGE_CONTAINER = &H2
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEUSAGE_NOLOCALDEVICE = &H4
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEUSAGE_SIBLING = &H8
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEUSAGE_ATTACHED = &H10
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEUSAGE_ALL = RESOURCEUSAGE_CONNECTABLE Or RESOURCEUSAGE_CONTAINER Or RESOURCEUSAGE_ATTACHED
        End Enum

        Public Enum ResourceDisplayType
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_GENERIC
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_DOMAIN
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_SERVERrhf
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_SHARE
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_FILE
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_GROUP
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_NETWORK
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_ROOT
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_SHAREADMIN
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_DIRECTORY
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_TREE
            ''' <summary>
            ''' 
            ''' </summary>
            RESOURCEDISPLAYTYPE_NDSCONTAINER
        End Enum

        <StructLayout(LayoutKind.Sequential)> _
        Public Structure NETRESOURCE
            Public dwScope As ResourceScope
            Public dwType As ResourceType
            Public dwDisplayType As ResourceDisplayType
            Public dwUsage As ResourceUsage
            Public lpLocalName As String
            Public lpRemoteName As String
            Public lpComment As String
            Public lpProvider As String
        End Structure

        <DllImport("mpr.dll", SetLastError:=True)> _
        Public Shared Function WNetAddConnection2 _
        (ByRef lpNetResource As NETRESOURCE, _
         ByVal lpPassword As String, _
         ByVal lpUserName As String, _
         ByVal dwFlags As Integer) As Integer
        End Function

        <DllImport("mpr.dll", SetLastError:=True)> _
        Public Shared Function WNetCancelConnection2 _
        (ByVal lpName As String, _
         ByVal dwFlags As Integer, _
         ByVal fForce As Integer) As Integer
        End Function

    End Class
End Namespace

        Public Shared Function MapDrive(ByRef UNCPath As String, ByRef Drive As String, Optional ByVal user As String = Nothing, Optional ByVal pass As String = Nothing) As Boolean
            Dim mDrive As String = GetLastDrive()
            Drive = String.Empty

            Dim data As New uSystem.Win32Native.NETRESOURCE
            With data
                .dwScope = LzmTW.uSystem.Win32Native.ResourceScope.RESOURCE_GLOBALNET
                .dwType = LzmTW.uSystem.Win32Native.ResourceType.RESOURCETYPE_DISK
                .dwUsage = LzmTW.uSystem.Win32Native.ResourceUsage.RESOURCEUSAGE_ALL
                .lpLocalName = GetDriveName(CChar(mDrive))
                .lpRemoteName = UNCPath
                .lpComment = Nothing
                .lpProvider = Nothing
            End With

            Dim result As Integer
            result = LzmTW.uSystem.Win32Native.WNetAddConnection2(data, pass, user, 0)

            If result = 0 Then
                Drive = mDrive
                Return True
            Else
                Drive = GetWin32ErrorMessage()
                Return False
            End If
        End Function

        Public Shared Function UnMapDrive(ByVal Driver As Char, ByRef ErrMessage As String) As Boolean
            Dim mDrive As String = GetDriveName(Driver)
            ErrMessage = String.Empty

            Dim result As Integer
            result = LzmTW.uSystem.Win32Native.WNetCancelConnection2(mDrive, 0, 1)

            If result = 0 Then
                Return True
            Else
                ErrMessage = GetWin32ErrorMessage()
                Return False
            End If
        End Function

        Private Shared Function GetDriveName(ByVal driver As Char) As String
            If driver < "A"c OrElse driver > "z"c OrElse (driver > "Z"c And driver < "a"c) Then
                Throw New Exception("驱动器无效")
            End If

            Return String.Concat(driver.ToString.ToUpper, IO.Path.VolumeSeparatorChar)
        End Function

[水如烟]

至于取可用可连接的驱动器，我找不到可用的方法，但应该有这样的方法，
WNetConnectionDialog对话框的驱动器列表就列出了可用可连接的驱动器。

现在我暂时这样做：

        Public Shared Function GetLastDrive() As Char
            Dim usedDriveList As New List(Of String)
            Dim result As Char = Nothing

            For Each info As IO.DriveInfo In IO.DriveInfo.GetDrives
                usedDriveList.Add(info.Name)
            Next

            For Each d As Char In Drives
                Dim drive As String = String.Concat(d.ToString, IO.Path.VolumeSeparatorChar, IO.Path.DirectorySeparatorChar)
                If Not usedDriveList.Contains(drive) Then
                    result = d
                    Exit For
                End If
            Next

            Return result
        End Function
        Private Shared ReadOnly Drives() As Char = New Char() {"C"c, "D"c, "E"c, "F"c, "G"c, "H"c, "I"c, "J"c, "K"c, "L"c, "M"c, "N"c, "O"c, "P"c, "Q"c, "R"c, "S"c, "T"c, "U"c, "V"c, "W"c, "X"c, "Y"c, "Z"c}

[水如烟]

我也尝试过利用WNetEnumResource枚举网络资源，但取不到那个列表。

Imports System.Runtime.InteropServices

Public Class NetResource
    Private Sub New()
    End Sub

    Public Const CONNECT_UPDATE_PROFILE As Integer = &H1

    Public Enum ResourceScope
        ''' <summary>
        ''' 枚举已连接的资源（忽略dwUsage）
        ''' </summary>
        RESOURCE_CONNECTED = 1
        ''' <summary>
        ''' 枚举所有资源
        ''' </summary>
        RESOURCE_GLOBALNET
        ''' <summary>
        ''' 只枚举永久性连接
        ''' </summary>
        RESOURCE_REMEMBERED
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCE_RECENT
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCE_CONTEXT
    End Enum

    Public Enum ResourceType
        ''' <summary>
        ''' 枚举所有类型的网络资源
        ''' </summary>
        RESOURCETYPE_ANY
        ''' <summary>
        ''' 枚举磁盘资源
        ''' </summary>
        RESOURCETYPE_DISK
        ''' <summary>
        ''' 枚举打印资源
        ''' </summary>
        RESOURCETYPE_PRINT
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCETYPE_RESERVED
    End Enum

    Public Enum ResourceUsage
        ''' <summary>
        ''' 只枚举那些能够连接的资源
        ''' </summary>
        RESOURCEUSAGE_CONNECTABLE = &H1
        ''' <summary>
        ''' 只枚举包含了其他资源的资源
        ''' </summary>
        RESOURCEUSAGE_CONTAINER = &H2
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEUSAGE_NOLOCALDEVICE = &H4
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEUSAGE_SIBLING = &H8
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEUSAGE_ATTACHED = &H10
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEUSAGE_ALL = RESOURCEUSAGE_CONNECTABLE Or RESOURCEUSAGE_CONTAINER Or RESOURCEUSAGE_ATTACHED
    End Enum

    Public Enum ResourceDisplayType
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_GENERIC
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_DOMAIN
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_SERVERrhf
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_SHARE
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_FILE
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_GROUP
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_NETWORK
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_ROOT
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_SHAREADMIN
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_DIRECTORY
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_TREE
        ''' <summary>
        ''' 
        ''' </summary>
        RESOURCEDISPLAYTYPE_NDSCONTAINER
    End Enum

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure NETRESOURCE
        Public dwScope As ResourceScope
        Public dwType As ResourceType
        Public dwDisplayType As ResourceDisplayType
        Public dwUsage As ResourceUsage
        Public lpLocalName As String
        Public lpRemoteName As String
        Public lpComment As String
        Public lpProvider As String
    End Structure


    <DllImport("mpr.dll", SetLastError:=True)> _
    Public Shared Function WNetOpenEnum _
    (ByVal dwScope As ResourceScope, _
     ByVal dwType As ResourceType, _
     ByVal dwUsage As ResourceUsage, _
     <MarshalAs(UnmanagedType.AsAny)> ByVal lpNetResource As Object, _
     ByRef lphEnum As IntPtr) As Integer
    End Function

    <DllImport("mpr.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Public Shared Function WNetCloseEnum _
    (ByVal lphEnum As IntPtr) As Integer
    End Function

    <DllImport("mpr.dll", SetLastError:=True)> _
    Public Shared Function WNetEnumResource _
    (ByVal hEnum As IntPtr, _
     ByRef lpCount As Integer, _
     ByVal lpBuffer As IntPtr, _
     ByRef lpBufferSize As Integer) As Integer
    End Function

End Class

Imports System.Runtime.InteropServices

Public Class WNET

    Public Shared Sub EnumResource(ByVal scope As NetResource.ResourceScope, ByVal type As NetResource.ResourceType, ByVal usage As NetResource.ResourceUsage, ByVal source As NetResource.NETRESOURCE, ByVal acton As Action(Of NetResource.NETRESOURCE))

        Dim iRet As Integer
        Dim ptrHandle As IntPtr = New IntPtr

        Try

            iRet = NetResource.WNetOpenEnum(scope, type, usage, source, ptrHandle)

            If iRet <> 0 Then
                Return
            End If

            Dim entries As Integer
            Dim buffer As Integer = &H4000
            Dim ptrBuffer As IntPtr = Marshal.AllocHGlobal(buffer)

            Dim nextSource As NetResource.NETRESOURCE

            Do While True
                entries = -1
                buffer = &H4000

                iRet = NetResource.WNetEnumResource(ptrHandle, entries, ptrBuffer, buffer)

                If iRet <> 0 OrElse entries < 1 Then
                    Return
                End If

                Dim ptr As Integer = ptrBuffer.ToInt32()

                For i As Integer = 0 To entries - 1

                    nextSource = CType(Marshal.PtrToStructure(New IntPtr(ptr), GetType(NetResource.NETRESOURCE)), NetResource.NETRESOURCE)

                    EnumResource(scope, type, usage, nextSource, acton)

                    acton.Invoke(nextSource)

                    ptr += Marshal.SizeOf(nextSource)


                Next i
            Loop

            Marshal.FreeHGlobal(ptrBuffer)

            iRet = NetResource.WNetCloseEnum(ptrHandle)

        Catch e As Exception
            Console.WriteLine(e.ToString)
        End Try
    End Sub
End Class

[水如烟]

如

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        WNET.EnumResource( _
        NetResource.ResourceScope.RESOURCE_CONNECTED _
        , NetResource.ResourceType.RESOURCETYPE_DISK _
        , NetResource.ResourceUsage.RESOURCEUSAGE_ALL _
        , Nothing, AddressOf action)
    End Sub

    Private Sub action(ByVal resoure As NetResource.NETRESOURCE)
        With resoure
            Console.WriteLine(" {0} : LocalName='{1}' RemoteName='{2}'", .dwDisplayType.ToString(), .lpLocalName, .lpRemoteName)
        End With
    End Sub

结果是：
RESOURCEDISPLAYTYPE_SHARE : LocalName='I:' RemoteName='\\fk-a09-05\shared_db1'

[honkerhero]

MARK and Learn

[CloneCenter]

仰望中……
学习中……

[mfhappy]

你好，我想问下dbase3中的数据可以导入到FoxPro中吗？dbase3怎样导入到FoxPro中？由于今天经理让我查这个问题，查了半天也没得出什么结论，还请楼主帮下我，dbase3和FoxPro以前从来都没有接触过。