| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969 |
- 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
|