Listing: 1 MODULE DataDef; 2 (* 3 * ModBase 4 * Release 3.0 5 * (c) Copyright 1986 - 1991 PMI 6 Copyright 1988 - 1991 John McMonagle 7 * P.O. Box 8402 8 * Green Bay Wi 53308 9 * All Rights Reserved 10 * by Ed Ross 11 *) 12 13 FROM Gen IMPORT GenFile; 14 FROM MakeDBF IMPORT MakeDataBaseFile; 15 FROM DataTypes IMPORT DataElmtRec,IndexElmtRec,TableName,FldList,IdxList, 16 DBFName,FullTableName; 17 FROM GenEdt IMPORT GenEdtFile; 18 FROM EnvironUtils IMPORT ReadEnvironment; 19 FROM NumTypes IMPORT Real8; 20 FROM Str IMPORT Copy; 21 FROM SmartScreen IMPORT ClearScreen; 22 FROM Hash IMPORT Define,Insert,KeyFind,HashTable,GetData; 23 FROM StrConv IMPORT RealToStr,CardinalToStr; 24 FROM ScrnUtl1 IMPORT GetFieldImageRec; 25 FROM Tables IMPORT Table,CellValue,GetCell,PutCell,BuildTable, 26 DefineTextCol,DefineIntegerCol,DefineGroupCol,DefineTable,ControlTable, 27 DeleteTable,ShowTable,NumberOfRows; 28 FROM GenLists IMPORT GenList,ListLength,GetElmtAdr,BlockToList, 29 GetElmt, ListInsertAdr,NewList,DisposeList,ListInsert,ShellSortList; 30 FROM HandleIO IMPORT BlockRead,BlockWrite,FileExists, 31 OpenFile,CloseHandle,CreateFile; 32 FROM StringIO IMPORT ErrorMessage,NoError,WriteEol,outp; 33 FROM PosUtils IMPORT Equal,Present,Pos; 34 FROM Prompts IMPORT PromptStr,PromptYN; 35 FROM M2Strings IMPORT Length,CompareStr; 36 FROM StrEdit IMPORT CAPstr,CrunchBlanks,Append,SetLength,AssignStr,LowerStr, 37 DeleteRightJustified,CAPstr; ***** ^ duplicate identifier 38 FROM ControlUtils IMPORT AddMenuItem,ChangeField,ReadInput,Control; 39 FROM DirManager IMPORT DirToFrame; 40 FROM Drectory IMPORT GetDrivePathAndName,GetCurrentDir,GetDefaultDrive, 41 SetDefaultDrive,ChDir; 42 FROM FramePainter IMPORT ShowDisplayFrame; 43 FROM InputManager IMPORT ControlFrame; 44 FROM ScrnTypes IMPORT InitDisplayFrame,DisplayFrame,AFrameName,ImageElement; 45 FROM ScrnUtl2 IMPORT CloseDisplayFrame; 46 FROM LowLevel IMPORT Fill; 47 FROM ModBase3 IMPORT DBFile, DBFieldDescriptor,AppendBlank,GetField, 48 CloseDBF,WriteDBRec,BuildDBF; 49 FROM DBIndxes IMPORT DBIndex,InitIndex,CloseIndex,BuildIndex,AddRecord, 50 InitCompIndex,BuildCompIndex; 51 FROM SYSTEM IMPORT TSIZE,ADR,ADDRESS; 52 IMPORT VWindows; 53 FROM VStorage IMPORT DosAlloc,DosDealloc; 54 FROM DBUtils IMPORT GetSelected,SelectFromScreen; 55 IMPORT InitCompilerMods; 56 57 58 59 60 VAR 61 DF : DisplayFrame; 62 Tab : Table; 63 SerList : GenList; 64 FileName : ARRAY[0..20] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 65 Card : CARDINAL; 66 EM : ErrorMessage; 67 Code,J : CARDINAL; 68 Bool : BOOLEAN; 69 Environ : ARRAY[0..60] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 70 71 (* Table should look like this 72 1234567890123456789012345678901234567890123456789012345678901234567890123456 73 1 2 3 4 5 6 7 74 Index Name Type Length Dec Description *) 75 76 77 PROCEDURE SetupTable(); 78 BEGIN 79 80 DefineTable(Tab,'Data Definitions'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 81 DefineTextCol(Tab,3,1,'Index',FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 DefineTextCol(Tab,10,10,'Name',FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 83 DefineTextCol(Tab,22,1,'Type',FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 84 DefineIntegerCol(Tab,27,5,'Length',0,9999); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 85 DefineIntegerCol(Tab,35,2,'Dec',0,99); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 86 DefineTextCol(Tab,40,35,'Desc',FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 END SetupTable; ***** ^ not supported yet 88 89 90 91 92 93 94 95 PROCEDURE GetDataElmts(FileName : ARRAY OF CHAR); ***** ^ not supported yet 96 97 (* return a list of all products *) 98 VAR 99 H : CARDINAL; 100 FldDesc: DataElmtRec; 101 EM : ErrorMessage; 102 Size : CARDINAL; 103 J : CARDINAL; 104 BEGIN 105 IF FileExists(FileName) ***** ^ not supported yet ***** ^ not supported yet 106 THEN 107 EM := OpenFile(H,FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 108 EM := BlockRead(H,ADR(FldDesc),SIZE(FldDesc)); (* get the first*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 109 WHILE (EM = 0) DO ***** ^ not supported yet 110 ListInsert(FldDesc,1,FldList,1000); (* put at the end*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 111 EM := BlockRead(H,ADR(FldDesc),SIZE(FldDesc)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 112 END; (* end while *) 113 EM := CloseHandle(H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 114 END; 115 END GetDataElmts; ***** ^ not supported yet 116 117 118 PROCEDURE UpdateDataElmtsFile(FileName : ARRAY OF CHAR); ***** ^ not supported yet 119 VAR 120 Row : CARDINAL; 121 FldDesc : DataElmtRec; 122 Cell : CellValue; 123 Code,Size : CARDINAL; 124 H : CARDINAL; 125 EM : ErrorMessage; 126 BEGIN 127 DisposeList(FldList); (* start the list over *) ***** ^ not supported yet ***** ^ not supported yet 128 NewList(FldList); ***** ^ not supported yet ***** ^ not supported yet 129 EM := CreateFile(H,FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 130 FOR Row := 1 TO NumberOfRows(Tab) DO (* read the screen & get elemts*) ***** ^ not supported yet ***** ^ not supported yet 131 GetCell(Tab,1,Row,Cell); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 132 FldDesc.Idx := Cell.Str[0]; (* indexed field*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 133 CAPstr(FldDesc.Idx); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 134 135 GetCell(Tab,2,Row,Cell); (* fld name *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 CAPstr(Cell.Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 137 Copy(FldDesc.Name , Cell.Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 138 139 GetCell(Tab, 3,Row,Cell); (* Fld Type *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 140 CAPstr(Cell.Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 141 FldDesc.Type := Cell.Str[0]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 142 143 GetCell(Tab,4,Row,Cell); (* fld lenght *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 144 FldDesc.Len := Cell.I; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 146 GetCell(Tab,5,Row,Cell); (* dec positions *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 147 FldDesc.Dec := Cell.I; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 149 GetCell(Tab,6,Row,Cell); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 150 Copy(FldDesc.Desc , Cell.Str); (* description *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 151 152 IF (FldDesc.Name[0] # ' ') AND(FldDesc.Idx # 'D') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 THEN 154 ListInsert(FldDesc,1,FldList,1000); (* put at the end*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 155 EM := BlockWrite(H,ADR(FldDesc),SIZE(FldDesc)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 156 END; 157 END; (* end for row *) 158 EM := CloseHandle(H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 159 160 END UpdateDataElmtsFile; ***** ^ not supported yet 161 162 163 164 PROCEDURE DefineDataElmts(TableName : ARRAY OF CHAR); ***** ^ not supported yet 165 VAR 166 J : CARDINAL; 167 Cell : CellValue; 168 Row : CARDINAL; 169 DataElmt : POINTER TO DataElmtRec; ***** ^ not supported yet 170 Nbr : ARRAY[0..4] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 171 Size,Code : CARDINAL; 172 BEGIN 173 BuildTable(Tab,ListLength(FldList)+20); (* increase table size by 20*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 174 FOR Row := 1 TO ListLength(FldList) DO ***** ^ not supported yet ***** ^ not supported yet 175 GetElmtAdr(FldList,Row,DataElmt,Size,Code); (* get address of data elmt *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 176 Cell.Str[0] := DataElmt^.Idx; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 177 Cell.Str[1] := 0C; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 178 PutCell(Tab,1,Row,Cell); (* indexed *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 179 180 Copy(Cell.Str , DataElmt^.Name); (* field names *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 181 PutCell(Tab,2,Row,Cell); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 182 183 Cell.Str[0] := DataElmt^.Type; (* field type *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 184 Cell.Str[1] := 0C; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 185 PutCell(Tab,3,Row,Cell); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 186 187 Cell.I := DataElmt^.Len; (* field length *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 188 PutCell(Tab,4,Row,Cell); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 189 190 Cell.I := DataElmt^.Dec; (* decimal positions *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 191 PutCell(Tab,5,Row,Cell); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 192 193 Copy(Cell.Str , DataElmt^.Desc); (* Description *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 194 PutCell(Tab,6,Row,Cell); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 195 196 END; 197 ControlTable(Tab,2,5,78,20); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 198 199 200 END DefineDataElmts; ***** ^ not supported yet 201 202 203 204 205 PROCEDURE SelectTable(VAR TableName : ARRAY OF CHAR); ***** ^ not supported yet 206 VAR 207 DF : DisplayFrame; 208 NxtFrame : AFrameName; 209 ReturnVal: ARRAY[0..40] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 210 Row : CARDINAL; 211 Drive : CHAR; 212 Card : CARDINAL; 213 PathName : ARRAY[0..63] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 214 Str : ARRAY[0..12] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 215 FileName : AFrameName; 216 217 ImageRec: ImageElement; 218 219 BEGIN 220 InitDisplayFrame(DF,VWindows.CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 221 DF^.action := 'I'; ***** ^ not supported yet ***** ^ not supported yet 222 AddMenuItem(DF,2,2,'NEW',30,1,'NEW'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 223 DF^.headline := 3; ***** ^ not supported yet ***** ^ not supported yet 224 EM := DirToFrame('*.ddf',DF,1); (* find data definition file *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 225 226 ControlFrame(DF,1,'',TRUE,FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 227 GetFieldImageRec( DF, DF^.CurrentField, ImageRec ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 228 Copy(FileName , ImageRec.text); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 229 Copy(TableName , FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 230 CrunchBlanks(TableName); ***** ^ not supported yet ***** ^ not supported yet 231 IF Equal(TableName,'NEW') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 232 THEN 233 PromptStr('Enter Table Name ',TableName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 234 CrunchBlanks(TableName); ***** ^ not supported yet ***** ^ not supported yet 235 IF Present('.',TableName) ***** ^ not supported yet ***** ^ not supported yet 236 THEN 237 SetLength(TableName,Pos('.',TableName)); (* make sure .ddf type*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 238 END; 239 Append(TableName,'.DDF') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 240 END; 241 Drive := GetDefaultDrive(); ***** ^ not supported yet ***** ^ not supported yet 242 Card := GetCurrentDir(Drive,PathName); ***** ^ not supported yet ***** ^ not supported yet 243 FullTableName[0] := Drive; ***** ^ not supported yet ***** ^ not supported yet 244 FullTableName[1] := 0C; ***** ^ not supported yet ***** ^ not supported yet 245 Append(FullTableName,':'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 246 Append(FullTableName,PathName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 247 IF FullTableName[Length(FullTableName)-1] <> '\' ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 248 THEN Append(FullTableName,'\'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 249 END; 250 Append(FullTableName,TableName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 251 END SelectTable; ***** ^ not supported yet 252 253 PROCEDURE FixLists(); 254 255 (* go through the list of fields and create a list of indexes *) 256 (* Give each index a accelerator key (highlighted key on menu) *) 257 (* by checking each letter in the field for an unused letter *) 258 (* the index will be given an name = Fieldname+'IDX' *) 259 (* the data base will be given the name of the table + 'DBF' *) 260 261 PROCEDURE MakeRep(VAR Item : DataElmtRec); 262 VAR Str : ARRAY [0..10] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 263 BEGIN 264 CASE Item.Type OF ***** ^ not supported yet ***** ^ not supported yet 265 'C' : IF Item.Len = 1 ***** ^ not supported yet ***** ^ not supported yet 266 THEN Item.RecType := 'CHAR' ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 267 ELSE Item.RecType := 'ARRAY[0..'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 268 CardinalToStr(Item.Len,3,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 269 Append(Item.RecType,Str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 270 Append(Item.RecType,'] OF CHAR;'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 271 END; 272 |'N' : IF (Item.Dec = 0 ) AND (Item.Len < 6) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 273 THEN Item.RecType := 'CARDINAL'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 274 ELSIF (Item.Dec = 0) ***** ^ not supported yet ***** ^ not supported yet 275 THEN Item.RecType := 'LONGINT'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 276 ELSE Item.RecType := 'Real8'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 277 END; 278 |'M' : Item.RecType := 'Memo'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 279 |'D' : Item.RecType := 'Date'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 280 281 |'L' : Item.RecType := 'BOOLEAN'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 282 END; 283 END MakeRep; ***** ^ not supported yet 284 285 VAR 286 J : CARDINAL; 287 Item : POINTER TO DataElmtRec; ***** ^ not supported yet 288 IdxItem : IndexElmtRec; 289 Size,Code : CARDINAL; 290 CharSet : SET OF CHAR; ***** ^ not supported yet 291 C : CHAR; 292 K : CARDINAL; 293 BEGIN 294 SetLength(TableName,Pos('.',TableName)); (* get rid of file type in name*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 295 LowerStr(TableName); ***** ^ not supported yet ***** ^ not supported yet 296 CAPstr(TableName[0]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 297 Copy(DBFName , TableName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 298 Append(DBFName,'DBF'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 299 (* the index fields will become menu items in 300 the generated EDT file. Each menu item will 301 have a selection character highlighted - 302 Find an unused character in the index name to 303 highlight *) 304 305 CharSet := CharSet/CharSet; (* Charset = the set of used characters *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 306 307 INCL(CharSet,'F'); (* First record*) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 308 INCL(CharSet,'L'); (* Last record *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 309 INCL(CharSet,'N'); (* Next record *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 310 INCL(CharSet,'P'); (* Prev record *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 311 INCL(CharSet,'A'); (* Add Record *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 312 INCL(CharSet,'Q'); (* The oddballs*) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 313 NewList(IdxList); ***** ^ not supported yet ***** ^ not supported yet 314 FOR J := 1 TO ListLength(FldList) DO ***** ^ not supported yet ***** ^ not supported yet 315 GetElmtAdr(FldList,J,Item,Size,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 316 MakeRep(Item^); ***** ^ not supported yet ***** ^ not supported yet 317 CrunchBlanks(Item^.Desc); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 318 IF Item^.Idx = 'I' ***** ^ not supported yet ***** ^ not supported yet 319 THEN 320 CrunchBlanks(Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 321 Copy(IdxItem.FldName , Item^.Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 322 LowerStr(IdxItem.FldName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 323 CAPstr(IdxItem.FldName[0]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 324 Copy(IdxItem.EdtName , IdxItem.FldName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 325 Copy(IdxItem.IdxName , IdxItem.FldName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 326 IF Equal(Item^.RecType ,'Real8') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 327 THEN IdxItem.IndexType := 'R' (* real type *) ***** ^ not supported yet ***** ^ not supported yet 328 ELSIF Equal(Item^.RecType, 'CARDINAL') ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 329 THEN IdxItem.IndexType := 'N' (* cardinal type *) ***** ^ not supported yet ***** ^ not supported yet 330 ELSE IdxItem.IndexType := 'C'; (* everything else is char*) ***** ^ not supported yet ***** ^ not supported yet 331 END; 332 333 IF Length(IdxItem.IdxName) > 8 ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 334 THEN 335 IdxItem.IdxName[8] := 0C; (* set to max of 8 *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 336 END; 337 CrunchBlanks(IdxItem.EdtName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 338 339 K := 0; 340 LOOP 341 IF K > Length(IdxItem.FldName) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 342 THEN 343 CAPstr(IdxItem.FldName[0]); (* this will cause a compiler error*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 344 IdxItem.HighLight := 'Q'; ***** ^ not supported yet ***** ^ not supported yet 345 EXIT; (* in the generated program CASE stm*) 346 END; 347 C := IdxItem.FldName[K]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 348 CAPstr(C); ***** ^ not supported yet ***** ^ not supported yet 349 IF NOT (C IN CharSet) ***** ^ not supported yet 350 THEN 351 CAPstr(IdxItem.EdtName[K]); (* make highlighted char *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 352 INCL(CharSet,IdxItem.EdtName[K]); (* add to set of used char*) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 353 IdxItem.HighLight := IdxItem.EdtName[K]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 354 EXIT; 355 END; 356 INC(K); ***** ^ undeclared identifier ***** ^ not supported yet 357 END; 358 ListInsert(IdxItem,1,IdxList,100); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 359 END; 360 END; (* end for j *) 361 362 END FixLists; ***** ^ not supported yet 363 364 365 BEGIN 366 367 368 NewList(FldList); ***** ^ not supported yet ***** ^ not supported yet 369 SelectTable(TableName); (* Get name of table *) ***** ^ not supported yet ***** ^ not supported yet 370 371 GetDataElmts(FullTableName); (* get the elements from the file *) ***** ^ not supported yet ***** ^ not supported yet 372 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 373 IF PromptYN('Update Table ?',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 374 THEN 375 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 376 WriteEol(outp, ***** ^ not supported yet ***** ^ not supported yet 377 ' ....This may take a few minutes to create the data structures ..'); ***** ^ not supported yet 378 SetupTable(); ***** ^ not supported yet ***** ^ not supported yet 379 DefineDataElmts(TableName); ***** ^ not supported yet ***** ^ not supported yet 380 UpdateDataElmtsFile(FullTableName); ***** ^ not supported yet ***** ^ not supported yet 381 END; 382 FixLists(); ***** ^ not supported yet ***** ^ not supported yet 383 IF PromptYN('Create New database file ?',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 384 THEN 385 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 386 MakeDataBaseFile(FldList); ***** ^ not supported yet ***** ^ not supported yet 387 END; 388 (* GenCode(TableName,FldList); *) 389 IF PromptYN('Create the EDT file?',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 390 THEN 391 GenEdtFile(TableName,FldList,IdxList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 392 END; 393 IF PromptYN('Generate Gode ?',DF) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 394 THEN 395 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 396 InitDisplayFrame(DF,VWindows.CurrentWindow); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 397 DF^.action := 'I'; ***** ^ not supported yet ***** ^ not supported yet 398 DF^.headline := 2; ***** ^ not supported yet ***** ^ not supported yet 399 EM := DirToFrame('*.TPL',DF,1); (* find data definition file *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 400 SelectFromScreen(DF); ***** ^ not supported yet ***** ^ not supported yet 401 GetSelected(SerList,DF); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 402 FOR J := 1 TO ListLength(SerList) DO ***** ^ not supported yet ***** ^ not supported yet 403 GetElmt(SerList,J,FileName,Code); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 404 GenFile(FileName); ***** ^ not supported yet ***** ^ not supported yet 405 END; 406 END; 407 ClearScreen(); ***** ^ not supported yet ***** ^ not supported yet 408 END DataDef. 555 errors