显示文件和文件夹的关联图标和说明

PUBLIC oForm As Explorer
oForm = CREATEOBJECT("Explorer")
oForm.Visible=.T.
* end of main


DEFINE CLASS Explorer As Form
#DEFINE LVM_FIRST 0x1000
#DEFINE LVM_GETIMAGELIST (LVM_FIRST + 2)
#DEFINE LVM_SETIMAGELIST (LVM_FIRST + 3)
#DEFINE LVM_SETITEM (LVM_FIRST + 6)
#DEFINE LVIF_IMAGE 0x0002


#DEFINE LVSIL_SMALL 1
#DEFINE LVS_SHAREIMAGELISTS 0x0040
#DEFINE GWL_STYLE -16
#DEFINE MAX_PATH 260


#DEFINE SHGFI_SYSICONINDEX 0x000004000
#DEFINE SHGFI_SMALLICON 0x000000001
#DEFINE SHGFI_ICON 0x000000100
#DEFINE SHGFI_TYPENAME 0x000000400
#DEFINE SHGFI_USEFILEATTRIBUTES 0x000000010


#DEFINE FILE_ATTRIBUTE_NORMAL 0x00000080
#DEFINE FILE_ATTRIBUTE_DIRECTORY 0x00000010


  Width=560
  Height=370
  MaxButton=.F.
  BorderStyle=2
  AutoCenter=.T.
  Caption="File Explorer"
  ShowWindow=2


  ADD OBJECT lst As TListViewFiles WITH;
  Left=5, Top=35, Width=550, Height=310


  ADD OBJECT Label1 As Label WITH Autosize=.T.,;
  BackStyle=0, Left=7, Top=7, Caption="Address:"
  
  ADD OBJECT txtFolder As TextBox WITH;
  Left=64, Top=5, Width=466,;
  ControlSource="THIS.Parent.lst.defaultpath"


  ADD OBJECT cmdFolder As CommandButton WITH;
  Left=530, Top=4, Width=24, Height=24, Caption=".."


PROCEDURE Init
  = BINDEVENT(THIS.cmdFolder, "Click", THIS, "GetFolder")
  THIS.lst.populatelist


PROCEDURE GotFocus
  THIS.lst.SwitchToSystemList


PROCEDURE GetFolder
  LOCAL cStoredPath, cPath
  cStoredPath = SYS(5) + SYS(2003)
  cPath = GETDIR(THIS.lst.defaultpath,;
    "Folders:", "Select Folder")
  SET DEFAULT TO (m.cStoredPath)
  IF NOT EMPTY(m.cPath)
    THIS.lst.defaultpath = LOWER(m.cPath)
    THIS.Refresh
  ENDIF


ENDDEFINE


DEFINE CLASS TListViewFiles As OleControl
  OleClass="MSComctlLib.ListViewCtrl"
  defaultpath=JUSTPATH(_vfp.ServerName)


PROCEDURE Init
  THIS.declare
  WITH THIS
    .View=3
    .LabelEdit=1
    .AddColumnHeader("Name", 200)
    .AddColumnHeader("Size", 80)
    .AddColumnHeader("Type", 110)
    .AddColumnHeader("Date Modified", 130)
    
    LOCAL oMsgFont As SystemMessageFont
    oMsgFont=CREATEOBJECT("SystemMessageFont")
    .Font.Name=oMsgFont.lfFaceName &&"Segoe UI"
    .Font.Size=oMsgFont.GetFontSize()  &&9
  ENDWITH


PROCEDURE defaultpath_ASSIGN(cPath As String)
  cPath=LOWER(ALLTRIM(JUSTPATH(m.cPath)))
  IF RIGHT(m.cPath,1)="\" AND LEN(m.cPath) > 3
    cPath=SUBSTR(m.cPath,1,LEN(m.cPath)-1)
  ENDIF
  THIS.defaultpath=m.cPath
  THIS.PopulateList


PROCEDURE ColumnClick
LPARAMETERS columnheader
  THIS.PopulateList


PROCEDURE AddColumnHeader(cCaption, nWidth)
  WITH THIS.ColumnHeaders.Add()
    .Text=cCaption
    .Width=nWidth
  ENDWITH


PROCEDURE SwitchToSystemList
  LOCAL nWStyle, hSysImageList, nResult, cBuffer


  * check if the list is already assigned
  IF SendMessage(THIS.HWND, LVM_GETIMAGELIST,;
    LVSIL_SMALL, 0) <> 0
    RETURN
  ENDIF


  WITH THIS
    nWStyle = GetWindowLong(.HWND, GWL_STYLE)
    nWStyle = BITOR(m.nWStyle, LVS_SHAREIMAGELISTS)
    SetWindowLong(.HWND, GWL_STYLE, nWStyle)


    cBuffer = REPLICATE(CHR(0), 1024)
    hSysImageList = SHGetFileInfo("", FILE_ATTRIBUTE_NORMAL,;
      @cBuffer, LEN(cBuffer),;
      BITOR(SHGFI_SYSICONINDEX, SHGFI_SMALLICON,;
        SHGFI_ICON, SHGFI_TYPENAME,;
        SHGFI_USEFILEATTRIBUTES))


    = SendMessage(.HWND, LVM_SETIMAGELIST, LVSIL_SMALL, 0)
    = INKEY(0.1)
    = SendMessage(.HWND, LVM_SETIMAGELIST, LVSIL_SMALL, hSysImageList)


  ENDWITH


PROCEDURE PopulateList
* scans current directory and populates the ListView
  THIS.ListItems.Clear
  
  LOCAL nCount, nIndex


  nCount = ADIR(arrListOfFiles,;
    THIS.defaultpath + "\*.*", "D", 1)


  FOR nIndex=1 TO nCount
    IF arrListOfFiles[nIndex, 1] = "."
      LOOP
    ENDIF
    IF DIRECTORY(THIS.defaultpath + "\" +;
      arrListOfFiles[nIndex, 1])
      THIS.AddLstItem(@arrListOfFiles, nIndex, .T.)
    ENDIF
  NEXT


  nCount = ADIR(arrListOfFiles,;
    THIS.defaultpath + "\*.*", "A", 1)


  FOR nIndex=1 TO nCount
    IF NOT DIRECTORY(THIS.defaultpath + "\" +;
      arrListOfFiles[nIndex, 1])
      THIS.AddLstItem(@arrListOfFiles, nIndex, .F.)
    ENDIF
  NEXT
  RELEASE arrListOfFiles


PROCEDURE AddLstItem(arr, nIndex, lDirectory)
* adds new ListItem to the ListView control
  LOCAL cFilename, nTypeIndex, cFiletype, oItem


  cFilename = arr[nIndex, 1]
  nTypeIndex=0
  cFiletype=""
  
  THIS.GetFileTypeInfo(THIS.defaultpath+"\"+m.cFilename,;
    @nTypeIndex, @cFiletype,;
    IIF(lDirectory, FILE_ATTRIBUTE_DIRECTORY,;
      FILE_ATTRIBUTE_NORMAL))
  
  oItem = THIS.ListItems.Add(,,cFilename)
  THIS.SetIcon(oItem.Index, m.nTypeIndex)


  WITH oItem
    IF NOT lDirectory
      .Subitems(1) = THIS.FormatFilesize(arr[nIndex, 2])
    ENDIF
    .Subitems(2) = m.cFiletype
    .Subitems(3) = THIS.FormatDT(arr[nIndex, 3], arr[nIndex, 4])
  ENDWITH


PROCEDURE SetIcon(nItemIndex, nImageIndex)
* sets the icon for the specified ListItem
    LOCAL cItemBuffer  && LVITEM structure


    cItemBuffer = num2dword(LVIF_IMAGE) +;
      num2dword(nItemIndex-1) + num2dword(0) + num2dword(0) +;
      num2dword(0) + num2dword(0) + num2dword(0) +;
      num2dword(nImageIndex) + num2dword(0)


    = SendMessageS(THIS.hWnd , LVM_SETITEM, 0, @cItemBuffer)


FUNCTION FormatDT(dDate, cTime) As String
  LOCAL cResult
  cResult = DTOC(dDate) + " " + cTime
RETURN m.cResult


FUNCTION FormatFilesize(nSize) As String
  LOCAL cBuffer
  cBuffer = REPLICATE(CHR(0), 128)
  = StrFormatByteSizeA(m.nSize, @cBuffer, LEN(m.cBuffer))
RETURN STRTRAN(m.cBuffer, CHR(0), "")


PROCEDURE GetFileTypeInfo(cFilename, nTypeIndex,;
  cFileType, nFileAttr)
* obtains the icon and description associated
* with the specified file type
  LOCAL nBufsize, cBuffer, nFlags, hIcon, nTypeIndex


  nBufsize=0x200
  cBuffer = REPLICATE(CHR(0), nBufsize)


  nFlags = BITOR(SHGFI_SYSICONINDEX,;
    SHGFI_SMALLICON, SHGFI_ICON, SHGFI_TYPENAME,;
    SHGFI_USEFILEATTRIBUTES)


  = SHGetFileInfo(m.cFilename, m.nFileAttr,;
    @cBuffer, nBufsize, nFlags)
  
  hIcon = buf2dword(SUBSTR(cBuffer, 1, 4))
  nTypeIndex = buf2dword(SUBSTR(cBuffer,5, 4))
  cFileType = STRTRAN(SUBSTR(m.cBuffer,13+MAX_PATH), CHR(0),"")


  IF hIcon <> 0
    = DestroyIcon(hIcon)
  ENDIF


PROCEDURE declare
  DECLARE INTEGER DestroyIcon IN user32 INTEGER hIcon


  DECLARE STRING StrFormatByteSizeA IN Shlwapi;
    INTEGER dw, STRING @pszBuf, INTEGER cchBuf


  DECLARE INTEGER SHGetFileInfo IN shell32;
    STRING pszPath, LONG dwFileAttributes,;
    STRING @psfi, LONG cbFileInfo, LONG uFlags


  DECLARE INTEGER SendMessage IN user32;
    INTEGER hWindow, INTEGER Msg,;
    INTEGER wParam, INTEGER lParam


  DECLARE INTEGER SendMessage IN user32 AS SendMessageS;
    INTEGER hWindow, INTEGER Msg,;
    INTEGER wParam, STRING @lParam


  DECLARE INTEGER SetWindowLong IN user32;
    INTEGER hWindow, INTEGER nIndex, INTEGER dwNewLong


  DECLARE INTEGER GetWindowLong IN user32;
    INTEGER hWindow, INTEGER nIndex


  DECLARE INTEGER GetWindowDC IN user32 INTEGER hWindow


  DECLARE INTEGER SystemParametersInfo IN user32;
    INTEGER uiAction, INTEGER uiParam,;
    STRING @pvParam, INTEGER fWinIni


  DECLARE INTEGER GetDeviceCaps IN gdi32;
    INTEGER hdc, INTEGER nIndex


  DECLARE INTEGER ReleaseDC IN user32;
    INTEGER hWindow, INTEGER hDC


ENDDEFINE


DEFINE CLASS SystemMessageFont As Custom
#DEFINE SPI_GETNONCLIENTMETRICS 0x0029
#DEFINE NONCLIENTMETRICS_SIZE 0x0154
#DEFINE LOGFONT_SIZE 0x003c
#DEFINE LOGPIXELSY 0x005a
  lfHeight=12
  lfFaceName="Arial"


PROCEDURE Init
  LOCAL cNonClientMetrics, cBuffer
  cNonClientMetrics=num2dword(NONCLIENTMETRICS_SIZE)
  cNonClientMetrics=PADR(cNonClientMetrics,;
    NONCLIENTMETRICS_SIZE, CHR(0))


  IF SystemParametersInfo(SPI_GETNONCLIENTMETRICS,;
    NONCLIENTMETRICS_SIZE, @cNonClientMetrics, 0) <> 0
    cBuffer=SUBSTR(cNonClientMetrics, 281, LOGFONT_SIZE)
    WITH THIS
      .lfHeight=buf2dword(SUBSTR(cBuffer,1,4))
      .lfFaceName=STRTRAN(SUBSTR(cBuffer,29,32), CHR(0),"")
    ENDWITH
  ENDIF


FUNCTION GetFontSize() As Number
  LOCAL hWindow, hDC, nPxPerInchY
  hWindow=_screen.HWnd
  hDC=GetWindowDC(hWindow)
  nPxPerInchY = GetDeviceCaps(hDC, LOGPIXELSY)
  ReleaseDC(hWindow, hDC)
RETURN ROUND((ABS(THIS.lfHeight) * 72) / nPxPerInchY, 0)


ENDDEFINE


FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
  BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  8) +;
  BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
  BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)


FUNCTION num2dword(lnValue)
#DEFINE m0 256
#DEFINE m1 65536
#DEFINE m2 16777216
  IF lnValue < 0
    lnValue = 0x100000000 + lnValue
  ENDIF
  LOCAL b0, b1, b2, b3
  b3 = Int(lnValue/m2)
  b2 = Int((lnValue - b3*m2)/m1)
  b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
  b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)

每种文件类型的关联图标和说明存储在注册表中。

例如，若要获取 DBF 文件的这些关联，第一步是找到“HKEY_CLASSES_ROOT.dbf”注册表项。此项的默认值为“Visual.FoxPro.Table”。这意味着“HKEY_CLASSES_ROOT\Visual.FoxPro.Table”键必须位于下一个。

后者具有默认值“Microsoft Visual FoxPro Table”，这是操作系统坚持DBF文件类型的实际描述。

此项的“DefaultIcon”子项的值为“C：\Program Files\Microsoft Visual FoxPro 9\vfp9.exe，-103”。这意味着组图标 #103 资源存在于 VFP9 可执行文件中。

此资源包含操作系统在需要时用于表示视觉 FoxPro DBF 文件的几个图标;例如，在资源管理器窗口中显示文件列表时。

资源查看器显示此资源以及存储在 VFP9 可执行文件中的其他资源。

以类似的方式，任何其他文件类型（读取“文件扩展名”）都可以追溯到图标+描述对。

没有单一的规则，寻找关联的方法即使不是混乱，也是棘手的。走这条路需要相当广泛的编码。幸运的是，MS费心在SHGetFileInfo API调用中隐藏了该过程的复杂性。

猫猫的心里话

加菲猫的VFP|狐友会社群接收投稿啦

加菲猫的VFP，用VFP不局限VFP，用VFP混合一切。无论是VFP，还是JS，还是C，只要能混合起来，都可以发表。

商业模式，销售技巧、需求规划、产品设计的知识通通可以发表。

暂定千字50元红包，，优秀的文章红包更大，一经发表，红包到手。

如何帮助使用VFP的人？

用VFP的人，有专业的，有非专业了，很多人其实是小白，问出的问题是小白，如果问题不对，我们引导他们问正确的问题。无论如何请不要嘲笑他们说帮助都不看，这么简单的问题都不会，嘲笑别人不行，而无法提出建设性答案，是很low的。

我们无论工作需要，还是有自己的软件，都是是需要真正的知识，如何让更多人学习真正的VFP知识呢，只需要点赞，在看，能转发朋友圈就更好了。

加菲猫的vfp倡导用"VFP极简混合开发，少写代码、快速出活，用VFP，但不局限于VFP，各种语言混合开发"。

我已经带领一百多名会员成功掌到VFP的黑科技，进入了移动互联网时代，接下来我们要进入物联网领域。

2023年狐友会社群会员继续招募中

社群会员获取的权益有：

祺佑三层开发框架商业版（猫框），终身免费升级，终身技术支持。

开放的录播课程有：

微信小程序，微信公众号开发，H5 APP开发，Extjs BS开发，VFP面向对象进阶，VFP中间层开发。

源码类资源有：

支付组件源码，短信源码，权限组件源码，一些完整系统的源码。这个可以单独出售的，需要的可以联系我。

会员也可以实现群内资源对接，可以接分包，合作等各项商业或技术业务