Visual Extend 8.0 Change History

Copyright © dFPUG c/o ISYS GmbH 2003

Date: 2003-11-17

Classlibrary: VFXAPPL

Class: cEmail

Method: AddAttachment

Classification:

Bugfix

Reason for change:

Parameters now checked correctly.

New Code:

Lparameters tsAlias, tcFileName, tcReport, tcFor

Local oNewAttacment, oCurrentOldAttacment

If !IsNull(This.oEmail_Attachment)

* If !(Type("tsAlias") == "C") or !(Type("tcFileName") == "C") or ;

* !(Type("tcReport") == "C") or !(Type("tcReport") == "C")

If !(Type("tsAlias") == "C") or !(Type("tcFileName") == "C") or ;

!(Type("tcReport") == "C") or !(Type("tcFor") == "C")

Return .F.

EndIf

If Empty(tcFileName)

Return .F.

EndIf

For Each oCurrentOldAttacment in This.oEmail_Attachment

If Alltrim(Upper(oCurrentOldAttacment.cPDF_File_Name)) == Alltrim(Upper(tcFileName))

Return .F.

EndIF

EndFor

If Empty(tcReport) and This.oEmail_Attachment.Count = 0

Return .F.

EndIf

oNewAttacment = NewObject("Custom")

oNewAttacment.AddProperty("cAlias_Name",Alltrim(tsAlias))

oNewAttacment.AddProperty("cPDF_File_Name",Alltrim(tcFileName))

oNewAttacment.AddProperty("cFRX_Name",Alltrim(tcReport))

oNewAttacment.AddProperty("cFor_Clause",Alltrim(tcFor))

This.oEmail_Attachment.Add(oNewAttacment)

Return .T.

Else

Return .F.

EndIf

Date: 2003-11-17

Classlibrary: VFXAPPL

Class: cFoxApp

Method: PrintScreen

Classification:

Bugfix

Reason for change:

Changes the name of the “View” menu.

New Code:

LOCAL lcerror,__vfx_error,lcMenu

__vfx_error = .F.

lcerror = ON('error')

ON ERROR __vfx_error = .T.

DECLARE INTEGER keybd_event IN win32api INTEGER a1,INTEGER a2,INTEGER a3,INTEGER a4

=keybd_event(44,0,0,0)

ON ERROR &lcerror

IF !__vfx_error

lnSelect=SELECT()

CREATE CURSOR hardcopy (picture G)

APPEND BLANK

DOEVENTS

* lcMenu=STRTRAN(CAP_MENUVIEW,'"','')

lcMenu="View"

DEFINE BAR 3 OF &lcMenu. PROMPT CAP_NEXTPAGE ;

KEY CTRL+PGUP, CAP_NEXTPAGEKEY ;

SKIP FOR OnSkipMenu("VIEW_NEXTPAGE") ;

MESSAGE CAP_NEXTPAGESTATUSBAR

DEFINE WINDOW _preview FROM -500,-500 TO -400,-400

ACTIVATE WINDOW _preview

KEYBOARD "{CTRL+PGDN}{CTRL+V}{CTRL+W}{CTRL+W}"

BROWSE IN _preview

RELEASE WINDOW _preview

DEFINE BAR 3 OF &lcMenu. PROMPT CAP_NEXTPAGE ;

KEY CTRL+PGDN, CAP_NEXTPAGEKEY ;

SKIP FOR OnSkipMenu("VIEW_NEXTPAGE") ;

MESSAGE CAP_NEXTPAGESTATUSBAR

REPORT FORM hardcopy NOCONSOLE TO PRINTER

*!* LOCAL owordobject

*!* owordobject = CREATEOBJECT("word")

*!* WITH owordobject

*!* IF .openword()

*!* .setvisible()

*!* .setwindowstate()

*!* .adddocument()

*!* .paste()

*!* .printdocument()

*!* .nsavechanges = 0

*!* .closedocument()

*!* ENDIF

*!* ENDWITH

*!* RELEASE owordobject

ENDIF

Date: 2003-11-13

Task Pane: VFX80TaskPane.xml

Classification:

Bugfix

Reason for change:

The Task Pane could not get the focus on some installations if the command window of VFP was set to ‘dockable’.

Installation:

To install this new version of the VFX 8.0 Task Pane open the Task Pane of VFP. Click on ‘Options’ and select ‘Task Pane Manager’. On the ‘Customize’ page click on ‘Install Pane’ and select the file

VFX80\Builder\VFX80TASKPANE.XML

Date: 2003-11-13

Classlibrary: VFXAPPL

Class: cVFXActivate

Method: CreateAndSendEMail

Classification:

Bugfix

Reason for change:

Sending registration information.

New Code:

Local lcOldSetDefault As String, FileToDelete As String, SetDefault As String, ;

loErrorNo, oError as Exception

lcOldSetDefault = Sys(5) + Sys(2003)

loErrorNo = 0

Try

This.AddObject("ED_MAPI", "cmapicontrols")

CATCH TO oError

loErrorNo = oError.ErrorNo

ENDTRY

IF loErrorNo > 0

RETURN .f.

ENDIF

Try

With This.ED_MAPI

.msMAPISession.NewSession = .T.

TRY

.msMAPISession.SignOn()

CATCH TO oError

loErrorNo = oError.ErrorNo

ENDTRY

IF loErrorNo = 0

.msMAPIMessages.SessionID = .msMAPISession.SessionID

.msMAPIMessages.Compose()

.msMAPIMessages.MsgNoteText = MSG_SEETHEATTACHEDFILE

.msMAPIMessages.MsgSubject = MSG_REGISTRATIONINFORMATION

* .msMAPIMessages.RecipAddress = This.cRegEMail

.msMAPIMessages.RecipDisplayName = This.cRegEMail

.msMAPIMessages.AttachmentIndex = 0

.msMAPIMessages.AttachmentPosition = 0

.msMAPIMessages.AttachmentType = 0 & Attach file

.msMAPIMessages.AttachmentPathName = This.cParamFile

TRY

.msMAPIMessages.Send()

.msMAPISession.SignOff()

CATCH TO oError

loErrorNo = oError.ErrorNo

ENDTRY

ENDIF

EndWith

FileToDelete = This.cParamFile

Delete File &FileToDelete

Catch

Finally

CD(lcOldSetDefault)

ENDTRY

IF loErrorNo > 0

RETURN .F.

ENDIFDate: 2003-11-13

Classlibrary: VFXAPPL

Class: cVFXActivate

Method: CheckActState

Classification:

Bugfix

Reason for change:

Check activation state.

New Code:

LPARAMETERS lcINIFile, nActionType, aAppRights

IF EMPTY(This.cActPattern)

This.cActPattern = " " & For Hex2Bin

ENDIF

If Len(lcINIFile) > 17 OR nActionType = 2

IF EMPTY(This.cActPattern)

MESSAGEBOX(MSG_INSTALLATIONKEYCANNOTBEGENERATED,0 + 64,MSG_ATTENTION)

RETURN .F.

ENDIF

lnVars = Memlines(This.cRegParameters)

For i = 1 To lnVars

lcLine = Mline(This.cRegParameters, i)

lnPos = At(":", lcLine)

lcVar = Left(lcLine, lnPos-1)

lcVal = Substr(lcLine, lnPos + 1)

If At("FileCreationDate", lcVar) > 0

lcData = GetFileCreationDateTime(lcVal)

If !(Vartype(lcData) = "C")

This.Reginfonotexist = .T.

RETURN .f.

ENDIF

Store lcData to &lcVar

Else

lnKeyPos = At("\", lcVal)

lnValPos = Rat("\", lcVal)

lcRoot = Left(lcVal, lnKeyPos - 1)

Try

lnRoot = Evaluate(lcRoot)

Catch

lnRoot = 0

EndTry

If lnRoot > 0 Then

lcData = " "

If RegistryAccess.GetRegKey(Substr(lcVal, lnValPos + 1), @lcData, Left(lcVal, lnValPos - 1), lnRoot) = ERROR_SUCCESS

Store lcData to &lcVar

ELSE

This.Reginfonotexist = .T.

RETURN .f.

EndIf

EndIf

EndIf

ENDFOR

ENDIF

IF INLIST(nActionType, 1, 3)

external array laAppRights

lcRightsBin = Substr(lcINIFile, 18)

lcCRC = PADL(Sys(2007, This.cActPattern,0,1),10,"0")

CheckString = Left(lcRightsBin, 5)+Right(lcRightsBin, 5)

If !(CheckString == lcCRC)

RETURN .F.

EndIf

lcRightsBin = This.Hex2Bin(Substr(lcRightsBin, 6, Len(lcRightsBin) - 10))

*If !GetAppRights(lcRightsBin, This.Hex2Bin(This.cActPattern))

lnRes = GetAppRights(lcRightsBin, This.Hex2Bin(This.cActPattern))

If lnRes > 0

IF nActionType > 1

MessageBox(TRANSFORM(lnRes) + " " + MSG_INSTALLATIONISNOTVALID, 16 + 0, ;

MSG_FATAL_ERROR)

ENDIF

RETURN .F.

ENDIF

This.ReorderRightArray(@laAppRights)

lnResult = .T.

If !This.AppRightsCheckSum()

FOR i = 1 TO ALEN(laAppRights)

laAppRights[i] = - 1

ENDFOR

lnResult = .F.

ENDIF

ACOPY(laAppRights, aAppRights)

lIsLicensed = lnResult

RETURN lnResult

ENDIF

RETURN GetSysInfo(This.Hex2bin(This.cActPattern))
Date: 2003-11-13

Classlibrary: VFXAPPL

Class: cEMail

Method: Send_Email_Report

Classification:

Bugfix

Reason for change:

Sending mails using MS Outlook.

New Code:

Lparameters tcEmail, tcSubject, tcText

Local lcPrinterName , lcChostPath, lcOldSetDefault, llResult, laExistFile[1], lcSetDefault, ;

oError as Exception, loCurrentAttachment, lcAlias_Name, lcPDF_Name, lcFRX_Name, ;

lcFor_Clause,oUserError as Exception, lnUserErrorNo

If This.LastErrorNo < 0

Return .f.

Else

This.LastErrorNo = 0

EndIf

If IsNull(This.oEmail_Attachment)

Return .f.

EndIF

lcOldSetDefault = Sys(5) + Sys(2003)

For Each loCurrentAttachment in This.oEmail_Attachment

lcAlias_Name = loCurrentAttachment.cAlias_Name

lcPDF_Name = loCurrentAttachment.cPDF_File_Name

lcFRX_Name = loCurrentAttachment.cFRX_Name

lcFor_Clause = loCurrentAttachment.cFor_Clause

If Empty(lcAlias_Name)

lcAlias_Name = Alias()

EndIf

If Empty(lcAlias_Name)

Loop

endif

If !Empty(lcFRX_Name)

tcReport = lcFRX_Name

EndIF

lcPDF_Name = JustFname(lcPDF_Name)

lcPDF_Name = FORCEEXT(ADDBS(SYS(2023)) + lcPDF_Name, ".pdf")

If !This.cCreatePDF.Create_PDF(lcAlias_Name, lcPDF_Name, tcReport, lcFor_Clause)

Return .f.

EndIf

EndFor

*** 4 ***

lnUserErrorNo = 0

Try

With This.ED_MAPI

lnCurrentAttach = 0

.msMAPISession.NewSession = .t.

TRY

.msMAPISession.SignOn()

CATCH TO oUserError

lnUserErrorNo = oUserError.ErrorNo

ENDTRY

IF lnUserErrorNo = 0

.msMAPIMessages.sessionID = .msMAPISession.sessionID

.msMAPIMessages.Compose

.msMAPIMessages.MsgNoteText = Alltrim(tcText)

.msMAPIMessages.MsgSubject = Alltrim(tcSubject)

* .msMAPIMessages.RecipAddress = Alltrim(tcEmail)

.msMAPIMessages.RecipDisplayName = Alltrim(tcEmail)

For Each loCurrentAttachment in This.oEmail_Attachment

lcPDF_Name = loCurrentAttachment.cPDF_File_Name

lcPDF_Name = FORCEEXT(Addbs(Sys(2023)) + lcPDF_Name,".PDF")

If ADir(laExistFile,lcPDF_Name) > 0

.msMAPIMessages.AttachmentIndex = lnCurrentAttach

.msMAPIMessages.AttachmentPosition = lnCurrentAttach

.msMAPIMessages.AttachmentType = 0 & attach file

.msMAPIMessages.AttachmentPathName = Alltrim(lcPDF_Name)

lnCurrentAttach = lnCurrentAttach + 1

EndIf

Release laExistFile

ENDFOR

TRY

.msMAPIMessages.send()

.msMAPISession.SignOff

CATCH TO oUserError

lnUserErrorNo = oUserError.ErrorNo

ENDTRY

ENDIF

ENDWITH

For Each loCurrentAttachment in This.oEmail_Attachment

lcPDF_Name = loCurrentAttachment.cPDF_File_Name

lcPDF_Name = Addbs(Sys(2023)) + lcPDF_Name + ;

Iif(Upper(Right(lcPDF_Name,4)) == ".PDF",[],+[.pdf])

If ADir(laExistFile,lcPDF_Name) > 0

Delete File &tcFileName

EndIf

Release laExistFile

ENDFOR

llResult = .t.

Catch to oError

This.LastErrorNo = oError.ErrorNo

This.LastErrorText = oError.Message

llResult = .f.

Finally

lcSetDefault = 'Set Default To "' + lcOldSetDefault + '"'

&lcSetDefault

ENDTRY

IF llResult = .f.

onerror(oError.ErrorNo,PROGRAM() , oError.LineNo, oError.Message, oError.LineContents)

ENDIF

IF lnUserErrorNo > 0

RETURN .F.

ENDIF

RETURN llResult

Date: 2003-11-12

Classlibrary: PJHOOK

Class: PjHook

Event: AfterBuild

Classification:

Bugfix

Reason for change:

In some situations an error occurred after rebuildinng all files of a project.

New Code:

LPARAMETERS nError

LOCAL i, j, PJX, nCount, AddedFile, lnCurrentFile

PJX = _VFP.ActiveProject

lnCurrentFile = 1

DO WHILE lnCurrentFile <= PJX.Files.Count

If Upper(Justext(PJX.Files.Item(lnCurrentFile).Name))="VMR"

lcAddedFileName = Forceext(PJX.Files.Item(lnCurrentFile).Name,"VMX")

IF FILE(lcAddedFileName) AND PJX.Files.Item(lnCurrentFile).Type = "P"

AddedFile = PJX.Files.add(lcAddedFileName)

AddedFile.Type = "M"

If PJX.Files.Item(lnCurrentFile).Exclude

AddedFile.Exclude = .T.

else

AddedFile.Exclude = .F.

ENDIF

ENDIF

PJX.Files.Item(lnCurrentFile).Remove()

ELSE

lnCurrentFile = lnCurrentFile + 1

ENDIF

ENDDO

PJX.CleanUp()

*PJX.refresh

*Dodefault()

Date: 2003-11-12

File: VFX.FLL

Classification:

Improvement

Reason for change:

Using MSVCR70.DLL instead of MSVCRT.DLL.

Remember, that VFX.fll must be delivered to the customers.

Date: 2003-11-12

Classlibrary: VFXFORM

Class: cRegister

Event: cmdRegister.Click

Classification:

Bugfix

Reason for change:

Proper loading the application rights.

New Value:

If !Empty(ThisForm.txtActivationKey.Value)

lcINIFile = SPACE(17)+ALLTRIM(ThisForm.txtActivationKey.Value)

DIMENSION laRegAppRights[1]

IF !vartype(Thisform.oActivation) = "O"

loCheckActivation = goActivation

ELSE

ThisForm.oActivation.DoNotLoadSecRights = .T.

loCheckActivation = ThisForm.oActivation

endif

IF loCheckActivation.CheckActState(lcINIFile, 3, @laRegAppRights)

IF LEFT(loCheckActivation.cStoreActivationData,5) = "HKEY_"

lRes = loCheckActivation.oRegistry.IsKey(loCheckActivation.cRegKeyPath, loCheckActivation.nSubKey)

ELSE

lRes = File(ThisForm.INIFileName)

ENDIF

If !lRes

MessageBox(MSG_INSTALLATIONISNOTVALID, 16 + 0, MSG_FATAL_ERROR)

Quit

ENDIF

IF LEFT(loCheckActivation.cStoreActivationData,5) = "HKEY_"

loCheckActivation.oRegistry.GetRegkey(loCheckActivation.cKeyName ,;

@lcINIFile,loCheckActivation.cRegKeyPath,loCheckActivation.nSubKey)

NewIniContent = Left(lcINIFile, 17) + Alltrim(ThisForm.txtActivationKey.Value)

lnRes = loCheckActivation.oRegistry.SetRegKey(loCheckActivation.cKeyName,NewIniContent,;

loCheckActivation.cRegKeyPath,loCheckActivation.nSubKey)

IF lnRes = ERROR_SUCCESS

WriteResult = 1

ELSE

WriteResult = -1

ENDIF

ELSE

lcINIFile = FileToStr(ThisForm.INIFileName)

NewIniContent = Left(lcINIFile, 17) + Alltrim(ThisForm.txtActivationKey.Value)

** activation key is valid

cSetSafetyState = Set("Safety")

Set Safety off

WriteResult = StrToFile(NewIniContent, ThisForm.INIFileName)

Set Safety &cSetSafetyState

ENDIF

If WriteResult>0

* loCheckActivation.Loadsecurityrights(Decrypt(Left(lcINIFile, 17), ""), laRegAppRights)

loCheckActivation.Loadsecurityrights(Decrypt(Left(lcINIFile, 17), ""), @laRegAppRights)

MESSAGEBOX(MSG_THANKSFORACTIVATING,0+64,MSG_ACTIVATIONSUCCESSFUL)

ThisForm.Release

ENDIF

ELSE

* ThisForm.txtActivationKey.Value = ""

MESSAGEBOX(MSG_INVALIDACTIVATIONKEY,0+16,MSG_INVALIDACTIVATIONKEY)

endif

ELSE

MESSAGEBOX(MSG_PLEASEENTERTHEACTIVATIONKEY,0,MSG_ACTIVATIONKEYERROR)

endif

Date: 2003-11-12

Classlibrary: VFXOBJ

Class: cPageFrame

Event: Click

Classification:

Bugfix

Reason for change:

Refreshing page.

New Code:

IF pemstatus(THISFORM,"lUseHook",5)

IF THISFORM.lusehook

LOCAL luhookvalue

luhookvalue = THISFORM.oneventhook("Click",THIS,THISFORM)

DO CASE

CASE VARTYPE(luhookvalue)="L"

IF !luhookvalue

RETURN .T.

ENDIF

CASE VARTYPE(luhookvalue)="N"

RETURN luhookvalue=0

ENDCASE

ENDIF

ENDIF

*THIS.tabrefresh(.T.)

THIS.tabrefresh(.T.)


Date: 2003-11-12

Classlibrary: VFXAPPL

Class: cTreeView

Method: GetFieldIDType

Classification:

Bugfix

Reason for change:

Setting type of ID field.

New Code:

LOCAL lcOldAlias, lnNumberOfField, lnNumberOfCurrentField, lcIDFieldName, lValue

IF EMPTY(ThisForm.cWorkAlias) or !USED(ThisForm.cWorkAlias)

this.IDfieldtype = []

RETURN .f.

ENDIF

IF EMPTY(This.IDFieldName)

this.IDfieldtype = []

RETURN .f.

ENDIF

lcOldAlias = ALIAS()

SELECT(ThisForm.cWorkAlias)

*IF !EMPTY(this.IDfieldtype)

* lValue = EVALUATE(ALLTRIM(ThisForm.cWorkAlias) + "." + ALLTRIM(this.IDfieldtype))

* this.IDfieldtype = VARTYPE(lValue)

*ELSE

* this.IDfieldtype = []

*ENDIF

lValue = EVALUATE(ALLTRIM(ThisForm.cWorkAlias) + "." + ALLTRIM(This.IDFieldName))

this.IDfieldtype = VARTYPE(lValue)

IF !EMPTY(lcOldAlias)

SELECT(lcOldAlias)

EndIF

Date: 2003-11-12

Classlibrary: VFXAPPL

Class: cVfxActivate

Method: Init

Classification:

Bugfix

Reason for change:

Proper loading the application rights.

New Code:

Local lcSysDir, lnLength, lcINIFile, lcFileDateTime, lcEncrypted, i, lnVars, lcLine, lnPos, ;

lcVar, lcVal, lcData, lnKeyPos, lnValPos, lcRoot, lnRoot, lnRight, lcRights, ;

lcRightsBin, lnErrorNo, loError as Exception, lcOldAlias

lcSysDir = ADDBS(GETENV("windir"))

IF TYPE("goprogram.ointroform.AlwaysOnTop")="L"

goprogram.ointroform.AlwaysOnTop= .F.

ENDIF

lcINIFile = ""

lnErrorNo = 0

IF UPPER(LEFT(This.cStoreActivationData,5)) = "HKEY_"

Try

This.oRegistry = CREATEOBJECT("cregistry")

This.oRegistry.LoadRegFuncs()

This.cStoreActivationData = ALLTRIM(This.cStoreActivationData)

cRoot = UPPER(LEFT(This.cStoreActivationData,AT("\", This.cStoreActivationData) - 1))

This.cKeyName = STRTRAN(This.cStoreActivationData, "\",CHR(13) + CHR(10))

lnReturnChar = AT("\", This.cStoreActivationData, MEMLINES(This.cKeyName) - 1) - ;

AT("\", This.cStoreActivationData) - 1

This.cRegKeyPath = SUBSTR(This.cStoreActivationData, AT("\",This.cStoreActivationData) + 1,;

lnReturnChar)

DO CASE

CASE cRoot == "HKEY_CLASSES_ROOT"

This.nSubKey = HKEY_CLASSES_ROOT

CASE cRoot == "HKEY_CURRENT_USER"

This.nSubKey = HKEY_CURRENT_USER

CASE cRoot == "HKEY_LOCAL_MACHINE"

This.nSubKey = HKEY_LOCAL_MACHINE

CASE cRoot == "HKEY_USERS"

This.nSubKey = HKEY_USERS

CASE cRoot == "HKEY_PERFORMANCE_DATA"

This.nSubKey = HKEY_PERFORMANCE_DATA

CASE cRoot == "HKEY_CURRENT_CONFIG"

This.nSubKey = HKEY_CURRENT_CONFIG

CASE cRoot == "HKEY_DYN_DATA"

This.nSubKey = HKEY_DYN_DATA

OTHERWISE

This.nSubKey = HKEY_LOCAL_MACHINE

ENDCASE

This.cKeyName = MLINE(This.cKeyName, MEMLINES(This.cKeyName))

IF This.oRegistry.IsKey(This.cRegKeyPath, This.nSubKey) = .F. & Key not exist

This.oRegistry.OpenKey(This.cRegKeyPath, This.nSubKey, .T.) & Create Key

This.oRegistry.SetRegKey(This.cKeyName,"",This.cRegKeyPath,This.nSubKey)

Endif

IF This.oRegistry.GetRegkey(This.cKeyName , @lcINIFile,This.cRegKeyPath,This.nSubKey) # ERROR_SUCCESS

lnErrorNo = 1

ENDIF

CATCH TO loError

lnErrorNo = loError.ErrorNo

ENDTRY

ELSE

TRY

* IF goprogram.lactivationtype = .F.

IF !FILE(lcSysDir + This.cStoreActivationData) & INI File not exist

STRTOFILE("",lcSysDir + This.cStoreActivationData)

ENDIF

* ENDIF

lcINIFile = FileToStr(lcSysDir + This.cStoreActivationData)

CATCH TO loError

lnErrorNo = loError.ErrorNo

ENDTRY

ENDIF

IF lnErrorNo > 0

MessageBox(MSG_INSTALLATIONISNOTVALID, 16 + 0, MSG_FATAL_ERROR)

RETURN .F.

ENDIF

If Len(lcINIFile) = 0

lRes = .F.

IF UPPER(LEFT(This.cStoreActivationData,5)) = "HKEY_"

lRes = This.oRegistry.IsKey(This.cRegKeyPath, This.nSubKey)

ELSE

lRes = .T.

If !File(lcSysDir + This.cFirstInstall) AND goprogram.lactivationtype = .t.

lRes = .F.

ENDIF

ENDIF

IF lRes = .F.

MessageBox(MSG_INSTALLATIONISNOTVALID, 16 + 0, MSG_FATAL_ERROR)

RETURN .F.

ENDIF

lcFileDateTime = ""

IF !EMPTY(This.cRegFileName)

lcFileDateTime = GetFileCreationDateTime(This.cRegFileName)

ENDIF

IF EMPTY(lcFileDateTime)

lcFileDateTime = TTOC(DATETIME(),1)+"000"

endif

If Vartype(lcFileDateTime) = "C"

lcEncrypted = Encrypt(lcFileDateTime, "")

If Vartype(lcEncrypted) = "C"

lnErrorNo = 0

Try

IF UPPER(LEFT(This.cStoreActivationData,5)) = "HKEY_"

lnRes = This.oRegistry.SetRegKey(This.cKeyName,lcEncrypted,This.cRegKeyPath,This.nSubKey)

IF lnRes # ERROR_SUCCESS

lnErrorNo = lnRes

Endif

Else

StrToFile(lcEncrypted, lcSysDir + This.cStoreActivationData)

ENDIF

CATCH TO loError

lnErrorNo = loError.ErrorNo

ENDTRY

ELSE

lnErrorNo = 1

ENDIF

IF lnErrorNo > 0

MessageBox(MSG_INSTALLATIONISNOTVALID, 16 + 0, MSG_FATAL_ERROR)

RETURN .F.

ENDIF

*!* else

*!* MessageBox(MSG_INSTALLATIONISNOTVALID, 16 + 0, MSG_FATAL_ERROR)

*!* RETURN .F.

ENDIF

If File(lcSysDir + This.cFirstInstall)

Declare Integer DeleteFile IN WIN32API String lpFileName

DeleteFile(lcSysDir + This.cFirstInstall)

Clear Dlls "DeleteFile"

ENDIF

lnErrorNo = 0

TRY

IF UPPER(LEFT(This.cStoreActivationData,5)) = "HKEY_"

lnRes = This.oRegistry.GetREgkey(This.cKeyName, @lcINIFile,This.cRegKeyPath,This.nSubKey)

IF lnRes # ERROR_SUCCESS

lnErrorNo = lnRes

Endif

Else

lcINIFile = FileToStr(lcSysDir + This.cStoreActivationData)

ENDIF

CATCH TO loError

lnErrorNo = loError.ErrorNo

ENDTRY

IF lnErrorNo > 0

MessageBox(MSG_INSTALLATIONISNOTVALID, 16 + 0, MSG_FATAL_ERROR)

RETURN .f.

ENDIF

ENDIF

lcFileDateTime = Decrypt(Left(lcINIFile, 17), "")

lIsLicensed = .f.

DIMENSION atAppRights[1]

If Len(lcINIFile) > 17

if !This.Checkactstate(lcINIFile, 1, @atAppRights)

IF This.Reginfonotexist = .t.

MESSAGEBOX(MSG_ERRORDURINGRETRIEVINGINSTALLATIONINFORMATION, 16 + 0, MSG_FATAL_ERROR)

RETURN .f.

ENDIF

This.Generatehardwarekey()

ENDIF

Else

This.Generatehardwarekey()

IF This.Reginfonotexist = .t.

RETURN .f.

ENDIF

ENDIF

IF !This.DoNotLoadSecRights

*This.Loadsecurityrights(lcFileDateTime, atAppRights, lIsLicensed)

This.Loadsecurityrights(lcFileDateTime, @atAppRights, lIsLicensed)

endif

IF TYPE("goprogram.ointroform.AlwaysOnTop")="L"

goprogram.ointroform.AlwaysOnTop= .T.

ENDIF

Date: 2003-11-10

Program: VFXFUNC

Function: VFX_DoUpdate

Classification:

Bugfix

Reason for change:

Enabling to update free tables in the database folder.

New Code:

FUNCTION vfx_doupdate(tofoxapp, tlmute, tcfrom, tcto, tcvfxpath)

*!* Check whether an update is currently running with this client.

IF ADIR(ladummy,tcto+"UPD$CTRL.KEY")=1

= errormsg(msg_update_running)

RETURN .F.

ENDIF

IF TYPE("tcVfxPath")#"C"

tcvfxpath = tcto

ENDIF

*!* Initialize this function.

LOCAL lcpath, lcdbc, lnhowmany, lafile[1], laupdated[1], lcdbclink, lnneedupdate,;

j, lcsafety, lnfile

lcdbc = LOWER(tofoxapp.cmaindatabase)

LOCAL lavfxfiles[1], lcto

lavfxfiles[1] = ""

lcto = ""

IF tcto > tcvfxpath

= ADIR(lavfxfiles,tcvfxpath+"*.*", "A")

ENDIF

IF !(".dbc" $ lcdbc)

lcdbc = lcdbc + ".dbc"

ENDIF

lcsafety = SET('safety')

SET SAFETY OFF

CLOSE DATA ALL

CLOSE TABLES ALL

lnfile = - 1

*!* Are there any files in the client directory?

lnhowmany = ADIR(lafile,tcto+"*.*", "A")

IF lnhowmany = 0

** New Installation, copy data from Update directory

lnhowmany = ADIR(lafile,tcfrom+"*.*", "A")

IF lnhowmany > 0

IF TYPE("toFoxApp.oIntroForm")="O" AND !ISNULL(tofoxapp.ointroform)

tofoxapp.ointroform.RELEASE()

ENDIF

lnfile = FCREATE(tcto+"UPD$CTRL.KEY", 0)

IF lnfile < 0

= errormsg(msg_update_conflict)

SET SAFETY &lcsafety

RETURN .F.

ENDIF

*!* Copy all files from update directory into client directory ...

*-- Pfad von VFX Tabellen wird berüchsichtigt wenn neue Instalation vorliegt

LOCAL lctable, llfree, lctemp

lctable = SYS(2015)

llfree = .F.

lctemp = ""

FOR j = 1 TO lnhowmany

IF ".LOG" $ lafile[j,1]

LOOP

ENDIF

IF ".KEY" $ lafile[j,1]

LOOP

ENDIF

IF "DATADICT." $ lafile[j,1]

LOOP

ENDIF

WAIT WINDOW msg_copying+" " + lafile[j,1] + " ..." NOWAIT

llfree = .F.

lctemp = ""

IF UPPER(LEFT(lafile[j,1],3)) == "VFX"

lctemp = LEFT(lafile[j,1], AT(".", lafile[j,1])-1)

USE (tcfrom+lctemp) IN 0 ALIAS (lctable) SHARED

SELECT (lctable)

llfree = EMPTY(CURSORGETPROP("database"))

USE IN (lctable)

IF !llfree

CLOSE DATABASES ALL

ENDIF

ENDIF

lcto = IIF(UPPER(LEFT(lafile[j,1],3)) == "VFX" AND llfree, tcvfxpath, tcto)

COPY FILE (tcfrom + lafile[j,1]) TO (lcto + lafile[j,1])

NEXT

RELEASE lctable, llfree, lctemp

=FCLOSE(lnfile)

ERASE(tcto+"UPD$CTRL.KEY")

ENDIF

CLOSE DATA ALL

SET SAFETY &lcsafety

RETURN .T.

ELSE

DIMENSION ladbcalttables(1), ladbcnewtables(1), lacurrusedtables(1)

ladbcalttables(1) = ""

ladbcnewtables(1) = ""

lacurrusedtables(1) = ""