frmaddress.frm

企业人事管理系统,有考勤,人员管理等功能,值得研究,也是我付费弄来的,绝对超值

VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmAddress 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "EMAIL管理"
   ClientHeight    =   5010
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5370
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5010
   ScaleWidth      =   5370
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Height          =   4935
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5295
      Begin VB.Frame Frame2 
         Caption         =   "操作"
         Height          =   855
         Left            =   120
         TabIndex        =   3
         Top             =   3960
         Width           =   5055
         Begin MSForms.CommandButton cmdAddTo 
            Height          =   375
            Left            =   2520
            TabIndex        =   7
            Top             =   360
            Width           =   975
            Caption         =   "插入"
            PicturePosition =   327683
            Size            =   "1720;661"
            Picture         =   "frmAddress.frx":0000
            FontName        =   "宋体"
            FontHeight      =   180
            FontCharSet     =   134
            FontPitchAndFamily=   34
            ParagraphAlign  =   3
         End
         Begin MSForms.CommandButton cmdExit 
            Cancel          =   -1  'True
            Height          =   375
            Left            =   3840
            TabIndex        =   6
            Top             =   360
            Width           =   975
            Caption         =   "退出"
            PicturePosition =   327683
            Size            =   "1720;661"
            Picture         =   "frmAddress.frx":27B2
            FontName        =   "宋体"
            FontHeight      =   180
            FontCharSet     =   134
            FontPitchAndFamily=   34
            ParagraphAlign  =   3
         End
         Begin MSForms.CommandButton cmdDel 
            Height          =   375
            Left            =   1320
            TabIndex        =   5
            Top             =   360
            Width           =   975
            Caption         =   "删除"
            PicturePosition =   327683
            Size            =   "1720;661"
            Picture         =   "frmAddress.frx":49EC
            FontName        =   "宋体"
            FontHeight      =   180
            FontCharSet     =   134
            FontPitchAndFamily=   34
            ParagraphAlign  =   3
         End
         Begin MSForms.CommandButton cmdOk 
            Default         =   -1  'True
            Height          =   375
            Left            =   120
            TabIndex        =   4
            Top             =   360
            Width           =   975
            Caption         =   "添加"
            PicturePosition =   327683
            Size            =   "1720;661"
            Picture         =   "frmAddress.frx":6B26
            FontName        =   "宋体"
            FontHeight      =   180
            FontCharSet     =   134
            FontPitchAndFamily=   34
            ParagraphAlign  =   3
         End
      End
      Begin VB.ListBox List1 
         Height          =   3120
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   5055
      End
      Begin VB.TextBox Text1 
         Height          =   375
         Left            =   120
         MaxLength       =   30
         TabIndex        =   1
         Top             =   3480
         Width           =   5055
      End
   End
End
Attribute VB_Name = "frmAddress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public blnTo As Boolean
Private Type MYINFO
    InfoNO As Integer
    InfoName As String * 30
End Type
Dim info As MYINFO
    Dim intNum As Integer
    Dim intLast As Integer
    Dim fso As FileSystemObject
    Dim fd As Folder
    Dim fl As File
    Dim blnChanged As Boolean
    Dim strFileName As String
    Dim strFullFilePath As String

Private Sub cmdAddTo_Click()
 Dim getEA As String
 getEA = Trim(List1.List(List1.ListIndex))
 If getEA = "" Then Exit Sub
 If blnTo = True Then
 frmEMAIL.txtTo = getEA
 Else
 frmEMAIL.txtFrom = getEA
 End If
 Unload Me
End Sub

Private Sub cmdDel_Click()
  
'删除记录
   If List1.ListIndex >= 0 Then
       blnChanged = True
       List1.RemoveItem List1.ListIndex
   End If
   
End Sub

Private Sub cmdExit_Click()
If blnChanged = True Then
    mbrtn = MsgBox("是否保存改变", vbQuestion + vbYesNo)
     If mbrtn = vbYes Then
         delFile
          If List1.ListCount = 0 Then
              Unload Me
          End If
          
          For i = 0 To List1.ListCount - 1
            SaveInfo List1.List(i)
          Next
      
      End If
    End If


  Unload Me
   If dfIsFormLoad("frmRS") = True Then
    frmRS.RefreshDuty
  End If
End Sub

Private Sub cmdOk_Click()
'添加记录
   If Text1.Text = "" Then Exit Sub
   For i = 0 To List1.ListCount - 1
       If List1.List(i) = Trim(Text1.Text) Then
       Exit Sub
       End If
   Next
   
   List1.AddItem Trim(Text1.Text)
   blnChanged = True
   Text1.Text = ""
End Sub

'删除文件
Private Function delFile()
    Dim p As String
    Dim f As String
  Set fso = New FileSystemObject
  
  If Not fso.FolderExists(pInfoFolderPath) Then
     fso.CreateFolder (pInfoFolderPath)
  End If
  If fso.FileExists(strFullFilePath) Then
          fso.DeleteFile (strFullFilePath)
  End If
  Set fso = Nothing
End Function
'文件是否存在
Private Function chkFile()
    Dim p As String
    Dim f As String
  Set fso = New FileSystemObject
  
  
  If Not fso.FolderExists(pInfoFolderPath) Then
     fso.CreateFolder (pInfoFolderPath)
  End If
  If fso.FileExists(strFullFilePath) Then
  chkFile = 1
  Else
  chkFile = 0
  End If
  Set fso = Nothing
End Function

Private Sub Form_Load()
'设文件名
 strFileName = "AddressInfo.txt"
 strFullFilePath = pInfoFolderPath & "\" & strFileName

 blnChanged = False
 
 '文件不存在就退出
 If chkFile = 0 Then Exit Sub
 '读取文件
 intNum = FreeFile
 Open strFullFilePath For Random As intNum Len = Len(info)
 intLast = LOF(1) / Len(info)
  Close intNum
  
 For i = 1 To intLast
    List1.AddItem GetInfo(i)
 Next
 
End Sub

Private Function SaveInfo(ByVal strInfoName As String)
    intNum = FreeFile
    Open strFullFilePath For Random As intNum Len = Len(info)
    intLast = LOF(1) / Len(info)
    intLast = intLast + 1
    info.InfoName = strInfoName
    info.InfoNO = intLast
    Put #intNum, intLast, info
    Close #intNum
End Function

Private Function GetInfo(ByVal intInfoNum As Integer)
    intNum = FreeFile
     Open strFullFilePath For Random As intNum Len = Len(info)
     Get #intNum, intInfoNum, info
     GetInfo = info.InfoName
    Close #intNum
End Function


 






Private Sub List1_DblClick()
  Dim getEA As String
 getEA = Trim(List1.List(List1.ListIndex))
 If getEA = "" Then Exit Sub
  If blnTo = True Then
 frmEMAIL.txtTo = getEA
 Else
 frmEMAIL.txtFrom = getEA
 End If
 Unload Me
End Sub