frmaddurls.frm

软件用到的技巧：透明窗体

         Width           =   900
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "登录密码："
         ForeColor       =   &H00C00000&
         Height          =   180
         Left            =   4485
         TabIndex        =   16
         Top             =   1785
         Width           =   900
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "登录用户名："
         ForeColor       =   &H00C00000&
         Height          =   180
         Left            =   4305
         TabIndex        =   15
         Top             =   1440
         Width           =   1080
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "所属类别："
         ForeColor       =   &H00C00000&
         Height          =   180
         Left            =   300
         TabIndex        =   14
         Top             =   1785
         Width           =   900
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "网站性质："
         ForeColor       =   &H00C00000&
         Height          =   180
         Left            =   300
         TabIndex        =   13
         Top             =   1440
         Width           =   900
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "网络地址："
         ForeColor       =   &H00C00000&
         Height          =   180
         Left            =   300
         TabIndex        =   12
         Top             =   1050
         Width           =   900
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "识别码："
         ForeColor       =   &H00C00000&
         Height          =   180
         Left            =   480
         TabIndex        =   11
         Top             =   705
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "网站名称："
         ForeColor       =   &H00C00000&
         Height          =   180
         Left            =   300
         TabIndex        =   10
         Top             =   360
         Width           =   900
      End
   End
   Begin VB.Label Label9 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "* 为必填内容"
      ForeColor       =   &H00C00000&
      Height          =   180
      Left            =   1350
      TabIndex        =   22
      Top             =   4215
      Width           =   1080
   End
End
Attribute VB_Name = "frmaddurls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/12/24
'描    述：商务名片及客户资料管理系统 Ver 1.73
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Private Sub Command1_Click()
    If Len(Trim(Text6.Text)) > 700 Then
        MsgBox "网站摘要文字内容过长，请保持在700字范围之内。", vbInformation, "文字内容过长"
        Exit Sub
    End If

    If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Or Trim(Text3.Text) = "" Then
        Exit Sub
    End If
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("urls")
    rs.AddNew
        rs!网址名称 = Trim(Text1.Text)
        rs!助记码 = Trim(Text2.Text)
        rs!网络地址 = Trim(Text3.Text)
        rs!登录用户名 = Trim(Text4.Text)
        rs!登录密码 = Trim(Text5.Text)
        rs!网站摘要 = Trim(Text6.Text)
        rs!所属类别 = Val(Trim(Text10.Text))
        rs!网站性质 = Val(Trim(Text9.Text))
    rs.Update
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    MsgBox "网址添加成功！", vbInformation, "添加网址"
    SumNumber '求各个表中的记录数总和
    If form12show = True Then
        ShowAllUrls ("select * from urls order by id desc")
    End If
    Unload Me
End Sub

Private Sub Command2_Click()
    Load FrmListUrlXingzhi
    FrmListUrlXingzhi.Show
End Sub

Private Sub Command3_Click()
    Load FrmListLeibie
    FrmListLeibie.Show
End Sub

Private Sub Form_Load()
Me.Icon = MDIForm1.Icon
Me.BackColor = FormBackColor: Me.Frame1.BackColor = Me.BackColor
    Me.Height = 5280
    Me.Width = 7860
    Me.Text1.Text = ""
    Me.Text2.Text = ""
    Me.Text4.Text = ""
    Me.Text5.Text = ""
    Me.Text6.Text = ""
    Me.Text7.Text = ""
    Me.Text8.Text = ""
    Text9.Text = "": Text10.Text = ""
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select textb from proset")
    If rs.RecordCount = 0 Then
        rs.AddNew
            rs!textb = "否"
        rs.Update
        Timer1.Enabled = False
    ElseIf rs.RecordCount > 0 Then
        rs.MoveFirst
        If Trim(rs!textb) = "否" Then
            Timer1.Enabled = False
        End If
    End If
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
End Sub


Private Sub Form_Resize()
On Error GoTo nextcode:
    Me.Height = 5280
    Me.Width = 7860
    Exit Sub
nextcode:
End Sub


Private Sub Text1_Change()
    Text2.Text = UCase(AutoPY1.AutoPY(Trim(Text1.Text)))
End Sub

Private Sub Text1_GotFocus()
    SendKeys "{end}"
End Sub
Private Sub Text2_GotFocus()
    SendKeys "{end}"

End Sub

Private Sub Text2_LostFocus()
    Text2.Text = Trim(UCase(Text2.Text))
End Sub
Private Sub Text3_GotFocus()
    SendKeys "{end}"
End Sub
Private Sub Text4_GotFocus()
    SendKeys "{end}"
End Sub
Private Sub Text5_GotFocus()
    SendKeys "{end}"

End Sub

Private Sub Timer1_Timer()
    Dim i As String
    i = Trim(Clipboard.GetText)
    If Len(Text3.Text) < 8 Then
        If Left(i, 7) = "http://" Or Left(i, 4) = "www." Then
            Text3.Text = i
            MsgBox "发现剪贴板上存在网址信息，已经将网址信息送到了网址栏。请继续复制网址名称并自行添加到名称一项中。", vbInformation
            Timer1.Enabled = False
            Text1.SetFocus
        End If
    End If
End Sub