apicall.bas

该软件是为文本文件的数据安全性而编制的

Attribute VB_Name = "WindowRgn"
'
'说明：
'     程序中调用的共用涵数及引用API的声明
'日期：1999.05.13
'编者：徐景周
'
 
 
 '产生窗体自动从系统工作区中出来或进入动态效果的API函数及参数
'Public Enum ZoomDirection
'  ZoomFormopen = 0
'  ZoomFormClosed = 1
'End Enum
'
'Public ZoomedFromLast As ZoomFrom
'
'Public Enum ZoomFrom
'  TopLeft = 0
'  TopCenter = 1
'  TopRight = 2
'  MidLeft = 3
'  MidCenter = 4
'  MidRight = 5
'  BtmLeft = 6
'  BtmCenter = 7
'  BtmRight = 8
'  ScreenCenter = 9
'  toTaskBarTray = 10
'  fromTaskBarTray = 11
'  FromMousePointer = 12
'  ScreenActiveFrm = 13
'End Enum
'
'Public Enum ZoomEffects
'  FromCenter = 0
'  FromLeft = 1
'  FromRight = 2
'  FromTopRight = 3
'  FromBotRight = 4
'  FromBotLeft = 5
'  FromTopLeft = 6
'  Explode = 7
'  FromTop = 8
'  FromBottom = 9
'End Enum
'
'
''Sound Functions
'Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
'Private Const SND_ASYNC = &H1         '  play asynchronously
'Private Const SND_NODEFAULT = &H2     '  silence not default, if sound not found
'Private Const SND_LOOP = &H8          '  loop the sound until next sndPlaySound
'Private Const SND_RESOURCE = &H40004  '  name is a resource name or atom
'
''Window
'Private Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
'Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
'
'Private Const GW_CHILD = 5
'Private Const GW_HWNDNEXT = 2
'
'Private Const rgRegSounds = "AppEvents\Schemes\Apps\.Default\"
'
''Zoom Window
'Private Const IDANI_OPEN = &H1
'Private Const IDANI_CLOSE = &H2
'Private Const IDANI_CAPTION = &H3
'
'Public Type POINTAPI
'    x As Long
'    y As Long
'End Type
'
'Public Type RECT
'        Left As Long
'        Top As Long
'        Right As Long
'        Bottom As Long
'End Type
'
'Public Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long
'Public Declare Function GetClientRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long
'Public Declare Function ScreenToClient Lib "User32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
'Public Declare Function GetDesktopWindow Lib "User32" () As Long
'Public Declare Function DrawAnimatedRects Lib "User32" (ByVal hWnd As Long, ByVal idAni As Long, lprcFrom As RECT, lprcTo As RECT) As Long
'Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'
'
'' (注册表参数信息及API函数)...
'Global Const READ_CONTROL = &H20000
'Global Const KEY_QUERY_VALUE = &H1
'Global Const KEY_SET_VALUE = &H2
'Global Const KEY_CREATE_SUB_KEY = &H4
'Global Const KEY_ENUMERATE_SUB_KEYS = &H8
'Global Const KEY_NOTIFY = &H10
'Global Const KEY_CREATE_LINK = &H20
'Global Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
'                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
'                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
'
' ' Reg Key ROOT Types...
'Global Const HKEY_CLASSES_ROOT = &H80000000
'Global Const HKEY_CURRENT_USER = &H80000001
'Global Const HKEY_LOCAL_MACHINE = &H80000002
'Global Const HKEY_USERS = &H80000003
'Global Const HKEY_PERFORMANCE_DATA = &H80000004
'Global Const HKEY_CURRENT_CONFIG = &H80000005
'Global Const HKEY_DYN_DATA = &H80000006
'
' ''Return Value...
'Global Const ERROR_SUCCESS = 0
'Global Const ERROR_ACCESS_DENIED = 5&
'Global Const ERROR_NO_MORE_ITEMS = 259&
'
'''Reg Data Types...
'Public Const REG_NONE = 0                                          ' No value type
'Public Const REG_SZ = 1                                            ' Unicode nul terminated string
'Public Const REG_EXPAND_SZ = 2                                     ' Unicode nul terminated string
'Public Const REG_BINARY = 3                                        ' Free form binary
'Public Const REG_DWORD = 4                                         ' 32-bit number
'Public Const REG_DWORD_LITTLE_ENDIAN = 4                           ' 32-bit number (same as REG_DWORD)
'Public Const REG_DWORD_BIG_ENDIAN = 5                              ' 32-bit number
'Public Const REG_LINK = 6                                          ' Symbolic Link (unicode)
'Public Const REG_MULTI_SZ = 7                                      ' Multiple Unicode strings
'Public Const REG_RESOURCE_LIST = 8                                 ' Resource list in the resource map
'Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9                      ' Resource list in the hardware description
'Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10
'
'Public Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
'Public Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
'Public Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
'Public Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
'Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
''public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
'Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
'Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
'Public Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
'Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'
'
''向桌面下的系统区添加和删除图标
'Public Type NOTIFYICONDATA
'  cbSize As Long
'  hWnd As Long
'  uId As Long
'  uFlags As Long
'  uCallBackMessage As Long
'  hIcon As Long
'  szTip As String * 64
'End Type
'Public Const NIM_ADD = &H0
'Public Const NIM_MODIFY = &H1
'Public Const NIM_DELETE = &H2
'Public Const NIF_MESSAGE = &H1
'Public Const NIF_ICON = &H2
'Public Const NIF_TIP = &H4
'Public Const WM_MOUSEMOVE = &H200
'Public Const WM_LBUTTONDBLCLK = &H203
'Public Const WM_LBUTTONDOWN = &H201
'Public Const WM_LBUTTONUP = &H202
'Public Const WM_RBUTTONDBLCLK = &H206
'Public Const WM_RBUTTONDOWN = &H204
'Public Const WM_RBUTTONUP = &H205
'Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, ByRef pnid As NOTIFYICONDATA) As Boolean
'Global nid As NOTIFYICONDATA

'建立特殊窗体及设置窗体优先位置函数
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Public Declare Function SetWindowRgn Lib "User32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
'Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

'更改墙纸的参数信息及调用的API函数
'Public Const SPI_SETDESKWALLPAPER = 20&
'Public Const SPIF_SENDWININICHANGE = &H2
'Public Const SPIF_UPDATEINIFILE = &H1
'Public Const SS_CENTER = &H1&
'Public Declare Function SystemParametersInfo Lib "User32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
'Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'无标题拖动需调用函数
Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DefWindowProc Lib "User32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public 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 WM_NCHITTEST = &H84  '无标题拖动参数
Public Const HTCAPTION = 2
Public Const HTCLIENT = 1
Public Const GWL_WNDPROC = (-4)
Public PROROC As Long

 '文件读写模式
Public Const ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0

'实现无标题拖动所需函数
Public Function WindowProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim rv As Long
   
      If msg = WM_NCHITTEST Then
        rv = DefWindowProc(hWnd, msg, wParam, lParam)
        If rv = HTCLIENT Then
          WindowProc = HTCAPTION
        Else
          WindowProc = rv
        End If
       '将其他的消息传给默认的窗口函数进行处理
      Else
        WindowProc = CallWindowProc(PROROC, hWnd, msg, wParam, lParam)
      End If
      
End Function

 '产生窗体从系统工作区中进入或出来的动态效果子过程
'Public Sub frmZoomToTray(f As Form, Direction As ZoomDirection, Optional ZoomEffect As ZoomEffects = 7, _
'                             Optional ShowMsgForm As Boolean = False)
'
'Dim TrayhWnd As Long
'Dim hWnd As Long
'Dim r
'Dim sClassName As String * 100
'Dim xFrom As RECT
'Dim xTo As RECT
'
'If Direction = ZoomFormClosed And f.Visible = False Then Exit Sub
'If Direction = ZoomFormopen And f.Visible = True Then Exit Sub
'
'hWnd = FindWindow("Shell_TrayWnd", 0&)
'
'hWnd = GetWindow(hWnd, GW_CHILD)
'
' Do
'   r = GetClassName(hWnd, sClassName, 100)
'
'   If Left(sClassName, r) = "TrayNotifyWnd" Then
'   Exit Do
'   End If
'
'   hWnd = GetWindow(hWnd, GW_HWNDNEXT)
' Loop While hWnd <> 0
'
'Select Case Direction
'
'Case ZoomFormopen
'
'  Call GetWindowRect(hWnd, xFrom)
'
'  xFrom.Left = (xFrom.Right - (xFrom.Right - xFrom.Left) / 2)
'  xFrom.Right = xFrom.Left + 1
'
'  Call GetWindowRect(f.hWnd, xTo)
'
'  Call DrawAnimatedRects(f.hWnd, IDANI_OPEN Or IDANI_CAPTION, xFrom, xTo)
'
' ' DoEvents
'
'Case ZoomFormClosed
'
'  Call GetWindowRect(f.hWnd, xFrom)
'  Call GetWindowRect(hWnd, xTo)
'
'  xTo.Left = (xTo.Right - (xTo.Right - xTo.Left) / 2)
'  xTo.Right = xTo.Left + 1
'
'  Call DrawAnimatedRects(f.hWnd, IDANI_CLOSE Or IDANI_CAPTION, xFrom, xTo)
'
' ' DoEvents
'
'End Select
'
'End Sub