frmreceivemail.frm

金算盘软件代码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmReceiveMail 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "导入导出"
   ClientHeight    =   1605
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4260
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1605
   ScaleWidth      =   4260
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox chkIn 
      Caption         =   "引入数据"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   750
      Width           =   1035
   End
   Begin MSComDlg.CommonDialog cdgFilePath 
      Left            =   2910
      Top             =   -150
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdFindPath 
      Height          =   285
      Left            =   3600
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1017"
      Top             =   345
      UseMaskColor    =   -1  'True
      Width           =   285
   End
   Begin VB.TextBox txtPath 
      Height          =   270
      Left            =   90
      TabIndex        =   3
      Top             =   345
      Width           =   3495
   End
   Begin VB.CommandButton cmdOKCancelFilter 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   2550
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   1110
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancelFilter 
      Default         =   -1  'True
      Height          =   350
      Index           =   0
      Left            =   1170
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   1110
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Label lblImPortTable 
      AutoSize        =   -1  'True
      Caption         =   "数据文件夹(&P)"
      Height          =   180
      Index           =   1
      Left            =   90
      TabIndex        =   2
      Top             =   75
      Width           =   1170
   End
End
Attribute VB_Name = "frmReceiveMail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''**********API函数声明***********
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private mstrDest As String

Private Sub cmdFindPath_Click()
    With cdgFilePath
        .DialogTitle = "接收邮件"
        .InitDir = GetFilePath(txtPath.Text)
        .Filter = "金算盘邮件(*.gdm)|*.gdm"
        .ShowOpen
        If .FileName <> "" Then
           txtPath.Text = .FileName
        End If
        txtPath.SetFocus
    End With
End Sub

Private Sub cmdOKCancelFilter_Click(Index As Integer)
  Dim strSource As String
  Dim MyFile As String
  Dim blnIn As Boolean
    
    strSource = txtPath.Text
    mstrDest = App.Path
    On Error Resume Next
    Select Case Index
        Case 0 '确认
           SendMail.DecompFile strSource, mstrDest
           Dir ("C:\WrTemp")
           
           MyFile = Dir("C:\WrTemp\*.Dat")
           Do While MyFile <> ""
              CopyFile "C:\WrTemp\" & MyFile, App.Path & "\" & MyFile, False
              Kill "C:\WrTemp\" & MyFile
              MyFile = Dir
           Loop
           CopyFile "C:\WrTemp\Format.ini", App.Path & "\Format.ini", False
           Kill "C:\WrTemp\Format.ini"
           RmDir "C;\WrTemp"
           
           ShowMsg Me.hwnd, "数据接收成功!", vbInformation + vbOKOnly, App.title
           If chkIn.Value = 1 Then
              blnIn = True
           End If
           Unload Me
           
           If blnIn Then
               frmInorOut.ShowCardInOrOut True
           End If
        
        Case 1 '取消
            Unload Me
    End Select

End Sub

Private Sub Form_Load()
    Set mclsComm = New Communication
    Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    Set cmdOKCancelFilter(0).Picture = GetFormResPicture(1001, vbResBitmap)
    Set cmdOKCancelFilter(1).Picture = GetFormResPicture(1002, vbResBitmap)
    Set cmdFindPath.Picture = GetFormResPicture(1017, vbResBitmap)
    
    Me.Caption = "数据接收"
    lblImPortTable(1).Caption = "邮件文件(&P)"
    txtPath.Text = App.Path & "\GaMail.gdm"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.RemoveFormResPicture (139)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1017)
    Utility.RemoveFormResPicture (139)
End Sub

'从格式文件中取主键值
Private Function VBGetPrivateProfileString(ByVal strSection As String, ByVal strKey As String, ByVal strFile As String) As String
    Dim KeyValue As String
    Dim Characters As Long
    
    KeyValue = String$(128, " ")
    Characters = GetPrivateProfileString(strSection, strKey, " ", KeyValue, 127, strFile)
    If Characters >= 1 Then
        KeyValue = Left$(KeyValue, Characters)
    Else
        KeyValue = ""
    End If
    VBGetPrivateProfileString = Trim(KeyValue)

End Function

Private Sub txtPath_LostFocus()
   If Dir(txtPath.Text) = "" Then
       If Me.ActiveControl Is cmdOKCancelFilter(1) Or Me.ActiveControl Is cmdFindPath Then
          Exit Sub
       End If
       ShowMsg Me.hwnd, "你所选择的路径不存在，请重新选择！", vbInformation, Me.Caption
       txtPath.SetFocus
       Exit Sub
   End If
End Sub