::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2003-03-07 20:06:14, Hit : 7759, Vote : 1477
 컴퓨터/파일/폴더 찾기 화면 띄우기

unit uFileOpen3;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, ShellAPI, ShlObj, Buttons, OLE2, ActiveX;

type
  TForm1 = class(TForm)
    lbFiles: TFileListBox;
    lbDirectories: TDirectoryListBox;
    drvcbDrives: TDriveComboBox;
    btnFileProperties: TBitBtn;
    btnFindFiles: TBitBtn;
    btnQuit: TBitBtn;
    chkbMyComputer: TCheckBox;
    Label1: TLabel;
    btnBrowseTo: TBitBtn;
    btnSendToRecycle: TBitBtn;
    procedure btnFilePropertiesClick(Sender: TObject);
    procedure btnQuitClick(Sender: TObject);
    procedure btnFindFilesClick(Sender: TObject);
    procedure lbDirectoriesChange(Sender: TObject);
    procedure drvcbDrivesChange(Sender: TObject);
    procedure btnSendToRecycleClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lbDirectoriesEnter(Sender: TObject);
    procedure drvcbDrivesEnter(Sender: TObject);
    procedure lbFilesEnter(Sender: TObject);
    procedure btnBrowseToClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ShowProperties(sFileName :String);
    procedure SendToRecycleBin(sFileName :String);
    procedure BrowseTo(sURL, sBrowser, sDir :String);
  end;

var
  sei : TShellExecuteInfo;
  Form1: TForm1;
  b : Integer;

implementation

uses ShBrowse;
const
  AILeft = 1;
  AIRight = 2;
  AIBottom = 3;
  AITop = 4;


{$R *.DFM}

procedure TForm1.btnFilePropertiesClick(Sender: TObject);
begin
  case b of
  0:
    ShowMessage('You must select a drive, directory or file first');
  1:
    ShowProperties(drvcbDrives.Drive + ':');
  2:
    ShowProperties(lbFiles.FileName);
  3:
    ShowProperties(lbDirectories.Directory);
  end;
end;

procedure TForm1.ShowProperties(sFileName :String);
begin
  ZeroMemory(@sei, sizeof(sei));
  with sei do
  begin
    cbSize := SizeOf(sei);
    fMask  := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
    Wnd   := Form1.Handle;
    lpVerb := 'properties';
    lpFile := PChar(sFileName);
    nShow := SW_SHOWNORMAL;
  end;
  ShellExecuteEX(@sei);
end;

procedure TForm1.btnQuitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.btnFindFilesClick(Sender: TObject);
var
  pidl: PITEMIDLIST;
begin
  ZeroMemory(@sei, sizeof(sei));
  with sei do
  begin
    cbSize := SizeOf(sei);
    fMask := SEE_MASK_INVOKEIDLIST;
    lpVerb := 'find';
    if chkbMyComputer.Checked then
    begin
      SHGetSpecialFolderLocation(0,CSIDL_DRIVES,pidl);
      lpIDList := pidl;
    end
    else
    begin
      case b of
      0, 1:
        lpFile := PChar(String(drvcbDrives.Drive) + ':');
      2:
        begin
          ShowMessage('You can only use this on Drives and Directories');
          Exit;
        end;
      3:
        lpFile := PChar(lbDirectories.Directory);
      end;
    end;
  end;
  ShellExecuteEx(@sei);
end;

procedure TForm1.lbDirectoriesChange(Sender: TObject);
begin
  lbFiles.Directory := lbDirectories.Directory;
  if chkbMyComputer.Checked then
    chkbMyComputer.Checked := False;
end;

procedure TForm1.drvcbDrivesChange(Sender: TObject);
begin
  lbDirectories.Drive := drvcbDrives.Drive;
  if chkbMyComputer.Checked then
    chkbMyComputer.Checked := False;
end;

procedure TForm1.btnSendToRecycleClick(Sender: TObject);
var
s : string;
begin
  case b of
  0:
    ShowMessage('You must select a drive, directory or file first');
  1:
    ShowMessage('You can only use this on Files and Directories');
  2:
    SendToRecycleBin(lbFiles.FileName);
  3:
    begin
      s := lbDirectories.Directory;
      if Copy(s,Length(s)-1,2) = ':' then
      begin
        ShowMessage('This cannot be used on the Root directory');
        Exit;
      end;
      SendToRecycleBin(lbDirectories.Directory);
    end;
  end;
end;

procedure TForm1.SendToRecycleBin(sFileName :String);
begin
  ZeroMemory(@sei, sizeof(sei));
  with sei do
  begin
    cbSize := SizeOf(sei);
    fMask  := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
    Wnd   := Form1.Handle;
    lpVerb := 'delete';
    lpFile := PChar(sFileName);
    nShow := SW_SHOWNORMAL;
  end;
  ShellExecuteEX(@sei);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {
    Need a flag to tell if focus is on DirectoryListBox, FileListBox,
    or DriveComboBox because when the button is clicked,
    Form1.ActiveControl won't point to any of them. This flag is used
    in the case statements to operate differently on the differnet controls.
  }
  b := 0;
end;

procedure TForm1.lbDirectoriesEnter(Sender: TObject);
begin
  b := 3;
end;

procedure TForm1.drvcbDrivesEnter(Sender: TObject);
begin
  b := 1;
end;

procedure TForm1.lbFilesEnter(Sender: TObject);
begin
  b := 2;
end;

procedure TForm1.BrowseTo(sURL, sBrowser, sDir :String);
begin
  ZeroMemory(@sei, sizeof(sei));
  with sei do
  begin
    cbSize := SizeOf(sei);
    fMask  := SEE_MASK_NOCLOSEPROCESS;
    Wnd   := Form1.Handle;
    lpVerb := 'open';
    // Need to see if sBrowser empty, if so, pass url to lpFile parameter
    if sBrowser <> #0 then
      lpFile := PChar(sBrowser)
    else
      lpFile := PChar(sURL);
    lpParameters := PChar(sURL);
    lpDirectory := PChar(sDir);
    nShow := SW_SHOWNORMAL;
  end;
  ShellExecuteEX(@sei);
end;

procedure TForm1.btnBrowseToClick(Sender: TObject);
begin
  BrowseTo('http://www.informant.com/undu/index.htm', 'netscape.exe',
           '"C:Program FilesNetscapeNavigatorProgram"');
end;

end.





491   [일반/컴포넌트] TRichEdit 의 선택된 영역만 인쇄하기  김영대 2003/03/07 4496 732
490   [시스템] CPU 종류 구하기  김영대 2003/03/07 4818 1199
489   [시스템] 사운드파일 없이 PC 스피커로 음악연주  김영대 2003/03/07 4670 925
488   [네트웍/인터넷] 프로그램으로 네트워크 드라이브 연결/해제  김영대 2003/03/07 6754 1256
487   [일반/컴포넌트] 윈도우즈 종료와 같은 그늘진 화면 만들기  김영대 2003/03/07 3151 843
486   [일반/컴포넌트] 아이콘 사이트  김영대 2003/03/07 3626 1078
485   [시스템] 윈도우즈 시스템 표준 폰트 구하기  김영대 2003/03/07 3029 853
484   [네트웍/인터넷] RS232 통신  김영대 2003/03/07 6949 1856
483   [일반/컴포넌트] 주어진 영역의 화면 캡처  김영대 2003/03/07 3570 1010
482   [일반/컴포넌트] 숫자를 영문 표기로 바꾸기  김영대 2003/03/07 4255 895
481   [일반/컴포넌트] 숫자를 한글 표기로 바꾸기  김영대 2003/03/07 3628 931
480   [일반/컴포넌트] RichEdit 의 내용을 Bitmap 으로 만들기 2  김영대 2003/03/07 3796 986
479   [COM/OLE] MS-WORD 종료시키기  김영대 2003/03/07 2676 751
478   [윈도우즈 API] 시스템 사운드 연주하기  김영대 2003/03/07 4809 1303
477   [일반/컴포넌트] Algorithm to sort a TStringGrid #2  김영대 2003/03/07 4787 1206
476   [윈도우즈 API] 외부 프로그램의 좌표,상태 구하기  김영대 2003/03/07 3172 1017
475   [윈도우즈 API] 윈도우즈 Telnet 으로 호스트 접속하기  김영대 2003/03/07 4074 1117
474   [일반/컴포넌트] 특정한 폴더로 이동한 DOS 창 띄우기  김영대 2003/03/07 4118 1135
473   [시스템] DOS 명령어 실행하고 결과 받아오기  김영대 2003/03/07 6552 1549
472   [윈도우즈 API] NT의 현재 user가 administrative privilege 를 가지고 있는지?  김영대 2003/03/07 2999 816
471   [일반/컴포넌트] 두개의 StringGrid sync 마추기  김영대 2003/03/07 3710 1017
470   [일반/컴포넌트] 윈도우의 title bar 폰트 바꾸기  김영대 2003/03/07 3242 846
469   [네트웍/인터넷] 네트워크 공유 설정/해제 하기 (Windows 9x)  김영대 2003/03/07 4408 1080
468   [네트웍/인터넷] 네트워크 공유 정보 읽어오기 (WIndows 9x)  김영대 2003/03/07 3663 1003
467   [일반/컴포넌트] 눌려진 키보드 키의 명칭 구하기  김영대 2003/03/07 7384 1439
466   [윈도우즈 API] Windows98 에서의 SetForegroundWindow  김영대 2003/03/07 5753 1492
465   [윈도우즈 API] Task bar 에 나타나지 않는 프로그램 만들기  김영대 2003/03/07 5168 1510
464   [COM/OLE] Outlook 사용하기  김영대 2003/03/07 3484 1095
463   [시스템] 지정한 drive가 CD-ROM 인지 검사하기  김영대 2003/03/07 6302 1651
462   [시스템] 어떤 어플리케이션이 시작 되는지 hook으로 알아내기  김영대 2003/03/07 5143 1528
461   [윈도우즈 API] 윈도우즈 탐색기의 아이콘 뽑아내서 사용하기  김영대 2003/03/07 8039 1888
460   [윈도우즈 API] System Images  김영대 2003/03/07 6324 1830
  [윈도우즈 API] 컴퓨터/파일/폴더 찾기 화면 띄우기  김영대 2003/03/07 7759 1477
458   [일반/컴포넌트] Unix-format time 을 TDateTime 로 바꾸기  김영대 2003/03/07 4103 1122
457   [일반/컴포넌트] 실행시 component 를 Move/Resize 시키기  김영대 2003/03/07 3321 956
456   [일반/컴포넌트] TMemo 를 화면크기로 인쇄하기  김영대 2003/03/07 2784 699
455   [일반/컴포넌트] SpeedButton 에 OnMouseEnter/OnMouseExit 이벤트 넣기  김영대 2003/03/07 3962 1042
454   [윈도우즈 API] 키보드의 Scroll Lock 켜기/끄기  김영대 2003/03/07 4187 1135
453   [데이터베이스] table packing 하기  김영대 2003/03/07 3485 1006
452   [윈도우즈 API] reboot Windows  김영대 2003/03/07 3894 1122

[이전 10개] [1]..[11][12] 13 [14][15][16][17][18][19][20]..[25] [다음 10개]
 

Copyright 1999-2022 Zeroboard / skin by zero