متد GETDATA
این Property هارو تو کلاس تون تعریف کنید.!
lcConStr
EvaloEconect
decryptcs(Assign method)
affectedRec
LPARAMETERS eFormat,MainDATA,TableSql,BindedTag,_tag,NoSchemea
WITH this
IF TYPE('oEconect')='U'
PUBLIC oEconect
oEconect =.EvaloEconect
ELSE
IF oEconect=0 OR oEconect<0 OR !m.activedataformCheked
.SqlServerCheck()
ENDIF
ENDIF
ENDWITH
****************************
PUBLIC eExecReq,acount
PRIVATE SelField,Seltable,Selwhere,SelGroup,Selhaving,Selo rder
STORE '' TO SelField,Seltable,Selwhere,SelGroup,Selhaving,Selo rder
DIMENSION StrSel[6],acount[2]
StrSel[1]=[Seltable]
StrSel[2]=[Selwhere]
StrSel[3]=[SelGroup]
StrSel[4]=[Selhaving]
StrSel[5]=[Selorder]
StrSel[6]=[SelField]
WITH this
MacStr=StrSel(6)+[=]+["]+SUBSTR(eFormat,1,.SemiPos(eFormat,1)-1)+["]
&MacStr
OldPos_=0
FOR Io_=1 TO OCCURS(';',eFormat)
IF io_=5
EXIT
ENDIF
OldPos_=.SemiPos(eFormat,Io_)+1
MacStr=StrSel(Io_)+[=]+["]+SUBSTR(eFormat,.SemiPos(eFormat,Io_)+1,.SemiPos(e Format,Io_+1)-OldPos_)+["]
&MacStr
ENDFOR
MacStr=StrSel(5)+[=]+["]+SUBSTR(eFormat,.SemiPos(eFormat,5)+1,LEN(eFormat)-.SemiPos(eFormat,5))+["]
&MacStr
ENDWITH
IF OCCURS(',',Seltable)=>1
Selx=''
Seltable=[,]+Seltable+[,]
DIMENSION Selt(OCCURS(',',Seltable))
FOR Iz_=1 TO OCCURS(',',Seltable)
OldPos_=AT(',',Seltable,Iz_)+1
Selt(Iz_)=iif(empty(NoSchemea) or !NoSchemea,[dbo.],'')+SUBSTR(Seltable,AT(',',Seltable,Iz_)+1,AT(',' ,Seltable,Iz_+1)-OldPos_)
IF Iz_<OCCURS(',',Seltable)
Selx=Selx+IIF(!EMPTY(Selx),[,],[])+Selt(Iz_)
ENDIF
ENDFOR
Seltable=Selx
ELSE
Seltable=iif(empty(NoSchemea) or !NoSchemea,[dbo.],'')+Seltable
ENDIF
IF m.activedataformCheked &&From Data Menu
IF type([m.ChangedDB])=[L]
IF .not. m.ChangedDB
eExecReq = SQLEXEC(oEconect,MainDataSource) && Call Main Database in Sql Server
ELSE
eExecReq = SQLEXEC(oEconect,MainDataServer) && Call Main Database in Sql Server
ENDIF
ELSE
eExecReq = SQLEXEC(oEconect,MainDataSource) && Call Main Database in Sql Server
ENDIF
ELSE
eExecReq = SQLEXEC(oEconect,MainDataServer) && Call Main Database in Sql Server
ENDIF
IF eExecReq <= 0
RELEASE SelField,Seltable,Selwhere,SelGroup,Selhaving,Selo rder,StrSel
=alert([!.Çã˜Çä ÏÓÊÑÓí Èå ÏíÊÇÈíÓ ÇÕáí æÌæÏ äÏÇÑÏ])
RETURN .f.
ENDIF
ExecCmdQ = [Select ]+SelField;
+[ From ]+Seltable &&[ with (XLOCK,PAGLOCK)]
ExecCmdQ =IIF(!EMPTY(Selwhere),ExecCmdQ+[ where ]+Selwhere,ExecCmdQ)
ExecCmdQ =IIF(!EMPTY(SelGroup),ExecCmdQ+[ group by ]+SelGroup,ExecCmdQ)
ExecCmdQ =IIF(!EMPTY(Selhaving),ExecCmdQ+[ Having ]+Selhaving,ExecCmdQ)
ExecCmdQ =IIF(!EMPTY(Selorder),ExecCmdQ+[ order by ]+Selorder,ExecCmdQ)
IF TableSql
SQLEXEC(oEconect,'select COUNT(*) as CntRec from '+Seltable,'cntR')
SET CLASSLIB TO abc ADDITIVE
SqlProgbar= CREATEOBJECT('progprocfrm')
WITH SqlProgbar
IF USED('cntr')
.CntRec=cntR.CntRec
USE IN cntR
ELSE
.CntRec=0
ENDIF
.ParentTable=MainDATA
.CapTable=this.ShowCapTable(SUBSTR(Seltable,AT('.' ,Seltable)+1,LEN(ALLTRIM(Seltable))))
ENDWITH
ENDIF
CatchErr=.f.
=AERROR(aErrorArray)
DO WHILE !CatchErr
IF TableSql
RetSetSync=IIF(SQLSETPROP(oEconect, [Asynchronous], .T.)>0,.T.,.F.)
WITH SqlProgbar
.progOle.value=1
*.SqlTime.interval=60000
*.SqlTime.enabled=.T.
IF RetSetSync
.PubExecCmdQ=ExecCmdQ
.PubMainDATA=MainDATA
.show()
.release
ENDIF
RetSet=IIF(SQLSETPROP(oEconect, [Asynchronous], .F.)>0,.T.,.F.)
ENDWITH
ELSE
eExecReq = SQLEXEC(oEconect,ExecCmdQ,MainDATA,acount) && T-SQL Script
ENDIF
IF !TableSql
TRY
SELECT(MainDATA)
CATCH TO OnoData
IF OnoData.errorno>0
CatchErr=this.ShowRetryMsg('ÏÑíÇÝÊ ÇØáÇÚÇÊ ãÞÏæÑ äíÓÊ.!')
CatchErr=.T.
EXIT
ENDIF
ENDTRY
ENDIF
IF eExecReq <0
this.errhandling(aErrorArray(1),aErrorArray(2))
CatchErr=this.ShowRetryMsg('ÏÑíÇÝÊ ÇØáÇÚÇÊ ãÞÏæÑ äíÓÊ.!')
IF CatchErr
LOOP
ELSE
CatchErr=.T.
EXIT
ENDIF
ELSE
CatchErr=.T.
EXIT
ENDIF
ENDDO
IF BindedTag AND MainDATA#'SqlTmpTable'
DO CreatTag IN openfile WITH UPPER(MainDATA),_tag
ENDIF
WAIT CLEAR
RELEASE SelField,Seltable,Selwhere,SelGroup,Selhaving,Selo rder,StrSel
IF TYPE([acount])#[U]
IF eExecReq>0 AND acount(2)>0
this.affectedRec=acount(2)
ELSE
this.affectedRec=0
ENDIF
ENDIF
IF !TableSql
IF eExecReq>0
CatchErr=.T.
ELSE
CatchErr=.F.
ENDIF
ENDIF
RELEASE eExecReq
RETURN CatchErr
PROCEDURE SemiPos
PARAMETERS EString,Noccu
SimiPos_=AT(';',EString,Noccu)
RETURN SimiPos_
پاسخ با نقل قول