收集为自己和大家

Question

如何把一个目录下的多个TXT文件导入到ACCESS中，生成对应的表， 请给出个例子 
作　　者：  seakingx (抗日统一联盟：亚龙湾)  
等　　级：    
信 誉 值：  100 
所属论坛：  VB 数据库 
问题点数：  100 
回复次数：  1 
发表时间：  2004-2-24 11:20:27 
   
 
   比如在一个目录下有 ZD1.TXT ZD2.TXT XD1.TXT XD2.TXT 等等
要生成ZD1 ZD2 XD1 XD2 4 个表，  
 
 
 回复人： hkhsd(天涯闲人) ( ) 信誉：100  2004-2-24 11:33:58  得分:100 
 
 
  
刚好写过类似的东西Sub InputDatabase(filepath As String, dbname As String)
    Dim db As Database, tbl As TableDef
    Dim f_name As String, f1_name As String
    Set db = OpenDatabase(dbname)
    Set tbl = db.CreateTableDef("temp")
    tbl.Connect = "text;database=" & GetPath(filepath)  'Getpath为取得路径函数，需自写，比较简单
    f_name = GetFileName(filepath)  'GetFileName为取得文件名函数，需自写，比较简单
    f1_name = Left(f_name, InStrRev(f_name, ".", -1) - 1)    CreateSchema (filepath)  'CreateSchema为生成文本对应的Schema.ini文件函数，需自写，比较简单
    tbl.SourceTableName = f_name
    DelTable dbname, f1_name
    db.TableDefs.Append tbl
    db.Execute "select * into " & f1_name & " from temp"
    db.TableDefs.Delete tbl.Name
    db.Close
    Set tbl = Nothing
    Set db = Nothing
    Kill GetPath(filepath) & "Schema.ini"
End Sub  
 
Top 
 
 该问题已经结贴 ，得分记录： hkhsd (100)、  

Answer 1

主　　题：  怎样将.txt导入到.mdb中，是导入到已存在的mdb库表中而不是新创建的mdb库表 
作　　者：  irene_pang (艾琳)  
等　　级：    
信 誉 值：  100 
所属论坛：  VB 基础类 
问题点数：  100 
回复次数：  6 
发表时间：  2004-02-21 22:28:53 
   
 
   
怎样将.txt导入到.mdb中，是导入到已存在的mdb库表中而不是新创建的mdb库表，
也就是说mdb中的table是已经存在的
  
 
 
 回复人： busisoft(chunlin) ( ) 信誉：100  2004-02-21 22:32:00  得分:0 
 
 
  '将文本文件导入数据库
    ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\mydb.mdb;User Id=admin;Password=;"
    Open CommonDialog1.FileName For Input As #1   ' 打开输入文件。    Do While Not EOF(1) ' 循环至文件尾。
        nRecord = nRecord + 1
'        If nRecord = 1 Then Input #1, F(1)
        For i = 1 To nCount
            Input #1, F(i)
            Debug.Print F(i)
        Next i
        szSql = "insert into (a,b,c) values ('" & Join(F, "','") & "')" '数据可作相应的转化
        rsTemp2.Open szSql, ConnectionString, adOpenDynamic, adLockPessimistic
    Loop
    Close #1   ' 关闭文件。  
 
Top 
 
 回复人： online(龙卷风V2.0--再战江湖) ( ) 信誉：118  2004-02-21 22:42:00  得分:0 
 
 
  可以把txt当成表来读，然后一条一条的插入access数据库
Public Function Read_Text_File() As ADODB.Recordset      Dim rs As ADODB.Recordset
      Set rs = New ADODB.Recordset
      Dim conn As ADODB.Connection
      Set conn = New ADODB.Connection
      conn.Open "DRIVER={Microsoft Text Driver (*.txt; *.csv)};" & _
                  "DBQ=" & App.Path & ";", "", ""      rs.Open "select * from [test#txt]", conn, adOpenStatic, _
                  adLockReadOnly, adCmdText
      Set Read_Text_File = rs
      Set rs = Nothing
      Set conn = Nothing
End FunctionPrivate Sub cmdReadTXT_Click()
      Dim rs As ADODB.Recordset
      Set rs = New ADODB.Recordset
      Set rs= obj.Read_Text_File
      .....
      .....
      Set obj = Nothing
End Sub
  
 
Top 
 
 回复人： irene_pang(艾琳) ( ) 信誉：100  2004-02-21 22:46:00  得分:0 
 
 
  不是以insert的方式，而是以集合的方式，根据一个schema.ini文件定义table的字段等，另外，有一个.txt文件是数据文件，请问这种方式怎样导入到已存在的mdb中的table中呢？
  
 
Top 
 
 回复人： hhjjhjhj(大头) ( ) 信誉：99  2004-02-21 23:39:00  得分:0 
 
 
  .Execute "SELECT * into " & sAccessTable & " FROM [Text;HDR=NO;DATABASE=" & sTxtPath & "]." & sTxtFileName
'sAccessTable=表名
'sTxtPath=TXT文件夹
'sTxtFileName=TXT文件名
  
 
Top 
 
 回复人： rainstormmaster(暴风雨 v2.0) ( ) 信誉：170  2004-02-21 23:53:00  得分:0 
 
 
  同意 大头 的意见，用SELECT  into 的效率要高得多
  
 
Top 
 
 回复人： lsr66(瑞丽.com员工) ( ) 信誉：100  2004-02-22 01:14:00  得分:0 
 
 
  请问楼上两位，字段要对应，顺序可调整吗？
 
 

Answer 2

主　　题：  gird中的数据怎么导出生成TXT文件？ 
作　　者：  datacn (datacn)  
等　　级：    
信 誉 值：  99 
所属论坛：  VB 基础类 
问题点数：  100 
回复次数：  8 
发表时间：  2004-03-30 14:30:00 
   
 
   
共有3万多行，每行10多列，数据量很大。还有，就是这样的一个TXT文件怎么导到Gird中？  
 
 
 回复人： MSTOP(陈建华(东莞立晨企业资讯服务有限公司)) ( ) 信誉：111  2004-03-30 14:29:00  得分:0 
 
 
  Sub SaveFile(FileName As String)
'保存文件
    Dim FileID As Long, ConTents As String
    Dim a As Long, B As Long
    Dim RowMax As Long, ColMax As Long
    Dim T1 As Date, T2 As Date
    Dim TmpProVal As Long, DltWidth As Single
    Dim NewVal As Long, OleVal As Long
    
    With MSHFlexGrid1(0)
    .Redraw = False: FileID = FreeFile
    RowMax = .Rows - 1: ColMax = .Cols - 1
    Screen.MousePointer = 11: T1 = Timer()
    Open FileName For Output As #FileID
         ConTents = RowMax + 1
         Print #FileID, ConTents
         For a = 1 To RowMax
             .Row = a: .Col = 1
             .RowSel = a: .ColSel = ColMax
             ConTents = .Clip
             Print #FileID, ConTents
             NewVal = (a * TmpProVal) \ RowMax
             If CBool(NewVal - OleVal) Then
                   ME.CAPTION=FORMAT$((NewVal*100)/RowMax,"00") & "%"
             End If
         Next a
    Close #FileID
    .Redraw = True
    Screen.MousePointer = 0
    End With
End Sub
  
 
Top 
 
 回复人： MSTOP(陈建华(东莞立晨企业资讯服务有限公司)) ( ) 信誉：111  2004-03-30 14:33:00  得分:0 
 
 
  Sub OpenFile(FileName As String)
    Dim InputID As Long, FileID As Long
    Dim GridInput As String, GridRowMax As Long
    Dim TmpProVal As Long, DltWidth As Single
    Dim CollMax As Long, AddSum As String
    Dim EndRow As Long, AddFlag As Boolean
    Dim DltAdd As Long, OleTmp As Long
    Dim KeyTab As String, KeyEnter As String
    Dim ValMax As Long, ColMax As Long
    
    On Error Resume Next    With MSHFlexGrid1(0)
    .Visible = False: .Redraw = False
    Screen.MousePointer = 11
    Err.Clear: SetAttr FileName, 0
    If Err.Number <> 0 Then '如果文件不存在
       Exit Sub
    End If
    Screen.MousePointer = 11
    .Visible = False: .Redraw = False
    InputID = 0: FileID = FreeFile: AddFlag = False: DltAdd = 25
    .FixedRows = 0: .FixedCols = 0: KeyTab = Chr(vbKeyTab): KeyEnter = Chr(13)
    .Rows = 1: .Cols = 21: ValMax = 50: ColMax = 20
    Open FileName For Input As #FileID
         Do While Not EOF(FileID) ' 循环至文件尾。
            Line Input #FileID, GridInput
            If InputID = 0 Then
               GridRowMax = CLng("0" & GridInput)
               If GridRowMax < 2 Then GridRowMax = 2
               .Rows = GridRowMax: DltWidth = CollMax / ValMax
            Else
               If AddFlag Then
                  AddSum = AddSum & KeyEnter & InputID & KeyTab & GridInput
               Else
                  AddSum = InputID & KeyTab & GridInput: AddFlag = True
               End If
               '------------------------------------------------------
               If InputID Mod DltAdd = 0 Then
                  .Row = InputID - DltAdd + 1: .Col = 0
                  .RowSel = InputID: .ColSel = ColMax
                  .Clip = AddSum: AddSum = ""
                  EndRow = InputID: AddFlag = False
               End If
               '-----------------------------------------------------
               TmpProVal = (InputID * 100) \ GridRowMax
               If TmpProVal - OleTmp > 0 Then
                     ME.CAPTION=FORMAT$(TMPPROVAL * 100,"00") & "%"
                     OleTmp = TmpProVal
               End If
               '-----------------------------------------------------
            End If
            InputID = InputID + 1
         Loop
         '--------------------------------------------------------
         If InputID - EndRow > 1 Then
            .Row = EndRow + 1: .Col = 0
            .RowSel = GridRowMax - 1
            .ColSel = ColMax
            .Clip = AddSum
            AddSum = ""
         End If
    Close #FileID
    .FixedRows = 1: .FixedCols = 2: ShowNum = False
    ShowRowID = 1: Call ShowGrid
    Unload Oscoll: DoEvents
    .Redraw = True: .Visible = True
    Screen.MousePointer = 0
    End With
End Sub
  
 
Top 
 
 回复人： MSTOP(陈建华(东莞立晨企业资讯服务有限公司)) ( ) 信誉：111  2004-03-30 14:34:00  得分:0 
 
 
  以上程序,尚要作一些小修改...
如不存在的对象.可直接删除.  
 
Top 
 
 回复人： passer_wave(路人) ( ) 信誉：98  2004-03-30 14:37:00  得分:0 
 
 
  这个是 MSFlexGrid，你修改一下也可以用的Public Sub OutDataToText(Flex As MSFlexGrid) 
    Dim s As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim strTemp As String
    On Error GoTo Ert
    Me.MousePointer = 11
    On Error Resume Next
    DoEvents
    Dim FileNum As Integer
    FileNum = FreeFile
    Open "d:\aa.txt" For Output As #FileNum
        With Flex
            k = .Rows
            For i = 0 To k - 1
                strTemp = ""
                For j = 0 To .Cols - 1
                    DoEvents
                    strTemp = strTemp & .TextMatrix(i, j) & ","
                Next j
                Print #FileNum, Left(strTemp, Len(strTemp) - 1)
            Next i
        End With
    Close #FileNum
    Me.MousePointer = 0
    MsgBox "导出成功"
Ert:
    MsgBox Err.Description
    Me.MousePointer = 0
End Sub
  
 

Answer 3

Private Sub Command1_Click()
 'MsgBox Inet1.OpenURL("http://www.213213.com/software/software/Time.txt")
Inet1.Execute "http://www.213213.com/software/software/Time.txt"
End Sub     Private Sub Inet1_StateChanged(ByVal State As Integer)
     Dim vtData As Variant ' Data variable.
     Select Case State
     ' ... Other cases not shown.
     Case icResponseCompleted ' 12
     ' Open a file to write to.
     Open "c:\111\Time.txt" For Binary Access _
     Write As #1
     
     ' Get the first chunk. NOTE: specify a Byte
     ' array (icByteArray) to retrieve a binary file.
     vtData = Inet1.GetChunk(1024, icString)
     
     Do While LenB(vtData) > 0
     Put #1, , vtData
     ' Get next chunk.
     vtData = Inet1.GetChunk(1024, icString)
     Loop
     Put #1, , vtData
     Close #1
     End Select
     End Sub

Answer 4

复制本地文件c:\net.log到远程主机上，
Inet1.Execute "ftp://User:[email protected]/", "put c:\net.log net.log"这是MSDN的帮助，看看吧：Execute 方法示例
该示例列举了一系列使用 Execute 方法的 FTP 操作。该示例假定窗体中有三个 TextBox 控件。第一个控件 txtURL 包含 FTP 服务器的 URL。第二个控件 txtRemotePath 包含特殊命令所需的附加信息。第三个控件 txtResponse 包含服务器的响应。Private Sub cmdChangeDirectory_Click()
   '将目录改变到 txtRemotePath。
   Inet1.Execute txtURL.Text, "CD " & _
   txtRemotePath.Text
End SubPrivate Sub cmdDELETE_Click()
   '删除 txtRemotePath 中的目录。
   Inet1.Execute txtURL.Text, "DELETE " & _
   txtRemotePath.Text
End SubPrivate Sub cmdDIR_Click()
   Inet1.Execute txtURL.Text, "DIR FindThis.txt"
End SubPrivate Sub cmdGET_Click()
   Inet1.Execute txtURL.Text, _
   "GET GetThis.txt C:\MyDocuments\GotThis.txt"
End SubPrivate Sub cmdSEND_Click()
   Inet1.Execute txtURL.Text, _
   "SEND C:\MyDocuments\Send.txt SentDocs\Sent.txt"
End SubPrivate Sub Inet1_StateChanged(ByVal State As Integer)
   'State = 12 时，用 GetChunk 方法检索服务器的响应。   Dim vtData As Variant ' Data variable.
   Select Case State
   '...没有列举其它情况。
   Case icError '11
      '出现错误时，返回 ResponseCode 和 ResponseInfo。
      vtData = Inet1.ResponseCode & ":" & _
      Inet1.ResponseInfo
   Case icResponseCompleted ' 12
      
Dim vtData As Variant
      Dim strData As String 
      Dim bDone As Boolean: bDone = False      '取得第一个块。
      vtData = Inet1.GetChunk(1024, icString)
      DoEvents      Do While Not bDone
         strData = strData & vtData
         '取得下一个块。
         vtData = Inet1.GetChunk(1024, icString)
         DoEvents         If Len(vtData) = 0 Then
            bDone = True
         End If
      Loop
      txtData.Text = strData
   End Select
   End Sub
Private Sub Command1_Click()
    Inet1.Execute "ftp://upload:[email protected]", "put c:\odbcconf.log odbcconf.log"
End SubPrivate Sub Inet1_StateChanged(ByVal State As Integer)
    Dim MsgStr As String
    Select Case State
        Case icNone
            MsgStr = "无状态可报告。"
        Case icHostResolvingHost
            MsgStr = "正在查询所指定的主机的 IP 地址。"
        Case icHostResolved
            MsgStr = "已成功地找到所指定的主机的 IP 地址。"
        Case icConnecting
            MsgStr = "正在与主机连接。"
        Case icConnected
            MsgStr = "已与主机连接成功。"
        Case icRequesting
            MsgStr = "正在向主机发送请求。"
        Case icRequestSent
            MsgStr = "发送请求已成功。"
        Case icReceivingResponse
            MsgStr = "正在接收主机的响应。"
        Case icResponseReceived
            MsgStr = "已成功地接收到主机的响应。"
        Case icDisconnecting
            MsgStr = "正在解除与主机的连接。"
        Case icDisconnected
            MsgStr = "已成功地与主机解除了连接。"
        Case icError
            MsgStr = "与主机通讯时出现了错误。"
        Case icResponseCompleted
            MsgStr = "该请求已经完成，并且所有数据均已接收到。"
    End Select
    Debug.Print MsgStr
End Sub
补充：
        Case icError
            MsgStr = "与主机通讯时出现了错误。"
            If Inet1.ResponseCode = 12003 Then MsgStr = MsgStr & vbCrLf & "用户名或密码错误！"

Answer 5

Option Explicit
Dim strCommand As String
Dim strWebPage As StringPrivate Sub Command1_Click()Winsock1.RemoteHost = "202.103.176.81" '返回或设置远程计算机，控件向它发送数据或从它那里接收数据。既可提供主机名，比如 "FTP://ftp.microsoft.com"，也可提供点格式下的 IP 地址字符串，比如 "100.0.1.1"。
Winsock1.RemotePort = 80 '返回或设置要连接的远程端口号
Winsock1.Connect '返回与远程计算机的连接。
End SubPrivate Sub Winsock1_Connect() '当一个 Connect 操作完成时发生。
On Error Resume Next
strWebPage = "http://202.103.176.81/crun/yingzi007/code_1.asp"
strCommand = "GET " + strWebPage + " HTTP/1.0" + vbCrLf 'GET 为FTP命令
strCommand = strCommand + "Accept: */*" + vbCrLf      '这句可以不要
strCommand = strCommand + "Accept: text/html" + vbCrLf '这句可以不要
strCommand = strCommand + vbCrLf      '记住一定要加上vbCrLfDebug.Print strCommandWinsock1.SendData strCommand  ''给远程计算机发送数据End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long) '当新数据到达时产生该事件
On Error Resume Next   '在错误处理程序结束后，恢复原有的运行
Dim webData As String
Winsock1.GetData webData, vbString '检取当前的数据块
Text1.Text = Text1.Text + webData
End Sub
Private Sub cmdconnect_Click()
On Error Resume Next  Winsock1.RemoteHost = txtwebserver.Text
  Winsock1.RemotePort = 80
  Winsock1.Connect
  
End SubPrivate Sub Form_Load()End SubPrivate Sub Winsock1_Connect()
On Error Resume Next
  Dim strCommand As String
  Dim strWebPage As String
  
  
  strWebPage = txtlocation.Text
  strCommand = "GET " + strWebPage + " HTTP/1.0" + vbCrLf
  strCommand = strCommand + "Accept: */*" + vbCrLf
  strCommand = strCommand + "Accept: text/html" + vbCrLf
  strCommand = strCommand + vbCrLf
  Winsock1.SendData strCommand
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  On Error Resume Next
  Dim webData As String
  
  Winsock1.GetData webData, vbString
  txtWebPage.Text = txtWebPage.Text + webData
End Sub
我在数据接收完毕后，要继续下载同一个服务器的另外一个文件，我有添加了发HTTP头的请求代码，但程序报错，不知道是什么原因， 要连续下载多个文件该怎么做，就是怎么发送请求头，和接收返回信息
Private Sub cmdconnect_Click()
On Error Resume Next  Winsock1.RemoteHost = txtwebserver.Text
  Winsock1.RemotePort = 80
  Winsock1.Connect
  
End SubPrivate Sub Form_Load()End SubPrivate Sub Winsock1_Connect()
On Error Resume Next
  Dim strCommand As String
  Dim strWebPage As String
  
  
  strWebPage = txtlocation.Text
  strCommand = "GET " + strWebPage + " HTTP/1.0" + vbCrLf
  strCommand = strCommand + "Accept: */*" + vbCrLf            
  strCommand = strCommand + "Accept: text/html" + vbCrLf       
  strCommand = strCommand + vbCrLf
  Winsock1.SendData strCommand
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  On Error Resume Next
  Dim webData As String
  
  Winsock1.GetData webData, vbString
  txtWebPage.Text = txtWebPage.Text + webData
End Sub

Answer 6

我看了： TechnoFantasy(冰儿马甲www.applevb.com) 看这篇文章：How to download a file from the Web server，使用了Winsock控件，包含代码
http://www.vbip.com/winsock/winsock_http_01.asp我照着做，但它是将exe文件显视为文本了，请问高手要怎么将下载的文件保存为exe文件？  Private m_strRemoteHost As String    'the web server to connect to
Private m_strFilePath As String      'relative path to the file to retrieve
Private m_strHttpResponse As String  'the server response
Private m_bResponseReceived As Boolean
'
Private Sub cmdReadURL_Click()
    '
    Dim strURL As String    'temporary buffer
    '
    On Error GoTo ERROR_HANDLER
    '
    'check the textbox
    If Len(txtURL) = 0 Then
        MsgBox "Please, enter the URL to retrieve.", vbInformation
        Exit Sub
    End If
    '
    'if the user has entered "http://", remove this substring
    '
    If Left(txtURL, 7) = "http://" Then
        strURL = Mid(txtURL, 8)
    Else
        strURL = txtURL
    End If
    '
    'get remote host name
    '
    m_strRemoteHost = Left$(strURL, InStr(1, strURL, "/") - 1)
    '
    'get relative path to the file to retrieve
    '
    m_strFilePath = Mid$(strURL, InStr(1, strURL, "/"))
    '
    'clear the RichTextBox
    '
    rtbDocument.Text = ""
    '
    'clear the buffer
    '
    m_strHttpResponse = ""
    '
    'turn off the m_bResponseReceived flag
    '
    m_bResponseReceived = False
    '
    'establish the connection
    '
    With wscHttp
        .Close
        .LocalPort = 0
        .Connect m_strRemoteHost, 80
    End With
    '
EXIT_LABEL:
    Exit Sub
    
ERROR_HANDLER:
    '
    If Err.Number = 5 Then
        strURL = strURL & "/"
        Resume 0
    Else
        MsgBox "Error was occurred." & vbCrLf & _
                "Error #: " & Err.Number & vbCrLf & _
                "Description: " & Err.Description, vbExclamation
        GoTo EXIT_LABEL
    End If
    '
End SubPrivate Sub wscHttp_Close()
    '
    Dim strHttpResponseHeader As String
    '
    'to cut of the header info, we must find?
    'a blank line (vbCrLf & vbCrLf)
    'that separates the message body from the header
    '
    If Not m_bResponseReceived Then
        strHttpResponseHeader = Left$(m_strHttpResponse, _
                                InStr(1, m_strHttpResponse, _
                                vbCrLf & vbCrLf) - 1)
        Debug.Print strHttpResponseHeader
        m_strHttpResponse = Mid(m_strHttpResponse, _
                            InStr(1, m_strHttpResponse, _
                            vbCrLf & vbCrLf) + 4)
        '
        'pass the document data to the RichTextBox control
        '
        rtbDocument.Text = m_strHttpResponse
        '
        'turn on the m_bResponseReceived flag
        '
        m_bResponseReceived = True
        '
    End If
    '
End SubPrivate Sub wscHttp_Connect()
    '
    Dim strHttpRequest As String
    '
    'create the HTTP Request
    '
    'build request line that contains the HTTP method,?
    'path to the file to retrieve,
    'and HTTP version info. Each line of the request?
    'must be completed by the vbCrLf
    strHttpRequest = "GET " & m_strFilePath & " HTTP/1.1" & vbCrLf
    '
    'add HTTP headers to the request
    '
    'add required header - "Host", that燾ontains the remote host name
    '
    strHttpRequest = strHttpRequest & "Host: " & m_strRemoteHost & vbCrLf
    '
    'add the "Connection" header to force the server to close the connection
    '
    strHttpRequest = strHttpRequest & "Connection: close" & vbCrLf
    '
    'add optional header "Accept"
    '
    strHttpRequest = strHttpRequest & "Accept: */*" & vbCrLf
    '
    'add other optional headers
    '
    'strHttpRequest = strHttpRequest & <Header Name> & _
                      <Header Value> & vbCrLf
    '. . .
    '
    'add a blank line that indicates the end of the request
    strHttpRequest = strHttpRequest & vbCrLf
    '
    'send the request
    wscHttp.SendData strHttpRequest
    '
    Debug.Print strHttpRequest
    '
End SubPrivate Sub wscHttp_DataArrival(ByVal bytesTotal As Long)
    '
    On Error Resume Next
    '
    Dim strData As String
    '
    'get arrived data from winsock buffer
    '
    wscHttp.GetData strData
    '
    'store the data in the m_strHttpResponse variable
    m_strHttpResponse = m_strHttpResponse & strData
    '
End Sub

Answer 7

How to download a file from the Web server      A little bit of a theory...Process of the communication via HTTP, between two computers, is very simple. Client application establishes a connection to TCP/IP port number 80 of a web server, and sends the HTTP request to the server. The server processes the client request, sends the HTTP response message to the client, and closes the connection.Thus, HTTP session consist of four steps: establishing connection by the client 
sending HTTP request by the client 
sending HTTP response by the server 
closing connection by the server 
The last stage of the HTTP session (closing connection) behaves differently depending on version of HTTP protocol. If version 1.0 is used, you don't need to make any additional work, the server closes the connection after all the data was sent. But in the case of using of 1.1 version of HTTP, you can control the connection state sending Connection header with HTTP request. To force the server to close the connection you need to send the Connection header as shown below:Connection: closeNow let's build the same scenario, but in terms of MS Winsock Control.Step 1: establishing connection by the clientTo perform this step we need just call the Connect method of the MS Winsock Control. For example:wscHttp.Connect "www.microsoft.com", 80If the web server is ready to communicate, it accepts our connection request. We'll know about it from the Connect event of the MS Winsock Control. Step 2: sending HTTP request by the clientSince the connection is established we can send HTTP request to the server. The HTTP request is a block of several lines of ASCII text. The first line contains the HTTP method, relative path to the resource to retrieve, and HTTP version information. Other lines of the HTTP request are HTTP headers that define additional properties of the request. Below is an example of HTTP request:GET /default.asp HTTP/1.1
Host: www.microsoft.com
Accept: */*
Connection: closeThe wscHttp_Connect event procedure is a good place to send the request. For example:Private Sub wscHttp_Connect()   Dim strHttpRequest As String
   '
   'create the HTTP Request
   '
   'build request line that contains the HTTP method, 
   'path to the file to retrieve,
   'and HTTP version info. Each line of the request 
   'must be completed by the vbCrLf
   strHttpRequest = "GET / HTTP/1.1" & vbCrLf
   '
   'add HTTP headers to the request
   '
   'add required header - "Host", that 
   'contains the remote host name
   strHttpRequest = strHttpRequest & _
                    "Host: www.microsoft.com" & vbCrLf
   'add optional header "Accept"
   strHttpRequest = strHttpRequest & "Accept: */*" & vbCrLf
   'add the "Connection" header to force 
   'the server to close the connection
   strHttpRequest = strHttpRequest & "Connection: close" & vbCrLf
   '
   'add other optional headers
   '
   'strHttpRequest = strHttpRequest & <Header Name> & _
                     <Header Value> & vbCrLf
   '. . .
   '
   'add a blank line that indicates the end of the request
   strHttpRequest = strHttpRequest & vbCrLf
   '
   'send the request
   wscHttp.SendData strHttpRequest End SubStep 3: sending HTTP response by the serverAs soon as the HTTP Request has arrived, the web server processes this request and sends a response back to the client. The structure of a response message is similar to the structure of a request. It consists of the two parts: HTTP header and message body, or entity. These two parts of the message must be separated by a blank line. So the response message looks like one shown below:                 -- HTTP/1.1 200 OK
                |   Server: Microsoft-IIS/5.0
                |   Date: Mon, 10 Apr 2000 10:00:01 GMT
HTTP Header ----    Content-Type: text/html
                |   Accept-Ranges: bytes
                |   Last-Modified: Fri, 07 Apr 2000 21:40:36 GMT
                |   ETag: "d061b8e8d9a0bf1:869"
                 -- Content-Length: 15796
Blank line ---->
                 -- <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
                |   <html>
Message body --     <head>
                |   ........
                 -- </html>As you can see, the HTTP response is just a text that we can store in a String data type variable. All the arrived data can be collected in a variable declared at the module level (in the General_Declarations section of the code module of the form):Private m_strHttpResponse As StringTo retrieve the arrived data it is enough to add the following code to the DataArrival event procedure of the Winsock Control:Private Sub wscHttp_DataArrival(ByVal bytesTotal As Long)   Dim strData As String   wscHttp.GetData strData
   m_strHttpResponse = m_strHttpResponse & strDataEnd SubNow all the data sent by the server will be stored in the m_strHttpResponse variable.Step 4: closing the connection by the serverAs all the data is sent, the server closes the connection. The Close event of the Winsock Control will let us know about it. The closing of the connection is also a signal for a client that all the data is received, therefore it is good time to show the retrieved resource to the user. To perform this we need to cut of the header information of the response message, and pass the data to a control such as a RichTextBox. For example:Private Sub wscHttp_Close()   'to cut of the header info, we must find 
   'a blank line (vbCrLf & vbCrLf)
   'that separates the message body from the header
   m_strHttpResponse = Mid(m_strHttpResponse, _
                       InStr(1, m_strHttpResponse, _
                       vbCrLf & vbCrLf) + 4)
   '
   'pass the document data to the RichTextBox control
   rtbDocument.Text = m_strHttpResponse End SubAt this point, I suppose, we are ready to write some code. Read the next page.

Answer 8

Let's write some code...Our simple application must handle only one user's action then she/he clicks on cmdReadURL button. As response to this user's action the program must:parse the data entered into txtURL textbox to detect the host name and relative path to the file 
establish the connection to TCP/IP port 80 at the web server 
send HTTP request to the server 
receive and collect arrived data 
output the data to the RichTextBox control 
Let's begin from the declaration of the global variables. Put the following code to the General_Declarations section of the form's code module:Private m_strRemoteHost As String    'the web server to connect to
Private m_strFilePath As String      'relative path to the file to retrieve
Private m_strHttpResponse As String  'the server response
Private m_bResponseReceived As BooleanThe cmdReadURL_Click event procedure parses the data entered into the txtURL textbox and establishes the connection to the web server:Private Sub cmdReadURL_Click()
   '
   Dim strURL As String 'temporary buffer
   '
   On Error GoTo ERROR_HANDLER
   '
   'check the textbox
   If Len(txtURL) = 0 Then
      MsgBox "Please, enter the URL to retrieve.", vbInformation
      Exit Sub
   End If
   '
   'if the user has entered "http://", remove this substring
   '
   If Left(txtURL, 7) = "http://" Then
      strURL = Mid(txtURL, 8)
   Else
      strURL = txtURL
   End If
   '
   'get remote host name
   '
   m_strRemoteHost = Left$(strURL, InStr(1, strURL, "/") - 1)
   '
   'get relative path to the file to retrieve
   '
   m_strFilePath = Mid$(strURL, InStr(1, strURL, "/"))
   '
   'clear the RichTextBox
   '
   rtbDocument.Text = ""
   '
   'clear the buffer
   '
   m_strHttpResponse = ""
   '
   'turn off the m_bResponseReceived flag
   '
   m_bResponseReceived = False
   '
   'establish the connection
   '
   With wscHttp
      .Close
      .LocalPort = 0
      .Connect m_strRemoteHost, 80
   End With
   '
EXIT_LABEL:
   Exit SubERROR_HANDLER:
   '
   If Err.Number = 5 Then
      strURL = strURL & "/"
      Resume 0
   Else
      MsgBox "Error was occurred." & vbCrLf & _
      "Error #: " & Err.Number & vbCrLf & _
      "Description: " & Err.Description, vbExclamation
      GoTo EXIT_LABEL
   End If
   '
End SubAs the connection will have been established, we'll send the HTTP request. The good place to do it - the Connect event procedure.Private Sub wscHttp_Connect()
   '
   Dim strHttpRequest As String
   '
   'create the HTTP Request
   '
   strHttpRequest = "GET " & m_strFilePath & " HTTP/1.1" & vbCrLf
   strHttpRequest = strHttpRequest & "Host: " & m_strRemoteHost & vbCrLf
   strHttpRequest = strHttpRequest & "Accept: */*" & vbCrLf
   strHttpRequest = strHttpRequest & "Connection: close" & vbCrLf
   '
   'add a blank line that indicates the end of the request
   strHttpRequest = strHttpRequest & vbCrLf
   '
   'send the request
   wscHttp.SendData strHttpRequest
   '
End SubIn response to the request the web server sends the response message. All the data received from the server must be collected in the m_strHttpResponse variable:Private Sub wscHttp_DataArrival(ByVal bytesTotal As Long)
   '
   On Error Resume Next
   '
   Dim strData As String
   '
   'retrieve arrived data from winsock buffer
   '
   wscHttp.GetData strData
   '
   'store the data in the m_strHttpResponse variable
   m_strHttpResponse = m_strHttpResponse & strData
   '
End SubThe Close event of the Winsock Control informs us that the data transfer is completed. Therefore, we need to put the following code to the wscHttp_Close event procedure. This code will cut off the header information from the response message and pass the document data to the RichTextBox:Private Sub wscHttp_Close()
   '
   'to cut of the header info, we must find 
   'a blank line (vbCrLf & vbCrLf)
   'that separates the message body from the header
   '
   If Not m_bResponseReceived Then
      m_strHttpResponse = Mid(m_strHttpResponse, _
                           InStr(1, m_strHttpResponse, _
                           vbCrLf & vbCrLf) + 4)
      '
      'pass the document data to the RichTextBox control
      '
      rtbDocument.Text = m_strHttpResponse
      '
      'turn on the m_bResponseReceived flag
      '
      m_bResponseReceived = True
      '
   End If
   '
End SubThat's it. Now you can run the application to test pressing F5. Enter URL into the txtURL textbox and click on Read URL button. Does it work?At this point the sample is not smart enough. It requires a lot of improvements to be a more useful application. In the following tutorials we will add other features to this example and learn more about HTTP protocol. You will found out how to handle errors, follow to redirection URL, communicate via a proxy server, show the progress of downloading of a resource, resume broken file transfer, and etc.

Answer 9

你的通信協定呢？TCP/IP？？？？
TCP/IP
Server端：
Private Sub Form_Load()
    ' 使用 TCP Protocol
    WskServer.Protocol = sckTCPProtocol
    
    ' 設定本 Server 的 IP Address
    txtServerIP = WskServer.LocalIP
End SubPrivate Sub cmdListen_Click()
    cmdListen.Enabled = False
    
    lblServerStatus = "Listening for Connection."    ' 設定本 Server 的連接 Port
    WskServer.LocalPort = txtServerPort.Text
 
    ' 檢查 Winsock 是否已產生連結?
    If WskServer.State <> sckConnected Then
        ' 若未產生連結則產生 Listen
        WskServer.Listen
    Else
        MsgBox "Server is already connected!", vbCritical
        Exit Sub
    End If
End SubPrivate Sub WskServer_ConnectionRequest(ByVal requestID As Long)
    ' 檢查 Server Winsock 是否已產生連結?
    If WskServer.State = sckConnected Then
        MsgBox "Server is already connected!", vbCritical
        Exit Sub
    End If
    
    WskServer.Close
    
    ' 接受來自 Client 端的 Request
    WskServer.Accept requestID
    
    lblServerStatus = "Processing Connection."
    
    lstServerLog.AddItem Time & " - " & "Client Connected"
    
    ' 傳送訊息回 Client 端
    WskServer.SendData "CLOSE"
    
    DoEvents
   
    WskServer.Close
    cmdListen.Enabled = True
    lblServerStatus = "Server Idle"
End Sub
Clinet端
Private Sub Form_Load()
    ' 使用 TCP Protocol
    WskClient.Protocol = sckTCPProtocol
End SubPrivate Sub cmdConnect_Click()
    Timer1.Enabled = True
    
    ' 設定欲連結 Server 的 Remote Host IP Address
    If LCase(txtClientIP) = "localhost" Then
        WskClient.RemoteHost = "127.0.0.1"
    Else
        WskClient.RemoteHost = txtClientIP
    End If
    
    ' 設定欲連結 Server 的 Remote Port
    WskClient.RemotePort = txtClientPort
    
    ' 檢查 Winsock 是否已經連結上 Server?
    If WskClient.State <> sckConnected Then
        ' 未連結上 Server
        WskClient.Connect
    Else
        ' 已連結上 Server
        MsgBox "Client is already connected!", vbCritical
        Exit Sub
    End If
    
    lblClientStatus = "Connecting."
    cmdConnect.Enabled = False
End SubPrivate Sub WskClient_Connect()
    Timer1.Enabled = False
    
    lblClientStatus = "Connected."
End SubPrivate Sub WskClient_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    
    ' 取得 Server 端回傳的指令資料
    WskClient.GetData strData
    
    ' 檢查 Server 端回傳指令是否為 "CLOSE"
    If UCase(strData) = "CLOSE" Then
        WskClient.Close
        lblClientStatus = "Closing Connection."
        cmdConnect.Enabled = True
    End If
    
    lblClientStatus = "Not Connected"
End SubPrivate Sub Timer1_Timer()
    ' 若無法連上 Server (Timer1.Interval = 5000) 則關閉連結    MsgBox "Client could not find server.", vbCritical
    
    ' 檢查 Winsock 是否已經關閉連結
    If WskClient.State <> sckClosed Then
        WskClient.Close
    End If
    
    cmdConnect.Enabled = True
    Timer1.Enabled = False
    lblClientStatus = "Not Connected."
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    Winsock1.Accept requestID
end sub
简单的聊天
服务段Private intmax As IntegerPrivate Sub Form_Load()
intmax = 0
tcpServer(0).LocalPort = 1001
tcpServer(0).Listen
Label1.Caption = "正在监听..."
End SubPrivate Sub tcpServer_ConnectionRequest(index As Integer, ByVal requestID As Long)
If index = 0 Then
intmax = intmax + 1
Load tcpServer(intmax)
tcpServer(intmax).LocalPort = 0
tcpServer(intmax).Accept requestIDLabel1.Caption = "有客户连接:" & requestID
End If
End SubPrivate Sub tcpServer_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim strData As String
tcpServer(index).GetData strData
txtOutput.Text = strData
End SubPrivate Sub txtSendData_Change()
tcpServer.SendData txtSendData.Text
End Sub
客户端
Private Sub Command1_Click()
If tcpClient.State = sckConnected Then
MsgBox "已经连接"
'Me.Enabled = False
Exit Sub
End If
tcpClient.ConnectEnd SubPrivate Sub Form_Load()
tcpClient.RemoteHost = "localhost"
tcpClient.RemotePort = 1001
End SubPrivate Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
tcpClient.GetData strData
txtOutput.Text = strData
End SubPrivate Sub txtSend_Change()
tcpClient.SendData txtSend.Text
End Sub
像你这样用UDP协议就可以了.Private Sub Form_Load()
UDPServer.Protocol = sckUDPProtocol
UDPServer.RemotePort = 10301
UDPServer.Bind 10300
end subPrivate Sub UDPServer_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
UDPServer.GetData strData
msgbox strData
end sub
另一个工程如下:Private Sub Command1_Click()
UDPServer.Close
UDPServer.Protocol = sckUDPProtocol
UDPServer.RemotePort = 10300
UDPServer.Bind 10301
UDPServer.RemoteHost = "10.187.24.56"
UDPServer.SendData "发送消息"
end sub

Answer 10

'======================
'加密函数 (支持中文)
'======================
Public Function GetCode(ByVal STRValue As String) As String
    Randomize
    Dim ll As Integer
    Dim AscNumber As Integer
    Dim i As Integer
    Dim hh As String
    Dim ss As String
    Dim mm As String
    Dim j As Integer
    Dim temp As String
    Dim temp1 As String
    Dim temp2 As String
    Dim temp3 As String
    Dim temp4 As String
        ll = Len(STRValue)If ll = 0 Then
   
   GetCode = ""
   
Else    ''''
    '**************************************
    i = 1
    For i = 1 To ll
   
        AscNumber = Asc(Mid(STRValue, i, 1)) '取ASC码
        
        hh = Hex(AscNumber) '换成16进制码
        
        If Len(hh) < 2 Then '不够二位的补0
          hh = "0" & hh
        End If
        
        For j = 1 To Len(hh)
            ss = Mid(hh, j, 1)
            
            Select Case ss
                   Case "0"
                        mm = "0000"
                   Case "1"
                        mm = "0001"
                   Case "2"
                        mm = "0010"
                   Case "3"
                        mm = "0011"
                   Case "4"
                        mm = "0100"
                   Case "5"
                        mm = "0101"
                   Case "6"
                        mm = "0110"
                   Case "7"
                        mm = "0111"
                   Case "8"
                        mm = "1000"
                   Case "9"
                        mm = "1001"
                   Case "A"
                        mm = "1010"
                   Case "B"
                        mm = "1011"
                   Case "C"
                        mm = "1100"
                   Case "D"
                        mm = "1101"
                   Case "E"
                        mm = "1110"
                   Case "F"
                        mm = "1111"
            End Select
            
            temp = temp & mm
        Next j
        
      Next i
      '**************************************
     '  Debug.Print "G", temp
      temp2 = ""
      temp3 = ""
      i = 1
      For i = 1 To Len(temp)
          If i / 2 = Int(i / 2) Then
                temp2 = temp2 & Mid(temp, i, 1)
          Else
                temp3 = temp3 & Mid(temp, i, 1)
          End If
      Next
      
      temp = temp2 & temp3
     
      '**************************************
      temp1 = Right(temp, 7)
      temp = temp1 & Left(temp, Len(temp) - 7)      temp1 = Left(temp, Len(temp) / 2)
      temp = Right(temp, Len(temp) / 2) & temp1      temp1 = Mid(temp, Len(temp) / 2, 2)
      
      temp = temp1 & temp & temp1
      '**************************************
      
      
      temp1 = ""
      ss = ""
      mm = ""
      j = 1
      For j = 1 To Len(temp) Step 4
            
            ss = Mid(temp, j, 4)
            
            Select Case ss
                   
                   Case "0000"
                        mm = "F"
                   Case "0001"
                        mm = "b"
                   Case "0010"
                        mm = "2"
                   Case "0011"
                        mm = "P"
                   Case "0100"
                        mm = "V"
                   Case "0101"
                        mm = "j"
                   Case "0110"
                        mm = "W"
                   Case "0111"
                        mm = "N"
                   Case "1000"
                        mm = "q"
                   Case "1001"
                        mm = "m"
                   Case "1010"
                        mm = "7"
                   Case "1011"
                        mm = "i"
                   Case "1100"
                        mm = "d"
                   Case "1101"
                        mm = "c"
                   Case "1110"
                        mm = "L"
                   Case "1111"
                        mm = "g"
            End Select
            
            temp1 = temp1 & mm
        Next j
        
           temp = temp1
      '**************************************
      '     Debug.Print "A", temp
           i = 1
           temp1 = ""
           For i = 1 To Len(temp)               temp1 = temp1 & Chr(Asc(Mid(temp, i, 1)) Xor 17)           Next i           temp = temp1
       '**************************************
     '      Debug.Print "B", temp
           i = 1
           temp1 = ""
           For i = 1 To Len(temp)
'               temp2 = Chr(Int(Rnd * 25) + 65)
'
'               If (Asc(Mid(temp, i, 1)) Xor Asc(temp2)) > 127 Then
'                    temp3 = Chr(Asc(Mid(temp, i, 1)) Xor Asc(temp2) - 127 + 32)
'                    temp4 = "a"
'               ElseIf (Asc(Mid(temp, i, 1)) Xor Asc(temp2)) < 32 Then
'                    temp3 = Chr(Asc(Mid(temp, i, 1)) Xor Asc(temp2) + 32)
'                    temp4 = "b"
'                    Else
'                    temp3 = Chr(Asc(Mid(temp, i, 1)) Xor Asc(temp2))
'                    temp4 = "c"
'               End If
'               temp1 = temp1 & temp3 & temp2 & temp4
               temp2 = Chr(Int(Rnd * 25))
               temp3 = Chr(Asc(Mid(temp, i, 1)) Xor Asc(temp2))
               temp1 = temp1 & temp3 & Chr(Asc(temp2) + 65)
           Next i
        '**************************************
        temp = temp1    '    Debug.Print "C", temp
           
      GetCode = temp
End IfEnd Function

Answer 11

'=========================
'解密函数
'=========================
Public Function GetPassword(ByVal temp As String) As String
    Dim ll As Integer
    Dim i As Integer
    Dim ss As String
    Dim mm As String
    Dim j As Integer
    Dim hh As String
    Dim DD As Long
    Dim TT As String
    Dim temp1 As String
    Dim temp2 As String
    Dim temp3 As String
    
    '**************************************
If Len(temp) = 0 Then
   GetPassword = ""
Else
    
    '********************************
    temp1 = ""
    
    i = 1
    For i = 1 To Len(temp) Step 2
        temp1 = temp1 & Chr(Asc(Mid(temp, i, 1)) Xor Asc(Mid(temp, i + 1, 1)) - 65)
    Next i
    temp = temp1
        
    '********************************
    i = 1
    temp1 = ""
    For i = 1 To Len(temp)
        temp1 = temp1 & Chr(Asc(Mid(temp, i, 1)) Xor 17)
    Next i
    temp = temp1
    
    '********************************
    temp1 = ""
    mm = ""
    ss = ""
    j = 1
      For j = 1 To Len(temp)
            
            ss = Mid(temp, j, 1)
            
            Select Case ss
                   
                   Case "F"
                        mm = "0000"
                   Case "b"
                        mm = "0001"
                   Case "2"
                        mm = "0010"
                   Case "P"
                        mm = "0011"
                   Case "V"
                        mm = "0100"
                   Case "j"
                        mm = "0101"
                   Case "W"
                        mm = "0110"
                   Case "N"
                        mm = "0111"
                   Case "q"
                        mm = "1000"
                   Case "m"
                        mm = "1001"
                   Case "7"
                        mm = "1010"
                   Case "i"
                        mm = "1011"
                   Case "d"
                        mm = "1100"
                   Case "c"
                        mm = "1101"
                   Case "L"
                        mm = "1110"
                   Case "g"
                        mm = "1111"
                   Case Else
                        GetPassword = ""
                        Exit Function
            End Select
            
            temp1 = temp1 & mm
        Next j
    
    temp = temp1
    
    '**************************************
    
    temp = Left(temp, Len(temp) - 2)
    temp = Right(temp, Len(temp) - 2)    temp1 = Left(temp, Len(temp) / 2)
    temp = Right(temp, Len(temp) / 2) & temp1    temp1 = Left(temp, 7)
    temp = Right(temp, Len(temp) - 7) & temp1
    
    '**************************************
    
      temp1 = ""
      temp2 = Left(temp, Len(temp) / 2)
      temp3 = Right(temp, Len(temp) / 2)
      
      i = 1
      For i = 1 To Len(temp2)
          temp1 = temp1 & Mid(temp3, i, 1) & Mid(temp2, i, 1)
      Next
      
      temp = temp1
    
     
    '**************************************
    ll = Len(temp)
    i = 1
    For i = 1 To ll Step 4
        ss = Mid(temp, i, 4)
        
            Select Case ss
                   
                   Case "0000"
                        mm = "0"
                   Case "0001"
                        mm = "1"
                   Case "0010"
                        mm = "2"
                   Case "0011"
                        mm = "3"
                   Case "0100"
                        mm = "4"
                   Case "0101"
                        mm = "5"
                   Case "0110"
                        mm = "6"
                   Case "0111"
                        mm = "7"
                   Case "1000"
                        mm = "8"
                   Case "1001"
                        mm = "9"
                   Case "1010"
                        mm = "A"
                   Case "1011"
                        mm = "B"
                   Case "1100"
                        mm = "C"
                   Case "1101"
                        mm = "D"
                   Case "1110"
                        mm = "E"
                   Case "1111"
                        mm = "F"
            End Select
            
            hh = hh & mm
     
    Next i
    '**************************************
    
    j = 1
    
    While j <= Len(hh)
        
        If Mid(hh, j, 1) < "8" Then
            DD = CDec("&H" & Mid(hh, j, 2))
            TT = TT & Chr(DD)
            j = j + 2
        Else
            DD = CDec("&H" & Mid(hh, j, 4))
            TT = TT & Chr(DD)
            j = j + 4
        End If
        
    Wend
    '**************************************
    
    
    GetPassword = TT
End IfEnd Function

Answer 12

Private Function Hex2String(ByVal s As String) As String  '一串十六进制的字符串转换成相应的汉字或字母（可能是汉字与字母或数字组成）    On Error Resume Next
    Dim bytearr() As Byte
    Dim temps As String
    Dim temp As Byte
    Dim i As Long
    Dim j As Long
    j = 0
    Dim outs As String
    For i = 1 To Len(s) Step 2
        temps = Mid(s, i, 2)
        temp = Val("&H" & temps)
        ReDim Preserve bytearr(j)
        bytearr(j) = temp
        j = j + 1
    Next
    outs = StrConv(bytearr, vbUnicode)
    Hex2String = outs
End Function
Private Sub Command1_Click()  汉字转化成16进制，谢谢各位
Dim mybyte() As Byte
mybyte = "中华人民共和国"
For i = 0 To UBound(mybyte)
Debug.Print Hex(mybyte(i)) & " ";  
NextEnd SubPrivate Sub Command2_Click()  汉字转化成16进制，谢谢各位
  MsgBox Hex(AscW("汉"))
End Sub

Answer 13

dyx(天火) ( ) 信誉：100 
On Error GoTo ErrHandler   '错误处理    '如何打印图片框中的曲线 
   '打印对话框
   CommonDialog1.CancelError = True
   CommonDialog1.ShowPrinter
   CommonDialog1.Flags = &H0
   Printer.PaintPicture Picture1.Image, 0, 0
   Printer.EndDoc
   Exit Sub
ErrHandler:      ' 用户按了“取消”按钮
   Exit Sub

Answer 14

SQL SERVER 与ACCESS、EXCEL的数据转换 熟悉SQL SERVER 2000的数据库管理员都知道，其DTS可以进行数据的导入导出，其实，我们也可以使用Transact-SQL语句进行导入导出操作。在Transact-SQL语句中，我们主要使用OpenDataSource函数、OPENROWSET 函数，关于函数的详细说明，请参考SQL联机帮助。利用下述方法，可以十分容易地实现SQL SERVER、ACCESS、EXCEL数据转换，详细说明如下： 一、           SQL SERVER 和ACCESS的数据导入导出常规的数据导入导出：使用DTS向导迁移你的Access数据到SQL Server，你可以使用这些步骤: 　　1在SQL SERVER企业管理器中的Tools（工具）菜单上，选择Data Transformation 　　2Services（数据转换服务），然后选择  czdImport Data（导入数据）。 　　3在Choose a Data Source（选择数据源）对话框中选择Microsoft Access as the Source，然后键入你的.mdb数据库(.mdb文件扩展名)的文件名或通过浏览寻找该文件。 　　4在Choose a Destination（选择目标）对话框中，选择Microsoft OLE　DB Prov ider for SQL　Server，选择数据库服务器，然后单击必要的验证方式。 　　5在Specify Table Copy（指定表格复制）或Query（查询）对话框中，单击Copy tables（复制表格）。 6在Select Source Tables（选择源表格）对话框中，单击Select All（全部选定）。下一步，完成。 Transact-SQL语句进行导入导出：1.         在SQL SERVER里查询access数据:-- ======================================================SELECT * FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0','Data Source="c:\DB.mdb";User ID=Admin;Password=')...表名------------------------------------------------------------------------------------------------- 2.         将access导入SQL server -- ======================================================在SQL SERVER 里运行:SELECT *INTO newtableFROM OPENDATASOURCE ('Microsoft.Jet.OLEDB.4.0',       'Data Source="c:\DB.mdb";User ID=Admin;Password=' )...表名------------------------------------------------------------------------------------------------- 3.         将SQL SERVER表里的数据插入到Access表中-- ======================================================在SQL SERVER 里运行：insert into OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',  'Data Source=" c:\DB.mdb";User ID=Admin;Password=')...表名 (列名1,列名2)select 列名1,列名2  from  sql表 实例：insert into  OPENROWSET('Microsoft.Jet.OLEDB.4.0',    'C:\db.mdb';'admin';'', Test) select id,name from Test  INSERT INTO OPENROWSET('Microsoft.Jet.OLEDB.4.0', 'c:\trade.mdb'; 'admin'; '', 表名)SELECT *FROM sqltablename-------------------------------------------------------------------------------------------------     二、           SQL SERVER 和EXCEL的数据导入导出 1、在SQL SERVER里查询Excel数据:-- ======================================================SELECT * FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0','Data Source="c:\book1.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...[Sheet1$] 下面是个查询的示例，它通过用于 Jet 的 OLE DB 提供程序查询 Excel 电子表格。SELECT * 
FROM OpenDataSource ( 'Microsoft.Jet.OLEDB.4.0',
  'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions
------------------------------------------------------------------------------------------------- 2、将Excel的数据导入SQL server :-- ======================================================SELECT * into newtableFROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',  'Data Source="c:\book1.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...[Sheet1$] 实例:SELECT * into newtableFROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',  'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions------------------------------------------------------------------------------------------------- 3、将SQL SERVER中查询到的数据导成一个Excel文件-- ======================================================T-SQL代码：EXEC master..xp_cmdshell 'bcp 库名.dbo.表名out c:\Temp.xls -c -q -S"servername" -U"sa" -P""'参数：S 是SQL服务器名；U是用户；P是密码说明：还可以导出文本文件等多种格式 实例:EXEC master..xp_cmdshell 'bcp saletesttmp.dbo.CusAccount out c:\temp1.xls -c -q -S"pmserver" -U"sa" -P"sa"'  EXEC master..xp_cmdshell 'bcp "SELECT au_fname, au_lname FROM pubs..authors ORDER BY au_lname" queryout C:\ authors.xls -c -Sservername -Usa -Ppassword' 在VB6中应用ADO导出EXCEL文件代码： Dim cn  As New ADODB.Connectioncn.open "Driver={SQL Server};Server=WEBSVR;DataBase=WebMis;UID=sa;WD=123;"cn.execute "master..xp_cmdshell 'bcp "SELECT col1, col2 FROM 库名.dbo.表名" queryout E:\DT.xls -c -Sservername -Usa -Ppassword'"------------------------------------------------------------------------------------------------- 4、在SQL SERVER里往Excel插入数据:-- ======================================================insert into OpenDataSource( 'Microsoft.Jet.OLEDB.4.0','Data Source="c:\Temp.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...table1 (A1,A2,A3) values (1,2,3) T-SQL代码：INSERT INTO   OPENDATASOURCE('Microsoft.JET.OLEDB.4.0',   'Extended Properties=Excel 8.0;Data source=C:\training\inventur.xls')...[Filiale1$]   (bestand, produkt) VALUES (20, 'Test')  -------------------------------------------------------------------------------------------------总结：利用以上语句，我们可以方便地将SQL SERVER、ACCESS和EXCEL电子表格软件中的数据进行转换，为我们提供了极大方便！

Answer 15

wingedsteed(星蓝) ( ) 信誉：100  2004-06-07 09:02:10Z  得分: 0  
 
 
   /********************** EXCEL导到远程SQL
insert OPENDATASOURCE(
         'SQLOLEDB',
         'Data Source=远程ip;User ID=sa;Password=密码'
         ).库名.dbo.表名 (列名1,列名2)
SELECT 列名1,列名2
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
  'Data Source="c:\test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions
/********************导整个数据库*********************************************/用bcp实现的存储过程
/*
 实现数据导入/导出的存储过程
         根据不同的参数,可以实现导入/导出整个数据库/单个表
 调用示例:
--导出调用示例
----导出单个表
exec file2table 'zj','','','xzkh_sa..地区资料','c:\zj.txt',1
----导出整个数据库
exec file2table 'zj','','','xzkh_sa','C:\docman',1--导入调用示例
----导入单个表
exec file2table 'zj','','','xzkh_sa..地区资料','c:\zj.txt',0
----导入整个数据库
exec file2table 'zj','','','xzkh_sa','C:\docman',0*/
if exists(select 1 from sysobjects where name='File2Table' and objectproperty(id,'IsProcedure')=1)
 drop procedure File2Table
go
create procedure File2Table
@servername varchar(200)  --服务器名
,@username varchar(200)   --用户名,如果用NT验证方式,则为空''
,@password varchar(200)   --密码
,@tbname varchar(500)   --数据库.dbo.表名,如果不指定:.dbo.表名,则导出数据库的所有用户表
,@filename varchar(1000)  --导入/导出路径/文件名,如果@tbname参数指明是导出整个数据库,则这个参数是文件存放路径,文件名自动用表名.txt
,@isout bit      --1为导出,0为导入
as
declare @sql varchar(8000)if @tbname like '%.%.%' --如果指定了表名,则直接导出单个表
begin
 set @sql='bcp '+@tbname
  +case when @isout=1 then ' out ' else ' in ' end
  +' "'+@filename+'" /w'
  +' /S '+@servername
  +case when isnull(@username,'')='' then '' else ' /U '+@username end
  +' /P '+isnull(@password,'')
 exec master..xp_cmdshell @sql
end
else
begin --导出整个数据库,定义游标,取出所有的用户表
 declare @m_tbname varchar(250)
 if right(@filename,1)<>'\' set @filename=@filename+'\' set @m_tbname='declare #tb cursor for select name from '+@tbname+'..sysobjects where xtype=''U'''
 exec(@m_tbname)
 open #tb
 fetch next from #tb into @m_tbname
 while @@fetch_status=0
 begin
  set @sql='bcp '+@tbname+'..'+@m_tbname
   +case when @isout=1 then ' out ' else ' in ' end
   +' "'+@filename+@m_tbname+'.txt " /w'
   +' /S '+@servername
   +case when isnull(@username,'')='' then '' else ' /U '+@username end
   +' /P '+isnull(@password,'')
  exec master..xp_cmdshell @sql
  fetch next from #tb into @m_tbname
 end
 close #tb
 deallocate #tb 
end
go
/************* Oracle **************/
EXEC sp_addlinkedserver 'OracleSvr', 
   'Oracle 7.3', 
   'MSDAORA', 
   'ORCLDB'
GOdelete from openquery(mailser,'select *  from yulin')select *  from openquery(mailser,'select *  from yulin')update openquery(mailser,'select * from  yulin where id=15')set disorder=555,catago=888insert into openquery(mailser,'select disorder,catago from  yulin')values(333,777) 补充：对于用bcp导出,是没有字段名的.用openrowset导出,需要事先建好表.
  
 

Answer 16

'如果表不存在:
'ADO.Execute "select * into table1 from [Text;database=c:\].test.txt"
'如果表存在:
'ADO.Execute "insert into table1 select * from [Text;database=c:\].test.txt"
'文本文件中第一行为字段名
access导出excell
 'conn.Execute "SELECT * INTO [Excel 8.0;DATABASE=" & App.Path & "\111.xls].[WorkSheet1] FROM newtable"
excell导出access
'如果表存在:
'conn.Execute "insert into [123] select * from [Excel 8.0;database=D:111.xls].[WorkSheet1]"
'如果表不存在:
conn.Execute "SELECT * INTO newtable from [Excel 8.0;database=D:\111.xls].[WorkSheet1]"
删除
Kill App.Path & "\111.xls"

Answer 17

Function readline(txtpath As String, linenum As Integer) As String '读取指定行
 Dim filetxt As String, x As Variant, i As Integer
     filetxt = String(FileLen(txtpath), " ")
     Open txtpath For Binary As 1
     Get #1, , filetxt
     Close 1
     x = Split(filetxt, vbCrLf)
     MsgBox "该文件一共 " & UBound(x) + 1 & " 行" '返回行数
  If linenum > UBound(x) Then MsgBox "行溢出", 64, "err!": Exit Function
  If linenum <= UBound(x) Then readline = x(linenum - 1)
Set x = Nothing
End FunctionSub writeline(txtpath As String, linenum As Integer, mystr As String)  '修改指定行内容为MYSTR
 Dim filetxt As String, x As Variant, i As Integer
     filetxt = String(FileLen(txtpath), " ")
     Open txtpath For Binary As 1
     Get #1, , filetxt
     Close 1
     x = Split(filetxt, vbCrLf)
  If linenum > UBound(x) Then MsgBox "行溢出", 64, "err!": Exit Sub
  If linenum <= UBound(x) Then x(linenum - 1) = mystr
  Open txtpath For Binary As 1
  put #1, , Join(x, vbCrLf)
  Close 1
Set x = Nothing
End SubPrivate Sub Command1_Click()
MsgBox readline("C:\XXX.TXT", 120) '第120行内容
writeline "C:\XXX.TXT", 120, "123456" '修改该行内容为"123456"
End Sub