1 files changed, 51 insertions, 0 deletions
diff --git a/win/tkWinInit.c b/win/tkWinInit.c
index 4a327a2..b1b2d6b 100644
--- a/win/tkWinInit.c
+++ b/win/tkWinInit.c
@@ -159,6 +159,57 @@ TkpDisplayWarning(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * Win32ErrorObj --
+ *
+ *	Returns a string object containing text from a COM or Win32 error code
+ *
+ * Results:
+ *	A Tcl_Obj containing the Win32 error message.
+ *
+ * Side effects:
+ *	Removed the error message from the COM threads error object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TkWin32ErrorObj(
+    HRESULT hrError)
+{
+    LPTSTR lpBuffer = NULL, p = NULL;
+    TCHAR  sBuffer[30];
+    Tcl_Obj* errPtr = NULL;
+
+    FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM
+	    | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError,
+	    LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL);
+
+    if (lpBuffer == NULL) {
+	lpBuffer = sBuffer;
+	wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError);
+    }
+
+    if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) {
+	*p = TEXT('\0');
+    }
+
+#ifdef _UNICODE
+    errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer));
+#else
+    errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
+#endif /* _UNICODE */
+
+    if (lpBuffer != sBuffer) {
+	LocalFree((HLOCAL)lpBuffer);
+    }
+
+    return errPtr;
+}
+
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4