چطور برای توابع API دسترسی موقت به فایل های با دسترسی محدود در ویندوز ایجاد کنم؟

[ROSTAM2]

به نام خدا.
سلام

من یک تابع سفارشی دارم با نام GetIcon:

Shared Function GetIcon(sResourceFileName As String, lpIconName As Integer) As Icon
Dim hInst As IntPtr
Dim hIco As IntPtr
Dim Expr As Icon = Nothing
hInst = LoadLibrary(sResourceFileName)
If hInst <> 0 Then
hIco = LoadIcon(hInst, lpIconName)
Expr = Icon.FromHandle(hIco)
End If
FreeLibrary(hInst)
Return Expr
End Function


این تابع به کمک توابع API توسط عدد Index هندل آیکون موجود در یک فایل EXE یا DLL را برای تبدیل به Icon می گیرد.

توابغ API:

Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As IntPtr

Declare Function LoadIcon Lib "user32" Alias "LoadIconA" _
(ByVal hInstance As IntPtr, ByVal lpIconName As Integer) As IntPtr

Private Declare Function FreeLibrary Lib "kernel32.dll" (
ByVal hLibModule As IntPtr
) As Boolean




اما مشکل این دستور این است که آیکون های موجود در فایل هایی که مجوز دسترسی آنها محدود است را نمی تواند استخراج کند.

سوال: چظور باید بصورت موقت این دسترسی را ایجاد کرد که دسترسی محدود شده ویندوز تغییری نکند بطوریکه فقط برنامه بتواند از فایل استفاده کند؟

154625

این مورد در پوشه Installer وجود دارد که System+Hidden است.

[ROSTAM2]

سلام مجدد.
پیداش کردم، مشکل از دسترسی محدود و این چیزا نبود. در رجیستری آیکونها آدرس فایل و بعد از یک کاما یک عدد دارند که اگر منفی بود آی.دی آیکون هست که تابع LoadIcon و اگر عدد منفی نبود Index آیکون هست که تابع ExtractIcon:


Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (
ByVal hInst As Integer, ByVal lpszExeFileName As String,
ByVal nIconIndex As Integer) As Integer

Shared Function GetIconByIndex(lpszExeFileName As String, IconIndex As Integer) As Icon
Dim hInst As IntPtr
Dim hIco As IntPtr
Dim Expr As Icon = Nothing
hInst = LoadLibrary(lpszExeFileName)
If hInst <> 0 Then
hIco = ExtractIcon(hInst, lpszExeFileName, IconIndex)
Expr = Icon.FromHandle(hIco)
End If
FreeLibrary(hInst)
Return Expr
End Function



154626

[پرستو پارسایی]

Imports System.Runtime.InteropServices

Public Class IconUtils
Private Const MAX_PATH As Integer = 260


<DllImport("shell32.dll", CharSet:=CharSet.Auto)>
Private Shared Function ExtractIconEx(ByVal lpszFile As String, ByVal nIconIndex As Integer, ByRef phiconLarge As IntPtr, ByRef phiconSmall As IntPtr, ByVal nIcons As UInteger) As UInteger
End Function


Public Shared Function GetIconByIndex(ByVal fileName As String, ByVal iconIndex As Integer) As Icon
Dim largeIconPtr As IntPtr = IntPtr.Zero
Dim smallIconPtr As IntPtr = IntPtr.Zero
Try
Dim result = ExtractIconEx(fileName, iconIndex, largeIconPtr, smallIconPtr, 1)
If result = 0 Then
Return Nothing
End If


Dim iconHandle As IntPtr = If(largeIconPtr <> IntPtr.Zero, largeIconPtr, smallIconPtr)
Return Icon.FromHandle(iconHandle)
Finally
If largeIconPtr <> IntPtr.Zero Then
DestroyIcon(largeIconPtr)
End If


If smallIconPtr <> IntPtr.Zero Then
DestroyIcon(smallIconPtr)
End If
End Try
End Function


<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function DestroyIcon(ByVal hIcon As IntPtr) As Boolean
End Function
End Class

[ROSTAM2]

سلام مجدد.

تابعی برای گرفتن آیکونهای یک فایل exe یا library

Sub ListFileIcons(ByVal Path As String)
Dim Ico As Icon = Nothing
Dim i% = 0
ComboBox1.Items.Clear()
Dim AppPath As IconItem
Do
Ico = ExternalResources.GetIconByIndex(Me.ComboBox1.GetH ashCode, Path, i)
If Ico Is Nothing Then Exit Do
Debug.Print(Path + ", " + i.ToString)
With ComboBox1.Items
AppPath = New IconItem("Icon " + i.ToString, Ico)
.Add(AppPath)
End With
i += 1
Loop
If Me.ComboBox1.Items.Count > 0 Then
ComboBox1.SelectedIndex = 0
End If
End Sub


تابع GetIconByIndex (Win32 API)

Shared Function GetIconByIndex(Component As Integer, lpszExeFileName As String, IconIndex As Integer) As Icon
Dim hInst As IntPtr
Dim hIco As IntPtr
Dim Expr As Icon = Nothing
hInst = LoadLibrary(lpszExeFileName)
Try
If hInst <> 0 Then
hIco = ExtractIcon(Component, lpszExeFileName, IconIndex)
Expr = Icon.FromHandle(hIco)
End If
Catch ex As Exception
End Try
FreeLibrary(hInst)
Return Expr
End Function


کلاس سفارشی IconItem

Public Class IconItem
Sub New(Text As String, Icon As Icon)
Me.Text = Text
Me.Icon = Icon
End Sub
Private TextValue As String
Public Property Text() As String
Get
Return TextValue
End Get
Set(ByVal value As String)
TextValue = value
End Set
End Property
Private IconValue As Icon
Public Property Icon() As Icon
Get
Return IconValue
End Get
Set(ByVal value As Icon)
IconValue = value
End Set
End Property
End Class


دستورات رویداد DrawItem از ComboBox:

Private Sub ComboBox1_DrawItem(sender As Object, e As DrawItemEventArgs) Handles ComboBox1.DrawItem
If e.Index = -1 Then Exit Sub
e.DrawBackground()
Dim g As Graphics = e.Graphics, Path As String = ""
Dim Item As IconItem = DirectCast(sender, ComboBox).Items(e.Index)
If Item.Icon IsNot Nothing Then
g.DrawIcon(Item.Icon, New Rectangle(e.Bounds.X + 1, e.Bounds.Y, 18, 18))
End If
g.DrawString(String.Format("{0}", Item.Text), e.Font, New SolidBrush(e.ForeColor), e.Bounds.X + 20, e.Bounds.Y + 1)
End Sub


154627