From YYpBD's MediaWiki
[빵집에서 활용된 팁 #1] IDataObject 의 구현..
IDataObject는 ActiveX에서 어떤 데이터를 처리할때 사용하는 OLE인터페이스이다.....
좀 막연한 설명인데.... 예를들자면....
뭔가를 클립보드로 복사를 할때 복사될 내용을 처리할때 이 넘이 쓰이며...
뭔가를 드래그 앤 드롭할때 드래그할 내용을 처리할때도 이 넘이 쓰인다...
빵집에서는..
IDataObject를 압축파일안에 있는 파일을 클립보드로 복사할때도 사용되었으며...
드래그앤드롭에서도 이 유닛이 사용됐다....
물론 두 가지 모두 처리되는 데이터는 파일명이다...
파일 자체나 파일 안에 내용을 가리키는 것이 아니라 파일명을 말하는것이다......
클립보드도, 드래그앤드롭도 파일명만 알면되기때문이다.....
즉, 이 유닛은 파일명을 다루는 IDataObject라고 할수 있다...
아... 실수...
클립보드와 드래그앤드롭 외에도 한가지 더 쓰였는데....
파일을 이메일에 첨부하는데서도 이게 쓰였다.....
으잉? 이메일하고 IDataObject하고 몬상관? 이라고 생각할수도 있는데....
파일을 이메일로 첨부하기와 클립보드로 복사하기는 별도의 강좌로 올리겠다
이 강좌는 그 두가지 강좌에 사용되는 공통 유닛이라고 할수 있겠따...
그럼 이하......TDataObject의 소스....
물론 양병규가 맹근거구....
마구 써도 된다......
대신 질문 사절... 알아서들 써주세여 --a (지송함다... )
unit DataObjects;
interface
uses
Windows, Classes, SysUtils, ShlObj, ActiveX, Dialogs;
type
{ TDataObject }
TDataObject = class(TInterfacedObject, IDataObject)
private
FDataFormatsCount: Integer;
FDataFormats: array[0..19] of TFormatEtc;
FOnCopyStart: TNotifyEvent;
FOnCopyStop: TNotifyEvent;
protected
{IDataObject}
function GetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium):HRESULT; stdcall;
function GetDataHere(const FormatEtc: TFormatEtc; out Medium: TStgMedium):HRESULT; stdcall;
function QueryGetData(const FormatEtc: TFormatEtc): HRESULT; stdcall;
function GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; out FormatEtcout: TFormatEtc): HRESULT; stdcall;
function SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; Release: Bool): HRESULT; stdcall;
function EnumFormatEtc(dwDirection: Integer; out EnumFormatEtc: IEnumFormatEtc): HRESULT; stdcall;
function dAdvise(const FormatEtc: TFormatEtc; advf: Integer; const advsink: IAdviseSink; out dwConnection: Integer): HRESULT; stdcall;
function dUnadvise(dwConnection: Integer): HRESULT; stdcall;
function EnumdAdvise(out EnumAdvise: IEnumStatData): HRESULT; stdcall;
{TDataObject}
procedure AddFormatEtc(cfFmt: TClipFormat; pt: PDVTargetDevice; dwAsp, lInd, tym: Longint);
public
Files: TStrings;
SrcFiles: TStrings;
constructor Create;
destructor Destroy; override;
property OnCopyStart: TNotifyEvent read FOnCopyStart write FOnCopyStart;
property OnCopyStop: TNotifyEvent read FOnCopyStop write FOnCopyStop;
end;
implementation
var
CF_FILENAMEMAP, CF_FILENAMEMAPW, CF_IDLIST, CF_PREFERREDDROPEFFECT: UINT;
type
{ TEnumFormatEtc }
PFormatList = ^TFormatList;
TFormatList = array[0..255] of TFormatEtc;
TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc)
private
FFormatList: PFormatList;
FFormatCount: Integer;
FIndex: Integer;
public
constructor Create(FormatList: PFormatList; FormatCount, Index: Integer);
{IEnumFormatEtc}
function Next(Celt: LongInt; out Elt; PCeltFetched: PLongInt): HRESULT; stdcall;
function Skip(Celt: Integer): HRESULT; stdcall;
function Reset: HRESULT; stdcall;
function Clone(out Enum: IEnumFormatEtc): HRESULT; stdcall;
end;
constructor TEnumFormatEtc.Create(FormatList: PFormatList; FormatCount, Index: Integer);
begin
inherited Create;
FFormatList := FormatList;
FFormatCount := FormatCount;
FIndex := Index;
end;
function TEnumFormatEtc.Next(Celt: LongInt; out Elt; PCeltFetched: PLongInt): HRESULT;
var
i: Integer;
begin
i := 0;
while ( i < Celt ) and ( FIndex < FFormatCount ) do
begin
TFormatList( Elt )[i] := FFormatList[FIndex];
Inc( FIndex );
Inc( i );
end;
if PCeltFetched <> nil then PCeltFetched^ := i;
if i = Celt then Result := S_OK else Result := S_FALSE;
end;
function TEnumFormatEtc.Skip(Celt: Integer): HRESULT;
begin
if Celt <= FFormatCount - FIndex then
begin
FIndex := FIndex + Celt;
Result := S_OK;
end
else
begin
FIndex := FFormatCount;
Result := S_FALSE;
end;
end;
function TEnumFormatEtc.Reset: HRESULT;
begin
FIndex := 0;
Result := S_OK;
end;
function TEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HRESULT;
begin
Enum := TEnumFormatEtc.Create( FFormatList, FFormatCount, FIndex );
Result := S_OK;
end;
{ TDataObject }
constructor TDataObject.Create;
procedure AddFmtEtc( cfFmt: TClipFormat );
begin
AddFormatEtc( cfFmt, nil, DVASPECT_CONTENT, -1, TYMED_HGLOBAL );
end;
begin
inherited Create;
Files := TStringList.Create;
SrcFiles := TStringList.Create;
FDataFormatsCount := 0;
AddFmtEtc( CF_HDROP );
AddFmtEtc( CF_IDLIST );
AddFmtEtc( CF_PREFERREDDROPEFFECT );
AddFmtEtc( CF_FILENAMEMAP );
AddFmtEtc( CF_FILENAMEMAPW );
end;
destructor TDataObject.Destroy;
begin
Files.Free;
SrcFiles.Free;
inherited Destroy;
end;
procedure TDataObject.AddFormatEtc(cfFmt: TClipFormat; pt: PDVTargetDevice; dwAsp, lInd, tym: LongInt);
begin
if FDataFormatsCount >= High( FDataFormats ) then Exit;
with FDataFormats[FDataFormatsCount] do
begin
cfFormat := cfFmt;
ptd := pt;
dwAspect := dwAsp;
lIndex := lInd;
tymed := tym;
end;
Inc( FDataFormatsCount );
end;
function TDataObject.dAdvise(const FormatEtc: TFormatEtc; advf: Integer; const advsink: IAdviseSink; out dwConnection: Integer): HRESULT;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function TDataObject.dUnadvise(dwConnection: Integer): HRESULT;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function TDataObject.EnumdAdvise(out EnumAdvise: IEnumStatData): HRESULT;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function TDataObject.EnumFormatEtc(dwDirection: Integer; out EnumFormatEtc: IEnumFormatEtc): HRESULT;
begin
if dwDirection = DATADIR_GET then
begin
EnumFormatEtc := TEnumFormatEtc.Create( @FDataFormats, FDataFormatsCount, 0 );
Result := S_OK;
end
else
if dwDirection = DATADIR_SET then
begin
Result := E_NOTIMPL;
end
else
Result := E_INVALIDARG;
end;
function TDataObject.GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; out FormatEtcout: TFormatEtc): HRESULT;
begin
Result := DATA_S_SAMEFORMATETC;
end;
function TDataObject.GetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium): HRESULT;
var
StrLength: Integer;
DropFiles: pDropFiles;
pFile: PChar;
i: Integer;
begin
Result := DV_E_FORMATETC;
if ( FormatEtcIn.cfFormat = CF_HDROP ) and
( FormatEtcIn.dwAspect = DVASPECT_CONTENT ) and
( FormatEtcIn.tymed and TYMED_HGLOBAL <> 0 ) then
begin
StrLength := 0;
for i := 0 to Files.Count - 1 do
Inc( StrLength, Length( Files[i] ) + 1 );
Medium.hGlobal := GlobalAlloc( GMEM_SHARE or GMEM_ZEROINIT, SizeOf( TDropFiles ) + StrLength + 1 );
if Medium.hGlobal = 0 then Result := E_OUTOFMEMORY
else
begin
Medium.tymed := TYMED_HGLOBAL;
DropFiles := GlobalLock( Medium.hGlobal );
try
DropFiles^.pFiles := SizeOf( TDropFiles );
DropFiles^.fwide := False;
LongInt(pFile) := LongInt( DropFiles ) + SizeOf( TDropFiles );
for i := 0 to Files.Count - 1 do
begin
StrPCopy( pFile, Files[i] );
Inc( pFile, Length( Files[i] ) );
pFile^ := #0;
Inc( pFile );
end;
pFile^ := #0;
finally
GlobalUnlock( Medium.hGlobal );
end;
Result := S_OK;
end;
end;
case LoByte( FormatEtcIn.cfFormat ) of
0, 74: if Assigned( OnCopyStart ) then FOnCopyStart( Self );
124, 136: if Assigned( OnCopyStop ) then FOnCopyStop( Self );
end;
end;
function TDataObject.GetDataHere(const FormatEtc: TFormatEtc; out Medium: TStgMedium): HRESULT;
begin
Result := E_NOTIMPL;
end;
function TDataObject.QueryGetData(const FormatEtc: TFormatEtc): HRESULT;
var
i: Integer;
begin
Result := S_OK;
for i := 0 to FDataFormatsCount-1 do
with FDataFormats[i] do
if ( FormatEtc.cfFormat = cfFormat ) and
( FormatEtc.dwAspect = dwAspect ) and
( FormatEtc.tymed and tymed <> 0 ) then Exit;
Result := E_FAIL;
end;
function TDataObject.SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; Release: Bool): HRESULT;
begin
Result := E_NOTIMPL;
end;
initialization
begin
OleInitialize( nil );
CF_IDLIST := RegisterClipboardFormat( CFSTR_SHELLIDLIST );
CF_PREFERREDDROPEFFECT := RegisterClipboardFormat( CFSTR_PREFERREDDROPEFFECT );
CF_FILENAMEMAP := RegisterClipboardFormat( CFSTR_FILENAMEMAPA );
CF_FILENAMEMAPW := RegisterClipboardFormat( CFSTR_FILENAMEMAPW );
end;
finalization
begin
OleUninitialize;
end;
end.
[빵집에서 활용된 팁 #2] 파일을 클립보드로 복사하기
파일을 클립보드로 복사하는건 의외로 간단 간단하다....
OleSetClipboard 함수가있다....
이 함수의 모양새를 보면 파바박하고 이해가 갈것이다.....
function OleSetClipboard(dataObj: IDataObject): HResult; stdcall;
파라미터가 하나 있는데 IDataObject형이다.....
클립보드로 복사할 파일명을 TDataObject로 만들어서 (요 밑에 TDataObject강좌에 소스가있다)
OleSetClipboard( DataObject ); 하면 복사가된다....
TDataObject에서 OnCopyStart는 복사한 파일을 다른 프로그램(탐색기등..)이 붙여넣기를 시작할때 발생한다..
아...그러고보니 이벤트핸들러 이름을 잘못지은것같다.... OnStartPaste라고 했어야하는디...--a
이하 소스....
이 역시 양병규가 맹글었고 맘껏 써도 좋으나...
제발 제발 묻지말고 걍 알아서들 잘 썼으면 좋겠다 ^^;;; (에혀..이젠 이말하기도 지쳤음..)
CopyDataObject := TDataObject.Create;
CopyDataObject.OnCopyStart := CopyStart; //복사된 파일을 탐색기같은데서 붙여넣기 시작할때 발생하는 이벤트.. 98에서 제대로 동작안한다
CopyDataObject.OnCopyStop := CopyStop; //붙여넣기가 끝날때...이 역시 문제가 많다
CopyDataObject.Files.Clear;
OleSetClipboard( CopyDataObject );
반대로...
클립보드에 있는 파일명을 가져오는것은 OleGetClipboard함수를 이용해서 할수 있다...
다음은 그 방법이다....
procedure GetPastedFiles( const DataObj: IDataObject; Strings: TStrings );
var
Etc: TFormatETC;
Med: TSTGMedium;
Res: Integer;
FileDropped: array [0..MAX_PATH-1] of Char;
Count, i : Integer;
S: String;
begin
Strings.Clear;
Etc.cfFormat := CF_HDROP;
Etc.ptd := nil;
Etc.dwAspect := DVASPECT_CONTENT;
Etc.lIndex := -1;
Etc.Tymed := TYMED_HGLOBAL;
Res := DataObj.GetData(Etc, Med);
if Res = S_OK then
begin
Count := DragQueryFile(HDROP(Med.HGlobal), $FFFFFFFF, nil, 0);
for i := 0 to Count-1 do
begin
DragQueryFile(HDROP(Med.HGlobal), i, FileDropped, SizeOf(FileDropped));
S := StrPas( FileDropped );
Strings.Add( S );
end;
end;
end;
function ClipboardIsFile: Boolean;
var
DataObj: IDataObject;
Strings: TStrings;
begin
Result := False;
if OleGetClipboard( DataObj ) = S_OK then
begin
Strings := TStringList.Create;
try
GetPastedFiles( DataObj, Strings );
Result := Strings.Count > 0;
finally
Strings.Free;
end;
end;
end;
[빵집에서 활용된 팁 #3] 파일을 이메일에 첨부하기
많은 압축 유틸리티들이 파일을 메일에 첨부하는 기능을 가지고 있어서...
당연히 빵집에서도 그것을 흉내내지 않으면 안되는 상황이었다....
해서....
고심을 해봤는디.....
젤루 확실한 방법은 "파일이 첨부된 메일을 작성중" 상태인 *.eml 파일을 생성해서 그것을 셸로 실행시키는 것이 젤루 확실할것 같았다....
음.... 이해가 안된다면 함 해보라....
아웃룩익스프레스(오피스아웃룩에서도 될라나?)에서 메일을 작성하자.... 파일도 하나 첨부하자....
보내기를 하지 말고 작성중인채로 메일을 파일로 저장한다... *.eml파일로.....
그리고 저장된 eml파일을 더블클릭하면 메일프로그램이 뜬다.... 파일이 첨부되고 작성중인 상태로....
그점을 이용해서... eml파일을 생성해서 셸로 실행하면 될것이다...
아씨... 근디 ,,, 그게 어디 간단해야 말이쥐 ^^;; 당췌 구찮아서...원...
해서 나는... 좀더 간단하고 10분안에 만들수없을까 하고 고심을 하다가......
탐색기에서 파일을 하나 선택하고 오른쪽 메뉴에서 "보내기 -> 편지 수신자"가 생각났다...
해서 그것이 어케 구현됐는가를 추적했는디...
원리는 간단했다....
편지 수신자라는 메뉴는 확장자가 *.MAPIMAIL 인 파일에 불과하다.....
함 해보자....
메모장을 실행해서 암것도 쓰지말고 바로 저장한다.....
바탕화면에다가 1234.MAPIMAIL 로 저장하자 ... 확장자가 8자다..
그리고 어떤 파일을 드래그해다가 바탕화면에 생긴 1234.MAPIMAIL 에다가 떨궈보자....
그러면 그 어떤 파일을 첨부한채로 메일 작성 프로그램이 뜰것이다.....
그 이후로는 간단했다.....
어떤 파일을 메일로 첨부할때 *.MAPIMAIL 파일에다가 드롭한것과 같은 효과를 내면 되는것이었따.....
해서....
메일로 첨부할 파일명을 IDataObject로 처리하고...(요 밑에 IDataObject강좌에 소스가있다)
.MAPIMAIL파일의 드롭핸들러 GUID인 {9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}로 (레지스트리를 뒤져서 알았다..) IDropTarget를 생성해다가...
DropTarget.Drop( DataObject, ... 이렇게하면 ...
DataObject이 가리키는 파일명을 .MAPIMAIL파일에다가 떨궈놓는것과 같은 효과가 나타난다.....
한가지 단점이 있다면 .MAPIMAIL파일이 한번에 한개씩밖에 첨부를 못한다....
해서... 빵집에서도 한개씩밖에 첨부를 못한다.....
물론 eml파일을 생성하면 그 문제는 극복할수 있겠지만....
필요성대 작업성을 따져보면... 이정도로 만족한다.....
아래는 .MAPIMAIL파일에 떨구기 효과를 이용한 파일을 메일에 첨부하기 소스....
물론 이 역시 양병규가 맹글었고....
맘껏써도 좋으나..... 제발 묻지말고... 걍 조용히 썼으면 좋겠다......
procedure AttachMail( AttachFileName: String );
const
CLSID_SendMailDropTarget: TGUID = '{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}';
var
DropTarget: IDropTarget;
DataObject: TDataObject;
Effect: Integer;
begin
if FileExists( AttachFileName ) then
begin
DataObject := TDataObject.Create;
DropTarget := CreateComObject( CLSID_SendMailDropTarget ) as IDropTarget;
try
DataObject.Files.Add( AttachFileName );
DropTarget.Drop( DataObject, 0, Mouse.CursorPos, Effect );
finally
DropTarget := nil;
DataObject.Free;
end;
end;
end;
[빵집에서 활용된 팁 #4] 트리뷰에 노드추가시 빠르고+소트 두가지를 한방에..
트리뷰에 노드를 추가할때.....
가장 빠르게 할수 있는 방법은?
노드를 추가하지 않는것이다.....
으잉? 왠 헛소리? 라고 할지도 모르겠는데..... (아니다...이미 많이들 알고 있을것이다.....)
간단하게 설명하겠다....
TTreeNode에는 HasChildren이라는 프로퍼티가 있는데...
말그대로 자식이 있으면 True고 없으면 False다...
근데 이놈이 리드온리가 아니다....
HasChildren 프로퍼티는 세팅할수 있다....
HasChildren를 True로 한다고해서 자식이 자동으로 만들어지는건 아니고...
+ 버튼이 생긴다....
물론 자식은 아직 없는 상태일것이고...
이때 사용자는 + 버튼이 있으니깐 그 노드를 펼치려 할것이다...
이때 OnExpanding이벤트가 발생하고...
그 노드에 자식을 그 이벤트핸들러에서 추가하면된다...
즉, 노드를 첨부터 한꺼번에 다 맹글어 놓지말고 펼칠때마다 추가해 넣는것이다...
탐색기도 이렇게 만들어졌으리라 생각이든다......
자... 빵집에서도 이렇게 했다는건 아니고 ^^;;
빵집에서는 사정상,...
노드를 한꺼번에 다 맹글어넣어야했다.....
노드를 한꺼번에 다 맹글어 넣을때는 아무래도 노드를 추가하는 자체가 시간이 걸리기때문에 위의 방법보다 빠를수 없다...
대신 가장 효율적인 방법으로 좀더 시간을 단축해보자는것이다.....
빵집의 트리뷰는 폴더구조이므로 한 노드에 같은 이름이 두 개이상 중복하지 않는다..
그리고 기왕이면 노드별로 소트를 하면 좋을것이다....
이 두가지를 감안하면 생각나는 방법이 이진트리가 생각난다.....
한노드에 자식들을 추가할때 ...
같은 노드가 두개 이상이면 안되므로....
현재 존재하는 노드들중에 추가하고자하는 노드와 같은 이름이 있는지 확인해야할것이다.....
이때 노드가 소트가 안되어있다면 당연히 노드 전체 루프를 돌아야할것이다.....
하지만 소트가 되어있다면 이진트리로 빠르게 찾을수 있다....
자.... 이진트리로 찾자....(이진트리가 몬지 모르면 인터넷에서 검색해서 일단 그것부터 배우자..)
찾아서 있는 경우? 있으면 그만이고.....(추가하지 말아야 겠지..)
없다면.... 없다고 끝이 아니라..... 추가해야할 노드가 들어가야할 위치를 알아낸다.....
단연히 이진트리 검색 알고리즘이 한번에 할수 있도록 만들어야 할것이다......
자......
끝이다...... 이 방법을 이용하면.....
1. 노드를 한꺼번에 추가하고...
2. 소트가 되어야하며..
3. 같은 이름의 노드가 중복되지 않아야할경우...
이럴때 가장 효과적인 방법일 것이다.....
소스?
직접 만들어보자 ^^;;;
[빵집에서 활용된 팁 #5] 빌드넘버 자동으로 표기하기....
빵집의 어바웃박스에 보면 빌드넘버가 표시되어있다.....
물론 내가 일일이 빌드할때마다 써넣은건아니고...
자동으로 처리하도록 했는데...
아래는 실행파일의 파일버전을 가져오는 방법이다....
알아서들 잘 쓰자....
이 소스는 델파이 도움말에 있는걸 조금 수정해서 만든거다....
도움말에 그런게 있다고?... 라고 생각하는가?
있다...
어딨냐하믄...
"프로젝트 옵션" -> "Version Info"을 클릭하고 밑에 있는 Help버튼을 클릭해보자...
그러면 Version Info에 관련된 도움말이 뜨는데...
밑에서 세번째 줄에..
Note: For details on how to access version information programmatically, see Reading version information.
라고 되어있고 그 문장 마지막에 보면 Reading version information. 를 클릭할수 있게 되어있는데 클릭해보자....
그러면 파일버전을 읽어들이는 소스가 나오는데...
그 소스에는 두가지 문제가 있다...
하나는 괄호 ")" 가 하나 빠져서 컴파일하믄 에러가 난다는것이고...
또 하나는 ..
040904E4 라는 문장이 나오는데...모냐믄..
파일버전은 언어별로 설정할수 있게되어있는데...
그 문장이 언어를 지정하는 문장인데..
우리는 보통 언어를 한국어(Locale ID: $0412)를 사용하므로 040904E4라는 문장을
041203B5 로 고쳐야 한다....근디 앞에 0412는 알겠는디 뒤에 03B5는 몰까나?
나도 몰겄다... 리소스 에디터로 열어보니깐 거기 나오드라... --a
자...
이하 소스....
function GetFileVersion: String;
const
InfoStr: array[0..9] of string = ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright', 'LegalTradeMarks', 'OriginalFileName', 'ProductName', 'ProductVersion', 'Comments');
var
ExeName: string;
VerInfoSize, Len, i: DWORD;
Buf: PChar;
Value: PChar;
begin
Result := '';
ExeName := Application.ExeName;
VerInfoSize := GetFileVersionInfoSize( PChar(ExeName), VerInfoSize );
if VerInfoSize > 0 then
begin
Buf := AllocMem(VerInfoSize);
try
GetFileVersionInfo( PChar(ExeName), 0, VerInfoSize, Buf );
for i := Low( InfoStr ) to High( InfoStr ) do
if VerQueryValue(Buf, PChar( 'StringFileInfo\041203B5\' + InfoStr[i] ), Pointer(Value), Len) then
if i = 2 then
Result := Value;
finally
FreeMem(Buf, VerInfoSize);
end;
end;
end;
[빵집에서 활용된 팁 #6] 인터넷에서 파일 다운로드 & 진행상태 표시....
빵집에 파일 다운로드 기능이 있다....
웹브라우져에서 http://xxxx.zip을 클릭하면 바로 다운로드 되다는 ... 그걸 말하는게 아니고....
빵집을 실행해 놓고.. 웹브라우져에서 zip파일 다운로드 링크를 .. 클릭을 하지말고
그 링크를 드래그해다가 빵집에다가 떨궈보자.....
그러면 빵집이 그 링크가 가리키는 경로의 파일을 다운로드해서 열어준다.....
그걸 설명하고자 하는것이니 한번도 안해본사람은(많을거다...맹글어 놓고도 얘기를 안했으니 --;; ) 일단 함 해보기 바란다......
파일을 다운로드 하는 방법중에 간단한 방법이 URLDownloadToFile 함수가 있다...
URLMon.pas에 있는 API함수인데... 사용법이 간단하고 명확해서 사용하기 좋다...
물론 인터넷에 연결이 안되있거나 하면 결과를 리턴해준다...
그런데 보통 이함수를 쓸때.. 두번째, 세번째 파라미터만 세팅을 해서 쓰는게 보통이다..
두번째가 URL이고 세번째가 저장할 파일명이다....
사실 이 두가지만 알면 되겠는데....
마지막 인자인 StatusCB: IBindStatusCallback 가 ... 척 보면 알겠지만... 심상치 않다..
혹시나해서 IBindStatusCallback를 열어보니..OnProgress라는 메소드도 있고....
척보니..이건 이벤트핸들러용으로 사용되는 인터페이스였다...
해서 .. 끼워맞춰서 구현을 했는데...
잘동작한다.... ^^;;;;
우선 IBindStatusCallback를 TInterfacedObject 와 다중상속을 해서
TURLDownload라는 클래스로 구현을 하고...
이 클래스에 Download라는 메소드를 만들어서 거기에서 URLDownloadToFile함수를 썼다..
마지막 파라미터에 Self라고 해서 IBindStatusCallback형 파라미터를 세팅했다..
이 클래스에는
function GetLocation(URL: String): String;
이런 메소드도 있는데... 파일다운로드 URL이 다이렉트로 파일을 가리킬수도 있지만
제로보드처럼 빙빙돌려서 다운로드 하는경우도 많으므로 http헤더에 로케이션이 있나확인해서
최종 다이렉트 URL을 얻어내서 ..
그 URL을 다운로드하도록 했뜨아...(이런걸보고 쌩쑈라고 하지여... --a )
아..여기서 인디콤포넌트가 쓰였다..
자.. 아래는 다운로드클래스의 소스인데 중간에 FProgress_Form가 나오는데 그거는 프로그래스창이다....
적당히 고쳐서 쓰자....
또 uses에 BZUtils도 추가되어있는데... 역시 적당히 고쳐서 쓰자....
unit URLDownloads;
interface
uses
Windows, SysUtils, URLMon, ActiveX, Forms, Classes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
Progress_Frm, Dialogs;
type
TOnProgressEvent = procedure ( Sender: TObject; Max, Position: DWord; StatusText: String; var Abort: Boolean ) of object;
TOnStartEvent = procedure ( Sender: TObject; URL: String ) of object;
TOnStopEvent = procedure ( Sender: TObject ) of object;
TURLDownload = class( TInterfacedObject, IBindStatusCallback )
private
FURL: String;
FAbort: Boolean;
FOnStart: TOnStartEvent;
FOnStop: TOnStopEvent;
FOnProgress: TOnProgressEvent;
FProgress_Form: TProgress_Form;
FLocalFileName: String;
FErrorMsg: String;
FAfterOpen: Boolean;
function GetLocation(URL: String): String;
procedure HTTPRedirect(Sender: TObject; var dest: String; var NumRedirect: Integer; var Handled: Boolean);
procedure DoStart(URL: String);
procedure DoStop;
procedure DoProgress(Max, Position: DWord; StatusText: String; var Abort: Boolean);
protected
{IBindStatusCallback}
function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
function GetPriority(out nPriority): HResult; stdcall;
function OnLowResource(reserved: DWORD): HResult; stdcall;
function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
public
function Download(FilePath: String): Boolean;
procedure Abort;
property ErrorMsg: String read FErrorMsg;
property LocalFileName: String read FLocalFileName;
property URL: String read FURL write FURL;
property OnStart: TOnStartEvent read FOnStart write FOnStart;
property OnStop: TOnStopEvent read FOnStop write FOnStop;
property OnProgressStatus: TOnProgressEvent read FOnProgress write FOnProgress;
end;
implementation
uses
BZUtils;
function TURLDownload.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
DoStart( URL );
Result := S_OK;
end;
function TURLDownload.GetPriority(out nPriority): HResult;
begin
Result := S_OK;
end;
function TURLDownload.OnLowResource(reserved: DWORD): HResult;
begin
Result := S_OK;
end;
function TURLDownload.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
var
Abort: Boolean;
begin
Abort := False;
DoProgress( ulProgressMax, ulProgress, szStatusText, Abort );
Application.ProcessMessages;
if Abort or FAbort then Result := E_ABORT
else Result := S_OK;
end;
function TURLDownload.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin
FErrorMsg := szError;
DoStop;
Result := S_OK;
end;
function TURLDownload.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;
begin
Result := S_OK;
end;
function TURLDownload.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
Result := S_OK;
end;
function TURLDownload.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult;
begin
Result := S_OK;
end;
function GetURLRoot( URL: String ): String;
var
i: Integer;
begin
Result := URL;
if Length( URL ) > 0 then
for i := 2 to Length( URL ) do
if ( URL[i] = '/' ) and not ( URL[i-1] in ['/',':'] ) then
begin
Result := Copy( URL, 1, i );
Break;
end;
if ( Length( Result ) > 0 ) and ( Result[ Length( Result ) ] <> '/' ) then Result := Result + '/';
end;
function GetBaseURL( URL: String ): String;
var
i: Integer;
begin
Result := URL;
for i := Length( URL ) downto 1 do
if URL[i] = '/' then
begin
Result := Copy( URL, 1, i );
Break;
end;
if ( Length( Result ) > 0 ) and ( Result[ Length( Result ) ] <> '/' ) then Result := Result + '/';
end;
function ExtractURLFileName( S: String ): String;
var
i: Integer;
begin
Result := S;
if Length( S ) > 0 then
for i := Length( S ) downto 1 do
if S[i] in ['/','\','=','&'] then
begin
Result := Copy( S, i + 1, Length( S ) - i );
Exit;
end;
end;
function TURLDownload.GetLocation( URL: String ): String;
var
Http: TIdHTTP;
Location: String;
begin
Result := URL;
Location := '';
Http := TIdHTTP.Create( nil );
try
Http.OnRedirect := HTTPRedirect;
Http.Request.Referer := GetURLRoot( URL );
Http.Head( URL );
Location := Http.Response.Location;
finally
Http.Free;
end;
if Location <> '' then
begin
if ( LowerCase( Copy( Location, 1, Length( 'http://' ) ) ) <> 'http://' )// and
//( LowerCase( Copy( Location, 1, Length( 'ftp://' ) ) ) <> 'ftp://' )
then
begin
if Location[1] = '/' then Delete( Location, 1, 1 );
Location := GetBaseURL( URL ) + Location;
end;
Result := GetLocation( Location );
end;
end;
function TURLDownload.Download(FilePath: String): Boolean;
var
FileName: String;
begin
URL := GetLocation( URL );
FileName := FilePath + ExtractURLFileName( URL );
FAbort := False;
URLDownloadToFile( nil, PChar( URL ), PChar( FileName ), 0, Self );
FLocalFileName := FileName;
Result := not FAbort and ( ErrorMsg = '' ) and FAfterOpen;
end;
procedure TURLDownload.Abort;
begin
FAbort := True;
end;
procedure TURLDownload.HTTPRedirect(Sender: TObject; var dest: String; var NumRedirect: Integer; var Handled: Boolean);
begin
Handled := True;
end;
procedure TURLDownload.DoStart(URL: String);
begin
FAfterOpen := True;
if Assigned( OnStart ) then OnStart( Self, URL )
else
begin
FProgress_Form := TProgress_Form.Create( nil );
FProgress_Form.SetStatus( psDownload );
FProgress_Form.AbortProc := Abort;
FProgress_Form.StaticText_Msg.Caption := URL;
FProgress_Form.CheckBox_AfterOpen.Enabled := IsArchiveFile( ExtractURLFileName( URL ) );
FProgress_Form.CheckBox_AfterOpen.Checked := FProgress_Form.CheckBox_AfterOpen.Enabled;
FProgress_Form.CheckBox_AfterOpen.Visible := True;
FProgress_Form.Show( True );
end;
end;
procedure TURLDownload.DoStop;
begin
if Assigned( OnStop ) then OnStop( Self )
else
begin
if FProgress_Form <> nil then
begin
FAfterOpen := FProgress_Form.CheckBox_AfterOpen.Checked;
FProgress_Form.Free;
FProgress_Form := nil;
end;
end;
end;
procedure TURLDownload.DoProgress(Max, Position: DWord; StatusText: String; var Abort: Boolean);
begin
if Assigned( FOnProgress ) then FOnProgress( Self, Max, Position, StatusText, Abort )
else
begin
if FProgress_Form <> nil then
begin
FProgress_Form.ProgressBar1.Max := Max;
FProgress_Form.ProgressBar1.Position := Position;
if FProgress_Form.StaticText_DownloadSize.Caption = '' then
begin
if Max > 0 then FProgress_Form.StaticText_DownloadSize.Caption := FormatFloat( '#,###,###,###,###0', Max ) + ' Byte';
end;
Abort := FAbort;
end;
end;
end;
end.
이 TURLDownload를 사용하는 방법은..
procedure TMain_Form.Download( URL: String );
var
DownloadFile: String;
URLDownload: TURLDownload;
begin
DownloadFile := GetDownloadPath;
URLDownload := TURLDownload.Create;
URLDownload.URL := URL;
if URLDownload.Download( DownloadFile ) then
begin
DownloadFile := URLDownload.LocalFileName;
[빵집에서 활용된 팁 #7] 탐색기... 강제로 업데이트 시키기.....
우선..... 정체부터 밝히자...나중에 기분상하지 않도록.....
빵집에서 활용된 팁을 주루룩 올려놓고보니.....
일방적으로 다 지껄여 버리면 재미가 없는것같다...
해서 이번에는 팁이 아니라 퀴즈로 가겠다.... (이래도 되남?... --a )
자.... 내용이 모냐믄.....
탐색기를 강제로 업데이트 시키는거다......
일단 현상 파악부터 하자.......
가장 쉬운 예로.. 알집과 빵집을 비교하겠다....
여기서는 압축 유틸리티에 대한 성능 비교가 아니라..
구현에 관련된 기술적인 내용을 다루는것이므로 두 유틸리티 자체에 대한 것은 논외다..
그러므로 두 압축 유틸리티에 대해 리플이나 굴비를 달지 말자...
....
일단 두 유틸이 다 깔려있다고 보고...
바탕화면이나 탐색기 등에서 파일하나를 선택한다...기왕이면 용량작은거를...
그거를 1234.txt라고 치자.....
그리고 마우스 오른쪽버튼을 클릭하면...
압축에 관련된 메뉴들이 있는데....
알집은 "1234.zip 으로 압축하기" 라고 되어있고..
빵집은 "1234.zip으로 압축하기" 라고 되어있다....(스페이스 하나 차이... ^^ )
자.. 이 두개의 메뉴를 차례로 클릭해보자....
같은가?
물론 압축을 하는 속도를 말하는게 아니다....
두 유틸이 모두 똑같이 동작할거다....
압축하는 창이 뜨고 ...
압축 다하면 창이 사라지고...
잠시 후..
압축파일 아이콘이 척~ 하고 나타난다.....
내가 얘기하고자하는것은....
압축이 끝난후부터 아이콘이 짠 하고 생기는 시간을 말하는거다.....
분명이 두 유틸이 아이콘이 나타나는 시간이 다를것이다.....
이런 현상은.....
압축을 다 해놓고도 아이콘이 나타나지 않아서 마치 느린것처럼 보일수 있다...
사실.... 파일이 만들어져 있어도 그 파일의 아이콘이 나타나 주지않으면 사용자는 그 파일을 다룰수 있는 방법이 없으므로....
파일이 만들어져 있더라도 아이콘이 나타날때까지는 없는거나 마찬가지라고 할수있겠다....
그리고 시각적으로도 아이콘이 나타나야 만들어졌다라고 느껴지므로 기왕이면 아이콘이 빨리 나타나 줘야 좀 빠른것같은 느낌을 팍팍 준다..... ^^;;; (별 쓸데 없는 걱정을 --;; )
자... 이번에는
델파이로 직접 테스트 해보자.....
Button1을 클릭하면 TFileStream을 하나 생성하도록 하자... 바탕화면에다가.. 단 SaveDialog를 사용하지말고 직접 경로를 줘서.....
그리고 테스트해보자...
버튼을 클릭하고 얼마만에 파일 아이콘이 나타나는가?....
아마도 얼마간의 시간이 걸릴거다.....
이번에는 똑같은것을 SaveDialog를 이용해서 파일명을 입력받고 바탕화면에 저장해보자.....
아마도 그전꺼보다 훨씬 빠른 느낌을 받을것이다.....
물론 TFileStream하고는 아무 관련이 없다...
자.... 문제를 내겠다....
빵집에서는 탐색기 업데이트를 어케 했을까나.....
힌트는......골때리는 꽁수다..... ( 결과가 중요하지머...... --a )
또 한가지 힌트는...
탐색기에서 F5를 누르면 업데이트가 되는데...
알집의 새 폴더가 그렇게 한다....
디렉토리를 만든다음에 F5가 눌러지게 해서.. 업데이트 하는데...
이때는 화면이 번~~쯔~~억 한다.....
그래서 알집의 새 폴더를 으다다다다 하고 계속 만들어보면...
화면이 번쩍 번쩍 번번쩍쩍하는것을 볼수 있는데...
빵집의 같은 기능은 전혀 그렇지 않다.....
(앗?.... 이런식으로 쓸라고 한게 아닌디.... --a )
암튼......
F5를 누르도록 한거는 아니란것이다....
.......
이 게시판이 강좌/팁이므로 리플을 달지말고 굴비를 달아주기 바란다....
굴비가 20개 이상 달리고 정답이 없으면 나의 꽁수를 과감히 공개하도록 하겠다...
단, 왕꽁수라고 낄낄대고 웃으면 다시는 이런거 안할지도 모른당......
솔직히 .. 걍 팁이라고 올릴래다가...쪽팔려서 원~ (관심도를 보고...판단할라구..--a )
########## 3월 3일 추가 #############################################
드디어 굴비가 20개 달렸군여....
자.. 약속대로 저의 왕꽁수 초허접한 방법을 공개합니다.
대신... 낄낄대고 웃으면 저 삐질겁니다. --;
자... 시작.....
실행되어있는 모든 탐색기를 업데이트 할수 있는 방법이 두가지 있습니다.
물론.... 제가 경험으로 알아낸 방법인다...
하나는 저~~ 위에서 말한것처럼 SaveDialog를 이용해서 파일을 저장하는겁니다.
파일을 저장한다는게 중요한게 아니고..
대화상자가 닫히는 순간부터 얼마간동안(아마도 0.5초 이내?..) 발생하는
모든 변화를 즉각 처리하는것 같습니다.
물론 그와 관련된 API나 머.. 그런건 전혀 모르겠고여..... 그런 현상만 확실합니다.
또 하나는 .... 이게 꽁수의 결정적인 힌트가 됐는데....
휴지통에다가 파일을 하나 버리면 모든 탐색기가 바로 업데이트 됩니다.
함 해보시져.....
SaveDialog를 쓰지말고 경로를 직접줘서...
바탕화면에 TFileStream을 생성하거나 StringList.SaveToFile같은거 해서 파일을 만들도록 하고....
저장하자마자 아무 파일이나 휴지통에 버려보세여...
물론 동작이 엄청 빨라야할겁니다.
가만히있어도 잠시후에 파일 아이콘이 나타나므로 확인할라믄 그 안에 파일을 버려야합니다.
자... 이 점을 이용해서 저의 꽁수가 만들어졌는데.....
그렇다고 임시파일을 만들어서 휴지통에 버리면?..
휴지통에 임시파일이 계속 쌓이므로.. 그걸 방지하기 위해서 존재하지 않는 파일을 휴지통에 버립니다.
그렇게해도 탐색기가 즉각 업데이트 됩니다. ^^;;
물론 파일삭제할때 메세지가 안뜨도록 플래그처리를 해야겠져.....
자... 소스 나갑니다. ^^;;
procedure UpdateExplorers;
var
SHF: TSHFileOpStruct;
begin
FillChar( SHF, SizeOf( TSHFileOpStruct ), 0 );
SHF.wFunc := FO_DELETE;
SHF.pFrom := PChar( 'z:\_xxyyzz_'#0 );
SHF.fFlags := FOF_ALLOWUNDO or FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_SIMPLEPROGRESS;
SHFileOperation( SHF );
end;
나그네 꽁수라고 하시지만...... 파일을 메일로 첨부하기도 일종의 꽁수라고 할수 있겠지만. 그런 꽁수들도 결국 알고있는 지식이나 기술, 경험등이 받쳐주기때문에 나올수 있는게 아닌가 싶습니다. 아..전 정답을 모릅니다... ^^V 2003/02/28 X
나그네 찬찬히 다시 보니... 꽁수라고 하기에는 너무 하이테크닉이군요....................... ㅡㅡ; 2003/02/28 X
pbi12 저는 리눅스쉘을 패키징 할때에 환경변수적용을 위해서 explorer 프로세스를 재시작해줬는데^^ 양병규씨가 한방법이 궁금하네요. 2003/02/28 X
오범석 그냥 SHChangeNotify API 를 쓰면 되는거 아닌지...? 2003/02/28 X
SHCNE_UPDATEDIR 나 SHCNE_UPDATEITEM 플래그를 써서 해당 파일이나 폴더가 변경되었다고 알려주면 될거 같은데..... 2003/02/28 X
황당^^;; 그것도 안깜빡거릴겁니다. shchangenotify.. 그런데 지금은 꽁수를 맞춰야 하는 것이므로 그건 아닐듯.. 뭔가 꽁수로 생각합시다. 2003/02/28 X
dma 근데 원래 탐색기가 자동으로 알아채는거 아닌가요? 난 그렇게 알고있느데.. 2003/02/28 X
헉 뭐지?;;;;;;;;;; 2003/02/28 X
흠.. 어렵군여...-_- 상위 디렉토리로 갔다가 다시 돌아오나-_-a 2003/02/28 X
윽... 1234.zip으로 압축하기:를 누르면 실행이 안되다가... 빵집으로 압축하기를 선택하니... Explorer에러가... 쿨럭;; 2003/02/28 X
양병규 저도 SHChangeNotify를 쓰면 당연히 될거라고 맘놓고 있었다가... 큰코를 다쳤다는.... --; 2003/02/28 X
마으미 젤루 확실한 꽁수 ㅡㅡv 현재 떠 있는 모든 탐색기에게 F5번 키 날려주기 ㅋ.ㅋ 2003/02/28 X
마으미 위에 글을 자세히 보니 F5번 안된다고 했네요 ㅠ______ㅠ 2003/02/28 X
마으미 탐색기의 SysListView32 핸들을 부여잡고 WM_PAINT 해달라고 애걸복걸한다. ^^; 2003/02/28 X
??? SaveDialog를 이용해서 어떻게 했나??? 2003/02/28 X
델파이초보 http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_11428379.html <- 혹시 이게 답? 2003/03/01 X
델파이초보 위 링크에 아래 답변에 코드와 같이 잠깐 설명이... 2003/03/01 X
델파이초보 위에 링크 답 아닌가요? ㅡㅡ;;; 2003/03/02 X
나그네 아닐겁니다. 2003/03/02 X
밥벌레 savedialog를 안보이게 띄우는 방법으로 성공 비스무리하게 됐는데요..-_-;; (굴비 20개 달렸으니까 얼렁 정답 갈쳐주세요 ^_^) 2003/03/02 X
밥벌레 쿡쿡쿡..그런 방법은 상상도 못했네요.. 아 잼따~ 병규님 쿡쿡하고 웃었으니까 삐지시면 안됨다- 2003/03/03 X
잔머리 오늘 정답달린거 보고, 주욱 읽어 내려가면서 생각한건데... 왠지 답이 프로그레스가 99%때에(99%가 중요한게 아니라 시간이 중요한거죠. 약 1초전쯤??)파일 생성을 해버리는 겁니다. 그럼 프로그레스는 100%에서 끝날테고(1초 후), 그럼 상대적으로 아이콘은 빨리 보이게 되는것이죠.;; 역시... 이건 심오함이 없군요. 병규님 멋져요. ㅡ.ㅜ 2003/03/03 X
흠.. 휴지통 ㅡ.ㅡ; ㅋㅋ
