📄 ccmdconvertdata.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CCmdConvertData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
' The author may be contacted at:
' TheodoreWard@Hotmail.com or TheodoreWard@Yahoo.com
Option Explicit
Private mIndex As Integer
Private mUniqueID As String
Private mConvertFromType As Integer
Private mConvertToType As Integer
Public Function GetID() As String
GetID = mUniqueID
End Function
Public Function Copy() As CCmdConvertData
On Error GoTo eHandler
Set Copy = Nothing
Dim newObj As CCmdConvertData
Set newObj = New CCmdConvertData
newObj.ConvertToType = Me.ConvertToType
newObj.ConvertFromType = Me.ConvertFromType
Set Copy = newObj
Set newObj = Nothing
Exit Function
eHandler:
LogError "CCmdConvertData", "Copy", Error(Err), False
End Function
Public Function GetSpecificDescription() As String
Dim x As String
x = "Convert from " & GOutputID.GetRSTDescription(Me.ConvertFromType)
x = x & " to " & GOutputID.GetRSTDescription(Me.ConvertToType)
GetSpecificDescription = x
End Function
Public Function GetApplications() As eCmdApplications
GetApplications = GCmdHelper.CMDGetApplications(CmdType())
End Function
Public Function EditProperties(NameForCaption As String, Optional ByRef Import As CImport = Nothing) As Integer
Dim tImport As CImport
Set tImport = Import
If tImport Is Nothing Then Set tImport = GImport
frmCMDConvertDataProperties.Initialize Me, NameForCaption
frmCMDConvertDataProperties.Show vbModal
EditProperties = vbOK
End Function
Public Function CmdType() As Integer
CmdType = eCmdTypes.cmdConvertData
End Function
Public Property Let ConvertToType(newType As Integer)
mConvertToType = newType
End Property
Public Property Get ConvertToType() As Integer
ConvertToType = mConvertToType
End Property
Public Property Let ConvertFromType(newType As Integer)
mConvertFromType = newType
End Property
Public Property Get ConvertFromType() As Integer
ConvertFromType = mConvertFromType
End Property
Public Property Let index(ByVal vData As Integer)
mIndex = vData
End Property
Public Property Get index() As Integer
index = mIndex
End Property
Public Function Execute(ByRef value As Variant, Optional ByVal CnvType As Integer = -1) As Boolean
On Error GoTo eHandler
Execute = False
CnvType = GOutputID.ConvertDBTypeToRST(CnvType)
Select Case CnvType 'mConvertToType
Case rdtReducedDataTypeSet.rdtNull
value = Null
Case rdtReducedDataTypeSet.rdtInteger
value = CLng(value) ' int sucks.
Case rdtReducedDataTypeSet.rdtLong
value = CLng(value)
Case rdtReducedDataTypeSet.rdtSingle
value = CSng(value)
Case rdtReducedDataTypeSet.rdtDouble
value = CDbl(value)
Case rdtReducedDataTypeSet.rdtCurrency
value = CCur(value)
Case rdtReducedDataTypeSet.rdtDate
value = CDate(value)
Case rdtReducedDataTypeSet.rdtString
value = CStr(value)
Case rdtReducedDataTypeSet.rdtBool
value = CBool(value)
Case rdtReducedDataTypeSet.rdtVariant
value = CVar(value)
Case rdtReducedDataTypeSet.rdtDecimal
value = CDec(value)
Case rdtReducedDataTypeSet.rdtByte
value = CByte(value)
Case Else
LogError "CCmdConvertData", "Execute", _
"Trying to convert to an unknown data type"
Exit Function
End Select
Execute = True
Exit Function
eHandler:
LogError "CCmdConvertData", "Execute", Error(Err)
'
End Function
Public Function Load(arc As CArchive) As Boolean
On Error GoTo eHandler
Load = False
Dim item As String, value As Variant, retVal As Integer
'***************************************
' Get the next line from the input file.
'***************************************
Do
retVal = arc.GetNextItem(item, value)
' Error, log it, then exit with error.
If retVal = ArcRetType.cERROR Then
arc.AddError
GoTo done
' We are done with this object, leave.
ElseIf retVal = ArcRetType.cENDITEM Then
Exit Do
End If
Select Case item
Case "INDEX"
mIndex = value
Case "CONVERTFROM"
mConvertFromType = value
Case "CONVERTTO"
mConvertToType = value
Case Else
arc.AddError
End Select
Loop While True
Load = True
done:
Exit Function
eHandler:
LogError "CCmdConvertData", "Load", Error(Err)
Exit Function
End Function
Public Function Save(arc As CArchive) As Boolean
On Error GoTo eHandler
Save = False
arc.SaveItem aiBEGINACTION, GCmdHelper.GetName(CmdType())
arc.SaveItem aiVALUE, "INDEX", mIndex
arc.SaveItem aiVALUE, "CONVERTFROM", mConvertFromType
arc.SaveItem aiVALUE, "CONVERTTO", mConvertToType
arc.SaveItem aiENDITEM, GCmdHelper.GetName(CmdType())
Save = True
Exit Function
eHandler:
LogError "CCmdConvertData", "Save", Error(Err)
Exit Function
End Function
Private Sub Class_Initialize()
mUniqueID = GetUniqueID
mConvertFromType = -1 'adodb.adChar
mConvertToType = -1 'adodb.adChar
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -