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

📄 config.pas

📁 该程序用D5编译
💻 PAS
字号:
unit Config;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Buttons, ExtCtrls, Spin,CommCtrl;

type
  TConfigForm = class(TForm)
    SpeedButton1: TSpeedButton;
    ConfigPageCtrl: TPageControl;
    FilterTabSheet: TTabSheet;
    BtnAddFilter: TSpeedButton;
    Label1: TLabel;
    BtnDelFilter: TSpeedButton;
    EditFilter: TEdit;
    CheckBox1: TCheckBox;
    ConfigTabSheet: TTabSheet;
    Bevel2: TBevel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    RadioGroup1: TRadioGroup;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    UserTabSheet: TTabSheet;
    GroupBox1: TGroupBox;
    Label7: TLabel;
    edtDftUser: TEdit;
    Label8: TLabel;
    edtDftPass: TEdit;
    btnChangeDft: TButton;
    btnSaveDft: TButton;
    Label6: TLabel;
    lvMountList: TListView;
    edtHost: TEdit;
    edtUser: TEdit;
    edtPass: TEdit;
    btnSave: TButton;
    btnChange: TButton;
    btnDelete: TButton;
    btnAdd: TButton;
    FilterPageCtrl: TPageControl;
    DestTabSheet: TTabSheet;
    DestListBox: TListBox;
    Mp3FilterTabSheet: TTabSheet;
    Mp3ListBox: TListBox;
    MovieDestTabSheet: TTabSheet;
    MovieListBox: TListBox;
    Bevel4: TBevel;
    AdvanceTabSheet: TTabSheet;
    cbNoPass: TCheckBox;
    procedure BtnAddFilterClick(Sender: TObject);
    procedure FilterPageCtrlChange(Sender: TObject);
    procedure BtnDelFilterClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure btnChangeDftClick(Sender: TObject);
    procedure btnSaveDftClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnChangeClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    CurFilterList:TListBox;
    BakUser, BakPass: string;
  public
    { Public declarations }
    function CheckDest(s: string):boolean;
    function CheckMP3(s: string):boolean;
    function CheckMovie(s: string):boolean;
    procedure GiveUserPassWord(Host: string; var User: string; var PassWord: string);
  end;

var
  ConfigForm: TConfigForm;

implementation
uses Main;
{$R *.DFM}

procedure TConfigForm.GiveUserPassWord(Host: string; var User: string; var PassWord: string);
var
  i: integer;
  s: string;
begin

  if edtDftUser.Color = clWhite then
  begin
    User := BakUser;
    PassWord := BakPass;
  end
  else
  begin
    User := edtDftUser.Text;
    PassWord := edtDftPass.Text;
  end;

  for i := 0 to lvMountList.Items.Count-1 do
  begin
    s := lvMountList.Items[i].Caption;
    if s[1] <> '\' then s := '\\' + s;
    if UpperCase(trim(Host)) =  UpperCase(trim(s)) then
    begin
      User := lvMountList.Items[i].SubItems[0];
      PassWord := lvMountList.Items[i].SubItems[1];
    end;
  end;

end;

function TConfigForm.CheckDest(s:String):boolean;
var
  i: integer;
begin

  Result:=false;
  for i:=1 to DestListBox.items.Count do
  if pos(lowercase(DestListBox.items[i-1]),lowercase(s))<>0 then Result:=true;

end;

function TConfigForm.CheckMP3(s:String):boolean;
var
  i: integer;
begin

  Result := false;
  for i:=1 to Mp3ListBox.items.Count do
  if pos(lowercase(Mp3ListBox.items[i-1]),lowercase(s))<>0 then Result:=true;

end;

function TConfigForm.CheckMovie(s:String):boolean;
var
  i: integer;
begin

  Result := false;
  for i:=1 to MovieListBox.items.Count do
  if pos(lowercase(MovieListBox.items[i-1]),lowercase(s))<>0 then Result:=true;
  
end;

procedure TConfigForm.BtnAddFilterClick(Sender: TObject);
var
  i,ImageIndex  : integer;
  s             : string;
  CurLV         : TListView;
  LI            : TListItem;
  SL            : TStringList;
begin

  CurFilterList.Items.Add(EditFilter.text);
  if CheckBox1.Checked then
  begin

    Case FilterPageCtrl.ActivePageIndex of
    //0: begin CurLV:=MainForm.FindListView; SL:=MainForm.StrListSearch; end;
    1: begin CurLV:=MainForm.MP3ListView; SL:=MainForm.StrListMp3; end;
    2: begin CurLV:=MainForm.MovieListView; SL:=MainForm.StrListMovie; end;
    else begin CurLV:=MainForm.FindListView; SL:=MainForm.StrListSearch; end;
    end; //end of case

    with MainForm do
    begin
      for i:= 0 to AllListBox.Items.Count-1 do
      begin
        s:= AllListBox.Items[i];
        if s[length(s)]='\' then
        begin
          ImageIndex:=0;
          delete(s,length(s),1);
        end
        else ImageIndex:=1;
        
        if pos(lowercase(EditFilter.text),lowercase(s))<>0 then
        begin
          LI:=CurLV.Items.Add;
          LI.ImageIndex := ImageIndex;
          LI.Caption := extractfilename(s);
          LI.SubItems.add(ExtractFilePath(s));
          LI.SubItems.add('unknow');
          SL.Add(' 工作组:'+'unknow'+' 地址:'+ExtractFilePath(s)+'\'+s);
        end;
      end;
    end;

  end;
  EditFilter.Clear;

end;

procedure TConfigForm.FilterPageCtrlChange(Sender: TObject);
begin

  Case FilterPageCtrl.ActivePageIndex of
  0:CurFilterList:=DestListBox;
  1:CurFilterList:=Mp3ListBox;
  2:CurFilterList:=MovieListBox;
  end; //end of case
  
end;

procedure TConfigForm.BtnDelFilterClick(Sender: TObject);
begin
  CurFilterList.Items.Delete(CurFilterList.ItemIndex);
end;

procedure TConfigForm.FormCreate(Sender: TObject);
begin

   CurFilterList:=DestListBox;
   RadioGroup1.ItemIndex := 0;
   if bk<>nil then Brush.Bitmap :=  bk;
   //ConfigPageCtrl.Brush.Bitmap :=  MainForm.coolbar1.Bitmap;
   //FilterPageCtrl.Brush.Bitmap :=  MainForm.coolbar1.Bitmap;
   ConfigPageCtrl.ActivePageIndex := 0;

end;

procedure TConfigForm.RadioGroup1Click(Sender: TObject);
begin

  case RadioGroup1.ItemIndex of
  0:begin
    recursive:=false;
    bAutoSearch:=true;
    end;
  1:begin
    recursive:=false;
    bAutoSearch:=false;
    end;
  2:begin
    recursive:=true;
    bAutoSearch:=true;
    end;
  end;   //end of case

end;

procedure TConfigForm.SpinEdit1Change(Sender: TObject);
begin
  ThreadNum:=SpinEdit1.Value;
end;

procedure TConfigForm.SpeedButton1Click(Sender: TObject);
begin
  Close;
end;

procedure TConfigForm.btnChangeDftClick(Sender: TObject);
begin
  BakUser := edtDftUser.Text;
  BakPass := edtDftPass.Text;

  edtDftUser.Enabled := true;
  edtDftUser.Color := clWhite;
  edtDftPass.Enabled := true;
  edtDftPass.Color := clWhite;
  edtDftUser.SetFocus;
end;

procedure TConfigForm.btnSaveDftClick(Sender: TObject);
begin
  edtDftUser.Text := trim(edtDftUser.Text);
  edtDftPass.Text := trim(edtDftPass.Text);
  edtDftUser.Enabled := false;
  edtDftUser.Color := color;
  edtDftPass.Enabled := false;
  edtDftPass.Color := color;
end;

procedure TConfigForm.btnAddClick(Sender: TObject);
var
  item: TListItem;
begin

  if (trim(edtHost.Text) = '')or(trim(edtUser.Text) = '') then
  begin
    ShowMessage('主机名和用户名不能为空!');
    edtHost.SetFocus;
  end
  else
  begin
    item := lvMountList.Items.Add;
    item.Caption := edtHost.Text;
    item.SubItems.Add(edtUser.Text);
    item.SubItems.Add(edtPass.Text);

    edtHost.Text := '';
    edtUser.Text := '';
    edtPass.Text := '';
  end;
  
end;

procedure TConfigForm.btnDeleteClick(Sender: TObject);
begin
  if lvMountList.Selected <> nil then lvMountList.Selected.Delete
  else ShowMessage('请选择要删除的项。');
end;

procedure TConfigForm.btnChangeClick(Sender: TObject);
begin

  if lvMountList.Selected <> nil then
  begin
    edtHost.Text := lvMountList.Selected.Caption;
    edtUser.Text := lvMountList.Selected.SubItems[0];
    edtPass.Text := lvMountList.Selected.SubItems[1];
  end
  else ShowMessage('请选择要修改的项。');

end;

procedure TConfigForm.btnSaveClick(Sender: TObject);
begin

  if lvMountList.Selected <> nil then
  begin
    if (trim(edtHost.Text) = '')or(trim(edtUser.Text) = '') then
    begin
      ShowMessage('主机名和用户名不能为空!');
      exit;
    end;
    lvMountList.Selected.Caption := edtHost.Text;
    lvMountList.Selected.SubItems[0] := edtUser.Text;
    lvMountList.Selected.SubItems[1] := edtPass.Text;
  end
  else
  ShowMessage('请选择要修改的项。');
  
end;

procedure TConfigForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin

  if edtDftUser.Color = clWhite then
  begin
    edtDftUser.Text := BakUser;
    edtDftPass.Text := BakPass;
    btnSaveDftClick(Self);
  end;
  
end;

end.

⌨️ 快捷键说明

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