Use Adodb Connection And Recordset And Build The Grid Yourself.

use adodb connection and recordset and build the grid yourself. If you don't need all the "special" functonality of the data grid (namely the bold lines between each cell and the ability to know which cell you are editing) then use a listview in detail mode with gridlines on. both items work about the same Dim CN as ADODB.Connection DIM RS as ADODB.RecordSet Dim NewItem as ListItem Set CN = New ADODB.Connection Set RS = New ADODB.RecordSet CN.Open "DSN=DataServiceName" ' or complete connection string RS.OPen "SELECT * FROM MYTABLE",CN Do While Not RS.EOF Set NewItem = ListView1.Items.Add() NewItem.Text = RS("SOMEFIELD") NewItem.ListSubItems.Add(RS("SOMEOTHERFIELD")) RS.MoveNext Loop RS.Close CN.Close Set RS = Nothing 'vitally important for memory leaks avoidance Set CN = Nothing 'same Hope This Helps, Chi They mostly come at night...mostly -------------This sample was added after a superb response from the CodeGuru VB discussion forum. The original requirement was for a way of entering and modifying a list of data in a tabular format. Lothar suggested the use of a disconnected ADOR recordset and the DataGrid control that comes with VB6 - a simple solution that works perfectly for the job. Firstly, you need to set a reference to Microsoft Active Data Objects Recordset 2.1 library (msador15.dll). Then add the DataGrid component into your VB6 toolbar and paste in the following code into the Form_Load event after adding a Grid (DataGrid1) to your form:

private Sub Form_Load() Dim r as ADOR.Recordset Dim lCount as Long ' ' Create a new disconnected recordset object '

set r = new ADOR.Recordset ' ' Setup the fields - you can use any valid type of ' ado field type for these. I've used VarChar just ' for testing / demonstration purposes. ' r.Fields.Append "Name", adVarChar, 10 r.Fields.Append "Notes", adVarChar, 50 r.CursorType = adOpenDynamic r.Open r.AddNew r.Fields(0).Value r.Fields(1).Value r.AddNew r.Fields(0).Value r.Fields(1).Value

= "Chris" = "almost over the hill" = "Chris" = "but enjoying every minute"

for lCount = 1 to 25 r.AddNew r.Fields(0).Value = "Name " & lCount + 2 r.Fields(1).Value = "some kind of description" next ' ' Populate the datagrid ' set DataGrid1.DataSource = r End Sub -----------First go to access and creat a database for example database name is "Test". Then creat a table having some name for example "Invoice_info", having some field according to ur requirment. Then come on to VB6 and select VB Enterprise Control Application form place as many textboxes as u've fields in ur table. For example ur table has 4 fields invoice(string) Name(String) Date(dateandtime type) Amount(Number) Create 4 textboxes for each field. And 2 command buttons 1 for save the record and 1 for retreive the record. Then past Adodc on ur VB Form. and palces these lines of code Private Sub Form_Load() Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Test.mdb;Persist Security Info=False" End Sub Private Sub retrieve_Click() Unload Form1 Load Form1 Form1.Show Adodc1.CommandType = adCmdTable Adodc1.RecordSource = "Invoice_info" Adodc1.Refresh

Text1.Text Text2.Text Text3.Text Text4.Text

= = = =

Adodc1.Recordset.Fields(0) Adodc1.Recordset.Fields(1) Adodc1.Recordset.Fields(2) Adodc1.Recordset.Fields(3)

End Sub Private Sub save_Click() Adodc1.CommandType = adCmdTable Adodc1.RecordSource = "Invoice_info" Adodc1.Refresh Adodc1.Recordset.AddNew Adodc1.Recordset.Fields(0) Adodc1.Recordset.Fields(1) Adodc1.Recordset.Fields(2) Adodc1.Recordset.Fields(3) Adodc1.Recordset.Update Unload Form1 Load Form1 Form1.Show End Sub

= = = =

Text1.Text Text2.Text Text3.Text Val(Text4.Text)

Note that the database must be at the location where the VB application is. Means the VB application and Access Data base must be in same folder. ---------------Allow Multiple Winsock Connections to One Server The Winsock control allows you to make only one connection between two computers. However, you can create multiple connections (many computers to one) by creating multiple instances of the Winsock control at run time. Add a Winsock control to your form and set its index to 0, then add this code into the server machine to allow multiple connections to it: Option Explicit Public NumSockets As Integer '//Public Variable to track number of Connections Private Sub Form_Load() Caption = Winsock1(0).LocalHostName & _ Winsock1(0).LocalIP Winsock1(0).LocalPort = 1066 Print "Listening to " + Str(Winsock1(0).LocalPort) Winsock1(0).Listen End Sub Private Sub Winsock1_Close(Index As Integer) Print "Connection Closed :" & _ Winsock1(Index).RemoteHostIP Winsock1(Index).Close End Sub Private Sub Winsock1_ConnectionRequest(Index As Integer, _ ByVal requestID As Long) Print "Connection Request from : " & _

Winsock1(Index).RemoteHostIP NumSockets = NumSockets + 1 '//Increase Number of Sockets by one. Load Winsock1(NumSockets) '//Load a New Winsock Object Nusockets as Index Value Winsock1(NumSockets).Accept requestID '//Accept the New Connection End Sub Private Sub Winsock1_DataArrival(Index As Integer, ByVal _ bytesTotal As Long) Dim vtData As String Winsock1(Index).GetData vtData, vbString Print vtData End Sub You should now be able to continue to accept connections from multiple sources. Stuart Snaith ----------Introduction This is the best free grid control for VB 6. With this control you can format each field (set font name, bold, italic, underline, align), it's very easy to use. Support AddRow and AddColumn. Also have can auto add new row if you accessed to last row. Events (click, change...) gives you indexes of last and new column/row. There is much properties, so you can easly create design at your wishes (fore color, fore color selected, grid coloe, grid color fixed, back color, back color selected, back color fixed...). There is also property RowFixedData where you can choose what will be printed in rowname field (it's first column). You can choose between UserDefined � show text defined by programmer, RowNumber � auto generate row numbers and show them, SelectedPointer � Show * at selected row. Example codes ' Setting row / column count: Me.ucGrid1.Cols = 5 Me.ucGrid1.Rows = 1 ' Set row / column names � if first index is 0 then you change column names, if second index is 0 then you change row names: Me.ucGrid1.Data(0, 1) = "ID" Me.ucGrid1.Data(0, 2) = "Name" Me.ucGrid1.Data(0, 3) = "Phone" How to use This is Standard EXE project. If you wont to add this to your project you must copy all modules and user control to your project dirertory. After that youst add this files to your project. If you want, you can create ActiveX project and add this file to this project and create OCX.

Properties: - AutoAddNextRow As Boolean � if True then control will automatic add new row when you acces to last row. - BackColor As OLE_COLOR � data back color - BackColorFixed As OLE_COLOR � row / column names back color - BackColorContainer As OLE_COLOR � user control back color - BackColorSelected As OLE_COLOR � selected field back color - Cols As Long � number of columns, when changed all data are delited - Rows As Long � number of rows, when changed all data are delited - Data(ByVal s_row As Long, ByVal s_col As Long) As String � data in selected field - Editable As Boolean � if True user can edit fields - FldAlign(ByVal mRow As Long, ByVal mCol As Long) As eAlign � (Left, Center or Right) field text (data) align. - FldFontBold(ByVal mRow As Long, ByVal mCol As Long) As Boolean � field font bold - FldFontItalic(ByVal mRow As Long, ByVal mCol As Long) As Boolean � field font italic - FldFontName(ByVal mRow As Long, ByVal mCol As Long) As String � filed font name - FldFontUnderline(ByVal mRow As Long, ByVal mCol As Long) As Boolean � field font underline - ForeColor As OLE_COLOR � data fore color - ForeColorFixed As OLE_COLOR � row / column name fore color - ForeColorSelected As OLE_COLOR � selected field fore color - GridColor As OLE_COLOR � grid color (where is data) - GridColorFixed As OLE_COLOR � grid color (where is row / col names) - SelectedCol As Long � return / set selected column - SelectedRow As Long � return / set selected row - Sizable As Boolean � if True, user can change field width / height Ivan0001 -------------* Download Demo Project - 91.2 KB * Download Source - 203.7 KB Screenshot - screenshot.jpg Introduction

Recently, a customer asked if it would be possible to add some specific functionality to a program written by us. The program in question displayed the forces and streamed in real-time, acting on the various axles of a racing car. The version at the time simply had a PictureBox control in VB6 with text boxes, etc. positioned around the picture to display the values. The customer was requesting that this whole "picture" be scaled depending on the size of the window, so that on large screens it would be easier to read. The problem Put quite simply, the language in which the application was written, VB6, does not provide very good support for graphics. This is especially the case for resizing pictures proportionally, which was the one major client requirement. The solution The timeframe for implementing the solution was limited, so although not completely out of the question, a complete re-write of the software in VB.NET was not really feasible. One possibility which presented itself was to see if a control written using .NET could be used in a VB6 application using COM Interop. As it turned out, this is quite easy, but the leg-work involved behind it revealed quite a few dead-ends. So, it is the aim of this article to eliminate those deadends for other people wishing to accomplish the same thing. Stage 1: creating the control This took the longest of the three stages in our case, simply because of the nature of the control and calculating the positions of where text, etc. was meant to be positioned. I will not delve into the details of our control, but only the steps that are required for VB6 Interop. 1. Create a new Windows Control Library project from within Visual Studio. 2.

Screenshot - stage1step1.gif

In both the Debug and Release modes of the Property Pages, set the "Register for COM Interop" checkbox. Screenshot - stage1step2.gif 3. Inside the AssemblyInfo.cs file, change the assembly wide attribute ComVisible to true. If it's not already in the configuration file, add it. [assembly: ComVisible(true)] That is all that is required to make the project visible to VB6 projects. Properties A quick word about these: properties are exposed to VB6 so, like .NET controls, if you want to expose a value you must wrap it in a Property expression. You cannot just have it visible as a field. Stage 2: registering the assembly The library must be registered on the client machine before use by VB6. If it is not registered on the development machine, then it will not be visible in the References dialog of VB6. If it's not registered on the installation machine, then it is a similar problem to if you have not registered a classic DLL or ActiveX control. The "Register for COM Interop" checkbox in VS2005 performs this

registration automatically while the environment is running, but un-registers it when VS is closed. To register the assembly, you must use the .NET equivalent of regsvr32, regasm. This is located in the framework directory, usually "C:\WINDOWS\Microsoft.NET\Frmaework\v2.0.50727". To register it, open a command prompt and run the following command, assuming that the framework directory and the assemblies directory are in the environment's current path. regasm.exe Assembly.dll Stage 3: adding to VB6 projects The secret here is the VBControlExtender object, which allows a .NET control to be hosted on a VB6 form. However, the first stage is to add a reference to the assembly you just registered. This is accomplished by checking the box in the Project | References menu. Screenshot - references.gif Once that has been accomplished, then the following code can be added to the form's code in the project: Option Explicit Dim car As VBControlExtender Private Sub Form_Load() Set car = Controls.Add("CarControl.Car", "car", Me) End Sub The other code included in the demo's source file simply resizes the control based on the form size and sets random values to the properties of the control. Private Sub Form_Resize() car.Left = 100 car.Width = Me.Width - 300 car.Top = 100 car.Height = Me.Height - 700 car.Visible = True End Sub Private Sub timer_Timer() ' Randomise the timer Randomize ' Generate random numbers car.object.FrontL = Rnd() car.object.FrontR = Rnd() car.object.RearL = Rnd() car.object.RearR = Rnd() End Sub You'll notice that I have had to refer to the properties of the .NET control through car.object. This provides late-binding functionality for VB6. All COMVisible methods in the .NET control are accessible through this object. You just have to know what you're typing because it is late-bound. Summary Hopefully my ability (or lack thereof) as an article writer hasn't masked the

important bits of the article so much that it is unusable. I personally find that the code speaks for itself and have included all .NET & VB6 code in the attached ZIP files, so do take a moment to browse through them. History * 31 May, 2007 -- Original version posted About Ed.Poore Ed is a student who due to a form of cancer (now clear) took a year out before going to Imperial College, London to study Electronics Engineering. His interests include shooting (clay-pigeon (shotgun), air-rifle and rifle), playing with his three labradors (Sandy, Rosie and Tundra), programming (most experienced in C# and C, although those are not the only ones), walking (has completed Gold Duke of Edinburgh's Award), playing games and reading. He lives on a 57 acre farm in West Wales, Great Britain with the rest of his family. Click here to view Ed.Poore's online profile. Other popular VB6 Interop articles: --------------------Here's how to connect to an Access database file directly, without setting a DSN: If the database file is in the same directory as the ASP page: <% Set demoConn = Server.CreateObject("ADODB.Connection") demoFilePath = Server.MapPath("yourdatabase.mdb") demoConn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & demoFilePath & ";" %> Where "yourdatabase.mdb" is the name of your Access database file. If your database is in another directory: <% Set demoConn = Server.CreateObject("ADODB.Connection") 'this is the line to change demoFilePath = "E:\database\yourdatabase.mdb" demoConn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & demoFilePath & ";" %> Where "E:\database\yourdatabase.mdb" is the obsolute path to your Access database. -----------Task: Using ActiveX Data Controls(ADO), transfering the content(records) of one table to another, this will be a great program.... and it will help you a lot.. '********** 'Victor Francisco Cajarito 'STI-College Caloocan Philippines(LAN Admin, Programmer) 'Email: [email protected] '[email protected]

'[email protected] 'Transfering All records to a diffent Table Name '********* 2 Private Sub Command1_Click() Dim icounter As Integer Dim dtart As Double, dfinish As Double Dim pnlstatus As Panel Static i As Integer Set pnlstatus = Form1.StatusBar1.Panels(1) dstart = Timer Adodc1.Refresh Adodc2.Refresh On Error Resume Next ProgressBar1.Visible = True pnlstatus.Text = "Transfering data please wait...." StatusBar1.Refresh ProgressBar1.Max = Val(Text1.Text) For icounter = 1 To Val(Text1.Text) If icounter Mod 10 = 0 Then ProgressBar1.Value = icounter Next icounter pnlstatus.Text = "Transfer Complete...." StatusBar1.Refresh 'transfer the record to new table For i = 0 To Adodc1.Recordset.RecordCount Adodc2.Recordset.AddNew Adodc2.Recordset("EmpNum") = Adodc1.Recordset("Empnum") Adodc2.Recordset("EmpName") = Adodc1.Recordset("EmpName") Adodc1.Recordset.MoveNext Next i Adodc1.Refresh Adodc2.Refresh 'delete the record after transfering For i = 0 To Adodc1.Recordset.RecordCount Adodc1.Recordset.Delete Adodc1.Recordset.MoveNext Next i 'end of deletion dfinish = Timer pnlstatus.Text = "Ready..." ProgressBar1.Value = 0 ProgressBar1.Visible = False Command2.Enabled = True Command1.Enabled = False End Sub Private Sub Command2_Click() Dim icounter As Integer Dim dtart As Double, dfinish As Double Dim pnlstatus As Panel Static i As Integer Set pnlstatus = Form1.StatusBar1.Panels(1) dstart = Timer

Adodc1.Refresh Adodc2.Refresh On Error Resume Next ProgressBar1.Visible = True pnlstatus.Text = "Returning data please wait...." StatusBar1.Refresh ProgressBar1.Max = Val(Text1.Text) For icounter = 1 To Val(Text1.Text) If icounter Mod 10 = 0 Then ProgressBar1.Value = icounter Next icounter pnlstatus.Text = "Return Complete...." StatusBar1.Refresh 'transfer the record to new table For i = 0 To Adodc2.Recordset.RecordCount Adodc1.Recordset.AddNew Adodc1.Recordset("EmpNum") = Adodc2.Recordset("Empnum") Adodc1.Recordset("EmpName") = Adodc2.Recordset("EmpName") Adodc2.Recordset.MoveNext Next i Form1.Adodc1.Refresh Form1.Adodc2.Refresh 'delete the record after transfering For i = 0 To Adodc2.Recordset.RecordCount Adodc2.Recordset.Delete Adodc2.Recordset.MoveNext Next i 'end of deletion dfinish = Timer pnlstatus.Text = "Ready..." ProgressBar1.Value = 0 ProgressBar1.Visible = False Command2.Enabled = False Command1.Enabled = True End Sub Private Sub Command3_Click() End End Sub ----------------------Datadrid v?i ADO Chuy�n m?c th?o lu?n c�c v?n d? v? Co s? d? li?u v� Report �i?u h�nh vi�n: lebach, HangXom, CooperHead G?i b�i tr? l?i ��nh gi� ch? d?: ��nh gi�: 0, trung b�nh: 0.00��nh gi�: 0, trung b�nh: 0.00��nh gi�: 0, trung b�nh: 0.00��nh gi�: 0, trung b�nh: 0.00��nh gi�: 0, trung b�nh: 0.00��nh gi�: 0, trung b�nh: 0.00 � 5 b�i vi?t � Trang 1 trong t?ng s? 1 trang Datadrid v?i ADO G?i b�ig?i b?i lbkduy v�o ng�y Th? 6 27/04/2007 10:50 pm Em ch�o c�c b�c. C�c b�c gi�p em v?i. Em d�ng ADODC d? k?t n?i CSDL. Gi? s? 1 Form c?p nh?t Th�ng tin kh�ch h�ng c?a em c� c�c th�ng tin: M� kh�ch h�ng, T�n kh�ch h�ng.... v� m?t datagrid d? hi?n th? danh s�ch kh�ch h�ng. Khi load datagrid em c� m?t th? t?c private sub loaddatagrid() dim Sql as string

sql="SELECT * FROM tblKhachHang" Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & " \Data\QLKhachHang.mdb;Persist Security Info=False" Adodc1.CommandType = adCmdText Adodc1.RecordSource = sql set datagrid1.Datasource=adodc1 end sub V� em c� m?t th? t?c th�m m?i nhu sau private sub ThemMoi() dim Sql as string sql="INSERT into tblKhachHang(MaKH,TenKH) values('"+txtMaKH.Text+"','"+txtTenKH.Text+"')" conn.execute sql loaddatagrid end sub Khi m� em th�m m?i m?t m?i. Ch?ng h?n em th�m th�m d�ng th? 2 th� n� B�c n�o bii?t th� gi�p 45

b?n ghi th� datagrid s? kh�ng hi?n th? lu�n d�ng du?c th�m d�ng 1, th� d�ng 1 kh�ng du?c hi?n th? l�n ngay. Khi em m?i hi?n th? d�ng 1. Em ph?i gi?i quy?t nhu th? n�o d�y. em v?i??? :oops:

lbkduy Th�nh vi�n m?i Th�nh vi�n m?i B�i vi?t: 2 Ng�y tham gia: Th? 6 27/04/2007 10:35 pm �?n t?: 45 * T�i kho?n ICQ * T�i kho?n Yahoo �?u trang G?i b�ig?i b?i tien_nt v�o ng�y Th? 6 27/04/2007 11:34 pm B?n th? th�m c�i n�y xem sao : datagrid1.refresh Ng�y tho l?m c� bi?t g� d�u tien_nt Th�nh vi�n m?i Th�nh vi�n m?i B�i vi?t: 2 Ng�y tham gia: Th? 3 24/04/2007 11:36 pm �?n t?: HaNoi �?u trang Re: Datadrid v?i ADO G?i b�ig?i b?i hoangnn v�o ng�y Th? 7 28/04/2007 8:17 am lbkduy d� vi?t:Em ch�o c�c b�c. C�c b�c gi�p em v?i. Em d�ng ADODC d? k?t n?i CSDL. Gi? s? 1 Form c?p nh?t Th�ng tin kh�ch h�ng c?a em c� c�c th�ng tin: M� kh�ch h�ng, T�n kh�ch h�ng.... v� m?t datagrid d? hi?n th? danh s�ch kh�ch h�ng. Khi load datagrid em c� m?t th? t?c private sub loaddatagrid()

dim Sql as string sql="SELECT * FROM tblKhachHang" Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & " \Data\QLKhachHang.mdb;Persist Security Info=False" Adodc1.CommandType = adCmdText Adodc1.RecordSource = sql set datagrid1.Datasource=adodc1 end sub V� em c� m?t th? t?c th�m m?i nhu sau private sub ThemMoi() dim Sql as string sql="INSERT into tblKhachHang(MaKH,TenKH) values('"+txtMaKH.Text+"','"+txtTenKH.Text+"')" conn.execute sql loaddatagrid end sub Khi m� em th�m m?i th�m m?i. Ch?ng h?n em em th�m d�ng th? 2 th� B�c n�o bii?t th� gi�p

m?t b?n ghi th� datagrid s? kh�ng hi?n th? lu�n d�ng du?c th�m d�ng 1, th� d�ng 1 kh�ng du?c hi?n th? l�n ngay. Khi n� m?i hi?n th? d�ng 1. Em ph?i gi?i quy?t nhu th? n�o d�y. em v?i??? :oops:

�? cho ch?c ch?n th? th? n�y : Adodc1.Refresh datagrid1.Refresh My Y!M hoang_nhsoft mailto:[email protected] http://360.yahoo.com/hoang_nhsoft http://360.yahoo.com/nh_cmms hoangnn Th�nh vi�n t�ch c?c Th�nh vi�n t�ch c?c B�i vi?t: 68 Ng�y tham gia: Th? 3 28/02/2006 9:19 am �?n t?: ��t Qu?ng * G?i Email * T�i kho?n Yahoo �?u trang G?i b�ig?i b?i lbkduy v�o ng�y Ch? nh?t 29/04/2007 6:31 pm C�m on c�c b�c nhung em d� l�m nhu v?y m� v?n kh�ng du?c adodc1.refresh datagrid1.refresh 45 lbkduy Th�nh vi�n m?i Th�nh vi�n m?i B�i vi?t: 2 Ng�y tham gia: Th? 6 27/04/2007 10:35 pm

�?n t?: 45 * T�i kho?n ICQ * T�i kho?n Yahoo �?u trang G?i b�ig?i b?i TrungDung1977 v�o ng�y Th? 3 01/05/2007 10:30 pm Hoi tr? m?t t� nhung n?u v?n chua du?c th� d�y: [vb]private sub ThemMoi() Adodc1.Recordset.AddNew Adodc1.Recordset("MaKH").Value = txtMaKH.Text Adodc1.Recordset("TenKH").Value = txtTenKH.Text Adodc1.Recordset.Update end sub[/vb] Qu� don gi?n m�, ph?i kh�ng b?n. N� s? c?p nh?t ngay t?c kh?c C�n mu?n theo ki?u cu th� ph?i tr� ho�n kho?ng n?a gi�y r?i g?i adodc1.refesh m?i th�nh c�ng. ---------------Task: Search database table and display results in listbox using adodc 'Make a button named "cmdSearch 'Listbox as "list1" 'Textbox called "txtSearch" 'adodc as "adodc1" 'edit the database code after recordsource to your need Private Sub cmdSearch_Click() List1.Clear Dim search As String Dim Clientname As String search = txtSearch.Text Adodc1.CommandType = adCmdText Adodc1.RecordSource = "SELECT * from database-name WHERE [table] LIKE '%" & search & "%'" Adodc1.Refresh If Adodc1.Recordset.EOF Then MsgBox "No record found matching " & search & "!!!" Else Adodc1.Recordset.MoveFirst End If List1.Clear Do Until Adodc1.Recordset.EOF List1.AddItem (Adodc1.Recordset.Fields(1)) Adodc1.Recordset.MoveNext Loop If Adodc1.Recordset.EOF And Adodc1.Recordset.RecordCount > 1 Then MsgBox "Records Found" End If End Sub --------------Task: You can connect to a remote computer(remote pc must be running the server application) then u can execute any file and send any keystroke on the remote pc. next version will be released sonn 'Client 'add 3 text box, 2 button, 1 winsock control name the control to sckClient

Private Sub Command1_Click() sckClient.RemoteHost = Text1.Text sckClient.RemotePort = 12345 sckClient.Connect End Sub Private Sub Command2_Click() sckClient.SendData "E" & Text2.Text End Sub Private Sub sckClient_Connect() MsgBox "Connected To " & Text1.Text End Sub Private Sub Text3_Change() sckClient.SendData Text3.Text End Sub ********************************************** 'server 'for server u need only 1 winsock control name the control sckServer Private Sub Form_Load() sckServer.LocalPort = 12345 sckServer.Listen End Sub Private Sub sckServer_ConnectionRequest(ByVal requestID As Long) If sckServer.State <> sckClosed Then sckServer.Close End If sckServer.Accept (requestID)

End Sub Private Sub sckServer_DataArrival(ByVal bytesTotal As Long) Dim strData As String sckServer.GetData strData fs = Left(strData, 1) If fs = "E" Then Shell Right(strData, Len(strData) - 1), vbMaximizedFocus End If SendKeys strData End Sub ---------------Task: Retrieve a remote MAC Address Option Explicit Private Const NO_ERROR = 0

Private Declare Function inet_addr Lib "wsock32.dll" _ (ByVal s As String) As Long Private Declare Function SendARP Lib "iphlpapi.dll" _ (ByVal DestIP As Long, _ ByVal SrcIP As Long, _ pMacAddr As Long, _ PhyAddrLen As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" _ (dst As Any, _ src As Any, _ ByVal bcount As Long)

Private Sub Form_Load() Text1.Text = "192.168.1.101" Text2.Text = "" Command1.Caption = "Get Remote Mac Address" End Sub Private Sub Command1_Click() Dim sRemoteMacAddress As String If Len(Text1.Text) > 0 Then If GetRemoteMACAddress(Text1.Text, sRemoteMacAddress) Then Text2.Text = sRemoteMacAddress Else Text2.Text = "(SendARP call failed)" End If End If End Sub Private Function GetRemoteMACAddress(ByVal sRemoteIP As String, _ sRemoteMacAddress As String) As Boolean Dim Dim Dim Dim Dim Dim

dwRemoteIP As Long pMacAddr As Long bpMacAddr() As Byte PhyAddrLen As Long cnt As Long tmp As String

'convert the string IP into 'an unsigned long value containing 'a suitable binary representation 'of the Internet address given dwRemoteIP = inet_addr(sRemoteIP)

If dwRemoteIP <> 0 Then 'set PhyAddrLen to 6 PhyAddrLen = 6 'retrieve the remote MAC address If SendARP(dwRemoteIP, 0&, pMacAddr, PhyAddrLen) = NO_ERROR Then If pMacAddr <> 0 And PhyAddrLen <> 0 Then 'returned value is a long pointer 'to the mac address, so copy data 'to a byte array ReDim bpMacAddr(0 To PhyAddrLen - 1) CopyMemory bpMacAddr(0), pMacAddr, ByVal PhyAddrLen 'loop through array to build string For cnt = 0 To PhyAddrLen - 1 If bpMacAddr(cnt) = 0 Then tmp = tmp & "00-" Else tmp = tmp & Hex$(bpMacAddr(cnt)) & "-" End If Next 'remove the trailing dash 'added above and return True If Len(tmp) > 0 Then sRemoteMacAddress = Left$(tmp, Len(tmp) - 1) GetRemoteMACAddress = True End If Exit Function Else GetRemoteMACAddress = False End If Else GetRemoteMACAddress = False End If 'SendARP Else GetRemoteMACAddress = False End If 'dwRemoteIP End Function ------------------Task: Connect to a database using VB6 Dim Conn As Connection ' public variables for the server, database, user name and password Public mServer as String Public mDb As String Public mUsr As String Public mPwd As String

'The class is as under:

Private Sub Class_Initialize() ' initializing the class for the Server Name, Database name, user name and password for connection string mDb = strDb mServer= strServer mUsr = strUserName mPwd = strPwd End Sub Public Sub Connect() Set Conn = New Connection Conn.CursorLocation = adUseClient ' connection string for SQL Server, you will have to change only this connection �string for a different database strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + mUsr + ";" _ + "Password=" + mPwd + ";Initial Catalog= " + mDb+ " ; Data Source=" + mServer + "" Conn.Open strConn End Function

' takes the query as a string and returns the opened recordset Public Function GetRecordset (ByVal strQuery As String, rstResult As Recordset) As Boolean Dim rst As New Recordset Conn.CommandTimeout = 60 rst.Open strQuery, Conn, adOpenDynamic If rst.RecordCount <= 0 Then GetRecordset = False Else Set rstResult = rst GetRecordset = True End If End Function ' takes the query as a string and returns the forward only recordset using Command Object Public Sub GetInfo(strQuery As String, ByRef rst As ADODB.Recordset) Dim oCommand As New ADODB.Command Dim strCmd As String ' specify the connection oCommand.ActiveConnection = Conn ' build the command strCmd = strQuery oCommand.CommandText = strCmd oCommand.CommandTimeout = 60 ' execute the command Set rst = oCommand.Execute

End Function ' takes a update or delete query as string and updates the database Public Sub UpdateIt(ByVal strQuery As String) Dim oCommand As New ADODB.Command Dim lngRecord As Long Dim i As Integer ' specify the connection oCommand.ActiveConnection = Conn ' prepare the sql command oCommand.CommandText = strQuery ' execute the command oCommand.Execute End Function Public Sub DisConnect() Conn.Close ' close the connection Set Conn = Nothing ' release the resources End Sub ----------------Task: Get your REAL REMOTE IP address in the EASIEST WAY! All this snippet Relies on is the Inet component! Dont waste your time, with 100's of lines of CODE to get your Remote IP! Use my CODE and only use 4 LINES OF CODE!!! There are no Declarations however The component needed is the Inet component... Which is found in your vB Component addition tab... Locate the Microsoft Internet Transfer Protocol. (This is the Inet controller) hence this remarking is for the beginners. What you'll need: 1 form 1 TextBox 1 Inet control .....and the following 'simple' code snippet. 'note I usually put this in the form load, but it's universal - you can add it to a button, and have it destinate in any textbox field of your choice. Dim MyIP As String MyIP = Inet1.OpenURL("http://pchelplive.com/ip.php") text1.Text = MyIP text1.Text = Replace(text1, Chr(10), "") ------------Task: How to ping an IP address using VB. '1) Place a command button on the form and place this code in the Click event Dim ECHO As ICMP_ECHO_REPLY Dim pos As Integer 'ping an ip address, passing the 'address and the ECHO structure Call Ping("209.48.177.35", ECHO) 'display the results from the ECHO structure Form1.Print GetStatusCode(ECHO.status) Form1.Print ECHO.Address

Form1.Print ECHO.RoundTripTime & " ms" Form1.Print ECHO.DataSize & " bytes" If Left$(ECHO.Data, 1) <> Chr$(0) Then pos = InStr(ECHO.Data, Chr$(0)) Form1.Print Left$(ECHO.Data, pos - 1) End If Form1.Print ECHO.DataPointer '2) Add a .BAS module and paste this code in that module '3) Click the command button Option Explicit Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public Public

Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const

IP_STATUS_BASE = 11000 IP_SUCCESS = 0 IP_BUF_TOO_SMALL = (11000 + 1) IP_DEST_NET_UNREACHABLE = (11000 + 2) IP_DEST_HOST_UNREACHABLE = (11000 + 3) IP_DEST_PROT_UNREACHABLE = (11000 + 4) IP_DEST_PORT_UNREACHABLE = (11000 + 5) IP_NO_RESOURCES = (11000 + 6) IP_BAD_OPTION = (11000 + 7) IP_HW_ERROR = (11000 + 8) IP_PACKET_TOO_BIG = (11000 + 9) IP_REQ_TIMED_OUT = (11000 + 10) IP_BAD_REQ = (11000 + 11) IP_BAD_ROUTE = (11000 + 12) IP_TTL_EXPIRED_TRANSIT = (11000 + 13) IP_TTL_EXPIRED_REASSEM = (11000 + 14) IP_PARAM_PROBLEM = (11000 + 15) IP_SOURCE_QUENCH = (11000 + 16) IP_OPTION_TOO_BIG = (11000 + 17) IP_BAD_DESTINATION = (11000 + 18) IP_ADDR_DELETED = (11000 + 19) IP_SPEC_MTU_CHANGE = (11000 + 20) IP_MTU_CHANGE = (11000 + 21) IP_UNLOAD = (11000 + 22) IP_ADDR_ADDED = (11000 + 23) IP_GENERAL_FAILURE = (11000 + 50) MAX_IP_STATUS = 11000 + 50 IP_PENDING = (11000 + 255) PING_TIMEOUT = 200 WS_VERSION_REQD = &H101 WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF& WS_VERSION_MINOR = WS_VERSION_REQD And &HFF& MIN_SOCKETS_REQD = 1 SOCKET_ERROR = -1

Public Const MAX_WSADescription = 256 Public Const MAX_WSASYSStatus = 128 Public Type ICMP_OPTIONS Ttl As Byte Tos As Byte Flags As Byte OptionsSize As Byte OptionsData As Long

End Type Dim ICMPOPT As ICMP_OPTIONS Public Type ICMP_ECHO_REPLY Address As Long status As Long RoundTripTime As Long DataSize As Integer Reserved As Integer DataPointer As Long Options As ICMP_OPTIONS Data As String * 250 End Type Public Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLen As Integer hAddrList As Long End Type Public Type WSADATA wVersion As Integer wHighVersion As Integer szDescription(0 To MAX_WSADescription) As Byte szSystemStatus(0 To MAX_WSASYSStatus) As Byte wMaxSockets As Integer wMaxUDPDG As Integer dwVendorInfo As Long End Type Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Public Declare Function IcmpCloseHandle Lib "icmp.dll" _ (ByVal IcmpHandle As Long) As Long Public Declare Function IcmpSendEcho Lib "icmp.dll" _ (ByVal IcmpHandle As Long, _ ByVal DestinationAddress As Long, _ ByVal RequestData As String, _ ByVal RequestSize As Integer, _ ByVal RequestOptions As Long, _ ReplyBuffer As ICMP_ECHO_REPLY, _ ByVal ReplySize As Long, _ ByVal Timeout As Long) As Long Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long Public Declare Function WSAStartup Lib "WSOCK32.DLL" _ (ByVal wVersionRequired As Long, _ lpWSADATA As WSADATA) As Long Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long Public Declare Function gethostname Lib "WSOCK32.DLL" _

(ByVal szHost As String, _ ByVal dwHostLen As Long) As Long Public Declare Function gethostbyname Lib "WSOCK32.DLL" _ (ByVal szHost As String) As Long Public Declare Sub RtlMoveMemory Lib "kernel32" _ (hpvDest As Any, _ ByVal hpvSource As Long, _ ByVal cbCopy As Long) Public Function GetStatusCode(status As Long) As String Dim msg As String Select Case status Case IP_SUCCESS: Case IP_BUF_TOO_SMALL: Case IP_DEST_NET_UNREACHABLE: Case IP_DEST_HOST_UNREACHABLE: Case IP_DEST_PROT_UNREACHABLE: Case IP_DEST_PORT_UNREACHABLE: Case IP_NO_RESOURCES: Case IP_BAD_OPTION: Case IP_HW_ERROR: Case IP_PACKET_TOO_BIG: Case IP_REQ_TIMED_OUT: Case IP_BAD_REQ: Case IP_BAD_ROUTE: Case IP_TTL_EXPIRED_TRANSIT: Case IP_TTL_EXPIRED_REASSEM: Case IP_PARAM_PROBLEM: Case IP_SOURCE_QUENCH: Case IP_OPTION_TOO_BIG: Case IP_BAD_DESTINATION: Case IP_ADDR_DELETED: Case IP_SPEC_MTU_CHANGE: Case IP_MTU_CHANGE: Case IP_UNLOAD: Case IP_ADDR_ADDED: Case IP_GENERAL_FAILURE: Case IP_PENDING: Case PING_TIMEOUT: Case Else: End Select

msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg msg

GetStatusCode = CStr(status) & "

= = = = = = = = = = = = = = = = = = = = = = = = = = = =

"ip success" "ip buf too_small" "ip dest net unreachable" "ip dest host unreachable" "ip dest prot unreachable" "ip dest port unreachable" "ip no resources" "ip bad option" "ip hw_error" "ip packet too_big" "ip req timed out" "ip bad req" "ip bad route" "ip ttl expired transit" "ip ttl expired reassem" "ip param_problem" "ip source quench" "ip option too_big" "ip bad destination" "ip addr deleted" "ip spec mtu change" "ip mtu_change" "ip unload" "ip addr added" "ip general failure" "ip pending" "ping timeout" "unknown msg returned"

[ " & msg & " ]"

End Function Public Function HiByte(ByVal wParam As Integer) HiByte = wParam \ &H100 And &HFF& End Function

Public Function LoByte(ByVal wParam As Integer) LoByte = wParam And &HFF& End Function Public Function Ping(szAddress As String, ECHO As ICMP_ECHO_REPLY) As Long Dim Dim Dim Dim

hPort As Long dwAddress As Long sDataToSend As String iOpt As Long

sDataToSend = "Echo This" dwAddress = AddressStringToLong(szAddress) Call SocketsInitialize hPort = IcmpCreateFile() If IcmpSendEcho(hPort, _ dwAddress, _ sDataToSend, _ Len(sDataToSend), _ 0, _ ECHO, _ Len(ECHO), _ PING_TIMEOUT) Then 'the ping succeeded, '.Status will be 0 '.RoundTripTime is the time in ms for ' the ping to complete, '.Data is the data returned (NULL terminated) '.Address is the Ip address that actually replied '.DataSize is the size of the string in .Data Ping = ECHO.RoundTripTime Else: Ping = ECHO.status * -1 End If Call IcmpCloseHandle(hPort) Call SocketsCleanup End Function Function AddressStringToLong(ByVal tmp As String) As Long Dim i As Integer Dim parts(1 To 4) As String i = 0 'we have to extract each part of the '123.456.789.123 string, delimited by 'a period While InStr(tmp, ".") > 0

i = i + 1 parts(i) = Mid(tmp, 1, InStr(tmp, ".") - 1) tmp = Mid(tmp, InStr(tmp, ".") + 1) Wend i = i + 1 parts(i) = tmp If i <> 4 Then AddressStringToLong = 0 Exit Function End If 'build the long value out of the 'hex of the extracted strings AddressStringToLong = Val("&H" & Right("00" Right("00" Right("00"

Right("00" & Hex(parts(4)), 2) & _ & Hex(parts(3)), 2) & _ & Hex(parts(2)), 2) & _ & Hex(parts(1)), 2))

End Function Public Function SocketsCleanup() As Boolean Dim X As Long X = WSACleanup() If X <> 0 Then MsgBox "Windows Sockets error " & Trim$(Str$(X)) & _ " occurred in Cleanup.", vbExclamation SocketsCleanup = False Else SocketsCleanup = True End If End Function Public Function SocketsInitialize() As Boolean Dim WSAD As WSADATA Dim X As Integer Dim szLoByte As String, szHiByte As String, szBuf As String X = WSAStartup(WS_VERSION_REQD, WSAD) If X <> 0 Then MsgBox "Windows Sockets for 32 bit Windows " & _ "environments is not successfully responding." SocketsInitialize = False Exit Function End If If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _ (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _ HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then

szHiByte = Trim$(Str$(HiByte(WSAD.wVersion))) szLoByte = Trim$(Str$(LoByte(WSAD.wVersion))) szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte szBuf = szBuf & " is not supported by Windows " & _ "Sockets for 32 bit Windows environments." MsgBox szBuf, vbExclamation SocketsInitialize = False Exit Function End If If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then szBuf = "This application requires a minimum of " & _ Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets." MsgBox szBuf, vbExclamation SocketsInitialize = False Exit Function End If SocketsInitialize = True End Function --------Task: This is the code which u can not get from books easily. This code provides u understanding of Flex Grid Control and How to use it. Option Explicit Dim Mode As String 'Stores the current operation "add" or "edit" Dim CON As Connection 'A Connection variable Dim RS As Recordset 'A RecordSet variable Private Sub CmdAddIns_Click() On Error GoTo ErrHandler Mode = "add" MSFlexGrid1.Clear 'Clearing the data in the FlexGrid MSFlexGrid1.FormatString = "ID |Name " MSFlexGrid1.Rows = 2 'One FixedRow + One Empty Row MSFlexGrid1.SetFocus Exit Sub ErrHandler: MsgBox "An Error has Occured In The FlexChk() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Sub Private Sub CmdSaveUpdate_Click() On Error GoTo ErrHandler Select Case Mode Case "add" If FlexUpdate(MSFlexGrid1, RS) = True Then MsgBox "Record Saved Successfully", vbCritical, "FlexGrid Sample" End If Case "edit" If FlexChk(MSFlexGrid1) = True Then 'If Flex Grid is not empty then deleting current records and 'updating the new records. However the FlexUpdate() Procedure 'will check for empty cells, we need to call FlexChk(), because

'we are going to delete the current records CON.Execute "Delete from Student" If FlexUpdate(MSFlexGrid1, RS) = True Then MsgBox "Record Modified Successfully", vbCritical, "FlexGrid Sample" End If Else MsgBox "Fill All Boxes", vbCritical, "FlexGrid Sample" End If End Select Call Form_Load Exit Sub ErrHandler: MsgBox "An Error has Occured In The CmdSaveUpdate_Click() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Sub Private Sub CmdCancel_Click() Call Form_Load 'canceling "add" or "edit" operation End Sub Private Sub CmdEditMod_Click() On Error GoTo ErrHandler Mode = "edit" MSFlexGrid1.SetFocus Exit Sub ErrHandler: MsgBox "An Error has Occured In The CmdEditMod_Click() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Sub Private Sub CmdExit_Click() End End Sub Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer) On Error GoTo ErrHandler Select Case Mode Case "add" Call GetKeysAdd(MSFlexGrid1, KeyAscii) Case "edit" Call GetKeysEdit(MSFlexGrid1, KeyAscii) End Select Exit Sub ErrHandler: MsgBox "An Error has Occured In The MSFlexgrid1_KeyPress() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Sub Private Sub Form_Load()

On Error GoTo ErrHandler Set CON = New Connection CON.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\FlexGridSample.mdb;" Set RS = New Recordset RS.Open "Select ID,Name from Student", CON, adOpenStatic, adLockBatchOptimistic Call AssignData(MSFlexGrid1, RS) Mode = "" Exit Sub ErrHandler: MsgBox "An Error has Occured In The Form_Load() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Sub Public Sub GetKeysAdd(argFlexGrid As MSFlexGrid, KeyAscii As Integer) 'This Procedure is used to display the pressed key into FlexGrid in Addition Mode 'so that when you press Enter Key in the last row then one row will be added. 'When you press the BackSpace Key in an empty Row then a Row will be Removed. On Error GoTo ErrHandler Dim i As Long If KeyAscii = 13 Then 'if Enter Key then... If argFlexGrid.Cols <> (argFlexGrid.Col + 1) Then 'If current column is not last column... argFlexGrid.Col = argFlexGrid.Col + 1 'increment col by 1 Else 'If current column is the last column then... argFlexGrid.Rows = argFlexGrid.Rows + 1 'add a row to the FlexGrid... argFlexGrid.Col = 0 'set the current column to first column - (0)... argFlexGrid.Row = argFlexGrid.Row + 1 'set the current row to last row... argFlexGrid.SetFocus 'set the focus. End If Exit Sub End If If KeyAscii = 8 Then 'If BackSpace Key then... If Len(Trim(argFlexGrid.Text)) <> 0 Then 'If current cell is not empty then... argFlexGrid.Text = Left(argFlexGrid.Text, (Len(argFlexGrid.Text) - 1)) 'Removing a character from the right side of the FlexGrid cell's text ElseIf argFlexGrid.Rows > 2 Then 'If FlexGrid has more than 2 Rows including the FixedRow then... For i = 0 To argFlexGrid.Cols - 1 'Checking that the current row is empty or not... If Len(Trim(argFlexGrid.TextMatrix(argFlexGrid.Row, i))) = 0 Then 'Checking for Empty cell in the current row... If argFlexGrid.Col <> argFlexGrid.Cols - 1 Then 'Checking that if we reached the last column... argFlexGrid.Col = argFlexGrid.Col + 1 'goto next column... Else 'If current columnn is the last column then... argFlexGrid.Rows = argFlexGrid.Rows - 1 'Remove a Row. Exit Sub End If End If Next End If Else 'If Not BackSpace key then... argFlexGrid.Text = argFlexGrid.Text + Chr(KeyAscii) 'Append the pressed character to the right.

End If Exit Sub ErrHandler: MsgBox "An Error has Occured In The GETKEYSAdd() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Sub Public Sub GetKeysEdit(argFlexGrid As MSFlexGrid, KeyAscii As Integer) 'This Procedure is used to display the pressed key into FlexGrid in Addition Mode 'that is you cannot add new rows as you do in GETKEYSAdd(). On Error GoTo ErrHandler Dim i As Integer If KeyAscii = 13 Or KeyAscii = 9 Then Exit Sub 'If Enter Key or Tab Key then Exit Sub. If KeyAscii = 8 Then 'If BackSpace key then... If Len(Trim(argFlexGrid.Text)) <> 0 Then 'If current cell is not empty then... argFlexGrid.Text = Left(argFlexGrid.Text, (Len(argFlexGrid.Text) - 1)) 'Removing a character from the right side of the FlexGrid cell's text End If Else argFlexGrid.Text = argFlexGrid.Text + Chr(KeyAscii) 'Append the pressed character to the right. End If Exit Sub ErrHandler: MsgBox "An Error has Occured In The GETKEYSEdit() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Sub Public Sub AssignData(argFlexGrid As MSFlexGrid, argRS As Recordset) 'This procedure is used to Assign the Data in the given recordset 'to the given FlexGrid On Error GoTo ErrHandler Dim FormatString As String 'Stores the FormatString Dim i As Long 'Loop Variable Dim j As Long 'Loop Variable Dim MaxFldValLen As Long 'Stores the Maximum Field Value Length, Used for Automatic Resizing 'Moving The Recordset to the First argRS.MoveFirst 'Checking for Empty Recordset If argRS.RecordCount = 0 Or IsEmpty(argRS) Then Exit Sub 'setting the number of rows 'the total rows of FlexGrid includes the FixedRows also 'So argFlexGrid.Rows=No. Of Records->(argRs.RecordCount) + argrs.FixedRows->(1) argFlexGrid.Rows = argRS.RecordCount + 1 'Setting the current row

argFlexGrid.Row = 1 'checking for FixedCols 'if FixedCols is 1 then S.No. will be automatically generated 'if FixedCols is 0 then S.No. will Not be generated If argFlexGrid.FixedCols = 1 Then 'If FlexGrid's FixedCols is 1 then data should be assigned from the second column is that argFlexGrid.col=1 argFlexGrid.Col = 1 'setting the number of columns 'the total Cols of FlexGrid includes the FixedCols also 'So argFlexGrid.Cols=No. Of Fields->(argRs.Fields.Count) + argrs.FixedCols->(1) argFlexGrid.Cols = argRS.Fields.Count + 1 For i = 1 To argRS.RecordCount 'this loop is for rows For j = 1 To argRS.Fields.Count 'this loop is for Columns argFlexGrid.TextMatrix(i, j) = argRS(j - 1) Next argFlexGrid.TextMatrix(i, 0) = i 'i holds the S.No. argRS.MoveNext Next argRS.MoveFirst FormatString = "S.No." 'The Following loop is used for resizing the FlexGrid Columns using the FormatString Property 'the MaxFldValLen variable stores the maximum length of a field's value 'and this variable is used to add spaces in the FormatString 'Note: This Resizing Is Not Very Accurate !!! For i = 0 To argRS.Fields.Count - 1 'this loop is for each Field in the argRS MaxFldValLen = 0 For j = 0 To argRS.RecordCount - 1 'this loop is for each Record in the argRS If MaxFldValLen <= Len(argRS(i)) Then MaxFldValLen = Len(argRS(i)) End If argRS.MoveNext Next argRS.MoveFirst If Len(argRS(i).Name) > MaxFldValLen Then 'if length of argRS(i).Name>MaxFldValLen(the maximum length of the field's value in a Record) then, 'add some spaces to the FormatString with the Name of the field, here I added 5 You can change it. FormatString = FormatString & "|" & argRS(i).Name & Space(5) Else 'if MaxFldValLen(the maximum length of the field's value in a Record) 'is greater than the length of argRS(i).Name then,

'add the excess spaces is that Space(MaxFldValLen - Len(argRS(i).Name) + 15), 'the value 15 should not be changed for exact output FormatString = FormatString & "|" & argRS(i).Name & Space(MaxFldValLen Len(argRS(i).Name) + 15) End If Next Else 'if argFlexGrid.FixedCols=0 then - "S.No." will Not be generated 'If FlexGrid's FixedCols is 0 then data should be assigned from the First column is that argFlexGrid.col=0 argFlexGrid.Col = 0 'setting the number of columns 'the total Cols of FlexGrid includes the FixedCols also 'So argFlexGrid.Cols=No. Of Fields->(argRs.Fields.Count) + argrs.FixedCols->(1) 'if FixedCols=0 then argFlexGrid.Cols = argRS.Fields.Count argFlexGrid.Cols = argRS.Fields.Count For i = 1 To argRS.RecordCount 'this loop is for rows For j = 0 To argRS.Fields.Count - 1 'this loop is for Columns argFlexGrid.TextMatrix(i, j) = argRS(j) Next argRS.MoveNext Next argRS.MoveFirst 'The Following loop is used for resizing the FlexGrid Columns using the FormatString Property 'the MaxFldValLen variable stores the maximum length of a field's value 'and this variable is used to add spaces in the FormatString 'Note: This Resizing Is Not Very Accurate !!! For i = 0 To argRS.Fields.Count - 1 'this loop is for each Field in the argRS MaxFldValLen = 0 For j = 0 To argRS.RecordCount - 1 'this loop is for each Record in the argRS If MaxFldValLen <= Len(argRS(i)) Then MaxFldValLen = Len(argRS(i)) End If argRS.MoveNext Next argRS.MoveFirst If Len(argRS(i).Name) > MaxFldValLen Then 'if length of argRS(i).Name>MaxFldValLen(the maximum length of the field's value in a Record) then, 'add some spaces to the FormatString with the Name of the field, here I added 5 You can change it. If FormatString = "" Then 'if this loop runs for first time then FormatString will be empty

FormatString = argRS(i).Name & Space(5) Else FormatString = FormatString & "|" & argRS(i).Name & Space(5) End If Else 'if MaxFldValLen(the maximum length of the field's value in a Record) 'is greater than the length of argRS(i).Name then, 'add the excess spaces is that Space(MaxFldValLen - Len(argRS(i).Name) + 15), 'the value 15 should not be changed for exact output If FormatString = "" Then 'if this loop runs for first time then FormatString will be empty FormatString = argRS(i).Name & Space(MaxFldValLen - Len(argRS(i).Name) + 15) Else FormatString = FormatString & "|" & argRS(i).Name & Space(MaxFldValLen Len(argRS(i).Name) + 15) End If End If Next End If 'Finally assign the FormatString argFlexGrid.FormatString = FormatString Exit Sub ErrHandler: MsgBox "An Error has Occured In The AssignData() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbYesNo + vbCritical, "FlexGrid Example" End Sub Public Function FlexUpdate(argFlexGrid As MSFlexGrid, argRS As Recordset) As Boolean 'This Procedure will Save the Data in the FlexGrid to the given 'Recordset's Database On Error GoTo ErrHandler Dim i As Long, j As Long If argFlexGrid.Rows <= 1 Then Exit Function 'If there is no Row or Only FixedRow. If FlexChk(argFlexGrid) = False Then 'Checking for empty cells by calling FlexChk(). FlexUpdate = False Exit Function End If argFlexGrid.Row = 0 'setting current row argFlexGrid.Col = 0 'setting current col argRS.AddNew For i = 0 To (argFlexGrid.Rows - 1) 'This loop saves data to the table. argFlexGrid.Row = argFlexGrid.Row + 1 argFlexGrid.Col = 0 For j = 0 To argRS.Fields.Count - 1 argRS(j) = Trim(argFlexGrid.Text) If argFlexGrid.Col + 1 <> argFlexGrid.Cols Then argFlexGrid.Col = argFlexGrid.Col + 1 End If Next

argRS.UpdateBatch adAffectAllChapters If argFlexGrid.Rows = (argFlexGrid.Row + 1) Then GoTo FIN argRS.AddNew Next FIN: argRS.UpdateBatch adAffectAllChapters FlexUpdate = True Exit Function ErrHandler: MsgBox "An Error has Occured In The FlexUpdate() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Function Public Function FlexChk(argFlexGrid As MSFlexGrid) As Boolean 'This Procedure will check the given flexgrid for empty cells On Error GoTo ErrHandler Dim ig, jg, ercnt As Long Dim flg As Boolean For jg = 0 To (argFlexGrid.Rows - 1) For ig = 0 To (argFlexGrid.Cols - 1) If Len(Trim(argFlexGrid.TextMatrix(jg, ig))) = 0 Then flg = True GoTo EMTY Else flg = False End If Next Next EMTY: If flg = True Then FlexChk = False Else FlexChk = True End If Exit Function ErrHandler: MsgBox "An Error has Occured In The FlexChk() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example" End Function ---------Task: How to use Crystal report with MS-Access cr1.ReportFileName = App.Path & "\reports\ot1.rpt" 'DataFiles method stores actual database location 'you must declare DataFiles equal to Tables used in Crystal Report 'By doing this you don't need to set database path from Crystal report setting

cr1.DataFiles(0) = App.Path & "\otmanag.mdb" cr1.DataFiles(1) = App.Path & "\otmanag.mdb" 'SelectionFormula is used to pass query to report cr1.SelectionFormula = "" 'cr1.SelectionFormula = {otmast.otid}='" & trim(text1.text) & "'" cr1.WindowState = crptMaximized cr1.Action = 1 cr1.PageZoom 89 ============ Task: Send Mail Using Visual Basic Dim cdoObj As CDO.Message Dim iConf As CDO.Configuration Dim str As String 'add reference ' Microsoft CDO Exchange 2000 Library Set cdoObj = CreateObject("cdo.message") Set iConf = CreateObject("CDO.Configuration") Set iFields = iConf.Fields iFields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' SMTP iFields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.0.1" iFields.Update Set cdoObj.Configuration = iConf str = vbNullString cdoObj.Subject = "Hai Check mail" str = str & " hai this is a check mail" str = str & " " cdoObj.HTMLBody = str cdoObj.To = "" 'type your friend email id cdoObj.CC = "" cdoObj.From = "" ' type your mail id cdoObj.Send MsgBox "Mails send sucessfully" ----------Getting the Network Card MAC Address Written by: dimport Published by: w0lf Published on: 2003-06-21 07:19:46 Topic: Visual Basic Search OSI about Visual Basic. More articles by dimport. viewed 22643 times send this article printer friendly Digg this! Rate this article : The Network card MAC address is a uniquely assigned code hardcoded into your network card. The value is used by networks when transmitting information between sources Here's how you get access to it from Visual Basic Simply create a new VB6 project, add a new module and cut and paste the code below into the module.

Then use the function GetMACAddress() to obtain the string value for the Network card MAC Address Option Explicit Public Const NCBASTAT As Long = H33 Public Const NCBNAMSZ As Long = 16 Public Const HEAP_ZERO_MEMORY As Long = H8 Public Const HEAP_GENERATE_EXCEPTIONS As Long = H4 Public Const NCBRESET As Long = H32 Public Type NET_CONTROL_BLOCK 'NCB ncb_command As Byte ncb_retcode As Byte ncb_lsn As Byte ncb_num As Byte ncb_buffer As Long ncb_length As Integer ncb_callname As String * NCBNAMSZ ncb_name As String * NCBNAMSZ ncb_rto As Byte ncb_sto As Byte ncb_post As Long ncb_lana_num As Byte ncb_cmd_cplt As Byte ncb_reserve(9) As Byte ' Reserved, must be 0 ncb_event As Long End Type Public Type ADAPTER_STATUS adapter_address(5) As Byte rev_major As Byte reserved0 As Byte adapter_type As Byte rev_minor As Byte duration As Integer frmr_recv As Integer frmr_xmit As Integer iframe_recv_err As Integer xmit_aborts As Integer xmit_success As Long recv_success As Long iframe_xmit_err As Integer recv_buff_unavail As Integer t1_timeouts As Integer ti_timeouts As Integer Reserved1 As Long free_ncbs As Integer max_cfg_ncbs As Integer max_ncbs As Integer xmit_buf_unavail As Integer max_dgram_size As Integer pending_sess As Integer max_cfg_sess As Integer max_sess As Integer max_sess_pkt_size As Integer name_count As Integer End Type

Public Type NAME_BUFFER name As String * NCBNAMSZ name_num As Integer name_flags As Integer End Type Public Type ASTAT adapt As ADAPTER_STATUS NameBuff(30) As NAME_BUFFER End Type Public Declare Function Netbios Lib "netapi32.dll" _ (pncb As NET_CONTROL_BLOCK) As Byte Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (hpvDest As Any, ByVal _ hpvSource As Long, ByVal _ cbCopy As Long) Public Declare Function GetProcessHeap Lib "kernel32" () As Long Public Declare Function HeapAlloc Lib "kernel32" _ (ByVal hHeap As Long, ByVal dwFlags As Long, _ ByVal dwBytes As Long) As Long Public Declare Function HeapFree Lib "kernel32" _ (ByVal hHeap As Long, _ ByVal dwFlags As Long, _ lpMem As Any) As Long Public Function GetMACAddress() As String 'retrieve the MAC Address for the network controller 'installed, returning a formatted string Dim tmp As String Dim pASTAT As Long Dim NCB As NET_CONTROL_BLOCK Dim AST As ASTAT 'The IBM NetBIOS 3.0 specifications defines four basic 'NetBIOS environments under the NCBRESET command. Win32 'follows the OS/2 Dynamic Link Routine (DLR) environment. 'This means that the first NCB issued by an application 'must be a NCBRESET, with the exception of NCBENUM. 'The Windows NT implementation differs from the IBM 'NetBIOS 3.0 specifications in the NCB_CALLNAME field. NCB.ncb_command = NCBRESET Call Netbios(NCB) 'To get the Media Access Control (MAC) address for an 'ethernet adapter programmatically, use the Netbios() 'NCBASTAT command and provide a "*" as the name in the 'NCB.ncb_CallName field (in a 16-chr string). NCB.ncb_callname = "* " NCB.ncb_command = NCBASTAT 'For machines with multiple network adapters you need to 'enumerate the LANA numbers and perform the NCBASTAT 'command on each. Even when you have a single network

'adapter, it is a good idea to enumerate valid LANA numbers 'first and perform the NCBASTAT on one of the valid LANA 'numbers. It is considered bad programming to hardcode the 'LANA number to 0 (see the comments section below). NCB.ncb_lana_num = 0 NCB.ncb_length = Len(AST) pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS _ Or HEAP_ZERO_MEMORY, NCB.ncb_length) If pASTAT = 0 Then Debug.Print "memory allocation failed!" Exit Function End If NCB.ncb_buffer = pASTAT Call Netbios(NCB) CopyMemory AST, NCB.ncb_buffer, Len(AST) tmp = Format$(Hex(AST.adapt.adapter_address(0)), "00") " " _ Format$(Hex(AST.adapt.adapter_address(1)), "00") " " _ Format$(Hex(AST.adapt.adapter_address(2)), "00") " " _

Format$(Hex(AST.adapt.adapter_address(3)), "00") " " _ Format$(Hex(AST.adapt.adapter_address(4)), "00") " " _ Format$(Hex(AST.adapt.adapter_address(5)), "00") HeapFree GetProcessHeap(), 0, pASTAT GetMACAddress = tmp

End Function This article was originally written by barnseyboy Did you like this article? There are hundreds more. * Join OSIX * Get Involved * Challenge or Test your skills Comments: Anonymous 2005-12-05 10:54:03 Doesn't wpork for XP Home Anonymous 2006-05-09 15:58:51 took too much tweaking. should run before posting. Anonymous 2006-09-27 10:05:12 Esto me da la mac de mi pc pero como obtener la de una Ip Anonymous 2006-12-27 09:03:14

VERY GOOD~! IT WORKS PERFECTLY~!! my os is xp pro , it works perfectly. thanks a lot Anonymous 2007-02-10 09:39:21 A wonderful program. Thanks a lot. True it requires some small corrections, at least on Windows 2000, like use &H33 instead of H33, but it's not a big deal. Anonymous 2007-03-03 17:35:57 Didn't work, Lots of coding errors. XP Home, SP2. VB6 Anonymous 2007-03-12 20:48:21 thanks a lot Anonymous 2007-07-11 11:24:17 Thank for the code but there are few errors. The following is the corrected code which can work on Win 2000 Server & Win Server 2003: Option Explicit Const NCBASTAT As Long = &H33 Public Const NCBNAMSZ As Long = 16 Public Const HEAP_ZERO_MEMORY As Long = &H8 Public Const HEAP_GENERATE_EXCEPTIONS As Long = &H4 Public Const NCBRESET As Long = &H32 Public tmp, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 Public Type NET_CONTROL_BLOCK 'NCB ncb_command As Byte ncb_retcode As Byte ncb_lsn As Byte ncb_num As Byte ncb_buffer As Long ncb_length As Integer ncb_callname As String * NCBNAMSZ ncb_name As String * NCBNAMSZ ncb_rto As Byte ncb_sto As Byte ncb_post As Long ncb_lana_num As Byte ncb_cmd_cplt As Byte ncb_reserve(9) As Byte ' Reserved, must be 0 ncb_event As Long End Type Public Type ADAPTER_STATUS adapter_address(5) As Byte rev_major As Byte reserved0 As Byte adapter_type As Byte rev_minor As Byte duration As Integer frmr_recv As Integer frmr_xmit As Integer

iframe_recv_err As Integer xmit_aborts As Integer xmit_success As Long recv_success As Long iframe_xmit_err As Integer recv_buff_unavail As Integer t1_timeouts As Integer ti_timeouts As Integer Reserved1 As Long free_ncbs As Integer max_cfg_ncbs As Integer max_ncbs As Integer xmit_buf_unavail As Integer max_dgram_size As Integer pending_sess As Integer max_cfg_sess As Integer max_sess As Integer max_sess_pkt_size As Integer name_count As Integer End Type Public Type NAME_BUFFER name As String * NCBNAMSZ name_num As Integer name_flags As Integer End Type Public Type ASTAT adapt As ADAPTER_STATUS NameBuff(30) As NAME_BUFFER End Type Public Declare Function Netbios Lib "netapi32.dll" _ (pncb As NET_CONTROL_BLOCK) As Byte Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (hpvDest As Any, ByVal _ hpvSource As Long, ByVal _ cbCopy As Long) Public Declare Function GetProcessHeap Lib "kernel32" () As Long Public Declare Function HeapAlloc Lib "kernel32" _ (ByVal hHeap As Long, ByVal dwFlags As Long, _ ByVal dwBytes As Long) As Long Public Declare Function HeapFree Lib "kernel32" _ (ByVal hHeap As Long, _ ByVal dwFlags As Long, _ lpMem As Any) As Long Public Function GetMACAddress() As String 'retrieve the MAC Address for the network controller 'installed, returning a formatted string Dim tmp As String Dim pASTAT As Long Dim NCB As NET_CONTROL_BLOCK

Dim AST As ASTAT 'The IBM NetBIOS 3.0 specifications defines four basic 'NetBIOS environments under the NCBRESET command. Win32 'follows the OS/2 Dynamic Link Routine (DLR) environment. 'This means that the first NCB issued by an application 'must be a NCBRESET, with the exception of NCBENUM. 'The Windows NT implementation differs from the IBM 'NetBIOS 3.0 specifications in the NCB_CALLNAME field. NCB.ncb_command = NCBRESET Call Netbios(NCB) 'To get the Media Access Control (MAC) address for an 'ethernet adapter programmatically, use the Netbios() 'NCBASTAT command and provide a "*" as the name in the 'NCB.ncb_CallName field (in a 16-chr string). NCB.ncb_callname = "* " NCB.ncb_command = NCBASTAT 'For machines with multiple network adapters you need to 'enumerate the LANA numbers and perform the NCBASTAT 'command on each. Even when you have a single network 'adapter, it is a good idea to enumerate valid LANA numbers 'first and perform the NCBASTAT on one of the valid LANA 'numbers. It is considered bad programming to hardcode the 'LANA number to 0 (see the comments section below). NCB.ncb_lana_num = 0 NCB.ncb_length = Len(AST) pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS _ Or HEAP_ZERO_MEMORY, NCB.ncb_length) If pASTAT = 0 Then Debug.Print "memory allocation failed!" Exit Function End If NCB.ncb_buffer = pASTAT Call Netbios(NCB) CopyMemory AST, NCB.ncb_buffer, Len(AST) tmp1 = Format$(Hex(AST.adapt.adapter_address(0)), tmp2 = Format$(Hex(AST.adapt.adapter_address(1)), tmp3 = Format$(Hex(AST.adapt.adapter_address(2)), tmp4 = Format$(Hex(AST.adapt.adapter_address(3)), tmp5 = Format$(Hex(AST.adapt.adapter_address(4)), tmp6 = Format$(Hex(AST.adapt.adapter_address(5)), tmp = tmp1 & " " & tmp2 & " " & tmp3 & " " & tmp4 HeapFree GetProcessHeap(), 0, pASTAT GetMACAddress = tmp End Function Anonymous 2007-07-18 05:26:38 Thx alot works super.

"00") "00") "00") "00") "00") "00") & " "

& & & & &

" " " " "

" " " " "

& tmp5 & " " & tmp6

but why two spaces between each octet? lg Michi Anonymous 2007-08-27 07:18:54 its not woking for me .. its returning all zeros .. can you tell what can be the reason Anonymous 2007-09-28 12:37:32 I have the same problem. On some computer return real value and on some all zeros. Any help? Anonymous 2007-10-01 15:17:30 me too Anonymous 2007-10-03 21:07:06 >> This article was originally written by barnseyboy jajajaja This thing it's belongs to microsoft... jjajajaja http://support.microsoft.com/kb/175472 What a thief!!!! that barnseyboy!!! Anonymous 2007-10-15 19:07:20 The updated version works perfectly in VBA as well. Anonymous 2007-12-01 18:49:42 The revised code produces the right MAC on three of my newest PCs (all Vista) but produces all zeros on my older XP boxes. Anybody understand why? Anonymously add a comment: (or register here) (registration is really fast and we send you no spam) BB Code is enabled. Captcha Number:

Test Yourself: (why not try testing your skill on this subject? Clicking the link will start the test.)