form1.frm

远程访问sql server 的源码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5010
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7470
   LinkTopic       =   "Form1"
   ScaleHeight     =   5010
   ScaleWidth      =   7470
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtDest 
      Height          =   375
      Left            =   3960
      TabIndex        =   8
      Top             =   840
      Width           =   2895
   End
   Begin VB.CommandButton cmdLoad 
      Caption         =   "载入源图片"
      Height          =   375
      Left            =   360
      TabIndex        =   7
      Top             =   1440
      Width           =   1335
   End
   Begin VB.TextBox txtSour 
      Enabled         =   0   'False
      Height          =   405
      Left            =   360
      TabIndex        =   6
      Text            =   "E:\程序图片\bmp1\011322.jpg"
      Top             =   840
      Width           =   2415
   End
   Begin VB.CommandButton cmdReLoad 
      Caption         =   "从新路径导入图片"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4920
      TabIndex        =   5
      Top             =   1440
      Width           =   1695
   End
   Begin VB.PictureBox PicDest 
      Height          =   2415
      Left            =   4560
      ScaleHeight     =   2355
      ScaleWidth      =   2235
      TabIndex        =   2
      Top             =   2040
      Width           =   2295
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "图片另存"
      Enabled         =   0   'False
      Height          =   375
      Left            =   2760
      TabIndex        =   1
      Top             =   1440
      Width           =   1575
   End
   Begin VB.PictureBox PicSour 
      Height          =   2295
      Left            =   360
      ScaleHeight     =   2235
      ScaleWidth      =   2115
      TabIndex        =   0
      Top             =   2040
      Width           =   2175
   End
   Begin VB.Label Label3 
      Caption         =   "改变位置后的图片路径："
      Height          =   255
      Left            =   3960
      TabIndex        =   4
      Top             =   360
      Width           =   2055
   End
   Begin VB.Label Label2 
      Caption         =   "原始的图片存放路径："
      Height          =   255
      Left            =   360
      TabIndex        =   3
      Top             =   360
      Width           =   1935
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private bmpArray() As Byte

'****************************************************************
'功能：   将一个磁盘二进制文件中的内容存放入二进制数组
'输入：
'   strPath     String  文件路径全名
'   ByteArray() Byte    字节类型动态数组
'输出：   无
'影响：     传址参数ByteArray()
'****************************************************************
Public Sub GetFileData(ByVal strPath As String, ByRef ByteArray() As Byte)
    
    Dim hFileHandle As Long
    hFileHandle = FreeFile
    
    '为字节数组分配大小
    ReDim ByteArray(FileLen(strPath))
    
    Open strPath For Binary As #hFileHandle
    '将二进制文件内容全部放入字节数组
    Get #hFileHandle, , ByteArray
    
    Close #hFileHandle
End Sub

'****************************************************************
'功能：   将Byte数组中的内容存放到磁盘文件中
'输入：
'   strPath     String  文件路径全名
'   ByteArray() Byte    字节类型动态数组
'输出：   无
'影响：     传址参数ByteArray()
'****************************************************************
Public Sub SaveToFile(ByVal strPath As String, ByRef ByteArray() As Byte)
    
    Dim hFileHandle As Long
    hFileHandle = FreeFile
    
    Open strPath For Binary As #hFileHandle
    Put #hFileHandle, , ByteArray
    Close #hFileHandle
End Sub

Private Sub cmdLoad_Click()
    PicSour.Picture = LoadPicture(Trim$(txtSour.Text))
    cmdSave.Enabled = True
End Sub

Private Sub cmdReLoad_Click()
    PicDest.Picture = LoadPicture(Trim$(txtDest.Text))
End Sub

Private Sub cmdSave_Click()
    cmdReLoad.Enabled = True
    
    '如果有另存为的路径，则通过自定义的两个函数完成二进制文件的操作
    If Trim$(txtDest.Text) <> vbNullString Then
        GetFileData Trim$(txtSour.Text), bmpArray
        SaveToFile Trim$(txtDest.Text), bmpArray
    Else
        MsgBox "请输入另存为文件路径！"
    End If
End Sub