كتابخانه برنامه نويسان-آموزشVB

سلام .احوال شما .حالتون كه خوبه.

گله دارم امروز.چرا نظر نمي دين .امروز مي خام يه شاه برنامه براتون بنويسم ولي خب نظر نمي دين كه چه فايده !! مي خام برنامه بنويسم كه هيچ جا سورسش رو نديده باشيد .البته سورس اصلي اين برنامه هم مال من نيست ازيه سي دي كد باز ( OpenSurce )درش آوردم .
با اين برنامه مي تونيد برنامه ها و دي ال ال هايي كه با سي پلاس پلاس نوشته شده و بعضي از برنامه هاي ديگر رو باز كنيد و ديالوگ هاش رو ببينيد .اين جور برنامه ها كه معروفترينش ResurceHaker هست براي جعل و فارسي كردن برنامه ها استفاده مي شه .البته برنامه اي كه من اين سورس رو ازش درآوردم قدرت ديدن تمامي اجزاي برنامه از جمله آيكون ها ومنو ها عكس ها و تصوير و صدا و خلاصه هر چي توي فايل هست رو داشت ولي من فقط اين قسمتش رو برداشتم.چون تمام اون قسمتها برنامه رو حجيم مي كرد كه از حوصله وبلاگ ما خارج است!! براي اين برنامه بايد كد زيادي بنويسيد.
خب شروع كنيد .پنجره ي كامپيونها رو باز كنيد ( Project/Component ) و تيك MicrosoftCommonDilog6 و تيك MicrosoftWindowsCommonControl6 را بزنيد
يك TreeView يك Commondialog و يك ImageList به فرم اضافه كنيد
خاصيت نام كامند ديالوگ رو به CDLG تنظيم كنيد.چهار تا عكس به ImageList اصافه كنيد .عكس اول علامت Search عكس دوم علامت پوشه بسته عكس سوم پشه باز و عكس چهارم علامت New باشه
مي تونيد از آيكونهاي خود وي بي استفاده كنيد .مثال

D:\Program Files\Microsoft Visual Studio\Common\Ghraphic

روي خاصيت Custom ليست درختي ( TreeView ) دو با ر كليك كنيد تا كادرش باز شود .سپس
خاصيت اسكرول ليست درختي( TreeView ) را فعال كنيد .و خاصيت ImageList آن را به ImageList1 تنظيم كنيد .
يك كامند ياتون با يه كادر عكس و يه تكست بوكس به فرم اضافه كنيد .خاصيت MultiLine تكست بوكس را به True و خاصيت ScrolBar اون رو به 3 تنظيم كنيد.
فرم و ليست درختي و كادر عكس رو خيلي بزرگ كنيد . و تكست بوكس و دكمه رو زياد بزرگ نكنيد
در كد كليك كامند كد زير رو بنويسيد

CurrentResType = "": CurrentResName = ""
RefreshView: ClearResource
cdlg.Filter = "Executable (dll,exe)|*.dll;*.exe|All files (*.*)|*.*"
cdlg.InitDir = App.Path
cdlg.ShowOpen
If cdlg.FileName <> "" Then
Call FillResTypes(TreeView1, cdlg.FileName, cdlg.FileTitle)
End If

در رويداد Collapse ليست درختي بنويسيد:

RefreshView

در رويداد Expand ليست درختي بنويسيد:

If Node.Child.Text = "Dummy" Then
TreeView1.Nodes.Remove Node.Child.Index
Call FillResNames(TreeView1, Node)
End If

و بلاخره در رويداد NodeClick ليست در ختي كد زير رو كپي كنيد:

Dim ResType As String, ResName As String, ret As Boolean
Text1.Visible = False
RefreshView
CurrentResType = "": CurrentResName = ""
If Node = Node.Root Then Exit Sub
Label1 = "ResType: " & Node.Text
If Node.Key = "" Then
CurrentResType = Node.Text
Else: CurrentResType = Mid(Node.Key, 2)
End If
If Node.Parent = Node.Root Then Exit Sub
MousePointer = vbHourglass
If Node.Parent.Key = "" Then
ResType = Node.Parent.Text
Else: ResType = Mid(Node.Parent.Key, 2)
End If
ResName = Node.Text
If IsNumeric(ResName) Then ResName = "#" & ResName
CurrentResType = ResType: CurrentResName = ResName
Label1 = "ResType: " & Node.Parent.Text & vbCrLf & "ResName: " & ResName & vbCrLf & "ResSize: " & ResSize(ResType, ResName) & " bytes"
Select Case UCase(ResType)
Case "1", "2", "3", "12", "14" '---picture(Icon)
Case "4" 'Menu
Case "5", "17" 'Dialog
ret = ShowDialog(ResName, Picture1)
Case "6" 'String
Case "9" 'Accelerators Table
Case "11" 'Message Table
Case "16" 'version info
Case "23", "HTML" 'Web Page
Case "AVI" '-video
Case "JPG", "JPEG", "GIF", "PNG", "TIF", "TIFF", "WMF", "EMF" - -Picture
End Select
If ret = False Then
If Text1.Visible Then
Text1.Text = Text1.Text & vbNewLine & "Can not load resourse"
Else: Picture1.Print "Can not load resourse"
End If
End If
Picture1.Refresh: MousePointer = vbDefault

فكر كرديدن تموم شد حالا قسمت اصليش مونده .يه ماژول به فرم اضافه كنيد و كد زير رو داخلش كپي كنيد

Public Enum ResTypes RT_CURSOR = 1& RT_BITMAP = 2& RT_ICON = 3& RT_MENU = 4& RT_DIALOG = 5& RT_STRING = 6& RT_FONTDIR = 7& RT_FONT = 8& RT_ACCELERATOR = 9& RT_RCDATA = 10& RT_MESSAGETABLE = 11& RT_GROUP_CURSOR = 12& RT_GROUP_ICON = 14& RT_VERSION = 16& RT_DLGINCLUDE = 17& RT_PLUGPLAY = 19& RT_VXD = 20& RT_ANICURSOR = 21& RT_ANIICON = 22& RT_HTML = 23& End Enum Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type '---------------Declear API---------------------- Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long Private Declare Function CopyStringA Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function FreeResource Lib "kernel32" (ByVal hResData As Long) As Long Private Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As String, ByVal lpType As String) As Long Private Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" (ByVal lpLibFileName As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long Private Declare Function SizeofResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long Private Declare Function EnumResourceNames Lib "kernel32" Alias "EnumResourceNamesA" (ByVal hModule As Long, ByVal lpType As String, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function EnumResourceTypes Lib "kernel32" Alias "EnumResourceTypesA" (ByVal hModule As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function FindResourceByNum Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As String, ByVal lpType As Long) As Long Private Declare Function CreateDialogParam Lib "user32" Alias "CreateDialogParamA" (ByVal hInstance As Long, ByVal lpName As String, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal lParamInit As Long) As Long Private Declare Function EnumResourceNamesById Lib "kernel32" Alias "EnumResourceNamesA" (ByVal hModule As Long, ByVal lpType As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Dim tv As TreeView, nd As Node Public hModule As Long, hDialog As Long Public Function ShowDialog(ByVal ResName As String, pb As PictureBox) As Boolean Dim rc As RECT, rcPic As RECT hDialog = CreateDialogParam(hModule, ResName, pb.hWnd, 0, 0) If hDialog Then If GetParent(hDialog) = pb.hWnd Then Call GetWindowRect(hDialog, rc) Call MoveWindow(hDialog, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top, 1) pb.Move 0, 0, (rc.Right - rc.Left) * Screen.TwipsPerPixelX, (rc.Bottom - rc.Top + 24) * Screen.TwipsPerPixelY Else Call GetWindowRect(hDialog, rc) Call GetWindowRect(pb.hWnd, rcPic) Call MoveWindow(hDialog, rcPic.Left, rcPic.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, 1) End If Call ShowWindow(hDialog, vbNormalFocus) ShowDialog = True End If End Function Public Function FillResTypes(ByVal tvw As TreeView, ByVal sFileName As String, ByVal sLibName As String) Dim ret As Long Set tv = tvw tv.Nodes.Clear tv.Nodes.Add , , sFileName, sLibName, 1, 1 Call InitResource(sFileName) If hModule Then ret = EnumResourceTypes(hModule, AddressOf ResTypesCallBack, 0) tv.Nodes.Item(1).Expanded = True Set tv = Nothing End Function Public Function InitResource(ByVal sLibName As String) As Boolean On Error Resume Next hModule = LoadLibraryEx(sLibName, 0, 1) InitResource = (hModule <> 0) End Function Public Function ResSize(ByVal ResType As String, ByVal ResName As String) As Long Dim hRsrc As Long, hGlobal As Long If IsNumeric(ResType) Then hRsrc = FindResourceByNum(hModule, ResName, CLng(ResType)) If hRsrc = 0 Then hRsrc = FindResource(hModule, ResName, ResType) If hRsrc = 0 Then Exit Function hGlobal = LoadResource(hModule, hRsrc) ResSize = SizeofResource(hModule, hRsrc) Call FreeResource(hGlobal) End Function Function ResTypesCallBack(ByVal hMod As Long, ByVal ResType As Long, ByVal lParam As Long) As Long Dim nd As Node If (ResType And &HFFFF0000) = 0 Then Set nd = tv.Nodes.Add(tv.Nodes.Item(1), tvwChild, "#" & CStr(ResType), ResTypeName(ResType), 2, 3) tv.Nodes.Add nd, tvwChild, , "Dummy" Else ' The resource type is defined by a string Set nd = tv.Nodes.Add(tv.Nodes.Item(1), tvwChild, , StrFromPtrA(ResType), 2, 3) tv.Nodes.Add nd, tvwChild, , "Dummy" End If Set nd = Nothing ResTypesCallBack = True End Function Public Function ResTypeName(ByVal ResType As ResTypes) As String Select Case ResType Case RT_ACCELERATOR: ResTypeName = "Accelerator table" Case RT_ANICURSOR: ResTypeName = "Animated cursor" Case RT_ANIICON: ResTypeName = "Animated icon" Case RT_BITMAP: ResTypeName = "Bitmap resource" Case RT_CURSOR: ResTypeName = "Hardware-dependent cursor resource" Case RT_DIALOG: ResTypeName = "Dialog box" Case RT_DLGINCLUDE: ResTypeName = "Header file that contains menu and dialog box #define statements" Case RT_FONT: ResTypeName = "Font resource" Case RT_FONTDIR: ResTypeName = "Font directory resource" Case RT_GROUP_CURSOR: ResTypeName = "Hardware-independent cursor resource" Case RT_GROUP_ICON: ResTypeName = "Hardware-independent icon resource" Case RT_HTML: ResTypeName = "HTML document" Case RT_ICON: ResTypeName = "Hardware-dependent icon resource" Case RT_MENU: ResTypeName = "Menu resource" Case RT_MESSAGETABLE: ResTypeName = "Message-table entry" Case RT_PLUGPLAY: ResTypeName = "Plug and play resource" Case RT_RCDATA: ResTypeName = "Application-defined resource (raw data)" Case RT_STRING: ResTypeName = "String-table entry" Case RT_VERSION: ResTypeName = "Version resource" Case RT_VXD: ResTypeName = "VXD" Case Else: ResTypeName = "User-defined custom resource" End Select End Function Public Sub ClearResource() If hDialog Then Call DestroyWindow(hDialog) If hModule Then FreeLibrary (hModule) End Sub Public Function FillResNames(ByVal tvw As TreeView, ByVal nod As Node) Dim ret As Long Set tv = tvw Set nd = nod If nd.Key = "" Then ret = EnumResourceNames(hModule, nd.Text, AddressOf ResNamesCallBack, 0) Else: ret = EnumResourceNamesById(hModule, CLng(Mid(nd.Key, 2)), AddressOf ResNamesCallBack, 0) End If Set tv = Nothing Set nd = Nothing End Function Public Function StrFromPtrA(ByVal lpszA As Long, Optional nSize As Long = 0) As String Dim s As String, bTrim As Boolean If nSize = 0 Then nSize = lstrlenA(lpszA) bTrim = True End If s = String(nSize, Chr$(0)) CopyStringA s, ByVal lpszA If bTrim Then s = TrimNULL(s) StrFromPtrA = s End Function Function ResNamesCallBack(ByVal hMod As Long, ByVal ResType As Long, ByVal ResId As Long, ByVal lParam As Long) As Long If (ResId And &HFFFF0000) <> 0 Then tv.Nodes.Add nd, tvwChild, , StrFromPtrA(ResId), 4, 4 Else: tv.Nodes.Add nd, tvwChild, , CStr(ResId), 4, 4 End If ResNamesCallBack = True End Function Public Function TrimNULL(ByVal str As String) As String If InStr(str, Chr$(0)) > 0& Then TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&) Else: TrimNULL = str End If End Function Public Sub RefreshView() If hDialog Then Call DestroyWindow(hDialog) Form1.Picture1.Cls Form1.Picture1.Refresh Form1.Text1 = "" End Sub '+-------------By:TcVB.Blogfa.com-NasserNiazyMobasser-------------+

 

.حالا برنامه رو اجرا كنيد .بازدن كامند كادر باز مي شه كه مي تونيد براش فايل اجرايي يا دي ال ال انتخاب كنيد تا داخل برنامه باز بشه .

راستي دقت كردين آدم نظر نمي ده چقدر عذاب وجدان مي گيره !!اون هيچي فشار قبر رو چي خدا بخير بگزرونه!!آره فشار قبر