// // DBFS.AML : For xBase programmers Read Dbf structure and create // Comment Block // Text // MemVar := Field // Field := MemVar // Declare Fields // Declare Locals // Declare Private // Array Scatter // Array Gatter // // Written : Roberto T. Dominguez G. // e-mail : jeomara@infosel.net.mx // Usage : Compile and Run it from the macro picklist // // Modified : 29/Apr/97 10:45 a.m. // Fixed : The path isn't in the Filename // include bootpath "define.aml" private function ReadDbf( filename ) if (openfile filename "r" ) <> -1 then filepos 2 "a" lupdate = readfile 3 lupdate = (bin2int (lupdate[3])) + "/" + ((bin2int (lupdate[2]))+100)[2..3] + "/" + ((bin2int (lupdate[1]))+100)[2..3] numreg = (bin2int (readfile 4)) numfie = ((bin2int (readfile 2))-33) / 32 lonrec = (bin2int (readfile 2)) filepos 33 fieldarr = array numfie+5 fieldarr[1] = upcase (getname filename) fieldarr[2] = lupdate fieldarr[3] = numreg fieldarr[4] = numfie fieldarr[5] = lonrec for i=6 to numfie+5 Str = readfile 32 Field = Str[1..10] Type = Str[12] Len = ((bin2int Str[17])+1000)[2..4] Dec = ((bin2int Str[18])+1000)[2..4] fieldarr[i] = { Field Type Len Dec } end closefile return fieldarr end private function wrComBloc(Selec dbfArr) if Selec=="X" then insabove "// File Name : " + dbfArr[1] insabove "// Last Update : " + dbfArr[2] insabove "// Records : " + dbfArr[3] insabove "// Fields : " + dbfArr[4] insabove "// Record Length : " + dbfArr[5] insabove "// 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴" insabove "// No. Field Name Type Width Decimal" insabove "// 컴컴 컴컴컴컴컴컴 컴컴 컴컴� 컴컴컴�" for i=6 to length dbfArr insabove ("// " + (i-5+10000)[2:4]+" "+ dbfArr[i][1]+ " " + dbfArr[i][2]+ " "+ dbfArr[i][3] +" " + dbfArr[i][4]) end insabove "" end private function wrBldText(Selec dbfArr) if Selec=="X" then insabove "File Name : " + dbfArr[1] 5 insabove "Last Update : " + dbfArr[2] 5 insabove "Records : " + dbfArr[3] 5 insabove "Fields : " + dbfArr[4] 5 insabove "Record Length : " + dbfArr[5] 5 insabove "컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴" 5 insabove " No. Field Name Type Width Decimal" 5 insabove "컴컴 컴컴컴컴컴컴 컴컴 컴컴� 컴컴컴�" 5 for i=6 to length dbfArr insabove ((i-5+10000)[2:4]+" "+ dbfArr[i][1]+ " " + dbfArr[i][2]+ " "+ dbfArr[i][3] +" " + dbfArr[i][4]) 5 end insabove "" end private function wrMemFiel(Selec dbfArr) if Selec=="X" then for i=6 to length dbfArr insabove ( (locase dbfArr[i][2])+dbfArr[i][1][1]+(locase dbfArr[i][1][2:9])+ " := "+ (upcase dbfArr[1][1]) + dbfArr[1][2:(pos "." dbfArr[1][2..11])-1]+"->"+dbfArr[i][1] ) 5 end insabove "" end private function wrFielMem(Selec dbfArr) if Selec=="X" then for i=6 to length dbfArr insabove ( (upcase dbfArr[1][1]) + dbfArr[1][2:(pos "." dbfArr[1][2..11])-1]+"->"+dbfArr[i][1]+" := "+ (locase dbfArr[i][2])+dbfArr[i][1][1]+(locase dbfArr[i][1][2:9]) ) 5 end insabove "" end private function wrDeclFie(Selec dbfArr) if Selec=="X" then insabove ( "FIELD " + (upcase dbfArr[6][1])+",;" ) 5 NomArch = " IN "+ dbfArr[1][1:(pos "." dbfArr[1][1..11])-1] for i=7 to length dbfArr insabove ( dbfArr[i][1] + if? i==(length dbfArr) NomArch ",;" ) 11 end insabove "" end private function wrDeclLoc(Selec dbfArr) if Selec=="X" then insabove ( "LOCAL " + (locase dbfArr[6][2])+dbfArr[6][1][1]+(locase dbfArr[6][1][2:9])+",;" ) 5 for i=7 to length dbfArr insabove ( (locase dbfArr[i][2])+dbfArr[i][1][1]+(locase dbfArr[i][1][2:9])+if? i==(length dbfArr) "" ",;" ) 11 end insabove "" end private function wrDeclPri(Selec dbfArr) if Selec=="X" then insabove ( "PRIVATE " + (locase dbfArr[6][2])+dbfArr[6][1][1]+(locase dbfArr[6][1][2:9])+",;" ) 5 for i=7 to length dbfArr insabove ( (locase dbfArr[i][2])+dbfArr[i][1][1]+(locase dbfArr[i][1][2:9])+if? i==(length dbfArr) "" ",;" ) 13 end insabove "" end private function wrDeclSca(Selec dbfArr) if Selec=="X" then insabove ("a"+(upcase dbfArr[1][1]) + dbfArr[1][2:(pos "." dbfArr[1][2..11])-1]+" := ARRAY(FCOUNT())") 5 insabove ("AEVAL(a"+(upcase dbfArr[1][1]) + dbfArr[1][2:(pos "." dbfArr[1][2..11])-1]+",{|xExpression, nField| a"+(upcase dbfArr[1][1]) + dbfArr[1][2:(pos "." dbfArr[1][2..11])-1]+"[nField] := FIELDGET(nField)})") 5 insabove "" end private function wrDeclGat(Selec dbfArr) if Selec=="X" then insabove ("AEVAL(a"+(upcase dbfArr[1][1]) + dbfArr[1][2:(pos "." dbfArr[1][2..11])-1]+",{|xExpression, nField| FIELDPUT(nField, xExpression)})") 5 insabove "" end private function DlgDbf variable control1, control2, control3 // Path and Type path = (getpath (getbufname)) filespec = path+"*.dbf" // main dialog box dialog filespec 69 13 "c" // control #1: listbox listbox "L&ist Box:" 3 1 (loadbuf filespec '' '' 'dfsl' (sub '[~lc]' '' _NameStyle 'x')) 39 11 fmgr.fsort 'n' // control #2: group box groupbox 'Options :' 45 1 (menu '' item ' [ ] &Comment Block ' item ' [ ] &Build Text ' item ' [ ] &MemVar := Field ' item ' [ ] &Field := MemVar ' item ' [ ] &Declare Fields ' item ' [ ] Declare &Locals ' item ' [ ] Declare &Private ' item ' [ ] Array &Scatter ' item ' [ ] Array &Gatter ' end) button "O&k" 47 12 8 if (getdialog ref control1 ref control2 ref control3) == "Ok" then filname = path + control1[18:(pos " " control1[18:9])-1]+control1[27:4] dbfarr = (ReadDbf filname ) wrComBloc control2[1] dbfarr wrBldText control2[2] dbfarr wrMemFiel control2[3] dbfarr wrFielMem control2[4] dbfarr wrDeclFie control2[5] dbfarr wrDeclLoc control2[6] dbfarr wrDeclPri control2[7] dbfarr wrDeclSca control2[8] dbfarr wrDeclGat control2[9] dbfarr end end DlgDbf // Call Dialog Dbf