of 06Sep96) this will crash if two processes or threads
turn debugging on at the same time.
$owner: GroupWise SDK Team Lead
Copyright (c) 1998 Novell, Inc. All Rights Reserved.
THIS WORK IS SUBJECT TO U.S. AND INTERNATIONAL COPYRIGHT LAWS AND TREATIES.
USE AND REDISTRIBUTION OF THIS WORK IS SUBJECT TO THE LICENSE AGREEMENT
ACCOMPANYING THE SOFTWARE DEVELOPMENT KIT (SDK) THAT CONTAINS THIS WORK.
PURSUANT TO THE SDK LICENSE AGREEMENT, NOVELL HEREBY GRANTS TO DEVELOPER A
ROYALTY-FREE, NON-EXCLUSIVE LICENSE TO INCLUDE NOVELL'S SAMPLE CODE IN ITS
PRODUCT. NOVELL GRANTS DEVELOPER WORLDWIDE DISTRIBUTION RIGHTS TO MARKET,
DISTRIBUTE, OR SELL NOVELL'S SAMPLE CODE AS A COMPONENT OF DEVELOPER'S
PRODUCTS. NOVELL SHALL HAVE NO OBLIGATIONS TO DEVELOPER OR DEVELOPER'S
CUSTOMERS WITH RESPECT TO THIS CODE.
****************************************************************************/}
unit debug;
interface
uses sysutils, windows, messages, controls, filectrl, graphics, ole2,
GlobUtil, Forms, RichEdit;
procedure InitDebug;
procedure SendToTraceWindow(Buffer: string);
procedure WriteDebug(s:string);
procedure ResetDebug;
procedure SetDebugFile(s: string);
procedure SetDebugging(b: Boolean);
function GetDebugging: Boolean;
function BoolToStr(b:Boolean): string;
procedure SetTraceMessages(b: Boolean);
function GetTraceMessages: Boolean;
function GetTraceAllMessages: Boolean;
function GetDebugOle: Boolean;
procedure DebugMessage(s: string; m: longint);
procedure DebugOle(m: string; h: Hresult);
procedure WriteETC(formattc: TFormatEtc;
medium: PStgMedium);
procedure DebugMarshalFlags(mshlflags: longint);
procedure DebugMarshalContext(mshlctx: longint);
procedure DebugDropEffects(dwEffect: Longint);
procedure StartAddr;
procedure WriteAddr(s: string; p:pointer);
procedure EndAddr;
function DebugVariant(v: Variant): string;
procedure DebugWindow(s: string; Window: TForm);
procedure DebugModifiedFields(s: string; m: TFieldNameSet);
function MessageBox(s1: string):Integer;
implementation
uses IniFiles;
var
debugFilePath: string;
var
debugging: Boolean;
debugFile: string;
debuggingOle: Boolean;
traceMessages: Boolean;
traceEnterExit: Boolean;
traceAllMessages: Boolean;
indent: Integer;
addrIndex : 0..200;
addresses: class='delphiKeyword'>array[0..200] of Longint;
names: class='delphiKeyword'>array[0..200] of string;
marked: class='delphiKeyword'>array[0..200] of Boolean;
const
debugIniSection = 'Notes Debug';
debugDir = 'debug_dir';
debugTrace = 'trace';
debugTraceMessages = 'trace_messages';
debugTraceEnterExit = 'tracefunc';
debugTraceOle = 'traceole';
debugTraceAllMessages = 'trace_windows_messages';
NEWLINE = #10;
const
WM_CAPTURECHANGED = $0215;
WM_MOVING = $0216;
WM_ENTERSIZEMOVE = $0231;
WM_SETICON = $0080;
function BoolToStr(b: Boolean): string;
class='delphiKeyword'>begin
if (b) then
result := 'TRUE'
else
result := 'FALSE';
end;
procedure SendToTraceWindow(Buffer: string);
var
hTraceWnd: HWND;
cds: PCopyDataStruct;
hcds: hGlobal;
p: pChar;
h: HGlobal;
const
TRACEAPPNAME = 'TRACE';
TRACEWINDOWNAME = 'Message Trace';
class='delphiKeyword'>begin
hTraceWnd := FindWindow(TRACEAPPNAME, TRACEWINDOWNAME);
if (hTraceWnd <> 0) then
class='delphiKeyword'>begin
hcds := GlobalAlloc(GMEM_SHARE, sizeof(TCopyDataStruct));
cds := GlobalLock(hcds);
cds.dwData := clblack;
cds.cbData := length(Buffer)+1;
h := GlobalAlloc(GMEM_SHARE, 255);
p := GlobalLock(h);
Buffer := Buffer + NEWLINE;
strPCopy(p, Buffer);
cds.lpData := p;
SendMessage(hTraceWnd, WM_COPYDATA, 0, longint(cds));
GlobalUnlock(h);
GlobalFree(h);
GlobalUnlock(hcds);
GlobalFree(hcds);
end;
end;
Procedure InitDebug;
var
iniFile: TIniFile;
class='delphiKeyword'>begin
iniFile := TIniFile.Create('win.ini');
if (iniFile <> nil) then
class='delphiKeyword'>begin
debugFilePath := iniFile.ReadString(debugIniSection, debugDir, '');
if (iniFile.ReadString(debugIniSection, debugTrace, 'off') = 'on') then
Debugging := TRUE
else
Debugging := FALSE;
if (iniFile.ReadString(debugIniSection, debugTraceMessages, 'off') = 'on') then
traceMessages := TRUE
else
traceMessages := FALSE;
if (iniFile.ReadString(debugIniSection, debugTraceAllMessages, 'off') = 'on') then
traceAllMessages := TRUE
else
traceAllMessages := FALSE;
if (iniFile.ReadString(debugIniSection, debugTraceEnterExit, 'off') = 'on') then
traceEnterExit := TRUE
else
traceEnterExit := FALSE;
if (iniFile.ReadString(debugIniSection, debugTraceOle, 'off') = 'on') then
debuggingOle := TRUE
else
debuggingOle := FALSE;
if debugging class='delphiKeyword'>and (debugFilePath <> '') class='delphiKeyword'>and (not DirectoryExists(debugFilePath)) then
MkDir(debugFilePath);
iniFile.Free;
end;
end;
Procedure setDebugFile(s: string);
var
p: pChar;
i, j: Integer;
class='delphiKeyword'>begin
i := pos('.', s);
if (i > 0) then
class='delphiKeyword'>begin
s := Copy(s, i+1, Length(s));
for j := 1 to 4 do class='delphiKeyword'>begin
i := pos('.', s);
if (i > 0) then
s := Copy(s, i+1, Length(s));
end;
i := pos('.', s);
while (i > 0) do
class='delphiKeyword'>begin
Delete(s, i, 1);
i := pos('.', s);
end;
end;
if (debugFilePath <> '') then
debugFile := debugFilePath + '\' + s;
indent := 0;
if (FileExists(debugFile)) then
class='delphiKeyword'>begin
p := StrAlloc(255);
strPCopy(p,debugFile);
DeleteFile(p);
StrDispose(p);
end;
end;
procedure ResetDebug;
var
p: PChar;
class='delphiKeyword'>begin
if (debugFilePath <> '') then
class='delphiKeyword'>begin
if (not (DirectoryExists(DebugFilePath))) then
mkdir(DebugFilePath);
if (FileExists(debugFile)) then
class='delphiKeyword'>begin
p := StrAlloc(255);
strPCopy(p,debugFile);
DeleteFile(p);
StrDispose(p);
end;
indent := 0;
end;
end;
procedure SetDebugging(b: Boolean);
class='delphiKeyword'>begin
Debugging := b;
if (debugging) then
WriteDebug(DateToStr(Now) + ' ' + TimeToStr(Now));
end;
function GetDebugging: Boolean;
class='delphiKeyword'>begin
result := Debugging;
end;
procedure SetTraceMessages(b: Boolean);
class='delphiKeyword'>begin
traceMessages := b;
end;
function GetTraceMessages: Boolean;
class='delphiKeyword'>begin
result := traceMessages;
end;
function GetTraceAllMessages: Boolean;
class='delphiKeyword'>begin
result := traceAllMessages;
end;
function GetDebugOle: Boolean;
class='delphiKeyword'>begin
result := debuggingOle;
end;
procedure WriteDebug(s:string);
var
fh: text;
indents: string;
c: string;
i: integer;
Hour, Min, Sec, MSec: Word;
skip: Boolean;
class='delphiKeyword'>begin
if (debugging) then
class='delphiKeyword'>begin
if (debugFilePath <> '') then
class='delphiKeyword'>begin
AssignFile(fh, debugFile + IntToStr(GetCurrentThreadId));
if (not FileExists(debugFile + IntToStr(GetCurrentThreadId))) then
class='delphiKeyword'>begin
Rewrite(fh);
indent := 0;
end
else
Append(fh);
end;
c := copy(s, 0, 2);
if (c = '< ') then indent := indent - 2;
if (indent < 0) then indent := 0;
indentS := '';
for i := 0 to indent - 1 do
indentS := indentS + ' ';
DecodeTime(time, Hour, Min, Sec, MSec);
if (debugFilePath <> '') then
class='delphiKeyword'>begin
Write(fh, IntToStr(Hour) + '.' + IntToStr(min) + ':' +
IntToStr(Sec) + '.' + IntToStr(MSec));
Writeln(fh, '(' + IntToHex(GetCurrentProcessId, 8) + ') ' + indentS + s);
end;
skip := FALSE;
if (c = '> ') then
class='delphiKeyword'>begin
if traceEnterExit then
s := 'In' + copy(s, 1, length(s))
else
skip := TRUE;
end
else if (c = '< ') then
class='delphiKeyword'>begin
if traceEnterExit then
s := 'Out' + copy(s, 1, length(s))
else
skip := TRUE;
end;
if (not skip) then
SendToTraceWindow('[PID=' + IntToHex(GetCurrentProcessId, 8) + '][' + s + ']');
if (c = '> ') then indent := indent + 2;
if (indent > 80) then indent := 80;
if (debugFilePath <> '') then
CloseFile(fh);
end;
end;
procedure DebugMessage(s: string; m: longint);
class='delphiKeyword'>begin
if (TraceMessages) then
class='delphiKeyword'>case m of
wm_Null:
WriteDebug(s +'wm_Null');
wm_Create:
WriteDebug(s +'wm_Create');
wm_Destroy:
WriteDebug(s +'wm_Destroy');
wm_Move:
WriteDebug(s +'wm_Move');
wm_Size:
WriteDebug(s +'wm_Size');
wm_Activate:
WriteDebug(s +'wm_Activate');
wm_SetFocus:
WriteDebug(s +'wm_SetFocus');
wm_KillFocus:
WriteDebug(s +'wm_KillFocus');
wm_Enable:
WriteDebug(s +'wm_Enable');
wm_SetRedraw:
WriteDebug(s +'wm_SetRedraw');
wm_SetText:
WriteDebug(s +'wm_SetText');
wm_GetText:
WriteDebug(s +'wm_GetText');
wm_GetTextLength:
WriteDebug(s +'wm_GetTextLength');
wm_Paint:
WriteDebug(s +'wm_Paint');
wm_Close:
WriteDebug(s +'wm_Close');
wm_QueryEndSession:
WriteDebug(s +'wm_QueryEndSession');
wm_Quit:
WriteDebug(s +'wm_Quit');
wm_QueryOpen:
WriteDebug(s +'wm_QueryOpen');
wm_EraseBkGnd:
WriteDebug(s +'wm_EraseBkGnd');
wm_SysColorChange:
WriteDebug(s +'wm_SysColorChange');
wm_EndSession:
WriteDebug(s +'wm_EndSession');
wm_SystemError:
WriteDebug(s +'wm_SystemError');
wm_ShowWindow:
WriteDebug(s +'wm_ShowWindow');
wm_CtlColor:
WriteDebug(s +'wm_CtlColor');
WM_CTLCOLORMSGBOX:
WriteDebug(s +'WM_CTLCOLORMSGBOX');
WM_CTLCOLOREDIT:
WriteDebug(s +'WM_CTLCOLOREDIT');
WM_CTLCOLORLISTBOX:
WriteDebug(s +'WM_CTLCOLORLISTBOX');
WM_CTLCOLORBTN:
WriteDebug(s +'WM_CTLCOLORBTN');
WM_CTLCOLORDLG:
WriteDebug(s +'WM_CTLCOLORDLG');
WM_CTLCOLORSCROLLBAR:
WriteDebug(s +'WM_CTLCOLORSCROLLBAR');
WM_CTLCOLORSTATIC:
WriteDebug(s +'WM_CTLCOLORSTATIC');
wm_WinIniChange:
WriteDebug(s +'wm_WinIniChange');
wm_DevModeChange:
WriteDebug(s +'wm_DevModeChange');
wm_ActivateApp:
WriteDebug(s +'wm_ActivateApp');
wm_FontChange:
WriteDebug(s +'wm_FontChange');
wm_TimeChange:
WriteDebug(s +'wm_TimeChange');
wm_CancelMode:
WriteDebug(s +'wm_CancelMode');
wm_SetCursor:
WriteDebug(s +'wm_SetCursor');
wm_MouseActivate:
WriteDebug(s +'wm_MouseActivate');
wm_ChildActivate:
WriteDebug(s +'wm_ChildActivate');
wm_QueueSync:
WriteDebug(s +'wm_QueueSync');
wm_GetMinMaxInfo:
WriteDebug(s +'wm_GetMinMaxInfo');
wm_PaintIcon:
WriteDebug(s +'wm_PaintIcon');
wm_IconEraseBkGnd:
WriteDebug(s +'wm_IconEraseBkGnd');
wm_NextDlgCtl:
WriteDebug(s +'wm_NextDlgCtl');
wm_SpoolerStatus:
WriteDebug(s +'wm_SpoolerStatus');
wm_DrawItem:
WriteDebug(s +'wm_DrawItem');
wm_MeasureItem:
WriteDebug(s +'wm_MeasureItem');
wm_DeleteItem:
WriteDebug(s +'wm_DeleteItem');
wm_VKeyToItem:
WriteDebug(s +'wm_VKeyToItem');
wm_CharToItem:
WriteDebug(s +'wm_CharToItem');
wm_SetFont:
WriteDebug(s +'wm_SetFont');
wm_GetFont:
WriteDebug(s +'wm_GetFont');
wm_QueryDragIcon:
WriteDebug(s +'wm_QueryDragIcon');
wm_CompareItem:
WriteDebug(s +'wm_CompareItem');
wm_Compacting:
WriteDebug(s +'wm_Compacting');
wm_CommNotify:
WriteDebug(s +'wm_CommNotify');
wm_WindowPosChanging:
WriteDebug(s +'wm_WindowPosChanging');
wm_WindowPosChanged:
WriteDebug(s +'wm_WindowPosChanged');
wm_Power:
WriteDebug(s +'wm_Power');
wm_NCCreate:
WriteDebug(s +'wm_NCCreate');
wm_NCDestroy:
WriteDebug(s +'wm_NCDestroy');
wm_NCCalcSize:
WriteDebug(s +'wm_NCCalcSize');
wm_NCHitTest:
WriteDebug(s +'wm_NCHitTest');
wm_NCPaint:
WriteDebug(s +'wm_NCPaint');
wm_NCActivate:
WriteDebug(s +'wm_NCActivate');
wm_GetDlgCode:
WriteDebug(s +'wm_GetDlgCode');
wm_NCMouseMove:
WriteDebug(s +'wm_NCMouseMove');
wm_NCLButtonDown:
WriteDebug(s +'wm_NCLButtonDown');
wm_NCLButtonUp:
WriteDebug(s +'wm_NCLButtonUp');
wm_NCLButtonDblClk:
WriteDebug(s +'wm_NCLButtonDblClk');
wm_NCRButtonDown:
WriteDebug(s +'wm_NCRButtonDown');
wm_NCRButtonUp:
WriteDebug(s +'wm_NCRButtonUp');
wm_NCRButtonDblClk:
WriteDebug(s +'wm_NCRButtonDblClk');
wm_NCMButtonDown:
WriteDebug(s +'wm_NCMButtonDown');
wm_NCMButtonUp:
WriteDebug(s +'wm_NCMButtonUp');
wm_NCMButtonDblClk:
WriteDebug(s +'wm_NCMButtonDblClk');
wm_KeyDown:
WriteDebug(s +'wm_KeyDown');
wm_KeyUp:
WriteDebug(s +'wm_KeyUp');
wm_Char:
WriteDebug(s +'wm_Char');
wm_DeadChar:
WriteDebug(s +'wm_DeadChar');
wm_SysKeyDown:
WriteDebug(s +'wm_SysKeyDown');
wm_SysKeyUp:
WriteDebug(s +'wm_SysKeyUp');
wm_SysChar:
WriteDebug(s +'wm_SysChar');
wm_SysDeadChar:
WriteDebug(s +'wm_SysDeadChar');
wm_KeyLast:
WriteDebug(s +'wm_KeyLast');
wm_InitDialog:
WriteDebug(s +'');
wm_Command:
WriteDebug(s +'wm_Command');
wm_SysCommand:
WriteDebug(s +'wm_SysCommand');
wm_Timer:
WriteDebug(s +'wm_Timer');
wm_HScroll:
WriteDebug(s +'wm_HScroll');
wm_VScroll:
WriteDebug(s +'wm_VScroll');
wm_InitMenu:
WriteDebug(s +'wm_InitMenu');
wm_InitMenuPopup:
WriteDebug(s +'wm_InitMenuPopup');
wm_MenuSelect:
WriteDebug(s +'wm_MenuSelect');
wm_MenuChar:
WriteDebug(s +'wm_MenuChar');
wm_EnterIdle:
WriteDebug(s +'wm_EnterIdle');
wm_MouseMove:
WriteDebug(s +'wm_MouseMove');
wm_LButtonDown:
WriteDebug(s +'wm_LButtonDown');
wm_LButtonUp:
WriteDebug(s +'wm_LButtonUp');
wm_LButtonDblClk:
WriteDebug(s +'wm_LButtonDblClk');
wm_RButtonDown:
WriteDebug(s +'wm_RButtonDown');
wm_RButtonUp:
WriteDebug(s +'wm_RButtonUp');
wm_RButtonDblClk:
WriteDebug(s +'wm_RButtonDblClk');
wm_MButtonDown:
WriteDebug(s +'wm_MButtonDown');
wm_MButtonUp:
WriteDebug(s +'wm_MButtonUp');
wm_MButtonDblClk:
WriteDebug(s +'wm_MButtonDblClk');
wm_ParentNotify:
WriteDebug(s +'wm_ParentNotify');
wm_MDICreate:
WriteDebug(s +'wm_MDICreate');
wm_MDIDestroy:
WriteDebug(s +'wm_MDIDestroy');
wm_MDIActivate:
WriteDebug(s +'wm_MDIActivate');
wm_MDIRestore:
WriteDebug(s +'wm_MDIRestore');
wm_MDINext:
WriteDebug(s +'wm_MDINext');
wm_MDIMaximize:
WriteDebug(s +'wm_MDIMaximize');
wm_MDITile:
WriteDebug(s +'wm_MDITile');
wm_MDICascade:
WriteDebug(s +'wm_MDICascade');
wm_MDIIconArrange:
WriteDebug(s +'wm_MDIIconArrange');
wm_MDIGetActive:
WriteDebug(s +'wm_MDIGetActive');
wm_MDISetMenu:
WriteDebug(s +'wm_MDISetMenu');
wm_DropFiles:
WriteDebug(s +'wm_DropFiles');
wm_Cut:
WriteDebug(s +'wm_Cut');
wm_Copy:
WriteDebug(s +'wm_Copy');
wm_Paste:
WriteDebug(s +'wm_Paste');
wm_Clear:
WriteDebug(s +'wm_Clear');
wm_Undo:
WriteDebug(s +'wm_Undo');
wm_RenderFormat:
WriteDebug(s +'wm_RenderFormat');
wm_RenderAllFormats:
WriteDebug(s +'wm_RenderAllFormats');
wm_DestroyClipboard:
WriteDebug(s +'wm_DestroyClipboard');
wm_DrawClipboard:
WriteDebug(s +'wm_DrawClipboard');
wm_PaintClipboard:
WriteDebug(s +'wm_PaintClipboard');
wm_VScrollClipboard:
WriteDebug(s +'wm_VScrollClipboard');
wm_SizeClipboard:
WriteDebug(s +'wm_SizeClipboard');
wm_AskCBFormatName:
WriteDebug(s +'wm_AskCBFormatName');
wm_ChangeCBChain:
WriteDebug(s +'wm_ChangeCBChain');
wm_HScrollClipboard:
WriteDebug(s +'wm_HScrollClipboard');
wm_QueryNewPalette:
WriteDebug(s +'wm_QueryNewPalette');
wm_PaletteIsChanging:
WriteDebug(s +'wm_PaletteIsChanging');
wm_PaletteChanged:
WriteDebug(s +'wm_PaletteChanged');
wm_PenWinFirst:
WriteDebug(s +'wm_PenWinFirst');
wm_PenWinLast:
WriteDebug(s +'wm_PenWinLast');
wm_Coalesce_First:
WriteDebug(s +'wm_Coalesce_First');
wm_Coalesce_Last:
WriteDebug(s +'wm_Coalesce_Last');
CM_ACTIVATE:
WriteDebug(s + 'CM_ACTIVATE');
CM_DEACTIVATE:
WriteDebug(s + 'CM_ACTIVATE');
CM_GOTFOCUS:
WriteDebug(s + 'CM_GOTFOCUS');
CM_LOSTFOCUS:
WriteDebug(s + 'CM_LOSTFOCUS');
CM_CANCELMODE:
WriteDebug(s + 'CM_CANCELMODE');
CM_DIALOGKEY:
WriteDebug(s + 'CM_DIALOGKEY');
CM_DIALOGCHAR:
WriteDebug(s + 'CM_DIALOGCHAR');
CM_FOCUSCHANGED:
WriteDebug(s + 'CM_FOCUSCHANGED');
CM_PARENTFONTCHANGED:
WriteDebug(s + 'CM_PARENTFONTCHANGED');
CM_PARENTCOLORCHANGED:
WriteDebug(s + 'CM_PARENTCOLORCHANGED');
CM_HITTEST:
WriteDebug(s + 'CM_HITTEST');
CM_VISIBLECHANGED:
WriteDebug(s + 'CM_VISIBLECHANGED');
CM_ENABLEDCHANGED:
WriteDebug(s + 'CM_ENABLEDCHANGED');
CM_COLORCHANGED:
WriteDebug(s + 'CM_COLORCHANGED');
CM_FONTCHANGED:
WriteDebug(s + 'CM_FONTCHANGED');
CM_CURSORCHANGED:
WriteDebug(s + 'CM_CURSORCHANGED');
CM_CTL3DCHANGED:
WriteDebug(s + 'CM_CTL3DCHANGED');
CM_PARENTCTL3DCHANGED:
WriteDebug(s + 'CM_PARENTCTL3DCHANGED');
CM_TEXTCHANGED:
WriteDebug(s + 'CM_TEXTCHANGED');
CM_MOUSEENTER:
WriteDebug(s + 'CM_MOUSEENTER');
CM_MOUSELEAVE:
WriteDebug(s + 'CM_MOUSELEAVE');
CM_MENUCHANGED:
WriteDebug(s + 'CM_MENUCHANGED');
CM_APPKEYDOWN:
WriteDebug(s + 'CM_APPKEYDOWN');
CM_APPSYSCOMMAND:
WriteDebug(s + 'CM_APPSYSCOMMAND');
CM_BUTTONPRESSED:
WriteDebug(s + 'CM_BUTTONPRESSED');
CM_SHOWINGCHANGED:
WriteDebug(s + 'CM_SHOWINGCHANGED');
CM_ENTER:
WriteDebug(s + 'CM_ENTER');
CM_EXIT:
WriteDebug(s + 'CM_EXIT');
CM_DESIGNHITTEST:
WriteDebug(s + 'CM_DESIGNHITTEST');
CM_ICONCHANGED:
WriteDebug(s + 'CM_ICONCHANGED');
CM_WANTSPECIALKEY:
WriteDebug(s + 'CM_WANTSPECIALKEY');
CM_INVOKEHELP:
WriteDebug(s + 'CM_INVOKEHELP');
CM_WINDOWHOOK:
WriteDebug(s + 'CM_WINDOWHOOK');
CM_RELEASE:
WriteDebug(s + 'CM_RELEASE');
CM_SHOWHINTCHANGED:
WriteDebug(s + 'CM_SHOWHINTCHANGED');
CM_PARENTSHOWHINTCHANGED:
WriteDebug(s + 'CM_PARENTSHOWHINTCHANGED');
CM_SYSCOLORCHANGE:
WriteDebug(s + 'CM_SYSCOLORCHANGE');
CM_WININICHANGE:
WriteDebug(s + 'CM_WININICHANGE');
CM_FONTCHANGE:
WriteDebug(s + 'CM_FONTCHANGE');
CM_TIMECHANGE:
WriteDebug(s + 'CM_TIMECHANGE');
CN_BASE:
WriteDebug(s + 'CN_BASE');
CN_CHARTOITEM:
WriteDebug(s + 'CN_CHARTOITEM');
CN_COMMAND:
WriteDebug(s + 'CN_COMMAND');
CN_COMPAREITEM:
WriteDebug(s + 'CN_COMPAREITEM');
CN_DELETEITEM:
WriteDebug(s + 'CN_DELETEITEM');
CN_DRAWITEM:
WriteDebug(s + 'CN_DRAWITEM');
CN_HSCROLL:
WriteDebug(s + 'CN_HSCROLL');
CN_MEASUREITEM:
WriteDebug(s + 'CN_MEASUREITEM');
CN_PARENTNOTIFY:
WriteDebug(s + 'CN_PARENTNOTIFY');
CN_VKEYTOITEM:
WriteDebug(s + 'CN_VKEYTOITEM');
CN_VSCROLL:
WriteDebug(s + 'CN_VSCROLL');
CN_KEYDOWN:
WriteDebug(s + 'CN_KEYDOWN');
CN_KEYUP:
WriteDebug(s + 'CN_KEYUP');
CN_CHAR:
WriteDebug(s + 'CN_CHAR');
CN_SYSKEYDOWN:
WriteDebug(s + 'CN_SYSKEYDOWN');
CN_SYSCHAR:
WriteDebug(s + 'CN_SYSCHAR');
WM_ENTERMENULOOP:
WriteDebug(s + 'WM_ENTERMENULOOP');
WM_CAPTURECHANGED:
WriteDebug(s + 'WM_CAPTURECHANGED');
WM_MOVING:
WriteDebug(s + 'WM_MOVING');
WM_ENTERSIZEMOVE:
WriteDebug(s + 'WM_ENTERSIZEMOVE');
WM_SETICON:
WriteDebug(s + 'WM_SETICON');
WM_CONTEXTMENU:
WriteDebug(s + 'WM_CONTEXTMENU');
WM_PRINTCLIENT:
WriteDebug(s + 'WM_PRINTCLIENT');
EM_GETLIMITTEXT:
WriteDebug(s + 'EM_GETLIMITTEXT');
EM_POSFROMCHAR:
WriteDebug(s + 'EM_POSFROMCHAR');
EM_CHARFROMPOS:
WriteDebug(s + 'EM_CHARFROMPOS');
EM_SCROLLCARET:
WriteDebug(s + 'EM_SCROLLCARET');
EM_CANPASTE:
WriteDebug(s + 'EM_CANPASTE');
EM_DISPLAYBAND:
WriteDebug(s + 'EM_DISPLAYBAND');
EM_EXGETSEL:
WriteDebug(s + 'EM_EXGETSEL');
EM_EXLIMITTEXT:
WriteDebug(s + 'EM_EXLIMITTEXT');
EM_EXLINEFROMCHAR:
WriteDebug(s + 'EM_EXLINEFROMCHAR');
EM_EXSETSEL:
WriteDebug(s + 'EM_EXSETSEL');
EM_FINDTEXT:
WriteDebug(s + 'EM_FINDTEXT');
EM_FORMATRANGE:
WriteDebug(s + 'EM_FORMATRANGE');
EM_GETCHARFORMAT:
WriteDebug(s + 'EM_GETCHARFORMAT');
EM_GETEVENTMASK:
WriteDebug(s + 'EM_GETEVENTMASK');
EM_GETOLEINTERFACE:
WriteDebug(s + 'EM_GETOLEINTERFACE');
EM_GETPARAFORMAT:
WriteDebug(s + 'EM_GETPARAFORMAT');
EM_GETSELTEXT:
WriteDebug(s + 'EM_GETSELTEXT');
EM_HIDESELECTION:
WriteDebug(s + 'EM_HIDESELECTION');
EM_PASTESPECIAL:
WriteDebug(s + 'EM_PASTESPECIAL');
EM_REQUESTRESIZE:
WriteDebug(s + 'EM_REQUESTRESIZE');
EM_SELECTIONTYPE:
WriteDebug(s + 'EM_SELECTIONTYPE');
EM_SETBKGNDCOLOR:
WriteDebug(s + 'EM_SETBKGNDCOLOR');
EM_SETCHARFORMAT:
WriteDebug(s + 'EM_SETCHARFORMAT');
EM_SETEVENTMASK:
WriteDebug(s + 'EM_SETEVENTMASK');
EM_SETOLECALLBACK:
WriteDebug(s + 'EM_SETOLECALLBACK');
EM_SETPARAFORMAT:
WriteDebug(s + 'EM_SETPARAFORMAT');
EM_SETTARGETDEVICE:
WriteDebug(s + 'EM_SETTARGETDEVICE');
EM_STREAMIN:
WriteDebug(s + 'EM_STREAMIN');
EM_STREAMOUT:
WriteDebug(s + 'EM_STREAMOUT');
EM_GETTEXTRANGE:
WriteDebug(s + 'EM_GETTEXTRANGE');
EM_FINDWORDBREAK:
WriteDebug(s + 'EM_FINDWORDBREAK');
EM_SETOPTIONS:
WriteDebug(s + 'EM_SETOPTIONS');
EM_GETOPTIONS:
WriteDebug(s + 'EM_GETOPTIONS');
EM_FINDTEXTEX:
WriteDebug(s + 'EM_FINDTEXTEX');
EM_SETPUNCTUATION:
WriteDebug(s + 'EM_SETPUNCTUATION');
EM_GETPUNCTUATION:
WriteDebug(s + 'EM_GETPUNCTUATION');
EM_SETWORDWRAPMODE:
WriteDebug(s + 'EM_SETWORDWRAPMODE');
EM_GETWORDWRAPMODE:
WriteDebug(s + 'EM_GETWORDWRAPMODE');
EM_SETIMECOLOR:
WriteDebug(s + 'EM_SETIMECOLOR');
EM_GETIMECOLOR:
WriteDebug(s + 'EM_GETIMECOLOR');
else
WriteDebug(s +IntToHex(m, 8));
end;
end;
procedure DebugOle(m: string; h: Hresult);
var s: string;
class='delphiKeyword'>begin
if (h = DRAGDROP_S_CANCEL) then
s := 'DRAGDROP_S_CANCEL'
else if (h = DRAGDROP_S_DROP) then
s := 'DRAGDROP_S_DROP'
else if (h = ResultCode(DV_E_FORMATETC)) then
s := 'DV_E_FORMATETC'
else if (h = ResultCode(S_OK)) then
s := 'S_OK'
else if (h = ResultCode(E_NOTIMPL)) then
s := 'E_NOTIMPL'
else if (h = ResultCode(S_FALSE)) then
s := 'S_FALSE'
else if (h = ResultCode(E_NOINTERFACE)) then
s := 'E_NOINTERFACE'
else if (h = ResultCode(DRAGDROP_S_CANCEL)) then
s := 'DRAGDROP_S_CANCEL'
else if (h = ResultCode(NOERROR)) then
s := 'NOERROR'
else if (h = ResultCode(DRAGDROP_S_DROP)) then
s := 'DRAGDROP_S_DROP'
else if (h = DRAGDROP_S_USEDEFAULTCURSORS) then
s := 'DRAGDROP_S_USEDEFAULTCURSORS'
else if (h = ResultCode(E_FAIL)) then
s := 'E_FAIL'
else
s := IntToHex(h, 8);
WriteDebug(m + s);
end;
procedure WriteETC(formattc: TFormatEtc;
medium: PStgMedium);
var
s: string;
class='delphiKeyword'>begin
WriteDebug('Formattc.cfFormat : ' + IntToHex(Formattc.cfFormat, 8));
WriteDebug('Formattc.ptd : ' + IntToHex(Longint(Formattc.ptd),8));
class='delphiKeyword'>case Formattc.dwAspect of
DVASPECT_CONTENT:
s := 'DVASPECT_CONTENT';
DVASPECT_THUMBNAIL:
s := 'DVASPECT_THUMBNAIL';
DVASPECT_ICON:
s := 'DVASPECT_ICON';
DVASPECT_DOCPRINT:
s := 'DVASPECT_DOCPRINT';
end;
WriteDebug('Formattc.dwAspect : ' + s);
WriteDebug('Formattc.lindex : ' + IntToStr(Formattc.lindex));
class='delphiKeyword'>case Formattc.tyMed of
TYMED_HGLOBAL:
s := 'TYMED_HGLOBAL';
TYMED_FILE:
s := 'TYMED_FILE';
TYMED_ISTREAM:
s := 'TYMED_ISTREAM';
TYMED_ISTORAGE:
s := 'TYMED_ISTORAGE';
TYMED_GDI:
s := 'TYMED_GDI';
TYMED_MFPICT:
s := 'TYMED_MFPICT';
TYMED_ENHMF:
s := 'TYMED_ENHMF';
TYMED_NULL:
s := 'TYMED_NULL';
end;
WriteDebug('Formattc.tymed : ' + s);
if (Medium <> nil) then
class='delphiKeyword'>begin
class='delphiKeyword'>case Medium.Tymed of
TYMED_HGLOBAL:
s := 'TYMED_HGLOBAL: ' + IntToHex(Longint(Medium.hGlobal),8);
TYMED_FILE:
class='delphiKeyword'>begin
s := 'TYMED_FILE';
end;
TYMED_ISTREAM:
s := 'TYMED_ISTREAM: ' + IntToHex(Longint(Medium.stm),8);
TYMED_ISTORAGE:
s := 'TYMED_ISTORAGE: ' + IntToHex(Longint(Medium.stg),8);
TYMED_GDI:
s := 'TYMED_GDI: ' + IntToHex(Longint(Medium.hBitmap),8);
TYMED_MFPICT:
s := 'TYMED_MFPICT: ' + IntToHex(Longint(Medium.hMetaFilePict),8);
TYMED_ENHMF:
s := 'TYMED_ENHMF: '+ IntToHex(Longint(Medium.hEnhMetaFile),8);
TYMED_NULL:
s := 'TYMED_NULL';
end;
WriteDebug('Medium.tymed : ' + s);
end;
end;
procedure DebugMarshalFlags(mshlflags: longint);
var
s: string;
class='delphiKeyword'>begin
s := '';
class='delphiKeyword'>case mshlflags of
MSHLFLAGS_NORMAL:
s := 'MSHLFLAGS_NORMAL';
MSHLFLAGS_TABLESTRONG:
s := 'MSHLFLAGS_TABLESTRONG';
MSHLFLAGS_TABLEWEAK:
s := 'MSHLFLAGS_TABLEWEAK';
end;
WriteDebug('mshlflags: ' + s);
end;
procedure DebugMarshalContext(mshlctx: longint);
var
s: string;
class='delphiKeyword'>begin
s := '';
class='delphiKeyword'>case mshlctx of
MSHCTX_LOCAL:
s := 'MSHCTX_LOCAL';
MSHCTX_NOSHAREDMEM:
s := 'MSHCTX_NOSHAREDMEM';
MSHCTX_DIFFERENTMACHINE:
s := 'MSHCTX_DIFFERENTMACHINE';
MSHCTX_INPROC:
s := 'MSHCTX_INPROC';
end;
WriteDebug('mshlctx: ' + s);
end;
procedure DebugDropEffects(dwEffect: Longint);
var
s: string;
class='delphiKeyword'>begin
s := '';
if (dwEffect = DROPEFFECT_NONE) then
s := 'DROPEFFECT_NONE';
if (dwEffect class='delphiKeyword'>and DROPEFFECT_COPY) <> 0 then
s := s + ' DROPEFFECT_COPY';
if (dwEffect class='delphiKeyword'>and DROPEFFECT_MOVE) <> 0 then
s := s + ' DROPEFFECT_MOVE';
if (dwEffect class='delphiKeyword'>and DROPEFFECT_LINK) <> 0 then
s := s + ' DROPEFFECT_LINK';
if (dwEffect class='delphiKeyword'>and DROPEFFECT_SCROLL) <> 0 then
s := s + ' DROPEFFECT_SCROLL';
WriteDebug('dweffect: ' + s);
end;
procedure StartAddr;
class='delphiKeyword'>begin
AddrIndex := 0;
end;
procedure WriteAddr(s: string; p:pointer);
class='delphiKeyword'>begin
WriteDebug(s + IntToHex(Longint(p), 8));
Addresses[AddrIndex] := Longint(p);
Names[AddrIndex] := s;
Marked[AddrIndex] := False;
AddrIndex := AddrIndex + 1;
end;
procedure EndAddr;
var
i,j: integer;
theAddr: longint;
theIndex : 0 .. 200;
class='delphiKeyword'>begin
theAddr := Addresses[0];
theIndex := 0;
for i := 0 to AddrIndex - 1 do class='delphiKeyword'>begin
for j := 0 to AddrIndex - 1 do class='delphiKeyword'>begin
if (not Marked[j]) then
if (addresses[j] < theAddr) then
class='delphiKeyword'>begin
TheAddr := addresses[j];
theIndex := j;
end;
end;
Marked[theIndex] := TRUE;
WriteDebug(IntToHex(TheAddr, 8) + ': ' + Names[theIndex]);
theAddr := $7FFFFFFF;
end;
end;
function DebugVariant(v: Variant): string;
class='delphiKeyword'>begin
class='delphiKeyword'>case (VarType(v)) of
varEmpty:
result := 'varEmpty';
varNull:
result := 'varNull';
varSmallint:
result := 'varSmallint ' + IntToHex(TVarData(v).VSmallint, 8);
varInteger:
result := 'varInteger ' + IntToHex(TVarData(v).VInteger, 8);
varSingle:
result := 'varSingle ' + IntToHex(Longint(TVarData(v).VSingle), 8);
varDouble:
result := 'varDouble';
varCurrency:
result := 'varCurrency';
varDate:
result := 'varDate';
varOleStr:
result := 'varOleStr';
varDispatch:
result := 'varDispatch ' + IntToHex(Longint(TVarData(v).VDispatch), 8);
varError:
result := 'varError';
varBoolean:
result := 'varBoolean ' + IntToHex(Longint(TVarData(v).VBoolean), 8);
varVariant:
result := 'varVariant';
varUnknown:
result := 'varUnknown';
varString:
result := 'varString ' + IntToHex(Longint(TVarData(v).VString), 8);
varTypeMask:
result := 'varTypeMask';
varByRef:
result := 'varByRef';
end;
if (TVarData(v).VType class='delphiKeyword'>and varByRef) <> 0 then
result := 'ByRef - ' + result;
end;
procedure DebugWindow(s: string; Window: TForm);
class='delphiKeyword'>begin
WriteDebug(s +
IntToStr(Longint(Window.left)) + ',' +
IntToStr(Longint(Window.top)) + ',' +
IntToStr(Longint(Window.width)) + ',' +
IntToStr(Longint(Window.height)));
end;
procedure DebugModifiedFields(s: string; m: TFieldNameSet);
var
s2: string;
i: TFieldNames;
const
debugStrings: class='delphiKeyword'>array [Low(TfieldNames).. High(TfieldNames)] of string =
('FieldStickyId',
'FieldAuthor',
'FieldEditable',
'FieldStartDate',
'FieldStartTime',
'FieldDateCreated',
'FieldTimeCreated',
'FieldColor',
'FieldTextColor',
'FieldViewState',
'FieldSubjectViewState',
'FieldShowingMenuBar',
'FieldShowingButtonBar',
'FieldOpenedPosition',
'FieldOpenedSize',
'FieldMinimizedPosition',
'FieldSubject',
'FieldText',
'FieldMailing',
'FieldDocked',
'FieldAccepted',
'FieldNoteType');
class='delphiKeyword'>begin
s2 := '[';
for i := Low(TfieldNames) to High(TFieldNames) do
class='delphiKeyword'>begin
if (i in m) then
class='delphiKeyword'>begin
if Length(s2) > 1 then
s2 := s2 + ',';
s2 := s2 + debugStrings[i];
end;
end;
s2 := s2 + ']';
WriteDebug(s + s2);
end;
function MessageBox(s1: string): Integer;
var
c1, c2: class='delphiKeyword'>array[0..255] of char;
class='delphiKeyword'>begin
strpcopy(c1, s1);
strpcopy(c2, 'Debug');
result := Windows.MessageBox(0, c1, c2, MB_OKCANCEL);
end;
end.