1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
| Define Class CaGeneric As CursorAdapter
CompareMemo = .F.
FetchAsNeeded = .T.
FetchSize = 100
FetchMemo = .T.
BatchUpdateCount = 100
WhereType = 1
AllowSimultaneousFetch = .T.
MapVarchar = .T.
MapBinary = .T.
BufferModeOverride = 5
*!* * Nodata = .T.
Handle = 0
Procedure AutoOpen
If Not Pemstatus(This, '__VFPSetup', 5)
This.AddProperty('__VFPSetup', 1)
This.Init()
Endif
Endproc
Procedure Init(tcType,tcConnectionString)
Local llReturn
Do Case
Case Not Pemstatus(This, '__VFPSetup', 5)
This.AddProperty('__VFPSetup', 0)
Case This.__VFPSetup = 1
This.__VFPSetup = 2
Case This.__VFPSetup = 2
This.__VFPSetup = 0
Return
Endcase
Set Multilocks On
llReturn = DoDefault()
This.DataSourceType = m.tcType
Store This.DataSourceType To ;
this.InsertCmdDataSourceType, ;
this.UpdateCmdDataSourceType, ;
this.DeleteCmdDataSourceType
***<DataSource>
Do Case
Case Upper(This.DataSourceType) == "ODBC"
This.Handle = Sqlstringconnect(m.tcConnectionString)
Store This.Handle To ;
This.Datasource,;
This.InsertCmdDataSource,;
This.UpdateCmdDataSource,;
This.DeleteCmdDataSource
Case Upper(This.DataSourceType) == "ADO"
Local loConnDataSource
loConnDataSource = Createobject('ADODB.Connection')
***<DataSource>
loConnDataSource.ConnectionString = m.tcConnectionString
***</DataSource>
loConnDataSource.Open()
This.Datasource = Createobject('ADODB.RecordSet')
This.Datasource.CursorLocation = 3 && adUseClient
This.Datasource.LockType = 3 && adLockOptimistic
This.Datasource.ActiveConnection = loConnDataSource
*** End of Select connection code: DO NOT REMOVE
loCommand = Createobject('ADODB.Command')
loCommand.ActiveConnection = loConnDataSource
This.AddProperty('oCommand',loCommand)
This.UpdateCmdDataSource=loCommand
This.InsertCmdDataSource=loCommand
This.DeleteCmdDataSource=loCommand
Case Upper(This.DataSourceType)="NATIVE" && Not implemented
Case Upper(This.DataSourceType)="XML" && Not implemented
Endcase
***</DataSource>
If This.__VFPSetup = 1
This.__VFPSetup = 2
Endif
Return llReturn
Endproc
Procedure MakeUpdatable(tcTableName,tckeyField,tlDoNotIncludeKey)
This.Tables = m.tcTableName
This.KeyFieldList = m.tckeyField
Local ix, lnUpdateableFCount
lnUpdateableFCount = Fcount(This.Alias)-Iif(This.DataSourceType='ADO',1,0) && last one is ADOBOOKMARK
For ix = 1 To m.lnUpdateableFCount
If !m.tlDoNotIncludeKey Or !(Upper(Field(m.ix,This.Alias,0)) == Upper(m.tckeyField))
This.UpdatableFieldList = This.UpdatableFieldList + ;
IIF(Empty(This.UpdatableFieldList),'',',') + ;
FIELD(m.ix,This.Alias,0)
Endif
This.UpdateNameList = This.UpdateNameList + ;
IIF(Empty(This.UpdateNameList),'',',') + ;
TEXTMERGE('<<FIELD(m.ix,this.Alias,0)>> <<m.tcTableName>>.<<FIELD(m.ix,this.Alias,0)>>')
Endfor
Endproc
Procedure QueryFill()
Local llSuccess
If This.DataSourceType ="ADO"
llSuccess = This.CursorFill(.F.,.F.,0,This.oCommand)
Else
llSuccess = This.CursorFill(.F.)
Endif
If !m.llSuccess
Messagebox(This.GetErrorExplanation())
Endif
Return m.llSuccess
Endproc
Procedure GetErrorExplanation
Local lcError,ix
Local Array aWhy[1]
Aerror(aWhy)
lcError = ""
For ix = 1 To 7
lcError = m.lcError + Transform(aWhy[m.ix]) + Chr(13)
Endfor
Return m.lcError
Endproc
Enddefine |
