竞博体育 > 前端 > 竞博体育官方版下载打开功能,1、 首先要保存文件到数据库

竞博体育官方版下载打开功能,1、 首先要保存文件到数据库

新建形成效:

VB中上传下载文件到SQL数据库

 

编写人:左丘文

 

2015-4-11

后日在退换三个VB编写的系统时,想给画面扩充二个上传文件到数据库,并得以下载查看的成效,前些天在这里处,小编想与大家齐声享用代码,在那做个小结,以供参照他事他说加以考查。有野趣的同桌,可以协同斟酌与学习一下,不然就略过呢。

 

1、 首先要保存文件到数据库,大家须求使用流对象保存,所以第不时间先在数据库中加进

二个image的字段(注意:Access中的photo字段类型为OLE对象.SqlServer中的photo字段类型为Image卡塔尔,用于存储文件。

    竞博体育官方版下载 1 

2、 上边再在镜头增加用于上传及下载的CommandButton及三个commondialog:

竞博体育官方版下载 2 

1卡塔尔         数据库连接管理

 1 Private Sub Form_Load()
 2     '数据库连接字符串
 3  Connstring="Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
 4 ";Data Source=d:csdn_vbdatabase保存图片access图片img.mdb"
 5  
 6 ‘上面包车型地铁说话是一连sqlserver数据库的.
 7 ‘Connstring="Provider=SQLOLEDB.1;Persist Security Info=True;" & _
竞博体育官方版下载 , 8 ‘"User ID=sa;Password=;Initial Catalog=test;Data Source=yang"
 9    Set Conn = New ADODB.Connection
10    Conn.Open Connstring
11 End Sub

2卡塔尔(قطر‎         上传文件管理

竞博体育官方版下载 3竞博体育官方版下载 4

 1 Private Sub cmdUpload_Click()
 2 ** 援引 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
 3 ‘2.5本子以下不支持Stream对象
 4  
 5 On Error GoTo handleErr
 6 Dim rs As ADODB.Recordset
 7 Dim mstream As ADODB.Stream
 8  
 9 '保存文件到数据库中
10 Set rs = New ADODB.Recordset
11 With rs
12         .ActiveConnection = Conn
13         .LockType = adLockOptimistic
14         .CursorLocation = adUseClient
15         .CursorType = adOpenKeyset
16         .Open "SELECT * from SR WHERE SRNUM='" & txtSRNUM.Text & "'"
17     End With
18  
19  
20  
21 CommonDialog1.Filter = "Pictures (*.PDF;*.pdf)|*.PDF;*.pdf"
22 CommonDialog1.ShowOpen
23 If CommonDialog1.filename = "" Then Exit Sub
24  
25 If (rs.RecordCount = 1) Then
26  
27  
28 '读取文件到内容
29     Set mstream = New ADODB.Stream
30     With mstream
31         .Type = adTypeBinary   '二进制格局
32         .Open
33         .LoadFromFile CommonDialog1.filename
34     End With
35  
36 rs.Fields("FileName").Value = CommonDialog1.FileTitle
37 rs.Fields("FileUploadTime").Value = Format(Now, "YYYY-MM-DD hh:mm")
38 rs.Fields("FileNameContent") = mstream.Read
39 rs.update
40 '完结后关门指标
41 mstream.Close
42  
43 End If
44 rs.Close
45  Set rs = Nothing
46 txtFileName.Text = CommonDialog1.FileTitle
47  
48 Exit Sub
49  
50 handleErr:
51   MsgBox ERR.Description
52 End Sub

View Code

3卡塔尔         下载文件管理

竞博体育官方版下载 5竞博体育官方版下载 6

 1 Private Sub cmdDownload_Click()
 2 On Error GoTo handleErr
 3 Dim rs As ADODB.Recordset
 4 Dim mstream As ADODB.Stream
 5  
 6 Set rs = New ADODB.Recordset
 7 With rs
 8         .ActiveConnection = ConGamma
 9         .LockType = adLockOptimistic
10         .CursorLocation = adUseClient
11         .CursorType = adOpenKeyset
12         .Open "SELECT * from SR WHERE SRNUM='" & txtSRNUM.Text & "'"
13     End With
14 If (rs.RecordCount = 1) Then
15    If (rs("FileNameContent"卡塔尔(قطر‎.ActualSize > 1卡塔尔 Then  ‘决断是或不是为空
16     '保存到文件
17     Set mstream = New ADODB.Stream
18     With mstream
19         .Mode = adModeReadWrite
20         .Type = adTypeBinary
21         .Open
22         .Write rs("FileNameContent")
23         .SaveToFile "C:8D.PDF"    ‘‘这里注意了,如果当前目录下存在8D.PDF,会报三个文件写入失利的错误.
24     End With
25    
26     '关闭指标
27     rs.Close
28     mstream.Close
29    
30  
31 End If
32 End If
33  
34 Exit Sub
35 handleErr:
36   MsgBox ERR.Description
37 End Sub

View Code

切切实实就需求各位优质的去自已去调治了。

 

3、有关更加的多的工夫分享,大家能够投入大家的技能群。

 

接待出席手艺分享群:238916811

 

Private Sub CommandButton1_Click(卡塔尔 '向SDE服务器增多本地shape文件

Private Sub xinjian_Click()

    If TextBox1.Text = "" Then
        MsgBox "缺乏上传文件!", vbCritical, "警告"
        Exit Sub
    End If
     
    Dim fWor As IFeatureWorkspace
    Dim wFac As IWorkspaceFactory
    Dim fCla1 As IFeatureClass, fCla2 As IFeatureClass
    Dim proSet As IPropertySet
    Dim fCount As Integer
    Dim fea As IFeatureBuffer
    Dim geo As IGeometry
   
    Dim sFile, sName, sPath As String
    sFile = TextBox1.Text
    sPath = sFile
    sName = Right(sPath, 1)
    Do While Not (sName = "")
        sPath = Left(sPath, Len(sPath) - 1)
        sName = Right(sPath, 1)
    Loop
    sName = Right(sFile, Len(sFile) - Len(sPath))
    sPath = Left(sPath, Len(sPath) - 1)
    Set wFac = New ShapefileWorkspaceFactory
    Set fWor = wFac.OpenFromFile(sPath, None)
    Set fCla1 = fWor.OpenFeatureClass(sName)
    fCount = fCla1.FeatureCount(Nothing)
   
    Set wFac = New SdeWorkspaceFactory
    Set proSet = New PropertySet
    proSet.SetProperty "server", "yj-gis2"
    proSet.SetProperty "instance", "5151"
    proSet.SetProperty "user", "sde"
    proSet.SetProperty "password", "sde"
    proSet.SetProperty "version", "DEFAULT"
    Set fWor = wFac.Open(proSet, 0)
    Set fCla2 = fWor.CreateFeatureClass(fCla1.AliasName, fCla1.Fields, fCla1.CLSID, fCla1.EXTCLSID, fCla1.FeatureType, fCla1.ShapeFieldName, None)
   
    Dim wEdit As IWorkspaceEdit
    Set wEdit = fWor
    wEdit.StartEditing True
    wEdit.StartEditOperation
   
    For i = 0 To fCount - 1
        Set fea = fCla2.CreateFeatureBuffer
        Set geo = fCla1.GetFeature(i).ShapeCopy
        Set fea.Shape = geo
        Dim fdCount As Integer
        fdCount = fCla1.Fields.FieldCount
        For j = 0 To fdCount - 1
            fea.Value(j) = fCla1.GetFeature(i).Value(j)
        Next j
        fCla2.Insert(True).InsertFeature (fea)
    Next i
   
    wEdit.StopEditOperation
    wEdit.StopEditing True
       
   
    MsgBox "增加成家立业!", vbInformation, "提醒"

Dim a As String

End Sub

Dim b As Integer

Private Sub CommandButton2_Click(State of Qatar '将SDE服务器上的图层删除

a = "文件"

    Dim fName As String
    fName = ComboBox1.Text
   
    Dim fWor As IFeatureWorkspace
    Dim wFac As IWorkspaceFactory
    Dim proSet As IPropertySet
    Dim fSet As IDataset
   
    Set wFac = New SdeWorkspaceFactory
    Set proSet = New PropertySet
    proSet.SetProperty "server", "yj-gis2"
    proSet.SetProperty "instance", "5151"
    proSet.SetProperty "user", "sde"
    proSet.SetProperty "password", "sde"
    proSet.SetProperty "version", "DEFAULT"
    Set fWor = wFac.Open(proSet, None)
    Dim wor As IWorkspace
    Set wor = fWor
   
    Set fSet = fWor.OpenFeatureClass(fName)
    fSet.Delete
   
    MsgBox "删除成功!", vbInformation, "提醒"

  • Caption + "的文字已经更动。"
  • Chr(13卡塔尔国 + "想保留文件呢?"

End Sub

If Text1.Text > "" Then b = MsgBox(a, vbApplicationModal + vbDefaultButton1 + vbYesNoCancel + vbExclamation, "记事本")

Private Sub CommandButton3_Click(卡塔尔 '浏览本地shape文件
    
    CommonDialog1.Filter = "Shape File|*.shp"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName <> "" Then
        TextBox1.Text = CommonDialog1.FileName
    End If
  
End Sub

Select Case b

Private Sub CommandButton4_Click(卡塔尔(قطر‎ '在下拉菜单中列出SDE服务器上的图层

       Case 6

    ComboBox1.Text = ""
    ComboBox1.Clear
   
    Dim fWor As IFeatureWorkspace
    Dim wFac As IWorkspaceFactory
    Dim proSet As IPropertySet
   
    Set wFac = New SdeWorkspaceFactory
    Set proSet = New PropertySet
    proSet.SetProperty "server", "yj-gis2"
    proSet.SetProperty "instance", "5151"
    proSet.SetProperty "user", "sde"
    proSet.SetProperty "password", "sde"
    proSet.SetProperty "version", "DEFAULT"
    Set fWor = wFac.Open(proSet, None)
    Dim wor As IWorkspace
    Set wor = fWor
    Dim eSet As IEnumDataset
    Set eSet = wor.Datasets(esriDTFeatureClass)
    Dim fCla As IFeatureClass
    Set fCla = eSet.Next
    While Not fCla Is Nothing
        ComboBox1.AddItem fCla.AliasName
        Set fCla = eSet.Next
    Wend
   
    MsgBox "更新成功!", vbInformation, "提醒"

            CommonDialog1.CancelError = True

End Sub

            On Error GoTo errhandler

            CommonDialog1.DialogTitle = "另存为"

            CommonDialog1.InitDir = "c:windows"

            CommonDialog1.FileName = "*.txt"

            CommonDialog1.Filter = "text files(*.txt)|*.txt"

            CommonDialog1.ShowSave

            Open CommonDialog1.FileName For Output As #1

            Print #1, Mid(Text1.Text, 1, Len(Text1.Text))

            Close #1

            Text1.Text = ""

errhandler:

             Exit Sub

           

        Case 7

            Text1.Text = ""

            Exit Sub

End Select

End Sub

 

另存为功用:

Private Sub lingcunwei_Click()

CommonDialog1.CancelError = True

On Error GoTo errhandler

CommonDialog1.DialogTitle = "另存为"

CommonDialog1.InitDir = "c:windows"

CommonDialog1.FileName = "*.txt"

CommonDialog1.Filter = "text files(*.txt)|*.txt"

CommonDialog1.ShowSave

Open CommonDialog1.FileName For Output As #1

     Print #1, Mid(Text1.Text, 1, Len(Text1.Text))

     Close #1

errhandler:

  Exit Sub

End Sub

 

 

 

 

保留功效:

Private Sub baocun_Click()

CommonDialog1.CancelError = True

On Error GoTo errhandler

CommonDialog1.DialogTitle = "另存为"

CommonDialog1.InitDir = "c:windows"

 CommonDialog1.FileName = "*.txt"

  CommonDialog1.Filter = "text files(*.txt)|*.txt"

  CommonDialog1.ShowSave

    Open CommonDialog1.FileName For Output As #1

    Print #1, Mid(Text1.Text, 1, Len(Text1.Text))

     Close #1

errhandler:

  Exit Sub

End Sub

 

 

开拓效率:

Private Sub dakai_Click()

CommonDialog1.CancelError = True

On Error GoTo errhandler

CommonDialog1.DialogTitle = "张开文本文件"

CommonDialog1.FileName = ""

CommonDialog1.InitDir = "c:windows"

CommonDialog1.Filter = "text files(*.text)|*.txt"

CommonDialog1.ShowOpen

If CommonDialog1.FileName > "" Then

Text1.Text = ""

Open CommonDialog1.FileName For Input As #1

Do While Not EOF(1)

   Line Input #1, s

   Text1.Text = Text1.Text + s + vbCrLf

Loop

Close #1

End If

errhandler:

  Exit Sub

End Sub

 

打字与印刷功效:

Private Sub dayin_Click()

CommonDialog1.CancelError = True

On Error GoTo errhandler

CommonDialog1.Flags = 256

CommonDialog1.ShowPrinter

For i = 1 To CommonDialog1.Copies

  Printer.Print Text1.Text

  Next i

errhandler:

   Exit Sub

End Sub

复制功用:

Private Sub fuzhi_Click()

Clipboard.Clear  'clipboard为剪切板

Clipboard.SetText Text1.SelText

End Sub

 

 

 

细分功效:

Private Sub jianqie_Click()

Clipboard.Clear   'clipboard为剪切板

Clipboard.SetText Text1.SelText

Text1.Text = ""

End Sub

 

粘贴功用:

Private Sub niantie_Click()

Text1.SelText = Clipboard.GetText

End Sub

 

 

查找功用:

Private Sub chazhao_Click()

Dim pos As Integer

Dim t As String

t = InputBox$("请输入要寻找的内容:", "查找"卡塔尔国

Text1.SetFocus

pos = InStr(1, Text1.Text, t)

If pos > 0 Then

        Text1.SelStart = pos - 1

        Text1.SelLength = Len(t)

   Else

       MsgBox "未有找到您要探究的剧情!", vbInformation, "记事本"

End If

End Sub

 

 

全选功效:

Private Sub quanxuan_Click()

Text1.SelStart = 0

Text1.SelLength = Len(Text1.Text)

End Sub

 

 

去除功用:

Private Sub shanchu_Click()

Text1.SelText = ""

End Sub

 

时刻/日期功效:

Private Sub shijian_Click()

a = Year(Date)

b = Month(Date)

c = Day(Date)

d = Hour(Time())

e = Minute(Time())

Text1.Text = Text1.Text + Str(a) + "-" + Str(b) + "-" + Str(c) + "   " + Str(d) + ":" + Str(e)

End Sub

 

Private Sub tuichu_Click()

End

End Sub


 

字体功用:

Private Sub ziti_Click()

CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects

CommonDialog1.ShowFont

CommonDialog1.FontName = "宋体"

With Text1

.FontName = CommonDialog1.FontName

.FontSize = CommonDialog1.FontSize

.FontItalic = CommonDialog1.FontItalic

.FontStrikethru = CommonDialog1.FontStrikethru

.FontUnderline = CommonDialog1.FontUnderline

.ForeColor = CommonDialog1.Color

End With

End Sub

 

 

至于记事本功效:

Private Sub guanyujishiben_Click()

Form2.Show

End Sub

 

援救宗旨效能:

Private Sub bangzhuzhuti_Click()

form3.Show

End Sub

 

 

分界面如下: 

 

 

上一篇:Chebyshev
下一篇:没有了
  • 首页
  • 电话
  • 软件