کلاس استفاده از SQL SERVER تو ویژوال فاکس پرو

[farhad_shiri_ex]

دوستان هرکسی تو هر بخشش اشکالی داشت یا کدها نامفهوم بود بگید توضیح بدم الان نمیگم برای اینکه نمیدونم برای کسی مفید هست یا نه به هر حال سالها تجربه برنامه نویسی تو این کدها نهفته است.
امیدوارم بدردتون بخوره.!


Public MainDataServer,MainDataSource,APP_DALayer,WaitStri ngMSg,DAL,WaitStringMSginsupd,oEconect,activedataf ormCheked;
,TarGetDataBaseName,SourceDataBaseName,IsoTempPath ,m.DefualtDb,m.CurrentDb
MainDataServer=[use Production]
MainDataSource=[use inv1394]
TarGetDataBaseName=[Production]
SourceDataBaseName=[inv1394]
IsoTempPath=[\\IP or DNS\hoa\transfertosql\transferd\]
m.DefualtDb=''
m.CurrentDb=_SAL
APP_DALayer= [sqlmgnt.vcx]
STORE .F. TO activedataformCheked
WaitStringMSg='...!در حال خواندن اطلاعات از سرور'
WaitStringMSginsupd='...!در حال به روز رساني اطلاعات'
Set Classlib To sqlmgnt.vcx Additive
DAL = Newobject("DALAYER",APP_DALayer)
If !DAL.SqlServerCheck()
=alert([!.رقرار نيست Sql Server ارتباط با])
Thisform.Release
Return .F.
Endif

PROCEDURE SqlServerCheck
PARAMETERS otherdatabasevisible AS boolean
#DEFINE mb_okbutton 0
#DEFINE mb_stopsign 16
SuccRet=.T.
WITH THIS
IF TYPE('oEconect')!='U'
=SQLIDLEDISCONNECT(oeconect)
ENDIF
RELEASE oeconect
PUBLIC oeconect
IF .not. PEMSTATUS(_SCREEN,[lCconstr],5)
IF FILE([CSQLMNGT.SSL])
SET CLASSLIB TO _encdeccryptor.vcx ADDITIVE
_decryptor=CREATEOBJECT([_encdecryptor])
_ls=_decryptor.decryptor()
IF FILE([CSQLMNGT.SSL]) AND _ls
RESTORE FROM csqlmngt.ssl ADDITIVE
_ls=_decryptor.encryptor()
RELEASE _decryptor
IF !otherdatabasevisible
IF type([m.ChangedDB])<>[L]
MainDataServer =iif(m.activedataformCheked,MainDataSource,alltrim (csetdatabasestr))
ENDIF
ENDIF
.lcconstr=csetconnectstr
_SCREEN.ADDPROPERTY([lCconstr],.lcconstr)
_screen.AddProperty([LCDataRep],alltrim(csetdatabasestr))
ELSE
MESSAGEBOX([CS is not Work!]+CHR(13)+[1-Copy File 'csqlmngt.ssl' from Servername\Hoa\inv-win\update-exe Folder]+CHR(13);
+[2-if not found file 'csqlmngt.ssl' Run Setting.exe]+CHR(13);
+[3-Please Contact by System Administrator],0+16+0,'System Error')
CLEAR EVENTS
CLOSE ALL
CLEAR ALL
QUIT
ENDIF
ELSE
MESSAGEBOX([CS is not Work!]+CHR(13)+[1-Copy File 'csqlmngt.ssl' from Servername\Hoa\inv-win\update-exe Folder]+CHR(13);
+[2-if not found file 'csqlmngt.ssl' Run Setting.exe]+CHR(13);
+[3-Please Contact by System Administrator],0+16+0,'System Error')
CLEAR EVENTS
CLOSE ALL
CLEAR ALL
QUIT
ENDIF
ELSE
IF !otherdatabasevisible
IF type([m.ChangedDB])<>[L]
maindataserver =iif(m.activedataformCheked,MainDataSource,iif(typ e([csetdatabasestr])=[U],_screen.LCDataRep,csetdatabasestr))
ENDIF
ENDIF
.lcconstr=_SCREEN.lCconstr
ENDIF
oeconect = SQLSTRINGCONNECT(.lcconstr)
IF oeconect <= 0
LOCAL ARRAY laerror[1]
AERROR(laerror)
MESSAGEBOX(laerror[2],mb_okbutton+mb_stopsign,[SQL Server Error:]+TRANSFORM(laerror[5]))
SuccRet=.F.
ENDIF
.evaloeconect = oeconect
SuccRet=.sqlsetpropvalue(oeconect)
ENDWITH
RETURN SuccRet


فایل CSQLMNGT.SSL حاوی کانکشن استرینگ هست کافی این فایل کنار کلاس ها و فایل اجرایی ایجاد کنید با ساختار زیر ...


Driver=SQL Server;Server=SQLSRV\INVENTORYSQLSRV;UID=**;PWD=** ;Initial Catalog=Production;Data Source=SQLSRV\INVENTORYSQLSRV;

این کلاس هم می تونید تو شاخه نصبی ویژوال فاکس پیدا کنید _encdeccryptor.vcx

[farhad_shiri_ex]

متد 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_

[farhad_shiri_ex]

میخواهید یک فایل dbf رو به پایگاه داده تون اضافه کنید و این فایل تبدیل به یک جدول تو پایگاه داده بشه از متد زیر استفاده کنید (CopyTableIntoSqlServer)


************************************************** ********
**\\ Method Name:Copy native Table to Sql Server Database*
**\\ By: Farhad shiri 2012-2014 *
************************************************** ********
PARAMETERS selfield AS CHARACTER ;
,targetdatabasename AS CHARACTER ;
,sourcedatabasename AS CHARACTER ;
,sourcetable AS CHARACTER ;
,temptable AS CHARACTER ;
,datasourcebind AS logical;
,CheckProject as Logical

PRIVATE genscript1,genscript2,succsesscopy,usetargetdata,u sesourcedata,skiplist,skiplistfield,stropendatasou rce
STORE .T. TO succsesscopy
STORE '' TO genscript1,genscript2
skiplist=[;systranschemas;]
skiplistfield =[,DESC,DATE,RESERVED,PRINT,ID,VIEW,BY,DEFAULT,CURRE NT,KEY,ORDER,CHECK,FROM,TO,GROUP,INDEX,VIEWNAME,DA TANAME,NOTAFIELD,DATAFIELD,DATALTAG,DATAFTAG,DATAT YPE,DATASPEC,DATALEN,HEAD,PICTURE,READONLY,BFORCEV AL,BOUNDARY,WHEN,VALID,FORCEVAL,COLWIDTH,ERROR,LEV EL,]
stropendatasource=''
WITH THIS
IF TYPE('oEconect')='U'
PUBLIC oeconect
oeconect =.evaloeconect
ELSE
IF oeconect=0 OR oeconect<0 OR !m.activedataformcheked
.sqlservercheck()
ENDIF
ENDIF
************************************************** *********
**\\Step 0 - if Source Table in Visual Foxpro Stack Memory OR in Native Dbf
IF !EMPTY(sourcetable) AND !EMPTY(temptable)
usetargetdata=[use ]+targetdatabasename
reqdataused = SQLEXEC(oeconect,usetargetdata)
IF reqdataused>0
**\\Step 1 - If table exist in database drop it by this script
***\\if checkproject para is set .F. or empty Program Runing Inventory or other INVAcc
IF empty(CheckProject) AND !CheckProject
=SQLTABLES(oeconect,[TABLE],[TableUsed])
SELECT * FROM tableused WHERE UPPER(ALLTRIM(table_name))==UPPER(ALLTRIM(temptabl e))
IF _TALLY>0
dropscript=[drop table ]+upper(temptable)
osqlexq= SQLEXEC(oeconect,dropscript)
IF osqlexq<0
=alert([!ÈÇä˜ ãæÞÊ ÍÐÝ äÔÏ])
RETURN .F.
ENDIF
ENDIF
USE IN tableused
ENDIF
**\\End step 1
**\\Step 2 - Genarte Script Copy table in database sql server
**\\if datasourcebind is .F. source table in databas sql server exist
**\\if datasourcebind is .T. sourcetable is noting exist database sql server
**\\in DataSource in vfp OLEDB MicroSoft ODBC Driver Method Server
IF EMPTY(datasourcebind) AND !datasourcebind
genscript1=selfield+[ into ]+targetdatabasename+[.dbo.]+sourcetable+[;]+targetdatabasename+[.dbo.]+temptable+[;;;;]
ELSE
IF FILE(IsoTempPath+temptable+[.dbf])
stropendatasource=[opendatasource('VFPOLEDB','Data Source="]+IsoTempPath+["')...]+temptable
ELSE
=alert([!.ÝÇíá ÈÑ Ñæí ÓÑæÑ ÇíÌÇÏ äÔÏå ÇÓÊ])
RETURN .F.
ENDIF
genscript2=[select ]+selfield+[ into ]+targetdatabasename+[.dbo.]+sourcetable+[ from ]+stropendatasource
ENDIF
**\\End step 2
**\\Step 3 - Send Script to Data access Layer in SqlManagment Class Lib.
DO CASE
CASE !empty(genscript1)
Cond_=[!.GETDATA(genscript1,'Notemp',.T.,.F.,.F.,.T.)]
CASE !empty(genscript2)
Cond_=[SQLEXEC(oeconect,genscript2) < 0]
ENDCASE
IF &Cond_
RETURN .F.
ELSE
reqtable= SQLEXEC(oeconect,[select * from dbo.]+sourcetable+[ where 0 is null ],sourcetable)
IF reqtable>0
SELECT(sourcetable)
=AFIELDS(laflds)
IF UPPER(ALLTRIM(laflds(1,1))) $ [,]+skiplistfield+[,]
&&Reserved Var
ENDIF
jidx=0
cmd=[CREATE CLUSTERED INDEX ]+laflds(1,1)+[ ON ]+sourcetable+[(]+laflds(1,1)+[)] &&UNIQUE
lr = SQLEXEC( oeconect, cmd )
IF lr < 0
jidx=jidx+1
DIMENSION erridx[Jidx]
erridx[Jidx]=ALIAS()
cmd=[CREATE CLUSTERED INDEX ]+laflds(1,1)+[ ON ]+sourcetable+[(]+laflds(1,1)+[)]
lr = SQLEXEC( oeconect, cmd )
IF lr < 0
jidx=jidx+1
DIMENSION erridx[Jidx]
erridx[Jidx]=ALIAS()
ENDIF
ENDIF
ENDIF
**\\End step 3
ENDIF
ENDIF
RETURN .T.
ENDIF
************************************************** *******************
usetargetdata=[use ]+targetdatabasename
reqdataused = SQLEXEC(oeconect,usetargetdata)
usesourcedata=[use ]+sourcedatabasename
reqdataused = SQLEXEC(oeconect,usesourcedata)
=SQLTABLES(oeconect,[TABLE],[TableUsedTar])
IF reqdataused>0
IF USED([TableUsedTar])
SELECT tableusedtar
GO TOP
SCAN
IF LOWER(ALLTRIM(tableusedtar.table_name)) $ [;]+skiplist+[;]
LOOP && table in sys database
ENDIF
targettablename=ALLTRIM(tableusedtar.table_name)
sourcetablename=targettablename
SELECT * FROM tableusedtar WHERE UPPER(ALLTRIM(table_name))=UPPER(targettablename)
IF _TALLY>0
dropscript=[drop table ]+targetdatabasename+[.dbo.]+targettablename
TRY
= SQLEXEC(oeconect,dropscript)
CATCH TO osqlexq
IF osqlexq.ERRORNO>0
*!* Skip this line only Catch the error Sql Server
ENDIF
ENDTRY
ENDIF
*!*GenScript=[select ]+SelField+[ into ]+TargetDatabaseName+[.dbo.]+TargetTableName+[ from ]+SourceDatabaseName+[.dbo.]+SourceTableName
*!*ReqDataUsed = SQLEXEC(oEconect,GenScript)
genscript=selfield+[ into ]+targetdatabasename+[.dbo.]+targettablename+[;]+sourcedatabasename+[.dbo.]+sourcetablename+[;;;;]
IF !.GETDATA(genscript,'Notemp',.T.,.F.,.F.,.T.)
STORE .F. TO succsesscopy
EXIT
ELSE
reqdataused = SQLEXEC(oeconect,usetargetdata)
reqtable= SQLEXEC(oeconect,[select * from dbo.]+sourcetablename+[ where 0 is null ],sourcetablename)
IF reqtable>0
SELECT(sourcetablename)
=AFIELDS(laflds)
IF UPPER(ALLTRIM(laflds(1,1))) $ [,]+skiplistfield+[,]
LOOP &&Reserved Var
ENDIF
jidx=0
cmd=[CREATE CLUSTERED INDEX ]+laflds(1,1)+[ ON ]+sourcetablename+[(]+laflds(1,1)+[)] &&UNIQUE
lr = SQLEXEC( oeconect, cmd )
IF lr < 0
jidx=jidx+1
DIMENSION erridx[Jidx]
erridx[Jidx]=ALIAS()
cmd=[CREATE CLUSTERED INDEX ]+laflds(1,1)+[ ON ]+sourcetablename+[(]+laflds(1,1)+[)]
lr = SQLEXEC( oeconect, cmd )
IF lr < 0
jidx=jidx+1
DIMENSION erridx[Jidx]
erridx[Jidx]=ALIAS()
ENDIF
ENDIF
ENDIF
ENDIF
SELECT tableusedtar
ENDSCAN
ENDIF
ENDIF
ENDWITH
RETURN succsesscopy

اینم بگم با این متد میتونید هم یه کرسر تیبل رو تبدیل کنید هم یه فایل dbf

[farhad_shiri_ex]

یه نمونه استفاده از متد GETDATA


T_SqlStr=[*;fixpara;fixpara.type=03;;;]
If DAL.GetData(T_SqlStr,'fixpara')

ورودی اول متغیر T_sqlStr نام فیلدها
دومی نام جداول
سومی Where clause
چهارمی Group by
پنجمی Order by
و ورودی های متد GETDATA اولی اسکریپت Tsql و دومین پارامتر نام جدول مجازی(Cursor Table) وقتی اطلاعات دریافت شود با این کرسر به آنها دسترسی خواهید داشت.

[farhad_shiri_ex]

اگر استقبال بشه حتما ادامه خواهم داد...

[farhad_shiri_ex]

جناب حسن زاده عزیز آقا خوشحالم مبینم که هنوز توی این تالار فعالیت دارید
قبلا یادم میاد ازم خواسته بودید که با شما تو سایت شخصی خوب تون کمک تون کنم ولی متاسفانه بدلیل مشغله کاری تو اون برهه نمی تونستم ولی الان فکر کنم بتونم باشما همکاری داشته باشم برای ارسال مقاله خوشحال میشم اگر امکان اش هست به هم خبر بدید.
چون کلا خیلی وقت که با وی فاکس کار نمیکنم متاسفانه نه اینکه دوستش ندارم من عاشق وی فاکسم ولی همونطور که میدونید بازار کار برای آدم تعیین تکلیف میکنه و برای همین داشتم سورسهامو بایگانی میکردم این سورسها رو دیدم گفتم حداقل بذارم اینجا هم خودم یادم نره هم شاید بدرد کسی بخوره البته اینم بگم همین سورسها همین الان دارن تویک نرم افزار بزرگ برای یه شرکت بزرگ کار میکنن اینم گفتم بدونن دوستان که هنوز هم هستن جاهایی که دارن برنامه با وی فاکس از شرکتهای بزرگ دیگه هم میتونم به یه شرکت خدمات پس از فروش اشاره کنم که نرم افزار اصلی شون رو وی فاکس پس فکر کنم سورسها هنوز هم بدرد بخور باشن.

[farhad_shiri_ex]

متد InsertToSql


PROCEDURE INSERT
LPARAMETERS emaindata,efields,evalues,skipsqlchkeing
IF !skipsqlchkeing
IF TYPE('oEconect')='U'
PUBLIC oeconect
oeconect =THIS.evaloeconect
ELSE
IF oeconect=0 OR oeconect<0 OR !m.activedataformcheked
THIS.sqlservercheck()
ENDIF
ENDIF
ENDIF
WAIT WINDOW waitstringmsginsupd NOWAIT
*****
*!* 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

inscmdq = [Insert Into ]+emaindata+[ (]+efields+[) ]+[values ] +[ (]+evalues+[) ]

IF !THIS.TRANSACTION(oeconect)
RETURN .F.
ENDIF

xcatcherr=.F.
zcatcherr=.F.

DO WHILE !xcatcherr
eexecreq = SQLEXEC(oeconect,inscmdq)
*!* Cmtd by fshiri CATCH TO oException
*!* Cmtd by fshiri IF oException.ErrorNo>1
*!* Cmtd by fshiri this.errhandling(oException.ErrorNo,oException.Mes sage+'-'+oException.Procedure)
*!* Cmtd by fshiri CatchErr= this.ShowRetryMsg(oException.Message)
*!* Cmtd by fshiri IF CatchErr
*!* Cmtd by fshiri LOOP
*!* Cmtd by fshiri ELSE
*!* Cmtd by fshiri CatchErr=.T.
*!* Cmtd by fshiri EXIT
*!* Cmtd by fshiri ENDIF
*!* Cmtd by fshiri ENDIF
*!* Cmtd by fshiri FINALLY
IF eexecreq <= 0
catcherrx=THIS.showretrymsg('!.Çã˜Çä ÇíÌÇÏ ÇØáÇÚÇÊ æÌæÏ äÏÇÑÏ')
IF catcherrx
LOOP
ELSE
xcatcherr=.T.
zcatcherr=.F.
EXIT
ENDIF
ELSE
xcatcherr=.T.
zcatcherr=.T.
EXIT
ENDIF
ENDDO

*!* Cmtd by fshiri = SQLCOMMIT(oEconect)

IF eexecreq <= 0
execcmdq =[ROLLBACK TRANSACTION]
eexecreq = SQLEXEC(oeconect,execcmdq) && T-SQL Script
IF eexecreq <= 0
zcatcherr=.F.
ENDIF
ELSE
execcmdq =[COMMIT TRANSACTION]
eexecreq = SQLEXEC(oeconect,execcmdq) && T-SQL Script
IF eexecreq <= 0
zcatcherr=.F.
ENDIF
ENDIF

WAIT CLEAR
RETURN zcatcherr


برای اینکه درد سر نوشتن اسم فیلد و نام کنترل سورس گرفتن اطلاعات کنترل هم به حداقل برسونم یه فانکشن نوشتم که کارش اینه که ببینه تو فرمی که کنترلها رو کاربر اطلاعات شو زده به صورت دینامیک خودش مقادیر رو میخونه میده به متدها INSERT , UPDATE سعی میکنم بیشتر توضیح بدم.
در حقیقت اسکریپت های مورد نیاز رو برای دستورات insert , update میسازه.


*********************************************
*\ This Method Dynamic bind Memo Var Value
*\ By F.shiri 1387
*\ Para : Main View , Flag (Update Or Insert)
*\ ,uniqe field view
*********************************************
PROCEDURE sqlfieldstring
PARAMETERS MainTableSQL,FlagUpdIns,UniquField
PRIVATE FieldCnt,StrFiledName,StrFieldValue,StrRetVlaue,Re servedWords,StrFieldNameins
ReservedWords =[,DESC,DATE,RESERVED,PRINT,ID,VIEW,BY,DEFAULT,CURRE NT,KEY,ORDER,CHECK,FROM,TO,GROUP,INDEX,VIEWNAME,DA TANAME,NOTAFIELD,DATAFIELD,DATALTAG,DATAFTAG,DATAT YPE,DATASPEC,DATALEN,HEAD,PICTURE,READONLY,BFORCEV AL,BOUNDARY,WHEN,VALID,FORCEVAL,COLWIDTH,ERROR,LEV EL,]


STORE '' TO StrFiledName,StrFieldValue,StrFieldUpd,StrFieldNam eins
FieldCnt=FCOUNT(ALLTRIM(MainTableSQL))
DIMENSION CFieldName[FieldCnt]
DIMENSION CFieldValue[FieldCnt]
RELEASE SmemValRem
PUBLIC SmemValRem
SET MULTILOCKS ON
=CURSORSETPROP("Buffering", 5, MainTableSQL )


FOR Cnt_=1 TO FieldCnt
DIMENSION SmemValRem[Cnt_]
IF TYPE([EVALUATE('m.'+allt(field(Cnt_,MainTableSQL)))])!='U'
CFieldName[Cnt_]=allt(field(Cnt_,MainTableSQL))
IF (OLDVAL(field(Cnt_,MainTableSQL),MainTableSQL)!=EV ALUATE('m.'+CFieldName[Cnt_])) OR (!FlagUpdIns)
StrFiledName=StrFiledName+IIF(EMPTY(StrFiledName), '',[,])+IIF([,]+CFieldName[Cnt_]+[,] $ ReservedWords,"["+CFieldName[Cnt_]+"]",CFieldName[Cnt_])
CFieldValue[Cnt_]=[?m.]+CFieldName[Cnt_]
StrFieldValue=StrFieldValue+IIF(EMPTY(StrFieldValu e),'',[,])+CFieldValue[Cnt_]
StrFieldUpd=StrFieldUpd+IIF(EMPTY(StrFieldUpd),'',[,])+IIF(FlagUpdIns,StrFiledName+[=]+CFieldValue[Cnt_],'')
StrFieldNameins=StrFieldNameins+IIF(EMPTY(StrField Nameins),'',[,])+StrFiledName
StrFiledName=''
SmemValRem[Cnt_]=[m.]+CFieldName[Cnt_]
ENDIF
ENDIF
ENDFOR


*!* Cmtd by fshiri StrRetVlaue=IIF(TYPE([UniquField])=[C],IIF([,]+UniquField+[,] $ ReservedWords,"["+UniquField+"]",UniquField)+[,],'')+StrFieldValueins+[|]+IIF(TYPE([UniquField])=[C],[=?m.]+UniquField+[,],'')+StrFieldValue
StrRetVlaue=StrFieldNameins+[|]+StrFieldValue
RETURN IIF(!FlagUpdIns,StrRetVlaue,StrFieldUpd)

این کد ها هم برای Transaction


PROCEDURE TRANSACTION
PARAMETERS oEconect

eExecReq = SQLEXEC(oEconect ,MainDataServer) && Call Main Database in Sql Server
IF eEXecReq <= 0
=alert([!.Çã˜Çä ÏÓÊÑÓí Èå ÏíÊÇÈíÓ ÇÕáí æÌæÏ äÏÇÑÏ])
RETURN .f.
ENDIF

*!*ExecCmdTran =[SET TRANSACTION ISOLATION LEVEL READ COMMITTED] && Row Level locking
ExecCmdTran =[SET TRANSACTION ISOLATION LEVEL SNAPSHOT] && No row Lock
eXecReq = SQLEXEC(oEconect,ExecCmdTran)
IF eEXecReq <= 0
RETURN .f.
ENDIF

ExecCmdTran =[BEGIN TRANSACTION] && T-SQL Script
eXecReq = SQLEXEC(oEconect,ExecCmdTran)

CatchErr=.t.
IF eXecReq <= 0
CatchErr=.f.
ENDIF
RELEASE ExecCmdTran
IF !CatchErr
=alert([!.Çã˜Çä ÇäÌÇã ÊÑǘäÔ æÌæÏ äÏÇÑÏ])
ENDIF
RETURN CatchErr

نحوه استفاده هم تو پست بعدی

[farhad_shiri_ex]

اینم نحوه استفاده اش
1- یه آبجکت می سازم از کلاس سرویس SqlServer که من اسمش گذاشتم sqlmgnt.vcx.


ooinsert = NEWOBJECT("DALAYER",'sqlmgnt.vcx')

2- میام متد دینامیک رو برای فرمم صدا میزنم برای استفاده از این متد اول باید کل کنتر لهایی که می خواهید اطلاعاتشو تو بانک ذخیره کنید به متغیر های حافظه ای که با .m شروع میشن باید Bindکنید یعنی تو خصیصه Control Source شی تون که مثلا تکست باکس هست نام متناظر فیلدی که توبانک تون تعریف کردید براش بنویسید یعنی
TetBox -> Name.ControlSource = m.name


روش اول استفاده
CfieldNa = sqlfieldstring('Table Name',!_isadding,.F.,'Where Clause if needed(Optional)')
روش دوم استفاده
CfieldNa = sqlfieldstring('Table Name',!_isadding)

3- حالا هم میام از متد Insert استفاده میکنم و اطلاعات را تو جدول سمت سرور مینویسم.


OoInsert.INSERT([Table Name],LEFT(CfieldNa,ATC([|],CfieldNa)-1),SUBSTR(CfieldNa,ATC([|],CfieldNa)+1,LEN(ALLT(CfieldNa))-ATC([|],CfieldNa))) &&New record

به همین راحتی یعنی اصلا کار ندارید که چه فیلدی دارید چه نوعی داره فقط نام جدول بهش میدید با پارامترهای بعدی که همیشه ثابت هست نیازی نیست توش تغییری بدید به نظر من که خیلی کار راه انداز کافی تو زمان طراحی فرم Design mode کنترل سورسهای آبجکتهای روی فرم با نام فیلد متناظر توی جدول سرور bind کنید بقیه کارهارو همین متدها براتون انجام میدن
اشکالی بود در خدمتم دوستان

[binyaz2003]

سلام و خیلی ممنون

منم خوشحالم فعالیت شما رو اینجا میبینم. براتون پیام میفرستم لطفا پیام هاتون رو چک کنید.


جناب حسن زاده عزیز آقا خوشحالم مبینم که هنوز توی این تالار فعالیت دارید
قبلا یادم میاد ازم خواسته بودید که با شما تو سایت شخصی خوب تون کمک تون کنم ولی متاسفانه بدلیل مشغله کاری تو اون برهه نمی تونستم ولی الان فکر کنم بتونم باشما همکاری داشته باشم برای ارسال مقاله خوشحال میشم اگر امکان اش هست به هم خبر بدید.
چون کلا خیلی وقت که با وی فاکس کار نمیکنم متاسفانه نه اینکه دوستش ندارم من عاشق وی فاکسم ولی همونطور که میدونید بازار کار برای آدم تعیین تکلیف میکنه و برای همین داشتم سورسهامو بایگانی میکردم این سورسها رو دیدم گفتم حداقل بذارم اینجا هم خودم یادم نره هم شاید بدرد کسی بخوره البته اینم بگم همین سورسها همین الان دارن تویک نرم افزار بزرگ برای یه شرکت بزرگ کار میکنن اینم گفتم بدونن دوستان که هنوز هم هستن جاهایی که دارن برنامه با وی فاکس از شرکتهای بزرگ دیگه هم میتونم به یه شرکت خدمات پس از فروش اشاره کنم که نرم افزار اصلی شون رو وی فاکس پس فکر کنم سورسها هنوز هم بدرد بخور باشن.

[farhad_shiri_ex]

سلام و خیلی ممنون

منم خوشحالم فعالیت شما رو اینجا میبینم. براتون پیام میفرستم لطفا پیام هاتون رو چک کنید.

آقا مخلصیم پیام دادم بهتون !

[mostafa_zamani]

سلام و احترام و تشکر
لطفا یک نونه سورس اون را بصورت zip یا هر طور که مدانید در اختارمون بگذارید.
با تشکر

[farhad_shiri_ex]

سلام و احترام و تشکر
لطفا یک نونه سورس اون را بصورت zip یا هر طور که مدانید در اختارمون بگذارید.
با تشکر

حتما ولی به علت مشغله زیاد حتما تو پیغام خصوصی باز هم یادآوری کنید که براتون آماده کنم