VB 可以分散到像 FoxPro 这样的变量吗?
Can VB scatter to variables like FoxPro?
我需要把一些用 VisualFoxPro 编写的代码用 VB 重写。由于没有使用 FoxPro 的经验,我询问了代码中使用的一些命令,并找到了一个特殊用途的命令:scatter memvar
,它从 table 中的列创建了单独的变量。 VB 是否具有等效功能,或者我是否需要使用 Dim
语句创建每个变量?
编辑:我应该提到我正在寻找使用它来传播数据tables,非常抱歉。稍后在 VFP 程序中 insert into memvar
将变量匹配到它们各自的列。我希望避免需要以下方法:
For Each row As DataRow in MyTable
row.Item(0,i) = myVar1
row.Item(1,i) = myVar2
'etc.
i += 1
Next
遗憾的是,以上是我输入大部分数据的方式。
编辑:为了回应@DRapp 的评论,我正在使用VB 读取.xin
文件并从其代码中形成访问数据table。 .xin
文件中有两个 "collections" 是我感兴趣的:<NamedSymbologyCollection>
和 <FeatureStylesCollection>
。这两个集合都在文件的同一行中,所以我编写了代码来逐个标记,挑选出我想要的信息,并将其添加到临时数据 table.
Do Until reader.EndOfStream
content = reader.ReadLine
For Each code In content
If content.Length > 0 Then
crntTag = content.Substring(0, content.IndexOf(">") + 1)
If crntTag.Contains("/FeatureStyleCollection>") Then
Exit Do
End If
If crntTag.Contains("<NamedSymbology ItemName") Then
wholeTag = GetFullLine(content)
xinCompile.Rows.Add()
For Each entry In wholeTag
lcstring = wholeTag.Substring(0, wholeTag.IndexOf(">") + 1)
If wholeTag.Length = 0 Then
Exit For
End If
If lcstring.Contains("<NamedSymbology ") Then
SymbName = GrabCodeElement(lcstring, "ItemName=")
SymbDesc = GrabCodeElement(lcstring, "Description=")
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
xinCompile.Rows(i).Item("symbName") = SymbName
xinCompile.Rows(i).Item("symbDesc") = SymbDesc
ElseIf lcstring.Contains("<BasePointSymbology ") Then
CellLayer = GrabCodeElement(lcstring, "CellLayerName=")
CellName = GrabCodeElement(lcstring, "Name=")
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
xinCompile.Rows(i).Item("cellLayer") = CellLayer
xinCompile.Rows(i).Item("cellName") = CellName
ElseIf lcstring.Contains("<LineSymbology ") Then
LineSymb = GrabCodeElement(lcstring, "<LineSymbology LayerName=")
LineSymb = LineSymb.Substring(15, LineSymb.Length - 16)
xinCompile.Rows(i).Item("lineSymb") = LineSymb
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
Else
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
End If
Next
i += 1
ElseIf crntTag.Contains("<FeatureStyle ItemName") Then
wholeTag = GetFullLine(content)
j = 0
featStyles.Rows.Add()
For Each entry In wholeTag
lcstring = wholeTag.Substring(0, wholeTag.IndexOf(">") + 1)
If wholeTag.Length = 0 Then
Exit For
End If
If lcstring.Contains("<FeatureStyle ") Then
SymbName = GrabCodeElement(lcstring, "ItemName=")
SymbDesc = GrabCodeElement(lcstring, "Description=")
For Each item As DataRow In xinCompile.Rows
If SymbName = item.Item("symbName") Then
found = True
Exit For
End If
j += 1
Next
If found = True Then
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
Else
Exit For
End If
xinCompile.Rows(j).Item("symbDesc") = SymbDesc
ElseIf lcstring.Contains("<SurveyFeature ") Then
NumCode = GrabCodeElement(lcstring, "NumericCode=")
DTMexclude = GrabCodeElement(lcstring, "ExcludeFromTriangulation=")
lineToPrev = GrabCodeElement(lcstring, "LineToPrevious=")
featType = GrabCodeElement(lcstring, "FeatureType=")
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
xinCompile.Rows(j).Item("numCode") = NumCode
xinCompile.Rows(j).Item("DTMexclude") = DTMexclude
xinCompile.Rows(j).Item("lineToPrev") = lineToPrev
xinCompile.Rows(j).Item("featType") = featType
ElseIf lcstring.Contains("<Attribute ") Then
LineLayer = GrabCodeElement(lcstring, "Name=")
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
ElseIf lcstring.Contains("<AlphaCode") Then
alphacode = GrabCodeElement(lcstring, "Code=")
If IsDBNull(xinCompile.Rows(j).Item("alphaCode")) Then
fullAlpha = ""
xinCompile.Rows(j).Item("alphaCode") = alphacode
Else
fullAlpha = xinCompile.Rows(j).Item("alphaCode")
xinCompile.Rows(j).Item("alphaCode") = fullAlpha & "," & alphacode
End If
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
Else
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
End If
Next
End If
content = content.Remove(0, crntTag.Length)
Else
Exit For
End If
Next
Loop
如果您对如何改进上述任何内容有任何建议,请告诉我。
首先,我从来没有用过 FoxPro 或 Visual FoxPro,所以不要指望我所说的在每种情况下都能完美工作。查看 this MSDN page,似乎要在 FoxPro 中执行简单的分散命令,您会使用如下内容:
SCATTER FIELDS LIKE A*,P* EXCEPT PARTNO* TO myArray
以上看起来只是获取所有以 A*
和 P*
开头的字段,并从结果中排除匹配 PARTNO*
的项目。我认为这最好转换为使用 LINQ 查询,它可以 return 一个 Object() 数组。
Dim testTable As New DataTable
Dim myArray As Object()
myArray = From rowItem In (From row As DataRow In testTable.Rows Select row.ItemArray) _
Where (rowItem.ToString.StartsWith("A") Or rowItem.ToString.StartsWith("P")) _
And Not rowItem.ToString.StartsWith("PARTNO") Select rowItem
如果您开始更复杂地使用分散命令将值分解为一个新对象,该对象具有与原始 table 中的列相同的属性,那么VB 等价物变得更加困难,因为您必须制作一个继承 System.Dynamic.DynamicObject
class 的 class。所以这个例子来自 the MSDN page
CREATE TABLE Test FREE ;
(Object C(10), Color C(16), SqFt n(6,2))
SCATTER MEMVAR BLANK
m.Object="Box"
m.Color="Red"
m.SqFt=12.5
APPEND BLANK
GATHER MEMVAR
BROWSE
在VB中变得一团糟。我将提供一个非常基本的示例,它非常简单,但希望它能让您了解从哪里开始。
Imports System.Dynamic
Private Class myDynObj : Inherits DynamicObject
Private internalDict As Dictionary(Of String, Object)
Public Sub New()
internalDict = New Dictionary(Of String, Object)
End Sub
Public Sub AddProperty(ByVal PropertyName As String, Optional ByVal Value As Object = Nothing)
addOrSetProperties(New KeyValuePair(Of String, Object)(PropertyName, Value))
End Sub
Public Sub addOrSetProperties(ByVal ParamArray newPropertyValuePairs() As KeyValuePair(Of String, Object))
For Each kvPair As KeyValuePair(Of String, Object) In newPropertyValuePairs.Where(Function(x) Not IsNothing(x.Key))
If internalDict.ContainsKey(kvPair.Key) Then
internalDict.Item(kvPair.Key) = kvPair.Value
Else
internalDict.Add(kvPair.Key, kvPair.Value)
End If
Next
End Sub
Public Overrides Function GetDynamicMemberNames() As IEnumerable(Of String)
Return internalDict.Keys.ToList.Cast(Of String)()
End Function
Public Overrides Function TryGetMember(binder As GetMemberBinder, ByRef result As Object) As Boolean
Return internalDict.TryGetValue(binder.Name, result)
End Function
Public Overrides Function TrySetMember(binder As SetMemberBinder, value As Object) As Boolean
internalDict(binder.Name) = value
Return True
End Function
End Class
以及上面的用法class:
Dim testTable As New DataTable("TheTable")
testTable.Columns.Add("foo")
testTable.Columns.Add("bar")
testTable.Columns.Add("Blargh")
Dim columnNames As New List(Of String)(From column As DataColumn In testTable.Columns Select column.ColumnName)
Dim m As Object = New myDynObj
columnNames.ForEach(Sub(x) DirectCast(m, myDynObj).AddProperty(x))
Console.WriteLine(String.Format("The current properties of the object are as follows: {0}", String.Join(", ", DirectCast(m, myDynObj).GetDynamicMemberNames.Cast(Of String))))
Console.WriteLine()
m.foo = "hoopla" : m.Blargh = 654219 : m.waffles = "I'm New!"
Console.WriteLine("And now the values are:")
DirectCast(m, myDynObj).GetDynamicMemberNames.ToList.ForEach(Sub(x) Console.WriteLine(String.Format("{0}, {1}", x, CallByName(m, x, CallType.Get, Nothing))))
Console.WriteLine()
testTable.Rows.Add(m.foo, m.bar, m.Blargh)
Console.WriteLine("XML result:")
Using sw As New StreamWriter(Console.OpenStandardOutput())
sw.AutoFlush = True
Console.SetOut(sw)
testTable.WriteXml(sw, XmlWriteMode.WriteSchema)
End Using
Console.ReadLine()
SCATTER 命令是 Foxpro 的遗留物,没有本机对象化数据。只需在 dotnet 编程中直接访问 recordset/dataset。
我需要把一些用 VisualFoxPro 编写的代码用 VB 重写。由于没有使用 FoxPro 的经验,我询问了代码中使用的一些命令,并找到了一个特殊用途的命令:scatter memvar
,它从 table 中的列创建了单独的变量。 VB 是否具有等效功能,或者我是否需要使用 Dim
语句创建每个变量?
编辑:我应该提到我正在寻找使用它来传播数据tables,非常抱歉。稍后在 VFP 程序中 insert into memvar
将变量匹配到它们各自的列。我希望避免需要以下方法:
For Each row As DataRow in MyTable
row.Item(0,i) = myVar1
row.Item(1,i) = myVar2
'etc.
i += 1
Next
遗憾的是,以上是我输入大部分数据的方式。
编辑:为了回应@DRapp 的评论,我正在使用VB 读取.xin
文件并从其代码中形成访问数据table。 .xin
文件中有两个 "collections" 是我感兴趣的:<NamedSymbologyCollection>
和 <FeatureStylesCollection>
。这两个集合都在文件的同一行中,所以我编写了代码来逐个标记,挑选出我想要的信息,并将其添加到临时数据 table.
Do Until reader.EndOfStream
content = reader.ReadLine
For Each code In content
If content.Length > 0 Then
crntTag = content.Substring(0, content.IndexOf(">") + 1)
If crntTag.Contains("/FeatureStyleCollection>") Then
Exit Do
End If
If crntTag.Contains("<NamedSymbology ItemName") Then
wholeTag = GetFullLine(content)
xinCompile.Rows.Add()
For Each entry In wholeTag
lcstring = wholeTag.Substring(0, wholeTag.IndexOf(">") + 1)
If wholeTag.Length = 0 Then
Exit For
End If
If lcstring.Contains("<NamedSymbology ") Then
SymbName = GrabCodeElement(lcstring, "ItemName=")
SymbDesc = GrabCodeElement(lcstring, "Description=")
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
xinCompile.Rows(i).Item("symbName") = SymbName
xinCompile.Rows(i).Item("symbDesc") = SymbDesc
ElseIf lcstring.Contains("<BasePointSymbology ") Then
CellLayer = GrabCodeElement(lcstring, "CellLayerName=")
CellName = GrabCodeElement(lcstring, "Name=")
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
xinCompile.Rows(i).Item("cellLayer") = CellLayer
xinCompile.Rows(i).Item("cellName") = CellName
ElseIf lcstring.Contains("<LineSymbology ") Then
LineSymb = GrabCodeElement(lcstring, "<LineSymbology LayerName=")
LineSymb = LineSymb.Substring(15, LineSymb.Length - 16)
xinCompile.Rows(i).Item("lineSymb") = LineSymb
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
Else
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
End If
Next
i += 1
ElseIf crntTag.Contains("<FeatureStyle ItemName") Then
wholeTag = GetFullLine(content)
j = 0
featStyles.Rows.Add()
For Each entry In wholeTag
lcstring = wholeTag.Substring(0, wholeTag.IndexOf(">") + 1)
If wholeTag.Length = 0 Then
Exit For
End If
If lcstring.Contains("<FeatureStyle ") Then
SymbName = GrabCodeElement(lcstring, "ItemName=")
SymbDesc = GrabCodeElement(lcstring, "Description=")
For Each item As DataRow In xinCompile.Rows
If SymbName = item.Item("symbName") Then
found = True
Exit For
End If
j += 1
Next
If found = True Then
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
Else
Exit For
End If
xinCompile.Rows(j).Item("symbDesc") = SymbDesc
ElseIf lcstring.Contains("<SurveyFeature ") Then
NumCode = GrabCodeElement(lcstring, "NumericCode=")
DTMexclude = GrabCodeElement(lcstring, "ExcludeFromTriangulation=")
lineToPrev = GrabCodeElement(lcstring, "LineToPrevious=")
featType = GrabCodeElement(lcstring, "FeatureType=")
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
xinCompile.Rows(j).Item("numCode") = NumCode
xinCompile.Rows(j).Item("DTMexclude") = DTMexclude
xinCompile.Rows(j).Item("lineToPrev") = lineToPrev
xinCompile.Rows(j).Item("featType") = featType
ElseIf lcstring.Contains("<Attribute ") Then
LineLayer = GrabCodeElement(lcstring, "Name=")
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
ElseIf lcstring.Contains("<AlphaCode") Then
alphacode = GrabCodeElement(lcstring, "Code=")
If IsDBNull(xinCompile.Rows(j).Item("alphaCode")) Then
fullAlpha = ""
xinCompile.Rows(j).Item("alphaCode") = alphacode
Else
fullAlpha = xinCompile.Rows(j).Item("alphaCode")
xinCompile.Rows(j).Item("alphaCode") = fullAlpha & "," & alphacode
End If
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
Else
wholeTag = wholeTag.Remove(wholeTag.IndexOf(lcstring), wholeTag.IndexOf(">") + 1)
End If
Next
End If
content = content.Remove(0, crntTag.Length)
Else
Exit For
End If
Next
Loop
如果您对如何改进上述任何内容有任何建议,请告诉我。
首先,我从来没有用过 FoxPro 或 Visual FoxPro,所以不要指望我所说的在每种情况下都能完美工作。查看 this MSDN page,似乎要在 FoxPro 中执行简单的分散命令,您会使用如下内容:
SCATTER FIELDS LIKE A*,P* EXCEPT PARTNO* TO myArray
以上看起来只是获取所有以 A*
和 P*
开头的字段,并从结果中排除匹配 PARTNO*
的项目。我认为这最好转换为使用 LINQ 查询,它可以 return 一个 Object() 数组。
Dim testTable As New DataTable
Dim myArray As Object()
myArray = From rowItem In (From row As DataRow In testTable.Rows Select row.ItemArray) _
Where (rowItem.ToString.StartsWith("A") Or rowItem.ToString.StartsWith("P")) _
And Not rowItem.ToString.StartsWith("PARTNO") Select rowItem
如果您开始更复杂地使用分散命令将值分解为一个新对象,该对象具有与原始 table 中的列相同的属性,那么VB 等价物变得更加困难,因为您必须制作一个继承 System.Dynamic.DynamicObject
class 的 class。所以这个例子来自 the MSDN page
CREATE TABLE Test FREE ;
(Object C(10), Color C(16), SqFt n(6,2))
SCATTER MEMVAR BLANK
m.Object="Box"
m.Color="Red"
m.SqFt=12.5
APPEND BLANK
GATHER MEMVAR
BROWSE
在VB中变得一团糟。我将提供一个非常基本的示例,它非常简单,但希望它能让您了解从哪里开始。
Imports System.Dynamic
Private Class myDynObj : Inherits DynamicObject
Private internalDict As Dictionary(Of String, Object)
Public Sub New()
internalDict = New Dictionary(Of String, Object)
End Sub
Public Sub AddProperty(ByVal PropertyName As String, Optional ByVal Value As Object = Nothing)
addOrSetProperties(New KeyValuePair(Of String, Object)(PropertyName, Value))
End Sub
Public Sub addOrSetProperties(ByVal ParamArray newPropertyValuePairs() As KeyValuePair(Of String, Object))
For Each kvPair As KeyValuePair(Of String, Object) In newPropertyValuePairs.Where(Function(x) Not IsNothing(x.Key))
If internalDict.ContainsKey(kvPair.Key) Then
internalDict.Item(kvPair.Key) = kvPair.Value
Else
internalDict.Add(kvPair.Key, kvPair.Value)
End If
Next
End Sub
Public Overrides Function GetDynamicMemberNames() As IEnumerable(Of String)
Return internalDict.Keys.ToList.Cast(Of String)()
End Function
Public Overrides Function TryGetMember(binder As GetMemberBinder, ByRef result As Object) As Boolean
Return internalDict.TryGetValue(binder.Name, result)
End Function
Public Overrides Function TrySetMember(binder As SetMemberBinder, value As Object) As Boolean
internalDict(binder.Name) = value
Return True
End Function
End Class
以及上面的用法class:
Dim testTable As New DataTable("TheTable")
testTable.Columns.Add("foo")
testTable.Columns.Add("bar")
testTable.Columns.Add("Blargh")
Dim columnNames As New List(Of String)(From column As DataColumn In testTable.Columns Select column.ColumnName)
Dim m As Object = New myDynObj
columnNames.ForEach(Sub(x) DirectCast(m, myDynObj).AddProperty(x))
Console.WriteLine(String.Format("The current properties of the object are as follows: {0}", String.Join(", ", DirectCast(m, myDynObj).GetDynamicMemberNames.Cast(Of String))))
Console.WriteLine()
m.foo = "hoopla" : m.Blargh = 654219 : m.waffles = "I'm New!"
Console.WriteLine("And now the values are:")
DirectCast(m, myDynObj).GetDynamicMemberNames.ToList.ForEach(Sub(x) Console.WriteLine(String.Format("{0}, {1}", x, CallByName(m, x, CallType.Get, Nothing))))
Console.WriteLine()
testTable.Rows.Add(m.foo, m.bar, m.Blargh)
Console.WriteLine("XML result:")
Using sw As New StreamWriter(Console.OpenStandardOutput())
sw.AutoFlush = True
Console.SetOut(sw)
testTable.WriteXml(sw, XmlWriteMode.WriteSchema)
End Using
Console.ReadLine()
SCATTER 命令是 Foxpro 的遗留物,没有本机对象化数据。只需在 dotnet 编程中直接访问 recordset/dataset。