执行sql查询.frm

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

        Else
            sqlstr = sqlstr & "Order By " & Combo2.Text
        End If
    End If
    'MsgBox sqlstr
    ShowAllUrls (sqlstr)
    frmresize
End Sub

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

Private Sub Command3_Click()
DoEvents
ShellExecute 0, "open", Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 3)), "", "", 1
DoEvents
End Sub

Private Sub Command4_Click()
    ShowAllUrls ("select * from urls order by id desc")
    'Me.MSFlexGrid1.Refresh
End Sub

Private Sub Command5_Click()
    If (Me.MSFlexGrid1.Rows - 1) = 0 Then
        Exit Sub
    End If
    If Trim(Me.MSFlexGrid1.TextMatrix(0, 0)) = "" Then
        Exit Sub
    End If
    Load FrmToExcel
    FrmToExcel.Show
    FrmToExcel.Label8.Caption = "4"
    FrmToExcel.Label7.Caption = Me.Label1.Caption
    FrmToExcel.Label6.Caption = Me.MSFlexGrid1.Rows - 1
    FrmToExcel.Label5.Caption = "当前的网址列表窗体"

End Sub

Private Sub Command6_Click()
If Me.MSFlexGrid1.RowSel = 0 Then
    MsgBox "没有选中行，所以不能进行隐藏行的操作。", vbInformation
    Exit Sub
End If
If Me.MSFlexGrid1.RowSel > 0 And Me.MSFlexGrid1.RowSel > 1 Then
    If MsgBox("你将要隐藏【" & Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 1) & "】的资料吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
        Me.MSFlexGrid1.RemoveItem (Me.MSFlexGrid1.RowSel)
    Else
        Exit Sub
    End If
Else
    'MsgBox "最后一条信息，不能再删除了，否则就没有什么信息可以供导出的了。", vbInformation
    MsgBox "非常抱歉，由于技术上的原因，目前此版本暂时无法删除第一行数据，这个问题后续版本有望解决，请及时关注下一版本。", vbInformation
    
End If

End Sub

Private Sub Form_Load()
HookWheel Me.hwnd '用于支持鼠标滚轮
    Me.Top = 400 '(Screen.Height - Me.Height) / 4
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.BackColor = FormBackColor
    Me.Frame1.BackColor = Me.BackColor
    Me.Check1.BackColor = Me.BackColor
    Me.MSFlexGrid1.BackColorFixed = 16777178
    Me.MSFlexGrid1.BackColorBkg = MsFlexGridBackColorBkgValue
    form12show = True
    Me.Icon = MDIForm1.Icon
    Me.Combo1.ListIndex = 0
    Me.Combo2.ListIndex = 0
    Text1.Text = ""
    Me.Height = 9210
    Me.Width = 12500
    Me.Top = (Screen.Height - Me.Height) / 10
    Me.Left = (Screen.Width - Me.Width) / 2
    frmresize
    ShowAllUrls ("select * from urls order by id desc")
    Me.MSFlexGrid1.ColWidth(0) = 500
    Me.MSFlexGrid1.ColWidth(1) = 3000
    Me.MSFlexGrid1.ColWidth(3) = 3000
    Me.MSFlexGrid1.ColWidth(4) = 1000
    Me.MSFlexGrid1.ColWidth(5) = 1000
    Me.MSFlexGrid1.ColWidth(6) = 1000
    Me.MSFlexGrid1.ColWidth(7) = 1000
    Me.MSFlexGrid1.ColWidth(8) = 1000
    If Me.MSFlexGrid1.RowSel > 0 Then
        Me.Text2.Text = Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 3))
    Else
        Me.Text2.Text = ""
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    AllBaiFangShow = False
    form12show = False
End Sub
Private Sub MSFlexGrid1_GotFocus()
Set CtlWheel = MSFlexGrid1 '用于设定支持鼠标滚轮
End Sub
Private Sub MSFlexGrid1_LostFocus()
Set CtlWheel = Nothing '用于设定取消鼠标滚轮的支持
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnHookWheel Me.hwnd '卸载鼠标滚轮的支持
End Sub
Private Sub Label1_DblClick()
    Load Form11
    Form11.Show
    Form11.Text1.Text = Label1.Caption
    Form11.Combo1.ListIndex = 3
End Sub

Private Sub frmresize()
    If Me.Height > 1200 And Me.Width > 10500 Then
        Me.MSFlexGrid1.Height = Me.Height - 1600
        Me.MSFlexGrid1.Width = Me.Width - 350
        Me.Command2.Left = Me.MSFlexGrid1.Left + Me.MSFlexGrid1.Width - Me.Command2.Width
        Me.Command3.Left = Me.MSFlexGrid1.Left + Me.MSFlexGrid1.Width - Me.Command3.Width
        Me.Command3.PICMaskColor = Me.MSFlexGrid1.BackColorBkg
        Me.Frame1.Top = Me.MSFlexGrid1.Top + Me.MSFlexGrid1.Height + 0
        Me.Command3.Top = Me.Frame1.Top + 100
        Me.Text2.Left = Me.Frame1.Left + Me.Frame1.Width + 50
        Me.Text2.Width = Me.Command3.Left - Me.Text2.Left - 50
        Me.Text2.Top = Me.Label1.Top + Me.Frame1.Top - 40
        Command5.Top = Command3.Top - 20
        Command6.Top = Command5.Top
    End If
End Sub

Private Sub Form_Resize()
    frmresize
End Sub


Private Sub MSFlexGrid1_Click()
    If Me.MSFlexGrid1.RowSel > 0 Then
        Me.Text2.Text = Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 3))
    Else
        Me.Text2.Text = ""
    End If
End Sub

Private Sub MSFlexGrid1_DblClick()
    
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from proset")

    
    If rs.RecordCount = 0 Then
        Exit Sub
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
    Else
        rs.MoveFirst
        If IsNull(rs!textc) = False Then
            If rs!textc = "是" Then
                DoEvents
                    ShellExecute 0, "open", Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 3)), "", "", 1
                DoEvents
                Exit Sub
                rs.Close
                db.Close
                Set rs = Nothing
                Set db = Nothing
            Else
            rs.Edit
                rs!textc = "否"
            rs.Update
            EditUrlInfo
            End If
        Else
            rs.Edit
                rs!textc = "否"
            rs.Update
        End If
    End If
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        
End Sub


    Private Sub EditUrlInfo()
        If Me.MSFlexGrid1.Rows = 1 Then Exit Sub
    Me.Text2.Text = Trim(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 3))
    
If FrmUrlsEditShow = True Then
    FrmUrlsEdit.SetFocus
Else
    Load FrmUrlsEdit
    FrmUrlsEdit.Show
End If

    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from urls where id =" & Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0))
    If rs.RecordCount = 0 Then
        MsgBox "软件在定位目标网址的时候，出现了错误，错误的原因是没有找到目标的资料。", vbCritical, "目标没有找到，错误"
        Exit Sub
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
    ElseIf rs.RecordCount > 0 Then
        rs.MoveLast
        rs.MoveFirst
        If rs.RecordCount > 1 Then
            MsgBox "软件在定位目标网址的时候，出现了错误，错误的原因是找到多个可供修改的目标的资料。无法精确定位。", vbCritical, "目标定位错误"
            Exit Sub
            rs.Close
            db.Close
            Set rs = Nothing
            Set db = Nothing
        ElseIf rs.RecordCount = 1 Then
            FrmUrlsEdit.Text11.Text = rs!id
            FrmUrlsEdit.Text1.Text = rs!网址名称
            FrmUrlsEdit.Text2.Text = rs!助记码
            FrmUrlsEdit.Text3.Text = rs!网络地址
            FrmUrlsEdit.Text4.Text = rs!登录用户名
            FrmUrlsEdit.Text5.Text = rs!登录密码
            FrmUrlsEdit.Text6.Text = rs!网站摘要
            FrmUrlsEdit.Text10.Text = rs!所属类别
            FrmUrlsEdit.Text9.Text = rs!网站性质
            Dim lbdb As Database
            Dim lbrs As Recordset
            Set lbdb = OpenDatabase(MdbPath)
            Set lbrs = lbdb.OpenRecordset("select * from urlleibie where id =" & rs!所属类别)
            If lbrs.RecordCount = 0 Then
                FrmUrlsEdit.Text8.Text = "(查找类别失败)"
            ElseIf lbrs.RecordCount > 0 Then
                lbrs.MoveLast
                lbrs.MoveFirst
                If lbrs.RecordCount = 1 Then
                    FrmUrlsEdit.Text8.Text = lbrs!所属类别
                Else
                    FrmUrlsEdit.Text8.Text = "(查找类别失败)"
                End If
            End If
            lbrs.Close
            Set lbrs = Nothing
            lbdb.Close
            Set lbdb = Nothing
            Dim xzdb As Database
            Dim xzrs As Recordset
            Set xzdb = OpenDatabase(MdbPath)
            Set xzrs = xzdb.OpenRecordset("select * from urlxingzhi where id =" & rs!网站性质)
            If xzrs.RecordCount = 0 Then
                FrmUrlsEdit.Text7.Text = "(查找性质失败)"
            ElseIf xzrs.RecordCount > 0 Then
                xzrs.MoveLast
                xzrs.MoveFirst
                If xzrs.RecordCount = 1 Then
                    FrmUrlsEdit.Text7.Text = xzrs!网站性质
                Else
                    FrmUrlsEdit.Text7.Text = "(查找性质失败)"
                End If
            End If
            xzrs.Close
            Set xzrs = Nothing
            xzdb.Close
            rs.Close
            db.Close
            Set rs = Nothing
            Set db = Nothing
        End If
    End If

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