Joined: 27 Jun 2005 Posts: 1000 Location: Горбунов Константин Occupation: БЭСТ-Партнер Interests: СПб
Posted: 17 Sep 2007 18:18 Post subject:
15.
Code:
****************************************************************
* Открытие базы данных: *
* в распределенном режиме lExc := NIL or lExc := .F. *
* или *
* в монопольном режиме lExc := .T. *
* NetUse( cAlias,cFile,[cIndexes],[lExc],[cRdd] ) --> lSuccess *
****************************************************************
FUNCTION NetUse( cAlias,cFile,cIndexes, lExc, cRdd, lReadyOnly, lNew, lNoIndex )
LOCAL i, cDbfFile, cCdxFile,cDisk,;
lForever:=.F., nSeconds:=10, nCo, cParol := GetId()
Local uPath,uLoad,nArea:=SELECT()
cFile := ALLTRIM( cFile )
i := ATNUM( '.', cFile )
IF ValType( cRdd ) <> 'C' ; cRdd := NameRdd() ; ENDIF
IF VALTYPE( lNew ) <> 'L' ; lNew := .T. ; ENDIF
IF SELECT( cAlias ) > 0 .AND. lNew ; (cAlias)->( dbCLOSEAREA() ) ; ENDIF
IF VALTYPE( lExc ) <> 'L' ; lExc := .F. ; ENDIF
IF( ValType(lReadyOnly) <> 'L', ;
lReadyOnly := .F. ,;
)
IF UPPER(cRdd) == 'SIXCDX'
cRdd:='DBFCDX'
ENDIF
if IsAds()
if !Empty( uPath := Upper(ExtractPath( cFile )) )
uLoad := Upper(LoadPath())
if !( SUBSTR(uLoad,3) $ uPath )
cRdd := 'DBFCDX'
endif
if "PRO\" $ uPath
cRdd := 'DBFCDX'
endif
endif
endif
IF( i == 0.OR. i < LEN(cFile) - 3, i:= LEN(cFile), i-- )
IF RIGHT( cFile, 3 ) == 'PRO'
cDbfFile := cFile
ELSE
cDbfFile := LEFT(cFile,i)+'.DBF'
cFile := LEFT(cFile,i)
ENDIF
/*
IF !_REC_YES .AND. !Bs_IsTmp( cFile )
// Глобальное запрещение записи
lReadyOnly := .T.
ENDIF
*/
cCdxFile := LEFT(cFile,i)+'.CDX'
IF( !FILE(cDbfFile), (nSeconds:= 0,SayError('Нет файла: '+cDbfFile)), ) // Нет базы
DO WHILE (!lForever .AND. nSeconds > 0)
WHILE SECONDS() - nOpenSec < MemVar->WAIT_OPEN .AND. dOpenData = DATE(); ENDDO
IF lNew
IF lExc
USE (cFile) ALIAS (cAlias) NEW VIA (cRdd) EXCLUSIVE
ELSE
USE (cFile) ALIAS (cAlias) NEW VIA (cRdd) SHARED
ENDIF
ELSE
IF lExc
USE (cFile) ALIAS (cAlias) VIA (cRdd) EXCLUSIVE
ELSE
USE (cFile) ALIAS (cAlias) VIA (cRdd) SHARED
ENDIF
ENDIF
dOpenData := DATE()
nOpenSec := SECONDS()
IF !NETERR() // USE успешно выполнена
IF FILE(cCdxFile) .AND. EMPTY(cIndexes) .AND. EMPTY(lNoIndex) // так как xH хватает CDX с таким же именем и падает
OrdListAdd( cCdxFile )
ENDIF
IF (VALTYPE(cIndexes) == 'C')
OrdListAdd(cIndexes )
ELSEIF (VALTYPE(cIndexes) == 'A')
FOR nCo:=1 TO LEN(cIndexes)
IF (LEN(TRIM(cIndexes[nCo])) > 0)
SET INDEX TO (cIndexes[nCo]) ADDITIVE
ENDIF
NEXT
ENDIF
lForever := .T.
EXIT
ENDIF
// Ожидание приблизительно 0.1 секунда
// INKEY(0.1)
nSeconds--
ENDDO
IF !lForever
IF nArea>0
SELECT(nArea)
ENDIF
ENDIF
#ifndef _DEBUG
CheckLastRec(cAlias)
#endif
RETURN(lForever)
Joined: 27 Jun 2005 Posts: 1000 Location: Горбунов Константин Occupation: БЭСТ-Партнер Interests: СПб
Posted: 17 Sep 2007 18:26 Post subject:
16.
Code:
/********
* Функция: DBOpenBases( <xBases>, [<cMessage>], [<lExc>], [<lRO>], [<NoProcess>], [<NoClearState>], [<lFile>])
*
* Назначение: Открывает базы данных
*
* Параметры:
*
* <xBases> - список открываемых баз данных. Может быть массивом {<NameTable>,...<nNameTable>}
* или если алиас не совпадает { {<Alias>,<NameTable>},...{<nAlias>,<nNameTable>} } или
* символьной строкой. "NameTable".
* <cMessage> - символьная строка сообщения ( по умолчанию со стандартным сообщением ).
* <lExc> - открываются при .T. локально базы данных ( по умолчанию общий доступ ).
* <lRO> - открываются только для чтения ( по умолчанию все ).
* <NoProcess> - показывать или нет индикацию при открытии ( по умолчанию показывается ).
*<NoClearState> - не очищает установки на область если база открыта ( по умолчанию не зачищает ).
* <lFile> - не выдает предупреждения при отсутствии базы и открывает .IDX если есть
*/
Function DBOpenBases( xBases, cMessage, lExc, lRO, NoProcess, NoClearState, lFile)
Local nProcess := 0
Local lOK := .T.
LOCAL aBases := If( Y_Type( xBases,"A"), xBases, {xBases} )
Local aSave := DBSave()
Local nLen := Len( aBases )
Joined: 27 Jun 2005 Posts: 1000 Location: Горбунов Константин Occupation: БЭСТ-Партнер Interests: СПб
Posted: 17 Sep 2007 18:30 Post subject:
17.
Code:
* Функция: DBPush([<cAlias>], [<xOrder>], [<cFilter>],;
* [<aScope>], [<aRelations>], [<LAdd>], [<nRecNo>], [<lNoStek>])
*
* Назначение: Сохраняет все текущие физические "элементы состояния" рабочей
* области, такие как: алиас, текущий тег, текущий фильтр, Scope,
* реляции, номер записи, анализируя, были ли они установлены
* каждый в отдельности и устанавливает новые если заданы
* соответствующие параметры. Если какой-либо параметр не задан
* то значение соответствующего "элемента состояния" остается
* прежним. Если необходимо снять текущие фильтр, Scope или
* реляции то вместо соответствующего параметра надо передать
* любое пустое значение кроме NIL: ("", {}, 0, .F.).
* Все параметры опциональны.
*
* Параметры:
*
* <cAlias> - новый алиас (символьная строка).
*
* <xOrder> - номер или имя нового тэга (число или символьная строка).
*
* <cFilter> - новое выражение фильтра (символьная строка).
*
* <aScope> - массив из двух, трех или четырех элементов соответствующих
* параметрам функции SetScope(), структура:
*
* {<cScope>, <xScope>, [<xScope1>], [<aOrder>]} .
*
* <aRelations> - новые реляции в виде массива подмассивов из двух элементов,
* подмассивов может быть несколько, структура:
*
* { {<xLinkArea>, <cLinkExpr>},... }
*
* где:
* <xLinkArea> - номер или алиас рабочей области для
* реляции (число или символьная строка).
* <cLinkExpr> - выражение реляции (символьная строка);
* Возможен вариант когда этот параметр строка используемая
* для реляции.
* <LAdd> - если задан то реляции добавляются к существующим.
* Этот параметр для совмещения со складским модулем
* может быть алиасом связной таблицы.
* <nRecNo> - новый номер записи (число).
* <lNoStek> - не сохраняется в стек DBStatus, а сбрасывается в массив.
*/
Local aOldStat
Local IsAnotherAlias
Local xT
Local nLen
Local i := 1
IF !IsNoScp.AND.LEN(aScope)>4.AND.VALTYPE(aScope[4])="L".AND.VALTYPE(aScope[5])="A"
aScope[4]:=aScope[5] //titov - когда приходит из запомненного aScope
ENDIF
Joined: 27 Jun 2005 Posts: 1000 Location: Горбунов Константин Occupation: БЭСТ-Партнер Interests: СПб
Posted: 18 Sep 2007 11:27 Post subject:
19.
Code:
FUNCTION SAVESETKEY()
Local aSave := HB_SetKeySave()
Local i
Local aRest := {}
For i := 1 to len(aSave)
if aSave[i][1] == K_F1.or.;
aSave[i][1] == K_ALT_F1.or.;
aSave[i][1] == K_ALT_Z.or.;
aSave[i][1] == K_ALT_K.or.;
aSave[i][1] == K_ALT_INS.or.;
aSave[i][1] == K_ALT_V
aadd(aRest,aSave[i])
else
setkey(aSave[i][1],nil)
endif
Next
if !Empty(aRest)
HB_SetKeySave(aRest)
endif
Joined: 27 Jun 2005 Posts: 1000 Location: Горбунов Константин Occupation: БЭСТ-Партнер Interests: СПб
Posted: 26 Oct 2007 16:41 Post subject:
20.
Code:
//--------------------------------------------------------------------------//
FUNCTION PricePere(lPrice,get,lSkid,bnCena,bnVCena)
//--------------------------------------------------------------------------//
// Если lPrice!=NIL, то по текущему прайс листу
LOCAL aMat:=aWindow[2][7]:cargo[1],i,cMat,nProces
LOCAL lIndik:=LEN(aMat)>10,nCena,nVCena,nKol,nKolNNum
LOCAL nWi:=WSELECT()
LOCAL aPar := DefParam()
LOCAL aParam := RetTypeParam(5)
IF get!=NIL.AND.!get:changed()
RETURN(.T.)
ENDIF
WSELECT(0)
IF lIndik
PROCES TO nProces PROMPT "Пересчет цен" MAX LEN(aMat)
ENDIF
FOR i:=1 TO LEN(aMat)
IF lIndik
Proces_Update(nProces)
ENDIF
cMat:=aMat[i]
MLabel->(DBSEEK(UPPER(SUBSTR(cMat,Q_GRUP,L_GRUP)+SUBSTR(cMat,Q_NNUM,L_NNUM))))
SPR_PART->(DBSEEK(UPPER(SUBSTR(cMat,Q_GRUP,L_GRUP)+SUBSTR(cMat,Q_NNUM,L_NNUM)+SUBSTR(cMat,Q_PARTIA,L_PARTIA))))
MSTRU->(DBSEEK(UPPER(SUBSTR(cMat,Q_GRUP,L_GRUP))))
MSCHET->(DBSEEK(UPPER(MSTRU->SCHET)))
MGRUP->(DBSEEK(UPPER(SUBSTR(cMat,Q_GRUP,L_GRUP))))
cMat:=STUFF(cMat,Q_VCENA,15,STR(nVCena,15,3))
cMat:=STUFF(cMat,Q_SUMOUT,15,STR(nCena*nKol,15,CURR_MAIN))
EditCalc(.F.,.F.,2,aPar,@cMat,aParam,@pModel)
aMat[i]:=cMat
NEXT
IF lIndik
Proces_End()
ENDIF
IF lPrice!=NIL
pUpdated:=.T.
SETLASTKEY(0)
ENDIF
WSELECT(aWindow[2][6])
aWindow[2][7]:RefreshAll() //Этот метод надо делать уже в окне
InitObj(aWindow[2][7],'Passiv') //Объект
WSELECT(nWi)
DispSum1()
RETURN(.T.)
All times are GMT + 4 Hours Goto page Previous1, 2
Page 2 of 2
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum