home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / database / gsdb28 / gsdblook.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-27  |  13.2 KB  |  539 lines
  1. program GSdBLook;
  2. uses
  3.    CRT,
  4.    DOS,
  5.    GS_Lst,
  6.    GS_FileH,
  7.    GS_KeyI,
  8.    GS_dBFld,
  9.    GS_Pick,
  10.    GS_Winfc,
  11.    GS_dBTbl,
  12.    GS_dBase;
  13.  
  14. const
  15.  
  16.    Initial_Count  = 7;
  17.    Initial_Choice : array [1..Initial_Count] of string[9] =
  18.                     (' Edit',' Append',' Select',' Print',
  19.                     ' Pack',' Info',' Exit');
  20.  
  21. type
  22.    Look_Obj  = object(GS_dBFld_Objt)
  23.                   constructor Init(FName : string);
  24.                   procedure   StatusUpdate(statword1,statword2,
  25.                                             statword3 : longint); virtual;
  26.                end;
  27.  
  28. var
  29.    Look      : Look_Obj;
  30.    LookIndex,
  31.    LookName  : string;
  32.    CreditWin,
  33.    FileWin,
  34.    FieldWin,
  35.    PrintWin,
  36.    AskWin,
  37.    StatusWin,
  38.    TalkWin,
  39.    LookWin   : GS_Wind_Objt;
  40.    LookTab   : dbTabl_Pick_Obj;
  41.    L         : PathStr;
  42.  
  43.  
  44. constructor Look_Obj.Init(FName : string);
  45. begin
  46.    GS_dBFld_Objt.Init(FName);
  47.    TalkWin.InitWin(10,10,70,15,Blue,LightGray,Yellow,LightGray,Black,true,
  48.                   '',true);
  49. end;
  50.  
  51. procedure Look_Obj.StatusUpdate(statword1,statword2,statword3 : longint);
  52. begin
  53.    case statword1 of
  54.       StatusStart   : begin
  55.                          case statword2 of
  56.                             StatusPack  : TalkWin.NamWin('[ Pack Progress ]');
  57.                             StatusIndexTo : TalkWin.NamWin
  58.                                                     ('[ Index Progress ]');
  59.                          end;
  60.                          TalkWin.SetWin;
  61.                          GotoXY(26,3);
  62.                          write('Total Records to Process = ',statword3);
  63.                       end;
  64.       StatusStop    : TalkWin.RelWin;
  65.       StatusPack,
  66.       StatusIndexTo : begin
  67.                          GoToXy(2,3);
  68.                          write('Record Number ',statword2,'  ');
  69.                       end;
  70.    end;
  71. end;
  72.  
  73.  
  74.  
  75. function SelField(MemoOk : boolean) : string;
  76. var
  77.   FilTabl : array[1..128] of string[12];
  78.   Labl    : string;
  79.   itms    : integer;
  80.   slct    : integer;
  81.   lctn    : integer;
  82. begin
  83.    itms := 0;
  84.    lctn := 0;
  85.    while itms < Look.NumFields do
  86.    begin
  87.       inc(itms);
  88.       if MemoOk then
  89.       begin
  90.          inc(lctn);
  91.          FilTabl[lctn] := Look.FieldsN^[itms];
  92.       end
  93.       else
  94.       begin
  95.          if Look.Fields^[itms].FieldType <> 'M' then
  96.          begin
  97.             inc(lctn);
  98.             FilTabl[lctn] := Look.FieldsN^[itms];
  99.          end;
  100.       end;
  101.    end;
  102.    FieldWin.SetWin;
  103.    slct := GS_Pick_Row_Item(FilTabl, 13, lctn, 1);
  104.    FieldWin.RelWin;
  105.    if slct > 0 then Labl := FilTabl[slct] else Labl := '';
  106.    SelField := Labl;
  107. end;
  108.  
  109.  
  110. function GetExt(pth, ext : string; LookElseWhere : boolean) : string;
  111. var
  112.    Labl : string;
  113. begin
  114.    FileWin.SetWin;
  115.    Labl := GS_FileFindFiles(pth,ext,LookElseWhere);
  116.    FileWin.RelWin;
  117.    if Labl = '-' then Labl := '';
  118.    GetExt := Labl;
  119. end;
  120.  
  121.  
  122. procedure FileEdit;
  123. var
  124.    i,
  125.    ml : integer;
  126.    vl,
  127.    vs : boolean;
  128.    aw : string[1];
  129. begin
  130.    StatusWin.SetWin;
  131.    write('':10,'ESC to Abort,  F10 For Next Record,',
  132.                '  F9 to Delete/Undelete');
  133.    LookWin.SetWin;
  134.    if Look.RecNumber < 1 then
  135.       Look.GetRec(Top_Record)
  136.    else
  137.       Look.GetRec(Look.RecNumber);
  138.    vl := true;
  139.    while vl do
  140.    begin;
  141.       ClrScr;
  142.       begin
  143.          vs := false;
  144.          vl := Look.FieldUpdateScreen;
  145.          if not vl then
  146.          begin
  147.             if Look.RecChanged then
  148.             begin
  149.                AskWin.NamWin('');
  150.                AskWin.SetWin;
  151.                gotoxy(1,1);
  152.                writeln(' Record has been modified!');
  153.                write(' Save before exit? ');
  154.                aw := Look.EditString('Y',21,2,1);
  155.                vs := aw[1] in ['T','t','Y','y'];
  156.                AskWin.RelWin;
  157.             end;
  158.          end;
  159.          if vl or vs then
  160.          begin
  161.             Look.PutRec(Look.RecNumber);
  162.             if GS_KeyI_Chr = Kbd_PgUp then
  163.                Look.GetRec(Prev_Record)
  164.             else
  165.                Look.GetRec(Next_Record);
  166.          end;
  167.       end;
  168.    end;
  169.    LookWin.RelWin;
  170.    StatusWin.RelWin;
  171. end;
  172.  
  173. procedure FileAppend;
  174. var
  175.    i,
  176.    ml : integer;
  177.    vc,
  178.    vl,
  179.    vs : boolean;
  180.    aw : string[1];
  181. begin
  182.    StatusWin.SetWin;
  183.    write('':10,'ESC to Quit,  F10 For Next Record,',
  184.                '  F9 to Delete/Undelete');
  185.    LookWin.SetWin;
  186.    Look.GetRec(Top_Record);
  187.    vl := true;
  188.    vc := true;
  189.    while vl do
  190.    begin;
  191.       ClrScr;
  192.       begin
  193.          vs := false;
  194.          vl := Look.FieldAppendScreen(vc);
  195.          vc := false;
  196.          if not vl then
  197.          begin
  198.             if Look.RecChanged then
  199.             begin
  200.                AskWin.NamWin('');
  201.                AskWin.SetWin;
  202.                gotoxy(1,1);
  203.                writeln(' Record has been modified!');
  204.                write(' Save before exit? ');
  205.                aw := Look.EditString('Y',21,2,1);
  206.                vs := aw[1] in ['T','t','Y','y'];
  207.                AskWin.RelWin;
  208.             end;
  209.          end;
  210.          if vl or vs then
  211.          begin
  212.             Look.Append;
  213.             LookTab.Reset_dBTabl;
  214.          end;
  215.       end;
  216.    end;
  217.    LookWin.RelWin;
  218.    StatusWin.RelWin;
  219. end;
  220.  
  221. procedure ShowFile;
  222. var
  223.    i,
  224.    ml : integer;
  225.    vl,
  226.    vs : boolean;
  227.    aw : string[1];
  228. begin
  229.    StatusWin.SetWin;
  230.    write('':10,'ESC to Abort,  F10 to Quit and Save,',
  231.                '  F9 to Delete/Undelete');
  232.    LookWin.SetWin;
  233.    vl := true;
  234.    begin;
  235.       ClrScr;
  236.       if LookTab.Addrec then
  237.       begin
  238.          vs := false;
  239.          vl := Look.FieldAppendScreen(true);
  240.          if not vl then
  241.          begin
  242.             if Look.RecChanged then
  243.             begin
  244.                AskWin.NamWin('');
  245.                AskWin.SetWin;
  246.                gotoxy(1,1);
  247.                writeln(' Record has been modified!');
  248.                write(' Save before exit? ');
  249.                aw := Look.EditString('Y',21,2,1);
  250.                vs := aw[1] in ['T','t','Y','y'];
  251.                AskWin.RelWin;
  252.             end;
  253.          end;
  254.          if vl or vs then
  255.          begin
  256.             Look.Append;
  257.             LookTab.Reset_dBTabl;
  258.          end;
  259.       end
  260.       else
  261.       begin
  262.          vs := false;
  263.          vl := Look.FieldUpdateScreen;
  264.          if not vl then
  265.          begin
  266.             if Look.RecChanged then
  267.             begin
  268.                AskWin.NamWin('');
  269.                AskWin.SetWin;
  270.                gotoxy(1,1);
  271.                writeln(' Record has been modified!');
  272.                write(' Save before exit? ');
  273.                aw := Look.EditString('Y',21,2,1);
  274.                vs := aw[1] in ['T','t','Y','y'];
  275.                AskWin.RelWin;
  276.             end;
  277.          end;
  278.          if vl or vs then
  279.          begin
  280.             Look.PutRec(Look.RecNumber);
  281.             if GS_KeyI_Chr = Kbd_PgUp then
  282.                Look.GetRec(Prev_Record)
  283.             else
  284.                Look.GetRec(Next_Record);
  285.          end;
  286.       end;
  287.    end;
  288.    LookWin.RelWin;
  289.    StatusWin.RelWin;
  290. end;
  291.  
  292.  
  293.  
  294. procedure FileDisplay;
  295. var
  296.    t : string[8];
  297.    fn : string[12];
  298.    i : integer;
  299.    z,
  300.    wcr : boolean;
  301. begin
  302.    fn := SelField(false);
  303.    if fn = '' then exit;
  304.    wcr := Look.Wait_CR;
  305.    Look.Wait_Cr := true;
  306.    AskWin.NamWin('[ Search Criteria ]');
  307.    AskWin.SetWin;
  308.    gotoxy(1,1);
  309.    write('Enter select criteria:');
  310.    t := Look.EditString('',8,2,20);
  311.    Look.Wait_CR := wcr;
  312.    AskWin.RelWin;
  313.    if GS_KeyI_Esc then exit;
  314.    LookTab.Reset_dBTabl;
  315.    repeat
  316.       StatusWin.SetWin;
  317.       write('':22,'ESC to Exit,  RETURN to Select Entry');
  318.       if LookTab.Tabl = nil then
  319.          z := LookTab.Scan_dBTabl(fn,t,fn)
  320.       else
  321.       begin
  322.          LookTab.Pick_Win.SetWin;
  323.          z := LookTab.Choose_dBTabl;
  324.          LookTab.Pick_Win.RelWin;
  325.       end;
  326.       StatusWin.RelWin;
  327.       if z then ShowFile;
  328.    until not z;
  329.    LookTab.Reset_dBTabl;
  330. end;
  331.  
  332. procedure Print_List;
  333. var
  334.    i,
  335.    ml,
  336.    lines : integer;
  337.    swork : string;
  338.    vs    : boolean;
  339.    aw    : string[2];
  340.  
  341.    fldtabl : array[1..128] of string[10];
  342.    fldlgth : array[1..128] of integer;
  343.    fldwork : string;
  344.    fldlctn,
  345.    mmolgth : integer;
  346.  
  347.    procedure Page_Top;
  348.    var
  349.       i : integer;
  350.    begin
  351.       if lines > 0 then write(lst,#12);
  352.       for i := 1 to fldlctn do
  353.          write(lst,fldtabl[i],'':fldlgth[i] - length(fldtabl[i]),' ');
  354.       writeln(lst);
  355.       writeln(lst);
  356.       lines := 2;
  357.    end;
  358.  
  359. begin
  360.    lines := 0;
  361.    fldlctn := 0;
  362.    PrintWin.SetWin;
  363.    Writeln('Print the following fields  (Select from menu)');
  364.    repeat
  365.       fldwork := SelField(false);
  366.       if fldwork > '' then
  367.       begin
  368.          inc(fldlctn);
  369.          fldtabl[fldlctn] := fldwork;
  370.          write(fldwork,' ');
  371.          swork := Look.FieldGet(fldwork);
  372.          fldlgth[fldlctn] := Look.LastFldLth;
  373.       end;
  374.    until (fldwork = '') or (fldlctn >= 128);
  375.    if fldlctn = 0 then
  376.    begin
  377.       PrintWin.RelWin;
  378.       exit;
  379.    end;
  380.    AskWin.NamWin('');
  381.    AskWin.SetWin;
  382.    gotoxy(1,2);
  383.    write(' Do you want to print this?');
  384.    aw := Look.EditString('',29,2,1);
  385.    vs := aw[1] in ['T','t','Y','y'];
  386.    AskWin.RelWin;
  387.    if not vs then
  388.    begin
  389.       PrintWin.RelWin;
  390.       exit;
  391.    end;
  392.    GS_Lst_Esc := false;
  393.    Page_Top;
  394.    Look.GetRec(Top_Record);
  395.    while not (Look.File_EOF) and not (GS_Lst_Esc) do
  396.    begin
  397.       for i := 1 to fldlctn do
  398.       begin
  399.          fillchar(swork,sizeof(swork),' ');
  400.          swork := Look.FieldGet(fldtabl[i]);
  401.          if length(swork) < length(fldtabl[i]) then
  402.             swork[0] := chr(length(fldtabl[i]));
  403.          write(lst,swork,' ');
  404.       end;
  405.       writeln(lst);
  406.       inc(lines);
  407.       if lines > 58 then Page_Top;
  408.       Look.GetRec(Next_Record);
  409.    end;
  410.    PrintWin.RelWin;
  411. end;
  412.  
  413. procedure FilePack;
  414. var
  415.    ia : pointer;
  416.    fm : string;
  417. begin
  418.    ia := Look.dbfNdxActv;
  419.    if ia <> nil then fm := Look.dbfNdxActv^.Ndx_Key_Form;
  420.    ClrScr;
  421.    gotoxy(37,12);
  422.    write('Packing');
  423.    Look.Pack;
  424.    ClrScr;
  425.    if ia <> nil then
  426.    begin
  427.       gotoxy(37,12);
  428.       write('Indexing');
  429.       Look.IndexTo(LookIndex,fm);
  430.       Look.Index(LookIndex);
  431.       ClrScr;
  432.    end;
  433.    Look.GetRec(Top_Record);
  434. end;
  435.  
  436.  
  437. procedure DisplayCredits;
  438. begin
  439.    CreditWin.SetWin;
  440.    GoToXY(15,2);
  441.    write('Griffin Solutions');
  442.    GoToXY(18,4);
  443.    write('GS_dB Look');
  444.    GoToXY(16,6);
  445.    write('Copyright 1991');
  446.    GoToXY(4,8);
  447.    write('A program to read, write, and edit');
  448.    GoToXY(4,9);
  449.    write('dBase III files, including index and');
  450.    GoToXY(4,10);
  451.    write('memo files.');
  452.    GoToXY(4,12);
  453.    write('Usage:  GSDBLOOK [filename [indexname]]');
  454.    GoToXY(4,13);
  455.    write('Where:  filename is a dBase III file');
  456.    GoToXY(4,14);
  457.    write('        indexname is a dBase III index');
  458.    GoToXY(4,16);
  459.    write('The filename is optional.  If omitted,');
  460.    GoToXY(4,17);
  461.    write('a menu of dBase files will be displayed.');
  462.    GoToXY(4,19);
  463.    write('ShareWare.  $25.00 for Registration.');
  464.    StatusWin.SetWin;
  465.    Write('':27,'Press any Key to continue');
  466.    WaitForKey;
  467.    StatusWin.RelWin;
  468.    CreditWin.RelWin;
  469. end;
  470.  
  471.  
  472. procedure What_Now;
  473. var
  474.    c1 : char;
  475.    q : integer;
  476. begin
  477.    q := 1;
  478.    while q < Initial_Count do
  479.    begin
  480.       StatusWin.SetWin;
  481.       q := GS_Pick_Line_Item(Initial_Choice,10,Initial_Count,q);
  482.       StatusWin.RelWin;
  483.       case q of
  484.          1 : FileEdit;
  485.          2 : FileAppend;
  486.          3 : FileDisplay;
  487.          4 : Print_List;
  488.          5 : FilePack;
  489.          6 : DisplayCredits;
  490.       end;
  491.    end;
  492. end;
  493.  
  494. begin
  495.    ClrScr;
  496.    CreditWin.InitWin(18,3,63,23,Yellow,Green,LightGray,Blue,LightGray,true,
  497.                    '',true);
  498.    LookWin.InitWin(1,1,80,24,Yellow,Blue,LightGray,Blue,LightGray,true,
  499.                    '',true);
  500.    AskWin.InitWin(20,8,60,11,Blue,LightGray,Yellow,LightGray,Black,true,
  501.                   '',true);
  502.    StatusWin.InitWin(1,25,80,25,Yellow,Red,Yellow,Red,LightGray,false,'',true);
  503.    FileWin.InitWin(5,5,55,20,Yellow,Blue,LightGray,Black,Cyan,True,
  504.                        '[ FILE SELECT ]',true);
  505.    FieldWin.InitWin(32,2,48,15,Yellow,Black,Yellow,Black,LightGray,True,
  506.                        '[ FIELD SELECT ]',true);
  507.    PrintWin.InitWin(1,16,80,24,Yellow,Blue,Yellow,Black,LightGray,True,
  508.                        '[ PRINT FIELDS SELECT ]',true);
  509.    DisplayCredits;
  510.    StatusWin.SetWin;
  511.    ClrScr;
  512.    if ParamCount < 1 then
  513.    begin
  514.       Write('Select dBase File to Examine':53);
  515.       LookName := GetExt('','*.DBF',true);
  516.       ClrScr;
  517.    end else LookName := ParamStr(1);
  518.    if LookName = '' then halt;
  519.    Look.Init(LookName);
  520.    Look.Open;
  521.    FileWin.NamWin('[ INDEX ]');
  522.    if ParamCount < 1 then
  523.    begin
  524.       Write('Choose an index or [ESC]':51);
  525.       LookIndex := GetExt(LookName,'*.NDX',false);
  526.       Clrscr;
  527.    end else
  528.          if ParamCount > 1 then LookIndex := ParamStr(2)
  529.             else LookIndex := '';
  530.    if LookIndex <> '' then Look.Index(LookIndex);
  531.    StatusWin.RelWin;
  532.    Look.MemoWidth(72);
  533.    LookTab.Init_dbTabl(Look, '[ ITEMS ]',10,2,70,22,
  534.                        Yellow,Blue,LightGray,Blue,LightGray);
  535.    LookTab.Append_dBTabl(true);
  536.    What_Now;
  537.    Look.Close;
  538. end.
  539.