modapis.bas

1、以DLL形式提供医生工作站 2、 根据【检查项目】

Attribute VB_Name = "modApis"
'----------------------------------------------------------------------------------------------------
'文件：modApis.bas
'作者：冷家锋
'时间：2008-4-10
'说明：一些API声明
'----------------------------------------------------------------------------------------------------

Option Explicit



Public Const PROCESS_TERMINATE = &H1
Public Const PROCESS_VM_READ = &H10

Public Const PROCESS_FILE_MAX_PATH = 1060



Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, hModule As Long, ByVal cb As Long, cbNeeded As Long) As Long
Public Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpBaseName As String, ByVal nSize As Long) As Long
Public Declare Function GetModuleFileNameEx Lib "PSAPI.DLL" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
   
  Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
   

  Public Const PROCESS_QUERY_INFORMATION = &H400
  Public Const MAX_PATH = 260


Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1
Const SW_NORMAL = 1
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMAXIMIZED = 3
Const SW_MAXIMIZE = 3
Const SW_SHOWNOACTIVATE = 4
Const SW_SHOW = 5
Const SW_MINIMIZE = 6
Const SW_SHOWMINNOACTIVE = 7
Const SW_SHOWNA = 8
Const SW_RESTORE = 9
Const SW_SHOWDEFAULT = 10
Const SW_FORCEMINIMIZE = 11
Const SW_MAX = 11
  
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long



Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
'说明获取一个已装载模板的完整路径名称返回值Long，如执行成功，返回复制到lpFileName的实际字符数量；零表示失败。
'会设置GetLastError参数表参数 类型及说明hModule     Long，一个模块的句柄。可以是一个DLL模块，或者是一个应用程序的实例句柄lpFileName  String，指定一个字串缓冲区，要在其中容纳文件的用NULL字符中止的路径名，
'hModule模块就是从这个文件装载进来的nSize   Long，装载到缓冲区lpFileName的最大字符数量注解
'在Windows 95下，函数会核查应用程序的内部版本号是否为4.0或更大的一个数字。如果是，就返回一个长文件名，否则返回短文件名


Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long

Public Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long

Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long





Public Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long

Public Type PROCESSENTRY32

dwSize As Long

cntUsage As Long

th32ProcessID As Long

th32DefaultHeapID As Long

th32ModuleID As Long

cntThreads As Long

th32ParentProcessID As Long

pcPriClassBase As Long

dwFlags As Long

szExeFile As String * 1024

End Type

Public Const TH32CS_SNAPHEAPLIST = &H1

Public Const TH32CS_SNAPPROCESS = &H2

Public Const TH32CS_SNAPTHREAD = &H4

Public Const TH32CS_SNAPMODULE = &H8

Public Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)

Public Const TH32CS_INHERIT = &H80000000




Public Const HKEY_CURRENT_USER = &H80000001
Public Const HIS_REG_KEY_USER = "HisUser"
Public Const HIS_REG_KEY_PASSWORD = "HisPassword"
Public Const PACS_REG_KEY_USER = "PacsUser"
Public Const PACS_REG_KEY_PASSWORD = "PacsPassword"
Public Const FTP_REG_KEY_USER = "FtpUser"
Public Const FTP_REG_KEY_PASSWORD = "FtpPassword"

Public Const REPORT_REG_KEY_PASSWORD = "ReportPassword"


Public Const REG_SZ = 1

Public Const regkey = "HPCONSOLE"

Public Const MaxLFNPath = 260
Public Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_DIRECTORY = &H10

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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Declare Function GetTickCount Lib "kernel32" () As Long
   
'LONG CompareFileTime(
'  const FILETIME* lpFileTime1,
'  const FILETIME* lpFileTime2
');+Return value Description
'-1 First file time is earlier than second file time.
'0 First file time is equal to second file time.
'1 First file time is later than second file time.
Public Declare Function CompareFileTime Lib "kernel32" (ByRef lpFileTime1 As FILETIME, ByRef lpFileTime2 As FILETIME) As Long


'typedef struct tagPOINT {
'    LONG x;
'    LONG y;
'} POINT;
 
Public Type POINTAPI
          x As Long
          y As Long
End Type


Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'---文件操作相关--------------------------------------------------------------------------------------------------------------------

'----------------------------------------------------------------------------------------------------------------------------------
'图象预览--数组定义
Public Type MyPosition
          left As Long
          Top As Long
          Width As Long
          Height As Long
End Type

'-----------------------------------------------------------------------------------------------------------------------------------

Public Type FILETIME
          dwLowDateTime As Long
          dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
          dwFileAttributes As Long
          ftCreationTime As FILETIME
          ftLastAccessTime As FILETIME
          ftLastWriteTime As FILETIME
          nFileSizeHigh As Long
          nFileSizeLow As Long
          dwReserved0 As Long
          dwReserved1 As Long
          cFileName As String * MaxLFNPath
          cShortFileName As String * 14
End Type
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long



'BOOL CopyFile(
'  LPCTSTR lpExistingFileName,
'  LPCTSTR lpNewFileName,
'  BOOL bFailIfExists
');
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Boolean
'---End of 文件操作相关--------------------------------------------------------------------------------------------------------------------


'typedef struct _SYSTEMTIME {
'WORD wYear;
'WORD wMonth;
'WORD wDayOfWeek;
'WORD wDay;
'WORD wHour;
'WORD wMinute;  WORD wSecond;  WORD wMilliseconds;
'} SYSTEMTIME,
  Public Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
  Public Type SYSTEMTIME
          wYear   As Integer
          wMonth   As Integer
          wDayOfWeek   As Integer
          wDay   As Integer
          wHour   As Integer
          wMinute   As Integer
          wSecond   As Integer
          wMilliseconds   As Integer
  End Type


'    BOOL SystemTimeToFileTime(
'  const SYSTEMTIME* lpSystemTime,
'  lpFileTime lpFileTime
');
Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)


Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long


'读写注册表
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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
    
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
    
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


    
Public Const ERROR_SUCCESS = 0&
Public Const error_baddb = 1009&
Public Const error_badkey = 1010&
Public Const error_cantopen = 1011&
Public Const error_cantread = 1012&
Public Const error_cantwrite = 1013&
Public Const error_registry_recovered = 1014&
Public Const error_registry_corrupt = 1015&
Public Const error_registry_io_failed = 1016&
Public Const hkey_classes_root = &H80000000
'Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002


'===注册表GET/SET用户名/密码等信息===================================================

'从注册表中获得连接的数据库用户名/密码等信息
Public Function GetConnectionArg(ByVal strRegRoot, ByVal strArg As String) As String
On Error GoTo ErrHandler
    
    Dim nRet As Long
    
    Dim key_id As Long
    nRet = RegCreateKey(HKEY_CURRENT_USER, strRegRoot, key_id)
    
    If nRet <> ERROR_SUCCESS Then
        RegCloseKey (key_id)
        GetConnectionArg = ""
        Exit Function
    End If
    
    Dim bufsize As Long
    Dim keyvalue As String
    
    bufsize = 50
    keyvalue = String(bufsize + 1, " ")
    nRet = RegQueryValueEx(key_id, strArg, 0&, REG_SZ, ByVal keyvalue, bufsize)
    
    If nRet <> ERROR_SUCCESS Then
        RegCloseKey (key_id)
        GetConnectionArg = ""
        Exit Function
    End If
    
    
    
    keyvalue = left(keyvalue, bufsize - 1)

    RegCloseKey (key_id)

    GetConnectionArg = keyvalue

    Exit Function
ErrHandler:
    RegCloseKey (key_id)
    GetConnectionArg = ""
    
    
End Function



'在注册表中设置连接的数据库用户名/密码等信息
Public Function SetConnectionArg(ByVal strRegRoot, ByVal strArg As String) As Boolean
On Error GoTo ErrHandler
    
    Dim nRet As Long
    
    Dim key_id As Long
    nRet = RegCreateKey(HKEY_CURRENT_USER, regkey, key_id)
    
    If nRet <> ERROR_SUCCESS Then
        RegCloseKey (key_id)
        SetConnectionArg = False
        Exit Function
    End If
    
    Dim bufsize As Long
    Dim keyvalue As String
    
    
    
    nRet = RegSetValueEx(key_id, strRegRoot, 0&, REG_SZ, ByVal strArg, Len(strArg) + 1)
    
    
    If nRet <> ERROR_SUCCESS Then
        RegCloseKey (key_id)
        SetConnectionArg = False
        Exit Function
    End If
    
    RegCloseKey (key_id)

    SetConnectionArg = True

    Exit Function
ErrHandler:
    RegCloseKey (key_id)
    SetConnectionArg = False
    
    
End Function

'===注册表GET/SET用户名/密码等信息===================================================



  Public Sub Pause(ByVal sSec As Long)
          Dim StartSec     As Long
          StartSec = GetTickCount()
          While (GetTickCount() - StartSec) < sSec
              DoEvents
          Wend
  End Sub

Public Function GetFileBetweenTimes(ByVal strDirectoryPath As String, ftTime1 As FILETIME, _
    ftTime2 As FILETIME) As String
    
    
    If Len(strDirectoryPath) <= 0 Then
        GetFileBetweenTimes = ""
        Exit Function