2012년 12월 19일 수요일

윈도우7 설치후 하는 것

1. 익스플러
- 도구> 인터넷 옵션> 일반> 탭> 설정> 팝업표시방법> Internet Explorer에서.. = 체크
- ... 연결>Lan 설정 > 자동구성 > 자동으로 설정 검색 = 체크 해제
2. 항상 관리자 모드로
- 제어판> 관리도구> 컴퓨터 관리> 로컬 사용자 및 그룹 > Administrator> 팝업창> 속성
> 일반 > 계정 사용 안함 = 체크 해제
- ... guest 와 사용자아이디에서> 팝업창> 속성> 일반> 계정 사용 안함 = 체크

2012년 12월 11일 화요일

JSON

델파이 XE2 기준으로 Json 기본 Unit는 DBXJSON 입니다.
uses 절에 포함 시켜 주면 됩니다.

델파이에서 JSON을 수월하게 사용하기 위하여는 JSon 관련 컴포넌트를 설치하면 되는데
C:\Users\Public\Documents\RAD Studio 9.0 Samples\Delphi\DataSnap\JSONViewer\pckgs 에 있는 djsonrt.dpk 와 djsondsgn.dpk 를 인스톨 하면 됩니다.

../apps/djsonview.dpr 를 불러 실행 시켜 보면 됩니다.

관련 자료는 이곳
Json 관련 동영상은 http://edn.embarcadero.com/article/40910 에서 보시고요..

2012년 11월 23일 금요일

델파이 레코드에서 함수 사용가능하기에 2

델파이 레코드에서 함수 사용가능하기에 1 에서 C++로 구현 한것을 델파이로 구현해 보았습니다. 이제 까진 Unit를 클래스에서나 사용해 왔는데.. 조금 나아가 생각하면 자신만의 라이브러리를 record로 구현 해 놓고 불러서 사용하면 좋을 것 같습니다.

unit Unit1;
interface
type
  변동금리형식 = record
    신용등급: integer;
    function 결정할증(): real;
  end;
type
  은행형식 = record
    원금, 이율, 기간: real;
    변동금리: 변동금리형식;
    function 원리합계: real;
  end;
implementation
{ 변동금리형식 }
function 변동금리형식.결정할증: real;
var 임시할증: real;
begin
  임시할증 := 1.0;
  case 신용등급 of
    1: 임시할증 := 1.1;
    2: 임시할증 := 1.2;
  else writeln('신용등급 입력 에러');
  end;
  Result := 임시할증;
end;
{ 은행형식 }
function 은행형식.원리합계: real;
begin
  Result := 원금 * 이율 * 기간 * 변동금리.결정할증;
end;
end.

program Project1;
{$APPTYPE CONSOLE}
uses
  System.SysUtils,
  Unit1 in 'Unit1.pas';  // 이게 C++에서 Namespace ?
var 은행: 은행형식;
begin
  with 은행 do begin  // 이게 C++ 에서 Using
    원금:= 10000.0;
    이율:= 0.035;
    기간:= 3; //년
    Write('신용등급?(1,2 으로 구분하여 입력) ');
    Readln (변동금리.신용등급);
    Writeln ('당신의 원리합계는 = ', 원리합계():10:3);
    Readln;
  end;
end.

델파이 레코드에서 함수 사용가능하기에 1

C++을 공부하면서 느낀 것인데 델파이에서 레코드에 함수를 사용 할 수 있게 함으로 인하여 C++의 네임스페이스를 거의 완벽하게 구현이 가능하다는 것을 느꼈습니다.
아래 예를 보면
Unit1.cpp

#include 
#include 
namespace 은행 {
 double 원금, 이율, 기간;
 double 원리합계();
 namespace 변동금리 {
  int 신용등급;
  double 결정할증();
 }
}
double 은행::원리합계() {
   return 원금 * 이율 * 기간 * 변동금리::결정할증();
}
double 은행::변동금리::결정할증() {
   double 임시할증;
   임시할증 = 1.0;
   switch (신용등급) {
  case 1 :
    임시할증 = 이율 * 1.1;
    break;
  case 2 :
    임시할증 = 이율 * 1.2;
    break;
   default:
  cout << "신용긍급 입력 에러!";
   }
   return 임시할증;
}

File1.cpp

#include 
#include 
#pragma hdrstop
#pragma argsused
#include "Unit1.cpp"
int main(int argc, char* argv[]) {
 using namespace 은행;
 원금 = 10000.0;
 이율 = 0.035;
 기간 = 3; // 년
 cout << "시용등급?(1,2 으로 구분하여 입력): ";
 cin >> 변동금리::신용등급;
 cout << "\n당신의 원리합계는 = " << 은행::원리합계() << "\n\n";
 return 0;
}

2012년 11월 21일 수요일

IdHttp 에서 get post 사용하기

클라이언트가 HTTP프로토콜을 이용해서 서버에 무언가를 전달할 때 Get 이나 Post가 사용됩니다. GET은 주소줄에 값이 ?뒤에 쌍으로 이어붙고 여러개일 경우에는 & 으로 반복하고, POST는 숨겨져서(body안에) 보내집니다. GET은 URL에 이어붙기 때문에 길이제한이 있어서 많은양의 데이터는 보내기 어렵고 POST는 많은 양을 보내기에 적합합니다.(역시 용량제한은 있지만) 즉 http://url/exam.asp?date=20121121&area=all 같이 하는 것이 GET방식이고 form을 이용해서 submit을 하는 형태가 POST입니다.
게시판의 리스트를 가져온다고 하면 당연히 GET을 쓸 것이고 글을 작성한다고 하면 POST를 이용하는 것이 일반적입니다. GET은 서버에서 어떤 데이터를 가져와서 보여준다거나 하는 용도이지 서버의 값이나 상태등을 바꾸지 않습니다.
정리하면 GET은
- URL에 정보가 담겨서 전송된다.
- 전송할 수 있는 정보의 길이가 제한되어 있다.
- 퍼머링크로 사용될 수 있다.
POST
- header의 body에 담겨서 전송된다.
- URL 상에 전달한 정보가 표시되지 않는다.
- GET에 비해서 보안상 약간의 우위에 있다. (사실상 동일하다)
- 전송할 수 있는 데이터의 길이 제한이 없다.
- 퍼머링크로 사용할 수 없다.
- 서버 쪽에 어떤 작업을 명령할 때 사용한다. (데이터의 기록, 삭제, 수정 등)

idHttp 에서 Get 사용
var iSS: TStringStream;
begin
iSS:= TstringStream.create;
idHttp.get('URL', iSS);
Memo1.lines.text:= iSS.DataString;
iSS.Free;
end;

idHttp 에서 Post 사용

var iStrings: TStrings;
begin
iStrings.values['loginID']:= 'id';
iStrings.Values['Pwd']:= 'pwd';
Memo1.Lines.text:= idHttp.post('http://url/emac.asp', iStrings);
iStrings.free;
end;

WebVrowser 에서 쿠키 갖어 오기
mmResult.Lines.Text:= WebBrowser1.OleObject.Document.Cookie;

idHttp 에 쿠기 저장하기 1.
IdHTTP1.Response.RawHeaders.Add('Cookie: '+ mmResult.Lines.Text);
이 때 Cookie: 또는 Set-Cookie: 등으로 바꿔서 사용하므로 선택하여 사용 필요(paros에서 확인)

idHttp 에 쿠기 저장하기 2.
TWebBrowserHelper = class Helper for TWebBrowser
public
function GetCookieValue(Name: string): string;
function GetSessionID(Const id:string): string;
end;
function TWebBrowserHelper.GetCookieValue(Name: string): string;
var
Doc: IHTMLDocument2;
sList, tList: TStringList;
i: Integer;
begin
Result := '';
Doc := Self.Document as IHTMLDocument2;
if not assigned(Doc) then exit;
sList := TStringList.Create;
tList := TStringList.Create;
try
ExtractStrings([';'], [], PChar(Doc.cookie), sList);
for i := 0 to sList.Count - 1 do begin
tList.Clear;
ExtractStrings(['='], [], PChar(Trim(sList[i])), tList);
if AnsiCompareText(tList[0], Name) = 0 then begin
Result := tList[1];
exit;
end;
end;
finally
FreeAndNil(sList);
FreeAndNil(tList);
end;
end;

function TWebBrowserHelper.GetSessionID(const id: string): string;
begin
Result := Self.GetCookieValue(id);
end;

edSessionID.Text 에 PHPSessionID 등 세션 아이디가 있음
웹 개발자가 멋대로 만들기에 찾아서 기록, 또는 방법 1을 사용 하여 찾을 수 있음...
procedure TForm1.btSetCookieClick(Sender: TObject);
var IdURI: TIdUri;
begin
IdURI := TIdUri.Create(WebBrowser1.LocationURL);
edSessionValue.Text:= WebBrowser1.GetSessionID(Trim(edSessionID.Text));
IdCookieManager1.AddServerCookie(edSessionID.Text+'='+edSessionValue.Text, IDUri);
iduri.Free;
end;

http/1.1 302 Found 예외 에러 발생 하면 IdHttp 의 속성을 HandleRedirects := True; 해주면 됩니다.

2012년 11월 13일 화요일

Assert 와 OutputDebugString 사용

로그를 찍어 보자(델마당: 양병규님 글)에서 퍼옴

Assert
Assert는 델파이 함수인데요.. Assert( False, '여기에서 에러났다'); 와 같이 코딩을 하면 이렇게 메세지가 뜹니다.

에러아이콘+내가 지정한 메세지+Assert함수를 호출한 유닛명+라인넘버가 같이 뜹니다.

첫번째 파라미터인 Condition은 말그대로 컨디션인데... 컨디션이 True이면 상태가 좋은거고 컨디션이 안좋으면 상태가 안좋은겁니다. 그래서 True일때는 상태가 좋으므로 에러가 아닌 상황이고 False일때는 상태가 안좋으니깐 에러인 상황입니다. 즉, 컨디션이 False일때만 메세지가 출력된다는 얘기였습니다.

물론 False라고 직접 써도 좋지만 Boolean형 변수를 이용하던가 아니면 Assert( i >= 0, '0 보다 작으면 안되는데..' );와 같이 이용해도 좋습니다.

OutputDebugString
OutputDebugString은 API 함수인데요. OutputDebugString( '여기에서 에러 났다' );와 같이 코딩하고 반드시 Run(F9)를 한 다음 View->Debug Windows->Event Log를 클릭해서(혹은 Ctrl+Alt+V) 이벤트로그 창을 띄워 놓으면 OutputDebugString 함수가 실행될때 이벤트로그 창에 다음과 같이 메세지가 뜹니다.

앞에 ODS라고 써는것이 OutputDebugString으로 찍은 메세지인데요 실제로 해보면 이 외에도 프로세스가 실행될때라든가 기타 여러가지 정보가 같이 올라오는데, 이벤트로그 창에서 오른쪽메뉴에서 Properties를 클릭하면 나오는 대화상자에서 Messages 그룹박스에 Output messages만 체크하고 나머지는 체크해제하면 OutputDebugString만 뜨게됩니다.(물론 다른 메세지들도 활용하면 좋습니다.)

Assert + OutputDebugString
앞에 두 가지는 잘 아는 내용이었구요. 이번에는 이 두 가지를 혼용하는 방법을 소개하겠습니다. Assert함수는 앞서 소개한 메세지창을 띄우는 방법이 일반적이지만 사용자가 어떤 식으로 출력할지를 세팅할 수 있게 되어 있습니다. AssertErrorProc을 이용하면 되는데요... AssertErrorProc은 System유닛에 선언되어 있는 전역변수이고 프로시져타입으로 원형은 다음과 같습니다.

type
TAssertErrorProc = procedure (const Message, Filename: string;
LineNumber: Integer; ErrorAddr: Pointer);

이런 형식으로 프로시져를 만들어서 AssertErrorProc에 할당해 주면 Assert함수가 호출될 때 이 프로시져를 호출해 줍니다. 프로시져 안에서 OutputDebugString을 이용하게되면 Assert를 호출할 때마다 이벤트로그 창에 메세지와 유닛명, 라인넘버가 함께 찍히게 됩니다.
다음은 그 예제이구요..

procedure AssertProc(const Message, Filename: String;
LineNumber: Integer; ErrorAddr: Pointer);
begin
OutputDebugString( PChar( ExtractFileName( Filename ) +
'(' + IntToStr( LineNumber )+' Line) '+ Message ) );
end;
procedure TForm1.Button1Click(Sender: TObject);
var i: Integer;
begin i := -1;
Assert( i >= 0, 'i는 0보다 작으면 안되는데..' );
end;
initialization
AssertErrorProc := AssertProc;

Button1을 클릭하면 이벤트로그창에 다음과 같이 찍힙니다.

유닛명과 라인수가 함께 출력이 되고 별도의 if문 없이도 상황에 따라서 선택적으로 출력할 수 있어서 좋습니다. 또한 디버깅시에만 동작하는 OutputDebugString을 이용함으로써 이 상태로 배포해도 되고 메세지박스를 띄우는 것이 아니므로 쓰레드나 메세지등과 같이 시간이나 절차에 민감한 에러를 잡을 때 편리합니다.

<펌> Hook 에 대한 또 다는 설명

Hooking?
Hooking는 처리될 윈도우 메시지를 도중에 가로채는 것을 의미한다. 윈도우 메시지는 처리과정에서 어떤 식으로든 시스템의 도움을 받아야 한다. 윈도우 시스템에서 메시지를 전달하기 전에 가로채 재처리를 할 수 있는 기회가 있는데 이것이 Hooking이다. 사실 Hooking은 가로챈 메시지를 처리하기 위한 Hook Procedure를 설치함으로써 간단하게 사용할 수 있지만 시스템이나 프로세스에 많은 부하를 줄 뿐만 아니라 시스템에 심대한 영향을 줄 수도 있는 위험한 기능이다. 그래서 윈도우에 대해 전반적인 이해가 필요하다.

Hooking의 종류
Hooking은 Hooking할 대상의 범위와 메시지의 종류에 따라 나눠 볼 수 있다. Hooking 대상의 범위는 Global Hook과 Thread Hook이 있다. 그리고 Hooking할 메시지의 종류에 따라 여러 가지를 선택할 수 있는데 이 Hooking Type에 따라 시스템의 성능이나 안정성에 심대한 영향을 줄 수 있으며, 대상으로 하는 메시지에 따라 적절하게 선택해야 한다. 특히 Global Hook은 System을 대상으로 하는 것으로 시스템 전체에 많은 영향을 줄 것이다.

System Hook (Global Hook)
시스템 전체에 대한 메시지를 Hooking한다. 시스템 전체에 대해서 Hooking하려면 Hook Procedure의 위치가 중요하다. 윈도우 플랫폼에서는 다른 프로세스의 주소 영역을 침범할 수 없음을 잘 알고 있을 것이다. 또한 각 프로세스마다 논리적으로 같은 실행 영역을 가지고 있음도 알고 있을 것이다. 그렇다면 Hook Procedure의 위치가 왜 중요한지 생각해 보면, Hooking을 시도하는 어플리케이션의 그 실행 영역에 Hook Procedure가 있다면, 시스템에서 그 Procedure를 호출하는 것은 위와 같은 이유로 쉬운 일이 아닐 것이다. 사실 윈도우에서는 시스템에서 서로 공통으로 사용할 수 있는 실행 영역이 따로 존재한다. 이 영역은 DLL과 같은 공통으로 사용할 수 있는 코드를 적재하기 위한 공간이다. 비록 어플리케이션이 실행될 때 어플리케이션 영역은 모두 논리적으로 고유한 공간을 확보하고 있지만 시스템을 위한 공간만큼은 공통으로 사용하게 된다. 다시 말하면, 시스템에 있는 주소 영역은 어느 어플리케이션이나 물리적으로 같은 것을 가리킨다. 정리하면, Global Hook을 위해서는 Hook Procedure가 어플리케이션의 영역이 아닌 DLL이 적재되는 영역에 있어야 한다.

다른 문제는 DLL 내에 존재할 수 있는 Hook의 Handle이 공유되어야 한다는 것이다. 왜냐면, CallNextHookEx에서 Hook의 Handle을 패스해야 하지만 이 Handle이 다른 어플리케이션에서 유효하지 않다. DLL은 코드만 공유할 뿐 그 데이터는 공유하지 않는다. 그래서 Hook Handle은 모든 프로세스에서 공유할 수 있도록 방법을 찾아야 한다. 프로세스간 데이터를 공유하는 방법은 여러 가지가 있다. 쉽게 생각할 수 있는 방법이 공유메모리와 Memory Map IO 등이다.

Thread Hook
특정 Thread에 대해서만 Hooking한다. System Hook (Global Hook)과는 다르게 같은 프로세스의 한 Thread만을 대상으로 하기 때문에 Hook Procedure의 위치는 DLL에 있든, 어플리케이션 실행 영역에 있든 상관 없다.

Hook Chain
위에서 설명한 것처럼 Hook Type은 여러 종류가 있다. 또한 여러 개가 설치될 수 있을 것이며, 그 Type도 여러 개일 수 있다. 그래서 시스템에서는 이들 Hook을 리스트로 관리한다. 메시지가 발생 하여 리스트에 설치된 Hook이 발생된 메시지와 일치하면 그 메시지를 Hooking하게 된다. 그리고 메시지가 Hooking되면 그 메시지는 다른 Hook에서 처리할 수 있도록 메시지를 전달해야 할 것이다.

Win32 API for Hooking
Hook은 SetWindowsHookEx, UnHookWindowsHookEx, CallNextHookEx, Hook Procedure 등 이용한다. 이중 Hook Procedure는 각 Hook Type에 맞는 Procedure가 따로 정의되어 있다. 그 Hook Procedure Prototype에 맞게 Hook Procedure를 새롭게 작성하면 된다.

SetWindowsHookEx
Hook을 설치한다.
function SetWindowsHookEx(idHook: Integer; lpfn: TFNHookProc; hmod: HINST; dwThreadId: DWORD): HHOOK; stdcall;
두 번째 Argument는 Hooking될 때 호출될 Hook Procedure이다. 마지막 Argument는 Global Hook을 사용할 때는 0을, Thread Hook을 사용할 때는 그 Thread ID를 넘겨준다. Hook Type에는 사용할 Type에 따라 Global Hook과 Thread Hook을 구분해야 할 것이다.

UnHookWindowsHookEx
Hook을 제거한다.
function UnhookWindowsHookEx(hhk: HHOOK): BOOL; stdcall;

CallNextHookEx
Hooking된 메시지를 다음 Hook으로 패스한다.
function CallNextHookEx(hhk: HHOOK; nCode: Integer; wParam: WPARAM; lParam: LPARAM): LongInt; stdcall;

Hook Procedure
Hook Procedure에서 주의할 점
Thread Hook의 경우 좀 덜하겠지만 Global Hook의 경우 시스템 영향이 상당하다. MSDN에도 보면 디버깅 용도 이외에는 가능하면 자제할 것을 권고하고 있다. 그러므로 Hook Procedure는 가능하면 간단하게 작성되어야 한다.

메시지를 Hooking하고 나면 그 다음 Hook으로 그 메시지를 넘겨야 한다. 그래서 CallNextHookEx를 호출해야 하는데 처음에 받은 nCode, wParam, lParam을 그대로 넘겨주면 된다. 만약 메시지를 수정하거나 CallNextHookEx를 호출하지 않더라도 상황에 따라 별 문제는 생기지 않지만 어떤 동작을 할지 보장할 수 없게 된다. 왜냐면, Hook Chain은 시스템이 관리하므로 메시지가 어떤 순서로 처리되고 있는지 보장할 수 없다. 그리고 정상적인 경우 Hook Procedure의 결과 값은 CallNextHookEx의 결과 값을 리턴한다. nCode는 0보다 작을 경우 메시지를 처리하지 말고 바로 CallNextHookEx로 호출하여 메시지를 넘겨야 한다.

WH_CALLWNDPROC 쓰레드 또는 시스템 윈도우 관련 메시지들이 처리되기 전에 동작하는 훅
WH_CALLWNDPROCRET 쓰레드 또는 시스템 윈도우 관련 메시지들이 처리된 후 동작하는 훅
WH_CBT 쓰레드 또는 시스템 윈도우의 생성, 소멸, 포커스 등의 이벤트가 발생할 때 동작하는 훅
WH_DEBUG 쓰레드 또는 시스템 다른 훅의 사용을 디버그할 수 있는 훅
WH_FOREGROUNDIDLE 쓰레드 또는 시스템 애플리케이션 맨 앞의 윈도우가 아이들 상태일 때 동작하는 훅
WH_GETMESSAGE 쓰레드 또는 시스템 메시지들이 메시지 큐로 들어올 때 동작하는 훅
WH_JOURNALPLAYBACK 시스템만 저널 레코드 훅에 의해 저장된 키보드나 마우스 이벤트를 재생시킬 수 있는 훅. 일반적으로 이 훅이 동작하는 동안 키보드나 마우스 사용은 정지된다.
WH_JOURNALRECORD 시스템만 모든 키보드와 마우스 동작을 저장 할 수 있는 훅. 키 매크로 등을 제작 할 때 아주 유용하다.
WH_KEYBOARD 쓰레드 또는 시스템 키보드 메시지 발생시 동작하는 훅
WH_MOUSE 쓰레드 또는 시스템 마우스 메시지 발생시 동작하는 훅
WH_MSGFILTER 쓰레드만 특정 애플리케이션에서 만들어낸 메뉴, 다이얼로그 박스, 스크롤 박스 등에서 메시지가 발생할 때 동작하
는 훅
WH_SHELL 쓰레드 또는 시스템 윈도우 쉘에 관계된 메시지를 대상으로 하는 훅
WH_SYSMSGFILTER 시스템만 모든 애플리케이션이 만들어낸 메뉴, 다이얼로그 박스, 스크롤 박스 등에서 메시지가 발생할 때 동작하는 훅

<펌> 아래 KeyBoard Hook 번역

Keyboard Hooking under Win32
--------------------------------------------------------------------------------
김영대님 홈에서 가져옴 (cozy@hanmail.net)
거기서 원래 출처를 밝히지 않았으므로 원출처에 대해서는 모름
김태훈 번역

다음 예제는 Win32에서 System wide windows hook(역자주:하나의 Application에 국한 되지 않고 시스템 상의 모든 프로세스에 영향을 미침)을 만들어 내는 것을 보여준다. 이 예제는 system hook dll과 example application 모두 제공한다. (역자주:System wide windows hook을 작성하기 위해서는 Hook Callback 함수가 DLL에 들어 있어야 한다) 또한 우리가 만들어 낼 Hook 함수는 진보된 코딩 기술, 즉, memory mapped files을 사용해서 프로세스 경계를 넘나드는 전역 메모리 공유하기, Key Hook 함수에서 메시지를 발생시킨 Application으로 메시지 돌려 보내기, 그리고 DLL을 실행중에 동적으로 Loading하기 같은 것을 보여준다.

우리가 만들어낼 이 키보드 훅 예제는 사용자가 키보드를 통해 넣는 Keystroke 수를 매겨서 유지한다. 나아가서 우리는 Enter Key를 Trap(사로잡기)하고, Enter Key를 누른 각 시점에 키보드 훅을 시작한 Application으로 메시지를 전달하는 것을 보여 줄 것이다. 그리고나서 우리는 현재 Application을 통해 키를 임대하지 않고, 왼쪽 화살표 키를 Trap하는 것을 보여줄 것이다. 그보다는 우리는 오른쪽 화살표키로 그것을 대체할 것이다. (노트: 의심이 적은 사용자에게는 많은 혼동을 야기할것이다.)

윈도우 시스템에 훅을 더하는 것은 SetWindowsHookEx()라는 Windows API를 호출하는 것과 당신이 설치하는 훅 함수의 주소를 당신이 설치하기를 원하는 타입에 전달하는 것을 포함한다. System wide hook functions은, 시스템 상의 각 프로세스에 mapping 되어져야(역자주:가상 주소와 연관되어 있음) 하므로, dynamic link library에 속해야 함이 요구되어진다. SetWindowsHookEx() 함수는 당신의 훅 함수를, 당신이 설치한 훅의 핸들(또는 ID)을 반환하는, Windows "hook chain"에 더한다. 당신은 이 핸들을 윈도우에 있는 당신의 훅을 확인하거나 키보드 트랩핑이 끝났을때 당신의 훅을 제거하는데 사용할 것이다.

윈도우즈 "hook chain"은 윈도우가 이미 설치된 모든 훅들의 track을 유지하는데 사용하는 연결 리스트이다. 임의로 주어진 시간에 설치되어지는 다중(multiple) 훅이 허락된다. 가끔 윈도우즈는 당신의 훅 함수에게 모든 훅에게 작동할 기회를 허락하는 그 체인내에 있는 다음 훅을 호출하기위해 물을 것이다. 우리가 체인상의 다음 훅을 호출할때 우리는 우리의 훅 함수 핸들을 다음 훅으로 전달함에 의해 우리 자신을 확인하는 것이 필요할 것이다.

윈도우즈 훅을 만드는 것은 win32 하에서 특별한 다룸이 필요하다. DLL이 keystrokes를 받는 모든 Application의 프로세스 공간으로 mapping되어야하기 때문이다. 이것은 이슈가 아니다. 그러나 keyhook procedure 내부에서 운영될때, 전역변수(당신의 훅 핸들 같은 것)는 그 DLL이 다른 프로세스 공간으로 mapping되어 있을동안 보존되어 있어야 한다. 윈16에서, 이것은 하나의 프로그램이 되지는 않는다. DLL들은 모든 프로세스 mapping에 공유된 단일 Data segment를 가지고 있기때문이다. 윈32에서는, DLL의 각 mapping은 소유권을 가진 Data segment를 받는다. 이것은 그것이 keyboard hook을 담고 있는 DLL이 keystroke를 받는 각 프로세스에 mapping되어 있음을 의미한다. 그것은 새로운 Data segment와 그것과 함께 초기화 되지 않은 새 변수를 를 받는다. 이것이 문제이다. 전역 변수(당신의 훅 핸들같은 것)는 process mapping들 사이에서 보존되어야만 한다. 이 문제를 해결하기 위해 우리는 system paging file로부터 map variable들을 기억하기 위한 Win32의 능력의 유리한 점을 가질 것이다.

각 시점에 우리의 DLL은 한 프로세스에 mapping될 것이다. 우리의 DLL안에 있는 DllMain() 함수는 호출에 대한 이유는 지시하는 파라미터 Flag과 함께 윈도우에 의해 호출될 것이다. 우리가 DLL_PROCESS_ATTACH flag(다른 프로세스로 mapping된 것을 얻고 있는 나의 DLL을 지시한다)를 받았을때, 우리는 system paging file을 mapping하는 파일을 만들 것이고, 우리의 메모리에 mapping된 변수들에 대한 포인터를 얻을 것이다. 우리가 DLL_PROCESS_DETACH flag(프로세스로부터 un-mapping되는 것을 얻고 있는 나의 DLL을 지시한다.)를 받았을때, 우리는 system paging file을 mapping한 우리의 파일을 해제할 것이다. 우리가 트랙에 유지하기를 필요로 하는(그리고 keyboard hook을 Load한 Application과 DLL 모두로부터 접근할 수 있는) 그 변수들은 THookRec을 호출한 기록 구조체에 할당될 것이다. THookRec 구조체는 다음과 같다.

TheHookHandle : 원문 참조
TheAppWinHandle : 원문 참조
TheCtrlWinHandle : 원문 참조
TheKeyCount : 원문 참조

DLL은 다음 함수들을 담고 있다. - 내용은 원문 참조

MapFileMemory
UnMapFileMemory
GetHookRecPointer
KeyBoardProc
StartKeyBoardHook
StopKeyBoardHook
DllEntryPoint

Delphi Hook DLL 예제:
원문 참조

Application notes:

우리가 만들어 낸 테스트 Application은 keyboard hook을 담고 있는 DLL을 Loading하는 것과 설치하는 것, 총 keystroke 수와 (실시간에) enter key사 몇번 눌러졌는가를 보여(Display)주는 것 그리고 keyboard hook과 DLL을 uninstall하는 것을 보여(demonstrates)준다.

application code는 두개의 label과 버튼, timer component를 가진 Form을 정의하므로서 시작한다. 한번 우리는 우리의 hook 한수를 설치한다. 우리는 timer를 시작할 것이다. 그리고 every timer event에 기반해서 우리는 label1에서 총 keystroke 수(Hook이 설정된 이후 사용자에 의해 들어온)를 보여 줄 것이다. 또한 그 훅은 버튼의 OnKeyDown event를 Enter Key가 눌러진 시점에서 점화시킬 것이다. 그리고 그것은 우리에게 Enter Key가 몇번 눌러졌는가를 label2의 captiom에 보여줄 수 있는 기회를 준다.

Form이 정의된후, 우리는 hook DLL에서 정의된 바와 같은 방식으로 THookRec 구조체를 정의한다. 우리가 사용할 것인 다른 변수들은 다음을 포함한다. hook sll을 Loading하기 위해 사용되는 handle 변수, GetHookRecPointer(), StartKeyBoardHook(), and StopKeyBoardHook()를 호출하는데 사용하기위한 세개의 함수 포인터 변수. 마지막으로 우리는 그 memory mapped 변수에 접근하는데 사용하는 THookRec 구조체에 대한 포인터, enter key가 몇번 눌러졌는가에 대한 트랙을 유지하는 변수, DLL Loading의 성공을 지시하는데 사용하는 변수, 그 함수들을 얻는데 사용하는 변수 그리고 그 hook을 설정하는데 사용하는 변수를 정의한다.

Application logic은 다음처럼 행해진다.
원문 참조

<펌> SetWindowsHookEx 이용 Keyboard Hook

unit UKeyHookMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
end;
var
Form1: TForm1;
HookID: HHOOK;
procedure KeybdHook;
procedure KeybdUnhook;

implementation
{$R *.dfm}
type
PKeyHookStruct = ^TKeyHookStruct;
TKeyHookStruct = record
vkCode: Integer;
ScanCode: Integer;
Flags: Integer;
Time: Integer;
dwExtraInfo: Integer;
end;
// 키 입력 필터링 함수

function LLKeyHookFunc(HookCode: Integer; KeyCode: wParam; kStrokeInfo: lParam): LResult; stdcall;
var
PKeyHook: PKeyHookStruct;
idlestate: boolean;
begin
// 키 정보 받아오기
PKeyHook := Ptr(kStrokeInfo);
if HookCode >= 0 then begin
// SHIFT + F2
// Showmessage(Format('%d',[GetAsyncKeyState(VK_SHIFT)]));
if (PKeyHook.vkCode = VK_F2) and (GetAsyncKeyState(VK_SHIFT) < -32766) then begin
// 항상 맨 위에
Form1.FormStyle := fsStayOnTop;
Result := 1;
end
// SHIFT + F3
else if (PKeyHook.vkCode = VK_F3) and (GetAsyncKeyState(VK_SHIFT) < -32766) then begin
// 항상 맨 위에 아님..
Form1.FormStyle := fsNormal;
Result := 1;
end;
idleState := true;
end;
// 필터링 된 키가 아니라면 계속 진행
Result := CallNextHookEx(HookID, HookCode, KeyCode, kStrokeInfo);
end;

procedure KeybdHook;
const
WH_KEYBOARD_LL = 13;
begin
HookID := SetWindowsHookEx(WH_KEYBOARD_LL, @LLKeyHookFunc, hInstance, 0);
end;

procedure KeybdUnhook;
begin
UnHookWindowsHookEx(HookID);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
KeybdUnHook;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
KeybdHook;
end;

end.

<펌> keyboard hook 아래 예제 설명

Window Hook - The following example demonstrates creating a system wide windows
The following example demonstrates creating a system wide windows
hook under Win32. The example provides both the code for the system
hook dll and an example application. The hook function that we will
create will also demonstrate advanced coding techniques such as
sharing global memory across process boundaries using memory mapped
files, sending messages from the key hook function back to the
originating application, and dynamic loading of a dll at runtime.

The example keyboard hook that we create will keep a count of the
number of keystrokes a user enters on the keyboard. Further, we will
demonstrate trapping the enter key, and passing a message back to the
application that initiated the keyboard hook each time the enter key
is pressed. Finally, we will demonstrate trapping the left arrow key
and instead of letting it through to the current application, we will
instead replace it with a right arrow keystroke. (Note: that this can
cause much confusion to a unsuspecting user).

Adding a hook to the windows system involves calling the Windows API
function SetWindowsHookEx() and passing it the type of hook you wish
to install, and address of the hook function you are installing.
System wide hook functions are required to reside in a dynamic link
library, since they must be mapped into each process on the system.
The SetWindowsHookEx() function adds your hook function into the
Windows "hook chain", returning a handle (or id) of the hook you are
installing. You will use this handle to identify your hook to windows,
and to remove your hook when you are done trapping the keyboard.

The Windows "hook chain" is a linked list of functions that Windows
uses to keep track of all the installed hooks, allowing multiple
hooks to be installed at any given time. Occasionally, Windows will
ask your hook function to call the next hook in the chain, allowing
all the hooks an opportunity to function. When we do call the next
hook in the chain, we will need to identify ourselves by passing the
handle of our hook function to the next hook.

Creating a Windows hook requires special handling under Win32, since
the dll must be mapped (on the fly) into the process space of every
application that receives keystrokes. Normally, this is not an issue,
however, when operating inside a keyhook procedure, global variables
(such as your hook handle) must be preserved while the dll is mapped
into other process spaces. Under Win16, this would not be a program,
since dlls had a single data segment that was shared across all
process mappings. Under Win32, each mapping of the dll receives its
own data segment. This means that as the dll that contains the
keyboard hook is mapped into each process that receives keystrokes,
it receives a new data segment, and new unitialized variables with it.
This is a problem, since global variables (such as your hook handle)
must be preserved across process mappings. To solve this problem, we
will take advantage of Win32's ability to memory map variables from
the system paging file.

Each time our dll is mapped into a process, the DllMain() function
in our dll will be called by windows, with a parameter flag indicating
the reason for the call. When we receive the DLL_PROCESS_ATTACH flag
(indicating our dll is getting mapped into a different process), we
will create a file mapping to the system paging file and get a pointer
to our memory mapped variables. When we receive the DLL_PROCESS_DETACH
flag (indicating our dll is getting un-mapped from a process), we will
free our file mapping of the system paging file. The variables we will
need to keep track of (and have access to from both the dll and the
application that originally loaded the keyboard hook) are placed in a
record structure called THookRec. The THookRec structure has the
following fields:

TheHookHandle : The handle (id) of the Keyboard hook that we set. We
will need access to this variable during the execution of the keyhook
function, to identify ourselves to windows when we are asked to call
the next hook in the hook chain. We will also need access to this
variable when we remove our hook. Finally, the originating application
that will receive the messages from our hook function can access this
variable to see if and when the hook is active.

TheAppWinHandle : While this variable is not used in our example dll
or application, it is a starting place for adding additional messaging
capabilities between the hook function and your application that
initiates the hook. It can also be useful for determining if the hook
is functioning while mapped into the context of the initiating
application.

TheCtrlWinHandle : This variable will hold the handle to a button
control in our initiating application. We will use this handle to send
messages from the keyboard hook function to the button control. Every
time the enter key is pressed, we will send a WM_KEYDOWN and a
WM_KEYUP message to the button and a key value of 0 (zero). We will
trap the OnKeyDown event in the button control, and keep count of the
number of times the user presses the enter key.

TheKeyCount : This variable will keep track of the total number of key
presses made by the user. Obviously our keyhook will need access to
this variable to increment its value, and the originating application
that will receive the messages from our hook function will want to
access this variable to display real time results.

The DLL contains the following functions:

MapFileMemory : Creates a system paging file mapping object and
initializes a pointer to our mapping variable of type THookRec.

UnMapFileMemory : Frees the system paging file mapping object and
mapping variable created by the MapFileMemory() function.

GetHookRecPointer : An exported function that returns a pointer to the
mapping variable created by the MapFileMemory() function. The
initiating application can both set and examine this memory block, and
effectively share memory that is used by our hook function during the
time the hook function is operating in the context of another process
space.

KeyBoardProc : The actual hook function. This function receives both
keydown, and keyup messages as well as a message from windows
indicating we should call the next hook in the windows "hook chain".
This function increments TheKeyCount field of the memory mapped
THookRec structure if the keystroke we are processing is a keyup
message. If the key being processed is the enter key, we will fire the
OnKeyDown event of the window provided in "TheCtrlWinHandle" field of
the memory mapped THookRec structure. Finally, if the left arrow key
is pressed, we will swallow the keystroke, and instead send a right
arrow key stroke to the application. Note that the following variables
and initializing code has been included in this function for your
convience. The variables have been commented out in the code (as not
to compile). To use them, simply remove the comments in the code:

IsAltPressed {Determines if the Alt key is currently down}
IsCtrlPressed {Determines if the Control key is currently down}
IsShiftPressed {Determines if the Shift key is currently down}

StartKeyBoardHook : An exported function that allows the application
to initiate installing the keyboard hook;

StopKeyBoardHook : An exported function that allows the application
to initiate removing the keyboard hook;

DllEntryPoint : The main entry point into our dll, allowing us to know
when our dll is being mapped in, and out of, different application's
address space.

KeyBoard Hook (DLL) 사용 예제

unit UKeyHookUsingDll;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ Functions prototypes for the hook dll }
type
TGetHookRecPointer = function: pointer stdcall;
TStartKeyBoardHook = procedure stdcall;
TStopKeyBoardHook = procedure stdcall;
{ The record type filled in by the hook dll }
THookRec = packed record
TheHookHandle: HHOOK;
TheAppWinHandle: HWND;
TheCtrlWinHandle: HWND;
TheKeyCount: DWORD;
end;
{ A pointer type to the hook record }
PHookRec = ^THookRec;
var
hHookLib: THANDLE; { A handle to the hook dll }
GetHookRecPointer: TGetHookRecPointer; { Function pointer }
StartKeyBoardHook: TStartKeyBoardHook; { Function pointer }
StopKeyBoardHook: TStopKeyBoardHook; { Function pointer }
LibLoadSuccess: bool; { If the hook lib was successfully loaded }
lpHookRec: PHookRec; { A pointer to the hook record }
EnterKeyCount: DWORD; { An internal count of the Enter Key }

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
{ Process message sent from hook dll and display }
{ number of time the enter key was pressed }
if (Key = 0) then begin
Inc(EnterKeyCount);
Label2.Caption := IntToStr(EnterKeyCount) + ' Enter Keys Logged';
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{ Set our initial variables }
Timer1.Enabled := FALSE;
Timer1.Interval := 1000;
Label1.Caption := '0 Keys Logged';
Label2.Caption := '0 Enter Keys Logged';
EnterKeyCount := 0;
lpHookRec := NIL;
LibLoadSuccess := FALSE;
@GetHookRecPointer := NIL;
@StartKeyBoardHook := NIL;
@StopKeyBoardHook := NIL;
{ Try to load the hook dll }
hHookLib := LoadLibrary('THEHOOK.DLL');
{ If the hook dll was loaded successfully }
if hHookLib <> 0 then begin
{ Get the function addresses }
@GetHookRecPointer := GetProcAddress(hHookLib, 'GETHOOKRECPOINTER');
@StartKeyBoardHook := GetProcAddress(hHookLib, 'STARTKEYBOARDHOOK');
@StopKeyBoardHook := GetProcAddress(hHookLib, 'STOPKEYBOARDHOOK');
{ Did we find all the functions we need? }
if ((@GetHookRecPointer <> NIL) AND (@StartKeyBoardHook <> NIL) AND (@StopKeyBoardHook <> NIL)) then begin
LibLoadSuccess := TRUE;
{ Get a pointer to the hook record }
lpHookRec := GetHookRecPointer;
{ Were we successfull in getting a ponter to the hook record }
if (lpHookRec <> nil) then begin
{ Fill in our portion of the hook record }
lpHookRec^.TheHookHandle := 0;
lpHookRec^.TheCtrlWinHandle := Button1.Handle;
lpHookRec^.TheKeyCount := 0;
{ Start the keyboard hook }
StartKeyBoardHook;
{ Start the timer if the hook was successfully set }
if (lpHookRec^.TheHookHandle <> 0) then begin
Timer1.Enabled := TRUE;
end;
end;
end else begin
{ We failed to find all the functions we need }
FreeLibrary(hHookLib);
hHookLib := 0;
@GetHookRecPointer := NIL;
@StartKeyBoardHook := NIL;
@StopKeyBoardHook := NIL;
end;
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{ Did we load the dll successfully? }
if (LibLoadSuccess = TRUE) then begin
{ Did we sucessfully get a pointer to the hook record? }
if (lpHookRec <> nil) then begin
{ Did the hook get set? }
if (lpHookRec^.TheHookHandle <> 0) then begin
Timer1.Enabled := FALSE;
StopKeyBoardHook;
end;
end;
{ Free the hook dll }
FreeLibrary(hHookLib);
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
{ Display the number of keystrokes logged }
Label1.Caption := IntToStr(lpHookRec^.TheKeyCount) + ' Keys Logged';
end;
end.

KeyBoard Hook win32 (DLL)

library TheHook;
uses
Windows,
Messages,
SysUtils;
{ Define a record for recording and passing information process wide }
type
PHookRec = ^THookRec;
THookRec = packed record
TheHookHandle: HHOOK;
TheAppWinHandle: HWND;
TheCtrlWinHandle: HWND;
TheKeyCount: DWORD;
end;
var
hObjHandle: THandle; { Variable for the file mapping object }
lpHookRec: PHookRec; { Pointer to our hook record }

procedure MapFileMemory(dwAllocSize: DWORD);
begin
{ Create a process wide memory mapped variable }
hObjHandle := CreateFileMapping($FFFFFFFF, NIL, PAGE_READWRITE, 0, dwAllocSize, 'HookRecMemBlock');
if (hObjHandle = 0) then begin
MessageBox(0, 'Hook DLL', 'Could not create file map object', MB_OK);
exit;
end;
{ Get a pointer to our process wide memory mapped variable }
lpHookRec := MapViewOfFile(hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
if (lpHookRec = NIL) then begin
CloseHandle(hObjHandle);
MessageBox(0, 'Hook DLL', 'Could not map file', MB_OK);
exit;
end;
end;

procedure UnMapFileMemory;
begin
{ Delete our process wide memory mapped variable }
if (lpHookRec <> NIL) then begin
UnMapViewOfFile(lpHookRec);
lpHookRec := NIL;
end;
if (hObjHandle > 0) then begin
CloseHandle(hObjHandle);
hObjHandle := 0;
end;
end;

function GetHookRecPointer: pointer stdcall;
begin
{ Return a pointer to our process wide memory mapped variable }
result := lpHookRec;
end;

{ The function that actually processes the keystrokes for our hook }
function KeyBoardProc(Code: integer; wParam: integer; lParam: integer): integer; stdcall;
var
KeyUp: bool;
{ Remove comments for additional functionability
IsAltPressed : bool; IsCtrlPressed : bool; IsShiftPressed : bool; }
begin
result := 0;
case Code of
HC_ACTION: begin { We trap the keystrokes here }
{ Is this a key up message? }
KeyUp := ((lParam AND (1 shl 31)) <> 0);
(* Remove comments for additional functionability
{Is the Alt key pressed}
if ((lParam AND (1 shl 29)) <> 0) then begin
IsAltPressed := TRUE;
end else begin
IsAltPressed := FALSE;
end;
{Is the Control key pressed}
if ((GetKeyState(VK_CONTROL) AND (1 shl 15)) <> 0) then begin
IsCtrlPressed := TRUE;
end else begin
IsCtrlPressed := FALSE;
end;
{if the Shift key pressed}
if ((GetKeyState(VK_SHIFT) AND (1 shl 15)) <> 0) then begin
IsShiftPressed := TRUE;
end else begin
IsShiftPressed := FALSE;
end;
*)
{ If KeyUp then increment the key count }
if (KeyUp <> FALSE) then begin
Inc(lpHookRec^.TheKeyCount);
end;
case wParam of
{ Was the enter key pressed? }
VK_RETURN: begin { if KeyUp }
if (KeyUp <> FALSE) then begin
{ Post a bogus message to the window control in our app }
PostMessage(lpHookRec^.TheCtrlWinHandle, WM_KEYDOWN, 0, 0);
PostMessage(lpHookRec^.TheCtrlWinHandle, WM_KEYUP, 0, 0);
end;
{ If you wanted to swallow the keystroke then return -1 }
{ else if you want to allow the keystroke then return 0 }
result := 0;
exit;
end; { VK_RETURN }
{ If the left arrow key is pressed then lets play a joke! }
VK_LEFT: begin { if KeyUp }
if (KeyUp <> FALSE) then begin
{ Create a UpArrow keyboard event }
keybd_event(VK_RIGHT, 0, 0, 0);
keybd_event(VK_RIGHT, 0, KEYEVENTF_KEYUP, 0);
end;
{ Swallow the keystroke }
result := -1;
exit;
end; { VK_LEFT }
end; { case wParam }
{ Allow the keystroke }
result := 0;
end; { HC_ACTION }
HC_NOREMOVE:
begin { This is a keystroke message, but the keystroke message } { has not been removed from the message queue, since an } { application has called PeekMessage() specifying PM_NOREMOVE }
result := 0;
exit;
end;
end; { case code }
if (Code < 0) then
{ Call the next hook in the hook chain }
result := CallNextHookEx(lpHookRec^.TheHookHandle, Code, wParam, lParam);
end;

procedure StartKeyBoardHook stdcall;
begin
{ If we have a process wide memory variable }
{ and the hook has not already been set... }
if ((lpHookRec <> NIL) AND (lpHookRec^.TheHookHandle = 0)) then begin
{ Set the hook and remember our hook handle }
lpHookRec^.TheHookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyBoardProc, hInstance, 0);
end;
end;

procedure StopKeyBoardHook stdcall;
begin
{ If we have a process wide memory variable }
{ and the hook has already been set... }
if ((lpHookRec <> NIL) AND (lpHookRec^.TheHookHandle <> 0)) then begin
{ Remove our hook and clear our hook handle }
if (UnHookWindowsHookEx(lpHookRec^.TheHookHandle) <> FALSE) then begin
lpHookRec^.TheHookHandle := 0;
end;
end;
end;

procedure DllEntryPoint(dwReason: DWORD);
begin
case dwReason of
Dll_Process_Attach:
begin { If we are getting mapped into a process, then get } { a pointer to our process wide memory mapped variable }
hObjHandle := 0;
lpHookRec := NIL;
MapFileMemory(sizeof(lpHookRec^));
end;
Dll_Process_Detach:
begin { If we are getting unmapped from a process then, remove } { the pointer to our process wide memory mapped variable }
UnMapFileMemory;
end;
end;
end;

exports
KeyBoardProc name 'KEYBOARDPROC',
GetHookRecPointer name 'GETHOOKRECPOINTER',
StartKeyBoardHook name 'STARTKEYBOARDHOOK',
StopKeyBoardHook name 'STOPKEYBOARDHOOK';

begin
{ Set our Dll's main entry point }
DLLProc := @DllEntryPoint;
{ Call our Dll's main entry point }
DllEntryPoint(Dll_Process_Attach);
end.

2012년 11월 12일 월요일

SIZE_T

XE2 에서는 아래 처럼 Size_T 타입으로 선언 되어 있음

function ReadProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer;
  nSize: SIZE_T; var lpNumberOfBytesRead: SIZE_T): BOOL; stdcall;
{$EXTERNALSYM ReadProcessMemory}
function WriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer;
  nSize: SIZE_T; var lpNumberOfBytesWritten: SIZE_T): BOOL; stdcall;

2012년 11월 10일 토요일

Static Window 생성하고 따로 CALLBACK WNDPROC 돌리기

static-window-생성하고-따로-CALLBACK-WNDPROC-돌리기-1 에서 갖어 왔습니다.
나중에 델파이로 구현 해보려고 잡아 두었습니다.

Static 윈도우를 자식창(WS_CHILD)으로 만들고 그 안에 브라우저를 박아넣는건데,
이제껏 통신방식을 파일, 클립보드, 파이프 등을 이용해서 했지만 썩 만족스럽지 못했다.
메시지를 보내는 게 제일 좋다고 생각하고 삽질하다 성공했다.

// 주고 받을 메시지 정의
#define WM_PROXY WM_USER+123
// 전역으로 쓸 프로시져
WNDPROC IEProcdure;
Callback 함수 선언
LRESULT CALLBACK IEProc(HWND hWnd, UINT iMsg, WPARAM wParam, LPARAM lParam) {
switch(iMsg) {
case WM_PROXY:
// 그냥 메시지가 오면 wParam 에 따라 메세지박스를 띄워준다...
if (wParam==0) MessageBox(hWnd, "0", "MyProxy", MB_OK);
else MessageBox(hWnd, "0 아니다", "MyProxy", MB_OK);
break;
}
return CallWindowProc(IEProcedure, hWnd, iMsg, wParam, lParam);
}
static window 생성
HWND g_hChild; // 생성할 정적 윈도우 핸들
// 윈도우 생성
g_hChild=CreateWindow("static", // 윈도우 클래스 = 정적(=static)
"Proxy", // 윈도우 캡션
WS_POPUP | WS_VISIBLE | WS_CHILD, // 윈도우 성격(-_-);
0, 0, // X, Y 위치
450, 600, // W, H 크기
hWnd, // 부모윈도우 핸들 (hWnd 라고 가정)
(HMENU)0, // 메뉴 (없다)
(HINSTANCE)GetWindowLong(hWnd, GWL_HINSTANCE), // 인스턴스 (type cast 에서 warning 뜸. 하지만 기능에는 지장없으므로 쫄지마셈)
(LPVOID)NULL);
// WndProc 과 연결
IEProcedure=(WNDPROC)SetWindowLong(g_hchild, GWL_WNDPROC, (LONG)IEProc);
끝이다..-_-;
졸라 간단한 거지만 개념이 안잡혀 있을 당시에는 가능한지도 몰랐었다...

GetDC(0) 으로 캡쳐되지 않는 윈도우 화면 캡춰

Delphi-GetDC0-으로-캡쳐되지-않는-윈도우 에서 갖어 왔습니다.

Transparent 나 AlphaBlend 가 먹힌 윈도우는 GetDC(0) 으로 캡쳐되지 않음.
(AlphaBlendValue 가 254 라도 안됨)

결론: Window Styles 의 Extended Styles 에 WS_EX_LAYERED 가 있다면 일반적 GetDC(0) 으로는 화면이 가져와지지 않음. 하지만 특정 윈도우의 핸들을 통해 GetDC(HWND) 로 받아오면 그려지는 걸로 봐서는 (하지만 Transparent, AlphaBlend 는 사라진 상태로) WS_EX_LAYERED 가 먹힌 윈도우의 화면은 바탕화면의 DC에서 관장하지 않는 듯함.

procedure DrawTopMostWnd(aBitmap: TBitmap);
var
aHWND: HWND;
aDC: HDC;
cRect, wRect: TRect;
X, Y: Integer;
BorderThick: Integer;
btm: TBitmap;
begin
// 최상위 윈도우의 핸들을 가져옴
aHWND:=GetForegroundWindow;
// 그런거 없다면 그냥 관둠...
if aHWND=0 then Exit;
// 최상위 윈도우의 ClientRect, WindowRect 가져옴
WinAPI.Windows.GetClientRect(aHWND, cRect);
Winapi.Windows.GetWindowRect(aHWND, wRect);
btm:=TBitmap.Create;
try
// 비트맵 크기 맞춤
btm.Width:=cRect.Right;
btm.Height:=cRect.Bottom;
// 최상위 윈도우의 DC를 가져옴
aDC:=GetDC(aHWND);
// 일단 그려주고
Bitblt(btm.Canvas.Handle,0,0,btm.Width,btm.Height,aDC,0,0,SRCCOPY);
// 테두리 영역의 크기를 구하고 전체화면에서 클라이언트 영역의 위치계산 (좀 더 스마트한 방법은 없을까...)
BorderThick:=(wRect.Right-wRect.Left-cRect.Right) div 2;
X:=wRect.Left+BorderThick;
Y:=wRect.Top+((wRect.Bottom-wRect.Top-cRect.Bottom))-BorderThick;
// 전체화면에 최상위 윈도우의 화면을 덧그려줌 Bitblt(aBitmap.Canvas.Handle,X,Y,btm.Width,btm.Height,btm.Canvas.Handle,0,0,SRCCOPY);
finally
FreeAndNil(btm);
ReleaseDC(aHWND, aDC);
// CloseHandle(aHWND);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
btm: TBitmap;
begin
btm:=TBitmap.Create;
try
btm.Width:=Screen.Width;
btm.Height:=Screen.Height;
Bitblt(btm.Canvas.Handle,0,0,btm.Width,btm.Height,GetDC(0),0,0,SRCCOPY);
DrawTopMostWnd(btm);
Image1.Picture.Assign(btm);
Image1.Refresh;
finally
FreeAndNil(btm);
end;
end;

String 다루는 방법이 바귀였습니다. (Delphi 2009 이후)

procedure TForm1.Button1Click(Sender: TObject);
var
ipChar: pAnsiChar;
S1,S2,S5,S6: AnsiString;
jpChar: pChar;
S3, S4: String;
begin
S1:= '1234 이정귀';
S2:= S1; // S1 와 S2는 같은 어드레스를 가르킴
ipChar:= pAnsiChar(S1);
// ipChar[1]:= 'G'; 델파이 2009 버전 부터는 컴파일 에러 발생
S1[1]:= 'G'; // S1의 어드레스가 바뀜니다.
Edit1.Text:= S2;
//
S3:= '1234 이정귀';
S4:= S3; // S3 와 S4는 같은 어드레스를 가르킴
jpChar:= pChar(S3);
// jpchar[1]:= 'G'; 델파이 2009 버전 부터는 컴파일 에러 발생
S3[1]:= 'G'; // S3의 어드레스가 바뀜니다.
Edit2.Text:= S4;
MessageBox(Handle, pChar(S3), pChar(S4), MB_OK); // 주1
S4[6]:= 'G';
Edit3.Text:= S4;
s5:= '1234 이정귀';
s6:= S5;
S5[6]:= 'G';
Edit4.Text:= S5;
end;

예전 버전에서는 jpchar[1] 과 같은 연산이 가능 했으며,
이 연산 이후에 S3, S4 의 어드레스가 같았습니다.

이젠 pChar 는 정말로 주1 과 같은 경우이외는 사용 할 필요가 없는 것 같습니다.

2012년 11월 6일 화요일

인터페이스(Interface) 이해(2)

인터페이스(Interface) 이해(1) 에서 Unit 간의 결합을 약하게 하기 위하여 Virtual; Abstract; 를 사용하였습니다.

인터페이스를 사용하여 구현해 보도록 하겠습니다.

1. 먼저 콘솔 프로젝트를 생성합니다.
2. 유니트를 하나 추가 하고 인터페이스를 선언 합니다.
인터페이스에는 필드가 없고 전부 Public 입니다.
unit Unit4;
interface
type
iMyInterface= interface
['{FEB663D2-1CCF-42E6-8429-049D97DC129E}'] // Vtrl + Shift + G
function GetQuestion: string;
procedure SetQuestion(const Value: string);
function Answer: string;
property Question: string read GetQuestion write SetQuestion;
end;
implementation
end.

3. 구현 클래스를 만듭니다.
unit Unit5;
interface
uses Unit4;
type TMyClass = class(TInterfacedObject, iMyInterface)
FQuestion: string;
private
function GetQuestion: string;
procedure SetQuestion(const Value: string);
public
function Answer: string;
property Question: string read GetQuestion write SetQuestion;
end;
implementation
{ iMyClass }
function TMyClass.Answer: string;
begin
Result:= 'Your Question is ' + FQuestion + '.';
end;
function TMyClass.GetQuestion: string;
begin
Result:= fQuestion;
end;
procedure TMyClass.SetQuestion(const Value: string);
begin
FQuestion:= Value;
end;
end.

4. 앞 설명과 일관성을 유지하기 위하여 생성 부분을 분리하였습니다.
unit Unit6;
interface
uses Unit4, Unit5;
function CreateObj: iMyInterface;
procedure FreeObj(Obj: iMyInterface);
implementation
function CreateObj: iMyInterface;
begin
Result:= TmyClass.Create;
end;
procedure FreeObj(Obj: iMyInterface);
begin
Obj:= nil;
end;
end.

5. Project3 부분을
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Unit4 in 'Unit4.pas',
// Unit5 in 'Unit5.pas',
Unit6 in 'Unit6.pas';
var
iMyInf: iMyInterface;
begin
iMyInf:= CreateObj;
iMyInf.Question:= 'Hello!';
writeln(iMyInf.Answer);
readln;
FreeObj(iMyInf);
end.
6 생성 부분과 해제 부분이 틀립니다. // 역시 구현 부분이 프로젝트 부분과 분리되어 있으며, 해제 부분에서 에러가 발생하지 않습니다. 앞의 (1) 설명에서 해제 부분에서 에러가 발생함.

델파이 환경 설정

1. Build All 할때 외부 추가 컴포넌트가 컴파일 되어 생성 되는 것을 못하게 하려면 Project 탭에서 Build Configarations 팝업 메뉴에서 [Delphi Compiler > Targer:= All configurations - All platform] Unit Output directory 의 .\$(Platform)\$(Config) 를 지워 주면 됩니다.

2020년 수정

2012년 11월 2일 금요일

퀀텀그리드 01

TMS 그리드를 사용하다가 퀀텀그리드를 접하게 되어 퀀텀 그리드를 익히고 있습니다.
이곳에서는 일반 그리드에 대한 개념을 갖고 계신 분이 퀀텀 그리드에 접근하는데,
도움이 될 수 있는 것을 메모 할려고 합니다.
컨텀 그리드 좋은 강좌는 :김성원블로그 이 잘되어 있습니다.
1. 델파이적인 기본 접근
- [File > New > VCL Forms Application] 하면 기본 품이 만들어 집니다.
- TClientDataSet, TDataSource, TDBNavigator 그리고 TCXGRid 를 올려 놓고 그림과 같이 배치합니다.

계속하여
- ClientDataSet1
FileName := C:\Users\Public\Documents\RAD Studio 9.0 Samples\Data\animals.xml
- Active:= True;
- DataSource1. DataSet:= ClientDataSet1
- DBNavigator1.DataSet:= ClientDataSet1

한다음 cxGrid1 바탕에서 마우스 오른쪽 버튼을 크릭하여 나타나는 팝업메뉴에서
LIne To DataSource1을 선택합니다.
또는, cxGrid 공간에서 더블크릭하여 나오는 제어 화면에서
cxGrid1DBTableView1.DataController.DataSource:= DataSource

cxGrid PopUp Menu 에서
Create All Columns (적색 표시 버튼)를 선택합니다.

제어 화면에서
cxGrid1DBTableView1BMP 를 선택하고
Properties:= Image
에서 (즉, cxGrid1DBTableView1BMP.roperties:= Image) 을 선택합니다.

소스를 보면

cxGrid1DBTableView1NAME: TcxGridDBColumn;
cxGrid1DBTableView1SIZE: TcxGridDBColumn;
cxGrid1DBTableView1WEIGHT: TcxGridDBColumn;
cxGrid1DBTableView1AREA: TcxGridDBColumn;
cxGrid1DBTableView1BMP: TcxGridDBColumn;
부분이 추가 되었씀을 참고 하십시요.
또한, 일반 그리드와는 달리 cxGrid의 그리드(테이블)의 셀 형식은 Varient 형식입니다.

2012년 10월 30일 화요일

서브클래싱

http://code.p-ark.co.kr/trackback/59 에서 갖어왔습니다.
1. 일반적으로 메세지 가로채기를 하려면 WinProc에 콜백을 걸어서 하는데
var

  Form1: TForm1; OldWindProc: Integer;
implementation
{$R *.dfm}
function NewWinProc(hWnd:HWND;Msg:Integer;wParam:Integer;lParam:Integer):LONGINT; StdCall;
var rect: TRect;
begin
  case Msg of
    WM_SIZE : begin
      GetClientRect(hWnd, rect); with rect do Form1.lst1.Items.Add('left:'
        +IntToStr(Left)+'top:' +IntToStr(Top)+'right:'+IntToStr(rect)
        +'bottom:'+IntToStr(rect));
      Form1.lst1.ItemIndex := Form1.lst1.Items.Count + 1; end; end;
  Result:=CallWindowProc(Pointer(OldWindProc),hWnd,Msg,wParam,lParam)
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  OldWindProc:=SetWindowLong(Form1.handle,GWL_WNDPROC,LongInt(@NewWinProc));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(Form1.handle, GWL_WNDPROC, OldWindProc);
end;

2. 클래스 내부에 포함 할때는 다른 방법으로 합니다. 아래와 같이 글로벌 영역에서는

unit Unit1;
interface
uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls;
type
  TForm1 = class(TForm)
    lst1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FTargetWnd: THandle; //서브클래싱 할 핸들 보관
    FOldProc: Pointer; //원본 윈도우프로시져 보관
    FNewProc: Pointer; //재구성 윈도우프로시져
  public
    procedure SubClassCreate(hWnd: THandle);
    procedure SubClassWndproc(var Message: TMessage);
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
// 서브 클래싱 걸기
procedure TForm1.SubClassCreate(hWnd: THandle);
begin
  if FTargetWnd <> 0 then Exit;
  FTargetWnd := hWnd;
  FOldProc := Pointer(GetWindowLong(FTargetWnd, GWL_WNDPROC));
  FNewProc := MakeObjectInstance(SubClassWndproc);
  SetWindowLong(FTargetWnd, GWL_WNDPROC, LongInt(FNewProc));
end;
// 서브클래싱 윈도우프로시져 재구성
procedure TForm1.SubClassWndproc(var Message: TMessage);
begin
  with Message do begin //Message 객체의 내부 메서드들로 윈도우 프로시져 원본을 돌려줌
    Result:=CallWindowProc(FOldProc,FTargetWnd,Msg,WParam,LParam);
    Case Msg of // Message 객체의 WM_SIZE 메세지를 받아옴
      WM_SIZE : begin
        lst1.Items.Add(Format('%d,%d',[LOWORD(Message.LParam),HiWord(Message.LParam)]));
        lst1.ItemIndex := lst1.Items.Count - 1;
    end;
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  //서브클래싱을 걸어 준다.예제 이므로 현재 윈도우의 핸들에
  SubClassCreate(Self.Handle);
end;
//서브클래싱 해제
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(FTargetWnd, GWL_WNDPROC, LongInt(FOldProc));
end;
end.

MDI 관련한 팁모음

SDI 로만 작업해 오다 MDI 가 필요하여 웹서핑하여 자료를 모아 보도록 하겠습니다.

1. MDI 폼에서 SDI 가 크라이언트 영역을 벗어나면 자동으로 스크롤 바가 생깁니다. 이 스크롤 바를 없애고 싶으면
- 메인폼에
function ClientWindowProc(wnd: HWND; msg: Cardinal; wparam, lparam: Integer): Integer; stdcall;
var
f: Pointer;
Begin
f := Pointer(GetWindowLong(wnd, GWL_USERDATA));
case msg of
WM_NCCALCSIZE: begin
if (GetWindowLong(wnd, GWL_STYLE) and (WS_HSCROLL or WS_VSCROLL)) <> 0 Then
SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) and not(WS_HSCROLL or WS_VSCROLL));
end;
end;
Result := CallWindowProc(f, wnd, msg, wparam, lparam);
end;
- 폼 생성 시
procedure TfrmMain.FormCreate(Sender: TObject);
begin
if ClientHandle <> 0 Then begin
if GetWindowLong(ClientHandle, GWL_USERDATA) <> 0 then Exit;
SetWindowLong(ClientHandle, GWL_USERDATA, SetWindowLong(ClientHandle, GWL_WNDPROC, Integer(@ClientWindowProc)));
end;
end;

2. 차일드폼이 미니마이즈 될때 엠디아이 크라이언트 영역 아래쪽에 네모로 보입니다. 이게 보기 싫어 안보이게 하려면..
- 베이직 폼을 하나 만들고
type
TfrmBase = class(TForm)
private
{ Private declarations }
public
procedure WMSize(var M: TWMSIZE); message WM_Size;
end;

- 구현(Implementation) 영역에
procedure TfrmBase.WMSize(var M: TWMSIZE);
begin
if M.SizeType = Size_Minimized then begin
ShowWindow(Handle, Sw_Hide);
M.Result := 0;
end
else inherited;
end;
- 차일드 폼이 이 베이직 폼을 승계 하면 됩니다.
TfrmChildForm = class(TfrmBase) // 그냥 만든 후 수정해주어도 됩니다.
private
public
end;

2012년 10월 28일 일요일

인터페이스(Interface) 이해(1)

델파이는 XE2 까지 오면서 몇번의 큰 변화가 있었다고 합니다. 그중 하나가 Interface 라고 하네요. 그런데 에전의 제 수준에서 인터페이스를 이해하기가 참 어렵더라고요.
그도 그럴것이 인터페이스를 처음 접하게 된게 COM이었기에, COM도 어려운데..
2번에 걸쳐 델파이의 인터페이스를 이해해 보도록 하겠습니다.
인터페이스를 사용하는 목적은 메모리 절약(?), 다중상속, COM 지원이 가능해 집니다.
우선 클래스만으로 구현 해보도록하겠습니다.

1. 먼저 콘솔 프로젝트를 생성합니다.
2. 유니트를 하나 추가 하고 클래스를 선언합니다.
unit Unit2;
interface
type
TMyClass=class
fQuestion: string;
public
function GetQuestion: string;
procedure SetQuestion(const Value: string);
function Answer: string;
property Question: string read GetQuestion write SetQuestion;
end;
implementation
{ TMyClass }
function TMyClass.Answer: string;
begin
Result:= 'Your Question is ' + FQuestion + '.';
end;
function TMyClass.GetQuestion: string;
begin
Result:= fQuestion;
end;
procedure TMyClass.SetQuestion(const Value: string);
begin
FQuestion:= Value;
end;
end.

3. 유니트 하나를 다시 추가하고 객체 생성과 소멸을 하게 합니다.
unit Unit1;
interface
uses Unit2;
function CreateObj: TMyClass;
procedure FreeObj(Obj: TMyClass);
implementation
function CreateObj: TMyClass;
begin
Result:= TMyClass.Create;
end;
procedure FreeObj(Obj: TMyClass);
begin
Obj.Free;
end;
end.

4. 프로젝트에서 결과를 구현합니다.
program Project2;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Unit2 in 'Unit2.pas',
Unit1 in 'Unit1.pas',
var
MyObj: TMyClass;
begin
MyObj:= CreateObj;
MyObj.Question:= 'hello';
Writeln(MyObj.Answer);
Readln;
FreeObj(MyObj)
end.

이상이 우리가 통상 해오던 OOP 코딩입니다.
살펴보면 Project2 의 구현 부분이 Unit2 의 구현 부분에 종속이 되어있습니다.
즉, Unit2 의 개발이 끝나야 Project2를 구현 할 수 있다는 것입니다.

5. 클래스 구현 방식을 약간 바꾸기 위하여 새로운 Unit를 추가합니다.
unit Unit3;
interface
type
TMyBaseClass=class
public
function GetQuestion: string; virtual; abstract;
procedure SetQuestion(const Value: string); virtual; abstract;
function Answer: string; virtual; Abstract;
property Question: string read GetQuestion write SetQuestion;
end;
implementation
end.
구현 부분이 없고 virtual; abstract; 지시 되어 있습니다.
이렇게 하고

6. Project2 를 아래와 같이 바꾸어 주면
program Project2;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
// Unit2 in 'Unit2.pas', 구현 부분이 빠집니다.
Unit1 in 'Unit1.pas',
Unit3 in 'Unit3.pas';
var
MyObj: TMyBaseClass;
begin
MyObj:= CreateObj;
MyObj.Question:= 'hello';
Writeln(MyObj.Answer);
Readln;
// FreeObj();
MyObj.Free;
end.
Project2 부분은 Unit2 구현 부분과 독립적으로 코딩이 가능하게 됩니다.

6. Unit2에는 Uses 에 Unit3을 추가하고
unit Unit2;
interface
uses Unit3;
type
TMyClass=class(TMyBaseClass) // 수정됨
fQuestion: string;
public
function GetQuestion: string; override; // 수정됨
procedure SetQuestion(const Value: string); override; //수정됨
function Answer: string; override; // 수정됨
property Question: string read GetQuestion write SetQuestion;
end;
implementation
{ TMyClass }
function TMyClass.Answer: string;
begin
Result:= 'Your Question is ' + FQuestion + '.';
end;
function TMyClass.GetQuestion: string;
begin
Result:= fQuestion;
end;
procedure TMyClass.SetQuestion(const Value: string);
begin
FQuestion:= Value;
end;
end.

7. 그러나 Unit1 은 Unit2 에 종속이 되어 있습니다.

2012년 10월 25일 목요일

폼 이름으로 폼 생성하기(한개만)

MDI 또는 SDI 에서 새로운 폼을 생성 할때 폼의 이름으로 생성하면 편리 할 때가 있습니다.

1. 우선 생성 될 폼을 [Project > Options... > forms] 에서 해당 폼을 Avaiable forms: 에 등록합니다.

2. 해당 폼 Unit 에서
initialization
RegisterClasses([TfrmChild]);
를 아래 쪽에 추가합니다.

3. 생성되는 폼의 OnClose 에서
procedure TfrmChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:= caFree;
end;

3. 폼을 생성 하는 메인 폼에서
function TfrmMain.CreateChild(iClass: string): Boolean;
var
iMyFormClass: TFormClass;
iWorkform: TForm;
iHnd: THandle;
idx: integer;
begin
result := True;
iHnd := 0;
for idx := 0 to Screen.FormCount - 1 do begin
if UpperCase('T' + Screen.Forms[idx].Name) = UpperCase(iClass) then begin
iHnd := Screen.Forms[idx].Handle;
Break;
end;
end;
if iHnd = 0 then begin
iMyFormClass := TFormClass(GetClass(iClass));
if iMyFormClass <> nil then begin
iWorkform := iMyFormClass.Create(Application.MainForm)
end
else result := False;
end
else begin
if IsIconic(iHnd) then ShowWindow(iHnd, SW_SHOWNORMAL)
else BringWindowToTop(iHnd);
end;
end;
을 선언 하여 주고

4. 폼 생성시 frmChild:= TfrmChild.Create(Self); 대신
CreateChild('TFrmChild');
을 사용하여 생성하거나 보여주거나, 최상위 위치로 올려 주면 됩니다.

델파이 기본 교육 YouTube 동영상 강좌 (21개)

링크 연결이 잘 안되네요.. 나중에 수정하겠습니다.

우선 YouTube 에 가셔서 아래 제목으로 검색하세요.

[데브기어] 델파이 기본 교육

1.프로젝트 시작하기
2.프로젝트소스와프로젝트관리
3.Unit 구조와 코드작성1
4.코드작성2(프로시저와함수)
5.Unit 구조와 코드작성3(클래스)
6.개체와컴포넌트사용방법1
7.개체와 컴포넌트 사용방법2
8.개체와 컴포넌트 사용방법(수동)
9.폼띄우기
10.폼의 속성과 이벤트
11.메뉴 작성 컴포넌트 설명
12.메모장만들기
13.메모장만들기2
14.메모장만들기3(스프래쉬화면과 리포지토리
15.델파이와 DB연결과 dbExpress
17.인사관리(편집과차)
18.부서관리
19.예외(Exception)처리
20.스토어드 프로시저
21.트랜잭션처리(최종)

2012년 10월 23일 화요일

TStringBuilder

2005 버전 부턴가(?) 델파이에도 TStringBuilder라는 클래스가 포함되었다.
당초에 델파이는 string 이라는 Type이 있고 이 타입은 아주 잘 설계되어 있었으며, Integer 나 Char 처럼 문자를 아주 간단하게 사용 할 수 있게 하였으며, 관련 함수들도 엄청 많이 준비되었습니다.

그후, 254 문자 이상을 처리하기 위하여, 기존의 string 을 AnsiString 이라고 바꾸고 새로운 방식의 string 타입을 사용케 하였으며, 포인트 처리를 돕기위하여 Pchar 연산이 보강되었습니다.

또, 델파이가 unicode를 지원하기 위하여 또한번의 변동이 이루어 졌습니다.
유니코드를 지원하기 위하여 기존의 2바이트 문자 처리용 Widestring 을 String으로 하고, 이전 1 바이트 쳬계의 문자 string을 AnsiString으로 바꾸고, 이전의 AnsiString 을 ShortString으로 바꾸었습니다.

극기야, 타언어와의 호환성 또는 속도 개선을 위하여 TStringBuilder라는 클래스가 만들어 졌습니다. 당초 파스칼과 베이직을 제외한 포인터 방식의 언어에서는 String을 기본 타입으로 가지고 있지 못 했기에 델파이와 같은 string 처리를 클래스화 하게 된게 아닌가 생각합니다(틀린 추측일 수 있습니다).

일단 살펴보면 속성은 Capacity, Chars, Length, MaxCapacity 가 있으며,
메소드로는 Append, Appendformat, AppendLine, Clear, CopyTo, Create, Equals, Free,
Insert, Remove Replace, ToString
등의 유용한 기능이 추가 되었습니다.

사용예)

procedure TForm3.Button2Click(Sender: TObject);
var iSb: TStringBuilder;
begin
iSb:= TStringBuilder.Create;
try
isb.Append('내이름은 %이름입니다.').Append(#13#10).Append('좋은 하루 되세요.');
isb.Replace('%이름', '이정귀');
memo1.Text:= isb.ToString;
finally
isb.Free;
end;
end;

Append 사용 방법이 좀 특이하지요. 계속하여 추가할 수 있고, InttoStr 사용하지 않아도 되고...

2012년 10월 22일 월요일

Class Helper

Delphi 2006 부터 추가된 기능으로 개체를 상속하지 않고 클래스를 확장 할 수 있는 방법입니다.
간단한 예제를 위하여
TEdit.Text 값을 Integer 값으로 불러 올 수 있는 기능을 구현 해 보렵니다.
1. Edit 컨트롤을 2개 올려 놓고 Edit1.text:= '2100'; Edit2.Text:= '3200';을 넣습니다.

2. type 문 가장 상단에 아래와 같은 형식으로 추가합니다.

type
TMyEditor = class helper for TEdit
function Value: integer;
end;

3. Ctrl + Shift + 'C"를 누르면

{ TMyEditor }
function TMyEditor.Value: integer;
begin

end;
이 만들어 집니다. begin end 사이에 아래 문장을 추가합니다.

if text <> '' then
result:= StrtoIntdef(text,0);

4. 그리고 버튼을 하나 올려 놓고 아래와 같이 추가합니다.

procedure TForm3.Button1Click(Sender: TObject);
begin
ShowMessageFmt('%d',[Edit1.Value + Edit2.Value]);
end;

5. TEdit 에 Value 라는 메소드가 추가 되었고, 디자인 타임에서도 적용 됨을 알 수 있습니다.
6. 다른 폼에서도 interface 의 uses 에 추가만 해준다면 그곳에서도 사용이 가능합니다.

7. Xe3 버전 부터는 Record Helper 라는 것이 추가 되었네요.

2012년 10월 19일 금요일

제네릭 이해를 돕기 위한 간단한 사용(TDictionary)

Generics 를 이해하기 위하여 Generics.collections 에 있는 클래스를 사용하면서 익히고 있습니다.
TDictionary 는 사전이라는 의미로 보면 좋겠습니다. 표제어(keys)가 있고 그 내용 설명(Values)이 있는 형식이요. 아래그림으로 이해에 도움이되시기를...

선언하고

var

Form3: TForm3;

iDictionary: TDictionary<string, integer>;

implementation

{$R *.dfm}

임의의 값으로 채워 출력하고

procedure TForm3.Button1Click(Sender: TObject);

var

idx: integer;

iStr: string;

iKey: string;

iValue: integer;

begin

for idx := 0 to 19 do begin

iValue := Random(65000);

iKey := 'Key' + IntToStr(iValue);

// if not iDictionary.ContainsKey(iKey) then iDictionary.Add(iKey, iValue);

iDictionary.AddOrSetValue(iKey, iValue);

end;

for iStr in iDictionary.Keys do begin

Memo1.Lines.Add(iStr + '=' + IntToStr(iDictionary.Items[iStr]));

end;

소팅하고 결과를 출력(소팅이 약간 이상하다?)

procedure TForm3.Button2Click(Sender: TObject);

var

iStr: string;

iArray: Tarray<string>;

begin

iArray := iDictionary.Keys.ToArray;

Tarray.Sort<string>(iArray);

memo1.Lines.Add('Sorted');

for iStr in iArray do begin // iArray 임에 주의

Memo1.Lines.Add(iStr+'='+IntToStr(iDictionary.Items[iStr]));

end;

생성하고 해제하고

procedure TForm3.FormCreate(Sender: TObject);

begin

iDictionary := TDictionary<string, integer>.Create;

end;

procedure TForm3.FormDestroy(Sender: TObject);

begin

iDictionary.Free;

end;

2012년 10월 18일 목요일

제네릭 이해를 돕기 위한 간단한 사용(TList)

우선 얼마전에 MyRecord 를 TList에 구겨 넣었던 것을 기억하실 것입니다.
그때 선언 방법과 비교해 보세요..
TMyClass = class
no: integer;
fname: string;
lname: string;
phone: string;
addr: string;
private
function GetName: string;
public
property name: string read GetName;
constructor create(ino:integer; ifname,ilname,iphone,iaddr: string);
end;
OOP는 여기에서 처럼 name을 얻을 수 있다는 것이 묘미가 아닐까요.
데이터와 메소드를 갖이 가지고 있으니까요?

1. 우선 객체(인스턴스)를 선언 하여야 겠지요.
private
MyList: TList<TMyClass>;
이게 제네릭문법입니다. TList<T>라는 클라스는 델파이가 만들어 놓았고, 어떠한 타입(형식)의 자료도 처리 할 수 있게 하여 주었습니다.

2. 폼 생성시 인스턴스를 만들고 폼이 닫일때 날려주어야 겠지요.
procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
var
idx: TMyClass;
begin
for idx in MyList do begin
idx.Free;
end;
MyList.Free;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
MyList:= TList<TMyClass>.Create;
end;

3. 자료를 TList에 넣습니다.
procedure TForm3.Button1Click(Sender: TObject);
var
idx: Integer;
iStrings: Tstrings;
begin
iStrings:= TstringList.Create;
try
for idx := 0 to StrHolder1.Strings.count - 1 do begin
iStrings.CommaText:= StrHolder1.Strings[idx];
if istrings.Count < 5 then continue;
MyList.Add(TMyClass.create( StrToInt(iStrings[0]), iStrings[1], iStrings[2], iStrings[3], iStrings[4]));
end;
finally
iStrings.Free;
end;
end

여기에 StrHolder 라는 RXLIB 컴포넌트를 사용하였는데 설치해 두변 편리 할 것입니다.
기본 컴포넌트 이외에 많이 설치하는 컴포넌트일 것입니다. 없으면 LIstBox를 폼에 올려 놓고 사용해서 되며, 파싱은 commaText 메소드를 이용합니다. 데이터는
1,이,정귀,515-5513,광주광역시 이런 형태로 만들어져 있습니다.

4. 넣어진 자료가 정상으로 잘 들어 갔는지 확인하기 위하여
procedure TForm3.Button2Click(Sender: TObject);
var
idx: TMyClass;
begin
ListBox2.Items.Clear;
for idx in MyList do
begin
listbox2.Items.Add(idx.GetName)
end;
end;

5. 당연히
function TMyClass.GetName: string;
begin
result:= fname + lname;
end;
도 있어야 겠지요...

6. 소팅을 해보겠습니다.
procedure TForm3.Button3Click(Sender: TObject);
begin
MyList.Sort(TComparer<TMyClass>.Construct(
function(const Item1, Item2: TMyClass): integer
begin
result := CompareText(Item1.fname, Item2.fname); // 다른 내용으로 해도 되겠지요
end));
end;

7. 당연히 Uses 절에 Generics.defaults, Generics.collections 을 추가합니다.
8. XE2 부턴 가는 Record 에서도 메소드를 포함 할 수 있습니다. Class 와 Record는 계승의 차이만 있나?

type
{
pMyRecord = ^MyRecord;
MyRecord = record
no: integer;
fname: string;
lname: string;
phone: string;
addr: string;
function GetName:string;
end;
}

9. GetName 을 구현하고...

function TMyRecord.GetName: string;
begin
Result:= FName + ' ' + LName;
end;

10. 리스트에 데이터 저장시

procedure TForm3.Button1Click(Sender: TObject);

var

idx: integer;

iStrings: Tstrings;

iRecord: TMyRecord;

begin

iStrings := TstringList.create;

try

for idx := 0 to StrHolder1.Strings.count - 1 do begin

iStrings.CommaText := StrHolder1.Strings[idx];

if iStrings.count < 5 then continue;

New(iRecord);

iRecord.no:= StrToInt(iStrings[0]);

iRecord.fname:= iStrings[1];

iRecord.lname:= iStrings[2];

iRecord.phone:= iStrings[3];

iRecord.addr:= iStrings[4];

iList.Add(iRecord);

end;

finally

iStrings.free;

end;

11. 내용 확인은

procedure TForm3.Button2Click(Sender: TObject);

var

idx: TMyRecord;

begin

for idx in iList do

ListBox1.Items.Add(idx.GetName);

end;

하면 됩니다.

제네릭 이해를 돕기 위한 간단한 사용(TCompare)

제네릭에는 TCompare 가 준비 되어 있습니다.

앞의 TArray 에서 소팅을 할때 기본적으로 올림차순으로 하였습니다.

자신만의 소팅을 하기위하여

1. 실제 비교 할 방법을 선언하고

private
function iThisCompare(const Left, Right: string): integer;

2. 구현하고

function TForm3.iThisCompare(const Left, Right: string): integer;
begin
Result:= CompareText(Left,Right);
end;

3. 소팅을 합니다.

procedure TForm3.Button4Click(Sender: TObject);
begin
TArray.Sort<string>(iArray,TComparer<string>.construct(iThisCompare))
end;

4. XE 버전 부턴가 익명메소드가 가능해 졌습니다.
위의 2에서 3 단계를 한방에 코딩하면

procedure TForm3.Button5Click(Sender: TObject);
begin
TArray.Sort<string>(iArray,TComparer<string>.construct(
function(const left, right: string): integer
begin
Result:= CompareText(Left, right);
end
));
end;

예전에 TList 에서는 @iCompareName 방법으로 불러 왔었지요.
참고 : MyList.Sort(@CompareName);

제네릭 이해를 돕기 위한 간단한 사용(TArray)

델파이가 2009 버전부터 Generic을 지원한다고하는데 아마추어 입장에서는 별로 변화를 못 느꼈습니다. 제네릭에 대한 일반적인 것은 도서를 참고하시고, 저는 Generics.Collectons 에 있는 델파이가 만들어 놓은 제네릭 클라스를 살펴보도록 하겠습니다.

당연 최상위는 Tobject 가 있고 그아래 TArray 가 있으며 그로부터 여러가지 클래스등이 있네요. 우선 TArray 를 살펴 보겠습니다. 이것은 class 메소드만으로 이루어 졌다고 보면 됩니다. 그중 중요한 것이 Create, Sort, BinarySearch 입니다.

uses Generics.Collections, Generics.Defaults;

{Test the Sort method of TArray}

procedure TForm1.Button1Click(Sender: TObject);

var

Arr: TArray<string>; //same as array of string

s: string;

begin

SetLength(arr, 5);

arr[0] := 'aaa';

arr[1] := 'AAA';

arr[2] := '111';

arr[3] := '333';

arr[4] := '222';

TArray.Sort<string>(arr);

Memo1.Clear;

for s in arr do Memo1.Lines.Add(s); //111 222 333 AAA aaa

end;

{Test TArray's BinarySearch method}

procedure TForm1.Button2Click(Sender: TObject);

var

Arr: TArray<Integer>; //same as array of Integer

i,n: Integer;

begin

SetLength(arr, 5);

for i := 0 to Length(arr) - 1 do arr[i] := Integer(Sqr(i));

Memo1.Clear;

for i := Low(arr) to High(arr) do Memo1.Lines.Add(IntToStr(arr[i]));

If TArray.BinarySearch<Integer>(arr, 4, n) then ShowMessage(IntToStr(n)); //2, which is the third

If TArray.BinarySearch<Integer>(arr, 5, n) then ShowMessage(IntToStr(n)); //When not found, can't judge according to the value of n

end;

{custom sorter}

procedure TForm1.Button3Click(Sender: TObject);

var

arr: TArray<Integer>;

num: Integer;

begin

SetLength(arr, 5);

arr[0] := 2;

arr[1] := 4;

arr[2] := 3;

arr[3] := 1;

arr[4] := 5;

TArray.Sort<Integer>(arr, TComparer<Integer>.Construct(

function (const a,b: Integer): Integer

begin

Result := b - a;

end

));

Memo1.Clear;

for num in arr do Memo1.Lines.Add(IntToStr(num)); //5 4 3 2 1

end;

2012년 10월 17일 수요일

VirtualTreeView 에 레코드 자료 넣기

VirtualTreeView에 Integer 자료를 넣어 보았는데, 만약 String 자료를 넣고 싶다면

1. 중간 매개자
var
iPData : PString; //Integer 일경우에는 PInteger 이었습니다.
2, 데이터 사이즈
NodeDataSize:= SizeOf(String) //Integer일 경우에는 SizeOf(Integer) 이었습니다.
3. 화면 표시
CellText:= iPData^; //Integer 일경우에는 InttoStr(iPData^); 이었습니다.

레코드 자료도 같은 방법으로 사용하면됩니다.
레코드 선언은

pMyRecord = ^MyREcord;
myRecord =record
no: integer;
name: string;
addr: string;
end;
와 같이하고, 예전에 List에 저장 할 경우에는 New 와 Dispose를 사용하였는데,
VirtualTreeView에서는 자체에서 메모리를 관리하므로 하지 않아도 됩니다.

1. 중간 매개자
var
iPData: pMyRecord;
2. 데이터 사이즈
NodeDataSize:= SizeOf(myRecord); //pmyRecord 가 아님
3. 화면 표시
화면에 표시 할 자료를 선정합니다. 여기서는 3개(no, name, addr) 다 표시합니다.
VTV 의 Header > Column... 을 크릭하여 Column 을 3개 추가 하고
각 Column 의 Text 와 Width 를 (순서: 50) , (이름: 100), (주소:100) 으로 설정합니다.
또한, Header > Options > hoVisible := True 로 합니다. (오브젝트 인스펙터에서).
그러면 VTV 에 해더가 나타납니다.

procedure TForm3.VirtualStringTree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
var iPData: pMyRecord;
begin
iPData:= Sender.GetNodeData(Node);
case Column of
0: CellText:= IntToStr(iPData.no);
1: CellText:= iPData.name;
2: CellText:= iPData.name;
end;
end;

각 걸럼의 CellText 를 Case 문으로 지정하여 주면 됩니다.

VST 의 TreeOptions > MiscOptions > toEditable := True 로 하면 F2 키로 편집이 되는데
다른 노드로 이동하면 원상이 되버립니다.
표시되는 값만 바뀌고 원 데이터는 아래와 같이 수정하여 주어야 합니다.
Events > OnNewText를 더블 크릭하여

procedure TForm3.VirtualStringTree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: string);
var iPData: pMyRecord;
begin
iPData:= Sender.GetNodeData(Node);
case Column of
0: iPData^.no:= StrToInt(NewText);
1: iPData^.name:= NewText;
2: iPData^.addr:= NewText;
end;
end;
하면 됩니다.

초 간단 버추얼트리뷰 예제 (개념잡기)

VirtualTreeView 는 공개된 컴포넌트 중에서 가장 쓸모 있는 것중 하나라고 할 수 있겠네요.

http://www.soft-gems.net/ 에가서 다운 받아 설치하면 됩니다.

기본 개념을 잡기 위하여 초 간단예제를 만들어 봅니다.

폼에 VirtualStringTree(이하 VST) 와 버튼을 올려 놓습니다.

랜덤 한 숫자 6500개를 생성하여 VST에 집어 넣어 보겠습니다.

1. 데이타는 노드에 집어 넣는데, 이 데이터의 길이를 지정해 줍니다.

- 여기서는 Integer로 넣으니 Integer 가 되겠네요.

- VST의 Event 에서 OnGetNodeDataSize를 더블크릭하여

procedure TForm3.VirtualStringTree1GetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);

begin

NodeDataSize:= SizeOf(Integer); // PInteger 가 아닙니다.

end;

2. VST가 저장된 데이터를 화면에 뿌려 주게 지정합니다.

- VST의 Event 에서 OnGetText를 더블 크릭하여

procedure TForm3.VirtualStringTree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;

TextType: TVSTTextType; var CellText: string);

var iPData: PInteger;

begin

iPData:= Sender.GetNodeData(Node);

CellText:= IntToStr(iPData^);

end;

3. 데이터를 VST에 넣습니다.

- Button을 더블크릭하여

procedure TForm3.Button1Click(Sender: TObject);

var idx: integer;

iNode: PVirtualNode;

iPData: PInteger;

begin

VirtualStringTree1.BeginUpdate;

for idx := 0 to 65000 do begin

iNode:= VirtualStringTree1.AddChild(nil);

iPData:= VirtualStringTree1.GetNodeData(iNode);

iPData^:= Random(65000);

end;

VirtualStringTree1.EndUpdate;

end;

순식간에 자료가 들어가 집니다.

2012년 10월 16일 화요일

TreeView Menu

트리뷰로 메뉴를 구현 해보겠습니다.

폼에 트리뷰와 액션리스트 와 이미지리스트를 올려 놓고 이미지 리스트에 적당한 이미지를 읽어 옵니다.
저는
C:\Users\Public\Documents\RAD Studio 9.0 Samples\Delphi\VCL\ActionBands
에 있는 main.pas 에서 이미지 리스트를 복사해옵니다.

ActionList 에 적당하게 액션을 만듭니다.
그리고 액션을 더블 크릭하여 실행문을 만듭니다.

트리뷰에 올릴 액션을 트리뷰를 더블 크릭하여 추가 합니다.

1. 액션을 액션리스트에 읽어와 트리뷰의 노트와 캡션을 비교하여 일치하면 액션을 DATA에 저장합니다.

2. 트리뷰의 OnChange 에서 선택된 액션이 실행 되게 합니다.

3. 액션이 실행 되면 실행된 액션의 캡션과 트리뷰의 노드의 캡션(text)이 일치하는 노드를 선택되게 합니다.

1 단계를 구현하기 위해서 트리뷰에서 캡션으로 찾는 루틴을 이용합니다( 재귀 호출)
이하 소스 갑니다.

unit MainUnit;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.ComCtrls, Vcl.ActnList;

type

TfrmMain = class(TForm)

ActionList1: TActionList;

acOpen: TAction;

acSave: TAction;

acShow: TAction;

acHide: TAction;

acExit: TAction;

TreeView1: TTreeView;

ImageList1: TImageList;

procedure FormCreate(Sender: TObject);

procedure TreeView1Change(Sender: TObject; Node: TTreeNode);

procedure ActionList1Execute(Action: TBasicAction; var Handled: Boolean);

procedure acOpenExecute(Sender: TObject);

procedure acSaveExecute(Sender: TObject);

procedure acShowExecute(Sender: TObject);

procedure acHideExecute(Sender: TObject);

procedure acExitExecute(Sender: TObject);

private

iActiveNode: TTreeNode;

procedure MakeTreeMenu;

function GetTVNodeByCaption(TV: TTreeView; const iCaption: string): TTreeNode;

function GetNodeByCaption(iTreeNode: TTreeNode; iCaption: string): TTreeNode;

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.acExitExecute(Sender: TObject);

begin

close;

end;

procedure TfrmMain.acHideExecute(Sender: TObject);

begin

caption:= 'Selected menu is Hide';

end;

procedure TfrmMain.acOpenExecute(Sender: TObject);

begin

caption:= 'Selected menu is Open';

end;

procedure TfrmMain.acSaveExecute(Sender: TObject);

begin

caption:= 'Selected menu is Save';

end;

procedure TfrmMain.acShowExecute(Sender: TObject);

begin

caption:= 'Selected menu is Show';

end;

procedure TfrmMain.ActionList1Execute(Action: TBasicAction; var Handled: Boolean);

var

iTreeNode: TTreeNode;

begin

if Action <> acExit then

if (Action is TAction) then

if (TreeView1.Selected <> nil) and (CompareText(TreeView1.Selected.Text, TAction(Action).Caption)= 0) then begin

iTreeNode:= GetTVNodeByCaption(TreeView1,TAction(Action).Caption);

if (iTreeNode <> nil) and (iTreeNode <> iActiveNode) then

iTreeNode.Selected:= True;

end;

procedure TfrmMain.FormCreate(Sender: TObject);

begin

iActiveNode:= nil;

MakeTreeMenu;

TreeView1.Items.GetFirstNode.Selected:= True;

end;

function TfrmMain.GetNodeByCaption(iTreeNode: TTreeNode; iCaption: string): TTreeNode;

var

jTreeNode: TTreeNode;

begin

Result:= nil;

jTreeNode:= iTreeNode;

while jTreeNode<> nil do begin

if CompareText(jTreeNode.Text, iCaption)=0 then begin

Result:= jTreeNode;

Exit;

end else begin

jTreeNode:= jTreeNode.getFirstChild;

while jTreeNode <> nil do begin

Result:= GetNodeByCaption(jTreeNode, iCaption); // 재귀호출

if Result <> nil then exit;

jTreeNode:= jTreeNode.GetNextChild(jTreeNode);

end;

function TfrmMain.GetTVNodeByCaption(TV: TTreeView; const iCaption: string): TTreeNode;

var

iTreeNode: TTreeNode;

begin

Result:= nil;

iTreeNode:= TV.Items.GetFirstNode;

while iTreeNode <> nil do begin

Result:= GetNodeByCaption(iTreeNode, iCaption); // 자손이 있으면 그 자손에서

if Result <> nil then exit;

iTreeNode:= iTreeNode.getNextSibling; // 다음 node 레벨에 관계없이

end;

procedure TfrmMain.MakeTreeMenu;

var

idx: Integer;

iTreeNode: TTreeNode;

iAction: TAction;

begin

// ActionList 에서 액션을 읽어 옵니다.

for idx := 0 to ActionList1.ActionCount -1 do begin

iAction:= (ActionList1.Actions[idx] as TAction);

if iAction is TAction then begin

iTreeNode:= GetTVNodeByCaption(TreeView1, iAction.Caption);

if iTreeNode <> nil then begin

if not iAction.Visible then

iTreeNode.Delete

else

if iAction.ImageIndex <> -1 then begin

iTreeNode.ImageIndex:= iAction.ImageIndex;

iTreeNode.SelectedIndex:= iAction.ImageIndex;

end;

iTreeNode.Data:= ActionList1.Actions[idx];

end;

procedure TfrmMain.TreeView1Change(Sender: TObject; Node: TTreeNode);

begin

if (Node <> nil) and (Node <> iActiveNode) then

if Assigned(Node.Data) and Assigned(TAction(Node.Data).OnExecute) then

TAction(Node.Data).Execute;

iActiveNode:= Node;

end;

end.