Проектирование программы оболочки

1. постановка  задачи

Написать  программу по типу FAR, NC, проводник, по переходу по директориям на текущем  носителе. Выделить при отображении  файлов в текущей директории с  заданным атрибутом цветом, отличающимся от остальных файлов. Внутри файлов найти количество повторений слова длиной заданной преподавателем. Файлы обрабатывать как нетипизированные. Не менее 5 примеров подготовить заранее. В число примеров обязательно должны быть включены файлы, в которых слово начинается в одном блоке и заканчивается в другом. Лабораторную работу можно писать в среде Delphi или Turbo Pascal.

Вариант №6: длина слова — 7, атрибут файла — скрытый, цвет выделения — красный.

 

2. текст программы

unit Explorer; 

interface 

uses

  Windows, Messages, SysUtils,ShellApi, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ComCtrls, Grids, XPMan, ActnMan,

  ActnColorMaps, XPStyleActnCtrls, ActnList, ExtCtrls, Buttons; 

type

  TForm1 = class(TForm)

    Panel1: TPanel;

    ComboBox1: TComboBox;

    ListBox1: TListBox;

    Button1: TButton;

    GroupBox1: TGroupBox;

    edSearch: TEdit;

    Memo1: TMemo;

    Procedure DirFileInListBox;

    procedure FormCreate(Sender: TObject);

    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;

      Rect: TRect; State: TOwnerDrawState);

    procedure ComboBox1Click(Sender: TObject);

    procedure ListBox1DblClick(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

  SR:TSearchRec;

  strDrive,str,str1,str2:string;

  indextemp:integer; 
 
 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject);

var

  intTypeDrive:integer;

  i:integer;

begin

  {определяем  место нахождения программы}

  Panel1.Caption:=ExtractFilePath(Application.EXEName);

  {определяем доступные диски +}

  for i:=65 to 90 do

   begin

    str:=chr(i)+':\';

    intTypeDrive:=GetDriveType(PChar(str));

    case intTypeDrive of

    0:               strDrive:=str+' (Тип устройство невозможно определить)';

     1:               strDrive:=str+' (Корневого каталога не существует)';

     DRIVE_REMOVABLE: strDrive:=str+' (Съемное устройство памяти)';

     DRIVE_FIXED:     strDrive:=str+' (Несъемное устройство памяти)';

     DRIVE_REMOTE:    strDrive:=str+' (Удаленное (сетевое) устройство памяти)';

     DRIVE_CDROM:     strDrive:=str+' (Компак-диск)';

     DRIVE_RAMDISK:   strDrive:=str+' (Псевдодиск в ОЗУ)';

    end;

    if not ((intTypeDrive=0) or (intTypeDrive=1)) then

     ComboBox1.Items.Add(strDrive);

   end;

  {выбор диска}

  for i:=1 to ComboBox1.Items.Count do

   begin

    str:=ComboBox1.Items.Strings[i];

    str1:=copy(Panel1.Caption,1,3);

    str2:=copy(ComboBox1.Items.Strings[i],1,3);

    if str1=str2 then ComboBox1.SelText:=str;

   end; 

  DirFileInListBox;

end; 

Procedure TForm1.DirFileInListBox;{определение  файлов}

begin

  ListBox1.Clear;

  FindFirst((Panel1.Caption + '*'), faAnyFile, SR);

  if SR.Name='.' then FindNext(SR);

  repeat

   ListBox1.Items.Add(SR.Name);

  until FindNext(SR)<>0;

  FindClose(SR);

end; 
 

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;

  Rect: TRect; State: TOwnerDrawState);

begin

  With ( Control As TListBox ).Canvas Do

    Begin

       begin

        if (FileGetAttr(panel1.Caption+ ListBox1.Items.Strings[index]) and faHidden)=faHidden

          then

            begin

              Font.Color:=clRed; // цвет текста

              Brush.Color:=clWhite;   // цвет фона за  текстом

            end

          else

            begin

              Font.Color:=clBlack;

              Brush.Color:=clWhite;

            end;

         FillRect(Rect);

         TextOut(Rect.Left, Rect.Top, ( Control As TListBox ).Items[Index]);

       end;

    end;

end; 

procedure TForm1.ComboBox1Click(Sender: TObject);

begin

  indextemp:=Combobox1.ItemIndex;

  Panel1.Caption:=Copy(ComboBox1.Items.Strings[indextemp],1,3);

  {определение  файлов}

  ListBox1.Clear;

  FindFirst((panel1.Caption + '*'), faAnyFile, SR);

  if not GetLastError=INVALID_HANDLE_VALUE then

    begin

      if (SR.Name='.') then FindNext(SR);

        repeat

          ListBox1.Items.Add(SR.Name);

        until FindNext(SR)<>0;

    end;

  FindClose(SR);

end; 

procedure TForm1.ListBox1DblClick(Sender: TObject);

var Itm:integer;

begin

  Itm:=ListBox1.ItemIndex;

  if (ListBox1.ItemIndex=0) and (Length(Panel1.Caption)>3) then

    begin

      Panel1.Caption:=copy(panel1.Caption,1,Length(panel1.Caption)-1);

      Panel1.Caption:=ExtractFilePath(Panel1.Caption);

      DirFileInListBox

    end

  else

    if (FileGetAttr(panel1.Caption+ ListBox1.Items.Strings[Itm]) and faDirectory)=faDirectory

      then

        begin

          Panel1.Caption:=Panel1.Caption+ListBox1.Items.Strings[Itm]+'\';

          DirFileInListBox;

        end;

end; 

procedure TForm1.Button1Click(Sender: TObject);

var WordSearch:array [1..7] of char;

    F:file of char;

    CountWord,Possition,CountRead,index,At:integer;

begin

  Memo1.Clear; //поиск

  At:=0;

  if Length(edSearch.Text)<>7 then Memo1.Lines.Add('Искомое слово должно  содержать 7 символов!')

  else

    for index:=0 to ListBox1.Count-1 do

      begin

        if (ExtractFileExt(panel1.Caption+ ListBox1.Items.Strings[index]))='.txt' then

          begin

            At:= FileGetAttr(panel1.Caption+ ListBox1.Items.Strings[index]);

            if At and faHidden <> 0 then

              begin

                FileSetAttr((panel1.Caption+ ListBox1.Items.Strings[index]), At - faHidden );

              end;

            AssignFile(F,(panel1.Caption+ ListBox1.Items.Strings[index]));

            Reset(F);

            CountWord:=0;

            Possition:=0;

            CountRead:=7;

            while (not EOF(F)) and (CountRead=7) do

              begin

                BlockRead(F,WordSearch,7,CountRead);

                if WordSearch=edSearch.Text

                then

                  begin

                    CountWord:=CountWord+1;

                    Possition:=Possition+7;

                  end

                else

                  begin

                    Possition:=Possition+1;

                  end;

                Seek(F,Possition);

              end;

            Memo1.Lines.Add(inttostr(CountWord)+'     '+ListBox1.Items.Strings[index]);

            CloseFile(F);

            if At and faHidden <> 0 then

              begin

                FileSetAttr((panel1.Caption+ ListBox1.Items.Strings[index]), faHidden);

                At:=0;

              end;

          end;

      end;

end; 

end.  

 

3. Результаты  работы

Рис. 1. Результаты работы

Программа тестировалась с использованием следующих слов Windows, colspan, Session, bgcolor, Request.