首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

[原创]快速拷贝数组程序,该如何处理

2012-03-15 来源:读书人网 【读书人网(Reader8.cn):综合教育门户网站】
[原创]快速拷贝数组程序这几天刚到新公司上班,还没安排任务下来,无聊就写了这个程序主要是为了在VB中提高

[原创]快速拷贝数组程序
这几天刚到新公司上班,还没安排任务下来,无聊就写了这个程序主要是为了在VB中提高效率,程序运行一次没问题,但是郁闷的是运行第二次会出问题,由于上班时间没得多的调试时间。大家可以一起研究改善一下。我目前发现的问题是第二次调用的时候会自动更改了原数组的内容问题就出在这里。  


Option   Explicit  

Private   Declare   Sub   CopyMemory   Lib   "kernel32 "   Alias   "RtlMoveMemory "   (Destination   As   Any,   Source   As   Any,   ByVal   Length   As   Long)  
Private   byteSave()   As   Byte  
Private   byteView()   As   Byte  
Private   strSave()   As   String  
Private   strView()   As   String  

Private   Sub   cmdCancel_Click()  
        Unload   Me  
End   Sub  

Private   Sub   cmdSave_Click()  
        If   textBytes1.Text   <>   " "   Then  
'                 cmdSave.Enabled   =   False  
'                 byteSave   =   StrConv(textBytes1.Text,   vbFromUnicode)  
'                 MsgBox   "保存完毕!!现在可以拷贝了!! "  
'                 cmdSave.Enabled   =   True  
                '字符串数组  
                cmdSave.Enabled   =   False  
                strSave   =   Split(textBytes1.Text,   ", ")  
'                 MsgBox   "保存完毕!!现在可以拷贝了!! "  
                cmdSave.Enabled   =   True  
        End   If  
'         Dim   hFile   As   Integer  
'         hFile   =   FreeFile  
'         Open   "c:\1.xls "   For   Binary   As   #hFile  
'         ReDim   byteSave(FileLen( "c:\1.xls ")   -   1)  
'         Get   #hFile,   ,   byteSave  
'         Close   #hFile  
End   Sub  

Private   Function   IsByteArrayIsInitialize(bytes()   As   Byte)   As   Boolean  
        Dim   i   As   Long  
        On   Error   GoTo   errLine  
        i   =   UBound(bytes)  
        IsByteArrayIsInitialize   =   True  
        Exit   Function  
errLine:  
        IsByteArrayIsInitialize   =   False  
End   Function  

Private   Function   IsStringArrayIsInitialize(strArray()   As   String)   As   Boolean  
        Dim   i   As   Long  
        On   Error   GoTo   errLine  
        i   =   UBound(strArray)  
        IsStringArrayIsInitialize   =   True  


        Exit   Function  
errLine:  
        IsStringArrayIsInitialize   =   False  
End   Function  

Private   Sub   cmdView_Click()  
'         CopyByteArray   byteSave,   byteView  
'         textBytes2.Text   =   StrConv(byteView,   vbUnicode)  
        '拷贝字符串数组  
        Dim   strTmp   As   String,   i   As   Integer  
        Erase   strView  
        CopyStringArray   strSave,   strView  
        For   i   =   0   To   UBound(strView)  
                strTmp   =   strTmp   &   strView(i)   &   ", "  
        Next  
        textBytes2.Text   =   Left(strTmp,   Len(strTmp)   -   1)  
'         Dim   hFile   As   Integer  
'         hFile   =   FreeFile  
'         Open   "c:\2.xls "   For   Binary   As   #hFile  
'         ReDim   byteView(FileLen( "c:\1.xls ")   -   1)  
'         Put   #hFile,   ,   byteSave  
'         Close   #hFile  
End   Sub  

'这几个注释的方法都是可以的  
'Private   Sub   CopyByteArray(byteSource()   As   Byte,   byteDest()   As   Byte)  
'         Dim   lng1   As   Long,   lng2   As   Long  
'         If   IsByteArrayIsInitialize(byteSource)   Then  
'                 lng1   =   StrPtr(byteSource)  
'                 CopyMemory   lng2,   lng1,   4  
'                 ReDim   byteView(UBound(byteSource))  
'                 CopyMemory   ByVal   VarPtr(byteDest(0)),   ByVal   lng2,   LenB(byteSource(0))   *   (UBound(byteSource)   +   1)  
'         End   If  
'End   Sub  

'Private   Sub   CopyByteArray(byteSource()   As   Byte,   byteDest()   As   Byte)  
'         Dim   lng1   As   Long,   lng2   As   Long  
'         If   IsByteArrayIsInitialize(byteSource)   Then  
'                 lng1   =   StrPtr(byteSource)  
'                 CopyMemory   lng2,   lng1,   4  
'                 ReDim   byteView(UBound(byteSource))  
'                 CopyMemory   byteDest(0),   ByVal   lng2,   LenB(byteSource(0))   *   (UBound(byteSource)   +   1)  


'         End   If  
'End   Sub  

Private   Sub   CopyByteArray(byteSource()   As   Byte,   byteDest()   As   Byte)  
        Dim   lng1   As   Long,   lng2   As   Long  
        If   IsByteArrayIsInitialize(byteSource)   Then  
                lng1   =   VarPtr(byteSource(0))  
                CopyMemory   lng2,   lng1,   4  
                ReDim   byteView(UBound(byteSource))  
                CopyMemory   ByVal   VarPtr(byteDest(0)),   ByVal   lng2,   LenB(byteSource(0))   *   (UBound(byteSource)   +   1)  
        End   If  
End   Sub  

'Private   Sub   CopyByteArray(byteSource()   As   Byte,   byteDest()   As   Byte)  
'         Dim   lng1   As   Long,   lng2   As   Long  
'         If   IsByteArrayIsInitialize(byteSource)   Then  
'                 lng1   =   VarPtr(byteSource(0))  
'                 CopyMemory   lng2,   lng1,   4  
'                 ReDim   byteView(UBound(byteSource))  
'                 CopyMemory   byteDest(0),   ByVal   lng2,   LenB(byteSource(0))   *   (UBound(byteSource)   +   1)  
'         End   If  
'End   Sub  

'这个注释的也可以和下面是一样的  
'Private   Sub   CopyStringArray(strSourceArray()   As   String,   strDestArray()   As   String)  
'         Dim   lng1   As   Long,   lng2   As   Long  
'         If   IsStringArrayIsInitialize(strSourceArray)   Then  
'                 Debug.Print   strSourceArray(0)  
'                 lng1   =   VarPtr(strSourceArray(0))  
'                 CopyMemory   lng2,   lng1,   4  
'                 ReDim   strDestArray(UBound(strSourceArray))  
'                 CopyMemory   ByVal   VarPtr(strDestArray(0)),   ByVal   lng2,   LenB(strSourceArray(0))   *   (UBound(strSourceArray)   +   1)  
'         End   If  
'End   Sub  

Private   Sub   CopyStringArray(strSourceArray()   As   String,   strDestArray()   As   String)  
        Dim   lng1   As   Long,   lng2   As   Long  
        If   IsStringArrayIsInitialize(strSourceArray)   Then  
                '问题出在这里第二次执行时会把strSourceArray(0)的值更改这是导致程序错误的所在  


                lng1   =   VarPtr(strSourceArray(0))  
                CopyMemory   lng2,   lng1,   4  
                ReDim   strDestArray(UBound(strSourceArray))  
                '这里最好用4*(UBound(strSourceArray)   +   1)   因为可能第一个元素为空上面的也修改即可
                CopyMemory   ByVal   VarPtr(strDestArray(0)),   ByVal   lng2,   4   *   (UBound(strSourceArray)   +   1)   'LenB(strSourceArray(0))   *   (UBound(strSourceArray)   +   1)  
        End   If  
End   Sub  

Private   Sub   Form_Load()  

End   Sub  

Private   Sub   Form_Unload(Cancel   As   Integer)  
        Erase   strSave  
        Erase   strView  
End   Sub


[解决办法]
只能对一维数组有效的,多维数组在VB中是按列存储的。
[解决办法]
up
[解决办法]
呵呵
其实一维数组的快速拷贝不就一条语句不就可以了


Private Declare Sub CopyMemory Lib "kernel32 " Alias "RtlMoveMemory " (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub CopyByteArray(byteSource() As Byte, byteDest() As Byte)
CopyMemory ByVal VarPtr(byteDest(0)), ByVal VarPtr(byteSource(0)), LenB(byteSource(0)) * (UBound(byteSource) + 1)
End Sub

Private Sub Command1_Click()
Dim a(10) As Byte
For i = 0 To 10
a(i) = i ^ 2
Next
Dim b(10) As Byte
CopyByteArray a, b
End Sub