các hàm API trong VB6.0

ACCESSTIMEOUT
Khai báo:
Type accesstimeout
cbSzie As Long
dwFlags As Long
iTimeOutMSec As Long
End Type

Mô tả:
Các biến kiểu Accesstimeout đặc tả thông tin về đặc tính thời gian giới hạn (time-out) cho những đặc tính truy xuất của cửa sổ. Sau Khoảng thời gian time-out (tính từ lần tương tác gần nhất từ người dùng), các chức năng như FilterKeys, HighContrast, MouseKeys, StickKeys và ToggleKeys sẽ bị làm mất hiệu lực.

Tham số:
cbSize: Kích thước tính theo byte của cấu trúc.

dwFlags: Có thể không dùng hoặc dùng, một trong các cờ sau đây để đặc tả sự thiết lập đặc điểm time-out.
ATF_AVAILABLE=&H4: Thời gian có thể được thay đổi (cờ này có thể được đọc nhưng không thiết lập).
ATF_ONOFFFEEDBACK=&H2: Phát ra âm thanh khi thời gian time-out trôi qua và các chức năng khác bị ảnh hưởng ngừng hoạt động.
ATF_TIMEOUTON=&H1: Chức năng time-out được kích hoạt.

ACL
Khai báo:
Type
AclRevision As Byte
Sbz1 As Byte
AclSize As Integer
AceCount As Integer
Sbz2 As Integer
End Type

Mô tả:
Biến kiểu ACL chứa thông tin về một danh sách các điều khiển truy xuất (Access Control List). Theo sau cấu trúc ACL có thể có hoặc không các thực thể điều khiển truy xuất (Access Control Entries) tạo nên ACL này. Chú ý là ACE không thực sự được chứa trong cấu trúc ACL.

Tham số:
AclRevision: Phải được thiết lập bằng cờ sau để chỉ ra mức độ xem xét lại của ACL:
ACL_REVISION=2: Mức độ xem xét lại duy nhất.

Sbz1: dành riêng thiết lập bằng 0. Thành phần này đơn thuần là để canh thẳng các thành phần khác của cấu trúc trong bộ nhớ.

AclSize: kích thước kết hợp của cấu trúc này và tất cả các ACE theo sau.

AceCount: Số các ACE theo sau cấu trúc này.

Sbz2: Dành riêng gán bằng 0. Thành phần này đơn thuần canh thẳng các thành phần khác của cấu trúc trong bộ nhớ.

Ví dụ:
'Example from MSDN (Q240176)
'The following code changes permissions on a folder to Add & Read or Change.
'The folder needs to be created on an NTFS partition.
'You need to be an Administrator on the machine in question and have read/write
'(READ_CONTROL and WRITE_DAC) access to the file or directory.

'1. Create a Standard EXE project in Visual Basic. Form1 is created by default.
'2. Add two Textboxes (Text1 and Text2) and two CommandButtons (Command1 and Command2) to Form1.
'3. Add the following code to the form and the module
'4. Run the application.
'5. In the Test1 TextBox, enter the name of the folder you want to change permissions on. (D:\test is entered by default.)
' In the Test2 Textbox, enter the name of the user you want to give these permissions to.
'6. Click the Add & Read permissions button to give Add & Read permissions to the folder, or click the Change Permissions
' button to give Change permissions to the folder.
'7. To check the permissions on the folder, right-click Explorer. Select the Properties menu item, and click the Security
' Tab of the Properties dialog box. On the Security tab, click the Permissions button. The specific account should say
' Add & Read or Change depending on which button you clicked in the preceding sample.

'Add this code to the form
Private Sub Command1_Click()
Dim sUserName As String
Dim sFolderName As String
sUserName = Trim$(CStr(Text2.Text))
sFolderName = Trim$(CStr(Text1.Text))
SetAccess sUserName, sFolderName, GENERIC_READ Or GENERIC_EXECUTE Or DELETE Or GENERIC_WRITE
End Sub
Private Sub Command2_Click()
Dim sUserName As String
Dim sFolderName As String
sUserName = Trim$(Text2.Text)
sFolderName = Trim$(Text1.Text)
SetAccess sUserName, sFolderName, GENERIC_EXECUTE Or GENERIC_READ
End Sub
Private Sub Form_Load()
Text1.Text = "enter folder name"
Text2.Text = "enter username"
Command1.Caption = "Change"
Command2.Caption = "Read & Add"
End Sub

'Add this code to a module

' Constants used within our API calls. Refer to the MSDN for more
' information on how/what these constants are used for.

' Memory constants used through various memory API calls.
Public Const GMEM_MOVEABLE = &H2
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED + LMEM_ZEROINIT)
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_ALL = &H10000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_WRITE = &H40000000

' The file/security API call constants.
' Refer to the MSDN for more information on how/what these constants
' are used for.
Public Const DACL_SECURITY_INFORMATION = &H4
Public Const SECURITY_DESCRIPTOR_REVISION = 1
Public Const SECURITY_DESCRIPTOR_MIN_LENGTH = 20
Public Const SD_SIZE = (65536 + SECURITY_DESCRIPTOR_MIN_LENGTH)
Public Const ACL_REVISION2 = 2
Public Const ACL_REVISION = 2
Public Const MAXDWORD = &HFFFFFFFF
Public Const SidTypeUser = 1
Public Const AclSizeInformation = 2

' The following are the inherit flags that go into the AceFlags field
' of an Ace header.

Public Const OBJECT_INHERIT_ACE = &H1
Public Const CONTAINER_INHERIT_ACE = &H2
Public Const NO_PROPAGATE_INHERIT_ACE = &H4
Public Const INHERIT_ONLY_ACE = &H8
Public Const INHERITED_ACE = &H10
Public Const VALID_INHERIT_FLAGS = &H1F
Public Const DELETE = &H10000

' Structures used by our API calls.
' Refer to the MSDN for more information on how/what these
' structures are used for.
Type ACE_HEADER
AceType As Byte
AceFlags As Byte
AceSize As Integer
End Type


Public Type ACCESS_DENIED_ACE
Header As ACE_HEADER
Mask As Long
SidStart As Long
End Type

Type ACCESS_ALLOWED_ACE
Header As ACE_HEADER
Mask As Long
SidStart As Long
End Type

Type ACL
AclRevision As Byte
Sbz1 As Byte
AclSize As Integer
AceCount As Integer
Sbz2 As Integer
End Type

Type ACL_SIZE_INFORMATION
AceCount As Long
AclBytesInUse As Long
AclBytesFree As Long
End Type

Type SECURITY_DESCRIPTOR
Revision As Byte
Sbz1 As Byte
Control As Long
Owner As Long
Group As Long
sACL As ACL
Dacl As ACL
End Type

' API calls used within this sample. Refer to the MSDN for more
' information on how/what these APIs do.

Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String, sid As Any, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal dwRevision As Long) As Long
Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As Byte, lpbDaclPresent As Long, pDacl As Long, lpbDaclDefaulted As Long) As Long
Declare Function GetFileSecurityN Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, ByVal pSecurityDescriptor As Long, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Declare Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As Byte, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Declare Function GetAclInformation Lib "advapi32.dll" (ByVal pAcl As Long, pAclInformation As Any, ByVal nAclInformationLength As Long, ByVal dwAclInformationClass As Long) As Long
Public Declare Function EqualSid Lib "advapi32.dll" (pSid1 As Byte, ByVal pSid2 As Long) As Long
Declare Function GetLengthSid Lib "advapi32.dll" (pSid As Any) As Long
Declare Function InitializeAcl Lib "advapi32.dll" (pAcl As Byte, ByVal nAclLength As Long, ByVal dwAclRevision As Long) As Long
Declare Function GetAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceIndex As Long, pace As Any) As Long
Declare Function AddAce Lib "advapi32.dll" (ByVal pAcl As Long, ByVal dwAceRevision As Long, ByVal dwStartingAceIndex As Long, ByVal pAceList As Long, ByVal nAceListLength As Long) As Long
Declare Function AddAccessAllowedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Byte) As Long
Public Declare Function AddAccessDeniedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Byte) As Long
Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal bDaclPresent As Long, pDacl As Byte, ByVal bDaclDefaulted As Long) As Long
Declare Function SetFileSecurity Lib "advapi32.dll" Alias "SetFileSecurityA" (ByVal lpFileName As String, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Sub SetAccess(sUserName As String, sFileName As String, lMask As Long)
Dim lResult As Long' Result of various API calls.
Dim I As Integer' Used in looping.
Dim bUserSid(255) As Byte' This will contain your SID.
Dim bTempSid(255) As Byte' This will contain the Sid of each ACE in the ACL .

Dim sSystemName As String' Name of this computer system.

Dim lSystemNameLength As Long' Length of string that contains
' the name of this system.

Dim lLengthUserName As Long' Max length of user name.

'Dim sUserName As String * 255 ' String to hold the current user
' name.


Dim lUserSID As Long' Used to hold the SID of the
' current user.

Dim lTempSid As Long' Used to hold the SID of each ACE in the ACL
Dim lUserSIDSize As Long' Size of the SID.
Dim sDomainName As String * 255' Domain the user belongs to.
Dim lDomainNameLength As Long' Length of domain name needed.

Dim lSIDType As Long' The type of SID info we are
' getting back.

Dim sFileSD As SECURITY_DESCRIPTOR' SD of the file we want.

Dim bSDBuf() As Byte' Buffer that holds the security
' descriptor for this file.

Dim lFileSDSize As Long' Size of the File SD.
Dim lSizeNeeded As Long' Size needed for SD for file.


Dim sNewSD As SECURITY_DESCRIPTOR' New security descriptor.

Dim sACL As ACL' Used in grabbing the DACL from
' the File SD.

Dim lDaclPresent As Long' Used in grabbing the DACL from
' the File SD.

Dim lDaclDefaulted As Long' Used in grabbing the DACL from
' the File SD.

Dim sACLInfo As ACL_SIZE_INFORMATION' Used in grabbing the ACL
' from the File SD.

Dim lACLSize As Long' Size of the ACL structure used
' to get the ACL from the File SD.

Dim pAcl As Long' Current ACL for this file.
Dim lNewACLSize As Long' Size of new ACL to create.
Dim bNewACL() As Byte' Buffer to hold new ACL.

Dim sCurrentACE As ACCESS_ALLOWED_ACE' Current ACE.
Dim pCurrentAce As Long' Our current ACE.

Dim nRecordNumber As Long

' Get the SID of the user. (Refer to the MSDN for more information on SIDs
' and their function/purpose in the operating system.) Get the SID of this
' user by using the LookupAccountName API. In order to use the SID
' of the current user account, call the LookupAccountName API
' twice. The first time is to get the required sizes of the SID
' and the DomainName string. The second call is to actually get
' the desired information.

lResult = LookupAccountName(vbNullString, sUserName, _
bUserSid(0), 255, sDomainName, lDomainNameLength, _
lSIDType)

' Now set the sDomainName string buffer to its proper size before
' calling the API again.
sDomainName = Space(lDomainNameLength)

' Call the LookupAccountName again to get the actual SID for user.
lResult = LookupAccountName(vbNullString, sUserName, _
bUserSid(0), 255, sDomainName, lDomainNameLength, _
lSIDType)

' Return value of zero means the call to LookupAccountName failed;
' test for this before you continue.
If (lResult = 0) Then
MsgBox "Error: Unable to Lookup the Current User Account: " _
& sUserName
Exit Sub
End If

' You now have the SID for the user who is logged on.
' The SID is of interest since it will get the security descriptor
' for the file that the user is interested in.
' The GetFileSecurity API will retrieve the Security Descriptor
' for the file. However, you must call this API twice: once to get
' the proper size for the Security Descriptor and once to get the
' actual Security Descriptor information.

lResult = GetFileSecurityN(sFileName, DACL_SECURITY_INFORMATION, _
0, 0, lSizeNeeded)

' Redimension the Security Descriptor buffer to the proper size.
ReDim bSDBuf(lSizeNeeded)

' Now get the actual Security Descriptor for the file.
lResult = GetFileSecurity(sFileName, DACL_SECURITY_INFORMATION, _
bSDBuf(0), lSizeNeeded, lSizeNeeded)

' A return code of zero means the call failed; test for this
' before continuing.
If (lResult = 0) Then
MsgBox "Error: Unable to Get the File Security Descriptor"
Exit Sub
End If

' Call InitializeSecurityDescriptor to build a new SD for the
' file.
lResult = InitializeSecurityDescriptor(sNewSD, _
SECURITY_DESCRIPTOR_REVISION)

' A return code of zero means the call failed; test for this
' before continuing.
If (lResult = 0) Then
MsgBox "Error: Unable to Initialize New Security Descriptor"
Exit Sub
End If

' You now have the file's SD and a new Security Descriptor
' that will replace the current one. Next, pull the DACL from
' the SD. To do so, call the GetSecurityDescriptorDacl API
' function.

lResult = GetSecurityDescriptorDacl(bSDBuf(0), lDaclPresent, _
pAcl, lDaclDefaulted)

' A return code of zero means the call failed; test for this
' before continuing.
If (lResult = 0) Then
MsgBox "Error: Unable to Get DACL from File Security " _
& "Descriptor"
Exit Sub
End If

' You now have the file's SD and a new Security Descriptor
' that will replace the current one. Next, pull the DACL from
' the SD. To do so, call the GetSecurityDescriptorDacl API
' function.

lResult = GetSecurityDescriptorDacl(bSDBuf(0), lDaclPresent, _
pAcl, lDaclDefaulted)

' A return code of zero means the call failed; test for this
' before continuing.
If (lResult = 0) Then
MsgBox "Error: Unable to Get DACL from File Security " _
& "Descriptor"
Exit Sub
End If

' You have the file's SD, and want to now pull the ACL from the
' SD. To do so, call the GetACLInformation API function.
' See if ACL exists for this file before getting the ACL
' information.
If (lDaclPresent = False) Then
MsgBox "Error: No ACL Information Available for this File"
Exit Sub
End If

' Attempt to get the ACL from the file's Security Descriptor.
lResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)

' A return code of zero means the call failed; test for this
' before continuing.
If (lResult = 0) Then
MsgBox "Error: Unable to Get ACL from File Security Descriptor"
Exit Sub
End If

' Now that you have the ACL information, compute the new ACL size
' requirements.
lNewACLSize = sACLInfo.AclBytesInUse + (Len(sCurrentACE) + _
GetLengthSid(bUserSid(0))) * 2 - 4

' Resize our new ACL buffer to its proper size.
ReDim bNewACL(lNewACLSize)

' Use the InitializeAcl API function call to initialize the new
' ACL.
lResult = InitializeAcl(bNewACL(0), lNewACLSize, ACL_REVISION)

' A return code of zero means the call failed; test for this
' before continuing.
If (lResult = 0) Then
MsgBox "Error: Unable to Initialize New ACL"
Exit Sub
End If

' If a DACL is present, copy it to a new DACL.
If (lDaclPresent) Then

' Copy the ACEs from the file to the new ACL.
If (sACLInfo.AceCount > 0) Then

' Grab each ACE and stuff them into the new ACL.
nRecordNumber = 0
For I = 0 To (sACLInfo.AceCount - 1)

' Attempt to grab the next ACE.
lResult = GetAce(pAcl, I, pCurrentAce)

' Make sure you have the current ACE under question.
If (lResult = 0) Then
MsgBox "Error: Unable to Obtain ACE (" & I & ")"
Exit Sub
End If

' You have a pointer to the ACE. Place it
' into a structure, so you can get at its size.
CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)

'Skip adding the ACE to the ACL if this is same usersid
lTempSid = pCurrentAce + 8
If EqualSid(bUserSid(0), lTempSid) = 0 Then

' Now that you have the ACE, add it to the new ACL.
lResult = AddAce(VarPtr(bNewACL(0)), ACL_REVISION, _
MAXDWORD, pCurrentAce, _
sCurrentACE.Header.AceSize)

' Make sure you have the current ACE under question.
If (lResult = 0) Then
MsgBox "Error: Unable to Add ACE to New ACL"
Exit Sub
End If
nRecordNumber = nRecordNumber + 1
End If

Next I

' You have now rebuilt a new ACL and want to add it to
' the newly created DACL.
lResult = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, _
lMask, bUserSid(0))

' Make sure added the ACL to the DACL.
If (lResult = 0) Then
MsgBox "Error: Unable to Add ACL to DACL"
Exit Sub
End If

'If it's directory, we need to add inheritance staff.
If GetAttr(sFileName) And vbDirectory Then

' Attempt to grab the next ACE which is what we just added.
lResult = GetAce(VarPtr(bNewACL(0)), nRecordNumber, pCurrentAce)

' Make sure you have the current ACE under question.
If (lResult = 0) Then
MsgBox "Error: Unable to Obtain ACE (" & I & ")"
Exit Sub
End If
' You have a pointer to the ACE. Place it
' into a structure, so you can get at its size.
CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
sCurrentACE.Header.AceFlags = OBJECT_INHERIT_ACE + INHERIT_ONLY_ACE
CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)

'add another ACE for files
lResult = AddAccessAllowedAce(bNewACL(0), ACL_REVISION, _
lMask, bUserSid(0))

' Make sure added the ACL to the DACL.
If (lResult = 0) Then
MsgBox "Error: Unable to Add ACL to DACL"
Exit Sub
End If

' Attempt to grab the next ACE.
lResult = GetAce(VarPtr(bNewACL(0)), nRecordNumber + 1, pCurrentAce)

' Make sure you have the current ACE under question.
If (lResult = 0) Then
MsgBox "Error: Unable to Obtain ACE (" & I & ")"
Exit Sub
End If

CopyMemory sCurrentACE, pCurrentAce, LenB(sCurrentACE)
sCurrentACE.Header.AceFlags = CONTAINER_INHERIT_ACE
CopyMemory ByVal pCurrentAce, VarPtr(sCurrentACE), LenB(sCurrentACE)
End If


' Set the file's Security Descriptor to the new DACL.
lResult = SetSecurityDescriptorDacl(sNewSD, 1, _
bNewACL(0), 0)

' Make sure you set the SD to the new DACL.
If (lResult = 0) Then
MsgBox "Error: " & _
"Unable to Set New DACL to Security Descriptor"
Exit Sub
End If

' The final step is to add the Security Descriptor back to
' the file!
lResult = SetFileSecurity(sFileName, _
DACL_SECURITY_INFORMATION, sNewSD)

' Make sure you added the Security Descriptor to the file!
If (lResult = 0) Then
MsgBox "Error: Unable to Set New Security Descriptor " _
& " to File: " & sFileName
MsgBox Err.LastDllError
Else
MsgBox "Updated Security Descriptor on File: " _
& sFileName
End If

End If

End If

End Sub

AddFontResource
Khai báo:
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long

Mô tả:
Thêm Font vào bảng Font hệ thống từ tập tin Font có sẳn.

Tham số:
lpFileName: tên tập tin Font gồm các lọai sau:
.fon
Font resource file.
.fnt
Raw bitmap font file.
.ttf
Raw TrueType file.
.ttc
Windows 95/98 East Asian and Windows NT: TrueType font collection.
.fot
TrueType resource file.
.otf
PostScript OpenType font.
.mmm
multiple master Type1 font resource file. It must be used with.pfm and.pfb files.
.pfb
Type 1 font bits file. It is used with a.pfm file.
.pfm
Type 1 font metrics file. It is used with a.pfb file.

Ví dụ:
Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long

'Ten cua Font
Private Const MY_FONT_NAME = "ABC-VBClubFont"

Private Sub Form_Load()
Dim i As Integer, retval As Long

'Khai bao su dung Font voi he thong
retval = AddFontResource("C:\myFont.fon")

'Khai bao su dung Font
Me.Font = MY_FONT_NAME

'Danh sach cac Font co trong he thong
Me.AutoRedraw = True
For i = 0 To Screen.FontCount - 1
Me.Print Screen.Fonts(i)
Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim retval As Long
'Go bo Font khoi he thong
retval = RemoveFontResource("C:\myFont.fon")
End
End Sub

BringWindowToTop
Khai báo:
Declare Function BringWindowToTop Lib "user32" Alias "BringWindowToTop" (ByVal hwnd As Long) As Long

Mô tả:
Chuyển cửa sổ lên đầu danh sách (làm lộ ra nếu bị khuất).

Tham số:
HWnd: handle của cửa sổ cần tác động.

Ví dụ:
'Cần 2 Form (Form1 và Form2). 1 Command button trên Form1
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Command1_Click()
'in form1
'Set Form2 on top
BringWindowToTop Form2.hwnd
End Sub
Private Sub Form_Load()
Form2.Visible = True
End Sub

BROWSEINFO
Khai báo:
Type Browseinfo
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
lImage As Long
End Type

Mô tả:
Cấu trúc Browseinfo lưu giữ thông tin dùng để tạo các thuộc tính duyệt thư mục của Windows Shell cho hộp thoại Folder. Cấu trúc này cũng nhận về một số thông tin về lựa chọn sau cùng của người dùng.

* Đặc điểm ghi nhớ: Vì có sự trùng hợp ngẫu nhiên trong cú pháp của VB nên toán tử AddressOf không được dùng một cách trực tiếp để thiết lập tham số con trỏ lpfnCallback tới một hàm callback. Vì toán tử AddressOf chỉ hợp lý trong một lời gọi hàm, một "hàm giả" phải được định nghĩa bởi chương trình mà chương trình đó đơn giản phải trả về giá trị truyền cho nó. Xem ví dụ với SHBrowseForFolder để thấy được cách thức mà nó có thể làm việc.

Tham số:
hwndOwner: Một handle dùng để mở một hộp thoại windows thông dụng.

pidlRoot: một con trỏ tới cấu trúc ITEMDLIST. Cấu trúc này xác định thư mục gốc cho hộp thoại. Sự lựa chọn của người dùng được giới hạn trong thư mục này và các thư mục con trong nó.

pszDisplayName: Nhận tên kết thúc bằng kí tự NULL của thư mục mà người dùng chọn. Biến này phải được khởi tạo là một chuỗi rỗng 260 kí tự.

lpszTitle: Tiêu đề của hộp thoại nó xuất hiện phía trên cây thư mục.

ulFlags: Sự kết hợp các cờ dưới đây đặc tả các tùy chọn bổ sung cho hộp thoại.
BIF_BROWSEFORCOMPUTER: chỉ cho người dùng chọn một máy tính.
BIF_BROWSEFORPRINTER: chỉ cho người dùng chọn một máy in.
BIF_BROWSEFINCLUDEFILES: với IE 4.0 hay phiên bản mới hơn: hiển thị các file như là các thư mục trong cây.
BIF_DONTGOBELOWDOMAIN: Không trình bày các thư mục mạng phía dưới mức phân vùng hiện thời trong cây thư mục.
BIF_EDITBOX: Với IE 4.0 hay phiên bản mới hơn: Hiển thị một hộp hiệu chỉnh phía trên cây thư mục cho phép người dùng trực tiếp gõ vào đường dẫn của thư mục để chọn.
BIF_RETURNFSANCESTORS: Chỉ cho phép người dùng chọn một hình thức ban đầu của hệ thống file.
BIF_RETURNONLYFSDIRS: Chỉ cho người dùng chọn một thư mục hệ thống file.
BIF_STATUSTEXT: hiển thị một vùng của văn bản trạng thái (văn bản này có thể được thiết lập bởi hàm callback) phía trên cây thư mục.
BIF_USENEWUI: Windows 2000 thiết kế giao tiếp người dùng mới của hộp thoại. Thiết kế mới này bao gồm: Một hộp thoại lớn hơn có kích thước thay đổi được, có thể kéo và thả: tái sắp xếp lại thứ tự các menu ngữ cảnh và tạo ra thư mục mới, xóa các lệnh menu ngữ cảnh khác.
BIF_VALIDATE: Với IE 4.0 hay mới hơn nếu người dùng gõ một đường dẫn sai vào trong hộp soạn thảo, gửi thông điệp BFFM_VALIDATEFAILED tới hàm callback để cảnh báo người dùng.

lpfnCallback: Một con trỏ tới hàm callback BrowseCallbackProc dùng để xử lý các thông điệp của hộp thoại. Để sử dụng tác động mặc định này phải thiết lập lpfnCallback là 0.

lParam: Một giá trị do ứng dụng định nghĩa để truyền cho hàm callback nếu cần.

lImage: nhận chỉ số của hình ảnh hệ thống kết hợp với sự lựa chọn của người dùng.

Hằng định nghĩa

Const BIF_BROWSEFORCOMPUTER=&H1000
Const BIF_BROWSEFORPRINTER=&H2000
Const BIF_BROWSEINCLUDEFILES=&H4000
Const BIF_DONTGOBELOWDOMAIN=&H2
Const BIF_EDITBOX=&H10
Const RETURNFSANCESTORS=&H8
Const RETURNONLYFSDIRS=&H1
Const BIF_STATUSTEXT=&H4
Const BIF_USENEWUI=&H40
Const BIF_VALIDATE=&H20

ôi choáng váng, lắc lư...hồn phay phảy, lâng lâng loạng xoạng thấy phê phê!!!

Ví dụ
'Module code:
Option Explicit

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Type Size
cx As Long
cy As Long
End Type

Private Const DIALOG_CURRENT_SELECTION_TEXT As String = "
Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED As Long = 2
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_STATUSTEXT As Long = &H4

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderW" (lpBrowseInfo As BROWSEINF As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal lPIDL As Long, _
ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function ILCreateFromPath Lib "shell32" Alias "#157" _
(ByVal sPath As String) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hmem As Long) As Long
Private Declare Function GetWindowDC Lib "user32.dll" (ByVal hwnd As Long) _
As Long
Private Declare Function GetTextExtentPoint Lib "gdi32.dll" Alias _
"GetTextExtentPointW" (ByVal hdc As Long, ByVal lpszString As Long, _
ByVal cbString As Long, ByRef lpSize As Size) As Long
Private Declare Function PathCompactPath Lib "shlwapi.dll" Alias _
"PathCompactPathA" (ByVal hdc As Long, ByVal pszPath As String, ByVal _
dx As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
Private Declare Function SetWindowTextW Lib "user32" (ByVal hwnd As Long, ByVal lpString As Long) As Long

Public Function BrowseForFolder(DialogText As String, DefaultPath As String, _
OwnerhWnd As Long, Optional ShowCurrentPath As Boolean = True, _
Optional RootPath As Variant, Optional NewDialogStyle As Boolean = False, _
Optional IncludeFiles As Boolean = False) As String

Dim biBrowseInfo As BROWSEINFO
Dim lPIDL As Long
Dim sBuffer As String
Dim lBufferPointer As Long

With biBrowseInfo
.hOwner = OwnerhWnd

If Not IsMissing(RootPath) Then .pidlRoot = PathToPIDL(RootPath)

If ShowCurrentPath And DialogText = "$" Then DialogText = "
.lpszTitle = StrPtr(DialogText)

If ShowCurrentPath Then .pszDisplayName = StrPtr(sBuffer)

.ulFlags = BIF_RETURNONLYFSDIRS + _
IIf(ShowCurrentPath, BIF_STATUSTEXT, 0) + _
IIf(NewDialogStyle, BIF_NEWDIALOGSTYLE, 0) + _
IIf(IncludeFiles, BIF_BROWSEINCLUDEFILES, 0)

.lpfnCallback = FunctionPointer(AddressOf BrowseCallbackProc)

.lParam = PathToPIDL(DefaultPath)
End With

lPIDL = SHBrowseForFolder(biBrowseInfo)

If lPIDL Then
sBuffer = Space$(MAX_PATH)

SHGetPathFromIDList lPIDL, sBuffer

sBuffer = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)

BrowseForFolder = sBuffer

Call CoTaskMemFree(lPIDL)
End If

If ShowCurrentPath Then Call LocalFree(lBufferPointer)
End Function

Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal lParam As Long, ByVal lpData As Long) As Long

Dim sBuffer As String
Dim lStaticWnd As Long
Dim lStaticDC As Long
Dim sPath As String
Dim rctStatic As RECT
Dim szTextSize As Size

Select Case uMsg
Case BFFM_INITIALIZED
' Thay doi chuoi text cho cac nut lenh
Call SendMessage(hwnd, BFFM_SETSELECTIONW, False, ByVal StrPtr(lpData))
SetWindowTextW hwnd, StrPtr("Ch" & ChrW$(&H1ECD) & "n th" & ChrW$(&H1B0) & " m" & ChrW$(&H1EE5) & "c")
lStaticWnd = FindWindowEx(hwnd, ByVal 0&, "BUTTON", "OK")
SetWindowTextW lStaticWnd, StrPtr("&Ch" & ChrW$(&H1ECD) & "n")
lStaticWnd = FindWindowEx(hwnd, ByVal 0&, "BUTTON", "Cancel")
SetWindowTextW lStaticWnd, StrPtr("&Tho" & ChrW$(&HE1) & "t")
lStaticWnd = FindWindowEx(hwnd, ByVal 0&, "BUTTON", "&Make New Folder")
SetWindowTextW lStaticWnd, StrPtr("T" & ChrW$(&H1EA1) & "o th" & ChrW$(&H1B0) & " &m" & ChrW$(&H1EE5) & "c m" & ChrW$(&H1EDB) & "i")

Case BFFM_SELCHANGED
sBuffer = Space$(MAX_PATH)

If SHGetPathFromIDList(lParam, sBuffer) Then
SendMessage hwnd, BFFM_SETSTATUSTEXTW, 0&, ByVal StrPtr("$")

lStaticDC = GetWindowDC(lStaticWnd)

GetWindowRect lStaticWnd, rctStatic

GetTextExtentPoint lStaticDC, ByVal StrPtr(DIALOG_CURRENT_SELECTION_TEXT), _
ByVal Len(DIALOG_CURRENT_SELECTION_TEXT), szTextSize

sPath = sBuffer
If PathCompactPath(ByVal lStaticDC, sPath, ByVal (rctStatic.Right - _
rctStatic.Left - szTextSize.cx + 80)) = 0 Then sPath = sBuffer

sPath = Left$(sPath, InStr(1, sPath, vbNullChar) - 1)

Call SendMessage(hwnd, BFFM_SETSTATUSTEXTW, 0&, _
ByVal StrPtr(DIALOG_CURRENT_SELECTION_TEXT & sPath))
Else
SendMessage hwnd, BFFM_SETSTATUSTEXTW, 0&, ByVal "
End If
End Select
End Function

Private Function PathToPIDL(ByVal sPath As String) As Long
Dim lRet As Long

lRet = ILCreateFromPath(sPath)
If lRet = 0 Then
sPath = StrConv(sPath, VbStrConv.vbUnicode)
lRet = ILCreateFromPath(sPath)
End If

PathToPIDL = lRet
End Function

Private Function FunctionPointer(fp As Long) As Long
FunctionPointer = fp
End Function


'Form code:
Private Sub Form_Load()
MsgBox BrowseForFolder("Ch" & ChrW$(&H1ECD) & "n th" & ChrW$(&H1B0) & " m" & ChrW$(&H1EE5) & "c", "c:\", Me.hwnd)
End Sub

CallWindowProc
Khai báo:
Declare Function CallWindowProc Lib “user32.dll” Alias “CallWindowProcA” (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg as Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Mô tả:
CallWindowProc (gọi tường minh là hàm hook) hoạt động như một thủ tục của cửa sổ để xử lý một thông điệp. Nó cho phép một thông điệp của cửa sổ được xử lý bằng một thủ tục cửa sổ mà không nhất thiết là thủ tục thường được gọi bởi cửa sổ.

Tham số:
lpPrevWndFunc: Một con trỏ tới hàm thủ tục window để gọi một cách tường minh. Hàm này dùng để xử lý thông tin.

hWnd: Một handle cho cửa sổ xử lý thông điệp.
Msg: Thông điệp để xử lý.
wParam: Thông tin bổ sung về thông điệp.
lParam: Thông tin bổ sung về thông điệp.

Ví dụ:
'Module code:
Option Explicit

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const GWL_WNDPROC = (-4)' This we recognize as the constant for accessing the callback address

Public lngOldProc As Long' This is for preserving the old address of the callback

Public Function myWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

myWindowProc = CallWindowProc(lngOldProc, hWnd, Msg, wParam, lParam)
'Your code here

End Function


'Form code:
Private Sub Form_Load()
' lngOldProc now holds the old addrss of the callback function.
lngOldProc = SetWindowLong (Me.hwnd, GWL_WNDPROC, AddressOf myWindowProc)
End Sub

ChooseColor
Khai báo:
Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long

Mô tả:
Mở một hộp thọai cho phép người dùng chọn màu.

Tham số:
pChoosecolor: trỏ tới cấu trúc CHOOSECOLOR lưu giữ các tham số cần dùng để khởi tạo khi mở hộp thoại. Nó sẽ trả về thông tin của màu mà người dùng đã chọn

Ví dụ:
'Form code:
Private Sub Form_Load()
Dim CDlg As COMDLG
'Open file
If ShowOpen(CDlg) Then MsgBox CDlg.Filename,, "Ban da chon:"

'Save file
If ShowSave(CDlg) Then MsgBox CDlg.Filename,, "Ban da chon:"

'Chon mau
If ShowColor(CDlg) Then MsgBox CDlg.Color,, "Ban da chon:"

'Chon Font
CDlg.flagsFont = CF_BOTH Or CF_LIMITSIZE
CDlg.hwndOwner = Me.hwnd'Can be ignored
CDlg.hInstance = App.hInstance'Can be ignored
CDlg.flagsFont = CF_BOTH Or CF_LIMITSIZE
CDlg.FontName = "Tahoma"
CDlg.FontBold = True
CDlg.FontUnderline = True
CDlg.FontItatic = True
CDlg.FontSizeMax = 20
CDlg.FontSizeMin = 8
If ShowFont(CDlg) Then MsgBox CDlg.FontName,, "Ban da chon:"
End Sub

Option Explicit

'############ KHAI BAO CAC API CAN SU DUNG ############

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameW" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As ChooseFont) As Long
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)


'############ DINH NGHIA CAC KIEU DU LIEU VA HANG SO CAN SU DUNG ############

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As Long
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As Long
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As Long
lpstrTitle As Long
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type ChooseColor
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type ChooseFont
lStructSize As Long
hwndOwner As Long' caller's window handle
hDC As Long' printer DC/IC or NULL
lpLogFont As Long' ptr. to a LOGFONT struct
iPointSize As Long' 10 * size in points of selected font
flags As Long' enum. type flags
rgbColors As Long' returned text color
lCustData As Long' data passed to hook fn.
lpfnHook As Long' ptr. to hook function
lpTemplateName As String' custom template name
hInstance As Long' instance handle of.EXE that contains cust. dlg. template
lpszStyle As String' return the style field here must be LF_FACESIZE or bigger
nFontType As Integer' same value reported to the EnumFonts call back with the extra FONTTYPE bits added
MISSING_ALIGNMENT As Integer
nSizeMin As Long' minimum pt size allowed &
nSizeMax As Long' max pt size allowed if CF_LIMITSIZE is used
End Type

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 31
End Type

Public Type COMDLG
Color As Long
DefExt As String
flagsOpenSave As OpenSaveflags
flagsColor As Colorflags
flagsFont As Fontflags
flagsPrint As Long
hwndOwner As Long
hInstance As Long
Filter As String
FilterIndex As Long
Filename As String
InitDir As String
Title As String
FontColor As Long
FontName As String
FontSize As Integer
FontBold As Boolean
FontItatic As Boolean
FontUnderline As Boolean
FontStrikeOut As Boolean
FontSizeMax As Integer
FontSizeMin As Integer
hDC As Long
End Type

Public Enum Colorflags
CC_ANYCOLOR = &H100
CC_FULLOPEN = &H2
CC_PREVENTFULLOPEN = &H4
CC_RGBINIT = &H1
CC_SOLIDCOLOR = &H80
End Enum

Public Enum Fontflags
CF_TTONLY = &H40000
CF_FIXEDPITCHONLY = &H4000&
CF_NOFACESEL = &H80000
CF_NOSCRIPTSEL = &H800000
CF_NOSTYLESEL = &H100000
CF_NOSIZESEL = &H200000
CF_NOVERTFONTS = &H1000000
CF_PRINTERFONTS = &H2
CF_SCALABLEONLY = &H20000
CF_SCREENFONTS = &H1
CF_ANSIONLY = &H400&
CF_SCRIPTSONLY = CF_ANSIONLY
CF_SELECTSCRIPT = &H400000
CF_SHOWHELP = &H4&
CF_USESTYLE = &H80&
CF_WYSIWYG = &H8000
CF_LIMITSIZE = &H2000&
CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
End Enum
Private Const CF_INITTOLOGFONTSTRUCT = &H40&
Private Const CF_EFFECTS = &H100&
Private Const CF_FORCEFONTEXIST = &H10000
Private Const BOLD_FONTTYPE = &H100
Private Const ITALIC_FONTTYPE = &H200
Private Const REGULAR_FONTTYPE = &H400
Private Const FW_BOLD = 700
Private Const FW_NORMAL = 400
Private Const DEFAULT_CHARSET = 1
Private Const OUT_DEFAULT_PRECIS = 0
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const FF_ROMAN = 16

Public Enum OpenSaveflags
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_ENABLESIZING = &H800000
OFN_EXTENSIONDIFFERENT = &H400
OFN_FILEMUSTEXIST = &H1000
OFN_HIDEREADONLY = &H4
OFN_NOCHANGEDIR = &H8
OFN_NODEREFERENCELINKS = &H100000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_OVERWRITEPROMPT = &H2
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHOWHELP = &H10
End Enum

Private Const OFN_EXPLORER = &H80000

Private Const WM_INITDIALOG = &H110&
Private Const WM_SETTEXT = &HC
Private Const SWP_NOMOVE = &H2&
Private Const SWP_NOZORDER = &H4&

Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40

Private pCustomColor(0 To 15) As Long

Private Enum DialogType
Color
Font
OpenSave
Printing
End Enum
Private Dialog As DialogType

'################################################# ################################################## #########

Public Function ShowColor(CDlg As COMDLG) As Boolean
Dialog = Color

Dim CC As ChooseColor
CC.lpCustColors = VarPtr(pCustomColor(0))
CC.rgbResult = CDlg.Color
CC.hwndOwner = CDlg.hwndOwner
CC.lStructSize = Len(CC)
CC.hInstance = CDlg.hInstance
CC.flags = CDlg.flagsColor

If ChooseColor(CC) Then
ShowColor = True
CDlg.Color = CC.rgbResult
Else
ShowColor = False
End If
End Function

Public Function ShowFont(CDlg As COMDLG) As Boolean
Dialog = Font

Dim CF As ChooseFont, LFONT As LOGFONT, hMem As Long, pMem As Long

LFONT.lfFaceName = CDlg.FontName & vbNullChar
LFONT.lfItalic = CDlg.FontItatic
LFONT.lfUnderline = CDlg.FontUnderline
LFONT.lfStrikeOut = CDlg.FontStrikeOut
LFONT.lfCharSet = DEFAULT_CHARSET
LFONT.lfOutPrecision = OUT_DEFAULT_PRECIS
LFONT.lfClipPrecision = CLIP_DEFAULT_PRECIS
LFONT.lfQuality = DEFAULT_QUALITY
LFONT.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN
If CDlg.FontBold Then
LFONT.lfWeight = FW_BOLD
Else
LFONT.lfWeight = FW_NORMAL
End If

CF.iPointSize = CDlg.FontSize * 10
CF.nSizeMax = CDlg.FontSizeMax
CF.nSizeMin = CDlg.FontSizeMin
CF.lStructSize = Len(CF)
CF.hInstance = CDlg.hInstance
CF.hwndOwner = CDlg.hwndOwner
CF.hDC = CDlg.hDC
CF.flags = CDlg.flagsFont Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT
hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(LFONT))
pMem = GlobalLock(hMem)
CopyMemory ByVal pMem, LFONT, Len(LFONT)
CF.lpLogFont = pMem

If ChooseFont(CF) Then
ShowFont = True
CopyMemory LFONT, ByVal pMem, Len(LFONT)
CDlg.FontName = left(LFONT.lfFaceName, InStr(LFONT.lfFaceName, vbNullChar) - 1)
CDlg.FontColor = CF.rgbColors
CDlg.FontBold = (LFONT.lfWeight = FW_BOLD)
CDlg.FontItatic = (CF.nFontType And ITALIC_FONTTYPE)
CDlg.FontStrikeOut = LFONT.lfStrikeOut
CDlg.FontUnderline = LFONT.lfUnderline
CDlg.FontSize = CF.iPointSize \ 10
Else
ShowFont = False
End If

Call GlobalUnlock(hMem)
Call GlobalFree(hMem)
End Function

Public Function ShowOpen(CDlg As COMDLG) As Boolean
Dialog = OpenSave

Dim File As String, OFName As OPENFILENAME
OFName.lStructSize = Len(OFName)
OFName.nMaxFile = 260
OFName.flags = CDlg.flagsOpenSave Or OFN_EXPLORER
OFName.hwndOwner = CDlg.hwndOwner
OFName.hInstance = CDlg.hInstance

CDlg.Filter = Replace(CDlg.Filter, "|", Chr(0))
OFName.lpstrFilter = StrPtr(CDlg.Filter)
OFName.lpstrDefExt = StrPtr(CDlg.DefExt)
OFName.lpstrTitle = StrPtr(CDlg.Title)
File = CDlg.Filename
File = File & Space$(261 - Len(File))
OFName.lpstrFile = StrPtr(File)
OFName.lpstrInitialDir = StrPtr(CDlg.InitDir)

If GetOpenFileName(OFName) Then
ShowOpen = True
CDlg.Filename = left$(File, InStr(1, File, vbNullChar) - 1)
CDlg.FilterIndex = OFName.nFilterIndex
Else
ShowOpen = False
End If
End Function

Public Function ShowSave(CDlg As COMDLG) As Boolean
Dialog = OpenSave

Dim File As String, OFName As OPENFILENAME
OFName.lStructSize = Len(OFName)
OFName.nMaxFile = 260
OFName.flags = CDlg.flagsOpenSave Or OFN_EXPLORER
OFName.hwndOwner = CDlg.hwndOwner
OFName.hInstance = CDlg.hInstance

CDlg.Filter = Replace(CDlg.Filter, "|", Chr(0))
OFName.lpstrFilter = StrPtr(CDlg.Filter)
OFName.lpstrDefExt = StrPtr(CDlg.DefExt)
OFName.lpstrTitle = StrPtr(CDlg.Title)
File = CDlg.Filename
File = File & Space$(261 - Len(File))
OFName.lpstrFile = StrPtr(File)
OFName.lpstrInitialDir = StrPtr(CDlg.InitDir)

If GetSaveFileName(OFName) Then
ShowSave = True
CDlg.Filename = left$(File, InStr(1, File, vbNullChar) - 1)
CDlg.FilterIndex = OFName.nFilterIndex
Else
ShowSave = False
End If
End Function

CloseWindow
Khai báo:
Declare Function CloseWindow Lib "user32" Alias "CloseWindow" (ByVal hwnd As Long) As Long

Mô tả:
Thu nhỏ cửa sổ.

Tham số:
HWnd: handle của cửa sổ cần thu.

Ví dụ:
Private Declare Function CloseWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Form_Load()
'Minimize this Window
CloseWindow Me.hwnd
End Sub

CommDlgExtendedError
Khai báo:
Declare Function CommDlgExtendedError Lib "comdlg32.dll" Alias "CommDlgExtendedError" () As Long

Mô tả:
CommDlgExtendedError trả về mã lỗi từ chức năng cuối cùng của một hộp thoại common dialog nào đó. Hàm không trả về mã lỗi cho bất kỳ hàm API nào khác (trong trường hợp này, dùng GetLastError để thay thế). Giá trị trả về của hàm không được xác định nếu chức năng được gọi sau cùng của hộp thoại commondialog thành công. Nếu có một lỗi xãy ra với chức năng này, giá trị trả về chính xác là một trong những cờ lỗi của hộp thoại common sau đây:

CDERR_DIALOGFAILURE=&HFFFF: Không thể mở hộp thoại.
CDERR_FINDRESFAILURE=&H6: Thất bại khi muốn tìm tài nguyên cần thiết.
CDERR_GENERALCODES=&H0: Lỗi liên quan đến một thuộc tính tổng quát của hộp thoại common.
CDERR_INITAILIZATION=&H2: Thất bại trong suốt quá trình khởi tạo (thường là bộ nhớ không đủ).
CDERR_LOADRESFAILURE=&H7: Thất bại khi nạp tài nguyên yêu cầu.
CDERR_LOADSTRFAILURE=&H5: Thất bại khi nạp chuỗi yêu cầu.
CDERR_LOCKRESFAILURE=&H8: Thất bại khi khóa tài nguyên yêu cầu.
CDERR_MEMALLOCFAILURE=&H9: Thất bại khi xác định khối bộ nhớ.
CDERR_MEMLOCKFAILURE=&HA: Thất bại khi khóa bộ nhớ yêu cầu.
CDERR_NOHINSTANCE=&H4: Không được cung cấp một handle hợp lệ (nếu handle được yêu cầu).
CDERR_NOHOOK=&HB: Không được cung cấp một handle tới hàm hook hợp lệ (nếu handle được yêu cầu)
CDERR_NOTEMPLATE=&H3: Không được cung cấp mẩu ban đầu hợp lệ (nếu mẩu được yêu cầu)
CDERR_REGISTERMSGFAIL=&HC: KHông thể đăng kí một thông điệp cửa sổ thành công.
CDERR_STRUCTSIZE=&H1: Được cung cấp một kích thước cấu trúc không hợp lệ.
CFERR_CHOOSEFONTCODES=&H2000: Lỗi liên quan đến hộp thoại Choose Font.
CFERR_MAXLESSTHANMIN=&H2600: Được cung cấp giá trị kích thước font lớn nhất nhỏ hơn kích thước font lớn nhất đã được cung cấp.
CFERR_NOFONTS=&H2001: Không thể tìm thấy các font đang tồn tại.
FNERR_BUFFERTOOSMALL=&H3003: Được cung cấp bởi một bộ đệm tên tập tin quá nhỏ.
FNERR_FILENAMECODES=&H3000: Lỗi liên quan đến hộpt hoại Open File hoặc Save File.
FNERR_INVALIDFILENAME=&H3002: Được cung cấp hay nhận một tên tập tin không hợp lệ.
FNERR_SUBCLASSFAILURE=&H3001: Không đủ bộ nhớ để phân lớp hộp danh sách.
FRERR_BUFFERLENGTHZERO=&H4001: Được cung cấp một bộ đệm không hợp lệ.
FRERR_FINDREPLACECODES=&H4000: Lỗi liên quan đến hộp thoại Find hoặc Repalce.
PDERR_CREATEICFAILURE=&H100A: Không thể tạo một ngữ cảnh thông tin.
PDERR_DEFAULTDIFFERENT=&H100C: Đang có thông tin được cung cấp của máy in mặc định, nhưng thực sự thì các thiết lập của máy in mặc định lại khác.
PDERR_DNDMMISMATCH=&H1009: Dữ liệu trong hai cấu trúc dữ liệu mô tả các máy in khác nhau (tức là chúng chứa các thông tin mẫu thuẫn).
PDERR_INITFAILURE= &H1006: Thất bại trong quá trình khởi tạo.
PDERR_GETDEVMODEFAIL=&H1005: Driver máy in thất bại khi khởi tạo cấu trúc DEVMODE.
PDERR_LOADDRVFAILURE=&H1004: Thất bại khi nạp Driver thiết bị yêu cầu.
PDERR_NODEFAULTPRN=&H1008: Không thể tìm thấy máy in mặc định.
PDERR_NODEVICES=&H1007: Không thể tìm thấy bất kỳ máy in nào.
PDERR_PARSEFAILURE=&H1002: Thất bại khi phân tích các chuỗi quan hệ với máy in trong WIN.INI.
PDERR_PRINTERCODES=&H1000: Lỗi liên quan đến hộp thoại Print.
PDERR_PRINTERNOTFOUND=&H100B: Không thể tìm thấy thông tin trong WIN.INI về máy in được yêu cầu.
PDERR_RETDEFFAILURE=&H1003: Các handle tới các cấu trúc dữ liệu được cung cấp là khác không đủ hàm được yêu cầu trả thông tin về máy in mặc định.
DPERR_SETUPFAILURE=&H1001: Thất bại khi nạp những tài nguyên yêu cầu.

Ví dụ:
Option Explicit

Const CDERR_DIALOGFAILURE = &HFFFF
Const CDERR_FINDRESFAILURE = &H6
Const CDERR_GENERALCODES = &H0
Const CDERR_INITIALIZATION = &H2
Const CDERR_LOADRESFAILURE = &H7
Const CDERR_LOADSTRFAILURE = &H5
Const CDERR_LOCKRESFAILURE = &H8
Const CDERR_MEMALLOCFAILURE = &H9
Const CDERR_MEMLOCKFAILURE = &HA
Const CDERR_NOHINSTANCE = &H4
Const CDERR_NOHOOK = &HB
Const CDERR_REGISTERMSGFAIL = &HC
Const CDERR_NOTEMPLATE = &H3
Const CDERR_STRUCTSIZE = &H1
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As Any) As Long
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'We're letting the GetOpenFileName-function crash
GetOpenFileName ByVal 0&
Select Case CommDlgExtendedError
Case CDERR_DIALOGFAILURE
MsgBox "The dialog box could not be created."
Case CDERR_FINDRESFAILURE
MsgBox "The common dialog box function failed to find a specified resource."
Case CDERR_INITIALIZATION
MsgBox "The common dialog box function failed during initialization."
Case CDERR_LOADRESFAILURE
MsgBox "The common dialog box function failed to load a specified resource."
Case CDERR_LOADSTRFAILURE
MsgBox "The common dialog box function failed to load a specified string."
Case CDERR_LOCKRESFAILURE
MsgBox "The common dialog box function failed to lock a specified resource."
Case CDERR_MEMALLOCFAILURE
MsgBox "The common dialog box function was unable to allocate memory for internal structures."
Case CDERR_MEMLOCKFAILURE
MsgBox "The common dialog box function was unable to lock the memory associated with a handle."
Case CDERR_NOHINSTANCE
MsgBox "The ENABLETEMPLATE flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a corresponding instance handle."
Case CDERR_NOHOOK
MsgBox "The ENABLEHOOK flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a pointer to a corresponding hook procedure."
Case CDERR_REGISTERMSGFAIL
MsgBox "The RegisterWindowMessage function returned an error code when it was called by the common dialog box function."
Case CDERR_NOTEMPLATE
MsgBox "The ENABLETEMPLATE flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a corresponding template."
Case CDERR_STRUCTSIZE
MsgBox "The lStructSize member of the initialization structure for the corresponding common dialog box is invalid."
Case Else
MsgBox "Undefined error ..."
End Select
End Sub

tưởng sủa được vài tiếng như dzậy là hay hỹ, thực ra sủa thì cũng chỉ là sủa thui!!!

không giúp thì thôi không làm loãng topic nha

mắc j phải giúp ?chuyên toán hok làm chiện rùi bu như mi

nói chung là vẫn cứ spam

moá nhiều wá thằng nào kiên nhẫn đọc hết chắc chỉ có thằng khùng , cái này là spam chắc rồi

không phải spam
mày không hiểu spam là gì àh

cái này dạng giống spam thôi có khác gì đâu ...?? khác ở chỗ spam là nói chuyện nhảm nhí , còn cái này là nói những chuyện đúng nhưng dài và không cần thiết

spam là post bài không đóng góp cho 4rum

chỉ không cần thiết đối với những thằng như mày
biết mới nói nha

cài bài xàm xí
nhìn hok hủ j hết
nhìn đã thấy mõi mắt
hok bik người post đã đọc hết chưa nữa là nói người #

hmm,tôi thích vc6.0 nhiều hơn nữa