prg转vcx,基本成型，不支持ole控件
目前ole控件转不回去，还有其他vcx的特性因为没用到过，所以不知道怎么添加，期待大家多参与讨论cprg="8.TXT"
xht=""
i1=FOPEN(cprg)
DO whil NOT FEOF(i1)
i2=ALLTRIM(STREXTRACT(CHRTRAN(FGETS(i1,4096),CHR(9),"")+"&"+"&","","&"+"&"))
DO whil RIGHT(i2,1)=";"
I2=I2+ALLTRIM(STREXTRACT(CHRTRAN(FGETS(i1,4096),CHR(9),"")+"&"+"&","","&"+"&"))
enddo
IF EMPTY(I2) OR LEFT(I2,1)="*"
LOOP
ENDIF
i3=UPPER(i2)
IF AT("HIDDEN ",I3)>0
BJ="HIDDEN"
I2=LTRIM(STRTRAN(I2,"HIDDEN ","",1,1,1))
I3=LTRIM(STRTRAN(I3,"HIDDEN ","",1,1,1))
ELSE
IF AT("PROTECTED ",I3)>0
BJ="PROTECTED"
I2=LTRIM(STRTRAN(I2,"PROTECTED ","",1,1,1))
I3=LTRIM(STRTRAN(I3,"PROTECTED ","",1,1,1))
ELSE
BJ=""
ENDIF
ENDIF
DO case
CASE OCCURS(",",xht)=0
IF LEFT(i3,4)="DEFI" AND AT(" CLASS ",I3)>0 AND AT(" AS ",I3)>0
COBJNAME=ALLTRIM(STREXTRACT(i3," CLASS "," AS "))
cclass=LTRIM(STREXTRACT(i3," AS "))
cclass=STREXTRACT(cclass+" ",""," ")
cbaseclass=CCLASS
IF cclass!="FORM"
IF NOT USED()
CREATE TABLE Mydef_VCX.VCX (;
PLATFORM C(8),;
UNIQUEID c(10),;
TIMESTAMP N(10),;
CLASS M,;
CLASSLOC M,;
BASECLASS M,;
OBJNAME M,;
PARENT M,;
PROPERTIES M,;
PROTECTED M,;
METHODS M,;
OBJCODE M NOCPTRANS,;
OLE M,;
OLE2 M,;
RESERVED1 M,;
RESERVED2 M,;
RESERVED3 M,;
RESERVED4 M,;
RESERVED5 M,;
RESERVED6 M,;
RESERVED7 M,;
RESERVED8 M,;
USER M)
INSERT INTO mydef_VCX (PLATFORM,UNIQUEID,RESERVED1) VALUES ("COMMENT" ,"Class","VERSION = 3.00")
ENDIF
IF INLIST(CCLASS+".","CUSTOM.","LABEL.","TEXTBOX.","EDITBOX.","COMMANDBUTTON.","COMMANDGROUP.","OPTIONGROUP.","CHECKBOX.","COMBOBOX.","LISTBOX.","SPINNER.","GRID.","IMAGE.","TIMER.","LINE.","SHAPE.","CONTAINER.","PAGEFRAME.")
cCLASSLOC=""
ELSE
cCLASSLOC="mydef_vcx.vcx"
endif
INSERT INTO MYDEF_VCX (CLASS ,BASECLASS,OBJNAME,RESERVED1,CLASSLOC) VALUE(CCLASS,CBASECLASS,COBJNAME,"Class",CCLASSLOC)
xht=str(RECNO())+cobjname+","+xht
ENDIF
endif
CASE OCCURS(",",xht)=1
DO CASE
CASE STREXTRACT(I3,""," ")="ADD" AND AT(" OBJECT ",I3)>0 AND AT(" AS ",I3)>0
COBJNAME=ALLTRIM(STREXTRACT(i3," OBJECT "," AS "))
cclass=LTRIM(STREXTRACT(i3," AS "))
cclass=STREXTRACT(cclass+" ",""," ")
cbaseclass=CCLASS
IF INLIST(CCLASS+".","CUSTOM.","LABEL.","TEXTBOX.","EDITBOX.","COMMANDBUTTON.","COMMANDGROUP.","OPTIONGROUP.","CHECKBOX.","COMBOBOX.","LISTBOX.","SPINNER.","GRID.","IMAGE.","TIMER.","LINE.","SHAPE.","CONTAINER.","PAGEFRAME.")
cCLASSLOC=""
ELSE
cCLASSLOC="mydef_vcx.vcx"
endif
INSERT INTO mydef_vcx (class,BASECLASS,OBJNAME,PARENT,CLASSLOC) values(CCLASS,CBASECLASS,COBJNAME,STREXTRACT(SUBSTR(XHT,11),"",","),CCLASSLOC)
IF AT(" WITH ",UPPER(I2))>0
REPLACE PROPERTIES WITH MYPROPERTIES(I2)
ENDIF
CASE LEFT("PROCEDURE",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ") OR LEFT("FUNCTION",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ")
i3=LTRIM(STREXTRACT(I3," "))
IF AT(".",I3)=0
GO VAL(left(xht,10))
ELSE
LOCATE FOR OBJNAME==STREXTRACT(I3,"",".") AND parent==STREXTRACT(SUBSTR(xht,11),"",",")
i3=STREXTRACT(I3,".")
ENDIF
IF AT("(",I3)=0
I2=""
ELSE
I2=ALLTRIM(STREXTRACT(I3,"(",")"))
I3=TRIM(STREXTRACT(I3,"","("))
ENDIF
XHT="PROCEDURE "+I3+","+XHT
IF EMPTY(I2)
REPLACE METHODS WITH METHODS+"PROCEDURE "+I3+0H0D0A,RESERVED3 WITH RESERVED3+'*'+I3+0H0D0A
ELSE
REPLACE METHODS WITH METHODS+"PROCEDURE "+I3+0H0D0A+"LPARAMETERS "+I2+0H0D0A,RESERVED3 WITH RESERVED3+'*'+I3+0H0D0A
ENDIF
=MYBJ(I3)
OTHERWISE
GO VAL(left(xht,10))
DO case
case AT("=",i2)>0
REPLACE PROPERTIES WITH PROPERTIES+MYJC(i2)
CASE LEFT("ENDDEFINE",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ")
INSERT INTO MYDEF_VCX (objname ,PLATFORM,UNIQUEID) VALUE(STREXTRACT(SUBSTR(xht,11),"",","),"COMMENT","RESERVED")
XHT=STREXTRACT(XHT,",")
CASE LEFT("DIMENSION",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ")
i3=CHRTRAN(LTRIM(STREXTRACT(i3," ")),"()","[]")
i3=IIF(AT(",",i3)=0,LEFT(i3,LEN(i3)-1)+",0"+RIGHT(i3,1),i3)
REPLACE RESERVED3 WITH RESERVED3+"^"+i3+0h0d0a
OTHERWISE
=MYBJ(I3)
endcase
ENDCASE
CASE OCCURS(",",xht)=2
DO case
case LEFT("PROCEDURE",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ") OR LEFT("FUNCTION",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ")
REPLACE METHODS WITH METHODS+"ENDPROC"+0H0D0A
XHT=STREXTRACT(XHT,",")
i3=LTRIM(STREXTRACT(I3," "))
IF AT(".",I3)=0
GO VAL(left(xht,10))
ELSE
LOCATE FOR OBJNAME==STREXTRACT(I3,"",".") AND parent==STREXTRACT(SUBSTR(xht,11),"",",")
i3=STREXTRACT(I3,".")
ENDIF
IF AT("(",I3)=0
I2=""
ELSE
I2=ALLTRIM(STREXTRACT(I3,"(",")"))
I3=TRIM(STREXTRACT(I3,"","("))
ENDIF
XHT="PROCEDURE "+I3+","+XHT
IF EMPTY(I2)
REPLACE METHODS WITH METHODS+"PROCEDURE "+I3+0H0D0A,RESERVED3 WITH RESERVED3+'*'+I3+0H0D0A
ELSE
REPLACE METHODS WITH METHODS+"PROCEDURE "+I3+0H0D0A+"LPARAMETERS "+I2+0H0D0A,RESERVED3 WITH RESERVED3+'*'+I3+0H0D0A
ENDIF
=MYBJ(I3)
CASE LEFT("ENDPROC",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ") OR LEFT("ENDFUNC",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ")
REPLACE METHODS WITH METHODS+"ENDPROC"+0H0D0A
xht=STREXTRACT(xht,",")
CASE LEFT("ENDDEFINE",LEN(STREXTRACT(I3+" ",""," ")))=STREXTRACT(I3+" ",""," ")
REPLACE METHODS WITH METHODS+"ENDPROC"+0H0D0A
xht=STREXTRACT(xht,",")
OTHERWISE
REPLACE METHODS WITH METHODS+I2+0H0D0A
ENDCASE
ENDCASE
ENDDO
=FCLOSE(i1)
IF USED()
xht="_7JJOGU7ZZ"
i3=1561673324
GO bott
DO whil RECNO()>1
IF EMPTY(PLATFORM)
REPLACE PLATFORM WITH "WINDOWS",UNIQUEID WITH xht,TIMESTAMP WITH i3
ELSE
i3=i3-1
xht=IIF(RIGHT(xht,1)="A",LEFT(xht,8)+CHR(ASC(LEFT(RIGHT(xht,2),1))-1)+"Z",LEFT(xht,9)+CHR(ASC(RIGHT(xht,1))-1))
endif
cobjname=IIF(TIMESTAMP=0,objname,cobjname)
i2=IIF(TIMESTAMP=0,0,i2+1)
IF TIMESTAMP>0 AND objname==cobjname
REPLACE RESERVED2 WITH TRANSFORM(i2)
endif
SKIP -1
enddo
USE
endif
COMPILE CLASSLIB mydef_vcx.vcx
[此贴子已经被作者于2026-8-23 21:28编辑过]
