frmupmap.frm

学生宿舍管理系统vb源码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmUpDWG 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "图形上传"
   ClientHeight    =   4575
   ClientLeft      =   45
   ClientTop       =   315
   ClientWidth     =   4665
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4575
   ScaleWidth      =   4665
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   375
      Left            =   3000
      TabIndex        =   10
      Top             =   1560
      Width           =   975
   End
   Begin VB.CommandButton cmdUp 
      Caption         =   "开始上传"
      Height          =   375
      Left            =   2040
      TabIndex        =   9
      Top             =   1560
      Width           =   975
   End
   Begin VB.TextBox txtNo 
      Height          =   375
      Left            =   1320
      TabIndex        =   8
      Top             =   1080
      Width           =   2655
   End
   Begin VB.TextBox txtName 
      Height          =   375
      Left            =   1320
      TabIndex        =   6
      Top             =   600
      Width           =   2655
   End
   Begin VB.CommandButton cmdView 
      Caption         =   "浏览"
      Height          =   375
      Left            =   3960
      TabIndex        =   4
      Top             =   120
      Width           =   615
   End
   Begin VB.TextBox txtFile 
      Height          =   375
      Left            =   1320
      TabIndex        =   3
      Top             =   120
      Width           =   2655
   End
   Begin VB.Frame Frame1 
      Caption         =   "数据库文件列表"
      Height          =   2415
      Left            =   120
      TabIndex        =   0
      Top             =   2040
      Width           =   4335
      Begin MSComctlLib.ListView ListView1 
         Height          =   1935
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   4095
         _ExtentX        =   7223
         _ExtentY        =   3413
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         GridLines       =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   0
      End
   End
   Begin MSComDlg.CommonDialog comDlg 
      Left            =   120
      Top             =   4080
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label3 
      Caption         =   "库中图号："
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   1200
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "库中图名："
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   720
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "上传文件："
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   975
   End
End
Attribute VB_Name = "frmUpDWG"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conSQL As New cxConnectSQL.Connect
Dim udFile As New cxUpDownFile.Operate
Dim FileFullName As String
Dim ServerName As String
Dim FileName As String
Dim FileNo As Integer

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdUp_Click()
    Dim i As Integer
    Dim tolLen As Integer
    Dim pos As Integer
    
    FileFullName = LTrim(RTrim(txtFile))
    FileName = LTrim(RTrim(txtName.Text))
    tolLen = Len(FileName)
    pos = tolLen - 3
    If LCase(Right(FileName, 4)) <> ".dwg" Then
        MsgBox "库中图名必须以'.dwg'结尾，请检查拼写错误！", vbOKOnly + vbExclamation, "提示"
        Exit Sub
    End If
    If Len(txtNo) = 0 Then
        MsgBox "库中图号不能为空！", vbOKOnly + vbExclamation, "提示"
        txtNo.SetFocus
        Exit Sub
    End If
    FileNo = txtNo
    For i = 1 To FileInfo(0).no
        If FileInfo(i).no = FileNo Then
            MsgBox "库中已存在一个图号为" & FileNo & "的图形，请更换库中图号！", vbOKOnly + vbExclamation, "提示"
            txtNo.SetFocus
            Exit Sub
        ElseIf FileInfo(i).name = FileName Then
            MsgBox "库中已存在一个图名为" & FileName & "的图形，请更换库中图名！", vbOKOnly + vbExclamation, "提示"
            txtName.SetFocus
            Exit Sub
        End If
    Next i
    If udFile.UpFile(FileFullName, FileNo, FileName) <> "" Then
        txtFile = ""
        txtNo = ""
        txtName = ""
        ShowRecord
        MsgBox "上传成功！", vbOKOnly + vbExclamation, "提示"
        Exit Sub
    Else
        MsgBox "上传失败！", vbOKOnly + vbExclamation, "提示"
        Exit Sub
    End If
    
End Sub

Private Sub cmdView_Click()
    comDLG.DialogTitle = "选择上传文件"
    comDLG.Filter = "AutoCAD图形文件(*.dwg)|*.dwg"
    comDLG.ShowOpen
    txtFile = comDLG.FileName
    txtName = GetFileName(comDLG.FileName)
End Sub

Private Sub Form_Load()
    
    ListView1.View = lvwReport
    
    Dim colX As Object
    Set colX = ListView1.ColumnHeaders.Add(1)
    colX.Text = "文件编号"
    colX.Width = ListView1.Width / 4
    Set colX = ListView1.ColumnHeaders.Add(2)
    colX.Text = "文件名称"
    colX.Width = ListView1.Width / 4 * 3 - 50
    
    ShowRecord
    
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
End Sub

Private Function GetFileName(ByVal FullName As String) As String
    Dim strLen As Integer
    Dim newLen As Integer
    Dim i As Integer
    Dim name As String
    
    strLen = Len(FullName)
    For i = strLen To 1 Step -1
        If Mid(FullName, i, 1) = "\" Then
            Exit For
        Else
            newLen = newLen + 1
        End If
    Next i
    name = Right(FullName, newLen)
    GetFileName = name
End Function

Private Sub txtNo_Validate(Cancel As Boolean)
    If Len(txtNo) = 0 Then Exit Sub
    If Not IsNumeric(txtNo) Then
        MsgBox "库中图号必须为数字！", vbOKOnly + vbExclamation, "提示"
        txtNo = ""
    End If
End Sub
Private Sub ShowRecord()
    Dim dbStr As String
    Dim i As Integer
    Dim newItem As ListItem
    
    ListView1.ListItems.Clear
    ServerName = GetKeyValue(HKEY_LOCAL_MACHINE, "software\CXSOFT", "ServerName")
    dbStr = "select Dwg_No,Name from FileTable order by Dwg_No"
    conSQL.OpenCn ServerName
    conSQL.openRs dbStr
    If conSQL.rs.RecordCount > 0 Then conSQL.rs.MoveFirst
    ReDim FileInfo(conSQL.rs.RecordCount) As FileStruct
    FileInfo(0).no = conSQL.rs.RecordCount
    For i = 1 To conSQL.rs.RecordCount
        Set newItem = ListView1.ListItems.Add()
        newItem.Text = conSQL.rs.Fields("Dwg_No").Value
        newItem.SubItems(1) = LTrim(RTrim(conSQL.rs.Fields("Name").Value))
        FileInfo(i).no = conSQL.rs.Fields("Dwg_No").Value
        FileInfo(i).name = conSQL.rs.Fields("Name").Value
        conSQL.rs.MoveNext
    Next i
    conSQL.cloRs
    conSQL.cloCn
End Sub