udfGUIDFromByteArray (GUIDByteArray)
;==========================================================================================================================================
; udflib.GUID.WBT  v.1.03  20031104                                                                                  Detlev Dalitz.20020625
;==========================================================================================================================================
; WinBatch User Defined Functions to create
; Globally Unique Identifier (GUID) (UUID) (CLSID)
;
; - as Binary Buffer,      e.g  Handle to a 16-byte-sized binary buffer.
;
; - as formatted String,   e.g. {95AFCBA7-8822-11D6-9280-0000B4704984}
;
; - as Array[16] of Byte,  e.g. 160,203,175,149,34,136,214,17,146,128,0,0,180,112,73,132
; - as Array[4]  of Long,  e.g. -1783641181,299272226,32914,-2075561804
;                          Maybe useful for database storage purposes.
;
; If someone needs unique identifiers for whatever purposes however,
; Microsoft supports some routines to create and handle unique numbers.
; Developers typically assign a Universal Unique Identifier
; (UUID, interchangeable with the term GUID, or Globally Unique Identifier)
; for example to each OLE interface.
;
; Use this function when you need an absolutely unique number
; that you will use as a persistent identifier in a distributed environment,
; for example unique naming of mountable drives.
;
; To a very high degree of certainty, this function returns a unique value –
; no other invocation, on the same or any other system (networked or not),
; should return the same value.
;
; A UUID is a string that contains a set of hexadecimal digits.
; The textual representation of a UUID is a string consisting of 8 hexadecimal digits
; followed by a hyphen,
; followed by three hyphen-separated groups of 4 hexadecimal digits,
; followed by a hyphen,
; followed by 12 hexadecimal digits.
;
; Example: {F9043C85-F6F2-101A-A3C9-08002B2F49FB}
;
; The 128-bit-number range is so large that reaching the end of this area seems
; to be impossible in the next few years ...
; ... follow the lyrics of Kraig Brockschmidt in his book "Inside OLE", Microsoft Press.
;
; Detlev Dalitz.20020625.20020911.20030108.20030119.20031104.
;==========================================================================================================================================


;==========================================================================================================================================
; udfGUIDCreateBB ()                                                                                                  ; 2002:09:11:18:51:52
; udfGUIDCreateStr ()                                                                                                 ; 2002:09:11:18:51:52
; udfGUIDCreateList ()                                                                                                ; 2002:09:11:18:51:52
; udfGUIDCreateByteArray ()                                                                                           ; 2002:09:11:18:51:52
; udfGUIDCreateLongArray ()                                                                                           ; 2002:09:11:18:51:52
; udfGUIDFromString (sGUID)                                                                                           ; 2002:09:11:18:51:52
; udfGUIDFromByteArray (GUIDByteArray)                                                                                ; 2002:09:11:18:51:52
; udfGUIDFromLongArray (GUIDLongArray)                                                                                ; 2002:09:11:18:51:52
;------------------------------------------------------------------------------------------------------------------------------------------
; udfProgIDFromCLSID (hBBCLSID)                                                                                       ; 2002:09:11:18:51:52
; udfIsOle1Class (hBBCLSID)                                                                                           ; 2002:09:11:18:51:52
; udfGetClassFromFile (sFilename)                                                                                     ; 2002:09:11:18:51:52
; udfClassServerFromCLSIDStr (sCLSID)                                                                                 ; 2002:09:11:18:51:52
; udfIsActiveXFromCLSIDStr (sCLSID)                                                                                   ; 2002:09:11:18:51:52
; udfVersionFromCLSIDStr (sCLSID)                                                                                     ; 2002:09:11:18:51:52
; udfProgIDFromCLSIDStr (sCLSID)                                                                                      ; 2002:09:11:18:51:52
; udfIndProgIDFromCLSIDStr (sCLSID)                                                                                   ; 2002:09:11:18:51:52
;------------------------------------------------------------------------------------------------------------------------------------------
; udfShortenPath (sPath, iWidth, iMode)                                                                               ; 2002:09:11:18:51:52
; udfBinarySortTextFile (sFilenameIn, sFilenameOut, iDirection, iKeyColumn, iKeySize)                                 ; 2002:09:11:18:51:52
; udfBrowseText (sFilename)                                                                                           ; 2002:09:11:18:51:52
;==========================================================================================================================================


;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGUIDCreateBB ()
hBBGUID = BinaryAlloc(16)
BinaryEodSet(hBBGUID,16)
hDLL = StrCat(DirWindows(1),"OLE32.DLL")
DllCall(hDLL,long:"CoCreateGuid",lpbinary:hBBGUID)
Return (hBBGUID)
;..........................................................................................................................................
; Returns a handle to a binary buffer which contains the 128-bit-GUID in a 16-byte allocated buffer.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGUIDCreateStr ()
sGUID = ""
hDLL = DllLoad(StrCat(DirWindows(1),"OLE32.DLL"))
hBBGUID = BinaryAlloc(16)
; Internal unicode format requires double sized buffer (2*39 byte) including terminating null characters.
iSizeUni = 78
hBBGUIDUni = BinaryAlloc(iSizeUni)
DllCall(hDLL,long:"CoCreateGuid",lpbinary:hBBGUID)
iLenGUID = DllCall(hDLL,long:"StringFromGUID2",lpbinary:hBBGUID,lpbinary:hBBGUIDUni,long:iSizeUni)
If iLenGUID
   ; Convert from Unicode to Ansi.
   BinaryEodSet(hBBGUIDUni,iSizeUni)
   BinaryConvert(hBBGUIDUni,3,0,0,0)
   sGUID = BinaryPeekStr(hBBGUIDUni,0,iLenGUID)
EndIf
BinaryFree(hBBGUID)
BinaryFree(hBBGUIDUni)
DllFree(hDLL)
Return (sGUID)
;..........................................................................................................................................
; Returns a created GUID in a human readable formatted string of hexadecimal numbers enclosed in curly brackets.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGUIDCreateList (iCount, sRemoveChars)
sList = ""
For i=1 To iCount
   sList = ItemInsert(udfGUIDCreateStr(),-1,sList,@TAB)
Next
sRemoveChars = StrClean(sRemoveChars,"{-}","",@TRUE,2)
sList = StrClean(sList,sRemoveChars,"",@TRUE,1)
Return (sList)
;..........................................................................................................................................
; This Function "udfCreateGUID" returns as many as iCount global unique GUID identifiers.
;
; iCount = n  ............. Create a list of GUIDs.
; sRemoveChars = ""     ... Standard GUID format with special characters inserted for better human readability..
; sRemoveChars = "{-}"  ... Set of Characters to remove from GUID string.
;
; Detlev Dalitz.20030119
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGUIDCreateByteArray ()
hBBGUID = udfGUIDCreateBB ()
GUIDByteArray = ArrDimension(16)
For i=0 To 15
   GUIDByteArray[i] = BinaryPeek(hBBGUID,i)
Next
BinaryFree(hBBGUID)
Return (GUIDByteArray)
;..........................................................................................................................................
; Returns a created GUID in an array where each element carries one byte of the 16-byte GUID.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGUIDCreateLongArray ()
hBBGUID = udfGUIDCreateBB ()
GUIDLongArray = ArrDimension(4)
For i=0 To 3
   GUIDLongArray[i] = BinaryPeek4(hBBGUID,i*4)
Next
BinaryFree(hBBGUID)
Return (GUIDLongArray)
;..........................................................................................................................................
; Returns a created GUID in an array where each element carries 4 byte of the 16-byte GUID as a long number.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGUIDFromString (sGUID)
iGUIDMax = 39 ; Including trailing zero byte.
sGUID = StrSub(sGUID,1,iGUIDMax) ; For sure.
hBBGUIDUni = BinaryAlloc(2*iGUIDMax)
BinaryPokeStr(hBBGUIDUni,0,sGUID)
BinaryConvert(hBBGUIDUni,0,3,0,0) ; From Ansi to Unicode.
hBBGUID = BinaryAlloc(16)
BinaryEodSet(hBBGUID,16)
hDLL = StrCat(DirWindows(1),"OLE32.DLL")
iResult = DllCall(hDLL,long:"CLSIDFromString",lpbinary:hBBGUIDUni,lpbinary:hBBGUID)
; Caution, no error checking.
BinaryFree(hBBGUIDUni)
Return (hBBGUID)
;..........................................................................................................................................
; Returns a handle to a binary buffer which contains a GUID after evaluating a given input GUID string.
; This udf is the inverse function to udfGUIDCreateStr ().
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGUIDFromByteArray (GUIDByteArray)
hBBGUID = BinaryAlloc(16)
For i=0 To 15
   BinaryPoke(hBBGUID,i,GUIDByteArray[i])
Next
Return (hBBGUID)
;..........................................................................................................................................
; Returns a handle to a binary buffer which contains a GUID after evaluating a given input GUIDByteArray.
; This udf is the inverse function to udfGUIDCreateByteArray ().
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGUIDFromLongArray (GUIDLongArray)
hBBGUID = BinaryAlloc(16)
For i=0 To 3
   BinaryPoke4(hBBGUID,i*4,GUIDLongArray[i])
Next
Return (hBBGUID)
;..........................................................................................................................................
; Returns a handle to a binary buffer which contains a GUID after evaluating a given input GUIDLongArray.
; This udf is the inverse function to udfGUIDCreateLongArray ().
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfProgIDFromCLSID (hBBCLSID)

hDLLOle32 = StrCat(DirWindows(1),"OLE32.DLL")
hDLLKernel32 = StrCat(DirWindows(1),"KERNEL32.DLL")

sProgID = ""

hBBAddress = BinaryAlloc(4)
iResult = DllCall(hDLLOle32,long:"ProgIDFromCLSID",lpbinary:hBBCLSID,lpbinary:hBBAddress)

If (iResult==0)
   pBBAddress = BinaryPeek4(hBBAddress,0)
   chcount = DllCall(hDLLKernel32,long:"lstrlenW",long:pBBAddress) ; lstrlenW counts chars without termination null.

   bbsize = (chcount + 1) * 2 ; Unicode doublebyte chars including terminating null character.
   hBBProgID = BinaryAlloc(bbsize)
   BinaryEodSet(hBBProgID,bbsize)

   iResult = DllCall(hDLLKernel32,long:"lstrcpyW",lpbinary:hBBProgId,long:pBBAddress)
   iResult = DllCall(hDLLOle32,long:"CoTaskMemFree",long:pBBAddress)

   BinaryConvert(hBBProgID,3,0,0,0) ; From Unicode to Ansi.
   sProgID = BinaryPeekStr(hBBProgID,0,BinaryEodGet(hBBProgID))

   BinaryFree(hBBProgID)
EndIf

BinaryFree(hBBAddress)

Return (sProgID)
;..........................................................................................................................................
; Returns the corresponding ProgID for a given CLSID held in a binary buffer.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfIsOle1Class (hBBCLSID)
hDLLOle32 = StrCat(DirWindows(1),"OLE32.DLL")
iResult = DllCall(hDLLOle32,long:"CoIsOle1Class",lpbinary:hBBCLSID)
Return (iResult)
;..........................................................................................................................................
; Determines if a given CLSID represents an OLE 1 object.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGetClassFromFile (sFilename)
If !FileExist(sFilename) Then Return (0)

iMAX_PATH = 260
hBBFile = BinaryAlloc(2*iMAX_PATH) ; Unicode requires double space.
BinaryPokeStr(hBBFile,0,sFilename)
BinaryConvert(hBBFile,0,3,0,0)     ; From Ansi to Unicode.
BinaryEodSet(hBBFile,2*iMAX_PATH)

hBBGUID = BinaryAlloc(16)
BinaryEodSet(hBBGUID,16)

hDLLOle32 = StrCat(DirWindows(1),"OLE32.DLL")
iResult = DllCall(hDLLOle32,long:"GetClassFile",lpbinary:hBBFile,lpbinary:hBBGUID)
; Caution, no error checking.
Return (hBBGUID)
;..........................................................................................................................................
; Returns a CLSID (GUID) after evalutating a given Filename.
; e.g. hBBCLSID = udfGetClassFromFile ("d:\temp\report.pdf")
; e.g. hBBCLSID = udfGetClassFromFile (StrCat(DirWindows(0),"fmxyz.wri"))
; e.g. hBBCLSID = udfGetClassFromFile (StrCat(DirWindows(0),"readme.htm"))
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfClassServerFromCLSIDStr (sCLSID)
hKey = RegOpenKeyEx(@REGCLASSES,StrCat("CLSID","\",sCLSID),1,"","") ; Read access.
ClassServer1 = "InProcServer32"
ClassServer2 = "LocalServer32"
ClassServer3 = "InProcServer"
ClassServer4 = "LocalServer"
sClassServer = ""
For i=1 To 4
   If RegExistKey(hKey,ClassServer%i%)
      sClassServer = RegQueryStr(hKey,ClassServer%i%)
      If (sClassServer > "") Then Break
   EndIf
Next
RegCloseKey(hKey)
Return (sClassServer)
;..........................................................................................................................................
; LocalServer[32]:
; Indicates that the ActiveX component is an .exe file and runs in a separate process from the ActiveX client.
; The optional 32 specifies a server intended for use on 32-bit Windows systems.
;
; InProcServer[32]
; Indicates that the ActiveX component is a DLL and runs in the same process space as the ActiveX client.
; The optional 32 specifies a server intended for use on 32-bit Windows systems.
;
; The filepath you register should give the full path and name.
; Applications should not rely on the MS-DOS PATH variable to find the object.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfIsActiveXFromCLSIDStr (sCLSID)
iIsActiveX = @FALSE
sSubKey = StrCat("CLSID","\",sCLSID)
If RegExistKey(@REGCLASSES,sSubKey)
   hKey = RegOpenKeyEx(@REGCLASSES,sSubKey,1,"","") ; Read access.
   iIsActiveX = RegExistKey(hKey,"Programmable")
EndIf
Return (iIsActiveX)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfVersionFromCLSIDStr (sCLSID)
sVersion = ""
sSubKey = StrCat("CLSID","\",sCLSID)
If RegExistKey(@REGCLASSES,sSubKey)
   hKey = RegOpenKeyEx(@REGCLASSES,sSubKey,1,"","") ; Read access.
   If RegExistKey(hKey,"Version") Then sVersion = RegQueryStr(hKey,"Version")
   RegCloseKey(hKey)
EndIf
Return (sVersion)
;..........................................................................................................................................
; Returns the corresponding Version string for a given string representation of a CLSID.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfProgIDFromCLSIDStr (sCLSID)
sProgID = ""
sSubKey = StrCat("CLSID","\",sCLSID)
If RegExistKey(@REGCLASSES,sSubKey)
   hKey = RegOpenKeyEx(@REGCLASSES,sSubKey,1,"","") ; Read access.
   If RegExistKey(hKey,"ProgID") Then sProgID = RegQueryStr(hKey,"ProgID")
   RegCloseKey(hKey)
EndIf
Return (sProgID)
;..........................................................................................................................................
; Returns the corresponding ProgID for a given string representation of a CLSID.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfIndProgIDFromCLSIDStr (sCLSID)
sIndProgID = ""
sSubKey = StrCat("CLSID","\",sCLSID)
If RegExistKey(@REGCLASSES,sSubKey)
   hKey = RegOpenKeyEx(@REGCLASSES,sSubKey,1,"","") ; read access.
   If RegExistKey(hKey,"VersionIndependentProgID") Then sIndProgID = RegQueryStr(hKey,"VersionIndependentProgID")
   RegCloseKey(hKey)
EndIf
Return (sIndProgID)
;..........................................................................................................................................
; Returns the corresponding Version Independent ProgID for a given string representation of a CLSID.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfShortenPath (sPath, iWidth, iMode)
iStrLen = StrLen(sPath)
If (iStrLen <= iWidth) Then Return sPath
p1 = StrScan(sPath,"\",4,@FWDSCAN)
m1 = p1
w = iWidth - p1 - 3
p2 = iStrLen
m2 = p2
c = 0
While 1
   p2 = StrScan(sPath,"\",p2-1,@BACKSCAN)
   If ((iStrLen-p2) >= w) Then Break
   c = c + 1
   m2 = p2
EndWhile
If (c > 0)
   p2 = m2
   sTilde = ""
Else
   p1 = p1 - 1 - iStrLen + p2 + w - 1
   sTilde = "~"
EndIf
If (p1 < 3)
   p1 = 0
   w = 3
Else
   w = iWidth - p1 - iStrLen + p2 - 1 - 1
EndIf
If !!iMode
   If (w > 3)
      c = w - 3
      w = 3
      While 1
         p1 = p1 + 1
         c = c - 1
         If (c < 1) Then Break
         p2 = p2 - 1
         c = c - 1
         If (c < 1) Then Break
      EndWhile
   EndIf
EndIf
Return StrCat(StrSub(sPath,1,p1),sTilde,StrFill(".",w),StrSub(sPath,p2,-1))
;..........................................................................................................................................
; iMode = 0
; Returns a shortened pathname inserted with repeated points (no ellipsis).
; Example: ("c:\program files\navigator\programs\bookmark.htm", 45) ==> "c:\program files\......\programs\bookmark.htm"
;
; iMode = 1
; Returns a shortened pathname inserted with three points (ellipsis).
; Example: ("c:\program files\navigator\programs\bookmark.htm", 45) ==> "c:\program files\na...r\programs\bookmark.htm"
;
; Detlev Dalitz.20020222.20020524.20020627.20020911
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfBinarySortTextFile (sFilenameIn, sFilenameOut, iDirection, iKeyColumn, iKeySize)

iFileSize = FileSize(sFilenameIn)
If !iFileSize Then Return (@FALSE)
If (iDirection <> @ASCENDING) Then If (iDirection <> @DESCENDING) Then Return (@FALSE)
If (sFilenameOut == "") Then sFilenameOut = sFilenameIn ; Caution: Input file will be overwritten!

IntControl(65,4096*256,0,0,0) ; Enlarge fileread buffer for speedy access.

; Get maximum line size for sort record.
iLineSize = 0
iLineCount = 0
hFR = FileOpen(sFilenameIn,"READ")
While 1
   sLine = FileRead(hFR)
   If (sLine == "*EOF*") Then Break
   iLineSize = Max(iLineSize,StrLen(sLine))
   iLineCount = iLineCount+1
EndWhile
FileClose(hFR)

; Fill the binary buffer.
iLineSize = iLineSize+2 ; Include trailing @CRLF.
hBB = BinaryAlloc(iLineCount*iLineSize)
hFR = FileOpen(sFilenameIn,"READ")
iOffset = 0
While 1
   sLine = FileRead(hFR)
   If (sLine == "*EOF*") Then Break
   BinaryPokeStr(hBB,iOffset,sLine)
   iOffset = iOffset + iLineSize
   BinaryPokeStr(hBB,iOffset-2,@CRLF)
EndWhile
FileClose(hFR)

; Sort the binary buffer.
iKeyColumn = Max(1,iKeyColumn)
iKeyOffset = iKeyColumn-1
iKeySize   = Max(0,iKeySize)
If !iKeySize Then iKeySize = iLineSize-iKeyOffset
BinarySort(hBB,iLineSize,iKeyOffset,iKeySize,@STRING|iDirection)

; Delete the binary zeroes.
BinaryReplace(hBB,"","",@FALSE)

; Write the binary buffer to diskfile.
BinaryWrite(hBB,sFilenameOut)
BinaryFree(hBB)

Return (@TRUE)
;..........................................................................................................................................
; This function "udfBinarySortTextFile" sorts an input textfile
; in ascending or descending order by using WIL's Binary Functions.
; If output filename is omitted then input file will be overwritten without permission.
; parameter:
; sFilenameIn .............. The input textfile.
; sFilenameOut ............. The output textfile.
; iDirection=@ASCENDING .... Sort order alphabetic ascending.
; iDirection=@DESCENDING ... Sort order alphabetic descending.
; iKeyColumn ............... Start column of the sortkey, one based (first char=first column).
; iKeySize ................. Length of the sortkey.
;
; Detlev Dalitz.20010709.20020708
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfBrowseText (sFilename)
; Use WIL Browser to look into the text files.
If Run(StrCat(DirHome(),"browser.exe"),sFilename)
   sBrowser = WinGetactive()
   SendKeysTo(sBrowser,"^t")
   TimeDelay(1)
EndIf
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
;==========================================================================================================================================



; --- test ---

IntControl(28,1,0,0,0) ; Selects system font used in list boxes. 1=Fixed pitch font.

sGUIDList = udfGUIDCreateList(10,"")
AskItemlist('Demo  udfGUIDCreateList (iCount, "" )',sGUIDList,@TAB,@UNSORTED,@SINGLE)   ; Including special delimiters.


sGUIDList = udfGUIDCreateList(10,"{}")
sGUIDList = StrLower(sGUIDList)
AskItemlist('Demo  udfGUIDCreateList (iCount, "{}" )',sGUIDList,@TAB,@UNSORTED,@SINGLE) ; No curly brackets, but hyphens.

sGUIDList = udfGUIDCreateList(10,"{-}")
sGUIDList = StrLower(sGUIDList)
AskItemlist('Demo  udfGUIDCreateList (iCount, "{}" )',sGUIDList,@TAB,@UNSORTED,@SINGLE) ; No brackets, no hyphens.

:CANCEL



; --- test ---

Exclusive(@ON)

iVerbose = (@YES==AskYesNo("CLSID Info","Display CLSID Info to screen?"))

BoxOpen("CLSID Info","")
If iVerbose Then BoxText("Collecting CLSIDs from Registry ...")
   Else BoxText("Running ... be patient ...")

hKey = RegOpenKeyEx(@REGCLASSES,"CLSID",1,"","") ; Read access. ; Key and SubKey should exist.
CLSIDList = RegQueryKeys(hKey)
RegCloseKey(hKey)
iCount = ItemCount(CLSIDList,@TAB)
iCountLen = Max(3,StrLen(iCount))

; Create report file.
sFilenameTemp = FileCreateTemp("TMP")
FileDelete(sFilenameTemp)
sFilePath = FilePath(sFilenameTemp)
sFilenameTemp1 = StrCat(sFilePath,"CLSID1.TXT")
sFilenameTemp2 = StrCat(sFilePath,"CLSID2.TXT")
hFW = FileOpen(sFilenameTemp1,"WRITE")


; Collect data from Registry.
For i=1 To iCount
   sCLSID = ItemExtract(i,CLSIDList,@TAB)

   hBBCLSID = udfGUIDFromString(sCLSID)
   sIsOle1  = ItemExtract(1+udfIsOle1Class(hBBCLSID),"    ,OLE1",",")
   ; sProgID = udfProgIDFromCLSID (hBBCLSID) ; We can retrieve the ProgId from Registry too, see below.
   BinaryFree(hBBCLSID)

   sIsActiveX = ItemExtract(1+udfIsActiveXFromCLSIDStr(sCLSID)," ,X",",")

   sProgID = udfProgIDFromCLSIDStr (sCLSID)

   If (sProgID > "")
      sIndProgId = udfIndProgIDFromCLSIDStr(sCLSID)
      sClassServer = udfClassServerFromCLSIDStr(sCLSID)
      sVersion = udfVersionFromCLSIDStr(sCLSID)
      If (sClassServer > "")
         sFName = ItemExtract(1,sClassServer,"/") ; Discard additionally parameters.
         sFName = FileLocate (sFName)
         iLastErrorMode = ErrorMode(@OFF) ; Trap file not found error message.
         LastError()
         sFVersion = FileVerInfo(sFName,"","FileVersion")
         If LastError() Then sFVersion = "N/A"
         LastError()
         sFTime = FileTimeGet(sFName)
         If LastError() Then sFTime = "N/A"
         LastError()
         sFSize = FileSizeEx(sFName)
         If LastError() Then sFSize = "N/A"
         ErrorMode(iLastErrorMode)
      EndIf
   Else
      sIndProgId = ""
      sClassServer = ""
      sVersion = ""
      sFVersion  = ""
      sFTime = ""
      sFSize = ""
      sFName = ""
   EndIf

   ; Build and Display Screen Message.
   sMsgText = ""
   sMsgText = StrCat(sMsgText,iCount,"/",StrFixLeft(i,"0",iCountLen),@CRLF)
   sMsgText = StrCat(sMsgText,"CLSID"    ,@TAB,sCLSID      ,@CRLF)
   sMsgText = StrCat(sMsgText,"ProgID"   ,@TAB,sProgID     ,@CRLF)
   sMsgText = StrCat(sMsgText,"IndID"    ,@TAB,sIndProgID  ,@CRLF)
   sMsgText = StrCat(sMsgText,"Version"  ,@TAB,sVersion    ,@CRLF)
   sMsgText = StrCat(sMsgText,"Server"   ,@TAB,sClassServer,@CRLF)
   sMsgText = StrCat(sMsgText,"IsOLE1"   ,@TAB,sIsOle1     ,@CRLF)
   sMsgText = StrCat(sMsgText,"IsActX"   ,@TAB,sIsActiveX  ,@CRLF)
   sMsgText = StrCat(sMsgText,"FVersion" ,@TAB,sFVersion   ,@CRLF)
   sMsgText = StrCat(sMsgText,"FTime"    ,@TAB,sFTime      ,@CRLF)
   sMsgText = StrCat(sMsgText,"FSize"    ,@TAB,sFSize      ,@CRLF)
   sMsgText = StrCat(sMsgText,"FName"    ,@TAB,sFName      ,@CRLF)
   If iVerbose Then BoxText(sMsgText)

   ; Write report.
   If (sProgID > "")
      sLogText = ""
      sLogText = StrCat(sLogText,StrFixLeft(i,"0",iCountLen)," ")
      sLogText = StrCat(sLogText,StrFix(sCLSID     ,"" ,38) ," ")
      sLogText = StrCat(sLogText,StrFix(sIsOle1    ,"" ,4)  ," ")
      sLogText = StrCat(sLogText,StrFix(sIsActiveX ,"" ,1)  ," ")
      sLogText = StrCat(sLogText,StrFix(sProgID    ,"" ,64) ," ")
      sLogText = StrCat(sLogText,StrFix(sIndProgID ,"" ,64) ," ")
      sLogText = StrCat(sLogText,StrFix(sVersion   ,"" ,16) ," ")
      sLogText = StrCat(sLogText,StrFix(udfShortenPath(sClassServer,48,1),"",48)," ")
      sLogText = StrCat(sLogText,StrFix(sFVersion  ,"" ,32) ," ")
      sLogText = StrCat(sLogText,StrFix(sFTime     ,"" ,20) ," ")
      sLogText = StrCat(sLogText,StrFixLeft(sFSize ,"" ,10) ," ")
      sLogText = StrCat(sLogText,StrFix(sFName     ,"" ,262)," ")
      FileWrite(hFW,sLogText)
   EndIf
Next

FileWrite(hFW,"")
FileClose(hFW)

; Sort report files.
If (FileSize(sFilenameTemp1) > 0)
   If iVerbose Then BoxText(StrCat("Sorting ",iCount," CLSIDs Pass 1 ..."))
   udfBinarySortTextFile(sFilenameTemp1,sFilenameTemp1,@ASCENDING,iCountLen+1,38)

   If iVerbose Then BoxText(StrCat("Sorting ",iCount," CLSIDs Pass 2 ..."))
   udfBinarySortTextFile(sFilenameTemp1,sFilenameTemp2,@ASCENDING,44,0)
EndIf

BoxText("Ready.")
BoxShut()

udfBrowseText(sFilenameTemp1)
udfBrowseText(sFilenameTemp2)

:CANCEL
Exclusive(@OFF)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*