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

水如烟 2008-05-04 10:35:39

加精

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

...全文

413 18 打赏收藏转发到动态举报

写回复

用AI写文章

18 条回复

切换为时间正序

请发表友善的回复…

发表回复

mfhappy 2011-02-14

打赏
举报

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

CloneCenter 2008-05-05

打赏
举报

仰望中……
学习中……

honkerhero 2008-05-05

打赏
举报

MARK and Learn

水如烟 2008-05-05

打赏
举报

如

    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'

水如烟 2008-05-05

打赏
举报

我也尝试过利用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

水如烟 2008-05-05

打赏
举报

至于取可用可连接的驱动器，我找不到可用的方法，但应该有这样的方法，
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}

水如烟 2008-05-05

打赏
举报

如何映射、断开一个网络资源，需用到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

水如烟 2008-05-05

打赏
举报

如何判断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

水如烟 2008-05-05

打赏
举报

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,是不允许的,只能通过映射共享文件为本地的一个驱动器来连接网络资源.

水如烟 2008-05-04

打赏
举报

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

    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

水如烟 2008-05-04

打赏
举报

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

水如烟 2008-05-04

打赏
举报

创建表的示例语句

    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,否则,为错误信息.

水如烟 2008-05-04

打赏
举报

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

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

水如烟 2008-05-04

打赏
举报

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

水如烟 2008-05-04

打赏
举报

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

水如烟 2008-05-04

打赏
举报

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