📄 basdata.bas
字号:
'-- Create Connection
If gbCreateConnection = True Then
If gbCommentCode = True Then strCode = strCode & " '-- Create ADODB Connection Object" & vbCrLf
strCode = strCode & " Dim " & gsConnectionObject & " as New ADODB.Connection" & vbCrLf & vbCrLf
End If
'-- Bind ConnectionString
If gbCreateConnectionString = True Then
If gbCommentCode = True Then strCode = strCode & " '-- Bind Connection String" & vbCrLf
strCode = strCode & " " & gsConnectionObject & ".ConnectionString = " & gsConnectionString & vbCrLf & vbCrLf
End If
'-- Create Command
If gbCreateCommand = True Then
If gbCommentCode = True Then strCode = strCode & " '-- Create ADODB Command Object" & vbCrLf
strCode = strCode & " Dim " & gsCommandObject & " as New ADODB.Command" & vbCrLf & vbCrLf
End If
'-- Set Command Properties
If gbCommentCode = True Then strCode = strCode & " '-- Set properties of Command Object" & vbCrLf
strCode = strCode & " With " & gsCommandObject & vbCrLf
strCode = strCode & " .ActiveConnection = " & gsConnectionObject & ".ConnectionString " & vbCrLf
strCode = strCode & " .CommandText = " & Chr(34) & gCurrentSproc & Chr(34) & vbCrLf
strCode = strCode & " .CommandType = " & IIf(gbConstants = True, "adCmdStoredProc", "4") & vbCrLf & vbCrLf
'-- Creat Command Parameters
If gbCommentCode = True Then strCode = strCode & " '-- Create ADODB Command Parameters" & vbCrLf
For i = 1 To lv.ListItems.Count
If lv.ListItems(i).Checked = True Then
Select Case Mid$(lv.ListItems(i).ListSubItems(2).Text, Len(lv.ListItems(i).ListSubItems(2).Text) - 1, 1)
Case 1 '-- Input Parameter
strCode = strCode & " .Parameters.Append " & gsCommandObject & ".CreateParameter(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ", " & Get_Parameter_Data(lv, i) & ", " & Get_Parameter_Type(lv, i)
If IsNumeric(lv.ListItems(i).ListSubItems(7).Text) Then
strCode = strCode & ", " & lv.ListItems(i).ListSubItems(7).Text
End If
strCode = strCode & ")" & vbCrLf
strParamCode = strParamCode & " .Parameters(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ") = '[ENTER VALUE]" & vbCrLf
Case 2 '-- Output Parameter
strCode = strCode & " .Parameters.Append " & gsCommandObject & ".CreateParameter(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ", " & Get_Parameter_Data(lv, i) & ", " & Get_Parameter_Type(lv, i) & ")" & vbCrLf
Case 3 '-- Unknown Parameter
strCode = strCode & " .Parameters.Append " & gsCommandObject & ".CreateParameter(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ", " & Get_Parameter_Data(lv, i) & ", " & Get_Parameter_Type(lv, i)
If IsNumeric(lv.ListItems(i).ListSubItems(7).Text) Then
strCode = strCode & ", " & lv.ListItems(i).ListSubItems(7).Text
End If
strCode = strCode & ")" & vbCrLf
strParamCode = strParamCode & " .Parameters(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ") = '[ENTER VALUE]" & vbCrLf
Case 4 '-- Return Parameter
strCode = strCode & " .Parameters.Append " & gsCommandObject & ".CreateParameter(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ", " & Get_Parameter_Data(lv, i) & ", " & Get_Parameter_Type(lv, i) & ")" & vbCrLf
End Select
End If
Next
strCode = strCode & vbCrLf
'-- Set Parameter Values
If strParamCode <> "" Then
If gbCommentCode = True Then strCode = strCode & " '-- Set Parameter Values" & vbCrLf
strCode = strCode & strParamCode
End If
strCode = strCode & " End With" & vbCrLf
strCode = strCode & vbCrLf
If gbCommentCode = True Then strCode = strCode & " '-- Run the stored procedure" & vbCrLf
'-- Run The Sproc
If gbCreateRecordset Then
strCode = strCode & " Dim " & gsRecordsetObject & " as Recordset" & vbCrLf
End If
If gbRecordsAffected = True Then
strCode = strCode & " Dim iRecordsEffected as Integer" & vbCrLf & vbCrLf
End If
If gbReturnRecordset Then
If gbRecordsAffected = True Then
strCode = strCode & " Set " & gsRecordsetObject & " = " & gsCommandObject & ".Execute(iRecordsEffected)" & vbCrLf & vbCrLf
End If
Else
If gbRecordsAffected = True Then
strCode = strCode & " " & gsCommandObject & ".Execute iRecordsEffected" & vbCrLf & vbCrLf
Else
strCode = strCode & " " & gsCommandObject & ".Execute " & vbCrLf & vbCrLf
End If
End If
If gbReturnRecordset Then
If gbCommentCode = True Then strCode = strCode & " '-- Loop through the recordset" & vbCrLf
If gbConstants = False Then
strCode = strCode & " While Not " & gsRecordsetObject & ".EOF Or Not " & gsRecordsetObject & ".State = 1 & vbCrLf"
Else
strCode = strCode & " While Not " & gsRecordsetObject & ".EOF Or Not " & gsRecordsetObject & ".State = adStateClosed" & vbCrLf
End If
strCode = strCode & vbclf & vbCrLf
strCode = strCode & " '[ADD CODE HERE]" & vbCrLf
strCode = strCode & vbclf & vbCrLf
strCode = strCode & " " & gsRecordsetObject & ".MoveNext" & vbCrLf
strCode = strCode & " Wend" & vbCrLf
strCode = strCode & vbCrLf
If gbConstants = False Then
strCode = strCode & " If " & gsCommandObject & ".State = 1 Then " & gsRecordsetObject & ".Close" & vbCrLf
Else
strCode = strCode & " If " & gsCommandObject & ".State = adStateOpen Then " & gsRecordsetObject & ".Close" & vbCrLf
End If
strCode = strCode & " Set " & gsRecordsetObject & " = Nothing" & vbCrLf
strCode = strCode & " Set " & gsCommandObject & " = Nothing" & vbCrLf
If gbConstants = True Then
strCode = strCode & " If " & gsConnectionObject & ".State = adStateOpen Then " & gsConnectionObject & ".Close" & vbCrLf
Else
strCode = strCode & " If " & gsConnectionObject & ".State = 1 Then " & gsConnectionObject & ".Close" & vbCrLf
End If
strCode = strCode & " Set " & gsConnectionObject & " = Nothing" & vbCrLf
End If
ElseIf cmd = cmd_asp Then
'-- ASP CODE
'-- Create Connection String
If gbCreateConnectionString = True Then
If gbCommentCode = True Then strCode = strCode & " '-- Create Connection String" & vbCrLf
strCode = strCode & " Dim " & gsConnectionString & vbCrLf
strCode = strCode & " " & gsConnectionString & " = " & Chr(34) & gSQLDriver & ";" & Chr(34) & " & _" & vbCrLf
strCode = strCode & " " & Chr(34) & "Server=" & gCurrentServer & ";" & Chr(34) & " & _" & vbCrLf
strCode = strCode & " " & Chr(34) & "Database=" & gCurrentDatabase & ";" & Chr(34) & " & _" & vbCrLf
strCode = strCode & " " & Chr(34) & "Uid=" & gCurrentUser & ";" & Chr(34) & " & _" & vbCrLf
strCode = strCode & " " & Chr(34) & "Pwd=" & gCurrentPassword & ";" & Chr(34) & vbCrLf & vbCrLf
End If
'-- Create Connection
If gbCreateConnection = True Then
If gbCommentCode = True Then strCode = strCode & " '-- Create ADODB Connection Object" & vbCrLf
strCode = strCode & " Dim " & gsConnectionObject & vbCrLf
strCode = strCode & " Set " & gsConnectionObject & " = Server.CreateObject(" & Chr(34) & "ADODB.Connection" & Chr(34) & ")" & vbCrLf & vbCrLf
End If
'-- Bind ConnectionString
If gbCreateConnectionString = True Then
If gbCommentCode = True Then strCode = strCode & " '-- Bind Connection String" & vbCrLf
strCode = strCode & " " & gsConnectionObject & ".ConnectionString = " & gsConnectionString & vbCrLf & vbCrLf
End If
'-- Create Command
If gbCreateCommand = True Then
If gbCommentCode = True Then strCode = strCode & " '-- Create ADODB Command Object" & vbCrLf
strCode = strCode & " Dim " & gsCommandObject & vbCrLf
strCode = strCode & " Set " & gsCommandObject & " = Server.CreateObject(" & Chr(34) & "ADODB.Command" & Chr(34) & ")" & vbCrLf & vbCrLf
End If
'-- Set Command Properties
If gbCommentCode = True Then strCode = strCode & " '-- Set properties of Command Object" & vbCrLf
strCode = strCode & " With " & gsCommandObject & vbCrLf
strCode = strCode & " .ActiveConnection = " & gsConnectionObject & ".ConnectionString " & vbCrLf
strCode = strCode & " .CommandText = " & Chr(34) & gCurrentSproc & Chr(34) & vbCrLf
strCode = strCode & " .CommandType = " & IIf(gbConstants = True, "adCmdStoredProc", "4") & vbCrLf & vbCrLf
'-- Creat Command Parameters
If gbCommentCode = True Then strCode = strCode & " '-- Create ADODB Command Parameters" & vbCrLf
For i = 1 To lv.ListItems.Count
If lv.ListItems(i).Checked = True Then
Select Case Mid$(lv.ListItems(i).ListSubItems(2).Text, Len(lv.ListItems(i).ListSubItems(2).Text) - 1, 1)
Case 1 '-- Input Parameter
strCode = strCode & " .Parameters.Append " & gsCommandObject & ".CreateParameter(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ", " & Get_Parameter_Data(lv, i) & ", " & Get_Parameter_Type(lv, i)
If IsNumeric(lv.ListItems(i).ListSubItems(7).Text) Then
strCode = strCode & ", " & lv.ListItems(i).ListSubItems(7).Text
End If
strCode = strCode & ")" & vbCrLf
strParamCode = strParamCode & " .Parameters(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ") = '[ENTER VALUE]" & vbCrLf
Case 2 '-- Output Parameter
strCode = strCode & " .Parameters.Append " & gsCommandObject & ".CreateParameter(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ", " & Get_Parameter_Data(lv, i) & ", " & Get_Parameter_Type(lv, i) & ")" & vbCrLf
Case 3 '-- Unknown Parameter
strCode = strCode & " .Parameters.Append " & gsCommandObject & ".CreateParameter(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ", " & Get_Parameter_Data(lv, i) & ", " & Get_Parameter_Type(lv, i)
If IsNumeric(lv.ListItems(i).ListSubItems(7).Text) Then
strCode = strCode & ", " & lv.ListItems(i).ListSubItems(7).Text
End If
strCode = strCode & ")" & vbCrLf
strParamCode = strParamCode & " .Parameters(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ") = '[ENTER VALUE]" & vbCrLf
Case 4 '-- Return Parameter
strCode = strCode & " .Parameters.Append " & gsCommandObject & ".CreateParameter(" & Chr(34) & lv.ListItems(i).Text & Chr(34) & ", " & Get_Parameter_Data(lv, i) & ", " & Get_Parameter_Type(lv, i) & ")" & vbCrLf
End Select
End If
Next
strCode = strCode & vbCrLf
'-- Set Parameter Values
If strParamCode <> "" Then
If gbCommentCode = True Then strCode = strCode & " '-- Set Parameter Values" & vbCrLf
strCode = strCode & strParamCode
End If
strCode = strCode & " End With" & vbCrLf
strCode = strCode & vbCrLf
If gbCommentCode = True Then strCode = strCode & " '-- Run the stored procedure" & vbCrLf
'-- Run The Sproc
If gbCreateRecordset Then
strCode = strCode & " Dim " & gsRecordsetObject & vbCrLf
End If
If gbRecordsAffected = True Then
strCode = strCode & " Dim iRecordsEffected" & vbCrLf & vbCrLf
End If
If gbReturnRecordset Then
If gbRecordsAffected = True Then
strCode = strCode & " Set " & gsRecordsetObject & " = " & gsCommandObject & ".Execute(iRecordsEffected)" & vbCrLf & vbCrLf
End If
Else
If gbRecordsAffected = True Then
strCode = strCode & " " & gsCommandObject & ".Execute iRecordsEffected" & vbCrLf & vbCrLf
Else
strCode = strCode & " " & gsCommandObject & ".Execute " & vbCrLf & vbCrLf
End If
End If
If gbReturnRecordset Then
If gbCommentCode = True Then strCode = strCode & " '-- Loop through the recordset" & vbCrLf
If gbConstants = False Then
strCode = strCode & " While Not " & gsRecordsetObject & ".EOF Or Not " & gsRecordsetObject & ".State = 1 & vbCrLf"
Else
strCode = strCode & " While Not " & gsRecordsetObject & ".EOF Or Not " & gsRecordsetObject & ".State = adStateClosed" & vbCrLf
End If
strCode = strCode & vbclf & vbCrLf
strCode = strCode & " '[ADD CODE HERE]" & vbCrLf
strCode = strCode & vbclf & vbCrLf
strCode = strCode & " " & gsRecordsetObject & ".MoveNext" & vbCrLf
strCode = strCode & " Wend" & vbCrLf
strCode = strCode & vbCrLf
If gbConstants = False Then
strCode = strCode & " If " & gsCommandObject & ".State = 1 Then " & gsRecordsetObject & ".Close" & vbCrLf
Else
strCode = strCode & " If " & gsCommandObject & ".State = adStateOpen Then " & gsRecordsetObject & ".Close" & vbCrLf
End If
strCode = strCode & " Set " & gsRecordsetObject & " = Nothing" & vbCrLf
strCode = strCode & " Set " & gsCommandObject & " = Nothing" & vbCrLf
If gbConstants = True Then
strCode = strCode & " If " & gsConnectionObject & ".State = adStateOpen Then " & gsConnectionObject & ".Close" & vbCrLf
Else
strCode = strCode & " If " & gsConnectionObject & ".State = 1 Then " & gsConnectionObject & ".Close" & vbCrLf
End If
strCode = strCode & " Set " & gsConnectionObject & " = Nothing" & vbCrLf
End If
End If
End Sub
Private Function Get_Parameter_Type(lv As ListView, Row As Integer)
Dim sText As String
sText = lv.ListItems(Row).ListSubItems(2).Text
If gbConstants = False Then
Get_Parameter_Type = Right(sText, Len(sText) - InStr(1, sText, "("))
Get_Parameter_Type = Left(Get_Parameter_Type, Len(Get_Parameter_Type) - 1)
Else
Get_Parameter_Type = Left(sText, InStr(1, sText, "(") - 1)
End If
End Function
Private Function Get_Parameter_Data(lv As ListView, Row As Integer)
Dim sText As String
sText = lv.ListItems(Row).ListSubItems(6).Text
If gbConstants = False Then
Get_Parameter_Data = Right(sText, Len(sText) - InStr(1, sText, "("))
Get_Parameter_Data = Left(Get_Parameter_Data, Len(Get_Parameter_Data) - 1)
Else
Get_Parameter_Data = Left(sText, InStr(1, sText, "(") - 1)
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -