⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fm_deleteenginnering.pas

📁 档案资料管理系统
💻 PAS
字号:
unit FM_DeleteEnginnering;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TFM_DeleteEnginnering1 = class(TForm)
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    ListBox1: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure GetDirectories(Directory: string;IncludeFiles: boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FM_DeleteEnginnering1: TFM_DeleteEnginnering1;

implementation

{$R *.dfm}

procedure TFM_DeleteEnginnering1.FormCreate(Sender: TObject);
var
 EngineerName:TSearchRec;
 EngineerNamePath:string;
begin
 EngineerNamePath:=ExtractFilePath(Application.ExeName)+'\'+'Project'+'\';
 if EngineerNamePath[length(EngineerNamePath)] <> '\' then
    EngineerNamePath := EngineerNamePath+ '\';
 if FindFirst(EngineerNamePath + '*.*',faDirectory,EngineerName) = 0 then
    begin
     repeat
      if (EngineerName.Attr and faDirectory = faDirectory) and (EngineerName.Name[1] <> '.') then
          begin
           if (EngineerName.Attr and faDirectory > 0) then
              ComboBox1.AddItem(EngineerName.Name,nil)
           end;
     until FindNext(EngineerName) <> 0;
     FindClose(EngineerName);
   end;
end;

procedure TFM_DeleteEnginnering1.ComboBox1Click(Sender: TObject);
var
 EngineerName1:TSearchRec;
 EngineerNamePath1:string;
 EngineerListCount:integer;
begin
 EngineerListCount:=0;
 While EngineerListCount<ListBox1.Items.Count do
       ListBox1.Items.Delete(EngineerListCount);
 EngineerNamePath1:=ExtractFilePath(Application.ExeName)+'\'+'Project'+'\'+ComBoBox1.Text;
 if EngineerNamePath1[length(EngineerNamePath1)] <> '\' then
    EngineerNamePath1 := EngineerNamePath1+ '\';
 if FindFirst(EngineerNamePath1+'*.*',faDirectory,EngineerName1) = 0 then
    begin
     repeat
      if (EngineerName1.Attr and faDirectory = faDirectory) and (EngineerName1.Name[1] <> '.') then
          begin
           if (EngineerName1.Attr and faDirectory > 0) then
              ListBox1.Items.Add(EngineerName1.Name)
           end;
     until FindNext(EngineerName1) <> 0;
     FindClose(EngineerName1);
   end;
end;

procedure TFM_DeleteEnginnering1.BitBtn1Click(Sender: TObject);
begin
 if (listbox1.ItemIndex<>-1) and (Combobox1.Text<>'') then
   begin
     if Application.MessageBox(PChar('确实要删除 【'+ListBox1.Items.Strings[listbox1.ItemIndex]+'】 吗?'),'真诚提醒您',MB_YESNO or MB_ICONQUESTION )=IDYes then
       begin
        GetDirectories(ExtractFilePath(Application.ExeName)+'\Project\'+Combobox1.Text+'\'+ListBox1.Items.Strings[listbox1.ItemIndex],True);
        Close;
       end;
   end
 else
    Application.MessageBox('必须要选择项目或工程','真诚提醒您',MB_OK or MB_ICONINFORMATION)
end;
procedure TFM_DeleteEnginnering1.GetDirectories(Directory: string; IncludeFiles: boolean);
var
 SearchRec: TSearchRec;
begin
 if Directory[length(Directory)] <> '\' then
    Directory := Directory + '\';
 if FindFirst(Directory + '*.*',faDirectory,SearchRec) = 0 then
    begin
     repeat
      if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
          begin
           if (SearchRec.Attr and faDirectory > 0) then
              begin
               GetDirectories(Directory + SearchRec.Name,IncludeFiles);
              end;
          end
       else if IncludeFiles then
             if SearchRec.Name[1] <> '.' then
               begin
                 DeleteFile(Directory+SearchRec.Name);
               end;
     until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
   end;
 RemoveDirectory(PChar(Directory));
end;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -