home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 2005 June (DVD) / DPPRO0605DVD.iso / Extras / TextPipe / textpipepro-cr.exe / {app} / database / database example.vbs < prev    next >
Encoding:
Text File  |  2002-07-11  |  3.7 KB  |  170 lines
  1. 'create a database table and insert records
  2.  
  3.   option explicit
  4.  
  5.   Dim DBConnection
  6.  
  7.   const adStateOpen = 1
  8.   const adOpenDynamic = 2
  9.   const adLockOptimistic = 3
  10.   const adCmdTable = 2
  11.  
  12.  
  13. function processLine(line, EOL)
  14.   'insert each line into the table
  15.  
  16.   Dim s, DBORecord
  17.  
  18.   on error resume next
  19.  
  20.   'split out each line into recno, lastname, firstname, address1 based on commas
  21.   s = split( line, "," )
  22.  
  23.   clearErrors
  24.   Set DBORecord = CreateObject("ADODB.Recordset")
  25.   DBORecord.Open "table1", DBConnection, adOpenDynamic, adLockOptimistic, adCmdTable
  26.   DBORecord.AddNew
  27.   DBORecord("recno") = s(0)
  28.   DBORecord("lastname") = s(1)
  29.   DBORecord("firstname") = s(2)
  30.   DBORecord("address1") = s(3)
  31. '  DBORecord.AddNew Array("recno", "lastname", "firstname", "address1"), Array( s(0), s(1), s(2), s(3) )
  32.  
  33.   if wasError() then
  34.     reportErrors "Can't insert record"
  35.   end if
  36.  
  37.   DBORecord.Update
  38.   DBORecord.Close
  39.  
  40.   processLine = "Inserted " & line & EOL
  41.   set DBORecord = Nothing
  42.  
  43. end function
  44.  
  45.  
  46. sub startJob()
  47.  
  48.   on error resume next
  49.  
  50.   clearErrors
  51.     
  52.   msgBox "Opening database connection - using " & GetScriptEngineInfo
  53.  
  54.   Set DBConnection = CreateObject("ADODB.Connection")
  55.   DBConnection.connectionString = "Data Source='Crystal';"
  56.   DBConnection.ConnectionTimeout = 30
  57.   DBConnection.open 
  58.  
  59.   if DBConnection.State <> adStateOpen then
  60.     reportErrors "Can't connect to data source 'Crystal'" 
  61.   end if
  62.  
  63.   msgBox "Creating the table1 table" 
  64.   DBConnection.Execute("CREATE TABLE table1 (recno char(5), lastname char(20), firstname char(20), address1 char(20) )")
  65.   if wasError() then
  66.     msgBox "Can't create table table1" 
  67.     clearErrors
  68.   else
  69.     msgBox "Table table1 created successfully"
  70.   end if
  71.  
  72. end sub
  73.  
  74.  
  75. sub endJob()
  76.  
  77.   on error resume next
  78.  
  79.   'end of script, drop table
  80.   msgBox "Dropping table table1" 
  81.   DBConnection.Execute("DROP TABLE table1")
  82.   if wasError() then
  83.     reportErrors "Can't drop table table1"
  84.   else
  85.     msgBox "Table table1 dropped successfully"
  86.   end if
  87.  
  88.   msgBox "Closing the connection" 
  89.   'close the connection
  90.   DBConnection.Close
  91.   reportErrors "Couldn't close connection"
  92.   set DBConnection = Nothing
  93.  
  94. end sub
  95.  
  96.  
  97. function startFile()
  98.   startFile = ""
  99. end function
  100.  
  101.  
  102. function endFile()
  103.   endFile = ""
  104. end function
  105.  
  106.  
  107. function wasError()
  108.  
  109.   wasError = (Err.Number <> 0) or (DBConnection.Errors.count <> 0)
  110.  
  111. end function
  112.  
  113.  
  114. sub clearErrors()
  115.  
  116.   'clear all messages first
  117.   if (Err.Number <> 0) then
  118.     Err.clear
  119.   End if
  120.  
  121.   if DBConnection <> null then
  122.     DBconnection.errors.clear
  123.   end if
  124.  
  125. end sub
  126.  
  127.  
  128. Function GetScriptEngineInfo
  129.    Dim s
  130.    s = ""   ' Build string with necessary info.
  131.    s = ScriptEngine & " Version "
  132.    s = s & ScriptEngineMajorVersion & "."
  133.    s = s & ScriptEngineMinorVersion & "."
  134.    s = s & ScriptEngineBuildVersion 
  135.    GetScriptEngineInfo = s   ' Return the results.
  136. End Function
  137.  
  138.  
  139. sub reportErrors( ErrorDescription )
  140.  
  141.   dim X
  142.  
  143.   If (Err.Number <> 0) or (DBConnection.Errors.count <> 0) Then
  144.     msgBox ErrorDescription
  145.  
  146.     If (Err.Number <> 0) then
  147.       MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description
  148.       Err.clear
  149.     End if
  150.  
  151.     For Each X In DBConnection.Errors        
  152.       msgBox "DBError: " & X.Description 
  153.     Next    
  154.     DBConnection.Errors.clear
  155.  
  156.     Exit Sub
  157.   End If
  158.  
  159. end sub
  160.     
  161.  
  162. 'use this code for testing inside a separate .vbs file
  163. startJob
  164. startFile()
  165. msgBox processLine("100,Carter,Simon,Woodbine Court", chr(13) & chr(10) )
  166. msgBox processLine("101,Carter,Simon,Woodbine Court", chr(13) & chr(10) )
  167. msgBox processLine("102,Carter,Simon,Woodbine Court", chr(13) & chr(10) )
  168. endFile()
  169. endJob
  170.