sfile1.bas

星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带

Attribute VB_Name = "Sfile1"
'****************************************************************************
'网  站：http://www.hackeroo.com/
'e-mail：[e-mail]
'OICQ  : 266370
'****************************************************************************
Option Explicit

Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_TYPENAME = &H400
Private Const SHGFI_ICON = &H100
Private Const SHGFI_LARGEICON = &H0
Private Const SHGFI_SMALLICON = &H1

Private Const MAX_PATH = 260
Private Type SHFILEINFO
    hIcon As Long                      '  out: icon
    iIcon As Long          '  out: icon index
    dwAttributes As Long               '  out: SFGAO_ flags
    szDisplayName As String * MAX_PATH '  out: display name (or path)
    szTypeName As String * 80         '  out: type name
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long
Private Type TypeIcon
    cbSize As Long
    picType As PictureTypeConstants
    hIcon As Long
End Type
Private Type CLSID
    id(16) As Byte
End Type



Public Function IconToPicture(hIcon As Long) As IPictureDisp
Dim cls_id As CLSID
Dim hRes As Long
Dim new_icon As TypeIcon
Dim lpUnk As IUnknown
    With new_icon
        .cbSize = Len(new_icon)
        .picType = vbPicTypeIcon
        .hIcon = hIcon
    End With
    With cls_id
        .id(8) = &HC0
        .id(15) = &H46
    End With
    hRes = OleCreatePictureIndirect(new_icon, cls_id, 1, lpUnk)
    If hRes = 0 Then Set IconToPicture = lpUnk
End Function

Public Function GetIcon(ByVal Filename As String, Optional ByVal bBigIcon As Boolean = False) As StdPicture
    Dim sh_info As SHFILEINFO
    SHGetFileInfo Filename, 0, sh_info, Len(sh_info), SHGFI_ICON + IIf(bBigIcon, SHGFI_LARGEICON, SHGFI_SMALLICON)
    Set GetIcon = IconToPicture(sh_info.hIcon)
End Function



Public Function udpico(f2 As String) As Long
Dim lngIcon As Long  '图标句柄
Dim a1 As String      '后缀
Dim fs                'fso模型
Dim im As ListImage

 Set fs = CreateObject("Scripting.FileSystemObject")
 
 a1 = fs.GetExtensionName(f2)
 
 Select Case a1
 Case "bmp", "ico"
 
 udpico = 4
 Case "exe", "lnk"
 udpico = 5
  

 
 Case Else
  Dim fin As Long
  fin = Form3.find(a1)
 
 If (fin = 0) Then
 
    udpico = 6
Else

    udpico = fin

End If

End Select

End Function