* -- Gets class library info from VCX files * -- and creates reference HTML page called classinfo.html * -- Robert Bradley Dec 9 98 lparameter tcClassSpec local lnNumVCXs, lnFile private lcLibDir if type("tcClassSpec") <> "C" ; or not directory(tcClassSpec) lcLibDir = getdir(curdir(), "Class Directory") if empty(lcLibDir) return endif else lcLibDir = alltrim(tcClassSpec) if right(lcLibDir,1) <> "\" lcLibDir = lcLibDir + "\" endif endif wait window "Gathering names of class libraries from " + lcLibDir nowait lnNumVCXs = adir(laVCXs, lcLibDir + "*.vcx") if lnNumVCXs < 1 wait window "There were no class libraries found in "+lcLibDir timeout 2 return endif create cursor curClassInfo (VCXFile C(20), Name C(30), BaseType C(17), Caption C(35), ; ParentClass C(20), ParentVCX C(20)) for lnFile = 1 to lnNumVCXs wait window "Processing: " + laVCXs(lnFile,1) nowait do processVCX with laVCXs(lnFile,1) && in this .prg endfor wait clear select curClassInfo do MakeHTML && in this prg set message to return ************************ procedure processVCX lparameter tcVCXFile local lcCaption select 0 use (lcLibDir + tcVCXFile) alias VCXFile noupdate again scan for empty(parent) and platform = "WINDOWS" lcCaption = strtran(mline(VCXFile.properties, atcline("Caption =", VCXFile.properties)), "Caption =") lcCaption = alltrim(strtran(lcCaption, ["])) insert into curClassInfo values ; (strtran(tcVCXFile, ".VCX"), VCXFile.objname, VCXFile.baseclass, ; lcCaption, VCXFile.class, VCXFile.classloc) endscan use ************************* procedure makehtml local lhHTMLFile lhHTMLFile = fcreate("ClassInfo.html") fputs(lhHTMLFile, [ Class Information from VCX files]) fputs(lhHTMLFile, [Class Information from VCX files]) fputs(lhHTMLFile, [
] + ttoc(datetime()) + []) fputs(lhHTMLFile, [

]) fputs(lhHTMLFile, [By Class Library (VCX)]) fputs(lhHTMLFile, [
])
fputs(lhHTMLFile, [NAME            BASE TYPE     PARENT  ])
local lcPreviousVCX
lcPreviousVCX = " "
scan
	if vcxfile <> lcPreviousVCX
		fputs(lhHTMLFile, [

] + trim(vcxfile) + [.VCX] + []) endif fputs(lhHTMLFile, name + basetype + ; iif(trim(parentclass)=trim(basetype), "", trim(parentclass)) + ; iif(empty(parentvcx), "", " of "+trim(parentvcx))) lcPreviousVCX = trim(vcxfile) endscan fputs(lhHTMLFile, [
]) select * from curClassInfo order by name into cursor temp fputs(lhHTMLFile, [

]) fputs(lhHTMLFile, [By Class Name]) fputs(lhHTMLFile, [
])
fputs(lhHTMLFile, [NAME            VCX FILE    BASE TYPE    PARENT  ])
scan
	fputs(lhHTMLFile, [] + name +[] + vcxfile + ;
		basetype + ;
		iif(trim(parentclass)=trim(basetype), "", trim(parentclass)) + ;
		iif(empty(parentvcx), "", " of "+trim(parentvcx)))
endscan
fputs(lhHTMLFile, [
]) select * from curClassInfo order by basetype into cursor temp fputs(lhHTMLFile, [

]) fputs(lhHTMLFile, [By Base Type]) fputs(lhHTMLFile, [
])
fputs(lhHTMLFile, [NAME            VCX FILE    PARENT  ])
local lcPreviousBase
lcPreviousBase = " "
scan
	if trim(basetype) <> lcPreviousBase
		fputs(lhHTMLFile, [

] + upper(trim(basetype)) + []) endif fputs(lhHTMLFile, name + vcxfile + trim(parentclass)+ iif(empty(parentvcx), "", " of "+trim(parentvcx))) lcPreviousBase = trim(basetype) endscan fputs(lhHTMLFile, [
]) select * from curClassInfo order by caption into cursor temp fputs(lhHTMLFile, [

]) fputs(lhHTMLFile, [By Caption]) fputs(lhHTMLFile, [
(only those with Captions)
]) fputs(lhHTMLFile, [
])
fputs(lhHTMLFile, [CAPTION                     NAME            VCX FILE    PARENT 
]) scan for not empty(caption) fputs(lhHTMLFile, [] + caption +[] + name + vcxfile + parentvcx) endscan fputs(lhHTMLFile, [
]) fputs(lhHTMLFile, []) fclose(lhHTMLFile) use in temp use in curClassInfo * if not empty(caption) * fputs(lhHTMLFile, replicate("   ",20) + ; * [Caption: ]+ caption) * endif