Author: Cooly Source: http: //search.9cbs.net/expert/topic/51/5101/2003/3/20/1555609.htm
'==================================================== ====== 'One, how to use the ADODC control to bind data to DataGrid and DataList' ============================= ==========================
Public isdb as boolean
Private Sub Form_Load () Dim connStr, AccessLocation As StringAccessLocation = "C: /db1.mdb" connStr = "Provider = Microsoft.Jet.OLEDB.4.0; Data Source =" & AccessLocation & "; Persist Security Info = False" Adodc1. ConnectionString = connStrAdodc1.CommandType = adCmdTextAdodc1.RecordSource = "select * from tableabc" Adodc1.RefreshFor i = 0 To Adodc1.Recordset.Fields.Count - 1 List1.AddItem Adodc1.Recordset.Fields (i) .NameNextSet DataList1.DataSource = Adodc1DataList1 .Datafield = "col1" DATALIST1.BOUNDCOLUMN = "col1" set datalist1.rowsource = adodc1dataList1.listfield = "col1"
Adodc1.recordset.movefirstnd Sub
PRIVATE SUB LIST1_CLICK () 'Select the field DIM SQL displayed in DataGrid, SQL1 AS STRING
SQL = "SELECT" for i = 0 to list1.listcount - 1 if List1.selected (i) Then IF TRIM (SQL1) = "" "THEN SQL1 = List1.List (i) Else SQL1 = SQL1 &", "& List1 .List (i) end if end ifnextif trim (SQL1) = "" "" "
SQL = SQL & SQL1 & "from Tableabc"
Adodc1.recordsource = SQLADODC1.REFREST DATAGRID1.DATASOURCE = AdodC1end Sub
'==================================================== ======= ', how to use the file to read and write' ================================ ========================= Dim getValue () AS Byte
Private Sub Command1_Click () Open "C: /1.cmd" for binary access Write as # 2 PUT # 2, GetValue () Close # 2
End Sub
Private sub flow_load ()
Open "c: /command.com" for binary access reading as # 1 redim getValue (Filelen ("c: /command.com") Get # 1, GetValueclose # 1END SUB
'==================================================== ======= 'Third, the string processing algorithm (1)' finds the string content and the number of frequencies in the known string, the number of times appears' ============== ===============================================================================================================================================================00 B AS STRINGDIM I as Longdim C, T as longc = 0A = "abcdefdedgcdeethcdenbicde" for i = 1 to len (a) t = 0 b = a if i = len (a) - 2 THEN EXIT for Do Until INSTR (B, MID (A, I, 3)) = 0 b = Right (b, len (b) - INSTR (B, MID (A, I, 3))) T = T 1 LOOP IF T, C THEN C = T End ifnextmsgbox CEND SUB
'==================================================== ======= '4, driveristbox, dirlistbox, filelistbox's three controls of three controls' ============================== ===========================
Private sub Dir1_change () file1.path = Dir1.Pathend Sub
PRIVATE SUB Drive1_change () Dir1.path = Drive1.DriveEnd Subprivate Sub file1_click () text1.text = file1.path & "/" & file1.filenameend SUB
'==================================================== ======= '5, how to operate (using fso)' =============================== ==========================
Private Sub Command1_Click () Dim fso As ObjectDim SourcePath, TargetPath As StringSourcePath = Text1.TextTargetPath = Text2.TextSet fso = CreateObject ( "Scripting.FileSystemObject") If fso.FolderExists (TargetPath) Then fso.CopyFolder SourcePath & "*. *" , TargetPath fso.CopyFile SourcePath & "*. *", TargetPathElse fso.CreateFolder (TargetPath) fso.CopyFolder SourcePath & "*. *", TargetPath fso.CopyFile SourcePath & "*. *", TargetPathEnd IfSet fso = NothingMsgBox "copy Complete "End Sub
Private Sub Command2_Click () Dim fso As ObjectDim TargetPath As StringTargetPath = "D: / Test" Set fso = CreateObject ( "Scripting.FileSystemObject") fso.DeleteFolder TargetPath, TrueSet fso = NothingMsgBox "deleted successfully" End Sub
'==================================================== ======= '6, how to remove the contents of the DataGrid control to select the line' =============================== ================================================================================================ # DataGrid1.rowcontaining (Y) msgbox datagrid1.columns (0) .TEXTEND SUB
Private Sub Form_Load () Adodc1.ConnectionString = "Provider = SQLOLEDB.1; Persist Security Info = False; User ID = sa; Initial Catalog = test; Data Source = SERVER" Adodc1.CommandType = adCmdTextAdodc1.RecordSource = "select * from test Adodc1.refreshset DataGrid1.datasource = Adodc1DataGrid1.allowUpdate = falseEnd Sub
'==================================================== ======= ', how to adoDB object bind DataGrid control' ================================= =========================
Private Sub Form_Load () Dim conn As ADODB.ConnectionDim rst As ADODB.RecordsetSet conn = New ADODB.ConnectionSet rst = New ADODB.Recordsetconn.ConnectionString = "Provider = SQLOLEDB.1; Persist Security Info = False; User ID = sa; Initial Catalog = test; data source = server "conn.open," sa "
Rst.cursorLocation = aduseclient
Rst.open "Select * from table1", conn, adopenDynamic, AdlockOptimisticSet DataGrid1.datasource = RST
End Sub
'==================================================== ======= '8, the date function is used and the file existing file is existing' ======================================================================================================================================================================================= ======================================================================================================================================================================================================================================== # ) = 0 and IXT1.TEXT, "-") = 0 Then if clng (text1.text)> 0 and clng (text1.text) <= 12 THEN MSGBOX DATEDIFF ("D", DateSerial (Year (NOW) )), Text1.Text, 1), DateAdd ("M", 1, DATESERIAL (Year (NOW ()), Text1.Text, 1)) Else Msgbox "Error" end ifelse msgbox "Error, Wrong Value" end IFEND SUB
Private Sub Command2_Click () Dim fso As ObjectSet fso = CreateObject ( "Scripting.FileSystemObject") If fso.FileExists ( "C: /command.com") = True Then MsgBox "C: /Command.com file already exists" Else MsgBox "C: /command.com file does not exist" end ifset fso = nothingend Sub
'==================================================== ======= 'Simple algorithm for nine, decimal and binary. '==================================================== =======
Private Sub Command1_Click () DIM A, B As longdim c as stringa = text1.textdo if a = 0 THEN EXIT DO if a> 1 THEN B = a mod 2 else b = a end if c = cstr (b) & cstr c) a = a / 2looptext2.text = CEND SUB
PRIVATE SUB Command2_Click () Dim A, B AS Stringdim i, C, D As longa = text2.text
For i = 1 to len (a) c = clng (MID (A, I, 1)) IF C = 1 THEN D = D 2 ^ (LEN (A) - i) end ifnextText3.Text = dend Sub
'==================================================== ======= ', move control in the container' ================================== ====================== Public ismove as booleanpublic bx, by as longprivate sub flow_load () ismove = falseeend Sub
Private Sub Label1_Mousedown (Button As Integer, Shift As Integer, x as single, y as single) ife = 1 dam = true bx = x by = yend ifend sub
Private sub Label1_Mousemove (Button as Integer, Shift As Integer, x as single, y as single) if button = 1 and ismove daml1.move x label1.top - BX, Y Label1.top - BYEND IFEND SUB
Private sub Label1_MouseUp (Button As Integer, Shift As Integer, x as single, y as single) ismove = false
'==================================================== ======= Eighte eight, how to get external parameters when running the program '======================================================================================================================================================================================== ====================================================================================================================== IF INSTR (GetString, "/") = 1 Then if len (getString)> 1 damtring = right (getString, len (getString) - 1) Pararray = split (getString, "/", -1, vbtextcompare) for I = 0 to Ubound (Paraarray ()) MsgBox "Parameter" & I 1 & ": =" & TRIM (Paraarray (i)) Next Else MsgBox "Empty Parameter!" End ifelse if INSTR (GetString, "/") = 0 THEN MSGBOX "No parameter!" Else Msgbox "Wrong Format" end ingnd ingnd sub
'==================================================== ======= ', the operation of the registry' ================================== ====================== Option ExplicitConst HKEY_CLASSES_ROOT = & H80000000Const HKEY_CURRENT_USER = & H80000001Const HKEY_LOCAL_MACHINE = & H80000002Const HKEY_USERS = & H80000003Const HKEY_PERFORMANCE_DATA = & H80000004Const HKEY_CURRENT_CONFIG = & H80000005Const HKEY_DYN_DATA = & H80000006Const REG_NONE = 0Const REG_SZ = 1const reg_expand_sz = 2const reg_binary = 3const reg_dword = 4const reg_dword_big_endian = 5const REG_MULTI_SZ = 7
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As LongPrivate Declare Function RegCreateKey Lib "Advapi32.dll" Alias "RegcreateKeya" (Byval HKEY AS STRING, PhkResult As Long) AS Long
Private Sub Command1_Click () DIM HKEY As Longdim DSNName, STRDRIVER, STRSERVER, STRDATABASE, STRLASTUSER, STRDBTYPE AS STRING
DSNNAME = "Myodbc"
STRDRIVER = "c: //winnt//system32//sqlsrv32.dll" "SQL Server driver, if you can change it with the VFP STRSERVER =" Server "strDatabase =" strlastuser = "STRDBTYPE =" SQL Server "RegcreateKey HKEY_LOCAL_MACHINE," Software / ODBC / ODBC.INI / ODBC Data Source ", HKEYREGSETVALUEEX HKEY, DSNNAME, 0, REG_SZ, BYVAL STRDBTYPE, LEN (STRDBTYPE) 1
RegCreateKey HKEY_LOCAL_MACHINE, "SOFTWARE / ODBC / ODBC.INI /" & DSNName, hKeyRegSetValueEx hKey, "Driver", 0, REG_EXPAND_SZ, ByVal CStr (strDriver), Len (strDriver) 1RegSetValueEx hKey, "Server", 0, REG_SZ, ByVal CStr (strServer), Len (strServer) 1RegSetValueEx hKey, "Database", 0, REG_SZ, ByVal CStr (strDatabase), Len (strDatabase) 1RegSetValueEx hKey, "LastUser", 0, REG_SZ, ByVal CStr (strLastUser), Len (STRLASTUSER) 1END SUB
'==================================================== ======= 'twenty, TreeView used, and select the node' ============================================== ===============================================================================00 TEXT)) = "ff" the nodey.selected = true treeview1.setfocus exit for end ifnextend Sub
Private Sub Form_Load () Rs1.CommandType = adCmdTextRs1.RecordSource = "select distinct biao, zu from test order by zu" Rs1.RefreshDim Rs As ADODB.RecordsetSet Rs = Rs1.RecordsetSet nodX = TreeView1.Nodes.Add (,, "r "," Report Group ") i = 0 DIM TEMPSTRING AS STRING DIM TEMPKEY As Long Do Until = e = rs! Zu dam nodex = treeview1.nodes.add (" z "& tempkey, tvwchild , "B" & I, RS! BIAO) Else Set Nodx = TreeView1.nodes.Add ("R", Tvwchild, "Z" & I, RS! ZU) set nodex = TreeView1.nodes.Add ("Z" & I, TVWchild, "B" & I, RS! BIAO) TEMPSTRING = rs! zu Tempkey = I end if rmovenext i = i 1 Loopend Sub
'==================================================== ======= 'Twenty-one, Word object use (find if you contain specified keywords in the Word document,', ', in the specified location Insert string)' ============= ============================================================= p.com As Objectdim F, FSO As Objectdim Filepath As Stringdim Keywords As String
Filepath = "c: / word" keywords = "abc"
SET FSO = CreateObject ("scripting.filesystemObject")
Set folders = fso.getfolder (filepath) i = 0for Each f in folders.files if Lcase (Right (f.name, len (f.name) - INSTRREV (f.name, "))) =" DOC " Then Set wrdApp = CreateObject ( "Word.Application") wrdApp.Visible = False wrdApp.Documents.Open FileName: = filepath & "/" & f.Name If InStr (wrdApp.ActiveDocument.Content.Text, Keywords) <> 0 Then msgbox f.name end if wrdapp.quit end ifXext
SET WRDAPP = Nothing
End Sub
Private Sub Command2_Click () Dim WRDAPP AS Objectdim Wrdrows, WRDCOLS, I AS Longdim Instext As String
WRDROWS = 10: wrdcols = 10instext = "test"
Set wrdApp = CreateObject ( "Word.Application") wrdApp.Visible = FalsewrdApp.Documents.Open FileName: = "C: /words/1.doc" For I = 1 To wrdRows wrdApp.ActiveDocument.Content.insertAfter vbCrLfNext
WRDAPP.ActiveDocument.content.goto what: = 3, Which: = 2, count: = WrDROWSWRDAPP.ActiveDocument.content.insertAfter Space (WRDCOLS) & "PPpppppppppppp"
WRDAPP.ActiveDocument.savewrdapp.quit
SET WRDAPP = Nothing
End Sub more please see the original post: http://expert.9cbs.net/expert/topic/1555/1555609.xml? Temp = .3376276
