module11.bas

适合乡镇供电所使用电费处理系统v3 软件

Attribute VB_Name = "Modulel"
Public username, CompName         '计算机用户名
Public Operator          '操作员
Public pbDw As String    '用户单位
Public pbDwBm As String    '用户单位编码
Public pbUserName As String          '当前用户名称
Public pbUserPermission As String    '当前用户权限
Public XzName As String, XzCode As String, XcName As String, XcCode As String, GzNian As String, GzYue As String, UserSeek As String
Public NdMd As Database, MdbR As Recordset    '全局库名，表名
Public StruA$, StruB$, StruC$, StruD
Public Cela As Boolean
Public Dbk As String
Public BenY As String, NianVal As String, ShangY As String
Public FrmIndex As Integer
Public AAA As String, AA As String, BB As String, CC As String, DD As String, EE As String, FF As String, GG As String, HH As String, II As String, JJ As String, KK As String, BBB As String, CCC As String

Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetDeviceCaps Lib "GDI32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long
Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hdc As Long) As Long
Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) As Long
Declare Function SelectObject Lib "GDI32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function BitBlt Lib "GDI32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function DeleteDC Lib "GDI32" (ByVal hdc As Long) As Long
Declare Function SelectPalette Lib "GDI32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Declare Function RealizePalette Lib "GDI32" (ByVal hdc As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function Rectangle Lib "GDI32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Declare Function CreateSolidBrush Lib "GDI32" (ByVal crColor As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

'拷贝文件
Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

'Declare Function SelectObject Lib "user32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Declare Function SetBkColor Lib "GDI32" (ByVal hdc As Long, ByVal crColor 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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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

Declare Function DeleteObject Lib "GDI32" (ByVal hObject As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long

'Public Const BITSPIXEL = 12
'Public Const HORZRES = 8
'Public Const VERTRES = 10
'Public Const PLANES = 14
Global hdesktopwnd
Global hdccaps
Global GetVal As Long

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

'exitwin
'Win32API类型的声明

Type PicBmp
  Size As Long
  Type As Long
  hBmp As Long
  hPal As Long
  Reserved As Long
End Type

Type PALETTEENTRY
  peRed As Byte
  peGreen As Byte
  peBlue As Byte
  peFlags As Byte
End Type

Type LOGPALETTE
  palVersion As Integer
  palNumEntries As Integer
  palPalEntry(255) As PALETTEENTRY
End Type

Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type


'拷贝文件--------------------------------------------
Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200

Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Long
     fAnyOperationsAborted As Long
     hNameMappings As Long
     lpszProgressTitle As String
End Type
'----------------------------------------------------------


'窗口置前-----------------------------------
Public Const HWND_TOPMOST = -1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
'-------------------------------------------

Public Const Xt = "系统管理员"
Public Const Pt = "普通管理员"
Public Const Kc = "可查看用户"

'Public Const SRCCOPY = &HCC0020

'///////////系统加载过程//////////////
Sub Main()
    frmSplash.Show
    frmSplash.Refresh
    frmMain.Show
  '  Load frmMain
    If App.PrevInstance Then
       MsgBox ("程序已经运行，不能再次装载！"), vbExclamation
       Unload frmMain
       End
    End If
    Dim fLogin As New frmLogin
    fLogin.Show vbModal
    Unload fLogin
    Unload frmSplash
    Dim RegPassTrue As String
    RegPassTrue = GetSetting(App.EXEName, "RegInfo", "RegTrue", "")
    'If RegPassTrue = "" Then
    '   RegMsg.Show
    'End If
End Sub

'/////////滚动标题函数//////////
'Public Function ScrollText(strText As String) As String
'strText = (Right$(strText, Len(strText) - 1)) & Left$(strText, 1)
'ScrollText = strText
'End Function

'/////////提示信息/////////////
Sub Ms()
   MsgBox "请您先选择要工作单位或村！", vbCritical
End Sub
   
'////////动画窗口过程//////////
Sub ExplodeForm(f As Form, Movement As Integer)
    Dim myRect As RECT
    Dim formWidth%, formHeight%, i%, X%, Y%, cx%, cy%
    Dim TheScreen As Long
    Dim Brush As Long
    GetWindowRect f.hwnd, myRect
    formWidth = (myRect.Right - myRect.Left)
    formHeight = myRect.Bottom - myRect.Top
    TheScreen = GetDC(0)
    Brush = CreateSolidBrush(f.BackColor)
    For i = 1 To Movement
        cx = formWidth * (i / Movement)
        cy = formHeight * (i / Movement)
        X = myRect.Left + (formWidth - cx) / 2
        Y = myRect.Top + (formHeight - cy) / 2
        Rectangle TheScreen, X, Y, X + cx, Y + cy
    Next i
    X = ReleaseDC(0, TheScreen)
    DeleteObject (Brush)
End Sub
'装入资源文件中的图片
'Image1.Picture = LoadResPicture(107, vbResBitmap)

'//////////////动画关闭窗口过程//////////////
Public Sub ImplodeForm(f As Form, Direction As Integer, Movement As Integer, ModalState As Integer)
    Dim myRect As RECT
    Dim formWidth%, formHeight%, i%, X%, Y%, cx%, cy%
    Dim TheScreen As Long
    Dim Brush As Long
    
    GetWindowRect f.hwnd, myRect
    formWidth = (myRect.Right - myRect.Left)
    formHeight = myRect.Bottom - myRect.Top
    TheScreen = GetDC(0)
    Brush = CreateSolidBrush(f.BackColor)
    For i = Movement To 1 Step -1
        cx = formWidth * (i / Movement)
        cy = formHeight * (i / Movement)
        X = myRect.Left + (formWidth - cx) / 2
        Y = myRect.Top + (formHeight - cy) / 2
        Rectangle TheScreen, X, Y, X + cx, Y + cy
    Next i
    X = ReleaseDC(0, TheScreen)
    DeleteObject (Brush)
End Sub

'///////////////打开数据库///////////////
Sub OpenMdb()
   Set NdMd = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\Data\Eletricity.Mdb")
End Sub

'///////////////置窗口于最上//////////
Public Function PutWindowOnTop(pFrm As Form)
  Dim lngWindowPosition As Long
  lngWindowPosition = SetWindowPos(pFrm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Function

'/////////////计算某月的天数//////////////
Public Function RDays(MYdate As Date) As Integer
    RDays = (31 - Day(DateSerial(Year(MYdate), Month(MYdate), 31)))
    If RDays = 0 Then
       RDays = 31
    Else
    End If
End Function

'/////////////////从指定路径中提取出文件名////////////
Function StripPath(T$) As String
Dim X%, ct%
StripPath$ = T$
X% = InStr(T$, "\")
Do While X%
ct% = X%
X% = InStr(ct% + 1, T$, "\")
Loop
If ct% > 0 Then StripPath$ = Mid$(T$, ct% + 1)
End Function

'///////////////析出文件所含路径//////////////////
Function ExtractPath(sFileName) As String
    Dim nIdx As Integer
    For nIdx = Len(sFileName) To 1 Step -1
       If Mid$(sFileName, nIdx, 1) = "\" Then
          ExtractPath = Mid$(sFileName, 1, nIdx)
          Exit Function
       End If
    Next nIdx
    ExtractPath = sFileName
End Function


'////////////字符串翻转////////////
Static Function reversestring(revstr As String) As String

    Dim doreverse As Long
    reversestring = ""
    For doreverse = Len(revstr) To 1 Step -1
        reversestring = reversestring & Mid$(revstr, doreverse, 1)
    Next
End Function


'/////////////计算一段时间的分钟数///////////

Public Function Minutes(d As Date) _
    As Long
    'Minutes since 1900
    Dim lPreviousDays As Long
    Dim lTotalMinutes As Long
    lPreviousDays = d - #1/1/1900#
    lTotalMinutes = _
        (lPreviousDays * 24) * 60
    lTotalMinutes = lTotalMinutes + _
        Hour(d) * 60
    lTotalMinutes = lTotalMinutes + _
        Minute(d)
    Minutes = lTotalMinutes
End Function

'////////////处理sql中的查询/////////////////
'以后在动态生成 Select 语句， 使用：
'  SqlString = "Select * from myBas where Name  = " & CheckString(Text1)
'///////////////////////////////////////////
Public Function CheckSQL(s) As String
    pos = InStr(s, "'")