home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programming Unleashed / Delphi_Programming_Unleashed_SAMS_Publishing_1995.iso / misc / demobase / main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  4.5 KB  |  180 lines
  1. unit Main;
  2.  
  3. { Program copyright (c) 1995 by Charles Calvert }
  4. { Project Name: DEMOBASE }
  5.  
  6. { Allows you to iterate through a table that
  7.   lists all the programs that ship with Delphi
  8.   Unleashed. If there is a description for the
  9.   program, you can view it.
  10.  
  11.   This program can rebuild the ALLDIRS.DBF table
  12.   at any time. To do so, just choose RELOAD from
  13.   the menu. Note that at this time the path from
  14.   which you want to start building the list is
  15.   hardcoded into the ReLoadClick method.
  16.  
  17.   The program gets the descriptions by reading any
  18.   text found at the top of the MAIN.PAS file for
  19.   a project. If there is no MAIN.PAS file, then
  20.   this program will not retrieve a description
  21.   for the progrect. The algorithm for getting the
  22.   description first searches for a file called
  23.   MAIN.PAS. If there is one, then it opens it
  24.   as a text file, skips one line, and reads in
  25.   everything up until the interface.
  26. }
  27.  
  28. interface
  29.  
  30. uses
  31.   SysUtils, WinTypes, WinProcs,
  32.   Messages, Classes, Graphics,
  33.   Controls, Forms, Dialogs,
  34.   StdCtrls, DB, DBTables,
  35.   DBCtrls, Grids, DBGrids,
  36.   AllDirs, Fileiter, Menus,
  37.   ExtCtrls;
  38.  
  39. type
  40.   TForm1 = class(TForm)
  41.     DataSource1: TDataSource;
  42.     DBGrid1: TDBGrid;
  43.     DBMemo1: TDBMemo;
  44.     Table1: TTable;
  45.     FileIterator1: TFileIterator;
  46.     Database1: TDatabase;
  47.     MainMenu1: TMainMenu;
  48.     Options1: TMenuItem;
  49.     Count1: TMenuItem;
  50.     N1: TMenuItem;
  51.     ReLoad1: TMenuItem;
  52.     Search1: TMenuItem;
  53.     Indexes1: TMenuItem;
  54.     None1: TMenuItem;
  55.     Programs1: TMenuItem;
  56.     Chapters1: TMenuItem;
  57.     Panel1: TPanel;
  58.     DBNavigator1: TDBNavigator;
  59.     procedure CountClick(Sender: TObject);
  60.     procedure FileIterator1FoundFile(FileName: String; SR: TSearchRec);
  61.     procedure FormCreate(Sender: TObject);
  62.     procedure ReLoad1Click(Sender: TObject);
  63.     procedure Search1Click(Sender: TObject);
  64.     procedure Indexes1Click(Sender: TObject);
  65.   private
  66.     procedure GetComments(FileName: string);
  67.   public
  68.     { Public declarations }
  69.   end;
  70.  
  71. var
  72.   Form1: TForm1;
  73.  
  74. implementation
  75.  
  76. uses
  77.   StrBox;
  78.  
  79. {$R *.DFM}
  80.  
  81. procedure TForm1.CountClick(Sender: TObject);
  82. var
  83.   i: Integer;
  84.   B: TBookmark;
  85. begin
  86.   B := Table1.GetBookmark;
  87.   i := 0;
  88.   DataSource1.Enabled := False;
  89.   Table1.First;
  90.   while not Table1.EOF do begin
  91.     Table1.Next;
  92.     Inc(i);
  93.   end;
  94.   Table1.GotoBookmark(B);
  95.   Table1.FreeBookmark(B);
  96.   DataSource1.Enabled := True;
  97.   MessageDlg('Total: ' + IntToStr(i), mtInformation, [mbok], 0);
  98. end;
  99.  
  100. procedure TForm1.GetComments(FileName: string);
  101. var
  102.   F: System.Text;
  103.   FName, S: string;
  104.   Done: Boolean;
  105. begin
  106.   Done := False;
  107.   FName := ExtractFilePath(FileName);
  108.   FName := FName + '\main.pas';
  109.   if not FileExists(FName) then exit;
  110.   System.Assign(F, FName);
  111.   System.Reset(F);
  112.   ReadLn(F, S);
  113.   while (not Done) and (not EOF(F)) do begin
  114.     ReadLn(F, S);
  115.     if Pos('interface', S) = 0 then
  116.       dbMemo1.Lines.Add(S)
  117.     else
  118.       Done := True;
  119.   end;
  120.   System.Close(F);
  121. end;
  122.  
  123. procedure TForm1.FileIterator1FoundFile(FileName: String; SR: TSearchRec);
  124. var
  125.   ChapName, S: string;
  126. begin
  127.   Table1.Insert;
  128.   Table1.FieldByName('Program').AsString := UpperCase(ExtractFileName(FileName));
  129.   S := ExtractFilePath(FileName);
  130.   S := Shorten(S, 1);
  131.   S := StripLastToken(S, '\');
  132.   ChapName := GetLastToken(S, '\');
  133.   Table1.FieldByName('Chapter').AsString := ChapName;
  134.   GetComments(FileName);
  135.   Table1.Post;
  136. end;
  137.  
  138. procedure TForm1.FormCreate(Sender: TObject);
  139. begin
  140.   Table1.Open;
  141. end;
  142.  
  143. procedure TForm1.ReLoad1Click(Sender: TObject);
  144. var
  145.   S: string;
  146. begin
  147.   S := 'This option deletes all current entries and rebuilds the listings.';
  148.   S := S + 'Don''t choose this option unless you sure you know what you''re doing.';
  149.   if MessageDlg(S, mtConfirmation, [mbOk, mbCancel], 0) = id_Cancel then Exit;
  150.   Table1.EmptyTable;
  151.   FileIterator1.Run('*.dpr', 'c:\unleash');
  152. end;
  153.  
  154. procedure TForm1.Search1Click(Sender: TObject);
  155. var
  156.   S: string;
  157. begin
  158.   S := '';
  159.   if not InputQuery('Program Name', 'Enter name: ', S) then Exit;
  160.   Table1.IndexName := 'PROG_NDX';
  161.   Table1.SetKey;
  162.   Table1.FieldByName('Program').AsString := UpperCase(S);
  163.   Table1.GotoNearest;
  164. end;
  165.  
  166. procedure TForm1.Indexes1Click(Sender: TObject);
  167. const
  168.   inNone = 100;
  169.   inPrograms = 101;
  170.   inChapters = 102;
  171. begin
  172.   case (Sender as TMenuItem).Tag of
  173.     inNone: Table1.IndexName := '';
  174.     inPrograms: Table1.IndexName := 'PROG_NDX';
  175.     inChapters: Table1.IndexName := 'CHAP_NDX';
  176.   end;
  177. end;
  178.  
  179. end.
  180.