One step ahead: September 2013

Sunday 29 September 2013

Retrieve Data from Oracle Database with ADODB using ASP

<!DOCTYPE html>
<html>
<body>
<%
set con=Server.CreateObject("ADODB.Connection")
con.Open("Provider=MSDAORA.1;user id=provide user name;password=provide password;datasource=service name in TNSNAMES.ORA file")

set rs = Server.CreateObject("ADODB.recordset")
rs.Open "select filed1,filed2.... from tablename", con
%>

<table border="1" width="100%">
<%do until rs.EOF%>
    <tr>
    <%for each orec in rs.Fields%>
       <td><%Response.Write(orec.value)%></td>
    <%next
    rs.MoveNext%>
    </tr>
<%loop
rs.close
con.close
%>
</table>
</body>
</html>

Add dynamically values to a combo list in Oracle D2k Forms

-- first method using creategroupfromquery function creating a recordgroup dynamically
declare
myrec RECORDGROUP;
begin
if not id_null(myrec) then
   delete_group(myrec);
end if;
myrec := CREATEGROUPFROMQUERY('otmp','select decode(emp_grade,'S','Staff', 'W', 'Worker','') ,emp_grade from employee_master');

if poplatre_group(myrec) =0 then
    clear_list('control.combolist1');
    populate_list('control.combolist1',myrec);
end if;
end;

--second method, using a explicit cursor and add to list using add_list_element

declare
cursor rec is select decode(emp_grade,'S','Staff', 'W', 'Worker','') emp_grade_desc ,emp_grade from employee_master;
reccount number:=0;
clear_list('control.combolist1');
begin
for o in rec loop
   add_list_element('control.combolist1',reccount,o.emp_grade_desc,o.emp_grade);
   reccount :=reccount +1;
end loop;
end;

Creating an inilne view in SQL,PL/SQL

Here is an example of an inline view SQL.
Lets take for example three tables/

1. tbl_withdrawdeposit
memb_id -- reference to p_k to tbl_member_master
    trans_date --Date of transaction
    amount       -- Amount of transaction
    transaction_type -- Type of Transaction ('W'-withgdrawal, 'D' - deposit
2. tbl_loansvr
memb_id -- reference to p_k to tbl_member_master
    trans_date --Date of transaction
    amount       -- Amount of transaction
    transaction_type -- Type of Transaction ('W'-withgdrawal, 'D' - deposit

3. tbl_member_master
    member_id   member_id primary key
    member_name --name of the member
    acc_no              -- account number of the member

we are going to write an inline view that will show the name,account number of all the member who
have deposited amount/ returned loan amount more than 1,00,00,00 in the year 2012

select A.acc_no,member_name from
(
(select a.acc_no,a.member_name,nvl(b.amount,0) amount
from tbl_member_master a,tbl_loansvr b
where b.memb_id = a.memb_id
and to_char(trans_date,'rrrr'')='2012'
and trans_type='D'
)
union
(
select a.acc_no,a.member_name,nvl(b.amount,0) amount
from tbl_member_master a,tbl_withdrawdeposit b
where b.memb_id = a.memb_id
and to_char(trans_date,'rrrr'')='2012'
)
) tbl_all

group by tbl_all.acc_no,tbl_all.member_name
having sum(tbl_all.amount)>1000000

We have created an inline view by union of two tabl and selected acc_no and member_name from
that view naming it tbl_all. Added summed up amount to having clause, grouping by acc_no and member_name, (iline view can contain record from both the table for a single member.).

Wednesday 25 September 2013

How to load a picture from resource file (.res) in Visual Basic

option explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long

Private Function SetImageFromResource(Optional ByRef PB As Object = Nothing, _
                                Optional ByVal RID As String = "") As IPictureDisp
    Dim bImage() As Byte
    bImage() = LoadResData(RID, "CUSTOM")
    Set SetImageFromResource = ArrayToPicture(bImage(), 0, UBound(bImage) + 1)
    If Not PB Is Nothing Then
        If PB.Picture <> SetImageFromResource Then
            PB.Picture = SetImageFromResource
        End If
    End If
    Erase bImage
End Function

Private Function ArrayToPicture(inArray() As Byte, Offset As Long, size As Long) As IPicture
    Dim o_hMem As Long
    Dim o_lpMem As Long
    Dim aGUID(0 To 3) As Long
    Dim IIStream As IUnknown

    aGUID(0) = &H7BF80980    ' GUID for stdPicture
    aGUID(1) = &H101ABF32
    aGUID(2) = &HAA00BB8B
    aGUID(3) = &HAB0C3000

    o_hMem = GlobalAlloc(&H2&, size)
    If Not o_hMem = 0& Then
        o_lpMem = GlobalLock(o_hMem)
        If Not o_lpMem = 0& Then
            CopyMemory ByVal o_lpMem, inArray(Offset), size
            Call GlobalUnlock(o_hMem)
            If CreateStreamOnHGlobal(o_hMem, 1&, IIStream) = 0& Then
                Call OleLoadPicture(ByVal ObjPtr(IIStream), 0&, 0&, aGUID(0), ArrayToPicture)
            End If
        End If
    End If

End Function

Search entire XML tree with recursive method XML DOM, Visual Basic 6.0

Private function SearchXMLNode(xmlNode as Object,nodeName as string) as Object
dim ochild,ochild1
for each ochild in xmlNode.childNodes
     if vba.lcase$(ochild.nodename) = vba.lcase$(nodeName) then           set SearchXMLNode = ochild
   exit function
   end if
   SearchXMLNode = SearchXMLNode(ochild)
   if not SearchXMLNode is nothing then exit function
next ochild
End Function

Reading an excel file using Microsoft excel object in Visual Basic.

option explicit
Private exc as Object
Private wb as Object
Private ws as Object

Private sub ImportExcelData(excelFileName as String)
if exc is nothing then
   set exc = CreateObject("Excel.Application")
   end if
   if exc is nothing then
        call msgbox("Failed to load excel application")
        exit sub
   end if
   set wb = exc.Workbook.Open(excelFileName)
   if wb is nothing then
        call msgbox("Failed to open excel file")
        exit sub
   end if

' please note that this program is for file without password, open file with password will be on the
' next blog
set ws = wb.Sheets("sheet1")

   if ws is nothing then
        call msgbox("Failed to load worksheet")
        exit sub
   end if
   dim r as long
   r=1
   while not ws.Range("A" & r ":A" & r).value<> ""
debug.print ws.Range("A" & r ":A" & r).value
r=r+1
   wend
   wb.close true
   set wb=nothing
   exc.quit
   set exc=nothing
End Sub

How to use Split Function in Visual Basic 6.0

Split function in VB 6.0 actually splits a string based on delimiter provided and returns it into an
array.

Suppose there is a string like this "Ram#23#Male#M.G.Road"
Now if we split this string with delimiter # into a variant array name arr the result will be
arr(0)="Ram"
arr(1)="23"
arr(0)="Male"
arr(0)="M.G.Road"

Here is the program written into a function

private sub SplitString(strTxt as string,delimiter as string)
dim var
dim i as integer
var = VBA.Split(strTxt,delimiter)
   for i=lbound(var) to ubound(var)
   debug.print var(i)
   next i
end sub

'In form load event the function is called with 2 parameters, a string and a delimiter #
private sub Form_Load()
call splitstring( "Ram#23#Male#M.G.Road","#")
end sub

Using Minus query in SQL.

(select * from employee_salary)
minus
(select * from employee_salary where to_date(pay_month_year,'mm/rrrr')<='01-dec-2012)

Just look into the above query.

Sql in the first line returns all the records.
Now i apply minus with the secong query which returns all the records where pay_month_year is less
than equal to december-2012. So the result will be all the records where pay_month_year starting from january-2013. (please note that pay_month_year is in the format mm/rrrr i.e. 12/2012.

Lets take another example.

(select * from employee_salary)
minus
(select * from employee_salary where gross_pay>=20000)

second query returns all the records whose gross_pay is greater than 20000, and first query returns
all the records so result of the query will return all the records where gross_pay is less than 20000.

How to extract day, month and year from a date field in SQL Server database sql query.

Here is a method to extract day, month and year from date field in sql server sql database.

Say their is a table named employee_attendance with field attn_date

we will get the day , month and year separately from the date field

Here is the SQL statement

select emp_id,substring(conver(char,attn_date,103),1,2) dy,
          substring(conver(char,attn_date,103),4,2) mon,
          substring(conver(char,attn_date,103),7,4) yr
from employee_attendance
          order by emp_id

Now look into the sql statement where day, month and year is extracted.

Lets start with day substring(conver(char,attn_date,103),1,2)

convert function with third parameter 103 convert date to dd/mm/yyyy
format, so 19th april 2013 is converted to 19/04/2013 and char converts the date to string, because if
we do not convert character to string then we cannot use substring function onto it. substring function
actually extract the pattern from the date string.

substring('19/04/2013',1,2) --> 19
substring('19/04/2013',4,2) --> 94
substring('19/04/2013',7,4) --> 2013

Using case statement in sql query on SQLServer database.

Say there is a table employee_master and we are going to use 5 fields

emp_code, emp_name, emp_sex, emp_grade and emp_category

last three fields
i. emp_sex have value 'M' and 'F' (need to output 'Male' for 'M' and 'Female' for 'F')
ii. emp_grade have value 'S' and 'W' (need to output 'Staff' for 'S' and 'Worker' for 'W')
iii. emp_category have value 'P' and 'T' (need to output 'Permanent' for 'P' and 'Temporary' for 'T')

Now this is the select statement using case statement

select emp_code,
          emp_name,
          (case when emp_sex='M' then 'Male' else case when emp_sex='F' then 'Female' else '' end end)
          as emp_sex,
          (case when emp_grade='S' then 'Staff' else case when emp_grade='W' then 'Worker' else '' end
          end)    as emp_grade,
          (case when emp_category='P' then 'Permanent' else case when emp_category='T' then
          'Temporary' else '' end) as emp_category
          from employee_master
          order by emp_code

       Now look into the case statement. For every case statement there is another nested case
       statement. "case when condition then value else (another nested case statement on the else part)
       end"

       I this way we can write multiple case statement just like next if else statement.

        end)    as emp_grade,

Oracle PL/SQL cursor example

--A Procedure ProcCur is created
create or replace procedure ProcCur is

--A cursor is declared selecting 2 fields from employee_master emp_code and emp_name
cursor rec is select emp_code,emp_name from employee_master
              where emp_grade='S'
              order by emp_code;
-- 2 variables are declared of filed type emp_code and emp_name
ecode employee_master.emp_code%type;
ename employee_master.emp_name%type;
begin

-- add this statement otherwise ORU-10027: buffer overflow will rise
dbms_output.enable(1000000);

-- cursor opened
open rec;

-- column header printed
dbms_output.put_line(lpad('Code',10,' ')||lpad('Name',60,' '));

-- loop started
loop

-- current record fetched into ecode and ename. remember that number of fields in the cursor should
--   be equal to number of variables on which records are fetched.
    fetch rec into ecode,ename;

-- exit the loop if when no more records are fetched
    exit when rec%NOTFOUND;

-- fetched values printed
    dbms_output.put_line(lpad(ecode,10,' ')||lpad(ename,60,' '));

-- end of loop
end loop;

--end of procedure
end TestProc;

-------------------------------------------------------------------------------------------------------------------------
-- Alternate method using for loop, this is the easiest and shortest wa.
-------------------------------------------------------------------------------------------------------------------------

--A Procedure ProcCur is created
create or replace procedure ProcCur is

begin

-- add this statement otherwise ORU-10027: buffer overflow will rise
dbms_output.enable(1000000);

-- column header printed
dbms_output.put_line(lpad('Code',10,' ')||lpad('Name',60,' '));

-- loop started
for rec in (select emp_code,emp_name from employee_master
              where emp_grade='S'
              order by emp_code)

loop

-- fetched values printed
    dbms_output.put_line(lpad(rec.emp_code,10,' ')||lpad(rec.emp_name,60,' '));

-- end of loop
end loop;

--end of procedure
end TestProc;

Tuesday 24 September 2013

How to create a dynamic combolist and add data from the database in HTML, Javascript

<html>
<head>
<script>
function myFunction()
{
var con = new ActiveXObject('ADODB.Connection');
var rs = new ActiveXObject('ADODB.Recordset');
con.ConnectionString="Provider=MSDAORA.1;User ID=hr_man;Password=hr_man;Data Source=ORCL;Persist Security Info=False";
con.Open();
rs.Open("select emp_id,emp_name from employee_master order by emp_name").value,con);
var s="<select>";
while(!rs.EOF)
{
s+="<option value='" + rs.Fields("emp_id").Value + "'>" + rs.Fields("emp_name").Value + "</option>";
rs.MoveNext();
}
s+-"</select> ";
rs.Close();
con.close;
document.getElementById("comboDiv").innerHTML=s;
}
</script>
</head>
<body>
<div id="comboDiv">
</div>
</body>
</html>

Monday 23 September 2013

How to Connect to Oracle and retrieve data using ActiveX object in Javascript

<html>
<head>
<script>
function myFunction()
{
var con = new ActiveXObject('ADODB.Connection');
var rs = new ActiveXObject('ADODB.Recordset');
con.ConnectionString="Provider=MSDAORA.1;User ID=hr_man;Password=hr_man;Data Source=ORCL;Persist Security Info=False";
con.Open();
rs.Open(document.getElementById("sqlTxt").value,con);
var s="<table><tr>";
for(var i=0;i<rs.Fields.count;i++)
s+="<td>" + rs.Fields(i).Name + "</td>";
s+="</tr> <tr>";
while(!rs.EOF)
{
for(var i=0;i<rs.Fields.count;i++)
s+="<td>" + rs.Fields(i).Value + "</td>";
rs.MoveNext();
}
s+-"</tr></table>";
rs.Close();
con.close;
document.getElementById("outputSection").innerHTML=s;
}
</script>
</head>
<body>
<div id="inputSection">
<textArea id="sqlTxt"></textArea>
<input type="Button" id="btn" value="Execute" onclick="myFunction();"/>
</div>
<div id="outputSection">
</div>
</body>
</html>

Sunday 22 September 2013

How to invoke Microsoft Common dialog box dynamically using createobject

option explicit

private function OpenDialog() as String
dim dlg as object
on error goto OpenDialog_Error
set dlg=CreateObject("MSCOMDlg.Commondialog")
if dlg is nothing then exit sub
dlg.Filter="All Files (*.*)|*.*"
dlg.CancelError=True
dlg.ShowOpen
OpenDialog=dlg.FileName
exit sub
OpenDialog_Error:
end sub

private sub Form_Load()
dim fileName as string
fileName=OpenDialog()
end sub

Create XML with XML Document Object

option explicit
private xmlObj as Object ' xml object
private xmlHead as object ' xml node
private xmlNode as object ' xml node
private xmlChildNode as object ' xml nodePrivate sub CreateXML
   set xmlObj = CreateObject("MSXML2.DOMDocument") ' dynamic xmlobject created
   if xmlObj is nothing then ' if failed then exit procedure
exit sub
end if
set xmlHead = xmlObj.createElement("Parent") 'first xml node created , head node
set xmlNode = xmlObj.createElement("Child1") ' xmlnode created, first child of head
cal xmlHead.appenChild(xmlNode) ' set to child of head
set xmlChildNode= xmlObj.createElement("Child1ofChild1") ' xmlnode created
call xmlNode.AppendChild(xmlChildNode) ' set to first child of the first child of head
set xmlChildNode= xmlObj.createElement("Child2ofChild1") ' xmlnode created
call xmlNode.AppendChild(xmlChildNode) ' set to second child of the first child of head
set xmlNode = xmlObj.createElement("Child2") ' xmlnode created, second child of head
call xmlHead.appenChild(xmlNode) ' set to child of head
   set xmlChildNode= xmlObj.createElement("Child1ofChild2") ' xmlnode created
call xmlNode.AppendChild(xmlChildNode) ' set to first child of the second child of head
set xmlChildNode= xmlObj.createElement("Child2ofChild2") ' xmlnode created
call xmlNode.AppendChild(xmlChildNode) ' set to second child of the second child of head
debug.print xmlHead.documentElement.xml
set xmlnode=nothing
set xmlchildnode=nothing
set xmlobj=nothing
End Sub

A simple subclassing example

Module Code
option explicit
Private Const GWL_WNDPROC = (-4)
Private Const WM_LBUTTONUP = &H202
Private Const WM_MOUSEMOVE = &H200
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
private originalHandler as long

'Window hooked with Customized function Winproc returning the original handle
public sub SubClassWindow(handle as long)
   oldWindowHandler = SetWindowLong(handler, GWL_WNDPROC, AddressOf WinProc)
End Sub

'Window restore to it's original Windows procedire
public sub UnSubClass(handle as long)
   call setWindowsLong(handler,, GWL_WNDPROC, oldWindowHandler)
End Sub

'Customized Windows function

private sub WinProc(ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   select case MSG
' If user released it's left mouse button
   Case WM_LBUTTONUP
   debug.print "Left Button Up"
       ' If user moved it's mouse
   Case WM_MOUSEMOVE
            debug.print "Mouse Moving"
   End select
' Original windows procedure invoked, this is necessary other wise program will crash
WinProc = CallWindowProc(OldHandler, hWnd, MSG, wParam, lParam)
End Sub

Validate email with Regxp (regular expression) in Visual Basic 6.0

option explicit
private Function IsValidEmail(ByVal emailStr As String) As Boolean

' if email is blank then return
    If VBA.Len(VBA.Trim$(emailStr)) = 0 Then
        IsValidEmail = False
        Exit Function
    End If


    Dim regex As Object
    Dim cMatch As Object ' For MatchCollection

    Set regex = CreateObject("VBScript.RegExp") ' Object created with VBscript.RegExp class.

    regex.MultiLine = False ' email is a single line expression therefore multiline is set to false

    regex.IgnoreCase = False ' Case sensitive checking is set to true

    regex.Pattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b" ' regular expression pattern

    Set cMatch = regex.Execute(emailStr)

    IsValidEmail = Not (cMatch.Count = 0) ' If no matches found then email is invalid

' first item of collection cMatch return length of the email is it is not equal to the length of meail email is invalid.
    If IsValidEmail Then IsValidEmail = IIf(VBA.Len(cMatch.Item(0)) = VBA.Len(emailStr), True, False)
    'Release memory
    Set cMatch = Nothing
    Set regex = Nothing
End Function

Private sub Form_Load()
if not IsValidEmail("subhroneelganguly@gmail.com") then
msgbox "Email not valid"
   else
msgbox "Email valid"
    end if
End Sub

How to get list of all files and folders starting from a specific path - Visual Basic 6.0

option explicit
private fs as Object     ' declared for filesystem object
private flds as Object    ' declared for main folder object
private fld as Object    ' declared for folder object
private fl as Object      ' declared for file object

private sub ListFolderAndFiles(pathname as String)
   create file system object
   set fs=CreateObject("Scripting.FileSystemObject")

   'exit if fails to create file system object
   if fs is nothing then exit sub

' exit is folder does not exists in the pathname
if not fs.isFolderExists(pathname) then
      msgbox "Ivalid path or folder name"
      exit sub
end if

   ' Set the folder object from the specified path
   set flds=fs.GetFolder(pathName)

   ' exit if failed to create folder object
   if not flds is nothing then exit sub

' enumerate through all folders in the parent folder
   for each fld in flds.Folder
   ' enumerate through all files in the folder
   for each fl in fld.Files
   ' add filename along with it's containing folder name in the listbox
   call list1.AddItem(fld.Name & "-" & fl.Name)
   next fl
   next fld

   'release object from memory
   set flds=nothing
   set fl=nothing
   set fs=nothing
End Sub

Private Sub Form_Load()
   ' Calling procedure
   call ListFolderAndFiles("c:\MyLibrary")End Sub

How to enable, disable controls in your form in Visual Basic 6.0

' procedure will take parameters as following
form object, enable or disable flag, types of controls to be enabled or disabled

option explicit
Private sub EnableDisableControls(frm as Object,flag as Boolean,ParamArray arg() as Variant)
   dim ctl
'   loop starts to fetch all controls in the form object
   for each ctl in frm.Controls
dim i as integer
'inner loop starts to navigate through arg from lower bound to upperbound for all the typename parameters passed by in the procedure

for i=lbound(arg) to ubound(arg)
'typename return control type name, if it matches with the typename send in the argument then ctl.enabled state is set to flag value.
if vba.lcase(vba.typename(ctl)) = vba.lcase(arg(i)) then
   ctl.Enabled = flag
   doevents
           end if
next i
   next ctl
End Sub

Writing a simple Text Validation function in Visual Basic 6.0 IDE

option explicit
' Enum created for validation type
private enum enumValidation
   numericOnly
   alphabetOnly
end enum

private sub ValidateText(ctl as object,byref keyascii as integer,e as enumValidation)
   ' parameter ctl is a by reference to text object, keyascii is the ascii key code value pressed by user send as byref so that we can modify the value, e is the validation type

' if the validation is not met type then keyascii is set to 0 which will prevent the value of the key pressed by user to be printered in the textbox

   select case e
case numericOnly
if not isNumeric(keyascii) then    keyascii=0
        end if
       case textOnly
if not (keyascii>=65 and keyascii<=90) or (keyascii>=97 and keyascii<=122) then
   keyascii=0
        end if
end select
End Sub

private sub Text1_Keypress(KeyAscii as Integer)
call ValidateText(text1,Keyascii,alphabetOnly)
End Sub

How to use extendable parameter list in functions using paramarray in Visual Basic 6.0

' This program will call a function which can take as many parameters as possible. Parameters not predefined.

option explicit

private sub PrintName(ParamArray arg() As Variant) ' argument is of type variant (can store any type of value) paramarray, function can be called with arguments which is flexible.

   dim i as integer
   for i=lbound(arg) to ubound(arg)
     ' lbound is the lower bound of the array and ubound is the upper bound of the array
   debug.print arg(i)
   next i
End Sub

How to get the list of all the controls in a form in Visual Basic 6.0

'This program will retrieve all the controls in the form and the name of the controls and their type in a list box.

option explicit
private ctl as object

private sub Form_Load()
   for each ctl in Me.Controls
      ' this listbox will contain name and types of all the controls including itself.
   list1.Additem ctl.Name & "," & vba.typename(ctl)
   doevents
   next ctl
End Sub

How to get computer name using windows API in Visual Basic 6.0

' Platform : any windows OS
' Developing platform visual basic 6.0 (Visual Studio 6.0 IDE)
'------------------------------------------------------------------------------------------------------------------
option explicit
' GetComputerName is a windows API to retrieve computer name
Private ComputerName as String
Private strBuffer As String
Private lngBufSize As Long
Private lngStatus As Long
private computername as string

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private sub Form_Load()

' before passing strBuffer as by reference to "GetComputerName" function, size need to be allocated for strBuffer which is assigned lngBufSize

    lngBufSize = 255

    strBuffer = String$(lngBufSize, " ") ' Memory allocated for strBuffer

' lngStatus returns status for success or failure. return any non zero value for success. computer name is set in the strBuffer string and length of the string is assigned in lngBuffsize, i.e. if computer name is "subhroneel" then strbuffer is set with "subhroneel" and lngBuffSize is set with 10

    lngStatus = GetComputerName(strBuffer, lngBufSize)

    If lngStatus <> 0 Then
        ' extra allocated space is truncated
        computername = Left(strBuffer, lngBufSize)
    End If

End Sub

How to get list of field names of a table using activex dataobject in VB6

Database used : Oracle 11g
Client used : Oracle Net8 client
Application developed in Visual Basic 6.0

We are going to print the output in a multiline textbox
'---------------------------------------------------------------------------------------------------------------------
' Declaration
option explicit
private con as ADODB.Connection
private rs as ADODB.Recordset

private sub Form_Load()
set con = new ADODB.Connection
if not con is nothing then exit sub

con.ConnectionString="Provided=MSDAORA.1;user id=hr_db;password=hr_db;Datasource=ORA" ' Datasource is the service name configure in TNSNAMES.ora file.

con.Open

rs.Open "select * from employee_master",con,adOpenDynamic
dim fld

text1.Text="List of field names in the table employee_master : "
if not rs.EOF
   for each fld in rs.Fields
   text1.text = text1.text & fld.Name & "," & vbcrlf
   next fld
end if
rs.close
con.close
set rs=nothing
set con=nothing
end sub