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) = ""