Mini Kabibi Habibi
�� VERSION = 3.00 )MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0
_qbf Pixels Class 4 Pixels
_container _qbf _data.h���M�( !Arial, 0, 9, 5, 15, 12, 32, 3, 0
_conflicts _data.h Pixels Class 10 _form
_conflicts
_conflicts lblConflicts _data.hJ _# ��� � � F: % x � � � U & G(� #)� T� � �-��
�� � � U THIS ENABLED THISFORM REFRESH Click, ��1 c Q � � 1 s ) � _qbf cmdClearFilter
commandbutton _base.vcx _commandbutton _qbf _base.vcx _offline
cmdExecuteQBF
commandbutton _qbf _data.h�^h E* !Arial, 0, 9, 5, 15, 12, 32, 3, 0
_data.h Class 2
_container _offline �PROCEDURE Option1.Click
THIS.Parent.Parent.GoOnline()
ENDPROC
PROCEDURE Option2.Click
THIS.Parent.Parent.GoOffline()
ENDPROC
_offline ogOffline custom dCaption = "Conflicts on row:"
Height = 17
Left = 8
Top = 17
Width = 158
Name = "lblConflicts"
label label 3PROCEDURE Click
THISFORM.NextConflict
ENDPROC
_conflicts ~PROCEDURE Click
*!* Clear the filter that was set
SET FILTER TO
GO TOP
THIS.enabled = .F.
THISFORM.Refresh
ENDPROC
_commandbutton
cmdQBFMode
commandbutton _base.vcx _commandbutton container 1 _data.h 1 �AutoSize = .F.
Top = 71
Left = 4
Height = 23
Width = 72
FontBold = .F.
FontName = "MS Sans Serif"
FontSize = 8
Caption = "\<Clear Filter"
Enabled = .F.
TabIndex = 25
Name = "cmdClearFilter"
�� b� % } � � � U � �� � � �
T� �� �� �� ���(�� � ���9 %�C�% THISFORM.Controls(nCnt).controlSourceb� U���F %�CC � � � � �
�( C� THISFORM.Controls(nCnt).valueb� U ���0 T� �CC � � � �
C � � � � � � � �� %�C� �
��� T� �� � AND � �� � � � �� �� T� � �-�� T� � � � �a�� %�C� �
��j� T� �CC� �굛�� � SET FILTER TO &cFilter
T� � �
� �a�� #)�
�� � � U CFILTER NCNT
CCONDITION THISFORM CONTROLCOUNT CONTROLS
CONTROLSOURCE THIS PARENT PARSECONDITION VALUE ENABLED
CMDQBFMODE CMDCLEARFILTER REFRESH Click, ��1 � � ��b�A A A A C � AQA �BR � 1 " ) �Top = 31
Left = 4
Height = 23
Width = 72
FontBold = .F.
FontName = "MS Sans Serif"
FontSize = 8
Caption = "\<Query"
Enabled = .F.
TabIndex = 24
Name = "cmdExecuteQBF"
�AutoSize = .F.
Top = 3
Left = 4
Height = 23
Width = 72
FontBold = .F.
FontName = "MS Sans Serif"
FontSize = 8
Caption = "\<Enter QBF"
TabIndex = 23
Name = "cmdQBFMode"
Zqbf_table Specifies the table to query against.
*parsecondition Filters based on query.
grid _execsp ��� i i �6 % �
� U w %�C� � � �
��& � F�� � � �� � ��� � T� � �-�� T� � � � �a�� T� � � � �-��
�� � � U THIS PARENT QBF_TABLE ENABLED
CMDEXECUTEQBF CMDCLEARFILTER THISFORM REFRESH Click, ��1 gA R R � BA� 1 � ) i �PROCEDURE Click
*!* In order to clear out all the controls with a controlSource,
*!* we need to start a transaction and append a record (then when
*!* we are done we'll rollback the transaction so the new record
*!* doesn't get added to the table
IF !EMPTY(THIS.Parent.QBF_table) THEN
SELECT (THIS.Parent.QBF_table)
ENDIF
BEGIN TRANSACTION
APPEND BLANK
THIS.Enabled = .F.
THIS.Parent.cmdExecuteQBF.Enabled = .T.
THIS.Parent.cmdClearFilter.enabled = .F.
THISFORM.Refresh
ENDPROC
VWidth = 80
Height = 97
BackStyle = 0
BorderWidth = 0
qbf_table =
Name = "_qbf"
_base.vcx container cmdSkip
commandbutton _base.vcx _commandbutton Label3 optiongroup optiongroup 1 XTop = 149
Left = 334
Height = 23
Width = 72
Caption = "\<Ignore"
Name = "cmdSkip"
_conflicts label label
_conflicts Label2 label _base.vcx _base.vcx _custom Class form �� � � �+ % U j d � U
�� � � U THISFORM NEXTCONFLICT Click, ��1 � 2 ( ) � VCaption = "New value"
Height = 15
Left = 8
Top = 108
Width = 84
Name = "Label3"
YCaption = "Current value"
Height = 15
Left = 8
Top = 88
Width = 96
Name = "Label2"
label
_conflicts )MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0
_cbodistinctvalues Pixels Class _combobox _cbodistinctvalues combobox _base.vcx UCaption = "Old value"
Height = 15
Left = 8
Top = 68
Width = 96
Name = "Label1"
Label1 label label 0PROCEDURE Click
THISFORM.release()
ENDPROC
_conflicts cmdClose
commandbutton _base.vcx +Height = 19
Width = 97
Name = "_execsp"
Pixels _data.h _grid �FontName = "MS Sans Serif"
FontSize = 8
Height = 23
Style = 2
Width = 175
display_column =
lookup_table =
return_column =
order_column =
Name = "_cbolookup"
_commandbutton _base.vcx combobox
_cbolookup _combobox Class Pixels _data.h ;�� " " �; % � � � � U ��C� � � � �� U THIS PARENT GOONLINE ��C� � � � �� U THIS PARENT GOOFFLINE
Option1.Click, ��
Option2.Click^ ��1 12 11 6 Z x ) " AutoSize = .F.
ButtonCount = 2
BorderStyle = 0
Value = 1
Height = 62
Top = 3
Width = 122
Name = "ogOffline"
Option1.Picture = graphics\online.ico
Option1.Caption = "Online"
Option1.Value = 1
Option1.Height = 59
Option1.Left = 5
Option1.Style = 1
Option1.Top = 0
Option1.Width = 55
Option1.Name = "Option1"
Option2.Picture = graphics\offline.ico
Option2.Caption = "Offline"
Option2.Height = 59
Option2.Left = 64
Option2.Style = 1
Option2.Top = 0
Option2.Width = 55
Option2.Name = "Option2"
Ocdatabase Name of database containing views to take offline.
lrevertonfail Whether to revert all views if one fails when going offline.
lupdateviews Whether to update all views when going online.
lallviews Whether to automatically use all views in database.
lusecurrentdbc Whether to use currently opened database at start.
*gooffline Takes specified views offline.
*goonline Takes specified views online
*checkoffline Checks to see if views are currently online/offline.
*alert Displays messagebox dialog.
^aupdateerrors[1,0]
^cviews[1,0] Array of views to process.
*setviews
=�� $ $ ~@ % -
� z �
� U � �� � �, %�C� � �
� C� DATABASEv� � ��F � G(�� � �� � %�CC�� � ���� �3 ��C�# No views specified to take offline.� � �� B�-�� � �� ���(�C� � ����+ %�CC �
� � � � VIEW� OFFLINE��� � .� � %�CC �
� � � ��
����E ��C�' Failed to take following view offline: C �
� � � � � �� %�� � ���� �� ���(�� ����� ��CC �
� � � ��� �� T� � � ���� B�-�� � � ��5 ��C�% View were successfully taken offline.� � �� U I J THIS CDATABASE CVIEWS ALERT
LREVERTONFAIL OGOFFLINE VALUE�% �� � � ���� � � � � T� �-�� � � ���� T� � ����� ��, %�C� � �
� C� DATABASEv� � ��� � G(�� � �� � %�CC�� � ���� �3 ��C�# No views specified to take offline.� �
�� B� � T� �CW�� �� ���(�C� � ��_�, %�CC �
� � � � VIEW� OFFLINE�
��>� .� � %�� � ���� T� �CC �
� � � ��� %��
� ���� F�C �
� � � �� ��� F� � � Q��C �
� � � �� %�CC����9 ��C� Could not open following view: C �
� � � �x�� T� �a�� !� � T� �C�� �� Q�C �
� � � �� %��
�
���� ��C� � � �
��Q ��C�7 A record conflict occured during the update with view: C �
� � � �x�� T� �a�� !� � � T� �CC �
� � � ��� %��
� ��� Q�C �
� � � �� � %��
�
��[�6 ��C� Failed to take online view: C �
� � � �x�� T� �a�� !� � �� %��
� ���� T� � �
���� ���4 ��C�$ View were successfully taken online.� �
�� � F��
� �� U LUPDATESUCCESS LDROPSUCCESS
AUPDATEERRORS I LABORT LALREADYUSED NSAVEAREA THIS CDATABASE CVIEWS ALERT LUPDATEVIEWS OGOFFLINE VALUEK �� � �, %�C� � �
� C� DATABASEv� � ��F � G(�� � �� �" %�C� � ��
CC�� � � ��� � T� � � � �-�� T� � � � �-�� B� � T� � � � �a�� T� � � � �a�� �� ���(�C� � ��!�+ T� �CC �
� � � � VIEW� OFFLINE�� %��
�� � !� � ��# T� � � �C�
� � �� �6�� U
LOFFLINE I THIS CDATABASE CVIEWS OGOFFLINE OPTION1 ENABLED OPTION2 VALUE �� � R,�����
� �� U CMESSAGE� %�� � ��� � �� � �
� ����, %�C� � �
� C� DATABASEv� � ��c � G(�� � �� � T� �C�� � VIEW�� %�� � ��� � � � ���� ��C� � � �
�� � � U THIS LALLVIEWS ATMPVIEWS NTOTVIEWS CDATABASE CVIEWSW %�� � � C� � � ��6 � T� � �C� DATABASEv�� �
��C� � ��
��C� � �� U THIS LUSECURRENTDBC CDATABASE SETVIEWS CHECKOFFLINE gooffline, �� goonlineg �� checkoffline� �� alertr �� setviews� �� Init� ��1 � �� A b1q A ��A A �Q�aA 1q A A A R3 Q� a�� A b1A A � ��A A �� A� � A a� �� A A 1Q1� A A A �� AA a� A A A � 1� AA � 3 � �� A "BAA A BA��� A A A 23 q !2 � � �� A �1A A 3 ��A � � 2 s � � ! Q J
b d f
�
} g �
@ � t [ � � ) $ �PROCEDURE gooffline
LOCAL i,j
IF !EMPTY(THIS.cDatabase) AND (SET("DATABASE") # THIS.cDatabase)
SET DATABASE TO (THIS.cDatabase)
ENDIF
IF EMPTY(THIS.cViews[1])
THIS.Alert(C_NOVIEWS_LOC)
RETURN .F.
ENDIF
FOR i = 1 TO ALEN(THIS.cViews)
* Check if already offline
IF DBGETPROP(THIS.cViews[m.i],"VIEW","OFFLINE")
LOOP
ENDIF
IF !CREATEOFFLINE(THIS.cViews[m.i])
THIS.Alert(C_FAILOFFLINE_LOC+THIS.cViews[m.i])
IF THIS.lRevertOnFail
FOR j = 1 TO i-1
DROPOFFLINE(THIS.cViews[m.i])
ENDFOR
THIS.ogOffline.value = 1
RETURN .F.
ENDIF
ENDIF
ENDFOR
THIS.Alert(C_OKOFFLINE_LOC)
ENDPROC
PROCEDURE goonline
LOCAL lUpdateSuccess,lDropSuccess,aUpdateErrors[1],i,lAbort,lAlreadyUsed,nSaveArea
lAbort = .F.
DIMENSION THIS.aUpdateErrors[1]
THIS.aUpdateErrors[1] = 0
IF !EMPTY(THIS.cDatabase) AND (SET("DATABASE") # THIS.cDatabase)
SET DATABASE TO (THIS.cDatabase)
ENDIF
IF EMPTY(THIS.cViews[1])
THIS.Alert(C_NOVIEWS_LOC)
RETURN
ENDIF
nSaveArea = SELECT()
FOR i = 1 TO ALEN(THIS.cViews)
* Check if already online
IF !DBGETPROP(THIS.cViews[m.i],"VIEW","OFFLINE")
LOOP
ENDIF
IF THIS.lUpdateViews
lAlreadyUsed = USED(THIS.cViews[m.i])
IF m.lAlreadyUsed
SELECT (THIS.cViews[m.i])
ELSE
SELECT 0
ENDIF
USE (THIS.cViews[m.i]) ONLINE EXCLUSIVE
IF EMPTY(ALIAS())
* Failed to open exclusively
MESSAGEBOX(C_NOOPEN_LOC+THIS.cViews[m.i])
lAbort = .T.
EXIT
ENDIF
lUpdateSuccess = TableUpdate(2,aUpdateErrors)
USE IN (THIS.cViews[m.i])
IF !m.lUpdateSuccess
ACOPY(aUpdateErrors,THIS.aUpdateErrors)
MESSAGEBOX(C_RECORDCONLICT_LOC+THIS.cViews[m.i])
lAbort = .T.
EXIT
ENDIF
ENDIF
lDropSuccess = DROPOFFLINE(THIS.cViews[m.i])
IF m.lAlreadyUsed
USE (THIS.cViews[m.i])
ENDIF
IF !m.lDropSuccess
MESSAGEBOX(C_FAILONLINE_LOC+THIS.cViews[m.i])
lAbort = .T.
EXIT
ENDIF
ENDFOR
IF m.lAbort
THIS.ogOffline.value = 2
ELSE
THIS.Alert(C_OKONLINE_LOC)
ENDIF
SELECT (m.nSaveArea)
ENDPROC
PROCEDURE checkoffline
LOCAL lOffline,i
IF !EMPTY(THIS.cDatabase) AND (SET("DATABASE") # THIS.cDatabase)
SET DATABASE TO (THIS.cDatabase)
ENDIF
IF EMPTY(THIS.cDatabase) OR EMPTY(THIS.cViews[1])
*THIS.Alert(C_NODATABASE_LOC)
THIS.ogOffline.Option1.Enabled = .F.
THIS.ogOffline.Option2.Enabled = .F.
RETURN
ENDIF
THIS.ogOffline.Option1.Enabled = .T.
THIS.ogOffline.Option2.Enabled = .T.
FOR i = 1 TO ALEN(THIS.cViews)
lOffline = DBGETPROP(THIS.cViews[m.i],"VIEW","OFFLINE")
IF !lOffline
EXIT
ENDIF
ENDFOR
THIS.ogOffline.value = IIF(m.lOffline,2,1)
ENDPROC
PROCEDURE alert
LPARAMETER cMessage
WAIT WINDOW m.cMessage TIMEOUT 2
ENDPROC
PROCEDURE setviews
* Abstract class to setup THIS.cViews array and THIS.cDatabase (optional)
IF THIS.lAllViews
LOCAL aTmpViews,nTotViews
DIMENSION aTmpViews[1]
IF !EMPTY(THIS.cDatabase) AND (SET("DATABASE")#THIS.cDatabase)
SET DATABASE TO (THIS.cDatabase)
ENDIF
nTotViews = ADBOBJECT(aTmpViews,"VIEW")
IF nTotViews>0
DIMENSION THIS.cViews[1]
ACOPY(aTmpViews,THIS.cViews)
ENDIF
ENDIF
ENDPROC
PROCEDURE Init
IF THIS.lUseCurrentDBC AND EMPTY(THIS.cDatabase)
THIS.cDatabase = SET("DATABASE")
ENDIF
THIS.SetViews()
THIS.CheckOffline()
ENDPROC
_execsp _data.h.��M�( �� � � � % S h b � U
��C� � �� U THISFORM RELEASE Click, ��1 � 2 % ) � XTop = 149
Left = 406
Height = 23
Width = 72
Caption = "\<Close"
Name = "cmdClose"
��� � � �� % ! F 0 � U � %�C� � ���= �$ R,����� No cursor specified.�� B�-�� � �� � T� �C-��
��C� � ��= ��CC� � � �
Revert failed� � 1 row reverted6� � ��
��C� � �� U THISFORM CURSORALIAS LNROWS CHECKSOURCE ALERT NEXTCONFLICT Click, ��1 !Aq A r � � �� 2 @ ) �
_conflicts cmdRevert
commandbutton _base.vcx
_cbolookup
_conflicts )MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0
_data.h����U# KPROCEDURE Click
IF EMPTY(THISFORM.CursorAlias)
WAIT WINDOW CS_NOALIAS_LOC TIMEOUT 2
RETURN .F.
ENDIF
LOCAL lnRows
lnRows = TABLEREVERT(.F.)
THISFORM.CheckSource()
* no conflicts, no row or one row reverted
THISFORM.Alert( IIF(lnRows = 0,WAIT_REVERTFAIL_LOC,WAIT_REVERT1_LOC))
THISFORM.NextConflict()
ENDPROC
ZTop = 149
Left = 262
Height = 23
Width = 72
Caption = "\<Revert"
Name = "cmdRevert"
_base.vcx -PROCEDURE Click
LOCAL cFilter,nCnt,cCondition
cFilter = ""
*!* First, we need to walk all the controls on the form and find
*!* all controls with a controlSource and has a value in the value property.
FOR nCnt = 1 to THISFORM.ControlCount
IF TYPE('THISFORM.Controls(nCnt).controlSource') <> "U" THEN
IF !EMPTY(THISFORM.Controls(nCnt).ControlSource) AND ;
TYPE('THISFORM.Controls(nCnt).value') <> "U" THEN
*!* Now we need to parse the value property into a proper
*!* condition using the parseCondition method of the form
cCondition = THIS.Parent.parseCondition(THISFORM.Controls(nCnt).value,THISFORM.Controls(nCnt).controlSource)
*!* If there is a condition, add it to are overall filter
IF !EMPTY(cCondition) THEN
cFilter = cFilter + " AND " + cCondition
ENDIF
ENDIF
ENDIF
ENDFOR
*!* We need to rollback the transaction to discard the APPEND'ed record
ROLLBACK
THIS.Enabled = .F.
THIS.Parent.cmdQBFMode.Enabled = .T.
*!* This removes the " AND " keyword that is not needed for the
*!* first condition added to cFilter
IF !EMPTY(cFilter) THEN
cFilter = ALLTRIM(SUBSTRC(cFilter,5))
ENDIF
*!* Now we are ready to apply the filter
SET FILTER TO &cFilter
THIS.Parent.cmdClearFilter.enabled = .T.
GO TOP
THISFORM.Refresh
ENDPROC
_commandbutton �� � � TD % X � g � U � %�C� � ���= �$ R,����� No cursor specified.�� B�-�� � �� � T� �C-a��
��C� � �� %��
� ��� � ��C� Update succeded� � �� �� �: ��C�* Update failed, the primary key has changed� � �� �
�� � � U THISFORM CURSORALIAS LLUPDATE CHECKSOURCE ALERT NEXTCONFLICT Click, ��1 !Aq A r � � � �� �A � 2 � ) � �PROCEDURE Click
IF EMPTY(THISFORM.CursorAlias)
WAIT WINDOW CS_NOALIAS_LOC TIMEOUT 2
RETURN .F.
ENDIF
LOCAL llUpdate
* force-update current row
llUpdate = TABLEUPDATE(.F., .T.)
THISFORM.CheckSource()
* Display whether update was successful or failed (e.g., primary key changed)
IF m.llUpdate
THISFORM.Alert(WAIT_UPDATEOK_LOC)
ELSE
THISFORM.Alert(WAIT_UPDATEFAIL1_LOC)
ENDIF
THISFORM.NextConflict
ENDPROC
ZTop = 149
Left = 190
Height = 23
Width = 72
Caption = "\<Update"
Name = "cmdUpdate"
cmdUpdate
commandbutton _base.vcx _commandbutton �ColumnCount = -1
Height = 90
Highlight = .F.
HighlightRow = .F.
Left = 108
ReadOnly = .T.
RecordSource = ""
ScrollBars = 1
Top = 48
Visible = .F.
Width = 370
Name = "grdConflicts"
_conflicts grdConflicts _base.vcx �conflictalias
cursoralias Name of alias to check for conflicts.
lrowconflict
lautocheck Automatically check on startup.
*nextconflict
^aconflicts[1,0]
*checksource
*startcheck Checks for conflicts in buffered data of alias.
*alert
��� p
p
x� % � � o � � U K �� � �� � � � � � � %�C� � ���l �$ ��C� No cursor specified.� � ��
��C�
� �� B�-�� �
F�� � �� %�C�t� ��� � T� �CO�� � T� �C� Buffering�� %�� ����= ��C�- Data buffering must be on to check conflicts.� � ��
��C�
� �� B�-�� � %�� �
� � � ��M�
��C�
� �� B�-�� � T� �C�
SourceType� � �� %�� ����� T� �C� � � �� %�� � ���� #�� � ��� �� � �� T� �C����� %�C� 1C� >QC� _�� � T� �CO�� ��
T� �� �� � �4 T� � �
�� Conflicts on row: CC� �
� ZA�� %�� � ����O ��CC�
� � � � No conflicts found.� � No more conflicts found.6� � ��
��C�
� �� B�-�� �
F�� � �� #)�! ��
� ���(�C� � ���/�3 >�C �
� �� � ��CC �
� �� � � � �_�� �� %��
� ���[� ��C�� � � �� � H�! ��
� ���(�C� � �����3 >�C �
� �� � ��CC �
� �� � � � �� �� H�! ��
� ���(�C� � ���%�& T� �� � � .C �
� �� � �� >�C �
� �� � ��C� �� �� #)�
�� � � �
F�� � �� U
LNSTARTROW LNROW LCUSERFIELD LNBUFFERING NCURSORTYPE LNFIELDS I THIS CURSORALIAS ALERT THISFORM RELEASE LBLCONFLICTS CAPTION
CONFLICTALIAS
ACONFLICTS GRDCONFLICTS REFRESHP �� � %�CC�
� C� � � ��1 � T� � �C�� � %�C� � ���r �$ ��C� No cursor specified.� � �� B�-�� �
� ���� � � ���� ��C�� ��� ��C� � � �
�� F� � h��
_conflicts� � T� � �C�� � � � T� � � �� � �� T� � � �a�� %�C� � �
��:� T� � �a�� �I� B�-�� � U
ATMPCONFLICTS THIS CURSORALIAS ALERT
ACONFLICTS
_CONFLICTS
CONFLICTALIAS GRDCONFLICTS RECORDSOURCE VISIBLE NEXTCONFLICT THISFORM �� � R,�����
� �� U CMESSAGE
��C� � �� U THISFORM RELEASEb %�CC�
� C� � � ��* � T� � �C�� � %�� � ��[ � %�C� �
��W � B�-�� � � U THIS CURSORALIAS
LAUTOCHECK
STARTCHECKg %�C� � �
� C� � � ��0 �
F�� � �� Q� � %�C� � �
� C� � � ��` �
F�� � �� � U THISFORM
CONFLICTALIAS CURSORALIAS nextconflict, ��
startcheck8 �� alert �� QueryUnloadC �� Initj �� Release� ��1 q �"A� q A � � A ��� q A �� q A b1A � �� � � A A B�� q A � Q 1A 5QA B 1A C a�A R � � 3 q �� A "Aq A � � 1� q� S Q Q bC� � q A 3 q !3 � 2 �� A !q A A 2 �� A A �� A 2 � ? � Q
Y Y m
�
~ \ �
�
� ^ �
� � g � � � ) p
Vccursorname
hconnecthandle
csql
cspname
aparams
setsql
setparams
processerror
jdisplay_column Specifies the column from lookup_table to display in the drop down list.
lookup_table Specifies the table to lookup the values to display in the drop down.
return_column Specifies the column value to return the value property of the combo box.
order_column Specifies the column to order the records displayed in the drop down list (optional).
�Height = 183
Width = 490
DoCreate = .T.
AutoCenter = .T.
Caption = "Resolve Conflicts"
MaxButton = .F.
MinButton = .F.
WindowType = 1
AlwaysOnTop = .T.
conflictalias =
cursoralias =
lautocheck = .T.
Name = "_conflicts"
�Width = 119
Height = 64
BackStyle = 0
BorderWidth = 0
lrevertonfail = .T.
lupdateviews = .T.
lusecurrentdbc = .T.
Name = "_offline"
�ccursorname
hconnecthandle
csql
cspname
lusesqlsyntax Use SQL Server Exec syntax.
*dosql Runs SPT statement.
^aparams[1,0]
*setsql
*setparams
*processerror
*getsql Gets results from SPT statement.
aFontName = "MS Sans Serif"
FontSize = 8
Height = 23
Width = 175
Name = "_cbodistinctvalues"
�PROCEDURE Destroy
LOCAL cCursor
cCursor = "c" + THIS.name
IF USED(m.cCursor) THEN
USE IN &cCursor
ENDIF
ENDPROC
PROCEDURE Init
LOCAL cSQL, cAlias, cColumn
IF !EMPTY(THIS.controlSource) THEN
IF NOT "." $ THIS.controlSource THEN
=MESSAGEBOX(NO_TABLE_LOC)
ELSE
cAlias = LEFTC(THIS.controlSource,(ATC(".",THIS.controlSource)-1))
cColumn = RIGHTC(THIS.controlSource,(LENC(THIS.controlSource)-ATC(".",THIS.controlSource)))
IF INLIST(TYPE(m.cAlias+"."+m.cColumn),"D","T","M","G","L")
RETURN
ENDIF
THIS.rowSourceType = 3
cSQL = "SELECT DISTINCT " + m.cColumn + " FROM " + m.cAlias + ;
" INTO CURSOR c" + THIS.name
THIS.rowSource = m.cSQL
ENDIF
ENDIF
ENDPROC
)�� �� % w � � � U �� � � �� � � %�C�
cConditionb� C��C � T� �C� ��� � T� �C� C� .� ��� %�C� �
���� %�C�
cConditionb� CM��1�� %�� <� �
� ==� � � LIKE� �
� <>� �
� !=� � � #� � � =� �
� >=� �
� <=� � � >� ��-� T� �� � �� � � %�C� �����
H�Q��� �C� b� CM����$ T� �� � = C�" � C�" �� �C� b� DT���� T� �� � = {C� *� }�� 2��� T� �� � = C� Z�� � � ���
T� �� �� � B�� �� U
CCONDITION CCONTROLSOURCE LCRETCONDITION LCFIELDNAME parsecondition, ��1 � � �� A ��zA A � � QAQ� �A A � � A � 1 ) �� � � O� % � , / � U A �� � T� �� � �� %�C�
� ���: � USE IN &cAlias
� U CALIAS THIS NAME� �� � � �
H� ��� �� ���� �� ��C� An invalid display column or return column has been specified in the 'display_column' or 'return_column' properties (combo box � � � ).�0�x�� �� ���F�k ��C�O An invalid column has been specified in the 'order_column' property (combo box � � � ).�0�x�� �� �
����~ ��C�b An invalid table has been specified in the 'display_column' or 'lookup_table' property (combo box � � � ).�0�x�� 2��� ��CCE�0�x�� � U NERROR CMETHOD NLINE THIS NAME� �� � � T� �a��
H�# ��� �C� � ���� �g ��C�K A lookup table must be specified in the 'lookup_table' property (combo box � � � ).�0�x�� T� �-�� �C� � ���/�k ��C�O A display column must be specified in the 'display_column' property (combo box � � � ).�0�x�� T� �-�� �C� � �����i ��C�M A return column must be specified in the 'return_column' property (combo box � � � ).�0�x�� T� �-�� �
%�� ���� %�C� � �
��>�e T� �� SELECT � � � ,� � � FROM � � �
ORDER BY � � �
INTO CURSOR � � �� ���P T� �� SELECT � � � ,� � � FROM � � �
INTO CURSOR � � �� � T� � ���� T� � �� �� T� �
���� �
�� � � U LOK NSQL THIS LOOKUP_TABLE NAME DISPLAY_COLUMN
RETURN_COLUMN ORDER_COLUMN
ROWSOURCETYPE ROWSOURCE BOUNDCOLUMN REFRESH Destroy, �� Error� �� Init� ��1 q !A 3 � � !� !�!�� � A 3 � � � !q� !�� !�� A � 1Q� A A � 1 g � W
r c ) � nPROCEDURE Destroy
LOCAL cAlias
cAlias = THIS.name
IF USED(m.cAlias) THEN
USE IN &cAlias
ENDIF
ENDPROC
PROCEDURE Error
LPARAMETERS nError, cMethod, nLine
#DEFINE INVALID_COLUMN_LOC "An invalid display column or return column has been specified in the 'display_column' or 'return_column' properties (combo box " + THIS.name + ")."
#DEFINE INVALID_TABLE_LOC "An invalid table has been specified in the 'display_column' or 'lookup_table' property (combo box " + THIS.name + ")."
#DEFINE INVALID_SORT_LOC "An invalid column has been specified in the 'order_column' property (combo box " + THIS.name + ")."
DO CASE
CASE nError = 1806
=MESSAGEBOX(INVALID_COLUMN_LOC,48)
CASE nError = 1808
=MESSAGEBOX(INVALID_SORT_LOC,48)
CASE nError = 1802
=MESSAGEBOX(INVALID_TABLE_LOC,48)
OTHERWISE
=MESSAGEBOX(MESSAGE(),48)
ENDCASE
ENDPROC
PROCEDURE Init
LOCAL lOK, nSQL
lOK = .T.
DO CASE
CASE EMPTY(THIS.lookup_table)
=MESSAGEBOX(NO_LOOKUP_TABLE_LOC,48)
lOK = .F.
CASE EMPTY(THIS.display_column)
=MESSAGEBOX(NO_DISPLAY_COLUMN_LOC,48)
lOK = .F.
CASE EMPTY(THIS.return_column)
=MESSAGEBOX(NO_RETURN_COLUMN_LOC,48)
lOK = .F.
ENDCASE
IF lOK THEN
IF !EMPTY(THIS.order_column)
nSQL = "SELECT " + THIS.display_column + "," + THIS.return_column + " FROM " + THIS.lookup_table + " ORDER BY " + THIS.order_column + " INTO CURSOR " + THIS.name
ELSE
nSQL = "SELECT " + THIS.display_column + "," + THIS.return_column + " FROM " + THIS.lookup_table + " INTO CURSOR " + THIS.name
ENDIF
THIS.RowSourceType = 3
THIS.RowSource = nSQL
THIS.BoundColumn = 2
ENDIF
THIS.Refresh
ENDPROC
�PROCEDURE nextconflict
LPARAMETERS lnStartRow
LOCAL lnRow, lcUserField, lnBuffering, nCursorType, lnFields, i
IF EMPTY(THIS.CursorAlias)
THIS.Alert(CS_NOALIAS_LOC)
THISFORM.release()
RETURN .F.
ENDIF
SELECT (THIS.CursorAlias)
* default start row is current row
IF PCOUNT() = 0
lnStartRow = RECNO()
ENDIF
* close form after single row conflicts
lnBuffering = CURSORGETPROP('Buffering')
IF lnBuffering = 1
THIS.Alert(CS_NOBUFFER_LOC)
THISFORM.release()
RETURN .F.
ENDIF
IF lnBuffering<4 AND lnStartRow#0
THISFORM.release()
RETURN .F.
ENDIF
nCursorType = CURSORGETPROP("SourceType",THIS.CursorAlias)
IF lnBuffering>3
* for table buffering move to next row
lnRow = GETNEXTMODIFIED(lnStartRow,THIS.CursorAlias)
IF lnRow # 0
GO lnRow IN (THIS.CursorAlias)
ENDIF
ELSE
* handle row buffering
lnFields = GETFLDSTATE(-1)
IF REPLICATE("1",LEN(lnFields))#TRANS(lnFields)
lnRow = RECNO()
ELSE
lnRow = 0
ENDIF
ENDIF
THIS.lblConflicts.caption = CS_ROWCONFLICT_LOC + LTRIM(STR(lnRow,10 , 0))
IF lnRow = 0
THIS.Alert(IIF(m.lnStartRow=0,CS_NOCONFLICTS1_LOC,CS_NOCONFLICTS_LOC))
THISFORM.Release()
RETURN .F.
ENDIF
* load original values
SELECT (THIS.ConflictAlias)
GO TOP
FOR m.i = 1 TO ALEN(THIS.aConflicts, 1)
REPLACE (THIS.aConflicts[m.i,1]) WITH OLDVAL(THIS.aConflicts[m.i,1], THIS.CursorAlias)
ENDFOR
* load current values
* add error code here
IF m.nCursorType # 3 && refresh if not a table
REFRESH(1, 0, THIS.CursorAlias)
ENDIF
SKIP
FOR m.i = 1 TO ALEN(THIS.aConflicts, 1)
REPLACE (THIS.aConflicts[m.i,1]) WITH CURVAL(THIS.aConflicts[m.i,1], THIS.CursorAlias)
ENDFOR
* load user values
SKIP
FOR m.i = 1 TO ALEN(THIS.aConflicts, 1)
lcUserField = THIS.CursorAlias + '.' + THIS.aConflicts[m.i,1]
REPLACE (THIS.aConflicts[m.i,1]) WITH EVALUATE(lcUserField)
ENDFOR
GO TOP
THIS.grdConflicts.Refresh
SELECT (THIS.CursorAlias)
ENDPROC
PROCEDURE startcheck
LOCAL aTmpConflicts
IF !EMPTY(ALIAS()) AND EMPTY(THIS.CursorAlias)
THIS.CursorAlias = ALIAS()
ENDIF
IF EMPTY(THIS.CursorAlias)
THIS.Alert(CS_NOALIAS_LOC)
RETURN .F.
ENDIF
DIMENSION aTmpConflicts[1]
DIMENSION THIS.aConflicts[1]
AFIELDS(aTmpConflicts)
ACOPY(aTmpConflicts,THIS.aConflicts)
SELECT 0
CREATE CURSOR _conflicts FROM ARRAY aTmpConflicts
THIS.ConflictAlias = ALIAS()
* append conflict records
APPEND BLANK
APPEND BLANK
APPEND BLANK
THIS.grdConflicts.RecordSource = THIS.ConflictAlias
THIS.grdConflicts.Visible = .T.
* move on first conflict
IF THIS.NextConflict(0)
THISFORM.Visible = .T.
ELSE
RETURN .F.
ENDIF
ENDPROC
PROCEDURE alert
LPARAMETERS cMessage
WAIT WINDOW m.cMessage TIMEOUT 2
ENDPROC
PROCEDURE QueryUnload
thisform.RELEASE()
ENDPROC
PROCEDURE Init
IF !EMPTY(ALIAS()) AND EMPTY(THIS.CursorAlias)
THIS.CursorAlias = ALIAS()
ENDIF
IF THIS.lAutoCheck
IF !THIS.StartCheck()
RETURN .F.
ENDIF
ENDIF
ENDPROC
PROCEDURE Release
IF !EMPTY(THISFORM.ConflictAlias) AND USED(THISFORM.ConflictAlias)
SELECT (THISFORM.ConflictAlias)
USE
ENDIF
IF !EMPTY(THISFORM.CursorAlias) AND USED(THISFORM.CursorAlias)
SELECT (THISFORM.CursorAlias)
ENDIF
ENDPROC
s�� Z Z e� % � � 2 ] � U H �� � T� �C� � � � � � �i�� %�� �
��A �
�� � � � U NERROR THIS HCONNECTHANDLE CSQL CCURSORNAME PROCESSERRORx %�� � ��9 �) T� � �� exec � � � C� � �� �q �0 T� � �� {call � � � (C� � � )}�� � U THIS
LUSESQLSYNTAX CSQL CSPNAME SETPARAMS� �� � �
T� �� �� �� ���(�C� � ��y � T� �� C � � � �� %�� C� � ���u � T� �� � ,�� � �� B�� �� U NARRAYCOUNT CPARMS THIS APARAMSE �� �
� ���� ��C�� �z�� T� �C��� �� ��C� �x�� U CMESSAGETEXT ASQLERROR B�� � �� U THIS CSQL" 4� � � � � %�C�t�
��i �> ��C�2 You must pass at least 3 parameters to this class.�x�� B�-�� � � � ���� ��C� � � �
�� %�C�
� �
��� � T� � ��
� �� � T� � ��
� �� %�C�t���� � T� � �� sqlresult�� �� T� � ��
� �� �
��C� � �� U CSPNAME HCONNECTHANDLE APARAMS CCURSORNAME THIS SETSQL dosql, �� setsql� �� setparamsb �� processerror �� getsqlu �� Init� ��1 q �� A 3 �� A 3 � � ��a!A A � 2 q � � A� 3 � 3 � 1�q A 1"!A "�� !A � 2 � � d
� ` � 0 % K F ) ) Z QPROCEDURE dosql
LOCAL nError
nError = SQLEXEC (this.hConnectHandle, this.cSQL, this.cCursorName)
IF nError < 0
this.ProcessError
ENDIF
ENDPROC
PROCEDURE setsql
IF THIS.lUseSQLSyntax
THIS.cSQL = "exec " + this.cSPName +" " +this.SetParams() &&SQL Server specific
ELSE
THIS.cSQL = "{call " + this.cSPName + "("+this.SetParams()+ ")}"
ENDIF
ENDPROC
PROCEDURE setparams
LOCAL nArrayCount,cParms
cParms=""
FOR nArrayCount = 1 TO ALEN (this.aParams)
cParms = cParms + this.aParams[nArrayCount]
IF nArrayCount <> ALEN (this.aParams)
cParms= cParms + ','
ENDIF
ENDFOR
RETURN cParms
ENDPROC
PROCEDURE processerror
LOCAL cMessageText
DIMENSION aSQLError[5]
=AERROR (aSQLError)
cMessageText = aSQLError[1,2]
=MESSAGEBOX (cMessageText)
ENDPROC
PROCEDURE getsql
RETURN this.cSQL
ENDPROC
PROCEDURE Init
* This class library is used for SQL Pass Thru and can allow you to execute stored procedures
* on your host database. For example, the sample belows shows how you might want to called a stored
* procedure called "UpdateAuthorName" on the database "pubs". The result set is returned to a cursor.
* Sample code
*!* sqldisconn(0)
*!* DIME aParams[3]
*!* aParams[1] = "'172-32-1176'"
*!* aParams[2] = "'S'"
*!* aParams[3] = "'E'"
*!* hConnect = SQLCONNECT ('pubs','sa','')
*!* set classlib to HOME()+"classes\utility.vcx"
*!* x=createobj('ExecSP', 'UpdateAuthorName', hConnect, @aParams)
*!* x.dosql()
PARAMETERS cSPName, hConnectHandle, aParams, cCursorName
IF PCOUNT() < 3
MESSAGEBOX(BADPARMS_LOC)
RETURN .F.
ENDIF
DIMENSION this.aParams[1]
ACOPY(aParams,this.aParams)
IF NOT EMPTY (m.cSPName)
this.cSPName = m.cSPName
ENDIF
this.hConnectHandle = m.hConnectHandle
IF PCOUNT() = 3
this.cCursorName = 'sqlresult'
ELSE
this.cCursorName = m.cCursorName
ENDIF
this.SetSQL()
ENDPROC
PROCEDURE parsecondition
LPARAMETERS cCondition, cControlSource
LOCAL lcRetCondition, lcFieldName
IF TYPE('cCondition') = 'C'
cCondition = ALLTRIM(cCondition)
ENDIF
lcFieldName = SUBSTRC(cControlSource,(RATC(".",cControlSource)+1))
*!* NOTE: If you add a checkbox, radio button, or command group to
*!* the form, this routine will need to be changed to handle that
*!* specific datatype.
IF !EMPTY(cCondition) THEN
*!* If the type is Character or Memo, check to see if the
*!* user has entered a complex condition (if so, take that
*!* condition literally without any manipulation
IF TYPE('cCondition')$ "CM"
IF ("<" $ cCondition OR ;
"==" $ cCondition OR ;
"LIKE" $ cCondition OR ;
"<>" $ cCondition OR ;
"!=" $ cCondition OR ;
"#" $ cCondition OR ;
"=" $ cCondition OR ;
">=" $ cCondition OR ;
"<=" $ cCondition OR ;
">" $ cCondition)
lcRetCondition = lcFieldName + cCondition
ENDIF
ENDIF
*!* If a complex condition wasn't found above (lcRetCondition will be empty)
*!* Then we need to create the WHERE condition ourselves
IF EMPTY(lcRetCondition)
*!* The RATC() Functions figure out the column to compare based on the
*!* controlSource of the control and any delimiters needed for the
*!* datatype are added around the values (not all conditions are
*!* assumed to be = when we construct them ourselves
DO CASE
CASE TYPE(cControlSource) $ "CM"
lcRetCondition = lcFieldName + " = " + CHR(34) + cCondition + CHR(34)
CASE TYPE(cControlSource) $ "DT"
lcRetCondition = lcFieldName + " = {" + DTOC(cCondition) + "}"
OTHERWISE
lcRetCondition = lcFieldName + " = " + STR(cCondition)
ENDCASE
ENDIF
ELSE
lcRetCondition = ""
ENDIF
RETURN lcRetCondition
ENDPROC
F�� - - x= % � � � � U G �� � T� �� c� � �� %�C�
� ���@ � USE IN &cCursor
� U CCURSOR THIS NAME� �� � � � %�C� � �
���� %�� .� �
��� �j ��C�^ The table alias must be specified in the controlSource property, in the format 'alias.column'.�x�� ���$ T� �C� � C� .� � ����* T� �C� � C� � �C� .� � ���2 %�CC�
� � .�
� b� D� T� M� G� L���.� B� � T� � ����L T� �� SELECT DISTINCT �
� � FROM �
� � INTO CURSOR c� � �� T� � ��
� �� � � U CSQL CALIAS CCOLUMN THIS
CONTROLSOURCE
ROWSOURCETYPE NAME ROWSOURCE Destroy, �� Init� ��1 q R1A 3 � 2a�� A�!A A �!A A 2 q � �
) -