Posted: Wed Aug 02, 2006 5:07 am Post subject: Re: كمك در مورد Visual Basic 6
aliscripter wrote:
سلام من علي هستم.
لطفا به من كمك كنيد.
كسي در مورد Resource Editor چيزي ميدونه ؟
about:
LoadResPicture,LoadResString,etc
complete informaion plesae.
thank you bye.
Posted: Wed Aug 02, 2006 5:22 am Post subject: Re: كمك در مورد Visual Basic 6
aliscripter wrote:
سلام من علي هستم.
لطفا به من كمك كنيد.
كسي در مورد Resource Editor چيزي ميدونه ؟
about:
LoadResPicture,LoadResString,etc
complete informaion plesae.
thank you bye.
من یه کد داشتم اما هر چی خواستم بفرستم اینو میداد:
Forbidden
You don't have permission to access /privmsg.php on this server.
Additionally, a 404 Not Found error was encountered while trying to use an ErrorDocument to handle the request.
Posted: Fri Aug 04, 2006 9:26 pm Post subject: Re: كمك در مورد Visual Basic 6
aliscripter wrote:
سلام من علي هستم.
لطفا به من كمك كنيد.
كسي در مورد Resource Editor چيزي ميدونه ؟
about:
LoadResPicture,LoadResString,etc
complete informaion plesae.
thank you bye.
من يه کد دارم...
خیلی هم کامل و خوبه!
اما هرچی خواستم بنویسمش این Error رو میداد:
Forbidden
You don't have permission to access /posting.php on this server.
Additionally, a 404 Not Found error was encountered while trying to use an ErrorDocument to handle the request.
سلام من علي هستم.
لطفا به من كمك كنيد.
كسي در مورد Resource Editor چيزي ميدونه ؟
about:
LoadResPicture,LoadResString,etc
complete informaion plesae.
thank you bye.
من يه کد دارم...
اينو تو
NOTEPAD
بنويس و با نام
1.frm
ذخيره کن
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 4800
ClientLeft = 150
ClientTop = 435
ClientWidth = 9435
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4800
ScaleWidth = 9435
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 375
Left = 7680
TabIndex = 11
Top = 4380
Width = 1635
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 375
Left = 5280
TabIndex = 10
Top = 4380
Width = 1875
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 375
Left = 3360
TabIndex = 9
Top = 4380
Width = 1875
End
Begin VB.PictureBox Picture4
Height = 255
Left = 3180
ScaleHeight = 195
ScaleWidth = 315
TabIndex = 8
Top = 3720
Width = 375
End
Begin MSComDlg.CommonDialog cdlg
Left = 3180
Top = 3240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox Text1
Height = 2475
Left = 4500
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 6
Text = "Form1.frx":014A
Top = 600
Width = 2655
End
Begin VB.PictureBox Picture2
Height = 4275
Left = 3360
ScaleHeight = 4215
ScaleWidth = 5895
TabIndex = 1
Top = 60
Width = 5955
Begin VB.PictureBox Picture3
BorderStyle = 0 'None
Height = 195
Left = 120
ScaleHeight = 195
ScaleWidth = 255
TabIndex = 5
Top = 2520
Width = 255
End
Begin VB.HScrollBar HScroll1
Height = 255
Left = 1020
TabIndex = 4
Top = 3480
Width = 4455
End
Begin VB.VScrollBar VScroll1
Height = 2835
Left = 5460
TabIndex = 3
Top = 1020
Width = 255
End
Begin VB.PictureBox Picture1
Height = 2595
Left = 60
ScaleHeight = 2535
ScaleWidth = 4335
TabIndex = 2
Top = 1260
Width = 4395
End
End
Begin ComctlLib.TreeView TreeView1
Height = 3375
Left = 120
TabIndex = 0
Top = 60
Width = 3195
_ExtentX = 5636
_ExtentY = 5953
_Version = 327682
HideSelection = 0 'False
Indentation = 529
LabelEdit = 1
Style = 7
ImageList = "ImageList1"
Appearance = 1
End
Begin VB.Label Label1
BorderStyle = 1 'Fixed Single
Caption = "Label1"
Height = 1335
Left = 120
TabIndex = 7
Top = 3420
Width = 3195
End
Begin ComctlLib.ImageList ImageList1
Left = 7080
Top = 4320
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 4
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0150
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0262
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0374
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0486
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim CurrentResType As String, CurrentResName As String
Private Sub Command1_Click()
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
End Sub
Private Sub Command2_Click()
Dim srcPic As StdPicture
Dim srcText As String, sTemp As String
Dim srcArr() As Byte
Dim nd As Node
cdlg.FileName = ""
cdlg.FilterIndex = 1
cdlg.InitDir = App.Path
If CurrentResType <> "6" And CurrentResName = "" Then
MsgBox "No resource selected!", vbCritical, "Error"
Exit Sub
End If
Select Case UCase(CurrentResType)
Case "1", "12"
cdlg.Filter = "Cursor files (*.cur)|*.cur|Bitmap files (*.bmp)|*.bmp"
Set srcPic = GetPicture(CurrentResType, CurrentResName)
Case "2"
cdlg.Filter = "Bitmap files (*.bmp)|*.bmp"
Set srcPic = GetPicture(CurrentResType, CurrentResName)
Case "3", "14"
cdlg.Filter = "Icon files (*.ico)|*.ico|Bitmap files (*.bmp)|*.bmp"
Set srcPic = GetPicture(CurrentResType, CurrentResName)
Case "4"
cdlg.Filter = "Save as text (*.txt)|*.txt|Save as data (*.*)|*.*"
srcText = Text1.Text
Case "6"
cdlg.Filter = "Save as text (*.txt)|*.txt"
If CurrentResName <> "" Then
srcText = Text1.Text
Else
TreeView1_Expand TreeView1.SelectedItem
Set nd = TreeView1.SelectedItem.Child
Do
If nd Is Nothing Then Exit Do
sTemp = nd.Text
If IsNumeric(sTemp) Then sTemp = "#" & sTemp
srcText = srcText & GetString(sTemp) & vbCrLf
Set nd = nd.Next
Loop
End If
Case "9"
cdlg.Filter = "Save as text (*.txt)|*.txt|Save as data (*.*)|*.*"
srcText = Text1.Text
Case "11"
cdlg.Filter = "Save as text (*.txt)|*.txt"
srcText = Text1.Text
Case "16"
cdlg.Filter = "Save as text (*.txt)|*.txt|Save as data (*.*)|*.*"
srcText = Text1.Text
Case "23", "HTML"
cdlg.Filter = "HTML files (*.html)|*.html"
Case "AVI", "JPG", "JPEG", "GIF", "PNG", "TIF", "TIFF", "WMF", "EMF"
cdlg.Filter = UCase(CurrentResType) & " files (*." & LCase(CurrentResType) & ")|*." & LCase(CurrentResType)
Case Else
cdlg.Filter = "Save as data (*.*)|*.*"
End Select
cdlg.ShowSave
If cdlg.FileName = "" Then Exit Sub
If Not srcPic Is Nothing Then
If cdlg.FilterIndex = 1 Then
SavePicture srcPic, cdlg.FileName
Else
Picture4.Picture = srcPic
SavePicture Picture4.Image, cdlg.FileName
End If
ElseIf (srcText <> "") And (cdlg.FilterIndex = 1) Then
SaveText cdlg.FileName, srcText
Else
srcArr = GetDataArray(CurrentResType, CurrentResName)
SaveData cdlg.FileName, srcArr
End If
ErrSave:
If Err Then MsgBox "Unable to save resource", vbCritical, "Error"
Set srcPic = Nothing
Set nd = Nothing
End Sub
Private Sub Command3_Click()
MsgBox "Vahid - 2006", vbInformation, "About..."
Unload Me
End Sub
Private Sub Form_Load()
Label1 = ""
Caption = "Ark's resource Viewer/Extractor"
Command1.Caption = "&Open file with resources"
Command2.Caption = "&Save resource"
Command3.Caption = "&Exit"
With VScroll1
.Move Picture2.Width - .Width - 60, 0, .Width, Picture2.Height - HScroll1.Height - 60
.SmallChange = 1
.LargeChange = 10
.Enabled = False
End With
With HScroll1
.Move 0, Picture2.Height - .Height - 60, Picture2.Width - VScroll1.Width - 60, .Height
.SmallChange = 1
.LargeChange = 10
.Enabled = False
Picture3.Move VScroll1.Left, .Top, VScroll1.Width, .Height
End With
With Picture1
.BorderStyle = 0
.BackColor = vbButtonFace
.AutoRedraw = True
.Move 0, 0, Picture2.Width - VScroll1.Width - 60, Picture2.Height - HScroll1.Height - 60
picWidth = .Width
picHeight = .Height
End With
With Text1
.Move Picture2.Left, Picture2.Top, Picture2.Width, Picture2.Height
.Visible = False
.BackColor = vbButtonFace
.FontName = "courier new"
End With
With Picture4
.BorderStyle = 0
.AutoRedraw = True
.AutoSize = True
.Visible = False
End With
Picture1_Resize
Call FillResTypes(TreeView1, "Shell32.dll", "shell32.dll")
End Sub
Private Sub Form_Unload(Cancel As Integer)
ClearResource
End Sub
Private Sub HScroll1_Change()
Picture1.Left = -HScroll1.Value * Screen.TwipsPerPixelX
End Sub
Private Sub Picture1_Resize()
HScroll1.Enabled = (Picture1.Width > picWidth)
VScroll1.Enabled = (Picture1.Height > picHeight)
If HScroll1.Enabled Then
HScroll1.Value = 0
HScroll1.Max = ((Picture1.Width - Picture2.Width) + 3 * Picture1.TextWidth("A")) \ Screen.TwipsPerPixelY
End If
If VScroll1.Enabled Then
VScroll1.Value = 0
VScroll1.Max = (Picture1.Height - Picture2.Height) \ Screen.TwipsPerPixelY
End If
End Sub
Private Sub TreeView1_Collapse(ByVal Node As ComctlLib.Node)
RefreshView
End Sub
Private Sub TreeView1_Expand(ByVal Node As Node)
If Node.Child.Text = "Dummy" Then
TreeView1.Nodes.Remove Node.Child.Index
Call FillResNames(TreeView1, Node)
End If
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As Node)
Dim ResType As String, ResName As String
Dim 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"
ret = ShowPicture(GetPicture(ResType, ResName), Picture1)
Case "4"
Text1.Visible = True
ret = ShowText(GetMenuText(ResName), Text1)
Case "5", "17"
ret = ShowDialog(ResName, Picture1)
Case "6"
Text1.Visible = True
ret = ShowText(GetString(ResName), Text1)
Case "9"
Text1.Visible = True
ret = ShowText(GetAccelerators(ResName), Text1)
Case "11"
Text1.Visible = True
ret = ShowText(GetMessageTable(ResName), Text1)
Case "16"
Text1.Visible = True
ret = ShowText(GetVersionInfo(ResName), Text1)
Case "23", "HTML"
Text1.Visible = True
ret = ShowText(GetHTML(ResType, ResName), Text1)
Case "AVI"
ret = ShowAVI(ResName, Picture1)
Case "JPG", "JPEG", "GIF", "PNG", "TIF", "TIFF", "WMF", "EMF"
ret = ShowPicture(GetPictureExt(ResType, ResName), Picture1)
Case Else
Text1.Visible = True
ret = ShowText(GetHexDump(ResType, ResName), Text1)
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
End Sub
Private Sub VScroll1_Change()
Picture1.Top = -VScroll1.Value * Screen.TwipsPerPixelY
End Sub
Private Sub VScroll1_GotFocus()
Picture1.SetFocus
End Sub
Private Sub HScroll1_GotFocus()
Picture1.SetFocus
End Sub
Private Sub RefreshView()
If Dir(TEMP_FILE_NAME) <> "" Then
Call mciSendString("close video", 0&, 0, 0)
Kill TEMP_FILE_NAME
End If
If hDialog Then Call DestroyWindow(hDialog)
Picture1.Cls
Picture1.Refresh
Label1 = ""
Text1 = ""
End Sub
حالا با اين همون کار رو بکن امه با نام :
1.bas
ذخيره کن
Attribute VB_Name = "mEnumResourse"
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 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 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
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
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
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 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.Refresh
tv.Nodes.Item(1).Expanded = True
Set tv = Nothing
End Function
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
Attribute VB_Name = "mGetResource"
Private Type ACCEL_TABLE_ENTRY
fFlags As Integer
wASCII As Integer
wID As Integer
wPadding As Integer
End Type
Private Const FVIRTKEY = &H1
Private Const FNOINVERT = &H2
Private Const FSHIFT = &H4
Private Const FCONTROL = &H8
Private Const FALT = &H10
Private Type PictDesc
cbSizeofStruct As Long
PicType As Long
hImage As Long
xExt As Long
yExt As Long
End Type
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
All times are GMT + 3.5 Hours Goto page Previous1, 2
Page 2 of 2
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum