Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VFP crashes while calling a DLL

Status
Not open for further replies.

RedLion

Programmer
Sep 13, 2000
342
NL
Hello,

I've got a problem with calling functions from a GoldMine DLL. The first time I run mine program everything goes well, but the second time it crashes on the first call to a GoldMine DLL function, the error I get is:
"Microsoft Visual C++ Runtime Library"
"Runtime Error!"
"program:c:\Program Files\Microsoft Visual FoxPro 9\vfp9.exe"
"R6025 - pure virtual function call"
.

The function colored red below is the first function called, and gives the error messega described above. If I make this function the second function then the other function will give the error message.

Any Ideas what the reason can be, do I make any errors clearing the dll's? Is my declaration wrong? Why does the TRY..CATCH... not catch this error?

The source from the program:


Code:
o = createobject("goldmine")
? o.createCall("...", "...","...","...","...","...","...")

define class Goldmine as Session olepublic


	* Create a goldmine opmgr
	function createCall(cUser as String, cUserPassword as String, cAccountNo as String, ;
			cCompany as String, cProjectOmschrijving as String, cContact as string, ;
			cHeerMevrouw as String) as string
		
		local lcError, lwOpmgr, lcOpId, lcId, lcDate, llResult
		lcDate = date()
		lcDate = alltrim(str(year(lcDate))) + alltrim(str(month(lcDate))) ;
			+ alltrim(str(day(lcDate)))
		
		* establish connection
		lcError = this.load(cUser, cUserPassword)
		if (lcError == "")
			lwOpmgr = GMW_DB_Open("OPMGR")
			if (lwOpmgr > 0)
				lcOpId = SPACE(20) && min 20 characters!
				* add first record P
				llResult = (gmw_db_append(lwOpmgr, @lcOpId) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "opid", lcOpId, 0) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "rectype", "P", 0) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "accountno", cAccountNo, 0) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "userid", cUser, 0) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "company", cCompany, 0) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "name", cProjectOmschrijving, 0) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "startdate", lcDate, 0) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "closeddate", lcDate, 0) = 1)
				llResult = llResult and (gmw_db_replace(lwOpmgr, "closeby", lcDate, 0) = 1)
				llResult = llResult and (gmw_db_Unlock(lwOpmgr) = 1)
				llResult = llResult and (gmw_db_close(lwOpmgr) = 1)
				lwOpmgr = GMW_DB_Open("OPMGR")
				if (lwOpmgr > 0)
					if (llResult)
						lcId = space(20)
						* add second record PC
						llResult = (gmw_db_append(lwOpmgr, @lcId) = 1)
						llResult = llResult and (gmw_db_replace(lwOpmgr, "opid", lcOpId, 0) = 1)
						llResult = llResult and (gmw_db_replace(lwOpmgr, "rectype", "PC", 0) = 1)
						llResult = llResult and (gmw_db_replace(lwOpmgr, "accountno", cAccountNo, 0) = 1)
						llResult = llResult and (gmw_db_replace(lwOpmgr, "company", cCompany, 0) = 1)
						llResult = llResult and (gmw_db_replace(lwOpmgr, "contact", cContact, 0) = 1)
						llResult = llResult and (gmw_db_replace(lwOpmgr, "cycle", cHeerMevrouw, 0) = 1)
						llResult = llResult and (gmw_db_replace(lwOpmgr, "u_stage", "", 0) = 1)
						llResult = llResult and (gmw_db_Unlock(lwOpmgr) = 1)
						llResult = llResult and (gmw_db_close(lwOpmgr) = 1)
						if (!llResult)
							lcError = "Fout toevoegen PC record"
						endif
					else
						lcError = "Fout toevoegen P record"
					endif
				else
					lcError = "Fout openen tabel voor toevoegen PC record"
				endif
			endif
		
		else
			return lcError + ", " + this.unload()
		endif
		
		* clear the garbage
		return this.unload()
	endFunc
	

	
	* Thake the nessesary preperations
	hidden function load(cUser as String, cUserPassword as String) as String
		
		local lcPathToGoldmineDir, lcLoginname, lcPassword, lcBDEAlias, loReg as oldinireg, ;
			lcPath, lcError, lnTeller, lnResult
		
		lcError = ""
		lcPath = FULLPATH(CURDIR())
		
		* Find path to ini file
		if (!file(lcPath + "vgt.ini"))
			return "Cannot find vgt.ini"
		endif		

		* get initial valus from ini file
		set Classlib To registry additive
		loReg = createobject("oldinireg")
		loReg.getIniEntry(@lcPathToGoldmineDir, "GOLDMINE", "pathtogoldminedir", lcPath + "vgt.ini")
		loReg.getIniEntry(@lcLoginname, "GOLDMINE", "sqlserverloginname", lcPath + "vgt.ini")
		loReg.getIniEntry(@lcPassword, "GOLDMINE", "sqlserverpassword", lcPath + "vgt.ini")
		loReg.getIniEntry(@lcBDEAlias, "GOLDMINE", "bdealias", lcPath + "vgt.ini")		
		release loReg
		
		* connecting functions
		DECLARE integer GMW_LoadBDE IN (lcPathToGoldmineDir + "\GM5S32.dll") string, ;
			string, string, string, string
		DECLARE integer GMW_UnloadBDE IN (lcPathToGoldmineDir + "\GM5S32.dll")
		DECLARE integer GMW_SetSQLUserPass IN (lcPathToGoldmineDir + "\GM5S32.dll") string, string

		* mutation functions
		DECLARE long GMW_DB_Open IN (lcPathToGoldmineDir + "\GM5S32.dll") string
		DECLARE long GMW_DB_Append IN (lcPathToGoldmineDir + "\GM5S32.dll") long, string
		DECLARE long GMW_DB_Replace IN (lcPathToGoldmineDir + "\GM5S32.dll") long, ;
			string, string, integer
		DECLARE long GMW_DB_Close IN (lcPathToGoldmineDir + "\GM5S32.dll") long
		DECLARE long GMW_DB_Filter IN (lcPathToGoldmineDir + "\GM5S32.dll") long, string
		DECLARE long GMW_DB_Top IN (lcPathToGoldmineDir + "\GM5S32.dll") long
		DECLARE long GMW_DB_Skip IN (lcPathToGoldmineDir + "\GM5S32.dll") long, integer
		DECLARE long GMW_DB_Unlock IN (lcPathToGoldmineDir + "\GM5S32.dll") long
		
		* establish a connection with goldmine
		try
			if ([COLOR=red]GMW_SetSQLUserPass(lcLoginname, lcPassword)[/color] # 1)
				return "Cannot log in to SQLSERVER"
			endif
			
			* Because the connection (load of the bde) is never established the first time,
			*	but always the second time first time -8 secound 1 as return value
			lnTeller = 1
			lnResult = -1
			do while (lnTeller < 4) and (lnResult < 0)
				lnResult = GMW_LoadBDE(lcPathToGoldmineDir, lcBDEAlias, lcBDEAlias, cUser, cUserPassword)
				lnTeller = lnTeller + 1
			enddo
			if lnResult < 0
				lcError = "Cannot loadBDE"
			endif
		catch 
			lcError = "Error during load"
		endtry
		return lcError
	endFunc



	* Clear all garbage
	hidden function unload as string
		local lnResult, lcReturn
		lcReturn = ""
		lnResult = GMW_UnloadBDE()
		if (!(lnResult = 1 or lnResult = -1))
			return "Cannot unloadBDE"
		endif
		try
			this.clearDllIfIsDeclared("GMW_LoadBDE")
			this.clearDllIfIsDeclared("GMW_UnloadBDE")
			this.clearDllIfIsDeclared("GMW_SetSQLUserPass")
			this.clearDllIfIsDeclared("GMW_DB_Open")
			this.clearDllIfIsDeclared("GMW_DB_Append")
			this.clearDllIfIsDeclared("GMW_DB_Replace")
			this.clearDllIfIsDeclared("GMW_DB_Close")
			this.clearDllIfIsDeclared("GMW_DB_Filter")
			this.clearDllIfIsDeclared("GMW_DB_Top")
			this.clearDllIfIsDeclared("GMW_DB_Skip")
			this.clearDllIfIsDeclared("GMW_DB_Unlock")
		catch
			lcReturn = "Error during unload"
		endtry
		return lcReturn
	endFunc



	* check if the alias exists and if, clear the declaration of the dll
	hidden function clearDllIfIsDeclared(cAlias as String)
		local laDlls
		dimension laDlls(1)
		adlls(laDlls)
		if (ascan(laDlls, cAlias, 1, alen(laDlls, 1), 2, 7) > 0)
			clear Dlls &cAlias
		endif
	endFunc


enddefine

Thanks,

Charl
 

Perhaps a call (or e-mail) to the creator of the DLL might help you. Not knowing what the DLL is suppose to do, it is difficult to determine the problem.

Mike Gagnon

If you want to get the best response to a question, please check out FAQ184-2483 first.
ReFox XI (www.mcrgsoftware.com)
 
Hi Charl,

The last time I had a problem with a DLL where it worked the first time and then crashed the second was because I called the DLL with the wrong number of parameters. This causes stack corruption.

Regards,

Mike
 
Thanks for the reactions!

I'll go and check the parameter count for the functions, thanks.

Charl
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top