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

📄 main.pas

📁 数据安全专家(BSE)开源发布
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    ListItem := ResultsList.Selected;  
  if ListItem = nil then Exit;

  dcShellProperties.ShowPropertiesByFile(ListItem.Caption);
end;

procedure TForm1.DiskScannerResultsMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ListItem: TListItem;
begin
  if Button = mbRight then
   begin
    if PageControl.ActivePage = DiskScannerSheet then
      ListItem := DiskScannerResults.Selected
    else
      ListItem := ResultsList.Selected;
    if ListItem = nil then Exit;

    dcShellProperties.ShowContextMenuByFile(ListItem.Caption);
   end; 
end;

procedure TForm1.GetDiskInfoClick(Sender: TObject);
var
  DriveNum: Integer;
  St: String;

  ListItem: TListItem;
begin
  DiskInfoView.Items.Clear;

  for DriveNum := 1 to Length(dcDiskInfo1.AvailableDrives) do
   begin
    dcDiskInfo1.Disk := dcDiskInfo1.AvailableDrives[DriveNum];

    ListItem := DiskInfoView.Items.Add;
    ListItem.Caption := dcDiskInfo1.Disk;
    ListItem.SubItems.Add(dcDiskInfo1.SerialNumberStr);

    if dcDiskInfo1.DriveType <> dtNoDrive then
     begin
      ListItem.ImageIndex := dcDiskInfo1.SysImageIndex;
      ListItem.SubItems.Add(dcDiskInfo1.FileSystem);

      case dcDiskInfo1.DriveType of
        dtCDROM: St := 'CD-ROM';
        dtFixed: St := 'Fixed';
        dtFloppy: St := 'Floppy';
        dtNetwork: St := 'Network';
        dtRAM: St := 'RAM';
        dtVirtual: St := 'Virtual';
        dtUnknown: St := 'Unknown';
       end;

      ListItem.SubItems.Add(St);
      ListItem.SubItems.Add(FloatToStr(dcDiskInfo1.DiskSize / 1024) + ' Kb');
      ListItem.SubItems.Add(FloatToStr(dcDiskInfo1.DiskFree / 1024) + ' Kb');
     end
    else
     begin
      ListItem.SubItems.Add('No Disk');
      ListItem.SubItems.Add('No Disk');
     end;
   end;
end;

procedure TForm1.GetBtnClick(Sender: TObject);
begin
  dcFileAssociation1.EXTENSION := ExtEdit.Text;
  ExtIconsBox.Visible := True;

  with ExtListBox, dcFileAssociation1 do
   begin
    Clear;
    Items.Add('Executable file: ' + ExecutableFile);
    Items.Add('Parameters: ' + ParamString);
    Items.Add('Icon file: ' + IconFile + '; Index: ' + IntToStr(IconIndex));
    Items.Add('File type: ' + FileDescription);
    Items.Add('Extension description: ' + ExtDescription);
   end;

  ExtLargeIcon.Picture.Icon.Assign(dcFileAssociation1.LargeIcon);
  ExtSmallIcon.Picture.Icon.Assign(dcFileAssociation1.SmallIcon);
end;

procedure TForm1.InstallTestExtensionBtnClick(Sender: TObject);
begin
  with dcFileAssociation1 do
   begin
    AccessMode := amReadWrite;
    EXTENSION := 'test';
    FileDescription := 'Test File';
    ExecutableFile := Application.ExeName;
    ParamString := '%1';
    IconFile := Application.ExeName;
    IconIndex := 1;
   end;
end;

procedure TForm1.UninstallTestExtensionBtnClick(Sender: TObject);
begin
  dcFileAssociation1.UninstallExtension('test');
end;

procedure TForm1.GetShellIconBtnClick(Sender: TObject);
begin
  dcShellIcon.FileName := ShObjectEdit.Text;
  ShIconsBox.Visible := True;

  ShListBox.Clear;
  ShListBox.Items.Add('File name: ' + dcShellIcon.FileName);  
  ShListBox.Items.Add('Display name: ' + dcShellIcon.DisplayName);
  ShListBox.Items.Add('File type: ' + dcShellIcon.FileType);
  ShLargeIcon.Picture.Icon.Assign(dcShellIcon.LargeIcon);
  ShSmallIcon.Picture.Icon.Assign(dcShellIcon.SmallIcon);
end;

procedure TForm1.DereferenceBoxClick(Sender: TObject);
begin
  if DereferenceBox.Checked then
    dcShellIcon.Options := dcShellIcon.Options + [ioDereferenceShellLinks]
  else
    dcShellIcon.Options := dcShellIcon.Options - [ioDereferenceShellLinks];

  GetShellIconBtnClick(nil);    
end;

procedure TForm1.LinkBoxClick(Sender: TObject);
begin
  if LinkBox.Checked then
    dcShellIcon.Options := dcShellIcon.Options + [ioLinkOverlay]
  else
    dcShellIcon.Options := dcShellIcon.Options - [ioLinkOverlay];

  GetShellIconBtnClick(nil);
end;

procedure TForm1.OpenBoxClick(Sender: TObject);
begin
  if OpenBox.Checked then
    dcShellIcon.Options := dcShellIcon.Options + [ioOpen]
  else
    dcShellIcon.Options := dcShellIcon.Options - [ioOpen];

  GetShellIconBtnClick(nil);
end;

procedure TForm1.SelectedBoxClick(Sender: TObject);
begin
  if SelectedBox.Checked then
    dcShellIcon.Options := dcShellIcon.Options + [ioSelected]
  else
    dcShellIcon.Options := dcShellIcon.Options - [ioSelected];

  GetShellIconBtnClick(nil);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LinkTargetEdit.Text := LowerCase(Application.ExeName);
  CRCFilenameEdit.Text := LowerCase(Application.ExeName);
  dcFileCRC1.FILENAME := Application.ExeName;
  CRCMethodCombo.ItemIndex := 0;
  CRCResult.Text := IntToStr(dcFileCRC1.CRC);
  CRCResultHex.Text := IntToHex(dcFileCRC1.CRC, 8);

  { FolderListView }
  ViewStyleComboBox.ItemIndex := Integer(dcFolderListView1.ViewStyle);
  case dcFolderListView1.ViewStyle of
    vsIcon: LargeIcons1.Checked := True;
    vsSmallIcon: SmallIcons1.Checked := True;
    vsList: List1.Checked := True;
    vsReport: Report1.Checked := True;
   end;
  case dcFolderListView1.SortColumn of
    1: byType1.Checked := True;
    2: bySize1.Checked := True;
    3: byDate1.Checked := True;
    else byName1.Checked := True;
   end;
  if dcFolderListView1.SortDirection = sdAscending then
    Ascending1.Checked := True
  else
    Descending1.Checked := True;
  { *** ***** *** }

  if ParamCount <> 0 then
   ShowMessage('We have to process the "' + ParamStr(1) + '" file !');
end;

procedure TForm1.GetShortcutInfoBtnClick(Sender: TObject);
begin
  if dcOpenShortcutDialog.Execute then
   begin
    dcShellLink.FileName := dcOpenShortcutDialog.FileName;
    ShortcutIconsBox.Visible := True;

    ShortcutListBox.Clear;
    ShortcutListBox.Items.Add('File Name: ' + dcShellLink.FileName);
    ShortcutListBox.Items.Add('Short Description: ' + dcShellLink.ShortDescription);
    ShortcutListBox.Items.Add('Link Target: ' + dcShellLink.LinkTarget);
    ShortcutListBox.Items.Add('Run Parameters: ' + dcShellLink.Parameters);
    ShortcutListBox.Items.Add('Working Directory: ' + dcShellLink.WorkingDirectory);
    ShortcutListBox.Items.Add('Hot Key: ' + ShortcutToText(dcShellLink.HotKey));
    ShortcutListBox.Items.Add('Icon Location: ' + dcShellLink.IconLocation + '; Index: ' + IntToStr(dcShellLink.IconIndex));

    ShortcutLargeIcon.Picture.Icon.Assign(dcShellLink.LargeIcon);
    ShortcutSmallIcon.Picture.Icon.Assign(dcShellLink.SmallIcon);
   end;
end;

procedure TForm1.SaveShellLinkBtnClick(Sender: TObject);
begin
  if dcSaveShortcutDialog.Execute then
   begin
    dcShellLink.LinkTarget := LinkTargetEdit.Text;
    dcShellLink.Parameters := RunParamsEdit.Text;
    dcShellLink.WorkingDirectory := WorkingDirEdit.Text;
    dcShellLink.SaveToFile(dcSaveShortcutDialog.FileName);
   end;
end;

procedure TForm1.CRCMethodComboChange(Sender: TObject);
begin
  dcFileCRC1.Method := TdcFileCRCMethod(CRCMethodCombo.ItemIndex);
  CRCResult.Text := IntToStr(dcFileCRC1.CRC);
  CRCResultHex.Text := IntToHex(dcFileCRC1.CRC, 8);
end;

procedure TForm1.DiskScannerSuspendedClick(Sender: TObject);
begin
  dcDiskScanner.Suspended := DiskScannerSuspended.Checked;
end;

procedure TForm1.MultiDiskScannerSuspendedClick(Sender: TObject);
begin
  dcMultiDiskScanner.Suspended := MultiDiskScannerSuspended.Checked;
end;

procedure TForm1.StartFolderExit(Sender: TObject);
begin
  try
    dcDiskScanner.Folder := StartFolder.Text;
  except
    StartFolder.SetFocus;
    raise
  end;
end;

procedure TForm1.ShObjectEditDlgOk(Sender: TObject);
begin
  GetShellIconBtnClick(nil);
end;

procedure TForm1.CRCFilenameEditDlgOk(Sender: TObject);
begin
  dcFileCRC1.FILENAME := CRCFilenameEdit.Text;
  CRCResult.Text := IntToStr(dcFileCRC1.CRC);
  CRCResultHex.Text := IntToHex(dcFileCRC1.CRC, 8);
end;

procedure TForm1.dcFolderEdit1DlgOk(Sender: TObject);
begin
  dcFolderListView1.Folder := dcFolderEdit1.Text;
  dcFolderMonitor1.Folder := dcFolderEdit1.Text;
  UpBtn.Enabled := dcFolderListView1.IsBackPossible;
end;

procedure TForm1.ViewStyleComboBoxChange(Sender: TObject);
begin
  if (Sender = nil) or not (Sender is TComponent) then Exit;

  LargeIcons1.Checked := False;
  SmallIcons1.Checked := False;
  List1.Checked := False;
  Report1.Checked := False;

  if (Sender as TComponent).Tag = 0 then
    dcFolderListView1.ViewStyle := TViewStyle(ViewStyleComboBox.ItemIndex)
  else
    dcFolderListView1.ViewStyle := TViewStyle((Sender as TComponent).Tag - 1);

  ViewStyleComboBox.ItemIndex := Integer(dcFolderListView1.ViewStyle);
  case dcFolderListView1.ViewStyle of
    vsIcon: LargeIcons1.Checked := True;
    vsSmallIcon: SmallIcons1.Checked := True;
    vsList: List1.Checked := True;
    vsReport: Report1.Checked := True;
   end;
end;

procedure TForm1.byName1Click(Sender: TObject);
begin
  if Sender <> nil then
   begin
    if not (Sender is TComponent) then Exit;
    if (Sender as TComponent).Tag < 4 then
      dcFolderListView1.SortColumn := (Sender as TComponent).Tag
    else
      dcFolderListView1.SortDirection := TdcListViewSortDirection((Sender as TComponent).Tag - 10);
   end;

  with dcFolderListView1 do
   begin
    byName1.Checked := SortColumn = 0;
    bySize1.Checked := SortColumn = 1;
    byType1.Checked := SortColumn = 2;
    byDate1.Checked := SortCOlumn = 3;
    Ascending1.Checked := SortDirection = sdAscending;
    Descending1.Checked := SortDirection = sdDescending;
   end; 
end;

procedure TForm1.dcFolderListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  byName1Click(nil);
end;

procedure TForm1.dcFolderListView1FolderChanged(Sender: TObject;
  Folder: String);
begin
  dcFolderEdit1.Text := Folder;
  dcFolderMonitor1.Folder := Folder;
  UpBtn.Enabled := dcFolderListView1.IsBackPossible;
end;

procedure TForm1.UpBtnClick(Sender: TObject);
begin
  dcFolderListView1.Back;
end;

procedure TForm1.dcFolderListView1BeginUpdate(Sender: TObject);
begin
  Animate1.Active := True;
  Animate1.Visible := True;
end;

procedure TForm1.dcFolderListView1EndUpdate(Sender: TObject);
begin
  Animate1.Visible := False;
  Animate1.Active := False;
end;

procedure TForm1.dcFolderMonitor1Change(Sender: TObject);
begin
  dcFolderListView1.Refresh;
end;

procedure TForm1.ShowFileExtensionsBoxClick(Sender: TObject);
begin
  dcFolderListView1.ShowFileExtensions := ShowFileExtensionsBox.Checked;
end;

procedure TForm1.ShowFoldersBoxClick(Sender: TObject);
begin
  with dcFolderListView1 do
   if ShowFoldersBox.Checked then
     FileAttributes := FileAttributes + [saDirectory]
   else
     FileAttributes := FileAttributes - [saDirectory]   
end;

procedure TForm1.SizeBoxClick(Sender: TObject);
begin
  dcFolderListView1.ReportColumns.Size.Visible := SizeBox.Checked;
end;

procedure TForm1.TypeBoxClick(Sender: TObject);
begin
  dcFolderListView1.ReportColumns.FileType.Visible := TypeBox.Checked;
end;

procedure TForm1.ModifiedBoxClick(Sender: TObject);
begin
  dcFolderListView1.ReportColumns.Modified.Visible := ModifiedBox.Checked;
end;

procedure TForm1.AttributesBoxClick(Sender: TObject);
begin
  dcFolderListView1.ReportColumns.Attributes.Visible := AttributesBox.Checked;
end;

procedure TForm1.MaskComboBoxChange(Sender: TObject);
begin
  dcFolderListView1.FileMask := MaskComboBox.Text;
end;

procedure TForm1.Refresh1Click(Sender: TObject);
begin
  dcFolderListView1.Refresh;
end;

procedure TForm1.Folder1Click(Sender: TObject);
begin
  dcFolderListView1.CreateFolder('New Folder', True);
end;

procedure TForm1.Shortcut1Click(Sender: TObject);
begin
  dcFolderListView1.CreateShortcut;
end;

procedure TForm1.Properties1Click(Sender: TObject);
begin
  dcFolderListView1.ShowFolderProperties;
end;

end.

⌨️ 快捷键说明

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