/******************************************************************/ /* Document : VB6, VBscript and VB.NET code examples */ /* Doc. Versie : 20 */ /* File : vb.txt */ /* Date : 28-02-2005 */ /* Content : just a series of SIMPLE VB & vbscript examples */ /* Compiled by : Albert */ /******************************************************************/ Part I deals with VBSCRIPT Part II deals with VB6 Part III deals with VB.NET #################################################################### #################################################################### PART I: VBSCRIPT: #################################################################### #################################################################### 1. Introduction: ================ What is VBScript? -VBScript is a scripting language -A scripting language is a lightweight programming language -VBScript is a light version of Microsoft's programming language Visual Basic How Does it Work? When a VBScript is inserted into a HTML document, the Internet browser will read the HTML and interpret the VBScript. The VBScript can be executed immediately, or at an event that occurs later. Scripting languages, like JavaScript and VBScript, are designed as an extension to HTML. The web browser receives scripts along with the rest of the web document. It is the browser's responsibility to parse and process the scripts. HTML was extended to include a tag that is used to incorporate scripts into HTML-the

VBScript Test

Comment: You see that in order to support the really old browsers we have put the statements between comment tags . example 2: new style: ---------------------

A sub procedure does not return a result.

To insert a script in an HTML document, use the Some info about HTML Forms: =========================== Study the example below to see some fundamental HTML form controls: HEAD> Intranet Time Away From Work

Intranet Time-Away-From-Work Form


Your Name:      

E-mail address: 

Dates Absent:   

Special Notes:

Type of Absence: Holiday Vacation Sick Leave of Absence With Pay

Your Department:

This document last modified: April 20, 1996
By Scott Zimmerman
e-mail: scottz@sd.znet.com
3. SIMPLE FORMS AND VBSCRIPT: ============================= example 1: ---------- Working With VBScript: Exercise 1

Your First VBScript Exercise

By utilizing VBScript you can give your Web pages actions. Click on the button below to see what we mean.

example 2: A better approach for example 1: ------------------------------------------- Working With VBScript: Exercise 1

Your First VBScript Exercise

By utilizing VBScript you can give your Web pages actions. Click on the button below to see what we mean.

Now we have used a sub-procedure called cmdClickMe_OnClick. This will be executed any time that the control cmdClickMe is clicked. This type of procedure is referred to as an event procedure. The event is the user clicking the button. 4. USING VARIABLES: =================== A variable is a named location in computer memory that you can use for storage of data during the execution of your scripts. You can use variables to: -Store input from the user gathered via your web page -Save data returned from functions -Hold results from calculations - Declare a variable: Dim Name - Assigning values: Variable_name = value Name = "Larry Roof" HoursWorked = 50 Overtime = True The VBScript language provides support for arrays. You declare an array using the Dim statement, just as you did with variables: Dim States(50) The statement above creates an array with 51 elements. Why 51? Because VBScript arrays are zero-based, meaning that the first array element is indexed 0 and the last is the number specified when declaring the array. Example 1: ---------- Working With VBScript: Exercise 1

Your First VBScript Exercise

By utilizing VBScript you can give your Web pages actions. Click on the button below to see what we mean.

Example 2: ---------- Working With VBScript: Exercise 2

Your Second VBScript Exercise

Variables can be used to store and manipulate values. To see a demonstration of this enter a quantity and unit price in the fields below and click the "Calculate Cost" button.

Quantity:
Unit price:

Comments: 1. Chr() is a VBScript function that returns the character associated with a specified ASCII code. ASCII codes 13, 10 and 9 are carriage return, line feed and tab, respectively. CRLF = Chr(13) & Chr(10) TABSPACE = Chr(9) 2. The form was named frmExercise2. Here we are referencing our web document, then the form, then the input field and finally the value of that field. The value associated with each field contains what the user entered into that field on the web page. The * says to multiply the value of the first field, txtQuantity, by the second field, txtUnitPrice. 5. SCRIPT FLOW AND LOOPS: ========================= Simple examples IF: ------------------- if i=10 Then msgbox "Hello" if i=10 Then msgbox "Hello" i = i+1 end If if i=10 then msgbox "Hello" else msgbox "Goodbye" end If if payment="Cash" then msgbox "You are going to pay cash!" elseif payment="Visa" then msgbox "You are going to pay with visa." elseif payment="AmEx" then msgbox "You are going to pay with American Express." else msgbox "Unknown method of payment." end If Simple examples SELECT CASE: ---------------------------- select case payment case "Cash" msgbox "You are going to pay cash" case "Visa" msgbox "You are going to pay with visa" case "AmEx" msgbox "You are going to pay with American Express" case Else msgbox "Unknown method of payment" end select Simple examples FOR..NEXT or Do While: -------------------------------------- dim names(2) names(0)="Tove" names(1)="Jani" names(2)="Hege" For Each x in names document.write(x & "
") Next Dim x(10) For i=1 to 10 x(i)=i*10 Next Do While i>10 some code Loop 6. OBJECTS: =========== - standard - intrinsic html: controls such as buttons, textboxes on forms - ActiveX controls - Java applets 6.1 Assigning names to controls: -------------------------------- To use an object in client-side script, you must first create the object and then assign a name to it. You use this object name to create event procedures and to access the properties and methods of the object. The syntax for assigning names varies slightly for different types of objects. Standard HTML Controls: ----------------------- To assign a name to a standard HTML control, you set the NAME attribute. example: Now you can write eventprocedures for this control like Sub cmdValidateOrder_OnClick -- code End Sub ActiveX Controls: ----------------- To assign a name to an ActiveX control, you set the ID attribute of the tag. example: Java Applets: ------------- To assign a name to a Java applet control, you set the NAME attribute of the tag. 7. VBScript and DTS: ==================== Suppose we need to load data from one table, or other source like a textfile, into a table in a SQL Server database, with DTS. Suppose a limited form of data transformation is needed. You might use VBScript to accomplish this, as in the following simple example: Function Main() Dim strFullName Dim intLoc ' Copy most of the fields directly: DTSDestination("customer-id")=DTSSource("Cust-Num") DTSDestination("Country")=DTSSource("Country") DTSDestination("Name")=DTSSource("Name") DTSDestination("City")=DTSSource("City") 'etc ' Now split the ContactName into firstname and lastname fields: strFullName=DTSSource("Contact") intLoc=InstrRev(strFullName," ") 'looking for a space If intLoc <> 0 Then DTSDestination("ContactFname")=Left(strFullName, intLoc) DTSDestination("ContactLname")=Mid(strFullName, intLoc+1) End If Main=1 DTSDestination("customer-id")=DTSSource("Cust-Num") DTSDestination("customer-id")=DTSSource("Cust-Num") 8. FORM VALIDATION: =================== Form validation involves checking if the required information is provided by the user. We can make sure to see if a field is empty, figure out type of value provided, count number of characters or value, can check if special character(s) is present and more. Here is a syntax for checking a field value. if form.name.value="" then msgbox"Please enter name". This checks if the name field is empty and informs the user. if len(form.name.value) < 2 or len(form.txtname.value)>50 then msgbox "Too short or too long". This checks if the lenth of the value provided is less than 2 characters or more than 50 characters and if so prompts message. if instr(form.txtemail.value,"@") = 0 then msgbox("Invalid e-mail"). This checks if @ is present and prompts message if not. if (Not (IsNumeric(form.txtage.value)) then msgbox"Invalid age". This check if the value is not numeric and prompts message if so. To check if it's numeric, do not specify NOT before IsNumeric. form.txtage.focus . This put focus in the text box, age. form.txtage.select . This highlights the text in the text box. 9. SOME MORE EXAMPLES: ====================== Example 1: replace text ----------------------- Example 2: trim spaces ---------------------- Example 3: display date and time -------------------------------- Example 4: format the date --------------------------

Syntax for FormatDateTime: FormatDateTime(date,namedformat).

Example 5: ---------- Example 6: Sort a 100 random numbers: ------------------------------------- Sorting an Array

Sorting an Array

Click the Generate button to generate 100 random numbers in the text box on the left. Then click the Sort button to sort these numbers and put them in the text box on the right.

The University of Southern California does not screen or control the content on this website and thus does not guarantee the accuracy, integrity, or quality of such content. All content on this website is provided by and is the sole responsibility of the person from which such content originated, and such content does not necessarily reflect the opinions of the University administration or the Board of Trustees
Example 7: date function ------------------------ DatePart function is a very useful function to get the a part of a date. You may get year, month, day of year .. etc. of a specific date. An Example : Function GetYear(strDate) GetYear = DatePart("yyyy", strDate) End Function Some of settings can be used with DatePart function : yyyy : Year q : Quarter m : Month y : Day of year d : Day w : Weekday ww : Week of year h : Hour n : Minute s : Second 10 WRITE TO FILES: ================== Dim objFile, strGuyFile, strFilePath strFilePath = "e:\ezine\strGuyFile.txt" Set objFile = CreateObject("Scripting.FileSystemObject") Set strGuyFile = objFile.CreateTextFile(strFilePath, True) strGuyFile.WriteLine("This was made using VBScript.") strGuyFile.Close Creating Files There are three ways to create an empty text file (sometimes referred to as a "text stream"). The first way is to use the CreateTextFile method. The following example demonstrates how to create a text file using the CreateTextFileMethod method. [VBScript] Dim fso, f1 Set fso = CreateObject("Scripting.FileSystemObject") Set f1 = fso.CreateTextFile("c:\testfile.txt", True) [JScript] var fso, f1; fso = new ActiveXObject("Scripting.FileSystemObject"); f1 = fso.CreateTextFile("c:\\testfile.txt", true); The second way to create a text file is to use the OpenTextFile method of the FileSystemObject object with the ForWriting flag set. [VBScript] Dim fso, ts Const ForWriting = 2 Set fso = CreateObject("Scripting. FileSystemObject") Set ts = fso.OpenTextFile("c:\test.txt", ForWriting, True) [JScript] var fso, ts; var ForWriting= 2; fso = new ActiveXObject("Scripting.FileSystemObject"); ts = fso.OpenTextFile("c:\\test.txt", ForWriting, true); A third way to create a text file is to use the OpenAsTextStream method with the ForWriting flag set. [VBScript] Dim fso, f1, ts Const ForWriting = 2 Set fso = CreateObject("Scripting.FileSystemObject") fso.CreateTextFile ("c:\test1.txt") Set f1 = fso.GetFile("c:\test1.txt") Set ts = f1.OpenAsTextStream(ForWriting, True) [JScript] var fso, f1, ts; var ForWriting = 2; fso = new ActiveXObject("Scripting.FileSystemObject"); fso.CreateTextFile ("c:\\test1.txt"); f1 = fso.GetFile("c:\\test1.txt"); ts = f1.OpenAsTextStream(ForWriting, true); Adding Data to the File Once the text file is created, add data to the file using the following three steps: Open the text file. Write the data. Close the file. To open an existing file, use either the OpenTextFile method of the FileSystemObject object or the OpenAsTextStream method of the File object. To write data to the open text file, use the Write, WriteLine, or WriteBlankLines methods of the TextStream object, according to the tasks outlined in the following table. Task Method Write data to an open text file without a trailing newline character. Write Write data to an open text file with a trailing newline character. WriteLine Write one or more blank lines to an open text file. WriteBlankLines To close an open file, use the Close method of the TextStream object. Note The newline character contains a character or characters (depending on the operating system) to advance the cursor to the beginning of the next line (carriage return/line feed). Be aware that the end of some strings may already have such nonprinting characters. The following example demonstrates how to open a file, use all three write methods to add data to the file, and then close the file: [VBScript] Sub CreateFile() Dim fso, tf Set fso = CreateObject("Scripting.FileSystemObject") Set tf = fso.CreateTextFile("c:\testfile.txt", True) ' Write a line with a newline character. tf.WriteLine("Testing 1, 2, 3.") ' Write three newline characters to the file. tf.WriteBlankLines(3) ' Write a line. tf.Write ("This is a test.") tf.Close End Sub [JScript] function CreateFile() { var fso, tf; fso = new ActiveXObject("Scripting.FileSystemObject"); tf = fso.CreateTextFile("c:\\testfile.txt", true); // Write a line with a newline character. tf.WriteLine("Testing 1, 2, 3.") ; // Write three newline characters to the file. tf.WriteBlankLines(3) ; // Write a line. tf.Write ("This is a test."); tf.Close(); } Reading Files To read data from a text file, use the Read, ReadLine, or ReadAll method of the TextStream object. The following table describes which method to use for various tasks. Task Method Read a specified number of characters from a file. Read Read an entire line (up to, but not including, the newline character). ReadLine Read the entire contents of a text file. ReadAll If you use the Read or ReadLine method and want to skip to a particular portion of data, use the Skip or SkipLine method. The resulting text of the read methods is stored in a string which can be displayed in a control, parsed by string functions (such as Left, Right, and Mid), concatenated, and so forth. The following example demonstrates how to open a file, write to it, and then read from it: [VBScript] Sub ReadFiles Dim fso, f1, ts, s Const ForReading = 1 Set fso = CreateObject("Scripting.FileSystemObject") Set f1 = fso.CreateTextFile("c:\testfile.txt", True) ' Write a line. Response.Write "Writing file
" f1.WriteLine "Hello World" f1.WriteBlankLines(1) f1.Close ' Read the contents of the file. Response.Write "Reading file
" Set ts = fso.OpenTextFile("c:\testfile.txt", ForReading) s = ts.ReadLine Response.Write "File contents = '" & s & "'" ts.Close End Sub [JScript] function ReadFiles() { var fso, f1, ts, s; var ForReading = 1; fso = new ActiveXObject("Scripting.FileSystemObject"); f1 = fso.CreateTextFile("c:\\testfile.txt", true); // Write a line. Response.Write("Writing file
"); f1.WriteLine("Hello World"); f1.WriteBlankLines(1); f1.Close(); // Read the contents of the file. Response.Write("Reading file
"); ts = fso.OpenTextFile("c:\\testfile.txt", ForReading); s = ts.ReadLine(); Response.Write("File contents = '" + s + "'"); ts.Close(); } Moving, Copying, and Deleting Files The FSO object model has two methods each for moving, copying, and deleting files, as described in the following table. Task Method Move a file File.Move or FileSystemObject.MoveFile Copy a file File.Copy or FileSystemObject.CopyFile Delete a file File.Delete or FileSystemObject.DeleteFile The following example creates a text file in the root directory of drive C, writes some information to it, moves it to a directory called \tmp, makes a copy of it in a directory called \temp, then deletes the copies from both directories. To run the following example, create directories named \tmp and \temp in the root directory of drive C: [VBScript] Sub ManipFiles Dim fso, f1, f2, s Set fso = CreateObject("Scripting.FileSystemObject") Set f1 = fso.CreateTextFile("c:\testfile.txt", True) Response.Write "Writing file
" ' Write a line. f1.Write ("This is a test.") ' Close the file to writing. f1.Close Response.Write "Moving file to c:\tmp
" ' Get a handle to the file in root of C:\. Set f2 = fso.GetFile("c:\testfile.txt") ' Move the file to \tmp directory. f2.Move ("c:\tmp\testfile.txt") Response.Write "Copying file to c:\temp
" ' Copy the file to \temp. f2.Copy ("c:\temp\testfile.txt") Response.Write "Deleting files
" ' Get handles to files' current location. Set f2 = fso.GetFile("c:\tmp\testfile.txt") Set f3 = fso.GetFile("c:\temp\testfile.txt") ' Delete the files. f2.Delete f3.Delete Response.Write "All done!" End Sub [JScript] function ManipFiles() { var fso, f1, f2, s; fso = new ActiveXObject("Scripting.FileSystemObject"); f1 = fso.CreateTextFile("c:\\testfile.txt", true); Response.Write("Writing file
"); // Write a line. f1.Write("This is a test."); // Close the file to writing. f1.Close(); Response.Write("Moving file to c:\\tmp
"); // Get a handle to the file in root of C:\. f2 = fso.GetFile("c:\\testfile.txt"); // Move the file to \tmp directory. f2.Move ("c:\\tmp\\testfile.txt"); Response.Write("Copying file to c:\\temp
"); // Copy the file to \temp. f2.Copy ("c:\\temp\\testfile.txt"); Response.Write("Deleting files
"); // Get handles to files' current location. f2 = fso.GetFile("c:\\tmp\\testfile.txt"); f3 = fso.GetFile("c:\\temp\\testfile.txt"); // Delete the files. f2.Delete(); f3.Delete(); Response.Write("All done!"); } #################################################################### #################################################################### PART II: VB6 #################################################################### #################################################################### Remark: Most of the time you will create a form associated with your program. To close you program: make a Quit or Exit button on your form with the following eventcode: Private Sub btnQuit_Click() End End Sub ================================================ 1. Call a SQL Server stored procedure with ADO: ================================================ Example 1: call a stored procedure, no parameters ------------------------------------------------- To call a SQL Server stored procedure, for example "set_bezig", from VB, use code like: Private Sub Command1_Click() Dim oConn Dim oCmd Dim oRs Dim tmpBody Set oConn = CreateObject("ADODB.Connection") oConn.Open ("DATABASE=aida;DSN=MDB;UID=karel;Password=karel;") Set oCmd = CreateObject("ADODB.Command") oCmd.ActiveConnection = oConn oCmd.CommandText = "exec set_bezig" oCmd.CommandType = 1 oCmd.Prepared = True Set oRs = oCmd.Execute Set oRs = Nothing Set oCmd = Nothing Set oConn = Nothing End Sub The procedure "set_bezig" in the above example, does something, and in this case we do not need to pass parameter. So "set_bezig" could for example be as simple as create procedure set_bezig as update CLR_ADMIN set BEZIG='J' GO Example 2: call a stored procedure with parameters -------------------------------------------------- Suppose you have a form, with a Textbox and a Command button. In the textbox, a name can be filled in, and this must go to a table in SQL server. So now we use a stored procedure "fill_y", which takes a parameter. Private Sub Command1_Click() Dim oConn Dim oCmd Dim oRs Dim tmpBody Dim name As String name = txtInput.Text Set oConn = CreateObject("ADODB.Connection") oConn.Open ("DATABASE=test;DSN=MDB;UID=klaas;Password=klaas;") Set oCmd = CreateObject("ADODB.Command") oCmd.ActiveConnection = oConn oCmd.CommandText = "exec fill_y " & name oCmd.CommandType = 1 oCmd.Prepared = True Set oRs = oCmd.Execute Set oRs = Nothing Set oCmd = Nothing Set oConn = Nothing End Sub create procedure fill_y @name varchar(10) as insert sales (name) values (@name) go ================================================ 2. Call a SQL Server stored procedure with RDO: ================================================ Private Sub Command1_Click() Dim rs As rdoResultset Dim cn As New rdoConnection Dim qd As New rdoQuery Dim cl As rdoColumn cn.Connect = "uid=sa;pwd=;server=MyServer;" _ & "driver={SQL Server};database=pubs;" _ & "DSN='ABC';" cn.CursorDriver = rdUseOdbc cn.EstablishConnection rdDriverNoPrompt Set qd.ActiveConnection = cn qd.SQL = "{ ? = call dbo.ByRoyalty (?) }" qd(0).Direction = rdParamReturnValue qd(1).Direction = rdParamInput qd.rdoParameters(1) = 100 Set rs = qd.OpenResultset(rdOpenForwardOnly, rdConcurReadOnly) For Each cl In rs.rdoColumns Debug.Print cl.Name, Next Debug.Print Do Until rs.EOF For Each cl In rs.rdoColumns Debug.Print cl.Value, Next rs.MoveNext Debug.Print Loop rs.Close qd.Close cn.Close End Sub ============================ 3. Call an Oracle procedure: ============================ Suppose we have the following simple tables: create table sales1 ( cust_name varchar2(10) ); create table sales2 ( cust_id number, cust_name varchar2(10) ); Suppose we have the following simple procedures, which fills a table: create or replace procedure ins_sales2 as begin insert into sales2 values (1,'Joop'); end; / create or replace procedure ins_sales1_parm (cust_name in varchar2) as begin insert into sales1 values (cust_name); end; / Example: Call a Oracle procedure without parameters with ADO: ------------------------------------------------------------- Suppose we create a DSN with the Oracle ODBC driver: Private Sub Command1_Click() Dim oConn Dim oCmd Dim oRs Dim tmpBody Set oConn = CreateObject("ADODB.Connection") oConn.Open ("DATABASE=o901;DSN=MISKM;UID=mis_owner;Password=mis_owner;") Set oCmd = CreateObject("ADODB.Command") oCmd.ActiveConnection = oConn oCmd.CommandText = "ins_sales2" 'oCmd.CommandType = 1 'oCmd.Prepared = True Set oRs = oCmd.Execute Set oRs = Nothing Set oCmd = Nothing Set oConn = Nothing End Sub Example: Call an Oracle procedure with parameters with ADO: ---------------------------------------------------------- Suppose we have a simple procedure, which fills a table: Private Sub Command1_Click() Dim oConn Dim oCmd Dim oRs Dim tmpBody Dim cust_name As String Set oConn = CreateObject("ADODB.Connection") oConn.Open ("DATABASE=o901;DSN=MISKM;UID=mis_owner;Password=mis_owner;") Set oCmd = CreateObject("ADODB.Command") oCmd.ActiveConnection = oConn oCmd.CommandText = "ins_sales_parm" 'objCmd.CommandText = "{ CALL Employees.GetEmpRecords(?,?) }" 'oCmd.CommandType = 1 'oCmd.Prepared = True Set oRs = oCmd.Execute Set oRs = Nothing Set oCmd = Nothing Set oConn = Nothing End Sub Example: Call an Oracle procedure with parameters with RDO: ----------------------------------------------------------- CREATE TABLE rdooracle ( item_number NUMBER(3) PRIMARY KEY, depot_number NUMBER(3) ); CREATE OR REPLACE PROCEDURE rdoinsert (insnum IN NUMBER, outnum OUT NUMBER) IS BEGIN INSERT INTO rdooracle (Item_Number, Depot_Number) VALUES (insnum, 16); outnum := insnum/2; END; -- add a reference to Microsoft Remote Dataobjects msrdo20.dll -- create a form like: Control Name Text/Caption --------------------------------- Button cmdCheck Check Button cmdSend Send Text Box txtInput Label lblInput Input: -- Code: Option Explicit Dim Cn As rdoConnection Dim En As rdoEnvironment Dim CPw As rdoQuery Dim Rs As rdoResultset Dim Conn As String Dim QSQL As String Dim Response As String Dim Prompt As String Private Sub cmdCheck_Click() QSQL = "Select Item_Number, Depot_Number From rdooracle Where " _ & "item_number =" & txtInput.Text Set Rs = Cn.OpenResultset(QSQL, rdOpenStatic, , rdExecDirect) Prompt = "Item_Number = " & Rs(0) & ". Depot_Number = " _ & Rs(1) & "." Response = MsgBox(Prompt, , "Query Results") Rs.Close End Sub Private Sub cmdSend_Click() CPw(0) = Val(txtInput.Text) CPw.Execute Prompt = "Return value from stored procedure is " & CPw(1) & "." Response = MsgBox(Prompt, , "Stored Procedure Result") End Sub Private Sub Form_Load() Conn = "UID=mis_owner;PWD=mis_owner;driver={Microsoft ODBC voor Oracle};" _ & "CONNECTSTRING=o901;" Set En = rdoEnvironments(0) Set Cn = En.OpenConnection("", rdDriverPrompt, False, Conn) QSQL = "{call rdoinsert(?,?)}" Set CPw = Cn.CreateQuery("", QSQL) End Sub Private Sub Form_Unload(Cancel As Integer) En.Close End Sub ====================== 4. VB AND COM or DCOM: ====================== Creating Objects, Local and Remote. ----------------------------------- One of the most basic requirements of a distributed system is the ability to create components. In the COM world, object classes are named with globally unique identifiers, or GUIDs. When GUIDs are used to refer to particular classes of objects, they are called Class IDs. These Class IDs are nothing more than fairly large integers (128 bits) that provide a collision free, decentralized namespace for object classes. If a COM programmer wants to create a new object, he or she calls one of several functions in the COM libraries. -CoCreateInstance(Ex) () Creates an interface pointer to an uninitialized instance of the object class. -CoGetInstanceFromFile Creates a new instance and initializes it from a file. -CoGetInstanceFromIStorage Creates a new instance and initializes it from storage. -CoGetClassObject () Returns an interface pointer to a "class factory object" that can be used to create one or more uninitialized instances of the object class . -CoGetClassObjectFromURL Returns an interface pointer to a "class factory object" for a given class. If no class is specified, this function will choose the appropriate class for a specified MIME type. If the desired object is installed on the system, it is instantiated. Otherwise, the necessary code is downloaded and installed from a specified URL. The COM libraries look up the appropriate binary code (dynamic-link library or executable) in the system registry, create the object, and return an interface pointer to the caller. For DCOM, the object creation mechanism in the COM libraries is enhanced to allow object creation on other machines. In order to be able to create a remote object, the COM libraries need to know the network name of the server. Once the server name and the CLSID are known, a portion of the COM libraries called the Service Control Manager, or SCM, on the client machine connects to the SCM on the server machine and requests creation of the object. DCOM provides two fundamental mechanisms for allowing clients to indicate the remote server name when an object is created. The remote server name can be indicated: - As a fixed configuration in the system registry or in the DCOM Class Store. - As an explicit parameter to CoCreateInstanceEx, CoGetInstanceFromFile, CoGetInstanceFromStorage, or CoGetClassObject. External RemoteServerName configuration --------------------------------------- The first mechanism, indicating the remote server name as a fixed configuration, is extremely useful for maintaining location transparency: clients need not know whether a component is running locally or remotely. When the remote server name is made part of the server component's configuration information on the client machine, clients do not have to maintain or obtain the server location. All a client ever needs to know is the CLSID of the component. It simply calls CoCreateInstance (or CreateObject in Visual Basic®, or "new" in Java), and the COM libraries transparently create the correct component on the preconfigured server. Even existing COM clients that were designed before the availability of DCOM can transparently use remote components using this mechanism. So the familiar "CreateObject" statement in VB can be associated to a more fundamental COM or DCOM functions in the COM libraries. OLE Servers (VB4), ActiveX (VB5) en COM: ---------------------------------------- COM components were known (to some extend) as OLE Servers in VB4 and ActiveX in VB5 environments. Loosely speaking, ActiveX and COM are the same thing. =============================== 5. Examples with queries in VB: =============================== Example 1: ---------- Dim Mydb As Database Dim strSQL As String Set Mydb = CurrentDb strSQL = "UPDATE tblRefuel SET odometer = " & Me!ComboBox & " WHERE VehID = " & Me!VehID Mydb.Execute strSQL Mydb.Close Example 2: ---------- DoCmd.RunSQL is used like this: Dim strSQL As String strSQL = "UPDATE TableName SET FieldName = " & Me.TextBox & " WHERE IDField = " & Me.ControlWithIDValue DoCmd.RunSQL strSQL The DoCmd.RunSQL can ONLY be used with action queries such as INSERT, UPDATE, DELETE, CREATE TABLE, DROP TABLE, TRUNCATE TABLE, etc. You CANNOT use it to return a recordset (i.e. SELECT statement). Example 3: ---------- DoCmd.RunSQL "DELETE FROM tblTest" CurrentDB.Execute "DELETE FROM tblTest" DoCmd.RunSQL "DELETE * FROM Artikel WHERE [Artikel-Nr] = Forms!frmArtikel![Artikel-Nr]" CurrentDB.Execute "DELETE * FROM Artikel WHERE [Artikel-Nr] = " & Forms!frmArtikel![Artikel-Nr] Public Function Beispiel() Dim db As Database Dim qdf As QueryDef Set db = CurrentDb Set qdf = db.QueryDefs("qryAnfügeabfrageMitParameter") qdf.Parameters("Kategorie") = "Neue Kategorie" On Error Resume Next qdf.Execute dbFailOnError If Not Err = 0 Then MsgBox "Fehler: " & Err.Number & vbCrLf & "Fehlerbeschreibung: " & Err.Description End If End Function Example 4: ---------- There are a number of ways to execute a SQL Data Manipulation Language (DML) statement from Microsoft Access, besides the obvious process of creating an Action Query and double-clicking its icon. Understanding your options with respect to executing SQL will make your code cleaner, give you more flexibility and we'll even throw in a great debugging feature as an added bonus. The following article, while not exploring every facet and option, will demonstrate how to execute SQL using the following methods: DoCmd.RunSQL DoCmd.OpenQuery [Querydef].Execute [Database].Execute dbFailOnError Saved Queries verses Embedded SQL For the sake of this discussion, a differentiation will be made between a saved query object in Microsoft Access and a raw SQL statement. When you read the word query in the text below, understand it to be a prepared, saved and tested Querydef object in Microsoft Access. Read SQL to be raw, embedded SQL in the VBA code itself. This becomes important for the following reasons: The RunSQL object cannot execute a saved query The OpenQuery object cannot execute raw SQL The Querydef object requires a saved query The demo download code for this includes a simple form that displays both the actual SQL statements and the VBA code to execute them. The application is designed to stop in debug mode so you may follow the execution in the code module itself. Saved queries are used where necessary but I have used embedded SQL everywhere possible. RunSQL RunSQL is a method of the DoCmd object in Microsoft Access. It is designed for DML SQL, such as UPDATE, INSERT and DELETE statements. You cannot "execute" a SELECT query so the RunSQL method will fail if you attempt to pass a select statement to it. As mentioned above, RunSQL requires the actual SQL statement, not the name of a saved query. The SQL string may be passed as a literal or through a variable, as follows: DoCmd.RunSQL "UPDATE titles SET price = price * 1.10 or ... sSQL = "UPDATE titles SET price = price * 1.10 DoCmd.RunSQL sSQL The effect to the user is the same as if a query object had been double-clicked. If warnings are enabled, the user will be informed of how many records will be affected and given the standard error report in the case of failures. We will discuss errors in more detail shortly. One advantage of this method is that it is a quick, simple way to execute simple SQL updates and deletes. The down side is that some SQL statements, especially inserts, can get very complicated very quickly so the sSQL variable becomes difficult to manage and debug. In addition, if you do not want users to be bothered with the standard Access warning messages, you will have to toggle them off and back on after the procedure. OpenQuery The OpenQuery method solves the first of the above-mentioned problems: knarly SQL statements. It is very easy to create complex INSERT, UPDATE and DELETE queries from the Microsoft Query By Example (QBE) grid and save them as a Querydef object. Once saved, they may be executed using the OpenQuery command of the DoCmd object. DoCmd.OpenQuery "qMkTbl_sales_bkup" This does not, however, address the issue of warnings that require user intervention to complete the query transaction. If you want to be sure that the query runs without the user knowing or being able to terminate, you need to turn off the warnings, like this ... DoCmd.SetWarnings False DoCmd.OpenQuery "qMkTbl_sales_bkup" DoCmd.SetWarnings True Now, there's a slight issue with this approach as well. It assumes that warnings are enabled. What if the user already has them turned off? Well, the above code will turn them on, which could irritate the user. I once wrote some code to determine whether or not warnings were enabled and return the setting to the previous state after executing, but that is extra code, and there's an easier way to handle this issue. Example 5: ---------- Access 2000 and higher: Sub PickRandom() Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field Dim rst As DAO.Recordset Dim strSQL As String Dim strTableName As String Access 97: Sub PickRandom() Dim db As Database Dim tdf As TableDef Dim fld As Field Dim rst As Recordset Dim strSQL As String Dim strTableName As String Code ' 1: Create a new temporary table containing the required fields strSQL = "SELECT tblStaff.Firstname, tblStaff.Lastname " & _ "INTO tblTemp " & _ "FROM tblStaff;" DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True ' 2: Add a new field to the new table Set db = CurrentDb() Set tdf = db.TableDefs("tblTemp") Set fld = tdf.CreateField("RandomNumber", dbSingle) tdf.Fields.Append fld ' 3: Place a random number in the new field for each record Set rst = db.OpenRecordset("tblTemp", dbOpenTable) rst.MoveFirst Do Randomize rst.Edit rst![RandomNumber] = Rnd() rst.Update rst.MoveNext Loop Until rst.EOF rst.Close Set rst = Nothing ' 4: Sort the data by the random number and move the top 25 into a new table strTableName = "tblRandom_" & Format(Date, "ddmmmyyyy") strSQL = "SELECT TOP 25 tblTemp.Firstname, tblTemp.Lastname " & _ "INTO " & strTableName & " " & _ "FROM tblTemp " & _ "ORDER BY tblTemp.RandomNumber;" DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True ' 5: Delete the temporary table db.TableDefs.Delete ("tblTemp") End Sub Example 6: ---------- Discussion from a forum: -- Dim Mydb As Database Dim strSQL As String Set Mydb = CurrentDb strSQL = "UPDATE tblRefuel SET odometer = " & Me!ComboBox & " WHERE VehID = " & Me!VehID Mydb.Execute strSQL Mydb.Close -- -- Accepted Answer from morpheus30 Date: 11/20/2003 07:31PM PST Grade: B Accepted Answer DoCmd.RunSQL is used like this: Dim strSQL As String strSQL = "UPDATE TableName SET FieldName = " & Me.TextBox & " WHERE IDField = " & Me.ControlWithIDValue DoCmd.RunSQL strSQL The DoCmd.RunSQL can ONLY be used with action queries such as INSERT, UPDATE, DELETE, CREATE TABLE, DROP TABLE, TRUNCATE TABLE, etc. You CANNOT use it to return a recordset (i.e. SELECT statement). Assisted Answer from thorkyl Date: 11/21/2003 10:27AM PST Grade: B Assisted Answer -- currentdb.execute ("UPDATE TableName SET FieldName = " & Me.TextBox & " WHERE IDField = " & Me.ControlWithIDValue) and you dont get any warnings or as everyone above -- Just add docmd.setwarnings=false DoCmd.RunSQL strSQL docmd.setwarnings=true DoCmd.RunSQL "CREATE TABLE tblTest ([StaffID] COUNTER CONSTRAINT ndxStaffID PRIMARY KEY, [FirstName] TEXT(25), [LastName] TEXT(30), [BirthDate] DATETIME);” SELECT * INTO x FROM lpars; Example 7: ---------- MS Access 2000 and MS Access 2002 (part of MS Office XP pro) do not allow the MS Access 97 code to work. Specifically, CurrentDb and some of the other commands won't work. Instead, you need something like this. Dim cnn As ADODB.Connection Dim rst1 As New ADODB.Recordset Set cnn = CurrentProject.Connection Query = "Select * from Alias_Details_tbl where Purpose='" & Alias_UICombo & "'" rst1.Open Query, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect Do Until rst1.EOF ' Place your code here str1 = rst1!FieldName Loop rst1.Close This syntax works for queries that don't return a record set. DoCmd.RunSQL "Delete * from Aliases_tbl" ============================== 6. ============================== ================== 7. CODE FRAGMENTS: ================== Fragment 1. Use of Internet Control: ------------------------------------- Navigate to a site: ------------------- Public Explorer As SHDocVw.InternetExplorer Private Sub Command1_Click() On Error GoTo errorhandler Set Explorer=New SHDocVw.InternetExplorer Explorer.Visible=True Explorer.Navigate Combo1.Text Exit Sub errorhandler: MsgBox "Error displaying file", Err.Description End Sub Private Sub Form_Load() Combo1.AddItem "http:/www.antapex.org" Combo1.AddItem "http:/www.abc.com" Combo1.AddItem "http:/www.xyz.com" End Sub Download of a file: ------------------- The two most important things to know about the ITC is that there are two methods of downloading files from a web site - the OpenURL method and the Execute method. Both support the FTP and HTTP file transfer protocols. The OpenURL method is very simple. You put in a file name to download and tell the program whether the file is all text or binary. The code looks for an HTTP transfer of a text file looks like this: text1.text = inet1.OpenURL ("http://www.vbinformation.com/badclick.htm", icString) The code for an HTTP transfer of a binary file looks like this: Dim bData() as Byte bData() = inet1.OpenURL ("http://www.vbinformation.com/badclick.htm", icByteArray) Since all files (text or binary) can be transferred as a binary file, I used the same file name in both examples. Note that in the first case, the downloaded file content is placed in a textbox named 'text1'. In the second case, the downloaded file content is saved i n a Byte array whose upper bound is set by the number of bytes downloaded by the OpenURL method. Also, note that both examples use HTTP URLs, but FTP URLs could have been used just as readily. In case you don't remember, an easy way to save the bData byte array is: Open "filename" for Binary as #1 Put #1, , bData() Close #1 This is really all there is to successfully downloading a file by using the OpenURL method. The second method for downloading a file is the Execute method. inet1.Execute ("ftp://www.microsoft.com", "DIR") This command transfers the directory listing of the Microsoft ftp site. Note than while the OpenURL method returns data to a variable or an array, the Execute method does not! The data returned by the Execute method will either be kept within the ITC's buffer, or be directed to a file according to the specifics of the command it is given. The Execute method actually supports 14 FTP commands (which are placed in the 'operation' argument), but there are primarily three (CD, GET, and PUT) which you will use most often: inet1.Execute ("ftp://www.microsoft.com", "CD newdirectory" inet1.Execute ("ftp://www.microsoft.com", "GET remotefile localfile" inet1.Execute ("ftp://www.microsoft.com", "PUT localfile remotefile" Fragment 2: use of WinApi: -------------------------- AddIn Manager: Api Viewer Public Declare Sub GlobalMemoryStatus Lib "kernel32" _ (lpBuffer As MEMORYSTATUS) Public Declare Function SetEnvironmentVariable Lib "kernel32" _ Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Const SW_SHOWNORMAL = 1 Private Sub mnuHomepage_Click() Dim rc As Long rc = ShellExecute(Me.hwnd, "Open", "http://www.abc-ware.de/",_ "", "", SW_SHOWNORMAL) End Sub Private Sub mnuEMail_Click() Dim rc As Long rc = ShellExecute(Me.hwnd, "Open", _ "mailto:Name@domain.de?Subject=Mathe-Max", "", "", SW_SHOWNORMAL) End Sub Question What is a hWnd and what can it be used for? Code examples for different kinds of usage are welcome. Answer An hWnd is a Handle to a Window if you will. A handle is a long integer generated by the operating system so it can keep track of the all the objects (a form, a command button etc.) You can't set a hwnd at design or runtime, and the value of the handle changes each time the form is opened. Handles are used when you make calls to API functions, the function needs to know the handle of the window, plus other arguements depending on the what the API does. The GetWindowsText API frx: Declare Function GetWindowText Lib "user32" alias _ "GetWindowTextA" (byval Hwnd as long, byval lpstring as _ string, byval cch as long) as Long Assuming the object in question is a form, passing the hwnd of the form to the api will cause a search to performed in windows internal data structures looking for that handle, and then return what text is in the forms title bar or caption. Fragment 3: How to use shell: ----------------------------- Examples: --------- Shell "C:\Program Files\Microsoft Office\Office\Winword.exe " & _ Chr$(34) & "C:\My Documents\Mydoc.doc" & Chr$(34) Shell "c:\project\create_db.bat" Fragment 4: Shell and wait: --------------------------- The ShellAndWait subroutine uses the Shell function to start the other program. It calls the OpenProcess API function to connect to the new process and then uses WaitForSingleObject to wait until the other process terminates. Note that neither the program nor the development environment can take action during this wait. After WaitForSingleObject returns, the ShellAndWait subroutine calls CloseHandle to close the process handle opened by OpenProcess and then exits at which point the program resumes normal execution. ' Start the indicated program and wait for it ' to finish, hiding while we wait. Private Sub ShellAndWait(ByVal program_name As String, _ ByVal window_style As VbAppWinStyle) Dim process_id As Long Dim process_handle As Long ' Start the program. On Error GoTo ShellError process_id = Shell(program_name, window_style) On Error GoTo 0 ' Hide. Me.Visible = False DoEvents ' Wait for the program to finish. ' Get the process handle. process_handle = OpenProcess(SYNCHRONIZE, 0, process_id) If process_handle <> 0 Then WaitForSingleObject process_handle, INFINITE CloseHandle process_handle End If ' Reappear. Me.Visible = True Exit Sub ShellError: MsgBox "Error starting task " & _ txtProgram.Text & vbCrLf & _ Err.Description, vbOKOnly Or vbExclamation, _ "Error" End Sub Or use this: ------------ Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long) Const STILL_ACTIVE = &H103 Const PROCESS_QUERY_INFORMATION = &H400 Private Sub Shell32Bit(ByVal JobToDo As String) Dim hProcess As Long Dim RetVal As Long hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbHide)) Do GetExitCodeProcess hProcess, RetVal DoEvents: Sleep 100 Loop While RetVal = STILL_ACTIVE End Sub Private Sub Command1_Click() Shell32Bit "command.com /c ipconfig > C:\tmpp" MsgBox "Complete" End Sub Or use this: ------------ ' ' Runs a command as the Shell command does but waits for the command ' to finish before returning. Note: The full path and filename extention ' is required. ' You might want to use Environ$("COMSPEC") & " /c " & command ' if you wish to run it under the command shell (and thus it) ' will search the path etc... ' ' returns false if the shell failed ' Public Function ShellWait(ByVal cCommandLine As String) As Boolean Dim NameOfProc As PROCESS_INFORMATION Dim NameStart As STARTUPINFO Dim i As Long NameStart.cb = Len(NameStart) i = CreateProcessA(0&, cCommandLine, 0&, 0&, 1&, _ NORMAL_PRIORITY_CLASS, 0&, 0&, NameStart, NameOfProc) If i <> 0 Then Call WaitForSingleObject(NameOfProc.hProcess, INFINITE) Call CloseHandle(NameOfProc.hProcess) ShellWait = True Else ShellWait = False End If End Function Fragment 4. Multiple forms: --------------------------- Private Sub List1_Click() If List1.ListIndex=0 Then Form1.WindowState = 2 ' Maximize Elseif List1.ListIndex =1 Then Load Form2 Form2.Show Elseif List1.Listindex =2 Then Load MDIForm1 MDIForm1.Show Else Form1.WindowState = 0 ' Normal End If End Sub Sub Main() Load Form1 Form1.Show End Sub Private Sub Command1_Click() frmChangeDir.Hide End Sub Private Sub Command2_Click() Load frmCreateDir frmCreateDir.Show End Sub Fragment 5. textFile: --------------------- Private Sub mnuItemOpen_Click() Wrap$=Chr$(13)+Chr$(10) 'creates a wrap character CommonDialog1.Filter="Text files (*.TXT) | *.TXT" CommonDialog1.ShowOpen If CommonDialog1.Filename<> "" Then Form1.MousePointer=11 'display hourglass Open CommonDialog1.FileName For Input As #1 On Error GoTo TooBig: Do Until EOF(1) 'then read lines from file Line Input #1, LineOfText$ AllText$ = AllText$ & LineOfText$ & Wrap$ Loop lblFile.Caption=CommonDialog1.FileNmae txtFile.Text=AllText$ 'display the file txtFile.Enabled=True mnuItemOpen.Enabled=False Cleanup: Form1.MousePointer=0 Close #1 End If Exit Sub TooBig: MsgBox ("The file is too big.") Resume Cleanup: 'jumps to Cleanup routine End Sub Private Sub mnuItemExit_Click() End End Sub Private Sub mnuItemSave_Click() ' the entire file is stored in a string CommonDialog1.Filter = "Text files (*.TXT)|*.TXT" CommonDialog1.ShowSave 'display Save Dialog If CommonDialog1.FileName<>"" Then Open CommonDialog1.FileName For Output As #1 Print #1, txtNote.Text - name of TextBox Close #1 End If End Sub Private mnuItemClose_Click() txtFile.Text="" lblFile.Caption="Load a text file with the Open command" mnuItemClose.Enabled=False mnuItemOpen.Enabled=True txtFile.Enabled=False End Sub Fragment 6: write to file: -------------------------- Dim iFileNum As Integer 'Get a free file handle iFileNum = FreeFile 'If the file is not there, one will be created 'If the file does exist, this one will overwrite it. Open App.Path & "\MyFile.txt" For Output As iFileNum Print #iFileNum, Text1.Text Close iFileNum '--end code block Fragment 7: write to file: -------------------------- Open "Result.txt" For output as #1 print #1, ResultVariable close #1 ' Then in your other VB Prog read it in Open "Result.txt" For Input As #1 Line Input #1, ResultVaraiable Close #1 Fragment 8. write to file: -------------------------- Private Sub Command1_Click() Dim fnum As Integer Dim s As String Dim fname As String Dim winPath As String On error goto ErrReadTextFile fnum = FreeFile ' get the windows folder name winPath = Environ$("SystemRoot") If winPath = "" Then MsgBox "Unable to retrieve the Windows path.", _ vbInformation, "Error Reading Windows Path" Exit Sub End If ' create a file name fname = winPath & "\win.ini" ' ensure the file exists If Dir$(fname) <> "" Then ' open the file Open fname For Binary As #fnum If Err.Number = 0 Then s = Space$(LOF(fnum)) ' read the file Get #fnum, 1, s Close #fnum Text1.Text = s Else Text1 = "Unable to read the file " & _ fname & "." End If Else Text1 = "The file " & fname & " does not exist." End If ExitReadTextFile: Exit Sub ErrReadTextFile: MsgBox Err.Number & ": " & Err.Description Exit Sub End SubEnd Sub Fragment 9. Write to file: -------------------------- Dim fno As Integer, s As String ' calculate string to return s = "Fred" fno = FreeFile Open "c:\tmp.bat" For Binary As #fno Put #fno, , "SET vbvar=""" & s & """" Close #fno This will write a small .bat file to set the environment variable then your .bat file should look like : c:\myprog.exe call c:\tmp.bat echo %vbvar% Fragment 10. Write to file: --------------------------- Dim BatchFile As String BatchFile = "C:\tmpbatch.bat" Open BatchFile For Output As #1 Print #1, "start C:\count.cmd" Close #1 Shell BatchFile, vbMinimizedNoFocus Fragment 11. Write to file: --------------------------- Dim EnvString, Indx Indx = 1 Do EnvString = Environ(Indx) If ucase(EnvString) = "DEBUG=ON" Then IsDebugMode = True Exit Do End If Indx = Indx + 1 ' Not PATH entry, Loop Until EnvString = Fragment 12. CommonDialog: -------------------------- Common Dialog/Direct is a new DLL or class library which shows how to completely replace COMDLG32.OCX through Visual Basic code. The main advantage of this is you no longer need to put a control on a form t o use common dialogs - just declare an instance of the class and you have a straight replacement. You can also incorporate the Common Dialog/Direct code straight into your own project if you want to reduce dependency files when you ship your project. Dim c As New cCommonDialog With c .DialogTitle = "Choose Text FIle" .CancelError = True .hWnd = Me.hWnd .flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST .InitDir = "C:\STEVEMAC" .Filter = "Internet documents (*.HTM)|*.HTM|Text files (*.TXT)|*.TXT|All Files (*.*)|*.*" .FilterIndex = 1 .ShowOpen txtFileName = .filename txtFilter = .Filter txtContents = GetFileText(.filename) End With Fragment 13. Complete program example: -------------------------------------- Private Sub btnInstall_Click() If SequenceStatus <> 1 Then MsgBox ("You must first perform Step 1 (download the create scripts), before you can begin installing.") Else 'STEP 1. First create setup.ini for unattended msde install '-------------------------------------------------- iFileNum = FreeFile Open TmpPath & "\setup.ini" For Output As iFileNum Print #iFileNum, "[OPTIONS]" Print #iFileNum, "[TARGETDIR]=" & TARGETDIR Print #iFileNum, "[DATADIR]=" & DATADIR Close iFileNum InstallStatus = " Setup.ini created.." txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar 'STEP 2. Now create create_db.sql '-------------------------------------------------- SetEnvironmentVariable "DATADIR", DATATDIR SetEnvironmentVariable "TARGETDIR", TARGETDIR Dim BatchFile As String Dim CmdStr As String BatchFile = TmpPath & "\create_db.cmd" Open BatchFile For Output As #1 Print #1, "SET DATADIR=" & DATADIR Print #1, "SET TARGETDIR=" & TARGETDIR Print #1, "type c:\download\create_db.txt >> "; TmpPath & "\create_db.cmd" Close #1 CmdStr = TmpPath & "\create_db.cmd" Shell (CmdStr) 'STEP 3. Secondly we create the msde install string like '\Setup.exe /i \SqlRun01.msi /settings \setup.ini /qr '-------------------------------------------------- InstallMSDEStr = "D:\PERSONAL\MSDE\setup.exe /i " _ & "D:\PERSONAL\MSDE\SETUP\SQLRUN01.msi /settings " & Chr(34) & TmpPath & "\setup.ini" & Chr(34) & " /qr" iFileNum = FreeFile Open TmpPath & "\setup.cmd" For Output As iFileNum Print #iFileNum, InstallMSDEStr Close iFileNum ' Shell (InstallMSDEStr) InstallStatus = " Setup commandline created.." txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar 'STEP 4. Install MSDE '-------------------------------------------------- CmdStr = TmpPath & "\setup.cmd" Shell (CmdStr) InstallStatus = " SQLServer MSDE installed" txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar 'STEP 5. Startup MSSQLServer '-------------------------------------------------- Shell ("net start MSSQLServer") InstallStatus = " Starting up SQLServer service.." txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar Form1.Show End If End Sub Private Sub btnCreateDatabase_Click() 'STEP 6. Create ELICSYR Database '-------------------------------------------------- InstallOSQLStr = "osql -E -i " & TmpPath & "\create_db.sql" Shell (InstallOSQLStr) InstallStatus = " ELICSYR Database installed" txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar Form1.Show End If End Sub Private Sub btnQuit_Click() End End Sub Private Sub Form_Load() Init ComboBox1.AddItem ("http//www.tollogic.nl/site1") ComboBox1.AddItem ("ftp//ftp.tollogic.nl/site2") End Sub ---------------------------------------------------------------------------- Private Declare Function GetEnvironmentStrings Lib "kernel32" Alias "GetEnvironmentStringsA" () As Long Private Declare Function FreeEnvironmentStrings Lib "kernel32" Alias "FreeEnvironmentStringsA" (ByVal lpsz As String) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Private Sub Form_Load() 'The KPD-Team 2001 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net Dim lngRet As Long, strDest As String, lLen As Long 'set the graphics mode to persistent Me.AutoRedraw = True 'retrieve the initial pointer to the environment strings lngRet = GetEnvironmentStrings Do 'get the length of the following string lLen = lstrlen(lngRet) 'if the length equals 0, we've reached the end If lLen = 0 Then Exit Do 'create a buffer string strDest = Space$(lLen) 'copy the text from the environment block CopyMemory ByVal strDest, ByVal lngRet, lLen 'show the text Me.Print GetFilePathName(strDest, LongFile) 'move the pointer lngRet = lngRet + lstrlen(lngRet) + 1 Loop 'clean up FreeEnvironmentStrings lngRet End Sub ---------------------------------------------------------------------------- I've done something similar where I kick off many DOS commands in a loop and the DOS window closes and the program in the batch file actually runs. The DOS program also redirects it's output to a file. This is the code what I used: for i = 1 to 10 cmdline = App.Path & "\doit.bat 123.123.123.123" aa = Shell(cmdline, vbHide) next i My doit.bat file contains something like this: nbtstat -A %1 >>C:\DATA\%1.TXT ---------------------------------------------------------------------------- Shell "command.com /c C:\Program.exe > outfile.dat" ---------------------------------------------------------------------------- Private Sub Command1_Click() ' connect to library Set PDF = CreateObject("PDFCreatorPilot.piPDFDocument") ' initialize PDF Engine PDF.StartEngine "demo@demo", "demo" ' set PDF ouput filename PDF.FileName = "HelloPDF_VB.pdf" PDF.AutoLaunch = True ' auto-open generated pdf document ' start document generation PDF.BeginDoc ' draw "HELLO, PDF" message on the current PDF page PDF.PDFPAGE_BeginText PDF.PDFPAGE_SetActiveFont "Verdana", True, False, False, False, 14, 0 PDF.PDFPAGE_TextOut 10, 20, 0, "HELLO, PDF!" PDF.PDFPAGE_EndText ' finalize document generation PDF.EndDoc ' disconnect from library Set PDF = Nothing End Sub This function will generate PDF document and save it as "HelloPDF_VB.PDF" file in the application's folder. ---------------------------------------------------------------------------- Private Sub Form_Load() btnInstall.Enabled = False Dim Drive As String Dim Path As String Dim TARGETDIR As String Dim DataDir As String Dim TmpPath As String Dim iFileNum As Integer End Sub Private Sub btnInstall_Click() fnum = FreeFile ' get the TMP folder name TmpPath = Environ$("TMP") lblCheck.Caption = TmpPath 'Get a free file handle iFileNum = FreeFile Open App.Path & "\create_db.bat" For Output As iFileNum Print #iFileNum, "SET DataDir=" & lblPath.Caption Close iFileNum 'Shell "copy var1 + create_db > create_db.bat" 'Shell "c:\project\create_db.bat" End Sub Private Sub btnQuit_Click() End End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub Dir1_Change() lblPath.Caption = Dir1.Path DataDir = Dir1.Path btnInstall.Enabled = True End Sub Private Sub Form_Load() btnInstall.Enabled = False Dim Drive As String Dim Path As String Dim TARGETDIR As String Dim DataDir As String Dim TmpPath As String Dim iFileNum As Integer End Sub ---------------------------------------------------------------------------- Create a unique temporary file: ------------------------------- Place all this code in a module and then just call the GetNewTempFile function and pass it a string to prefix the temporary filename with. (can be anything you want.), and it will pass back the fullpath of the temporary file created. It`s up to you to kill the file when you are though with it. Private Declare Function GetTempPath Lib "kernel32" _ Alias "GetTempPathA" (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long Private Declare Function GetTempFileName Lib "kernel32" _ Alias "GetTempFileNameA" (ByVal lpszPath As String, _ ByVal lpPrefixString As String, ByVal wUnique As Long, _ ByVal lpTempFileName As String) As Long Public Function GetNewTempFile(strPrefix As String) As String Dim strPath As String * 512 Dim strName As String * 576 Dim lngRetVal As Long lngRetVal = GetTempPath(512, strPath) If (lngRetVal > 0 And lngRetVal < 512) Then lngRetVal = GetTempFileName(strPath, strPrefix, 0, strName) If lngRetVal <> 0 Then GetNewTempFile = Left$(strName, _ InStr(strName, vbNullChar) - 1) End If End If End Function ---------------------------------------------------------------------------- The fastest way to read a text file is using the Input$ function, as shown in this reusable procedure: Function FileText (filename$) As String Dim handle As Integer handle = FreeFile Open filename$ For Input As #handle FileText = Input$(LOF(handle), handle) Close #handle End Function This method is much faster than reading each single line of the file using a Line Input statements. Here's how you can load a multiline textbox control with the contents of Autoexec.bat: Text1.Text = FileText("c:\autoexec.bat") UPDATE: Andrew Marshall wrote us to point out that the above routine fails when the file includes a Ctrl-Z (EOF) character, so we prepared a better version that works around that problem: Function FileText(ByVal filename As String) As String Dim handle As Integer ' ensure that the file exists If Len(Dir$(filename)) = 0 Then Err.Raise 53 ' File not found End If ' open in binary mode handle = FreeFile Open filename$ For Binary As #handle ' read the string and close the file FileText = Space$(LOF(handle)) Get #handle, , FileText Close #handle End Function -------------------------------------------------------------------------------- Fragment Errorhandling: ------------------------ public sub whatever() on error goto err_handler ....... code here ....... err_exit: Exit Sub Err_Handler: MsgBox "An error occurred while loading the clinic view form, " & Err.Description & "(" & Err.Number & ")." & _ vbCrLf & vbCrLf & "Source: form1:Load" Module1.LogError "form1:whatever", Err.Description, Err.Number Resume err_exit End Sub ---------------------------------------------------------------------------- Public Drive As String Public Path As String Public TARGETDIR As String Public DATADIR As String Public TmpPath As String Public ChooseState As Integer Public iFileNum As Integer Public WrapChar As String Public TEMP As String Public InstallMSDEStr As String Public InstallMSDE As String Public InstallOSQLStr As String Public CmdStr As String Public StartMSSqlserver As String Public InstallStatus As String Public SequenceStatus As Integer Public txtLine As String Public ChooseDir As Integer Public sDirectory As String Public Tempstring As Long Public Length As Long Public Location As String Public ResultInstall As Integer Public Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Sub Main() Load Form1 Form1.Show End Sub Sub GetTempDir() Length = 99 Location = String$(100, 0) Tempstring = GetTempPath(Length, Location) End Sub Public Sub Init() GetTempDir Dim Explorer As SHDocVw.InternetExplorer Dim GetEnvironmentVar As String TARGETDIR = "C:\MSSQL2K" DATADIR = "C:\MSSQL2K" TEMP = "C:\TEMP" SetEnvironmentVariable "TARGETDIR", TARGETDIR SetEnvironmentVariable "DATADIR", DATATDIR WrapChar = Chr(13) & Chr(10) TmpPath = Environ$("TMP") Form1.lblTargetDir.Caption = TARGETDIR Form1.lblDataDir.Caption = DATADIR Form1.lblTmpPath.Caption = TmpPath Form1.lblSysTmpPath.Caption = Location End Sub Function FileText(filename$) As String Dim handle As Integer handle = FreeFile Open filename$ For Input As #handle FileText = Input$(LOF(handle), handle) Close #handle End Function Sub Create_Directory() Dim strPath As String 'The directory which will be created... Dim intOffset As Integer 'Searches for a "\" so it can create the dirs... Dim intAnchor As Integer 'Equal to the above variable... Dim strOldPath As String 'Returns the CurDir to the old path(the dir 'the setup file is in)... On Error Resume Next 'Error handling... strOldPath = CurDir$ 'Find the current Directory... intAnchor = 0 'Reset intAnchor... 'Searches for the "\" to create the dirs properly... intOffset = InStr(intAnchor + 1, sDirectory, "\") intAnchor = intOffset 'Equal to the above... Do intOffset = InStr(intAnchor + 1, sDirectory, "\") intAnchor = intOffset If intAnchor > 0 Then 'If there is 1 or more "\" then... 'Create the directory using the text before the "\"... strPath = Left$(sDirectory, intOffset - 1) ' Determine if this directory already exists... Err = 0 ChDir strPath 'If it does, change to that directory... If Err Then 'If it doesn't exist... ' We must create this directory... Err = 0 MkDir strPath 'Make the Directory... End If End If Loop Until intAnchor = 0 'Loop until all directories have been made 'I.e C:\Prog\David\Cowan is 3 directories... Done: ChDir strOldPath 'Change back to the the 'old' current directory... Err = 0 'Reset the error number... End Sub Private Sub Command1_Click() End Sub Private Sub btnProgDir_Click() ChooseDir = 1 Load frmChangeDir frmChangeDir.Show lblTargetDir.Caption = TARGETDIR End Sub Private Sub btnDataDir_Click() ChooseDir = 2 Load frmChangeDir frmChangeDir.Show lblDataDir.Caption = DATADIR End Sub Private Sub btnDownLoad_Click() SequenceStatus = 0 'Method 1: just for local test ' Inet1.Execute txtURL.Text, _ ' "GET C:\temp\create_db.cmd" ' Inet1.Execute txtURL.Text, _ ' "SEND c:\download\create_db.txt c:\temp\create_db.cmd" 'Method 2: this works for real if we use a remote machine ' Dim bData() As Byte ' bData() = Inet1.OpenURL("file://c:\download\create_db.txt", icByteArray) ' Open TmpPath & "\create_db.cmd" For Binary As #1 ' Put #1, , bData() ' Close #1 MsgBox "File downloaded" SequenceStatus = 1 InstallStatus = "Create scripts downloaded.." txtStatus.Text = InstallStatus & WrapChar End Sub Private Sub btnInstall_Click() If SequenceStatus <> 1 Then MsgBox ("You must first perform Step 1 (download the create scripts), before you can begin installing.") Else 'STEP 1. First create setup.ini for unattended msde install '-------------------------------------------------- iFileNum = FreeFile Open TmpPath & "\setup.ini" For Output As iFileNum Print #iFileNum, "[OPTIONS]" Print #iFileNum, "[TARGETDIR]=" & TARGETDIR Print #iFileNum, "[DATADIR]=" & DATADIR Close iFileNum InstallStatus = " Setup.ini created.." txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar 'STEP 2. Now create create_db.sql '-------------------------------------------------- SetEnvironmentVariable "DATADIR", DATATDIR SetEnvironmentVariable "TARGETDIR", TARGETDIR Dim BatchFile As String Dim CmdStr As String BatchFile = TmpPath & "\create_db.cmd" Open BatchFile For Output As #1 Print #1, "SET DATADIR=" & DATADIR Print #1, "SET TARGETDIR=" & TARGETDIR Print #1, "type c:\download\create_db.txt >> "; TmpPath & "\create_db.cmd" Close #1 CmdStr = TmpPath & "\create_db.cmd" Shell (CmdStr) 'STEP 3. Secondly we create the msde install string like '\Setup.exe /i \SqlRun01.msi /settings \setup.ini /qr '-------------------------------------------------- InstallMSDEStr = "D:\PERSONAL\MSDE\setup.exe /i " _ & "D:\PERSONAL\MSDE\SETUP\SQLRUN01.msi /settings " & Chr(34) & TmpPath & "\setup.ini" & Chr(34) & " /qr" iFileNum = FreeFile Open TmpPath & "\setup.cmd" For Output As iFileNum Print #iFileNum, InstallMSDEStr Close iFileNum ' Shell (InstallMSDEStr) InstallStatus = " Setup commandline created.." txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar 'STEP 4. Install MSDE '-------------------------------------------------- CmdStr = TmpPath & "\setup.cmd" Shell (CmdStr) InstallStatus = " SQLServer MSDE installed" txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar 'STEP 5. Startup MSSQLServer '-------------------------------------------------- Shell ("net start MSSQLServer") InstallStatus = " Starting up SQLServer service.." txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar Form1.Show End If End Sub Private Sub btnCreateDatabase_Click() 'STEP 6. Create ELICSYR Database '-------------------------------------------------- InstallOSQLStr = "osql -E -i " & TmpPath & "\create_db.sql" Shell (InstallOSQLStr) InstallStatus = " ELICSYR Database installed" txtStatus.Text = txtStatus.Text & InstallStatus & WrapChar Form1.Show End If End Sub Private Sub btnQuit_Click() End End Sub Private Sub Form_Load() Init ComboBox1.AddItem ("http//www.tollogic.nl/site1") ComboBox1.AddItem ("ftp//ftp.tollogic.nl/site2") End Sub --------------------------------------------------- Simple Examples: ================ Example 1: ---------- Private Sub cmdBepaal_Click() ' Variabelen declaratie Dim testdeler As Integer Dim uitkomst As String Dim g As Integer ' Toekenning g = CInt(txtInput.Text) lblOutput.Caption = "" uitkomst = "Ja" ' Bepaling of het ingevoerde getal > 2 is If Round(g, 0) <= 2 Then MsgBox ("Het getal is kleiner dan of gelijk aan 2.") Else ' Bepaling of de invoer een priemgetal is For testdeler = 2 To Sqr(g) If g Mod testdeler = 0 Then 'deler gevonden uitkomst = "Nee" Exit For End If Next testdeler lblOutput.Caption = uitkomst End If End Sub Private Sub cmdExit_Click() End End Sub Private Sub Form_Load() End Sub Private Sub lblAant100_Click() End Sub Example 2: ---------- Private Sub cmdBepaal_Click() ' Variabelen declaratie Dim AantalBoeken As Integer Dim AantalDagen As Integer Dim BoeteGeld As Double Dim boete As String Dim WDatum As Date Dim UDatum As Date Dim Vandaag As Date ' Toekenning waarden aan variabelen ' m.b.v. functie CInt kunnen we van string naar integer converteren ' m.b.v. functie CDate kunnen we van string naar date converteren BoeteGeld = 0.75 AantalBoeken = CInt(txtAantalBoeken.Text) UDatum = CDate(txtUitDatum.Text) WDatum = CDate(txtInlDatum.Text) Vandaag = Now() boete = "0" ' Bepaling of het aantal ingevoerde Aantal Boeken > 0 is If Round(AantalBoeken, 0) <= 0 Then MsgBox ("Het aantal boeken is kleiner dan of gelijk aan 0.") Else ' Bepaling of het inleveren te laat is. ' De functie Datediff bepaald het aantal dagen tussen WDatum en UDatum ' Als de inleverdatum nog onder de uiterste inleverdatum zit, ' is er geen boete. If DateDiff("d", UDatum, WDatum) < 0 Then MsgBox ("Boeken zijn niet te laat.") lblOutput.Caption = boete Else ' De werkelijke inleverdatum is voorbij de uiterste ' inleverdatum, en dus is er sprake van een boete. ' Bepaling van de boete: boete = BoeteGeld * AantalBoeken * DateDiff("d", UDatum, WDatum) lblOutput.Caption = boete End If End If End Sub Private Sub cmdExit_Click() End End Sub Private Sub Label1_Click() End Sub Private Sub lblOut_Click() End Sub Private Sub txtUitInlDatum_Change() End Sub Example 3: ---------- Private Sub cmdBepaal_Click() ' Variabelen declaratie Dim Invoer As String ' De ingevoerde waarde Dim Bedrag As Double ' Ingevoerde waarde geconverteerd naar bedrag Dim Afgerond As Integer ' Het ingevoerde bedrag afgerond naar geheel getal Dim Nieuwbedrag As Integer ' hulpvariabele Dim B100 As Integer ' Aantal briefjes van f. 100 Dim B10 As Integer ' Aantal briefjes van f. 10 Dim M5 As Integer ' Aantal munten van f. 5 Dim M1 As Integer ' Aantal munten van f. 1 Dim Rest As Double ' Het restbedrag ' Assignments B100 = 0 B10 = 0 M5 = 0 M1 = 0 ' Bepaling of de ingevoerde waarde een getal is If IsNumeric(txtInput.Text) Then Bedrag = Val(txtInput.Text) Else MsgBox ("De ingevoerde waarde is geen getal") End If ' Bepaling of het ingevoerde bedrag < 5000 If Bedrag >= 5000 Or Bedrag < 0 Then MsgBox ("Het ingevoerde bedrag is groter dan 5000 of kleiner dan 0") Else ' De bepaling minimale geldeenheden' ' Eerst het bedrag naar beneden afronden ' en het restbedrag bepalen Afgerond = Int(Bedrag) Rest = Round(Bedrag - Afgerond, 2) ' Aantal briefjes van f. 100 bepalen B100 = Int(Afgerond / 100) ' Aantal briefjes van f. 10 bepalen If B100 >= 1 Then Nieuw_Bedrag = Afgerond - (B100 * 100) B10 = Int(Nieuw_Bedrag / 10) If B10 >= 1 Then ' Aantal munten van f. 5 bepalen Nieuw_Bedrag = Nieuw_Bedrag - (B10 * 10) M5 = Int(Nieuw_Bedrag / 5) If M5 = 0 Then ' Aantal munten van f. 1 bepalen M1 = Int(Nieuw_Bedrag) Else If M5 >= 1 Then Nieuw_Bedrag = Nieuw_Bedrag - 5 M1 = Int(Nieuw_Bedrag) End If End If End If End If lblAant100.Caption = B100 lblAant10.Caption = B10 lblAant5.Caption = M5 lblAant1.Caption = M1 lblAantrest.Caption = Rest End If End Sub Private Sub cmdExit_Click() End End Sub Example 4: ---------- Dim rstRecordset As ADODB.Recordset Dim cnnConnection As ADODB.Connection Dim strStream As ADODB.Stream Dim imgname As String Private Sub cmdLoad_Click() Set cnnConnection = New ADODB.Connection Set rstRecordset = New ADODB.Recordset imgname = GiveId.Text cnnConnection.Open ("Provider=SQLOLEDB; " & _ "data Source=xpora;" & _ "Initial Catalog=pubs; " & _ "User Id=karel;Password=karel") rstRecordset.Open "Select * from docs where id=" & imgname, cnnConnection, _ adOpenKeyset, adLockOptimistic Set strStream = New ADODB.Stream strStream.Type = adTypeBinary strStream.Open strStream.Write rstRecordset.Fields("Doc").Value strStream.SaveToFile "C:\Temp.doc", adSaveCreateOverWrite Shell "E:\Program Files\Microsoft Office\Office\Winword.exe " & _ Chr$(34) & "C:\temp.doc", 1 End Sub Private Sub cmdLoad2_Click() Set cnnConnection = New ADODB.Connection Set rstRecordset = New ADODB.Recordset imgname = GiveId.Text cnnConnection.Open ("Provider=SQLOLEDB; " & _ "data Source=xpora;" & _ "Initial Catalog=pubs; " & _ "User Id=karel;Password=karel") rstRecordset.Open "Select * from docs where id=" & imgname, cnnConnection, _ adOpenKeyset, adLockOptimistic Set strStream = New ADODB.Stream strStream.Type = adTypeBinary strStream.Open strStream.Write rstRecordset.Fields("Doc").Value strStream.SaveToFile "C:\Temp.doc", adSaveCreateOverWrite Dim wsApp As Word.Application 'Set wsApp = GetObject(, "Word.Application") Set wsApp = CreateObject("Word.Application") wsApp.Visible = True wsApp.Documents.Open ("c:\temp.doc") End Sub Private Sub cmdQuit_Click() End End Sub Private Sub cmdSelectSave_Click() 'Shell "C:\Program Files\Microsoft SQL Server\mssql\binn\textcopy.exe " & _ '"-I -S xpora -D pubs -T docs -C doc -U karel -P karel -W where id=" & imgname & " -F c:\temp.doc" Set cnnConnection = New ADODB.Connection Set rstRecordset = New ADODB.Recordset imgname = GiveId.Text cnnConnection.Open ("Provider=SQLOLEDB; " & _ "data Source=xpora;" & _ "Initial Catalog=pubs; " & _ "User Id=karel;Password=karel") rstRecordset.Open "Select * from docs where id=" & imgname, cnnConnection, _ adOpenKeyset, adLockOptimistic Set mstream = New ADODB.Stream mstream.Type = adTypeBinary mstream.Open mstream.LoadFromFile "c:\temp.doc" rstRecordset.Fields("doc").Value = mstream.Read rstRecordset.Update rstRecordset.Close cnnConnection.Close End Sub Example 5: ---------- Dim rstRecordset As ADODB.Recordset Dim cnnConnection As ADODB.Connection Dim strStream As ADODB.Stream Private Sub cmdClear_Click() Image1.Picture = Nothing End Sub Private Sub cmdLoad_Click() If Not LoadPictureFromDB(rstRecordset) Then MsgBox "Invalid Data Or No Picture In DB" End If End Sub Private Sub cmdSelectSave_Click() 'Open Dialog Box With Dialog .DialogTitle = "Open Image File...." .Filter = "Image Files (*.gif; *.bmp)| *.gif;*.bmp" .CancelError = True procReOpen: .ShowOpen If .FileName = "" Then MsgBox "Invalid filename or file not found.", _ vbOKOnly + vbExclamation, "Oops!" GoTo procReOpen Else If Not SavePictureToDB(rstRecordset, .FileName) Then MsgBox "Save was unsuccessful :(", vbOKOnly + _ vbExclamation, "Oops!" Exit Sub End If End If End With End Sub Private Sub Form_Load() Set cnnConnection = New ADODB.Connection Set rstRecordset = New ADODB.Recordset cnnConnection.Open ("Provider=SQLOLEDB; " & _ "data Source=xpora;" & _ "Initial Catalog=pubs; " & _ "User Id=karel;Password=karel") rstRecordset.Open "Select * from doctest", cnnConnection, _ adOpenKeyset, adLockOptimistic End Sub Public Function LoadPictureFromDB(RS As ADODB.Recordset) On Error GoTo procNoPicture 'If Recordset is Empty, Then Exit If RS Is Nothing Then GoTo procNoPicture End If Set strStream = New ADODB.Stream strStream.Type = adTypeBinary strStream.Open strStream.Write RS.Fields("Doc").Value strStream.SaveToFile "C:\Temp.doc", adSaveCreateOverWrite 'Image1.Picture = LoadPicture("C:\Temp.doc") 'Kill ("C:\Temp.doc") Shell "E:\Program Files\Microsoft Office\Office\Winword.exe " & _ Chr$(34) & "C:\temp.doc" & Chr$(34) LoadPictureFromDB = True procExitFunction: Exit Function procNoPicture: LoadPictureFromDB = False GoTo procExitFunction End Function Public Function SavePictureToDB(RS As ADODB.Recordset, _ sFileName As String) On Error GoTo procNoPicture Dim oPict As StdPicture Set oPict = LoadPicture(sFileName) 'Exit Function if this is NOT a picture file If oPict Is Nothing Then MsgBox "Invalid Picture File!", vbOKOnly, "Oops!" SavePictureToDB = False GoTo procExitSub End If RS.AddNew Set strStream = New ADODB.Stream strStream.Type = adTypeBinary strStream.Open strStream.LoadFromFile sFileName RS.Fields("Pic").Value = strStream.Read Image1.Picture = LoadPicture(sFileName) SavePictureToDB = True procExitSub: Exit Function procNoPicture: SavePictureToDB = False GoTo procExitSub End Function Example 6: ---------- How to generate SQL insert statements: ' 'GenerateSqlInserts.vbs ' 'Version 2005.11.26 ' 'Copyright (c) 2004-2005 CodeHQ.net - Free to use anywhere as long as this 'message is retained intact. ' 'Based on sp_generate_inserts stored procedure by Narayana Vyas Kondreddi '(http://vyaskn.tripod.com/). ' 'Requires: ' ' 1. VBScript version 5. ' ' 2. ADO 2.5 or higher. ' ' 3. SQL Server 2000 or higher. ' 'Features: ' ' 1. Unicode output file. Ensures no character mistranslations occur. ' ' 2. Correct handling of long text and ntext columns (greater than 4000 ' characters). ' ' 3. Handles binary, varbinary and image types. The output code is a bit ' slow at the moment but works correctly. ' ' 4. Multiple table names can be specified. Inserts are generated in the ' same table order. ' ' 5. Any existing records in the named tables can be preserved or deleted ' (default is to delete). The records can be deleted in the specified ' table order or the reverse (default is reverse). Normally the table ' inserts are ordered to satisfy foreign key constraints. Deleting in ' this order (forward) may fail if a table has not enabled cascaded ' deletes. ' 'Current limitations: ' ' 1. The "INSERT INTO", column list and "VALUES" always appear on a single ' line (before the line break tests start). This is not usually an ' issue if the line width is wide enough. ' ' 2. Only a limited number of data types have been coded (it is quite ' simple to add others). The GetFieldValue function will raise an error ' when an unhandled type is encountered. ' ' 3. Doesn't support the sp_generate_inserts advanced options such as the ' renamed output table and disabling constraints. ' ' 4. The script doesn't determine inter-table foreign key dependencies. ' Option Explicit '============================================================================ ' 'GLOBALS ' Dim sServer, sDatabase, sOwner, sTableList, sTableName, sColumnList Dim sIdentityColumn, sColumnName, sql, insPrefix, insSuffix, insField, ins Dim rhs, sOutFile, sQuotedTableName, sForcedIdentity Dim oConn, oCmd, oRS, oArgs, oFSO, oFile Dim i, cnt, lenIns, lenField, lenPrefix, idx, maxLineLength, listIndex Dim bReverseDelete, bNoDelete, bNoCreateTime, bVerbose Dim aTableNames(), cTables '============================================================================ ' 'CONSTANTS ' Const kVersionString = "2005.11.26" Const msecsPerDay = 86400000 '(24hrs X 60mins X 60secs X 1000msecs) 'Selected FieldStatusEnum values: Const adFieldIsNull = 3 'Selected DataTypeEnum values: Const adSmallInt = 2 Const adInteger = 3 Const adSingle = 4 Const adDouble = 5 Const adCurrency = 6 Const adBoolean = 11 Const adDecimal = 14 Const adTinyInt = 16 Const adBigInt = 20 Const adGUID = 72 Const adBinary = 128 Const adChar = 129 Const adWChar = 130 Const adNumeric = 131 Const adDBTimeStamp = 135 Const adVarChar = 200 Const adLongVarChar = 201 Const adVarWChar = 202 Const adLongVarWChar = 203 Const adVarBinary = 204 Const adLongVarBinary = 205 'Selected CursorTypeEnum values: Const adOpenStatic = 3 'Selected LockTypeEnum values: Const adLockOptimistic = 3 'Selected CommandTypeEnum values: Const adCmdText = &H0001 '============================================================================ ' 'Process command line. ' Set oArgs= WScript.Arguments.Named cnt= (oArgs.Count - 1) If (Not oArgs.Exists("database") Or _ Not oArgs.Exists("tables") Or _ Not oArgs.Exists("out") Or _ (WScript.Arguments.Unnamed.Count > 0)) Then Call Usage("Invalid command line.") End If If (oArgs.Exists("server")) Then sServer= oArgs("server") Else sServer= "(local)" End If sDatabase= oArgs("database") If (oArgs.Exists("owner")) Then sOwner= oArgs("owner") Else sOwner= "dbo" End If sTableList= oArgs("tables") maxLineLength = 500 'Default width If (oArgs.Exists("width")) Then maxLineLength= CLng(oArgs("width")) If (maxLineLength < 80) Then maxLineLength= 80 ElseIf (maxLineLength > 2000) Then maxLineLength= 2000 End If End If maxLineLength= maxLineLength - 4 'Fixup for trailing line characters sOutFile= oArgs("out") bReverseDelete= Not oArgs.Exists("forwardDelete") bNoDelete= oArgs.Exists("noDelete") bNoCreateTime= oArgs.Exists("noCreateTime") bVerbose= oArgs.Exists("verbose") ' ' Create ADO objects ' Set oConn= CreateObject("ADODB.Connection") Set oCmd= CreateObject("ADODB.Command") oConn.Open "Provider=SQLOLEDB;Data Source=" & sServer & ";Initial Catalog=" & _ sDatabase & ";Integrated Security=SSPI" ' 'Parse and validate the table list ' cTables= 0 While (sTableList <> "") listIndex= InStr(sTableList, ",") If (listIndex > 0) Then sTableName= Left(sTableList, listIndex - 1) sTableList= Mid(sTableList, listIndex + 1) Else sTableName= sTableList sTableList= "" End If idx= InStrRev(sTableName, ":") If (idx > 0) Then sForcedIdentity= Mid(sTableName, idx + 1) sTableName= Left(sTableName, idx - 1) Else sForcedIdentity= "" End If sql= "SELECT 1 FROM INFORMATION_SCHEMA.TABLES WHERE (TABLE_NAME = '" & sTableName & _ "') AND (TABLE_TYPE = 'BASE TABLE' OR TABLE_TYPE = 'VIEW') AND (TABLE_SCHEMA = '" & _ sOwner & "')" Set oRS= oConn.Execute(sql) If (oRS.EOF) Then Set oRS= Nothing Set oCmd= Nothing Set oConn= Nothing Call Usage("Table or view (" & sTableName & ") does not exist.") End If ReDim Preserve aTableNames(2, cTables + 1) aTableNames(0, cTables)= sTableName aTableNames(1, cTables)= sForcedIdentity cTables= cTables + 1 WEnd If (cTables = 0) Then Call Usage("No tables or views specified.") End If ' 'Create file, write header. ' Set oFSO= CreateObject("Scripting.FileSystemObject") Set oFile= oFSO.CreateTextFile(sOutFile, oArgs.Exists("overwrite"), True) oFile.WriteLine "/*" oFile.WriteLine " * " & oFSO.GetFile(sOutFile).Name oFile.WriteLine " *" If (bNoCreateTime) Then oFile.WriteLine " * Automatically generated." Else oFile.WriteLine " * Automatically generated on " & GetDateString(Now) End If oFile.WriteLine " *" oFile.WriteLine " * Created by GenerateSqlInserts, version " & kVersionString oFile.WriteLine " * From CodeHQ.net, http://codehq.net/" oFile.WriteLine " *" oFile.WriteLine " */" oFile.WriteLine oFile.WriteLine "USE " & sDatabase & ";" oFile.WriteLine "GO" oFile.WriteLine oFile.WriteLine "EXEC sp_dboption '" & sDatabase & "', 'select into/bulkcopy', 'true';" oFile.WriteLine "GO" oFile.WriteLine ' 'Process each named table. ' If (Not bNoDelete) Then WriteSectionHeader() If (bReverseDelete) Then For idx = (cTables - 1) To 0 Step -1 sTableName= aTableNames(0, idx) sForcedIdentity= aTableNames(1, idx) Call WriteDelete(GetQuotedTableName(sOwner, sTableName)) Next Else For idx = 0 To (cTables - 1) sTableName= aTableNames(0, idx) sForcedIdentity= aTableNames(1, idx) Call WriteDelete(GetQuotedTableName(sOwner, sTableName)) Next End If End If For idx = 0 To (cTables - 1) sTableName= aTableNames(0, idx) sForcedIdentity= aTableNames(1, idx) Call ProcessTable() Next ' 'Write footer, cleanup. ' WriteSectionHeader() oFile.WriteLine "EXEC sp_dboption '" & sDatabase & "', 'select into/bulkcopy', 'false';" oFile.WriteLine "GO" oFile.WriteLine oFile.WriteLine "PRINT N'Done.';" oFile.WriteLine oFile.Close Set oFile= Nothing Set oFSO= Nothing Set oRS= Nothing Set oCmd= Nothing Set oConn= Nothing WScript.Echo "OK." Call WScript.Quit(0) '============================================================================ Sub ProcessTable() Dim sBinaryColumns, sNtextColumns, sTextColumns, sFieldName Dim ofs, chunkSize, binSize Dim identityValue Dim bHasRealIdentityColumn Dim oFld sQuotedTableName= GetQuotedTableName(sOwner, sTableName) If (bVerbose) Then WScript.Echo sQuotedTableName End If ' 'Create column list, determine identity column (if defined). ' sColumnList= "" sIdentityColumn= "" bHasRealIdentityColumn= False sql= "SELECT ORDINAL_POSITION AS Ordinal, " & _ "COLUMN_NAME AS ColumnName, " & _ "DATA_TYPE AS DataType, " & _ "COLUMNPROPERTY(OBJECT_ID('" & sQuotedTableName & _ "'), COLUMN_NAME, 'IsIdentity') AS IsIdentity, " & _ "COLUMNPROPERTY(OBJECT_ID('" & sQuotedTableName & _ "'), COLUMN_NAME, 'IsComputed') AS IsComputed " & _ "FROM INFORMATION_SCHEMA.COLUMNS (NOLOCK) " & _ "WHERE (TABLE_NAME = '" & sTableName & "') AND (TABLE_SCHEMA = '" & sOwner & "');" Set oRS= oConn.Execute(sql) While (Not oRS.EOF) sColumnName= oRS.Fields("ColumnName") sColumnList= sColumnList & "[" & sColumnName & "]" If (oRS.Fields("IsIdentity") = 1) Then sIdentityColumn= sColumnName bHasRealIdentityColumn= True End If oRS.MoveNext If (Not oRS.EOF) Then sColumnList= sColumnList & "," End If WEnd If (sForcedIdentity <> "") Then sIdentityColumn= sForcedIdentity End If sql= "SELECT " & sColumnList & "FROM " & sQuotedTableName 'Set oRS= oConn.Execute(sql) Set oRS= CreateObject("ADODB.Recordset") oRS.Open sql, oConn, adOpenStatic, adLockOptimistic, adCmdText If (oRS.EOF) Then WScript.Echo "WARNING: " & sQuotedTableName & " has no rows!" Exit Sub End If insPrefix= "INSERT INTO " & sQuotedTableName & " (" & sColumnList & ") VALUES (" insSuffix= ");" lenPrefix= Len(insPrefix) WriteSectionHeader() If (oRS.RecordCount > 0) Then If (bVerbose) Then WScript.Echo " Rows=" & oRS.RecordCount End If oFile.WriteLine "PRINT N'Inserting " & oRS.RecordCount & " row(s) into " & sQuotedTableName & "';" Else oFile.WriteLine "PRINT N'Inserting into " & sQuotedTableName & "';" End If oFile.WriteLine If (bHasRealIdentityColumn) Then oFile.WriteLine "SET IDENTITY_INSERT " & sQuotedTableName & " ON;" oFile.WriteLine "GO" oFile.WriteLine End If While (Not oRS.EOF) ins= insPrefix lenIns= lenPrefix cnt= oRS.Fields.Count - 1 sBinaryColumns= "" sNtextColumns= "" sTextColumns= "" For i= 0 To cnt Set oFld= oRS.Fields(i) insField= GetFieldValue(oFld, False) 'Suppress real value for binary or long text fields lenField= Len(insField) If (IsBinary(oFld) And (insField <> "NULL")) Then 'Deferred binary insertion sBinaryColumns= sBinaryColumns & oFld.Name & "|" ins= ins & "0x00" lenIns= lenIns + 4 ElseIf (IsNtext(oFld) And (insField <> "NULL")) Then 'Deferred NTEXT insertion sNtextColumns= sNtextColumns & oFld.Name & "|" ins= ins & "N''" lenIns= lenIns + 3 ElseIf (IsText(oFld) And (insField <> "NULL")) Then 'Deferred TEXT insertion sTextColumns= sTextColumns & oFld.Name & "|" ins= ins & "''" lenIns= lenIns + 2 ElseIf (IsTextField(oFld) And (lenIns + lenField >= maxLineLength) And (insField <> "NULL")) Then Do While (lenIns + lenField >= maxLineLength) idx= maxLineLength - lenIns If (idx < 3) Then If (lenField < 3) Then idx= lenField Else idx= 3 End If ElseIf (idx >= lenField) Then idx= lenField - 1 End If While ((idx > 0) And (Mid(insField, idx, 1) = "'")) idx= idx - 1 WEnd rhs= Mid(insField, idx + 1) If (rhs = "'") Then 'Include single trailing quote. idx= idx + 1 rhs= "" End If If (rhs = "") Then 'EOL ins= ins & insField lenIns= lenIns + lenField If (i < cnt) Then 'More columns ins= ins & "," lenIns= lenIns + 1 End if oFile.WriteLine ins ins= " " lenIns= 4 insField= "" lenField= 0 Exit Do End If ins= ins & Left(insField, idx) & "' +" oFile.WriteLine ins If (IsWideText(oFld)) Then ins= " N'" Else ins= " '" End If lenIns= Len(ins) insField= Mid(insField, idx + 1) lenField= lenField - idx Loop If (insField <> "") Then ins= ins & insField lenIns= lenIns + lenField End If Else ins= ins & insField lenIns= lenIns + lenField End If If ((i < cnt) And (lenIns > 4)) Then ins= ins & "," lenIns= lenIns + 1 If (lenIns >= maxLineLength) Then oFile.WriteLine ins ins= " " lenIns= 4 End If End if Next ins= ins & insSuffix oFile.WriteLine ins If ((sBinaryColumns <> "") And (sIdentityColumn = "")) Then WScript.Echo "WARNING: Cannot insert binary columns into " & _ sQuotedTableName & vbCrLf & " - it has no identity column!" Exit Sub ElseIf ((sNtextColumns <> "") And (sIdentityColumn = "")) Then WScript.Echo "WARNING: Cannot insert NTEXT columns into " & _ sQuotedTableName & vbCrLf & " - it has no identity column!" Exit Sub ElseIf ((sTextColumns <> "") And (sIdentityColumn = "")) Then WScript.Echo "WARNING: Cannot insert TEXT columns into " & _ sQuotedTableName & vbCrLf & " - it has no identity column!" Exit Sub End If ' 'Write out BINARY/VARBINARY/LONGVARBINARY column data. ' While (sBinaryColumns <> "") idx= InStr(sBinaryColumns, "|") sFieldName= Left(sBinaryColumns, idx - 1) sBinaryColumns= Mid(sBinaryColumns, idx + 1) WScript.Echo "Deferred binary processing for " & sQuotedTableName & ".[" & sFieldName & "]" insField= GetFieldValue(oRS.Fields(sFieldName), True) 'Get real binary value lenField= Len(insField) binSize= oRS.Fields(sFieldName).ActualSize identityValue= oRS.Fields(sIdentityColumn).Value oFile.WriteLine "DECLARE @ptrval binary(16);" oFile.WriteLine "SELECT @ptrval= TEXTPTR([" & sFieldName & _ "]) FROM " & sQuotedTableName & " WHERE ([" & _ sIdentityColumn & "] = " & identityValue & ");" ofs= 0 chunkSize= (maxLineLength - 60) \ 2 While (ofs < binSize) If (ofs + chunkSize > binSize) Then chunkSize= binSize- ofs End If If (ofs = 0) Then oFile.WriteLine "WRITETEXT " & sQuotedTableName & ".[" & _ sFieldName & "] @ptrval 0x" & _ Mid(insField, (ofs * 2) + 1, chunkSize * 2) & ";" Else oFile.WriteLine "UPDATETEXT " & sQuotedTableName & ".[" & _ sFieldName & "] @ptrval " & Right(Space(6) & ofs, 7) & " 0 0x" & _ Mid(insField, (ofs * 2) + 1, chunkSize * 2) & ";" End If ofs= ofs + chunkSize WEnd oFile.WriteLine "GO" WEnd ' 'Write out NTEXT column data. ' While (sNtextColumns <> "") idx= InStr(sNtextColumns, "|") sFieldName= Left(sNtextColumns, idx - 1) sNtextColumns= Mid(sNtextColumns, idx + 1) WScript.Echo "Deferred NTEXT processing for " & sQuotedTableName & ".[" & sFieldName & "]" insField= GetFieldValue(oRS.Fields(sFieldName), True) 'Get real field value lenField= Len(insField) binSize= oRS.Fields(sFieldName).ActualSize / 2 identityValue= oRS.Fields(sIdentityColumn).Value oFile.WriteLine "DECLARE @ptrval binary(16);" oFile.WriteLine "SELECT @ptrval= TEXTPTR([" & sFieldName & _ "]) FROM " & sQuotedTableName & " WHERE ([" & _ sIdentityColumn & "] = " & identityValue & ");" ofs= 0 chunkSize= (maxLineLength - 60) While (ofs < binSize) If (ofs + chunkSize > binSize) Then chunkSize= binSize- ofs End If If (ofs = 0) Then oFile.WriteLine "WRITETEXT " & sQuotedTableName & ".[" & _ sFieldName & "] @ptrval N'" & _ FixQuotes(Mid(insField, ofs + 1, chunkSize)) & "';" Else oFile.WriteLine "UPDATETEXT " & sQuotedTableName & ".[" & _ sFieldName & "] @ptrval " & Right(Space(6) & ofs, 7) & " 0 N'" & _ FixQuotes(Mid(insField, ofs + 1, chunkSize)) & "';" End If ofs= ofs + chunkSize WEnd oFile.WriteLine "GO" WEnd ' 'Write out TEXT column data. ' While (sTextColumns <> "") idx= InStr(sTextColumns, "|") sFieldName= Left(sTextColumns, idx - 1) sTextColumns= Mid(sTextColumns, idx + 1) WScript.Echo "Deferred TEXT processing for " & sQuotedTableName & ".[" & sFieldName & "]" insField= GetFieldValue(oRS.Fields(sFieldName), True) 'Get real field value lenField= Len(insField) binSize= oRS.Fields(sFieldName).ActualSize identityValue= oRS.Fields(sIdentityColumn).Value oFile.WriteLine "DECLARE @ptrval binary(16);" oFile.WriteLine "SELECT @ptrval= TEXTPTR([" & sFieldName & _ "]) FROM " & sQuotedTableName & " WHERE ([" & _ sIdentityColumn & "] = " & identityValue & ");" ofs= 0 chunkSize= (maxLineLength - 60) While (ofs < binSize) If (ofs + chunkSize > binSize) Then chunkSize= binSize- ofs End If If (ofs = 0) Then oFile.WriteLine "WRITETEXT " & sQuotedTableName & ".[" & _ sFieldName & "] @ptrval '" & _ FixQuotes(Mid(insField, ofs + 1, chunkSize)) & "';" Else oFile.WriteLine "UPDATETEXT " & sQuotedTableName & ".[" & _ sFieldName & "] @ptrval " & Right(Space(6) & ofs, 7) & " 0 '" & _ FixQuotes(Mid(insField, ofs + 1, chunkSize)) & "';" End If ofs= ofs + chunkSize WEnd oFile.WriteLine "GO" WEnd oRS.MoveNext WEnd oFile.WriteLine "GO" oFile.WriteLine If (bHasRealIdentityColumn) Then oFile.WriteLine "SET IDENTITY_INSERT " & sQuotedTableName & " OFF;" oFile.WriteLine "GO" oFile.WriteLine End If End Sub Function GetQuotedTableName(own, tab) If (own <> "") Then GetQuotedTableName= "[" & own & "].[" & tab & "]" Else GetQuotedTableName= "[" & tab & "]" End If End Function Function GetFieldValue(fld, realValue) If ((fld.Status = adFieldIsNull) Or (IsNull(fld.Value))) Then GetFieldValue= "NULL" Exit Function End If Select Case fld.Type Case adSmallInt GetFieldValue= fld.Value Case adInteger GetFieldValue= fld.Value Case adSingle GetFieldValue= fld.Value Case adDouble GetFieldValue= fld.Value Case adCurrency GetFieldValue= fld.Value Case adBoolean GetFieldValue= fld.Value Case adDecimal: GetFieldValue= fld.Value Case adTinyInt GetFieldValue= fld.Value Case adBigInt GetFieldValue= fld.Value Case adGUID GetFieldValue= "'" & CStr(fld.Value) & "'" Case adChar If (realValue And (fld.ActualSize >= 2000)) Then GetFieldValue= fld.Value Else GetFieldValue= "'" & FixQuotes(fld.Value) & "'" End If Case adWChar If (realValue And (fld.ActualSize >= 2000)) Then GetFieldValue= fld.Value Else GetFieldValue= "N'" & FixQuotes(fld.Value) & "'" End If Case adNumeric GetFieldValue= fld.Value Case adDBTimeStamp GetFieldValue= "'" & GetDateString(fld.Value) & "'" Case adVarChar If (realValue And (fld.ActualSize >= 2000)) Then GetFieldValue= fld.Value Else GetFieldValue= "'" & FixQuotes(fld.Value) & "'" End If Case adLongVarChar If (realValue And (fld.ActualSize >= 2000)) Then GetFieldValue= fld.Value Else GetFieldValue= "'" & FixQuotes(fld.Value) & "'" End If Case adVarWChar If (realValue And (fld.ActualSize >= 2000)) Then GetFieldValue= fld.Value Else GetFieldValue= "N'" & FixQuotes(fld.Value) & "'" End If Case adLongVarWChar If (realValue And (fld.ActualSize >= 2000)) Then GetFieldValue= fld.Value Else GetFieldValue= "N'" & FixQuotes(fld.Value) & "'" End If Case adBinary If (realValue) Then GetFieldValue= GetBinaryString(fld) Else GetFieldValue= "00" End If Case adVarBinary If (realValue) Then GetFieldValue= GetBinaryString(fld) Else GetFieldValue= "00" End If Case adLongVarBinary If (realValue) Then GetFieldValue= GetBinaryString(fld) Else GetFieldValue= "00" End If Case Else Call Usage("Encountered unsupported field type (" & fld.Type & ")") End Select End Function Function GetBinaryString(fld) Dim x, sb, sx, sc, byt, hc, bin sb= "" '"0x" sx= "" bin= fld.GetChunk(fld.ActualSize) If (IsNull(bin)) Then bin= fld.GetChunk(fld.ActualSize) End If For x= 1 To fld.ActualSize sc= Right("0" & Hex(AscB(MidB(bin, x, 1))), 2) If (Len(sc) <> 2) Then WScript.Echo "ERROR: sc=[" & sc & "]" End If sx= sx & sc If ((x \ 300) = 0) Then sb= sb & sx sx= "" End If Next 'WScript.Echo "Bin length=" & Len(sb & sx) GetBinaryString= sb & sx End Function Function IsTextField(fld) If (fld.Status = adFieldIsNull) Then IsTextField= False ElseIf ((fld.Type = adWChar) Or _ (fld.Type = adVarWChar) Or _ (fld.Type = adLongVarWChar)) Then IsTextField= True Else IsTextField= False End If End Function Function IsWideText(fld) If (fld.Status = adFieldIsNull) Then IsWideText= False ElseIf ((fld.Type = adWChar) Or _ (fld.Type = adVarWChar) Or _ (fld.Type = adLongVarWChar)) Then IsWideText= True Else IsWideText= False End If End Function Function IsBinary(fld) If (fld.Status = adFieldIsNull) Then IsBinary= False ElseIf ((fld.Type = adBinary) Or _ (fld.Type = adVarBinary) Or _ (fld.Type = adLongVarBinary)) Then IsBinary= True Else IsBinary= False End If End Function Function IsNTEXT(fld) If (fld.Status = adFieldIsNull) Then IsNTEXT= False ElseIf (((fld.Type = adWChar) Or _ (fld.Type = adVarWChar) Or _ (fld.Type = adLongVarWChar)) And _ (fld.ActualSize >= 2000)) Then IsNTEXT= True Else IsNTEXT= False End If End Function Function IsTEXT(fld) If (fld.Status = adFieldIsNull) Then IsTEXT= False ElseIf (((fld.Type = adChar) Or _ (fld.Type = adVarChar) Or _ (fld.Type = adLongVarChar)) And _ (fld.ActualSize >= 2000)) Then IsTEXT= True Else IsTEXT= False End If End Function Function FixQuotes(val) FixQuotes= Replace(val, "'", "''") End Function Function GetDateString(val) Dim ds, msecs ' 'NOTE: VBScript doesn't have a DatePart parameter for the milliseconds ' in a datetime (adDBTimeStamp) value. ' ds= DatePart("yyyy", val) & "-" & _ Right("0" & DatePart("m", val), 2) & "-" & _ Right("0" & DatePart("d", val), 2) & " " & _ Right("0" & DatePart("h", val), 2) & ":" & _ Right("0" & DatePart("n", val), 2) & ":" & _ Right("0" & DatePart("s", val), 2) ' 'Now take the difference between the to-the-second date string 'and the actual field value to obtain the milliseconds value; 'multiply it by the number of millseconds in a day (86400000). 'Get the rightmost 3 zero-filled digits as a string. ' msecs= CLng(CDbl(val) - CDbl(CDate(ds))) * msecsPerDay GetDateString= ds & "." & Right("00" & msecs, 3) End Function Sub WriteDelete(sTab) oFile.WriteLine "PRINT N'Deleting existing values from " & sTab & "';" oFile.WriteLine "DELETE FROM " & sTab & ";" oFile.WriteLine "GO" oFile.WriteLine End Sub Sub WriteSectionHeader() oFile.WriteLine "/* ======================================================================= */" oFile.WriteLine End Sub Sub Usage(reason) WScript.Echo WScript.Echo reason WScript.Echo WScript.Echo "GenerateSqlInserts version " & kVersionString WScript.Echo "From CodeHQ.net, http://codehq.net/" WScript.Echo WScript.Echo "Usage: GenerateSqlInserts.vbs" WScript.Echo " [/server:{s}] /database:{d} [/owner:{o}] /tables:{t}" WScript.Echo " [/width:{w}] /out:{f} [/overwrite] [/noCreateTime]" WScript.Echo " [/forwardDelete | /noDelete]" WScript.Echo WScript.Echo " {s} SQL Server instance name; default: (local)." WScript.Echo " {d} Database name; no default." WScript.Echo " {o} Object owner name; default: dbo." WScript.Echo " {t} Comma-separated list of table names; no default." WScript.Echo " {w} Output width in characters; default: 500." WScript.Echo " {f} Output file name; no default." WScript.Echo WScript.Echo " Each table name in the list can be optionally followed by a colon" WScript.Echo " and the name of a forced identity column (if the table does not" WScript.Echo " have one)." WScript.Echo WScript.Echo " The script will NOT overwrite an existing output file unless the" WScript.Echo " /overwrite switch is specified." Call WScript.Quit(1) End Sub #################################################################### #################################################################### PART III: VB.NET #################################################################### #################################################################### Contents: Part 1. Some simple uses of Toolbox controls and user interface elements Part 2. Working with menus and dialog boxes Part 3. Working with procedures Part 4. Text files and String Processing Part 5. VB.NET and COM Servers like MS Office components (not native .NET) Part 6. Process Control Part 7. Inheritance Part 8. VB .NET and ADO .NET Part 9. How to call MSSQL or Oracle stored procedures Part 10. VB .NET and XML ==================================================================== Part 1: Some simple uses of Toolbox controls user interface elements: ==================================================================== 1.1 Lucky Seven "slot machine": =============================== - Form1 Design: --------------- The form contains 2 buttons: "spin" and "end". There are 3 labels that will display the resulting numbers of spinning the slotmachine. There is 1 label, just showing text: Lucky Seven There is 1 Picture Box object, showing a picture if a number is 7 There is 1 label showing the number of Wins There is 1 label showing the winrate - Code Standard Module: ----------------------- needed for two public global variables "Wins" and "spins" needed for a function HitRate which calculates the ratio of number of spins and number wins Module Module1 Public Wins As Short Public Spins As Short Function HitRate(ByVal Hits As Short, ByVal Tries As Short) As String Dim Percent As Single Percent = Hits / Tries Return Format(Percent, "0.0%") End Function End Module - Code Form1: ------------- Here you find event handlers for the 2 buttons Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click End End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click PictureBox1.Visible = False ' hide picture Label1.Text = CStr(Int(Rnd() * 10)) ' pick numbers Label2.Text = CStr(Int(Rnd() * 10)) Label3.Text = CStr(Int(Rnd() * 10)) Spins = Spins + 1 ' if any caption is 7 display picture and beep If (Label1.Text = "7") Or (Label2.Text = "7") _ Or (Label3.Text = "7") Then PictureBox1.Visible = True Beep() Wins = Wins + 1 lblWins.Text = "Wins: " & Wins End If lblRate.Text=HitRate(Wins,Spins) End Sub End Class 1.2 Hello World: ================ - Form1 Design: --------------- There is 1 TextBox control, showing "Hello World" after the button is pressed. There is 1 button with an eventhandler procedure, which displays "Hello, world!" in the TextBox control mentioned above. - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click TextBox1.Text = "Hello, world!" End Sub End Class 1.3 Example eventhandlers of Input controls: ============================================ Example: Eventhandler when the user clicks a button: ---------------------------------------------------- Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim Prompt, Title As String Dim i As Short Prompt = "Enter the day's high temperature." For i = 0 To UBound(Temperatures) Title = "Day " & (i + 1) Temperatures(i) = InputBox(Prompt, Title) Next End Sub Example: Eventhandler for "Radiobutton": --------------------------------------- Private Sub RadioButton1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButton1.CheckedChanged PictureBox1.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\pcomputr.bmp") End Sub Private Sub RadioButton2_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButton2.CheckedChanged PictureBox1.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\computer.bmp") End Sub Example: Eventhandler for Checkboxes: ------------------------------------ Private Sub CheckBox1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged 'If the CheckState property for a check box is 1, it has a mark in it If CheckBox1.CheckState = 1 Then PictureBox2.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\answmach.bmp") PictureBox2.Visible = True Else 'If there is no mark, hide the image PictureBox2.Visible = False End If End Sub Example: Loading a ListBox and/or ComboBox at runtime: -------------------------------------------------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 'These program statements run when the form loads PictureBox1.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\pcomputr.bmp") 'Add items to a list box like this: ListBox1.Items.Add("Extra hard disk") ListBox1.Items.Add("Printer") ListBox1.Items.Add("Satellite dish") 'Combo boxes are also filled with the Add method: ComboBox1.Items.Add("U.S. Dollars") ComboBox1.Items.Add("Check") ComboBox1.Items.Add("English Pounds") End Sub Example: Eventhandler when user selects item in a ListBox: --------------------------------------------------------- Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged 'The item you picked (0-2) is held in the SelectedIndex property Select Case ListBox1.SelectedIndex Case 0 PictureBox3.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\harddisk.bmp") Case 1 PictureBox3.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\printer.bmp") Case 2 PictureBox3.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\satedish.bmp") End Select End Sub Example: Eventhandler when user selects item in a ComboBox: ---------------------------------------------------------- Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged 'The selected list item (numbered 0-2) is stored in the SelectedIndex property Select Case ComboBox1.SelectedIndex Case 0 PictureBox5.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\dollar.bmp") Case 1 PictureBox5.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\check.bmp") Case 2 PictureBox5.Image = System.Drawing.Image.FromFile _ ("c:\vbnetsbs\chap03\input controls\poundbag.bmp") End Select End Sub End Class Example: Eventhandler when user selects a command in a Menu: ------------------------------------------------------------ Private Sub mnuOpenItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOpenItem.Click OpenFileDialog1.Filter = "Bitmaps (*.bmp)|*.bmp" If OpenFileDialog1.ShowDialog() = DialogResult.OK Then PictureBox1.Image = System.Drawing.Image.FromFile _ (OpenFileDialog1.FileName) mnuCloseItem.Enabled = True End If End Sub 1.4 LinkLabel control: ====================== The form can show any url and start explorer. - Form1 Design: --------------- The form contains a LinkLabel control: the Text property is set to "www.microsoft.com/mspress/" - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked ' Change the color of the link by setting LinkVisited to True. LinkLabel1.LinkVisited = True ' Use the Process.Start method to open the default broswer ' using the Microsoft Press URL: System.Diagnostics.Process.Start("IExplore.exe", _ "http://www.microsoft.com/mspress/") End Sub End Class 1.5 Working with arrays: ======================== Fixed size array: ----------------- - Form1 Design: --------------- 1 TextBox object, Multiline, Vertical scrollbar 1 button, text="Enter Temps" 1 button, text="Display Temps" - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Dim Temperatures(6) As Single Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim Prompt, Title As String Dim i As Short Prompt = "Enter the day's high temperature." For i = 0 To UBound(Temperatures) Title = "Day " & (i + 1) Temperatures(i) = InputBox(Prompt, Title) Next End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim i As Short Dim Result As String Dim Total As Single = 0 Result = "High Temperatures for the week:" & vbCrLf & vbCrLf For i = 0 To UBound(Temperatures) Result = Result & "Day " & (i + 1) & vbTab & Temperatures(i) & vbCrLf Total = Total + Temperatures(i) Next Result = Result & vbCrLf & "Average temperature: " & Format(Total / 7, "0.0") TextBox1.Text = Result End Sub End Class Dynamic array: -------------- If you do not know the number of elements in an array beforehand, you can use a dynamic array: Dim Temperatures() As Single Dim Days As Short Days=InputBox("How many days?") Redim Temperatures(Days - 1) 1.6 Working with objects in a collection: ========================================= Example 1: The Controls collection ---------------------------------- The "Controls collection" represent the entire set of objects on a form. Dim Ctrl As Control For Each Ctrl In Controls Do something... Next Ctrl So you can, for example, change the Enabled, Left, Text, Visible etc.. properties' of all the objects in the collection. The following program will do such an action: - Form1 Design: --------------- 3 buttons on Form1 - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form ' Declare a variable of type Control to represent form controls Dim ctrl As Control Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click For Each ctrl In Controls ctrl.Text = "Click Me!" Next End Sub End Class The Button1_Click event procedure will change the Text property of all 3 buttons in one run in "Click Me!" Example 2: Creating your own collection --------------------------------------- The Collection is an array like object designed to hold objects like user interface controls, but can also be used to store strings or other items. - Form1 Design: --------------- 1 TextBox with initial Text property "http://www.microsoft.com/mspress" 1 Button with Text="Visit Site" 1 Button with Text="List all sites visited" - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Dim URLsVisited As New Collection() Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click URLsVisited.Add(TextBox1.Text) ' Use Add method to populate the Collection System.Diagnostics.Process.Start(TextBox1.Text) End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim URLName, ALLUrls As String For Each URLName In URLsVisited ALLUrls = ALLUrls & URLName & vbCrLf Next URLName MsgBox(ALLUrls, MsgBoxStyle.Information, "Web sites visited sofar") End Sub End Class 1.7 Loops: ========== Do Until Loop: -------------- Do Until EOF(1) 'read lines from file LineOfText = LineInput(1) 'add each line to the AllText variable AllText = AllText & LineOfText & vbCrLf Loop For.. Next: ----------- For Each ctrl In Controls ctrl.Text = "Click Me!" Next 1.8 Error handling: =================== You can use the following to trap errors: Try .. statements that might produce a runtime error Catch .. statements to run if error occurs Finaly .. optional statements End Try .. end of handling Example 1: ---------- Here is an example of code NOT handling a disk drive error: Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click PictureBox1.Image = _ System.Drawing.Bitmap.FromFile("a:\fileopen.bmp") End Sub End Class If the floppy drive does not contain a disk, the following error occurs: An unhandled exception of type 'System.IO.FileNotFoundException' occurred in system.drawing.dll Example 2: ---------- Now we have added an error handler: Public Class Form1 Inherits System.Windows.Forms.Form Dim Retries As Short = 0 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Try PictureBox1.Image = _ System.Drawing.Bitmap.FromFile("a:\fileopen.bmp") Catch Retries += 1 If Retries <= 2 Then MsgBox("Please insert the disk in drive A!") Else MsgBox("File Load feature disabled") Button1.Enabled = False End If End Try End Sub End Class You can also use the Err object. It has a number of usefull properties: Err.Number propery Err.Description property Err.Clear method Example 3: ---------- Try PictureBox1.Image = _ System.Drawing.Bitmap.FromFile("a:\fileopen.bmp") Catch When Err.Number = 53 ' That's file not found error MsgBox("Check path and disk drive") Catch When Err.Number = 7 ' That's out of memory error MsgBox("Is this really a bitmap file?", , Err.Description) End Try ==================================================================== Part 2: Working with menus and dialog boxes: ==================================================================== You can add a Main Menu to your program by adding the "MainMenu" control from the Toolbox to the Form. Now it is possible to add Menu commands at the form. Example 1: ---------- 1. The MainMenu Control has been added. 2. Now we can create menu items like Clock Date Time and possibly more items. You can expand the menu as you like. - Form1 Design: --------------- Add the MainMenu control Create a clock menu like: Clock Date Time A label control (to display the date and time) - Code Form1: ------------- Now event handlers for the menu commands must be created. In the case of the clock example, the code could be like the follwing: Public Class Form1 Inherits System.Windows.Forms.Form Private Sub MenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem3.Click Label1.Text = TimeString End Sub Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click Label1.Text = DateString End Sub End Class Example 2: ---------- Using the MainMenu Control with the 7 standard dialog controls: OpenFileDialog SaveFileDialog FontDialog ColorDialog PrintDialog PrintPreviewDialog PageSetupDialog - Form1 Design: --------------- Add the MainMenu control Add OpenFileDialog control Add a PictureBox control (used to dipslay an opened bitmap file) Create a File menu like: File Open Close Exit - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub mnuOpenItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOpenItem.Click OpenFileDialog1.Filter = "Bitmaps (*.bmp)|*.bmp" If OpenFileDialog1.ShowDialog() = DialogResult.OK Then PictureBox1.Image = System.Drawing.Image.FromFile _ (OpenFileDialog1.FileName) mnuCloseItem.Enabled = True End If End Sub Private Sub mnuExitItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExitItem.Click End End Sub Private Sub mnuCloseItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuCloseItem.Click PictureBox1.Image = Nothing mnuCloseItem.Enabled = False End Sub End Class ==================================================================== Part 3: Working with procedures: ==================================================================== 2 Types of procedures: - function procedures - Sub procedures Place as much general purpose functions and procedures in a module so they can be called from any place in your project. ByVal: if the variables passed to function are modified during the procedure the updates are not returned to the caller. ByRef: updates are returned to the caller. 3.1 How to use a function: -------------------------- Function TotalTax(ByVal Cost as Single) As Single Dim StateTax, CityTax As Single StateTax = Cost * 0.05 CityTax = Cost * 0.015 TotalTax = StateTax + CityTax 'final calculation in functionname End Function or Function TotalTax(ByVal Cost as Single) As Single Dim StateTax, CityTax As Single StateTax = Cost * 0.05 CityTax = Cost * 0.015 Return StateTax + CityTax 'final calculation returned with Return statement End Function Now call the TotalTax function in a event procedure: lblTaxes.Text = TotalTax(500) 3.2 How to use a Sub procedure: ------------------------------- Sub BirthdayGreeting (ByVal Person As String) Dim Msg As String If Person <> "" Then Msg = "Happy birthday " & Person & "!" Else Msg = "Name not specified." End If MsgBox(Msg, ,"Best Wishes") End Sub Now call the Sub procedure: BirthdayGreeting("Robert") 3.3 Data Entry 1: ----------------- - Form1 Design: --------------- 1 Label name="lblSales" Text="Sales", 1 Label name="lblMkt" Text="Marketing" 1 TextBox name=txtSales (Multiline, Scrollbar vertical) 1 TextBox name=txtMkt (Multiline, Scrollbar vertical) 1 button name=btnSales, Text=Add Name 1 button name=btnMkt, Text=Add Name 1 button name=btnQuit, Text=Quit - Code Standard Module: ----------------------- Module Module1 Sub AddName(ByVal Team As String, ByRef ReturnString As String) Dim Prompt, Nm, WrapChar As String Prompt = "Enter a " & Team & " employee." Nm = InputBox(Prompt, "Fill in the name") WrapChar = Chr(13) + Chr(10) ' Carriage return plus linefeed ReturnString = Nm & WrapChar End Sub End Module - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub btnSales_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSales.Click Dim SalesPosition As String AddName("Sales", SalesPosition) txtSales.Text = txtSales.Text & SalesPosition End Sub Private Sub btnMkt_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnMkt.Click Dim MktPosition As String AddName("Sales", MktPosition) txtMkt.Text = txtMkt.Text & MktPosition End Sub Private Sub btnQuit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnQuit.Click End End Sub End Class ==================================================================== Part 4. Text files and String Processing: ==================================================================== There are several possibilities to work (display, write to disk) with text files. 4.1 Browsing a textfile using the TextBox object: ------------------------------------------------- You will use the OpenFileDialog with which you can get the path from the user. Then you will use a number of functions: FileOpen(), LineInput(), EOF, and FileClose() - Form1 Design: --------------- 1 TextBox name="txtNote" (Multiline, scrollbars both) 1 Label object name="lblNote" Text="Load a text file with the Open command" 1 MainMenu control 1 OpenFileDialog control Create a File menu like: File (menuItem1) Open (mnuOpenItem) Close (mnuCloseItem) Exit (mnuExitItem) - Code Form 1: -------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub mnuExitItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExitItem.Click End End Sub Private Sub mnuOpenItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuOpenItem.Click Dim AllText, LineOfText As String OpenFileDialog1.Filter = "Text files (*.TXT)|*.TXT" OpenFileDialog1.ShowDialog() 'display Open dialog box If OpenFileDialog1.FileName <> "" Then Try 'open file and trap any errors using handler FileOpen(1, OpenFileDialog1.FileName, OpenMode.Input) Do Until EOF(1) 'read lines from file LineOfText = LineInput(1) 'add each line to the AllText variable AllText = AllText & LineOfText & vbCrLf Loop lblNote.Text = OpenFileDialog1.FileName 'update label txtNote.Text = AllText 'display file txtNote.Select(1, 0) 'remove text selection txtNote.Enabled = True 'allow text cursor mnuCloseItem.Enabled = True 'enable Close command mnuOpenItem.Enabled = False 'disable Open command Catch MsgBox("Error opening file.") Finally FileClose(1) 'close file End Try End If End Sub Private Sub mnuCloseItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuCloseItem.Click txtNote.Text = "" 'clear text box lblNote.Text = "Load a text file with the Open command." mnuCloseItem.Enabled = False 'disable Close command mnuOpenItem.Enabled = True 'enable Open command End Sub End Class 4.2 Editing and Saving a textfile using the TextBox object: ------------------------------------------------------------- You will use the SaveFileDialog with which you can get the path from the user. Then you will use a number of functions: FileOpen(), PrintLine() and FileClose() - Form1 Design: --------------- 1 TextBox name="txtNote" (Multiline, scrollbars both) 1 Label object name="lblNote" Text="Type your text and save it to a file" 1 MainMenu control 1 SaveFileDialog control Create a File menu like: File (MenuItem1) SaveAs (mnuSaveAsItem) InsertDate (mnuInsertDateItem) Exit (mnuExitItem) - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub mnuSaveAsItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSaveAsItem.Click SaveFileDialog1.Filter = "Text files (*.txt)|*.txt" SaveFileDialog1.ShowDialog() If SaveFileDialog1.FileName <> "" Then FileOpen(1, SaveFileDialog1.FileName, OpenMode.Output) PrintLine(1, txtNote.Text) 'copy text to disk FileClose(1) End If End Sub Private Sub mnuInsertDateItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuInsertDateItem.Click txtNote.Text = DateString & vbCrLf & txtNote.Text ' Date will thus be in upper section of the text txtNote.Select(1, 0) 'remove selection End Sub Private Sub mnuExitItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExitItem.Click End End Sub Private Sub lblNote_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblNote.Click End Sub End Class 4.3 Some string processing examples: ------------------------------------ Dim Slogan As String Slogan = "Bring" & " on the " & "circus!" 'Slogan="Bring on the circus!" Dim Slogan As String Slogan = String.Concat("Bring"," on the ","circus!") Dim Name, NewName As String Name="Kim" NewName=Name.ToUpper 'result is KIM, compare to UCase from VB6 Dim Name, NewName As String Name="Kim" NewName=Name.ToLower 'result is kim, compare to LCase from VB6 Dim River As String Dim Size As Short River="Mississippi" Size=River.Lenght 'result Size=11, compare to Len from VB6 Dim Test, Middle As String Test="First Second Third" Middle=Test.Substring(6,6) 'result Middle="Second", compare to Mid from VB6 Dim Test, Trimmed As String Test=" Hello " Trimmed=Test.Trim 'result Trimmed="Hello", compare to Trim from VB6 Dim AscCode As Short AscCode=Asc("z") 'result AscCode=112 Dim Letter As Char Letter=Chr(122) 'result Letter="z" "A"<"B" 'True, compare ASCII codes "A">"B" 'False, compare ASCII codes Private Sub int_to_string Dim No_of_records, Cur_record As Integer No_of_records=100 Cur_rec=10 lbl1.Text=No_of_records.ToString lbl2.Text=Cur_record.ToString End Sub ==================================================================== Part 5. VB.NET and COM Servers like MS Office components: ==================================================================== VB .NET is not designed to the former COM specifications, but primarily to the .net framework and associated classes. The COM technology specifies "server" objects that can expose there methods and properties, which "client" or "controlling" programs can use. This is also referred to as automation. Still you can use COM components in VB .NET applications. VB will generate a class "wrapper" for the component. This acts like a .NET interface around the COM components. One example of server components are Office components like those from Office 97, Office 2000, Office XP. Before you write the VB .NET program, add a reference to the COM component to your application. The "Add reference" dialog box will display all .NET, COM, and PROJECTS objects that you can incorporate. 5.1 Example: VB .NET and automation with Excel: ----------------------------------------------- We are goiing to use Excel functions in our VB program. The program will be a mortgage payment calculator. 1. Create a new project 2. Add a reference to the project to the Microsoft Excel Object Libary. This is the "old" Office suite of Offcice 97, 2000, or XP In the Solution Explorer you will find along the .NET references also a reference to Excel: - System - System.Drawing - System.Windows.Forms etc... - Excel - Form1 Design: --------------- - A Label, Label1, just containing text "Calculate Payements using Excel" - 3 Labels, Label2, Label3, Label4, containing text "Interest", "MOnths", and "Principal". - 3 Textboxes used for user input: TextBox1 name=txtInterest TextBox2 name=txtMonths TextBox3 name=txtPrincipal - 1 TextBox name=txtResult, used to display the LoanPayment - 1 Button, name=btnCalculate, Text=Calculate, used to start the calculation. - Code Form1: ------------- We only need to write an eventhandler for the Button control Public Class Form1 Inherits System.Windows.Forms.Form Private Sub btnCalculate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCalculate.Click Dim xlApp As Excel.Application Dim LoanPayment As Short xlApp = CType(CreateObject("Excel.Application"), Excel.Application) LoanPayment = xlApp.WorksheetFunction.Pmt(txtInterest.Text / 12, txtMonths.Text, txtPrincipal.Text) txtResult.Text = LoanPayment xlApp.Quit() End Sub End Class ==================================================================== Part 6. Process Control: ==================================================================== You can launch any Windows application (for example, in an eventhandler) by using the Process.Start command: Examples: --------- Private Sub btn_Click System.Diagnostics.Process.Start("notepad.exe") End Sub Private Sub btn_Click System.Diagnostics.Process.Start("IExplore.exe", _ "http://www.microsoft.com/mspress/") End Sub So you can start applicaties this way, but there is no further control from VB. In the Toolbox you find the Components tab. Here the "process" control is listed. This control can be usefull to have control over started applications. Example: -------- - Form1 Design: --------------- - Create a new project - Add the process control to the form. Right Click the process control and set the name to "noteProces"s. - Create 2 buttons: Button1 with text= Start Notepad Button2 with text= Stop Notepad You now must use the objectname "noteProcess" in your program code: - Code Form1: ------------- Imports System.Threading Imports System.Diagnostics Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click noteProcess.Start() End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click noteProcess.CloseMainWindow() End Sub End Class ==================================================================== Part 7. Inheritance ==================================================================== Form1: Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click MsgBox("You clicked OK") End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click MsgBox("You clicked Cancel") End Sub End Class Form2: Public Class Form2 Inherits My_Form_Inheritance.Form1 Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click MsgBox("This is the inherited form!") End Sub End Class ==================================================================== Part 8. VB .NET and ADO .NET ==================================================================== Method 1. --------- Connection -> Data Adapter -> Dataset -> bind to the Form To use VB .NET with databases, you use ADO .NET. First you create a number of objects that let your program connect to the database, and extract data from this database. 1. Create a "Connection". - Start Server Explorer. - Create a "connection" meaning that you choose a provider like "Microsoft OLE DB Provider for SQL Server" or "Microsoft JET 4.0 OLE DB Provider" or any other provider that does teh job. - As needed, depending on the provider chosen, enter the Servername, authentication information, and database name, in the associated dialogboxes. - If all went OK, in Server Explorer you can expand the chosen database and see the tables and the possible other objects it contains. 2. Create a "Data Adapter". - Start the "Data Adapter Configuration Wizard", or drag a table icon from Server Explorer onto the Form. The Wizard can be started by choosing the "OleDbDataAdapter" from the Toolbox. We do this procedure to make selections on which tables or views our Data Adapter will be based on. With the Wizard you can choose the tables and create the SELECT statements to retrieve the data. 3. Create the "Dataset". - We now create an object that represents the data we want to use. It is a representation of the data provided by the Connection object and extracted by the Data Adapter object. Next, choose "Generate Dataset" from the Data menu. 4. Create the Form using Bound Controls. You can use several controls from the Windows Forms Toolbox to display Database information, like the TextBox, ListBox, and the DataGrid control. These controls with a databinding property are also called "Bound Controls". Example: -------- - Form1 Design: --------------- We will create a Connection, Data Adapter and Dataset to an Access database "students". In this example we will only access the Instructors table and select only the Instructor field. In this example the Dataset is called DsInstructor1. Create the Form as follows: 1 Label name-lblInstructor, Text="Instructor" 1 TextBox name=txtInstructor, Text=empty 1 Button name=btnLoad, Text=Load Data Set the DataBinding Text property of the TextBox txtInstructor to the Dataset DsInstructor1. Now we need to program some code that loads the data. - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub btnLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoad.Click DsInstructors1.Clear() OleDbDataAdapter1.Fill(DsInstructors1) End Sub End Class This very simple example uses two methods, one to clear the Dataset and one to fill the Dataset. But this example will only show one record. Example: -------- We now enhance the above example. We add button controls and extra code in order to navigate through the records of the Dataset. So we add a couple of buttons to the project: Button1, name=btnFirst, Text=First Button2, name=btnLast, Text=Last Button3, name=btnPrev, Text=Previous Button4, name=btnNext, Text=Next The mechanisme involved is that ADO .NET is using an object called the "CurrencyManager". This object keeps track of all records associated with a Dataset. Also, there is a "BindingsContext" object that keeps track of all the "CurrencyManager" objects on the form. Now add the following eventhandlers for these new controls: Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Count() Dim Records, Current As Integer Records = Me.BindingContext(DsInstructors1, "Instructors").Count Current = Me.BindingContext(DsInstructors1, "Instructors").Position + 1 lblCount.Text = "Record" & Current.ToString & " of " & Records.ToString End Sub Private Sub btnLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoad.Click DsInstructors1.Clear() OleDbDataAdapter1.Fill(DsInstructors1) End Sub Private Sub btnFirst_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFirst.Click Me.BindingContext(DsInstructors1, "Instructors").Position = 0 Count() End Sub Private Sub btnLast_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLast.Click Me.BindingContext(DsInstructors1, "Instructors").Position = _ Me.BindingContext(DsInstructors1, "Instructors").Count - 1 Count() End Sub Private Sub btnPrev_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPrev.Click Me.BindingContext(DsInstructors1, "Instructors").Position -= 1 Count() End Sub Private Sub btnNext_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnNext.Click Me.BindingContext(DsInstructors1, "Instructors").Position += 1 Count() End Sub End Class Example: Using the DataGrid control ----------------------------------- Create a Connection, Data Adapter and Dataset as appropriate. This might be a connection to Access, or SQL Server etc.. On the form, place a DataGrid control. You may also place a button control, in order to load data. We now bind the data to the DataGrid control in the following manner: - Use the "DataSource" property to assigh the Dataset - Use the "DataMember" property to specify the sublist of data. Now you can create an eventhandler for the button to load the data. Private Sub btnLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoad.Click DataSetName.Clear() OleDbDataAdapter1.Fill(DataSetName) End Sub Example: Web application with ASP. NET: --------------------------------------- - Have IIS running with virtual directory /wwwroot/MyWebCalculator - Create a New project - Choose ASP.NET Web Application - choose as location: http://localhost/MyWebCalculator Visual Studio loads the Web Forms Designer and creates a Web Forms page WebForm1.aspx that will contain the user interface and a code behind file WebForm1.aspx.vb that will contain the code for the application. - WebForm1 Design: ------------------ WebForm1.aspx Create 3 Textbox controls: TextBox1 ID=txtAmount TextBox2 ID=txtInterest TextBox3 ID=txtPayment Create 3 labels: Label1 ID=lblAmount Text=Loan Amount Label2 ID=lblInterest Text=Interest Rate label3 ID=lblPayment Text=Monthly Payment Create 1 button: Button1 ID=btnCalculate Text=Calculate. - Code WebForm1: ---------------- WebForm1.aspx.vb Dubbleclick the button to create the eventhandler. Imports System.Math Public Class WebForm1 Inherits System.Web.UI.Page Protected WithEvents txtAmount As System.Web.UI.WebControls.TextBox Protected WithEvents txtInterest As System.Web.UI.WebControls.TextBox Protected WithEvents txtPayment As System.Web.UI.WebControls.TextBox Protected WithEvents lblAmount As System.Web.UI.WebControls.Label Protected WithEvents lblInterest As System.Web.UI.WebControls.Label Protected WithEvents lblPayment As System.Web.UI.WebControls.Label Protected WithEvents btnCalculate As System.Web.UI.WebControls.Button Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 'Put user code to initialize the page here End Sub Private Sub btnCalculate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCalculate.Click Dim LoanPayment As Single LoanPayment = Pmt(txtInterest.Text / 12, 36, txtAmount.Text) txtPayment.Text = Format(Abs(LoanPayment), "$0.00") End Sub End Class ==================================================================== Part 9. How to call MSSQL or Oracle stored procedures: ==================================================================== 9.1 GENERAL INFORMATION: ======================== In VB.NET,to access a database, there are several ways to do that. Here we are interested in how to call a stored procedure in a database like MSSQLserver or Oracle. There are several ways to use ADO.NET to call a stored procedure and to get back return values and return parameters, including: - Use a "DataSet" object to gather the returned rows and to work with these rows, in addition to the return values and the return parameters. - Use a "DataReader" object to gather the returned rows, to move through these rows, and to gather return values and return parameters. - Use the "ExecuteScalar" method to return the value from the first column of the results' first row with the return values and the return parameters. This is most useful with aggregate functions. - Use the "ExecuteNonQuery" method to return only the return parameters and the return values. Any returned rows are discarded. This is most useful for executing action queries. In using a Dataset, the approach is as follows: --------- connection DataBase |<-----|C |--- --------- | | Data Adapter ------- ---------- --------|D |----->|Data | |Form with| |Set |-------|bound | ------- |controls | ---------- first a "connection" is made, which specifies connection information about the database. For example, it is here that you choose a "provider" to access the database. Next a "data adapter" is created, which manages retreiving data from the database and posting data changes. Then a "dataset" is created, which is a representation of one ore more of the tables you plan to work with. Information in the dataset can then be bound to controls on a form. Connection -> Data Adapter -> Dataset -> bind to Controls on the Form To use VB .NET with databases, you most likely will use ADO .NET. To get to the database from Visual Studio, in a graphical way: First you create a number of objects that let your program connect to the database, and extract data from this database. 1. Create a "Connection". - Start Server Explorer. - Create a "connection" meaning that you choose a provider like "Microsoft OLE DB Provider for SQL Server" or "Microsoft JET 4.0 OLE DB Provider" or any other provider that does the job. - As needed, depending on the provider chosen, enter the Servername, authentication information, and database name, in the associated dialogboxes. - If all went OK, in Server Explorer you can expand the chosen database and see the tables and the possible other objects it contains. 2. Create a "Data Adapter". - Start the "Data Adapter Configuration Wizard", or drag a table icon from Server Explorer onto the Form. The Wizard can be started by choosing the "OleDbDataAdapter" from the Toolbox. We do this procedure to make selections on which tables or views our Data Adapter will be based on. With the Wizard you can choose the tables and create the SELECT statements to retrieve the data. Or you can choose the right stored procedures to work with. 3. Create the "Dataset". - We now create an object that represents the data we want to use. It is a representation of the data provided by the Connection object and extracted by the Data Adapter object. Next, choose "Generate Dataset" from the Data menu. 4. Create the Form using Bound Controls. You can use several controls from the Windows Forms Toolbox to display Database information, like the TextBox, ListBox, and the DataGrid control. These controls with a databinding property are also called "Bound Controls". You can also of course write the neccesary code "right away", without using Server explorer and that sort of tools. We will explore this approach in the following examples. These examples will use the DataReader and SqlCommand provider in section 1.2 and the DataReader and OleDb provider in section 1.3 Actually a third provider exists, namelijk the ODBC .NET provider. We illustrate this type of connection in section 1.4 Example 9.2 HOW TO: Call a Parameterized Stored Procedure by Using ADO.NET and SQLClient ======================================================================================== This example will use the SqlCommand provider. 1. We will use the Pubs database in SQL Server. Create the following stored procedure: create procedure stp_getauthorslastname @au_id varchar(20) as select au_lname from authors where au_id=@au_id 2. create a new VB.NET project. You must first choose your managed provider, that is either the "SqlCommand" or "OleDBCommand". In your project, put the correct references: System.Data System.Data.SqlClient System.Data.OleDb Use the Imports statement on the System and the System.Data namespaces so that you do not have to qualify declarations in those namespaces later in your code. You must use the Imports statement prior to any other declarations. Make sure to copy only the code for the provider that you have chosen. - SQL Client Imports System.Data.SqlClient - OLE DB Data Provider Imports System.Data.OleDb You can use the DataReader object to return a read-only, forward-only stream of data. The information that the DataReader contains can come from a stored procedure. This example uses the DataReader object to run a stored procedure that has an input parameter. Make a form with an TextBox (name=txtInput), a second TextBox (name=txtOutput) and a Start button. Make the following event procedure: Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim PubsConn As SqlConnection = New SqlConnection("Data Source=xpora;integrated security=sspi;initial Catalog=pubs;") Dim testCMD As SqlCommand = New SqlCommand("sp_get", PubsConn) testCMD.CommandType = CommandType.StoredProcedure Dim au_id As SqlParameter = testCMD.Parameters.Add("@au_id", SqlDbType.VarChar, 11) au_id.Direction = ParameterDirection.Input au_id.Value = txtInput.Text PubsConn.Open() Dim myReader As SqlDataReader = testCMD.ExecuteReader myReader.Read() txtOutput.Text = myReader.GetString(0) myReader.Close() End Sub Here only one value is retreived. If you get more values back, you need to loop, as for example Do While myReader.Read() Loop Notice that the code loops through the DataReader. This is because the DataReader reads only one line at a time. Example 9.3 HOW TO: Call a Parameterized Stored Procedure by Using ADO.NET and OleDb ==================================================================================== This example is very similar to example 1.2. This time we will use the OleDB provider. Make a form with an TextBox (name=txtInput), a second TextBox (name=txtOutput) and a Start button. Make the following event procedure: Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim PubsConn As OleDbConnection = New OleDbConnection & _ ("Provider=sqloledb;Data Source=xpora;" & _ "integrated security=sspi;initial Catalog=pubs;") Dim testCMD As OleDbCommand = New OleDbCommand & _ ("sp_get", PubsConn) testCMD.CommandType = CommandType.StoredProcedure Dim au_id As SqlParameter = testCMD.Parameters.Add("@au_id", SqlDbType.VarChar, 11) au_id.Direction = ParameterDirection.Input au_id.Value = txtInput.Text PubsConn.Open() Dim myReader As OleDbDataReader = testCMD.ExecuteReader myReader.Read() txtOutput.Text = myReader.GetString(0) myReader.Close() End Sub -- -------------------------------------------- Conclusion: - Choose the provider - Define a SqlConnection / or OleDbConnection) - Define the SqlCommand / or OleDbCommand) - Define Commandtype - Define optional SqlParameter / or OleDbParameter) - Define SqlDataReader / or OleDbDataReader) - Use the Read() method of the DataReader to move through the records - put result somewhere - Close() So you define: Dim MyConnection As SqlConnection / or Dim MyConnection As OleDbConnection Dim MyCommand As SqlCommand / or Dim MyCommand As OleDbCommand Dim MyDataReader As SqlDataReader / or Dim MyDataReader As OleDbDataReader -- -------------------------------------------- Example 9.4 HOW TO: Execute SQL Parameterized Stored Procedures by Using the ODBC .NET Provider =============================================================================================== This time your program must have a reference to "Microsoft.Data.ODBC" namespace. So, let your program begin with: Imports Microsoft.Data.ODBC This step-by-step example, describes how to call a parameterized SQL Server stored procedure using the ODBC .NET Managed Provider and Visual Basic .NET. Although executing a parameterized stored procedure using the ODBC .NET Provider is slightly different from executing the same procedure using the SQL or the OLE DB Provider, there is one important difference -- the stored procedure must be called using the ODBC CALL syntax rather than the name of the stored procedure. Call Syntax Examples - Here is an example of the call syntax for an actual stored procedure in the Northwind sample database that expects one input parameter: {CALL CustOrderHist (?)} - Here is an example of the call syntax for a stored procedure that expects one input parameter and returns one output parameter and a return value. The first placeholder represents the return value: {? = CALL Procedure1 (?, ?) The ODBC .NET Managed Provider, like the OLE DB Provider, processes parameters by ordinal position (zero-based) and not by name. As in the other examples, create a form with an TextBox (name=txtInput), a second TextBox (name=txtOutput) and a Start button. Make the following event procedure: Dim cn As OdbcConnection Try cn = New OdbcConnection("Driver={SQL Server};Server=(local);Database=Northwind;Trusted_Connection=Yes") Dim cmd As OdbcCommand = New OdbcCommand("{call CustOrderHist (?)}", cn) Dim prm As OdbcParameter = cmd.Parameters.Add("@CustomerID", OdbcType.Char, 5) prm.Value = "ALFKI" cn.Open() Dim dr As OdbcDataReader = cmd.ExecuteReader() While dr.Read Console.WriteLine(dr.GetString(0)) End While dr.Close() Catch o As OdbcException MsgBox(o.Message.ToString) Finally cn.Close() End Try Example 9.5 GET DATA FROM A SQL Server 2000 DATABASE WITH A STORED PROCEDURE USING A DATASET: ============================================================================================== This example shows that's easy to receive data from SQL Server into a Dataset. Suppose we have a SQL Server database TEST with the tables EMP, DEPT, LOC. Suppose we have the following records in EMP SELECT * FROM EMP EMPID EMPNAME DEPID ----------- ---------------- ----------- 1 Joop 1 2 Gerrit 2 3 Harry 2 4 Christa 3 5 NULL 4 6 Nina 5 7 Nadia 5 (7 row(s) affected) We also have a Stored Procedure show_emp: create procedure show_emp as select * from EMP Now create a VB.NET program that calls "show_emp" and shows the results in a DataGrid. 1. Create a connection - Start Server Explorer - Connect to database - In the "Data Link Properties" dialog box, choose the right properties: Microsoft OLE DB Provider for SQL Server Servername: xpora Choose database: test Choose appropriate authentication method - Rename the connection to "sqlconnectionTest" In Server Explorer you can now view the tables and stored procedures. 2. Create a Data Adapter - Go to the Toolbox - choose the "Data" Tab - Drag the OleDbDataAdapter control of the toolbox to the form The Data Adapter Configuration Wizard starts. - Choose "sqlconnectionTest" as the data connection - Choose use existing stored procedures (or just make SQL queries) - Choose all Select, Insert, Update, Delete stored procedures that apply to your program - Finish and rename the data adapter to "sqlDataAdapter" 3. Create the Data Set - In the main menu, choose "Data" and choose "Generate Dataset" - Choose "new"and name it "DSsqlDataSet". VS will call it "DSsqlDataSet1". 4. Add controls to the form and set the properties Add a button to the form. Name: btnLoad Text: Load Data Add a datagrid to the form. Go to the properties and databindings. Choose DataSource = DSsqlDataSet1._dbo_show_emp So here is the place where you "link" the Data Grid to the stored procedure. Immediately, the data grid on the form show the column headings of the output of the stored procedure. Set the button_click eventhandler as follows: Private Sub btnLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoad.Click DSsqlDataSet.Clear() sqlDataAdapter.Fill(DataSetName) End Sub Example 9.6 SHOW AND GET DATA FROM A MSACCESS DATABASE USING A DATASET: ======================================================================= Form1 Design: ------------- We will create a Connection, Data Adapter and Dataset to an Access database "students". In this example we will only access the Instructors table and select only the Instructor field. In this example the Dataset is called DsInstructor1. Create the Form as follows: 1 Label name =lblInstructor, Text="Instructor" 1 TextBox name=txtInstructor, Text=empty 1 Button name =btnLoad, Text=Load Data Set the DataBinding Text property of the TextBox txtInstructor to the Dataset DsInstructor1. Now we need to program some code that loads the data. - Code Form1: ------------- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub btnLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoad.Click DsInstructors1.Clear() OleDbDataAdapter1.Fill(DsInstructors1) End Sub End Class This very simple example uses two methods, one to clear the Dataset and one to fill the Dataset. But this example will only show one record. Example: -------- We now enhance the above example. We add button controls and extra code in order to navigate through the records of the Dataset. So we add a couple of buttons to the project: Button1, name=btnFirst, Text=First Button2, name=btnLast, Text=Last Button3, name=btnPrev, Text=Previous Button4, name=btnNext, Text=Next The mechanisme involved is that ADO .NET is using an object called the "CurrencyManager". This object keeps track of all records associated with a Dataset. Also, there is a "BindingsContext" object that keeps track of all the "CurrencyManager" objects on the form. Now add the following eventhandlers for these new controls: Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Count() Dim Records, Current As Integer Records = Me.BindingContext(DsInstructors1, "Instructors").Count Current = Me.BindingContext(DsInstructors1, "Instructors").Position + 1 lblCount.Text = "Record" & Current.ToString & " of " & Records.ToString End Sub Private Sub btnLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoad.Click DsInstructors1.Clear() OleDbDataAdapter1.Fill(DsInstructors1) End Sub Private Sub btnFirst_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFirst.Click Me.BindingContext(DsInstructors1, "Instructors").Position = 0 Count() End Sub Private Sub btnLast_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLast.Click Me.BindingContext(DsInstructors1, "Instructors").Position = _ Me.BindingContext(DsInstructors1, "Instructors").Count - 1 Count() End Sub Private Sub btnPrev_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPrev.Click Me.BindingContext(DsInstructors1, "Instructors").Position -= 1 Count() End Sub Private Sub btnNext_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnNext.Click Me.BindingContext(DsInstructors1, "Instructors").Position += 1 Count() End Sub End Class Using the DataGrid control -------------------------- Create a Connection, Data Adapter and Dataset as appropriate. This might be a connection to Access, or SQL Server etc.. On the form, place a DataGrid control. You may also place a button control, in order to load data. We now bind the data to the DataGrid control in the following manner: - Use the "DataSource" property to assigh the Dataset - Use the "DataMember" property to specify the sublist of data. Now you can create an eventhandler for the button to load the data. Private Sub btnLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLoad.Click DataSetName.Clear() OleDbDataAdapter1.Fill(DataSetName) End Sub Example 9.7 HOW TO: Use a DataReader Against an Oracle Stored Procedure ======================================================================= This step-by-step example uses the DataReader object to retrieve data from an Oracle stored procedure. You can use the DataReader to retrieve a read-only, forward-only stream of data from a database. Using the DataReader can increase application performance and reduce system overhead because only one row is ever in memory. 9.7.1 First create the Oracle stuff: ------------------------------------ - Create the Oracle Tables This sample uses tables that are defined in the Oracle Scott/Tiger schema. The Oracle Scott/Tiger schema is included with the default Oracle installation. If this schema does not exist, you must run the following table and insert scripts for the tables: CREATE TABLE DEPT (DEPTNO NUMBER(2,0) NOT NULL, DNAME VARCHAR2(14) NULL, LOC VARCHAR2(13) NULL, PRIMARY KEY (DEPTNO) ); INSERT INTO Dept VALUES(11,'Sales','Texas'); INSERT INTO Dept VALUES(22,'Accounting','Washington'); INSERT INTO Dept VALUES(33,'Finance','Maine'); CREATE TABLE EMP (EMPNO NUMBER(4,0) NOT NULL, ENAME VARCHAR2(10) NULL, JOB VARCHAR2(9) NULL, MGR NUMBER(4,0) NULL, SAL NUMBER(7,2) NULL, COMM NUMBER(7,2) NULL, DEPTNO NUMBER(2,0) NULL, FOREIGN KEY (DEPTNO) REFERENCES DEPT(DEPTNO), PRIMARY KEY (EMPNO) ); INSERT INTO Emp VALUES(123,'Bob','Sales',555,35000,12,11); INSERT INTO Emp VALUES(321,'Sue','Finance',555,42000,12,33); INSERT INTO Emp VALUES(234,'Mary','Account',555,33000,12,22); - Create the Oracle Packages Create the following Oracle package on the Oracle server: CREATE OR REPLACE PACKAGE curspkg_join AS TYPE t_cursor IS REF CURSOR ; Procedure open_join_cursor1 (n_EMPNO IN NUMBER, io_cursor IN OUT t_cursor); END curspkg_join; / Create the following Oracle package body on the Oracle server: CREATE OR REPLACE PACKAGE BODY curspkg_join AS Procedure open_join_cursor1 (n_EMPNO IN NUMBER, io_cursor IN OUT t_cursor) IS v_cursor t_cursor; BEGIN IF n_EMPNO <> 0 THEN OPEN v_cursor FOR SELECT EMP.EMPNO, EMP.ENAME, DEPT.DEPTNO, DEPT.DNAME FROM EMP, DEPT WHERE EMP.DEPTNO = DEPT.DEPTNO AND EMP.EMPNO = n_EMPNO; ELSE OPEN v_cursor FOR SELECT EMP.EMPNO, EMP.ENAME, DEPT.DEPTNO, DEPT.DNAME FROM EMP, DEPT WHERE EMP.DEPTNO = DEPT.DEPTNO; END IF; io_cursor := v_cursor; END open_join_cursor1; END curspkg_join; / 9.7.2 Create your VB.NET app: ----------------------------- Create a new Visual Basic Windows Application project. Form1 is added to the project by default. Add the following code to the top of the Code window: Imports System.Data.OleDB Add the following code to the Form_Load event of Form1: Dim Oraclecon As New OleDbConnection("Provider=MSDAORA.1;Password=tiger;" & _ "User ID=scott;Data Source=MyOracleServer;" & _ "Persist Security Info=True") Oraclecon.Open() Dim myCMD As New OleDbCommand _ ("{call curspkg_join.open_join_cursor1(?, {resultset 0, io_cursor})}", Oraclecon) myCMD.Parameters.Add("ID", OleDbType.Numeric, 4).Value = 123 Dim myReader As OleDbDataReader myReader = myCMD.ExecuteReader() Dim x, count As Integer count = 0 Do While myReader.Read() For x = 0 To myReader.FieldCount - 1 Console.Write(myReader(x) & " ") Next Console.WriteLine() count += 1 Loop MsgBox(count & " Rows Returned.") myReader.Close() Oraclecon.Close() ==================================================================== Part 10. VB .NET and XML ==================================================================== Introduction ADO.NET, a major upgrade to ADO introduced some nice architectural enhancemenets. DataSet class, an alternative to disconnected recordsets, is an example of these upgrades. The DataSet class is useful to hold chunks of data read from the database. The in-memory cache for DataSet consist of tables, relationships and constraints. In this short article, I'll illustrate use of DataSet class first to read an XML data file and then we'll add one record to the data file. Note that in this article we are working with data stored in an XML file, however you could very well use DataSet class with the database. Interestingly DataSet in turn reads and writes data and schema as XML documents. The DataSet class resides in System.Data namespace and is available in System.Data.dll assembly. Following are the DataSet class methods useful to read and write XML data: Read Method Write Method Description ----------- ------------ ----------- ReadXml WriteXml Reads/Writes XML schema and data into the DataSet. ReadXmlData WriteXmlData Used to read/write only XML data. ReadXmlSchema WriteXmlSchema Used to read/write only XML schema. Example 1: reading XML in a Webforms DataGrid --------------------------------------------- Webbased: WebForm1.aspx.vb: Public Class WebForm1 Inherits System.Web.UI.Page Protected WithEvents Button1 As System.Web.UI.WebControls.Button Protected WithEvents DataGrid1 As System.Web.UI.WebControls.DataGrid Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 'Put user code to initialize the page here End Sub Private Sub DataGrid1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DataGrid1.SelectedIndexChanged End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim XmlFile As String = "f:\inetpub\wwwroot\x.xml" Dim ds As DataSet = New DataSet() ds.ReadXml(XmlFile) DataGrid1.DataSource = ds DataGrid1.DataBind() End Sub End Class Example 2: reading XML in a Windows forms DataGrid -------------------------------------------------- Windows Form: Form1.vb : Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim XmlFile As String = "f:\inetpub\wwwroot\x.xml" Dim ds As DataSet = New DataSet() ds.ReadXml(XmlFile) DataGrid1.DataSource = ds DataGrid1.Show() End Sub Private Sub DataGrid1_Navigate(ByVal sender As System.Object, ByVal ne As System.Windows.Forms.NavigateEventArgs) Handles DataGrid1.Navigate End Sub End Class ---- protected sub ReadXmlDemo () ' initialize dataset object dim myData as new DataSet(); ' read xml file into dataset myData.ReadXml (Server.MapPath("/aspxtreme/adonet/demos/authors.xml")) ' call method to display dataset contents into html table displayData (myData) end sub ---- Example 3: How Do I...Read XML from a file? ------------------------------------------- Dim reader As XmlTextReader = New XmlTextReader ("books.xml") Do While (reader.Read()) Select Case reader.NodeType Case XmlNodeType.Element ' The node is an Element Console.Write("<" + reader.Name) while (reader.MoveToNextAttribute()) ' Read attributes Console.Write(" " + reader.Name + "='" + reader.Value + "'") end while Console.Write(">") Case XmlNodeType.DocumentType ' The node is a DocumentType Console.WriteLine(NodeType & "<" & reader.Name & ">" & reader.Value); ... End Select Loop Example 4: How Do I...Read XML from a URL? ------------------------------------------ private const URLString as String = "http://localhost/quickstart/howto/samples/Xml/XmlReadFromUrl/vb/books.xml" ' Load the XmlTextReader from the URL myXmlURLreader = new XmlTextReader (URLString) While reader.Read() Select (reader.NodeType) case XmlNodeType.XmlDeclaration: Format (reader, "XmlDeclaration") declarationCount += 1 case XmlNodeType.ProcessingInstruction: Format (reader, "ProcessingInstruction") piCount += 1 case XmlNodeType.DocumentType: Format (reader, "DocumentType") docCount += 1 case XmlNodeType.Comment: Format (reader, "Comment") commentCount += 1 case XmlNodeType.Element: Format (reader, "Element") elementCount += 1 if (reader.HasAttributes) attributeCount += reader.AttributeCount end if case XmlNodeType.Text: Format (reader, "Text") textCount += 1 case XmlNodeType.Whitespace: whitespaceCount += 1 End Select End While Example 5: writing XML ---------------------- 5.1 --- Sub DataGrid1_DeleteCommand(source As Object, e As DataGridCommandEventArgs) Dim ds As DataSet = New DataSet() ds.ReadXml(Server.MapPath(XmlFile)) ds.Tables("persoon").Rows.RemoveAt(e.Item.ItemIndex) DataGrid1.DataSource = ds DataGrid1.DataBind() ds.WriteXml(Server.MapPath(XmlFile)) End Sub 5.2 --- In CreateDataSource we are just getting a DataSet to use as the DataSource for our DataGrid. Page_Load, doCancel, and doEdit should look pretty familiar so we'll skip over those. First, let's take a look at doDelete public void doDelete(Object sender, DataGridCommandEventArgs e) { mygrid.EditItemIndex = -1; DataSet ds = CreateDataSource(); DataRow row = ds.Tables[0].Rows[e.Item.ItemIndex]; row.Delete(); ds.WriteXml(Server.MapPath("xml_data_x1.xml")); mygrid.DataSource = CreateDataSource(); mygrid.DataBind(); } 5.3 --- Saving a DataSet to a file as XML ' Open a database connection. Dim strConnection As String = _ "Data Source=localhost;Initial Catalog=Northwind;" _ & "Integrated Security=True" Dim cn As SqlConnection = New SqlConnection(strConnection) cn.Open( ) ' Set up a data adapter object. Dim strSql As String = "SELECT * FROM Customers" _ & " WHERE CustomerID = 'GROSR'" Dim da As SqlDataAdapter = New SqlDataAdapter(strSql, cn) ' Load a data set. Dim ds As DataSet = New DataSet("MyDataSetName") da.Fill(ds, "Customers") ' Set up a new data adapter object. strSql = "SELECT Orders.*" _ & " FROM Customers, Orders" _ & " WHERE (Customers.CustomerID = Orders.CustomerID)" _ & " AND (Customers.CustomerID = 'GROSR')" da = New SqlDataAdapter(strSql, cn) ' Load the data set. da.Fill(ds, "Orders") ' Close the database connection. cn.Close( ) ' Create a relation. ds.Relations.Add("CustomerOrders", _ ds.Tables("Customers").Columns("CustomerID"), _ ds.Tables("Orders").Columns("CustomerID")) ' Save as XML. ds.WriteXml("c:\temp.xml") 5.4 --- Public Class Form1 Inherits System.Windows.Forms.Form Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim strSql As String ' Load a data set. Dim ds As DataSet = New DataSet("MyDataSetName") da.Fill(ds, "Instructors") ' Set up a new data adapter object. ' Load the data set. ' Create a relation. ' Save as XML. ds.WriteXml("c:\temp.xml") End Sub End Class -- END OF FILE