home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMSTRU.PRG < prev    next >
Text File  |  1991-12-13  |  3KB  |  99 lines
  1. *.............................................................................
  2. *
  3. *   Program Name: MEMSTRU.PRG       Copyright: EDON Corporation
  4. *   Date Created: 04/30/91           Language: Clipper S'87
  5. *   Time Created: 08:01:15             Author: Ed Phillips
  6. *           Desc: Display a Database Structure
  7. *.............................................................................
  8.  
  9. PRIVATE oldcolor, savscrn, oldarea
  10.  
  11. struvar = If(Len(struvar) < 30, Gaspad(struvar,30), struvar)
  12.  
  13. ex_flg = .f.
  14. savscrn = Savescreen(1,0,24,79)
  15. oldcolor = Setcolor(c_statln1)
  16. oldarea = Select()
  17.  
  18. Shadow(5,17,13,64)
  19. Scroll(5,17,13,64,0)
  20. Setcolor(c_error)
  21. @ 5,17 SAY Replicate(Chr(176),48)
  22. @ 5,30 SAY ' List DBF Structure '
  23. @ 13,17 SAY Replicate(Chr(176),48)
  24. Setcolor(c_statln1)
  25. SET KEY -2 TO DbfileList
  26.  
  27. @ 07,23 SAY "Enter DBF file name: (path optional)"
  28. @ 11,21 SAY 'Press <F3> for a list, <Esc> to Cancel'
  29. Setcolor(c_fielda)
  30. @ 09,26 GET struvar PICT '@K!'
  31. READ
  32. SET KEY -2 TO
  33.  
  34. IF Empty(struvar) .OR. Lastkey() = esc
  35.    ex_flg = .t.
  36. ELSEIF ! File(struvar)
  37.    ex_flg = .t.
  38.    Sayerr('File not found')
  39. ENDIF                                            && IF Empty(struvar) .OR. Lastkey() = esc
  40.  
  41. IF ! ex_flg
  42.    SELECT 0
  43.    USE (struvar)
  44.    COPY STRU EXTENDED TO MemJunk
  45.    USE MemJunk
  46.  
  47.    bhelp_msg = Chr(24)+Chr(25)+', <Esc> = Done'
  48.    btit1 = 'Structure: '+Trim(struvar)
  49.    Shadow(3,18,22,63)
  50.    Setcolor(c_error)
  51.    Scroll(3,18,5,63,0)
  52.    @ 3,Centr(btit1) SAY btit1
  53.    @ 5,19 SAY 'Field No.   Field Name   Type   Width   Dec'
  54.    expr = "Space(3)+Str(Recno(),3,0)+Space(6)+Field_name+Space(4)+Field_type+Space(6)+FieldSize()"
  55.    Setcolor(c_statln1)
  56.    Browze_dbf(expr,6,18,22,63)
  57.    USE
  58. ENDIF                                            && IF ! ex_flg
  59.  
  60. IF File('MemJunk.dbf')
  61.    ERASE MemJunk.dbf
  62. ENDIF                                            && IF File('MemJunk.dbf')
  63.  
  64. Setcolor(oldcolor)
  65. Restscreen(1,0,24,79,savscrn)
  66. SELECT (oldarea)
  67. RETURN
  68.  
  69. *----------------------------
  70. *         Author: Ed Phillips
  71. *   Date Created: 04/30/91
  72. *----------------------------
  73. FUNCTION FieldSize
  74.    PRIVATE ret_val
  75.  
  76.    ret_val = Str(Field_len,4,0)+Space(3)+Str(Field_dec,3,0)
  77.    IF Field_type = 'C'
  78.       IF Field_dec > 0
  79.          ret_val = Str(Field_dec * 256 + Field_len,4,0)+Space(5)+'0'
  80.       ENDIF                                      && IF Field_dec > 0
  81.    ENDIF                                         && IF Field_type = 'C'
  82. RETURN(ret_val)
  83.  
  84. *----------------------------
  85. *         Author: Ed Phillips
  86. *   Date Created: 04/30/91
  87. *----------------------------
  88. PROCEDURE DbfileList
  89.    PRIVATE dbf_files[Adir('*.dbf')], oldcolor, dwin
  90.  
  91.    Adir('*.dbf',dbf_files)
  92.    sel = PickList("dbf_files", " File List",15,3,1)
  93.    IF sel > 0
  94.       struvar = dbf_files[sel]
  95.    ENDIF                                         && IF sel > 0
  96.  
  97. RETURN
  98. * EOF: MEMSTRU.PRG
  99.