■ 学新的编程语言先仔细看该语言案例教程或从入门到精通的书。对具体语句、函数及可使用对象不了解或忘记的，可在该编程语言的“参考手册”中检索。　《如果资料为电子书时，即使不知道具体名称也能按需要的功能用关键字在手册中搜索，比如微软的MSDN中带有中/英文的索引，可以在索引/搜索页中查：如：报表report、API、分隔split、表grid/table、数组下标Array Bound、文件File、查找Find/Look/Seek、行Row列Col、左left右right中mid、顶Top底bottom 等就会显示出相关内容，当然也可以直接输入语句/函数/对象等查其用法。》 ■ 多看案例，养成好的开发习惯 1、模块化开发(如读入/回写，查找、验证模块)，在模块旁标注模块用途及用法，变量及重要语句后标注含义。常用值常量化（如读写的单元格位置用常量名） 2、【尽量使用局部变量和对象，因为过程嵌套调用时公用对象状态和值就无法控制，而且非局部变量调用时一般也是要赋初始值。】 3、循环或判断内的语句缩进，在结束语句标上结束哪个循环或判断。 4、过程与变量名尽量包含大写字母，这样在使用时容易看出是否书写错了名称。 5、作说明文件（主要流程，数据库结构等），统一对象/变量的命名规则(自己易记易懂)。 6、小心使用复合判断（复合判断是指含And or 等的判断），多数复合判断做成简单判断的嵌套更可靠。 7、保留模块头的Option Explicit声明，在发布软件前尽量不使用容错机制，正式发布时应使用容错机制（有些错可以忽略跳过比如：重复关闭对象或提交等无效操作） 8、程序中可以使用debug.print 在立即窗中输出表达式结果，debug不会被编译进exe。Vb调试时无错误的编译后的仍可能报错。 9、断点即执行该语句前中断程序，VB断点快捷键F9，断点或在出现错误时进入调试，都可以直接修改程序后继续运行，也可在立即窗中输入? rs!f等语句回车显示该语句结果，断点所在过程中的表达式鼠标停留即可查看当前值。 On error goto errs '一般放在过程头行，仅在首次错误时跳转到过程，在错误处理过程中再次出错会退出程序 Errs: '通用错误提示 If Err.Number <> 0 Then Dim cwts '错误提示 cwts = Err.Description & vbCrLf & "错误代码：" & Err.Number If Err.Number <> -2147217887 And Err.Number <> -2147467259 Then cwts = cwts & vbCrLf & "引发错误部件：" & Err.Source MsgBox cwts End If On Error Resume Next '错误时继续执行，▲可用于同一个过程中多次出现错误的处理，以下示例▲ dim ErrState if Err.Number<>0 then '用在要判断是否有错误的行前 if Err.number=10048 then ErrState= "端口占用" Err.number=0 '--------清除错误状态，以正确响应下次错误● Err.Description = "" '-------------清除错误描述（如不用就不需要清) ..... (清完后再执行尝试解决错误的程序,如尝试解决仍可能出错误，则下面再来一次if err...)● else debug.print err.Number,err.Source,err.Description ... endif ... On Error GoTo errs '在处理完需要多次偿试的错误后，可以使用其他错误处理结构● ■ 所有对象（含变量,方法,事件,控件,API；ActiveX dll/ocx等）都必须先注册再创建使用。 ⊕系统及VB自带对象安装时已经注册，其他COM或ActiveX对象则必须用，win+R组合键在运行中运行命令 regsvr32 filename.dll(或ocx文件，/U卸载/s不返回成功否的提示框。) ，有些对象要用DLL自带函数注册，如sqliteodbc，注册运行命令(或批命令.bat文件)rundll32 sqlite3.dll,install (参数quiet表示无提示框， uninstall表示反注册) 　⊕VB中静态创建：基本对象直接定义(Public|Private,Dim,Declare等)，是部件的可直接拖放出来即可，扩展对象或ActiveX dll/ocx则要先在菜单中将“引用/部件”勾选，外部对象的定义dim object as classname，有些还要用set object=new classname或其自带的初始化方法进行初始化。 ⊕VB中动态创建：先定义一个空对象，然后通过语句“如：Set Obj=CreateObject()/GetObject()”将创建并初始化后的对象装入空对象中。动态对象也有各自的堆栈和事件池等(要求该COM对象已注册)。　API函数声明必须用Declare可以在Declare前加Public。 /*** 可用对象在Visual C/Basic...中的对象浏览器(Object Viewer)中可以查看。在"添加 引用/部件"的列表中找到并选中，在对象浏览器<所有支持库下拉列表>中的名称一般即是该对象名(有Lib等明显不是名称要素的后缀去掉)。 ★要响应Active对象的事件可以在定义对象的名称前加“withevents”关键字，这样就可以在对象下拉表中选中对象再在事件中选择相应事件。★ ***/ ■VB运算符、变量、语句、函数、对象等基础 + 加（也是字符串拼接） - 减（也是取负值） * 乘 / 浮点数除 \ 整数除 Mod 取余数 ^ 乘方 & 字符串拼接(A & B即表示AB)，还有些特殊用法如&H...表示16进制数。 : 分隔两个语句，两个语句放同一行时。 也可以作为goto跳转的段落标识如Error:，段落必须放在过程中，所有段落都会被执行，因此要加以判断如：If Err.Number <> 0 Then End _ 下划线连接下一行，将一个长语句拆分为多行时用。 AddressOf 引用对象地址 < 小于 <= 小于等于 > 大于 >= 大于等于 = 等于 (【=号的两边是区分大小写的】，instr等查找比较时是可以设定是否区分大小写的，UCase函数将所有字母大写，LCase所有字母小写 ) <> 不等于 Like 字符比较（通配符"*"代表任意长度任意字符"?"任意一个字符"#"代表一个数字"!"表示非"-"在[]中表示范围。示例："a[L-P]#[!c-e]"值ao3f则符合） Is 两个对象比较，如果是同类对象则返回真 Eqv 数值同位比较，以二进制方式，逐位比较。 And 变量1 And 变量2 两个量均为True ，才返回True Or 变量1 Or 变量2 只要有一个量为True ，返回值就为True Xor 变量1 Xor 变量2 两个量一个为True,一个为False才返回True Not 变量1 Not 变量2 简单地把True 变为False ，把False 变为True $ String 字符串 % Integer 整型-32,768 到 32,767 之间 & Long 长整型，计算精度高速度快， -2,147,483,648 到 2,647之间 @ Currency 定点精确计算（货币型），小数点左边15位，右边4位，计算精度高。 〖一般不使用 !Single型 #Double型，因为这两种变量精度不够，且相互赋值或运算时会出错，另外long=integer*integer如：x=300*200也会溢出，详见底部案例说明〗 Variant '变体型，VB默认的通用类型，如果是数值且不含小数它会自动按整数处理；如果数值所含小数不多于4位它会按货币型处理；如果小数位大于4就按浮点数处理（也就是说小数大于4位且超过实际有效位数时用变体型和浮点型一样会产生误差） Decimal '整数连小数部分共28位有效数值，是VB能接受的最大数值范围，不能直接定义，只能用dim iDec as Variant: iDec= CDec(0)来把变体实例化为Decimal型，之后iDec就是Decimal型了，用Cdec()定义时最好用比较小的整数如CDec(1)这样。 byte 字节型0-255，主要用于存储二进制内容。可以byte()="string"直接把文本存入字节数组，其他类型数组则不可以。 【未使用变量（含数组），数值类的默认值为0，非数值的（包括变体型）默认初始值为""，Boolean默认False】。 【a = "0001" if CStr(Trim(Val(a))) = a then 'a是数值，可以避免编码如：0001当成数值。IsNumeric()可以判断0.00】 【VarType()用于判断数据类型如8024表示8192+12即变体型数组(类型值小于7一般是数值)。 变体不能赋值为整个数组、自定义型、对象型】 ⊕dim a(9)或dim a$(9)或dim a(9) as Variant定义一维静态数组，其下标为0上标为9。上下标范围内的数组才可访问如：A(0)="xxx"。　 ⊕dim　a(9,9)定义10行10列的二维静态数组，用格式a(0,0)访问数组成员。 ⊕dim VarName() as Variant '空括号表示数组是上下标及维数可变的动态数组，Lbound取数组下标，ubound取数组上标，dim v() as byte 成员可变字节数组为特殊数组可以直接存放字节集或文本。 ⊕redim VarName(3 to 9) 清空动态数组成员，重定义上下标。【非动态数组不可redim，redim不能改变数组类型】【Preserve改变上标而不清空原数组内容，但用这个关键字时下标不可改变，多维数组的非最后一维也不可变】。 ⊕如果A(1)=Barr，则Barr成为A(1)子数组，访问A(1)成员用格式A(1)(X) X是Barr数组的上下标范围。 ⊕数组可以作为过程的返回值，格式为 Function returnArr(...) As Variant()。和定义数组时写法不一样,括号应在类型后且不能用简写。 ⊕【判断VB数组为空不能用Ubound()或Lbound()会报错(err.Number=9，err.Description=下标越界)，只能用if join(Arr,",")="" 来判断】 ⊕只有同类型数组(不论上下标是否一样)才能用Aarr=Barr整组赋值，Aarr必须为动态数组，赋值后两个数组完全一样，即原数组上下标范围和内容都会被新数组代替。 ⊕VB自带的collection对象有时比数组方便。首项为1，count属性为成员数量，add用于插入（设before或after参数，两个只能选一个。 key参数是用于替代index的别名只能是字符串。）,remove index删除指定成员(指定成员被删除后index会自动重新从1连续排到count)，成员只能x=c(i)读出而不能c(i)=x被赋值。 ⊕Set obj=objx (将对象赋于对象变量，被New实例化的对象不能装入其他对象，即dim objectX as new object不能被set objectX=object) ⊕load object/unload object 加载对象，或释放对象。 ⊕if object.state=1 then object.close 适用于所有有close方法的对象，判断对象是否已经打开，如果打开就关闭。 ⊕set obj = Nothing 完全清除对象 ⊕【end　语句后不带任何参数，直接释放当前程序（含所有窗口），这个是真正的退出应用程序，程序不止一个窗体时很有用】 ⊕Form.show 1 '带模式打开窗口（不可使用其他窗口），0为无模式窗口（其他窗口可正常用），Mdi窗体中不可以用带模式窗体(但mdi比较便于集中关闭窗口退出应用等操作)，窗口关闭后show或visiable或使用窗体中的对象都会加载窗口触发Load事件。 ⊕Command函数可以取本程序运行时的参数，比如命令行运行本程序 ok.exe　/s，command返回"/s" ⊕【Format 函数可以用于定义或转换各种格式(如："00000"可以将数值变为前置0的定长字符串，也可以用">"将英文全部转大写，详见VB MSDN)】 ⊕len()字符个数,lenB字符字节数，instr查找字符左边首个为1(InstrRev从末尾向前查找)，Replace替换count参数为-1时替换所有符合项，left取字符左边指定个数,Right取右边，Mid取中间指定个数字符。 ⊕str转为字符型(会保留首位符号位，如正数则为空格，去前后空格用trim函数),Val转为数值(截取出数字直到碰到第一个非数字)； 类型转换只能对具体单个变量，不能对整个数组(比如A为数组：str(a(1))可以,str(a)不可以），str("b")将出错。 ⊕Ccur转为小数型,Clng转为长整型，Cdec变体转为精确小数型，Cvar...开头的转换函数仅限于转换符合最终格式的值【Cstr("b")不像str("b")会出错，但CSng("-1a")和Cdec("")将出错。 ∴转换类型用此类函数，但取数值用val()】 ⊕Split分割字符返回数组（接收数组必须为字符型动态数组），Join把数组组合成字符串（判定数组为空时可以用 str=join(Array,") 如果str=""则为空数组） ⊕Asc()函数可取字符的ASCII码，Chr函数则可将ASCII码还原成字符如：Chr(13) & Chr(10) 表示回车符加换行符。 StrConv()转码UniCode、Ansi及单双字节等转换。 ⊕String()函数，string(10,"a")返回10个a。　string即是声明变量类型的关键字，也是函数。 ⊕系统自带常量：Null无任何类型数据(不能用if xx=null判断，只能isnull(xx)判断)　vbNullstring即""(用if xx=vbNullstring判断) Empty可以表示0或""(用if xx=empty判断) vbCrLf回车换行； Nothing空对象(判断用is Nothing)。 使用Alt+→可以调出可用常量与系统对象，比如输入ad然后按组合键就会把ad开头(多数是ado常量)的常量列出来。 ⊕【Static静态(再次执行Static语句也能保留变量值而不像Dim初始化变量)】、Private私有、Public公开、ByVal传值、ByRef传址(即直接引用该地址的对象) 、sub无返回值的过程、 Function可返回值的过程、 As([new] 过程作用的对象或返回值)、 Dim声明变量或对象、 Declare声明API、 Event定义事件(RaisEvent触发)、 Property <set/let/get>属性定义、赋值等过程、Type语句自定义变量结构、New关键字将外部对象实例化(外部对象必须实例化后使用，部件在被拖到窗口时即已经实例化，VB内部对象本身已经实例化所以不能NEW)，【withevents声明对象带事件】，【自定义函数：Optional关键字使参数可省略并设默认值、ParamArray声明数组参数能接收的参数个数不限(只能用在最后一个参数上)、Enum在模块中定义枚举（用作参数的备选项）】、Const定义常数(常数默认为其所赋值的类型而不是Variant，使用常数以后修改程序只要改常数值就可以修改所有用到该值的语句) ⊕【If..then..elseif..elseif..else..endif】●、 Do..while/until..loop、 For..to..next、For Each..in..next(遍历集合中的元素)、 Select case 表达式/对象 case..case else..end select(不支持Like比较，不支持case is >0.5 <1这样的区间范围，【Case对大小写敏感，为了使用Like和区间范围select case true后支持case a like [0-9]这样的表述】)、 Exit sub/do/for/Function(跳出)、GoSub(跳转到其他过程)、open(打开文件)。。。On Error goto/Resume Next/Exit ... (VB容错机制,Err.Number返回错误代码。)、 IIf(expression,) 根据表达式逻辑值，返回两个参数中的一个、Choose(expression,...) 根据表达式整数值，返回多个参数中的对应位置的那个。 ⊕模块中的函数可以直接调用且允许public declare等公开声明而类模块不允许，但类模块允许withevents的对象（调用类模块dim c as new class1:c.func()），CreateObject("工程名(不是文件名).类模块名")可以创建独立线程的类模拟多线程效果（只有在Active EXE的工程属性中选右下角的“每个对象对应一个线程”，并编译后运行才有多线程效果） ⊕“工具--菜单编辑器”－－可以调出菜单编辑器制作菜单，然后可以用PopUpMenu函数在窗体中任意位置弹出菜单。 ⊕在过程中常用对象可以用 with 常用对象名...end with　这样的结构，结构中该常用对象直接用 . 表示。如：with form1 后 .text1.text=""等效于form1.text1.text=""，这样便于批量修改代码。 ⊕VB实现拖放功能，设窗体或PictureBox等要接收拖放对象的 OLEDropMode=1 ，在OLEDragDrop事件中的Data.files(index)集合即被拖放入的文件名集合。 ⊕“编辑”工具栏中的“设置注释块”“解除注释块”，可以快速在选中语句首自动添加/去除注释标记。　书签可以快速跳转到书签行（关闭即清空书签)。 ⊕VB6动态创建控件，1、先把控件的Index设为0（只能在设计窗口的属性中设，在运行时为只读，设为0后事件中也会出现Index参数用于接收是哪个成员返回的事件，ubound同样可以取对象数组的上标）2、运行时load object(Index)即可创建，Index不可为已经存在的，使用时object(index).方法/属性。 ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ⊕Form和TextBox的BorderStyle属性在运行时是只读属性，只能使用Windows API 去修改一个Window的样式了，PictureBox等无hwnd的BorderStyle是可以在代码中设置的。 ⊕有些属性在属性页是不可见的如：hwnd(对象句柄handle的一种)、Parent...这些只能些只能在对象浏览器中看，或见msdn语言参考手册等。 ⊕X:\Microsoft Visual Studio\Common\Tools\Winapi　安装VB等VS Studio中的开发工具后，该目录中即有windows的常用API。 ⊕“格式”菜单－－顺序－－移到顶层Ctrl+J、移到底层Ctrl+K，也可在“窗体编辑器”快捷工具条上点选（位置在控件对齐方式旁边）。 /*** 决定哪个控件显示在最顶端，也可在程序中使用Zorder方法设置，但注意后方置控件不可完全被放置在一个容器控件中（变成类似于子控件，这样就不可能把父控件置于子控件前）***/ ⊕“外接程序”－－外接程序管理器(加载/卸载外接功能，使其在菜单中出现/不出现)，含VB6 ActiveX控件接口向导、VB6 资源编辑器(加载后在工具菜单下)、打包和展开向导等外置工具。 条件编译或选择编译，可以用于一个软件有不同版本，这时只要一个版本常量设定，就可以编译出不同版本软件 #Const OSVer= "WIN95" '(or WIN98 or WINXP) #If OSVer = "WIN95" Then 'WIN95 Code here '只有常量=win95，才编译 #ElseIf OSVer = "WIN98" Then 'WIN98 Code here #ElseIF OSVer = "WINXP" Then 'WINXP Code here #Else 'Non-specific OS here #End If VB常用内部可引用对象 App.Path 返回程序所在路径(返回的路径最后是不带"\"的，后面要加文件名时必须自行加上) 用法例：app.path & "\..\data" (返回程序上级目录下的data) App.EXEName 可执行文件名 App.LegalCopyright 版权信息 App.hInstance 返回应用程序实例的句柄 App.PrevInstance 【提示是否已经有个本程序在运行，如果已经存在返回true。可用于禁止程序重复运行。】 ...... 用Environ函数获取环境变量值　 Environ ("Windir") ' Windows目录 Environ ("ProgramFiles") 'ProgramFiles目录 Environ ("UserProfile") 'Administrator目录 Environ ("ALLUSERSPROFILE") '所有用户目录 Environ ("APPDATA") '系统默认应用程序存储数据的位置 【Environ ("COMPUTERNAME") '返回计算机的名称】 Environ ("COMSPEC") '命令行解释器可执行程序的准确路径 Environ ("HOMEDRIVE") '连接到用户主目录的本地工作站驱动器号。基于主目录值的设置。用户主目录是在“本地用户和组”中指定的。 Environ ("HOMEPATH") '返回用户主目录的完整路径。基于主目录值的设置。用户主目录是在“本地用户和组”中指定的。 Environ ("NUMBER_OF_PROCESSORS") '指定安装在计算机上的处理器的数目。 Environ ("OS") '返回操作系统的名称。Windows 2000或win7 都显示为 Windows_NT Environ ("PATH") '指定可执行文件的搜索路径。 Environ ("PATHEXT") '返回操作系统认为可执行的文件扩展名的列表 Environ ("PROCESSOR_ARCHITECTURE") '返回处理器的芯片体系结构。值: x86，IA64 Environ ("PROCESSOR_LEVEL") '计算机上处理器的型号 Environ ("PROCESSOR_LEVEL") '处理器的版本号 Environ ("SYSTEMDRIVE") '返回包含 Windows XP 根目录（即系统根目录）的驱动器。 Environ ("SYSTEMROOT") '返回 Windows XP 根目录的位置 Environ ("TEMP") '返回对当前登录用户可用的应用程序所使用的默认临时目录。有些应用程序需要 TEMP，而其它应用程序则需要 TMP Environ ("USERDOMAIN") '返回包含用户帐户的域的名称。 Environ ("USERNAME") '返回当前登录的用户的名称。 ME. 窗体本身 ...... Screen.MousePointer 屏幕鼠标形状 Screen.Forms.Count 已打开窗口数量 ...... Printer. 打印机对象 (可通过printers打印机集合对象来设置当前打印机。) 打印机对象与pictureBox对象比较类似，也可以使用DrawText、Bitblt等用于设备场景的API。 ■常用模块 部件 Microsoft Windows Common Controls-...　 '工具条、多页夹、状态栏、进度条、树型框等 Microsoft Common Dialog Controls 'commondialog通用对话框，用于打开/保存文件，调用字体调色板等对话框（filename返回的是全路径）。 filter(提示|过滤，如：数据库*.*db|*.*db|全部|*.*) InitDir(默认路径)　ShowOpen(打开文件) FileName（被选中的文件名含全路径），也可以用默认的driveListBox、dirListBox、fileListBox操作（这三个列表框可以按列普通表框操作，但建议用特有属性drive、path、filename注意filename返回的是不带路径的path返回的是不带最后"\"的） Microsoft Tabbed dialog controls 6 'sstab控件，替代多页夹 Microsoft Rich TextBox control 6.0 Microsoft Hierarchical FlexGrid Control 6.0... '能绑定ADODB和ADODC与数据环境的表格 　Microsoft Comm Control　 '串口通讯控件 　Microsoft Winsock Control 6.0 '网络编程接口 引用 　Microsoft ActiveX Data objects 2.8 Library 'ADODB 　Microsoft ADO Exr. 2.8 for DDl and ..... 'ADO扩展 　设计器 Data Environment 'ADO集成数据环境设计器(可直接拖放等，详见例程大全中datareport及ADO相关) Data Report 'VB自带报表(功能较一般，注脚没办法放余额等，明细部分不能放统计框。) '常用的ActiveX 引用/部件多数是以“Microsoft ”开头的，如Microsoft DataList Controls 6.0...即datalist控件 '自定义的通用的模块放一个文件里，如VB的comm.bas '某类软件的开发可以做一个空的框架，把模块和要用的对象先配置好。 ■、开发经验 一、编程时要注意变量值可能被过程更改而不是出于设计的本意,这时要注意两点，以VB为例：1、过程声明使用Static使过程中局部变量值被保留而不会在每次调用该过程时被刷新为初始值。 (易语言局部变量勾选静态) 2、过程参数为数值或字符的应设为ByVal(传值)限定,VB默认的ByRef(传址)适用于参数为某类对象。即：传址时如果过程中更新参数值则会直接对该变量地址操作,导致调用该过程语句所提供的变量参数值被更改。3、大量循环不要频繁取对象值for i=1 to text1.text应该x=text1.text后再for i=1 to x。 　　二、VB调用过程需要用到返回值时，才必须带()，否则不可带括号。 　　三、dim a,b as string是将a定义为变体型，B定义为字符型。快速定义可用dim a$（$表定义为字符，% integer,& long,@ Curreny)。 而VB中用#1999-01-01#表时间值,&Hxxx&表示16进制值,&Oxxx&表示8进制值。 　　四、null（如读出数据库字段值为空时）赋给字符串等变量会出错，解决方法有二个，一个是用isnull()函数判断值是否为空，另一种是直接用string="" & rs(n).value，这样如果原值是null就会得到""。 　　五、常用技巧 1、解决VB自带四舍五入函数不能用问题， round()不像Excel中的可以用"负号",且round(6.5)=6,round(7.5)=8的偶数原则。************************** Public Function roundX(Num#,Optional Rx% = 0) '自定义四舍五入函数 Num = Num / (1 / 10 ^ Rx) Num = Format(Num,"0") Num = Num * (1 / 10 ^ Rx) roundX = Num End Function '附注：fix(-9.9)＝-9对负数取整时会直接去掉小数，VB和excel中的取整Int(-9.1)＝-10。 --------------------------------------------------------------------------------- 2、菜单标题或按钮标题末尾加 &x 可定义相应快捷访问键。这样就可用ALT_X键访问了。　　Label标签对象backstyle属性设为0，则背景透明，但其所框起的范围仍然响应click、dbclick等事件，可以作为自构形按钮等使用。 VB定义快捷键几种方式1、设Form.KeyPreview = True '表单优先响应按键，然后keydown/keyup的keycode=17即ctrl按下/抬起状态，keypress中的KeyAsci=13即回车，也可以直接用keydown中的keycode=13 and shift=2也相当于ctrl+回车。　2、菜单中设置菜单快捷键。 3、定义操作系统全局快捷键需要用API。　 --------------------------------------------------------------------------------- 3、For...nex循环的step不为整数的时候一定要注意i应为single。For i=1 to 1执行一次，For i=1 to 0不执行，For i=1 to 0 step -1执行两次，for i=1 to 1 step -1执行一次。 vba 没有控件组，可以用 枚举 Dim c As Control For Each c In Me.Controls If TypeName(c) = "TextBox" Then 'typename取除自定义类型外的所有变量或对象类型，返回字符串如：string、integer、picture c.Text = "..." End If Next --------------------------------------------------------------------------------- 4、在窗体上回车自动将控件焦点移到下个控件上，先将窗体的Keypreview属性设为true,再 　　　Private Sub Form_KeyPress(KeyAscii As Integer) 　　　If KeyAscii = 13 Then KeyAscii = 0: SendKeys "{TAB}" 　　　End Sub 5、最简化的状态切换，（仅限两种状态间切换） Static b As Boolean b = Not (b) '求反 If b Then ... --------------------------------------------------------------------------------- 6、VB日期相关操作： 取当前月份天数 day(DateAdd("D",-1,DateAdd("M",1,Format(sDateVal,"YYYY-MM-" & "01")))) 说明 now 函数返回当前系统日期+时间 time返回时间 date返回日期 datevalue或cdate可以把字符转为日期型 dateadd（）　返回指定日期加上一定时间后的日期 datediff() 返回两个日期间的时间差，可以返回日差或月差等 DateSerial 返回该年所剩的天数 "yyyy-mm-dd hh:nn:ss" 日期时间的表示完整格式，用于Format函数中，单个字母则用在时间操作中。 Public Function c2d$(Dstr$) '将字符串转为日期，字符串必须符合中国日期顺序如：2015815，年份必须为四位 Select Case Len(Dstr) Case 5 c2d = Format(Dstr,"####-#") Case 6 c2d = Format(Dstr,"####-##") Case 7 If Val(Mid(Dstr,5,2)) < 13 Then c2d = Format(Dstr,"####-##-#") Else c2d = Format(Dstr,"####-#-##") End If Case 8 c2d = Format(Dstr,"####-##-##") End Select End Function --------------------------------------------------------------------------------- 7、'shell函数可以执行外部可执行文件(如exe,bat等) Dim port As Long port = 445 shell "cmd /c netstat -na|find /c " & Chr(34) & ":" & CStr(port) & Chr(34) & " >d:\ret.txt",vbHide '查端口是否被占用，无占用返回0到ret.txt '原DOS命令是：cmd /c netstat -na|find /c ":445" >d:\ret.txt chr(34)是“双引号” vbhide是不显示执行的dos窗 任何有>或>>dos符的都要在cmd环境中 'if shell ("explorer 目录路径",1)=0 then msgBox "成功用浏览窗打开指定文件夹" 'shell函数使用Dos内部命令，如copy，必须 shell "cmd /c copy a b"。因为cmd加载dos环境后才能用DOS内部命令，如果使用Xcopy这样的外部命令则不用cmd /c。 '用默认程序打开文件则要用API Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long,ByVal lpOperation As String,ByVal lpFile As String,ByVal lpParameters As String,ByVal lpDirectory As String,ByVal nShowCmd As Long) As Long ShellExecute Me.hwnd,"open","要打开的文件","可执行程序(否则为Null)",vbNull,3 '用默认程序打开文件 ShellExecute vbNull,"http://www.ok510.com",SW_SHOWNORMAL '用默认浏览器打开网址SW_SHOWNORMAL=1，网址必须为http://开头(Shell "explorer.exe http://www.ok510.com" 可以用IE打开网址，但如果有杀软等控制，则会被改为默认浏览器打开 ) --------------------------------------------------------------------------------- 8、把注册表当作软件“系统设置”的数据库，可以用 SaveSetting 和　GetSetting() 函数 --------------------------------------------------------------------------------- 9、 取得指定范围内“不重复”的随机数序列(随机遍历) '返回指定范围内不重复的随机数集合,stepV为步长 ****************** 功能函数一：取不重复随机数序列 ************ Public Function rndC(Optional startV = 0,Optional endV = 9,Optional stepV = 1) As Collection Dim iCol As New Collection '定义一个可以加减元素的集合对象 Dim i,index& '这里i为变体型，用于step为非整数的循环，速度会比整数略慢！ Dim Nums Randomize '初始化随机数种子，无参数默认以当前时间为参数 For i = startV To endV Step stepV '将要指定的范围加入集合对象中 iCol.Add i Next For i = 1 To iCol.Count '随机产生一个整数index，输出指定index并删除该index项 If iCol.Count = 1 Then '只有一项时就不要随机了 Nums = iCol.Item(1) rndC.Add Nums iCol.Remove 1 Else index = CInt(Rnd * (iCol.Count - 1)) + 1 'round(Rnd * (最大上限值- 最低下限值),小数位数) + 最低下限值 ，产生min-max(含最大最小本身）的随机数 Nums = iCol.Item(index) rndC.Add Nums iCol.Remove index End If Next Set iCol = Nothing End Function '把总额按指定的小数位数和范围随机拆分，个数不定，返回上下标1-N数组。 如果Join(返回数组,")=""则拆分失败 ********** 功能函数二 ************ Public Function RndCF(TotalV,DecimalN%,basicMin,basicMax,Optional Least = "min",Optional Most = "max") As Variant() If Least = "min" Then Least = basicMin If Most = "max" Then Most = basicMax If Most < Least Or basicMin > TotalV Or basicMax > TotalV Or basicMax < basicMin Or Most < basicMax Or Least > basicMin Then Exit Function If DecimalN > 4 Then '小数多于四位，将变体设为精确小数型 basicMin = CDec(basicMin) basicMax = CDec(basicMax) Least = CDec(Least) Most = CDec(Most) TotalV = CDec(TotalV) End If Randomize Dim jxcf As Boolean,TryTime%,IiI& '继续拆分，偿试次数 jxcf = True Dim CIndex&,Jrnd As New Collection,temV,temSum,viodC As New Collection '随机数，临时变量，临时合计和临时集合 For IiI = 1 To 10 If jxcf = False Then Exit For temV = CDec(0) temSum = CDec(0) 'Set temC = viodC '将空集合赋给temC以清空它的方法是无效的，所以只能先set c=noting再dim 才能清 Dim temC As New Collection Debug.Print "清空后temc.count" & temC.Count & " viodc.count" & viodC.Count TryTime = TryTime + 1 Do While jxcf temV = RoundX(Rnd * (basicMax - basicMin) + basicMin,DecimalN) '__________********必须配合自定义roundX函数使用********__________ If temSum + temV <= TotalV Then '如果本次与之前累加后不超过总额 temC.Add temV temSum = temSum + temV If temSum = TotalV Then jxcf = False Else '累加超过总额 temV = TotalV - temSum '超过总额了，就把余值作为最后一次值 If temV >= Least And temV <= Most Then '剩余值如果不低于最小约定且不大于最大约定 ，　将剩余值作为最后一次值 temC.Add temV jxcf = False '退出拆分 Else '剩余值不足最低约定 ，将剩余值随机并入前值(并入后不超过最大限制) Set Jrnd = RndC(1,temC.Count) '__________********必须配合自定义Rndc取不重复随机序列函数使用********________ For CIndex = 1 To Jrnd.Count If temC(Jrnd(CIndex)) + temV <= Most Then temC.Add temC(Jrnd(CIndex)) + temV temC.Remove Jrnd(CIndex) jxcf = False Exit For End If Next CIndex End If '处理最后剩余值结束 If jxcf = True Then Set temC = Nothing Exit Do End If Loop Next IiI '如果已经取得正确值就不循环 Debug.Print "偿试次数：" & TryTime If jxcf = False Then '分拆完成，偿试10次内得到正确值，将集合写入数组并返回 Dim Temp() ReDim Temp(1 To temC.Count) For IiI = 1 To temC.Count Temp(IiI) = CDec(temC.Item(IiI)) Next IiI RndCF = Temp End If End Function --------------------------------------------------------------------------------- 10、大量的运算或需要刷新调用DoEvents()方法，可以响应外部事件，以便继续运行后面程序。 '示例：等待几秒后继续运行后面程序，等待过程可以用timer控件或dateadd函数，要精确的可用API计步空循环，循环中必须DoEvents，否则程序假死。 Public Sub Delay(DelayTime As Single) '参数等待时间单位为秒，可以有小数点。 Dim BeginTime,EndTime,acrossDays&,acrossed As Boolean BeginTime = Timer EndTime = BeginTime + DelayTime 'Timer是VB本身的函数，取0点到当前经过的秒数，精度到1%秒。 While Timer + (86400 * acrossDays) < EndTime If Timer - BeginTime < -0.01 And acrossed = False Then '跨0点timer从0开始，所以跨越天数+1 acrossDays = acrossDays + 1 acrossed = True Else If Timer - BeginTime >= 0 Then acrossed = False End If DoEvents Wend End Sub --------------------------------------------------------------------------------- 11、窗体的Active、DeActive、GotFocus、LostFocus事件只在APP自身窗口间切换时有效，外部窗口和程序中的窗口切换无效。 --------------------------------------------------------------------------------- 12、数组排序，SortArr 要排序的数组,Ascending是否按升序排列，调用本过程后作参数的数组就已经排序好了。 Sub SortArr(ByRef Arr(),Optional Ascending As Boolean = True) Dim i,j Dim bound,L,t L = LBound(Arr) bound = UBound(Arr) If Ascending Then For i = L To bound - 1 '升序排列 For j = i + 1 To bound If Arr(i) > Arr(j) Then t = Arr(i) Arr(i) = Arr(j) Arr(j) = t End If Next Next Else For i = L To bound - 1 '降序排列 For j = i + 1 To bound If Arr(i) < Arr(j) Then t = Arr(i) Arr(i) = Arr(j) Arr(j) = t End If Next Next End If End Sub '数组去重复，　注意，数组类型必须匹配！ Sub delrepeatArr(ByRef Arr()) Dim i,j Dim Ub,Lb,t(),c c = 0 Lb = LBound(Arr) Ub = UBound(Arr) ReDim t(Lb To Ub) For i = Lb To Ub If i = Lb Then If Not Arr(i) = "" Then t(i) = Arr(i) End If Else For j = Lb To Lb + c If Arr(i) = t(j) Or Arr(i) = "" Then Exit For If j = Lb + c Then c = c + 1 t(Lb + c) = Arr(i) End If Next End If Next ReDim Arr(Lb To Lb + c) ReDim Preserve t(Lb To Lb + c) Arr = t End Sub '在数组中查找指定值，找到则返回ID，没找到返回-1 Public Function LookArr(ByRef Arr(),LookV,Optional StartPos = 0) Dim Lb&,Ub&,i& If StartPos = 0 Then Lb = LBound(Arr) Else Lb = StartPos End If Ub = UBound(Arr) For i = Lb To Ub If Arr(i) = LookV Then LookArr = i Exit Function End If Next i LookArr = -1 End Function Public Sub WByteArr(ByRef TheArr() As Byte,WantWrite$,Optional IsHex As Boolean = True) '将字节连续赋值给字节数组，　VB6中不允许byteArry={01,02,03,05}这样的连续成串赋值，所以必须自定义函数 Dim i&,wwV$() WantWrite = Replace(WantWrite,"，",") wwV = Split(WantWrite,") ReDim TheArr(LBound(wwV) To UBound(wwV)) For i = LBound(wwV) To UBound(wwV) '逐个赋值，不管原来什么类型，只要符合转换条件，就一定变成byte。 If IsHex Then '如果是16进制 TheArr(i) = Val("&H" & wwV(i)) Else '否则视为10进制 TheArr(i) = wwV(i) End If Next End Sub ------------------------------------------------------------------------------------------------------------ 13、窗体事件 Form_Initialize '初始化 引用未加载窗体属性或事件，也可以触发Initialize事件 Form_Load '加载 不可在load中使用setfocus方法(如果要用setfocus可以在Initialize中用，也可以在me.show语句后用) Form_Resize '大小改变 Form_Activate '活动 Form_GotFocus '得到焦点 Form_Paint '绘 Form_LostFocus '失去焦点 Form_Deactivate '失去活动 Form_QueryUnload '询问卸载 Form_Unload '卸载 Form_Terminate '停止 ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★ 六、ADO操作数据库 (工程-引用-Mircosoft ActiveX Data Objects 2.8 Library，adodb的connection.Cursorlocation默认为服务器游标，sqlite一定要客户端游标●)； 工程-部件-M.. ado data control或工程-添加date environment（adodc和de都默认客户端游标) 1、ADO记录集首行位置为1，首列为0。【未赋值的行列值为Null不论列类型，必须用if isnull(rs(n))或 if ""+rs(n)=""判断。】rs.field(...).type<7的都是数值型(比如sqlite中5为real，2为短整，而字符和无定义都为202)● 2、打开或关闭等数据库操作前先判断cn（connection对象）.state和rs（RecordSet对象）.state是不打开，值为1则表示已经打开，0表示已经关闭。 3、sql语句中所有值为字符的都应该加上''（如：x='c'　或 values('a')），而所有表示数据库表名字段名的都不能加单引号。 4、cn.Execute执行sql语句不如用rs.open执行来的好，因为rs.open执行的语句如果没有返回记录集，则执行完后会自动关闭rs，这样再用其他rs打开时数据库已经更新，而cn.excute则不会自动关闭cn从而影响其他rs的查询结果。 5、数据库字段能用数字的尽量不用字符，能用整数的尽量不用浮点，常用字段要索引，用无重复的ID字段代表行号。这样能使查询更快并实现类似游标功能。 6、窗口关闭时判断cn和rs是否关闭并关闭它们，然后用set cn=Nothing清除对象所占内存。控件失去焦点或记录集使用完毕应立即关闭rs，尽量使用局部rs对象。 7、游标（CursorType）、锁定（LockType）和选项(Options)，常用Cursortype为3，locktype为3，Options为1。　以下是三个参数可选值及用法(Connection简写为cn，Recordset简写为rs)： 0(adOpenForwardOnly)只向前，和静态游标类似。可提高性能，但不支持rs.recordcount等属性。 1(adOpenKeyset)键集游标，除添加和删除不可见，其余同动态游标，但不支持rs.recordcount等属性。 2(adOpenDynamic)动态。其他连接所作变更均可见且允许RS所有移动类型。 3(adOpenStatic)静态游标，打开时建立副本故其他连接作的变更全不可见。 adLockReadOnly 1 缺省值，只读方式启动，无法用AddNew、Update及Delete等方法 adLockPRSSimistic 2 只要保持Recordset为打开,别人就无法编辑该记录集中的记录(悲观，【对rs修改影响数据库与乐观锁定时相同】)。 adLockOptimistic 3 改写数据库时，其他用户可以进行增删改操作(乐观，【“第二次对rs更改”或update或UpdateBatch，都会将上一条对rs的更改写入数据库，如果最后一条对rs的更改没调用update写入数据库关闭rs则会出错】)。 adLockBatchOptimistic 4 改写数据库时，其他用户必须将cn.CursorLocation属性为adUdeClientBatch才能对数据进行增删改的操作(【“修改操作”只作用于rs对象，只有UpdateBatch后才写入数据库。update方法不会起任何作用】)。 1(adCmdText):sql语句 2(adCmdTable):数据表的名字 4(adCmdStoredProc):存储过程 8、应用中可以设cnn和RSS为公用对象，而cn和rs为局部对象，公用对象用于需要保持打开直到程序结束才关闭的连接。 记录集在做过程参数使用后应在过程尾set rs=nothing。 9、Recordset.open方法可以打开sql语句、表、由recordset.save保存的xml(其他软件生成的xml文件打开会出错)等，记录集可以修改内容或addnew加新行等操作再通过update或updatebatch保存变更到数据库。 10、ADO自带的BeginTrans、CommitTrans 和 RollbackTrans 方法在客户端 Connection 对象上无效。 '基本示例 dim cn As New Adodb.Connection dim rs As New Adodb.Recordset dim ConnString$,sqlText$,whereText$ '▼连接串，查询语句，where子句三个变量保存“最新”的语句以便后续过程知道当前查询记录。 cn.open "Driver=sqlite3 ODBC Driver;Database=f:\x.db;PassWord=123456;" cn.Cursorlocation=3 '使用客户端游标， 2为服务器游标 ● cn.excute "begin" cn.excute "insert into tb1 values('a','b','c',2,3) cn.excute "commit" if rs.state=1 then rs.close '无论rs为任何状态(哪怕事务未提交)，Set rst = New Recordset 即可完全恢复初始状态● rs.open "sql/db或xml完整路径",cn,3,1 rs.movefirst '如果connectiong或recordset游标不对，rs的move可能无法跳转到指定记录位置，比如sqlite数据库的connection.Cursorlocation要设为3（adUseClient)如果为2（adUseServer）则无法控制 do while not rs.eof() rs.sort "Field1 DESC,f2 ASC" '在客户端游标下对记录集排序 rs.movenext rs.move 3,1 'move方法参数第一个是移动几行，第二个是从哪开始0表示当前位置开始，1表示从第一行开始，2表示最后一行 rs.addnew '后面的字段和参数都是数组变量，一般不带参数，addnew方法后记录指针即在增加行可以直接给字段赋值如下 rs!字段名="字段值" '该写法是 rs.fields(字段号/"字段名").value="字段值"的简化写法，也可以写成rs().value或rs()。用别名的字段无法upadte保存修改● rs.delete '删除当前指针所在记录行(参数删除所有行经常失效，不建议用)，(删除后指针会停在被删除行，　cairo_sqlite会自动移到下一行) rs.Filter="表达式"　'表达式类同于sql的where子句，但注意通配符%只能在最后或头尾都有，不能为%xxx。筛选后除AbsolutePosition属性值为在总记录中的绝对位置外，其他属性和操作都只针对筛选结果，如Recordcount,move...等都只是筛选结果集中操作。 　 rs.Find　"表达式"　　'查找并将记录指针指向对应记录 rs.Update '将记录集修改保存到数据库中，不论修改后的记录值是否符合where子句条件，只要符合数据库字段要求。 '▲有的驱动(比如sqlite在cn客户端游标且rs3,1时)，执行addnew、delete等写操作时默认会自动update，一般建议先将要修改的记录删除，然后新增，在结尾要用updatebatch确认提交所有修改。 ...... loop set rs=nothing set cn=nothing Public Function Q1(ParamArray VarNames()) As String '强制加单引号，不作判断 ********************* Q1 ********************************* Dim zdsl&,i& zdsl = UBound(VarNames) 'zdsl值比实际少1，因为从0开始计 For i = 0 To zdsl Q1 = Q1 & "'" & VarNames(i) & "'," Next i Q1 = Left(Q1,Len(Q1) - 1) '去最后逗号 End Function '示例：【sqlFV(字段1,Q1(字段2),Q1(在sqlFV中只能单个字段),P1(加井号单个字段)...,字段n)　或 Q1(指定为字符的字段1,字段2...) & "," & P1(指定为access日期的字段1...) & "," & sqlFV(字段)】 '智能给多个字段值加单引号 ********************* sqlFV ********************************* Public Function sqlFV(ParamArray VarNames()) As String '将变量转化为sql语句的字段值，如果为数字，就不加单引号 Dim zdsl&,i&,IsDateV As Boolean,IsNumV As Boolean '字段数量 zdsl = UBound(VarNames) 'zdsl值比实际少1，因为从0开始计 For i = 0 To zdsl If IsNull(VarNames(i)) Then VarNames(i) = "" '去掉null If VarType(VarNames(i)) = vbDate Or (Left(VarNames(i),1) = "#" And Right(VarNames(i),1) = "#") Then '判断是否日期 IsDateV = True Else IsDateV = False End If If IsNumeric(VarNames(i)) Then '"0""888888"等也会当成数值，如需指定成字符则要预先加上''，【access字符字段会把数值转成字符再写入，查询或判断则类型错误，sqlite读写都直接按数值处理不会报错】 IsNumV = True Else IsNumV = False End If If IsDateV Or IsNumV Then '是数值或日期，则不加引号 sqlFV = sqlFV & IIf(VarNames(i) = Empty,VarNames(i)) & "," Else '不是数字 sqlFV = sqlFV & IIf(Left(VarNames(i),1) <> "'","'","") & VarNames(i) & IIf(Right(VarNames(i),"") & "," '判断前后是否已经有单引号，有则不再加 End If Next sqlFV = Left(sqlFV,Len(sqlFV) - 1) '去掉最后的逗号 End Function '自动生成表达式(仅限于 字段='字段值') ********************* sqlExp ********************************* Public Function sqlExp$(FieldNames$,ParamArray VarNames()) '字段名中用逗号（可以全角）分割　　********主要用于upadte的set语句 f1='fv1'，也可用于where子句，必须有sqlFV自定义函数。 Dim Farr$(),zds&,ffwb$,i& Replace FieldNames," Farr = Split(FieldNames,") zds = UBound(Farr) '字段数，比实际少1，因为从0开始 For i = 0 To zds '只按字段数为准，如果参数少了，会出错 ffwb = ffwb & Farr(i) & "=" & sqlFV(VarNames(i)) & "," Next sqlExp = Left(ffwb,Len(ffwb) - 1) '去掉最后一个逗号返回 End Function '数据库连接串 '在控制面板--管理工具--数据源(ODBC)，驱动程序页中可以查看可用驱动名称，Driver="驱动名称;"是ODBC驱动标准写法。 Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\我的文档\db.mdb;Jet OLEDB:Database Password=1; 'access ado连接。 Driver={Microsoft ODBC for Oracle};Server=OracleServer.world;Uid=admin;Pwd=pass; 'Oracle ODBC DSNless 连接 Driver={sql Server};Server=servername;Database=dbname;Uid=sa;Pwd=pass; 'MS sql Server DSNless 连接 Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=c:\somepath\;Extensions=asc,csv,tab,txt;Persist Security Info=False; 'Text Driver DSNless 连接 Driver={MysqL}; database=yourdatabase;uid=username;pwd=password;option=16386; 'MysqL DSNless 连接 Driver=Firebird/InterBase(r) driver;Uid=SYSDBA;Pwd=masterkey;DbName=C:\Documents and Settings\Administrator\桌面\data\demo.fdb; 'firebird标准连接串 .NET - Firebird .Net Data Provider 连接串 User=SYSDBA;Password=masterkey;Database=SampleDatabase.fdb;DataSource=localhost;Port=3050;Dialect=3; Charset=NONE;Role=;Connection lifetime=15;Pooling=true;MinPoolSize=0;MaxPoolSize=50;Packet Size=8192;ServerType=0; 'sqlite3连接文本 Driver=sqlite3 ODBC Driver;Database=C:\x.db;PassWord=123456; '【基本sql语句，[]中表示可选项，|表示或者，例如使用distinct则表示筛选出不重复的记录】 1、select [all/distinct] [结果集名.] * | {[函数][结果集名.]列名 [as 列名]} [,[函数][结果集名.]列名 [as 列名] [,...] ] from [其他数据库路径.]表名|select... [as 别名] [,|Inner Join|... 表名或查询语句 [as 别名]] where <条件> 条件例：字段 like '01%' (支持like、In等运算符。like支持通配符，'%'匹配任意多个字符，'_'匹配一个任意字符，Access中工具--选项--表/查询中如果没有勾选ANSI-92则为ANSI-89通配符为*和?) order by 列名 [asc|desc|RANDOM()] 默认asc为升序 group by 列名 [having 筛选条件] (having子句是针对group by的分组结果进行的，比如having count(*)>3表示该组的记录数>3的才筛选出来) Limit 数量 (限制筛选出的记录数，不能超过设定) 2、delete from 表名 [where 条件] '不带条件则表示删除所有记录 3、insert into 表名[(字段名1,字段名2...)] values(表达式1,表达式2) 4、REPLACE INTO 表名[(字段名...)] values(表达式1,表达式2) 或 select-statement '替换，不存在则追加,需要有主键作为判断存在否的标志 5、Update 表名 set 字段名='值'[,字段名2=表达式2,...] [where 条件表达式] '更新字段值 6、drop table 表名 '删除表 7、ALTER TABLE 表名 RENAME TO 新表名 | ADD [COLUMN] 列名 |...　'修改表结构语句各数据库差别较大，详见其参考手册。 '查询的连接 1、INNER JOIN　两个查询结果集都只出现where子句匹配的行（from tb1,tb2时默认此种连接） 2、LEFT OUTER JOIN 结果集左边出现全部行，右边只出现符合where的行。 3、RIGHT OUTER JOIN 与left连接相反。 4、FULL OUTER JOIN 两个结果集所有行都出现，不论它们与where子句是否匹配 5、CROSS JOIN 交叉连接，将分别来自两个结果集中的行以所有可能的方式进行组合 'ADO常见错误 (读有的表能读出来，有的读不出，能创建表但不能addnew或insert into等奇怪的问题多是connection游标设置不对●) 1、数据提供程序或其他服务返回 E_FAIL 状态：一般是数据库中被查询的字段溢出或不符合字段要求，合格的字段可以正常查询，一一排除。 2、连接无法用于执行此操作,在此上下文中它可能已被关闭或无效：可能是connection已经被关闭，或rs没有指明cn。 3、VB中BOF或EOF中有一个是真,或者当前的记录已被删除,所需的操作要求一个当前的记录：在bof或eof时进行记录集操作，应该if not rs.eof then ... 或 do not rs.eof ... loop 4、在此环境中不允许操作： 比如rs.state=1但无法rs.close，一般是因为将rs在执行中，或者对rs修改后没有update。　还有如delete使用了adaffectall或adaffectallchapters这样的无效参数。 5、对象关闭时 不允许操作.对象打开时 不允许操作.： 这两个错误是同一类型，操作前用if rs.state=1 then rs.close清一下再open 6、键列信息不足或不正确 更新影响到多行。　这个多出现在rs.delete方法时，delete其实和delete from语句是类似的，并不是删除当前指针所在行，而是根据当前行的特征做为条件来删除有这特征的行，行特征有两行以上一样，就会报这个错 7、多步操作产生错误 请检查每一步的状态值：给列赋值不符合列类型或要求。 8、行句柄引用了一个已被删除的行或被标识为删除的行　　由于错误7被忽略，就可能将其他行标为已删除，这时move到该被删除行就出错【鉴于问题7、8以及便于其他操作，数据库应有一个主键序号列(或创建一个唯一索引)，针对特定行操作的记录集中要包含序号列】 9、无法为更新定位行。一些值可能已在最后一次读取后已更改-2147217864 这个主要是由于要提交的修改与原记录一致造成的，解决办法只能判断修改前后是否一样。如果是MysqL ODBC可以在连接配置Cursors/Results页中勾选Return Matched Rows... ，如果是sqlite只要避免行中有null值就可以很大程度避免这个错误【Integer PRIMARY KEY可以较好的解决这个问题，如sqlite主键未指定类型的，ado本身能识别它，但绑定它的表格会默认当成字符串（一旦含有数值就无法同步修改数据库)】。 'sqlite相关(使用API操作原生DLL，或rundll32 sqlite_odbc.dll,uninstall quiet后使用odbc版本的支持库，或regsvr32 vbRichClient -s使用带vb_cairo_sqlite.dll的vbRichClient。）(ado的connection必须使用客户端游标，否则写入非常慢且必出错，win7以上系统要administrator才能安装odbc驱动●●●) '注： 原生不支持加密，有少量支持加密的odbc版本。　vbRichClient配合cairo_sqlite支持加密且操作简单高效，但没有ODBC所以无法直接使用ADO，其带的3.9版本sqlite与3.63ODBC版本不完全兼容（写记录集会错乱）。 sqlite3.8.7比3.7.17性能提升50%。 1、创建sqlite数据库 连接数据库不存在时，会自动创建新数据库。 注：VACUUM 语句可以整理表、索引或数据库，释放已删除记录等占用的空间，带密码的库不能使用本命令否则锁死或出错。　【在空数据库中才能用 PRAGMA auto_vacuum = 1;开启自动整理】。试图在已有表的情况下修改不会导致报错但设置无效。 2、跨数据库复制表，使用sql语句 ATTACH DATABASE 'database-filename' AS dbname KEY 'password'; create table t2 as select * from dbname.table; 3、筛选出字段结果中“某部分”不重复的内容，连接两个字段 select distinct substr(开单时间,10) as 日期,sum(数量) as 总数量 from db 字段A||字段B，用连接符“||”可以把两个字段连接当成一个字段使用。 4、筛选出符合查询的随机记录 order by RANDOM() limit 1 5、自增序列Integer PRIMARY KEY（给字段赋值为null即可。sqlite没有记录数量限制，但rowid受VB Long变量影响只能显示到 2147483647） 主键一般和UniQue等效（即不重复），AUTOINCREMENT声明只能跟在INT Primary Key后，如果同时定义两个列为主键则两列中至少有一列不重复即可，Null不被视为重复（只能单独声明Not Null） 每个表中都有一个隐藏的RowID字段，select *时不列出，只能select *,RowID才能列出。带rowid的rs.update时rowid不须赋值。 6、系统结构表 sqlite_master 表为隐藏表，存储了sqlite数据库的表结构字段信息等，可以select * from sqlite_master查看内容，修改表结构等。 7、修改密码（只有直持加密的版本才可以使用密码，官方标准版不带加密） 【pragma password = 888888;　修改密码后Set Cn = Nothing再Set Cn = New ADODB.Connection才生效】，密码后必须加“;”号结束语句，不带;或带两个以上;密码将锁死数据库出错。 8、实现Update select from REPLACE INTO t1(key,Column1,Column2) SELECT t2.key,t2.Column1,t2.Column2 FROM t2,t1 WHERE t2.key = t1.key; UPDATE table1 SET col1 = 1 WHERE table1.col2 = (SELECT col2 FROM table2 WHERE table2.col2 = table1.col2 AND table2.col3 = 5); 内联接式更新 9、函数只对一个字段｜表达式有效 比如：select min(a),b from tb1 '该SQL查询结果集是“最小的A字段值，最后一行B字段值” 为了保证取的是a字段最小值整行正确的sql应该是： select a,b from tb1 order by a limit 1 10、Round()函数不但可以取四舍五入值，还可以用于从文本中取数值如round('9a')返回9。 typeeof()取类型。　quote()给值加单引号。 11、3.6.19起支持外键约束FOREIGN KEY(ThisTbField) REFERENCES OutTb(Field)外键会检查两个表字段，如果外表不存在的则本表不允许添加，如果本表存在同样外表不能删除该记录。 12、可以用两种方法处理null，一种是 field is null判断是否为null，一种是 ifnull(field,'')这种自动返回两者中首个非null。 13、操作冲突详解 ①当有读写操作时，其他读写操作都会被驳回。②当开启事务时，在提交事务之前，其他写操作或事务会被驳回。③读操作之间能够并发执行。【sqlite用ado连接时，每个Connection连接的事务是独立的，即set cn=Noting后所有事务等一并被清除，两个Cn的事务互不影响。所以写操作尽量用独立的局部Cn】 14、create unique index 索引名 on 表(字段)　创建唯一索引，效果类似主键。【根据Create ... a,b,c,PRIMARY KEY(a,b)指定的主键判断(null不被视为重复，所以双字段主键只要有一个字段值为null则视同没有重复，解决方法是用DEFAULT设置字段的默认值)，存在则更新不存在则追加】 15、注意：【sqlite默认比较时区分大小写】， COLLATE NOCASE关键字可以使sqlite比较时忽略大小写(如：select * from tb where f1="aAa" COLLATE NOCASE，也可用于createTable等语句的字段限定中)。　　也可以用大小写转换函数LOWER、UPPER。 16、sqlite函数、变量类型： 【substr(字段名,起始位置,取字符个数)、round(X,保留小数位数)、total(X)非null行合计没有行返回0、max()/min()/avg()/count()/abs()】 '日期时间函数strftime(时间/日期表达式,修饰计算符，修饰计算符...) 可以替代其他所有时间日期函数如：date()/time()等，sqlite日期格式仅yyyy-mm-dd有效（少任何一位都不行，如2016-02-8就是无效的） '修饰计算符：'n days'、'n hours'、'n minutes'、'n seconds'、'n months'、'n years'、'n month'、'n year'、'n week'、'n day'、'weekday N' SELECT strftime('%Y-%m.%d %H:%M:%S','now','localtime') '结果：2016-10.17 21:41:09 (完全区分大小写) SELECT date('now','start of year','+9 months','weekday 2') '计算今年十月份第一个星期二的日期，'start of year'是当年的第一天 SELECT date(‘now’,’start of month’,’+1 month’,’-1 day’) '当月最后一天 SELECT julianday('now')-julianday('1981-12-23') '返回两个日期间差几天，jolianday是从格林威治时间公元前4714年11月24号开始算起的天数，精确到小数后8位，和VB用数值表示的时间是完全不同的，VB只保留4位小数 SELECT strftime('%s','now') '返回开机多少秒了 SELECT datetime(julianday('now')) '返回当前日期，格式根据系统格式，一般为2016-01-28。　这个例子表明sqlite天与日期时间的互转关系 【TEXT文本、INTEGER带符号的整型、REAL浮点数、smallint短整数、char(n)定长字符、nchar(n)unicode定长字符】 17、判断sqlite密码错误（连接时不会产生错误，只有查询等实际操作才返回未知错误●，其他未知错误代码也是一样的，所以有可能是其他错误） On error goto errs Errs: 'ADO.recordset打开时发生密码错误，在过程底添加本判断提示程序。 If Err.Number = -2147217887 Or Err.Number = -2147467259 Then MsgBox "数据库密码错误!" Debug.Print "连接数据库错误代码:" & Err.Number '视图 将特定的一个或多个表的记录筛选汇集在视图中，这个视图可以像表一样操作。 创建的语法例： CREATE VIEW name [( view_col [,view_col …])] AS <select> [WITH CHECK OPTION]; drop view命令删除一个视图。删除视图并不影响与该视图关联的基表 '事务 将要执行的一系列sql语句放在一个事务中，要么全部生效，要么全部取消。 sqlite中用cn.excute sql来执行事务操作，如sql语句Begin[TRANSACTION] [Name]启动/开始事务 Commit提交事务 Rollback撤消/回滚事务。 ADO中用cn.BeginTrans方法开始事务cn.CommitTrans方法提交事务，例如access就是使用ADO自带启动方法的，但有最多9500条操作的限制(注册表中可以改)。 注：像sqlite这样的库，写操作一定要用事务，因为逐个记录变动都来次硬盘I/O比成批在内存打开后写回硬盘要慢的多。 事务begin后，程序如果还没有commit/rollback就结束或转向其他过程序，又begin事务就会出错，这种错误就算关闭再打开cn也还是存在，所以启动事务或结束事务要用一个参照如if form1.tag<>"begin" then cn.excute "begin"结束也类似。 'sqlite事务不能嵌套，可以用以下过程来防止嵌套。　（注意：一个过程只能对一个CN连接，否则两个连接可能混肴出错） Enum BCRoption BeginTran = 1 CommitTran = 2 RollBackTran = 0 End Enum Public Sub DoSW(ConnectiongX As Connection,BCR As BCRoption) 'bcr 1启动　2提交　0回滚 ***************每个connection必须单独使用一个DoSw函数 Static swzt% '事务状态,0已回滚或提交,1开始 Select Case BCR Case 1 If swzt = 0 Then ConnectiongX.Execute "begin" swzt = 1 Else ConnectiongX.Execute "RollBack" '如果已经启动，则回滚事务后重新启动 ConnectiongX.Execute "begin" swzt = 1 End If Case 2 If swzt = 1 Then ConnectiongX.Execute "Commit" swzt = 0 End If Case 0 If swzt = 1 Then ConnectiongX.Execute "RollBack" swzt = 0 End If End Select End Sub '索引 对于经常对其查询排序的字段，可建立索引，以加快查询速度。创建索引语法： CREATE INDEX index-name ON table-name(column-name [,column-name]* ) '关于内建函数问题 有些函数，如：Access的dsum(字段,表,条件)用于计算指定（域）中值集的总和，这些函数只能在其软件中使用，为其软件所支持的函数，数据库驱动本身不支持这些函数。 '多层ADO记录集 ADO支持在sql语句中可以使用Shape Append生成子记录集或Shape Compute生成父记录集(构形关键字不依赖数据库，shape时支持sum,avg等函数，也支持calc("VBA表达式")函数，表达式操作的是同一行中的其他非CALC列，参阅ADO手册的Shape Recordset项)。虽然数据库本身可以用 sql JOIN 子句关联两个表。但是分级Recordset可以更有效地表示信息。由JOIN 创建的每一行Recordset都会冗余地重复一个表中的信息。对于每一个多子 Recordset对象，分级 Recordset 都只包含一个父 Recordset。例：rs.open "SHAPE {SELECT * FROM Customers} APPEND ({SELECT * FROM Orders} AS chapOrders RELATE customerID TO customerID)"　访问子记录集 set SubRs=rs("子集别名").value，然后SubRs就可以像单独的记录集一样操作。可以用Data Environment向导式生成构形语句。 '把sqlite当局网数据库 先把数据库所在文件设夹为共享（可以看上文中批命令设置共享，也可以限定共享用户数） 再在服务器上执行服务器程序，主要用于判断当前数据库状态（如：客户端在线，写入，读取...)，也用于收发数据库所在目录，要操作的数据库文件名等。 七、表格及报表 （reportx为表格控件，要连续打单或报表可以用Grid++report6它的分组可以插入明细网格后插入分组，再设置“行为”类属性下的分组依据） 【一】、reportX支持预览和打印、支持公式、支持表格模版、支持导出excel、支持单元格锁定及格式、支持图表和条码等，不支持数据源、单元格边框单独改色，至2.7版本时仍有些BUG如：OnCellChanging事件无效,只能用API getfocus()取当前输入框句柄然后取该控件的标题即是正在输入的内容，在设计时修改所有属性值无效（只能OpenReport载入rptx文件，文件可用其自带设计器预设）。 发布只要regsvr32注册ReportX.ocx即可。 1、常用属性及方法： setcellvalue()置单元格文本、getcellvalue()取单元格文本、Explain...()计算刷新单元格公式、OpenReport()载入表格模版、Colcount和Rowcount属性设置或取得表格行列数、 GetSelectCell方法的参数应使用变量而不是变量值以便该方法将选择范围返回给变量、TopRow属性为当前表格可见行首行号、Sortcol()对指定列进行排序、sortrow()对指定行排序、PageHeader...Text和PageFooter...Text属性设置页眉页脚其中@number表示当前面@Count表示总页数、 GetCellHAlignment取横向对齐方式GetCellVAlignment纵向SetCellHAlignment设置0左1中2右、ExplainCellExpression计算单元格公式(单元格公式不会自动计算，只能在程序中调用执行)、ExportExcel导出到excel、GetRowPageBreak取行换页标记。 2、BottomHeight和RightWidth设为0则reportX没有滚动条,PoleHeight和PoleWidth设为0则表格没有固定标题行列。 3、reportx单元格首列和首行号均为1 4、setpoletext()和getpoletext 参数一为标杆方向横向为0，纵向为1，参数二位置从1开始（即最左上角标杆格无法设置任何数据） 5、MergeCell()合并单元格必须用合并后的最前的行列进行读写，用SplitCell拆分单元格。用setselectcell方法时acol1和arow1要设为合并单元格的最后一格才有效。 6、VB对其setfocus()无效（易语言支持setfocus），可使用控件本身的SetSelectCell方法代替。 7、AppendRow和AppendCol方法增加指定的行数或列数，DeleteCol和DeleteRow删除（但至少留一行一列），InsertCol和InsertRow插入(插在最后一行时要用AppendRow)。 8、reportx.SetColWidth col,reportx.GetColBestWidth(col) + 9 '填充完数据后，用此语句设置最佳列宽。 9、SetCellNextPos设定回车后跳转到哪个单元格。　 SetCellNote设单元格批注。 SetCellFormat格式类型（0：无；1：小数格式；2：有效数字格式；3：日期格式；4：时间格式）。 SetCellMultiLine允许多行。 10、 SetCellControl输入控制（0无；1字母；2自然数；3整数；4字母数字；5字母数字_；6实数） SetDropCell和GetCellDroptext设置和读取单元格下拉列表(用VbCrLf分割列表项，只能从列表中选)。 SetDateCell带日期控件只能从控件中选 11、Copycell和Paste方法可以复制，粘贴区域，包含格式(但不含分页符)，可以粘贴到另一个Rpt对象中。【自定义纸张只能通过模版加载，加载的模版无法被粘贴入内容，只能增加新行再删除加载的行】 12、OnInputChange事件相当于单元格被选中事件，可以用SetSelectCell或GetSelectCell来设置或取得当前选定的单元格。　OnKeyPress仅接收Ctrl与字母的组合銉键，Ctrl+回车的Key值为10。 13、大量写表格数据时，设置InvalidatePaint()使表格刷新无效，写好数据后使用ValidatePaint()使报表刷新有效并刷新，这样可以加快写的速度。如果这样还是太慢或内存不足，则只能用分页分册的方式了。 '将记录集写入ReportX ******************************* Rs2Rpt ***************************** Public Function Rs2Rpt(ByRef rst As ADODB.Recordset,ByRef rptx As ReportX,Optional AutoPB As Boolean = True) As Long '记录集列表，并返回记录总数 On Error Resume Next Dim ZiDuanZhi '字段值 If rst.EOF Or rst.fields.Count <= 0 Then rptx.RowCount = 1 rptx.ClearCell 1,rptx.ColCount,1 Exit Function End If rst.MoveFirst rptx.InvalidatePaint Dim i&,j&,c&,r& 'c列数r行数 With rptx .ColCount = 1 .RowCount = 1 .ClearData 1,1 c = rst.fields.Count For i = 1 To c '增加列并写列名 .SetPoleText 0,i,rst(i - 1).Name If i < c Then .AppendCol 1 Next j = 0 '取行数 Do While Not rst.EOF rst.MoveNext j = j + 1 Loop r = j .RowCount = j If j > 0 Then rst.MoveFirst '逐列写入行数据 j = 1 Do While Not rst.EOF For i = 1 To c ZiDuanZhi = rst(i - 1).Value If Not IsNull(ZiDuanZhi) Then .SetCellValue i,j,ZiDuanZhi If AutoPB Then .SetCellHAlignment i,1 '置单元格居中对齐 Next j = j + 1 rst.MoveNext Loop If AutoPB Then For i = 1 To c '设置最佳列宽 .SetColWidth i,.GetColBestWidth(i) + 9 Next End If End With Rs2Rpt = j - 1 rptx.ValidatePaint End Function '将表内容传给记录集，并返回记录总数。{注：本过程默认会update修改数据库，如需update大量数据，要在调用本过程前启用事务，调用后结束事务，否则速度可能很慢} '在写记录集前，对表格数据有效性，是否与记录集对应等要作判断修正，然后调用本过程 {列行顺序与记录集一一对应} ******************************* Rpt2Rs ***************************** '删除原记录集所有行，再添加新行，这样不会重复追加行到数据库中，invalidC所指定列的值为""则该行不写入记录集，记录集字段名为BanReNewC的不会被写入值 Public Function Rpt2Rs(ByRef rptx As ReportX,ByRef rst As ADODB.Recordset,Optional invalidC& = 1,Optional Upd As Boolean = True,Optional BanReNewC$ = "rowid") As ADODB.Recordset On Error Resume Next If rptx.RowCount < 1 Then Exit Function rptx.InvalidatePaint Dim i&,r&,f&,rr& 'c为列数，r为行数,f为字段数,rr为记录集行数 With rptx c = rptx.ColCount '取表列数 r = rptx.RowCount '取表行数 f = rst.fields.Count '取记录集列数 rr = rst.RecordCount Debug.Print "删除前记录数：" & rr 'rst.Delete adAffectAll 'adAffectGroup和adAffectAll等都是无效的参数，只能一条条删除 If rr>0 Then rst.MoveFirst '只要有记录，即使指针在Eof，也能MoveFirst，所以不使用if not rs.eof For i = 1 To rr '逐行删除记录 不用Do While Not rst.EOF，避免delete时错误导致死循环 rst.Delete '【整个记录行删除，哪怕sql语句只列出1个字段。因此回写时只有rpt中有的字段才会写回数据库】 If Upd Then rst.Update '这里update是否有效取决于rs的locktype，如果为4批量乐观，则本次对记录集所有操作都不会改写数据库。悲观和乐观锁定都会改写数据库。 rst.MoveNext j = j + 1 Next Debug.Print "j" & j & "r" & r & "f" & f Debug.Print "删除后记录数：" & rst.RecordCount rr = 0 j = 1 '初始化变量及记录集指针 i = 1 Dim RowV,ColV For j = 1 To r '逐行写完，移到下行 RowV = Trim(rptx.GetCellValue(invalidC,j)) If RowV <> Empty And RowV <> "0" Then rst.AddNew rr = rr + 1 For i = 1 To f '列数以记录集为准 ColV = .GetCellValue(i,j) If rst(i - 1).Name <> BanReNewC Then rst.fields(i - 1).Value = ColV Next If Upd Then rst.Update Next End With If Upd Then rst.UpdateBatch adAffectAll DoEvents Set Rpt2Rs = rst Debug.Print "rr" & rr & "recordcount" & rst.RecordCount rptx.ValidatePaint End Function '条件合计 lookcol比较列，比较值，合计列(合计列<=0则计数)，比较方式（等或不等），要求不重复列 ************** rtpsumif条件合计 ********************** Public Function rptsumif(rptx As ReportX,lookcol&,EquOrNot As Boolean,lookValue,Optional SumCol& = -1,Optional DistinctCol& = 0) Dim i&,Temsv,AllV() ReDim AllV(1 To rptx.RowCount) If EquOrNot Then For i = 1 To rptx.RowCount If rptx.GetCellValue(lookcol,i) = lookValue Then If SumCol > 0 Then If DistinctCol > 0 Then If LookArr(AllV,rptx.GetCellValue(DistinctCol,i)) = -1 Then Temsv = Temsv + Val(rptx.GetCellValue(SumCol,i)) Else Temsv = Temsv + Val(rptx.GetCellValue(SumCol,i)) End If Else If DistinctCol > 0 Then If LookArr(AllV,i)) = -1 Then Temsv = Temsv + 1 Else Temsv = Temsv + 1 End If End If End If If DistinctCol > 0 Then AllV(i) = rptx.GetCellValue(DistinctCol,i) Next i Else '如果要求不等于 For i = 1 To rptx.RowCount If rptx.GetCellValue(lookcol,i) <> lookValue Then If SumCol > 0 Then If DistinctCol > 0 Then If LookArr(AllV,i)) End If Else If DistinctCol > 0 Then If LookArr(AllV,i) Next i End If rptsumif = Temsv End Function Public Function delR(rptx As ReportX) '************ 删除选定行 ****************** rptx.InvalidatePaint Dim sdh1&,sdh2&,sdl1&,sdl2&,i& '选定起始行，终止行，起始列，终止列 rptx.GetSelectCell sdl1,sdh1,sdl2,sdh2 If MsgBox("确定删除" & sdh1 & "到" & sdh2 & "行",vbOKCancel,"删除资料") = vbCancel Then Exit Function rptx.InvalidatePaint If sdh1 = 1 And sdh2 = rptx.RowCount Then '如果选定所有行，则追加一行再删除原有行 rptx.AppendRow 1 rptx.DeleteRow sdh1,sdh2 - sdh1 + 1 Else rptx.DeleteRow sdh1,sdh2 - sdh1 + 1 End If rptx.ValidatePaint End Function '对ReportX排版，全部居中，Colname为要设置的字段名用豆号分割，'AutoReplaceComma是否自动替换逗号，逗号英文comma。 ******************************* ReportX置列标题 ***************************** Sub rptPB(rptx As ReportX,Optional ColName$ = "",Optional AutoReplaceComma = 1,Optional Szddq As Boolean = True) 'szddq设自动对齐，如为False则只添加列标题 Dim i&,hs&,cols$(),ls& rptx.InvalidatePaint If AutoReplaceComma = 1 Then ColName = Replace(ColName,") End If ls = -1 If ColName <> "" Then cols = Split(ColName,") ls = UBound(cols) End If For i = 0 To ls rptx.SetPoleText 0,i + 1,cols(i) '置标题 Next If Szddq Then '如果设置自动对齐 ls = rptx.ColCount hs = rptx.RowCount For i = 1 To ls '行对齐方式为居中 rptx.SetColWidth i,rptx.GetColBestWidth(i) + 9 '设最佳列宽 For j = 1 To hs rptx.SetCellHAlignment i,1 Next j Next i End If rptx.ValidatePaint End Sub '******************************控件跟随光标，ResizeC默认自动调整Objs与单元格同宽高，OutRpt一般用在控件在rpt以外即有冻结行列时************************* Sub Kjgs(rptx As ReportX,Objs As Object,Optional ResizeC As Boolean = True,Optional OutRpt As Boolean = False) Dim leftC,topR,Ljg,Ljk,djh&,Djl&,djg,djk,Djljg,Djljk '最左可见列，顶端可见行，累计高，累计宽，冻结行，冻结列，冻结高，冻结宽，冻结累计高 Dim C1&,R1&,C2&,R2& Dim Dygg,Dygk,i '单元格高，单元格宽 rptx.GetSelectCell C1,R1,C2,R2 leftC = rptx.LeftCol topR = rptx.TopRow rptx.GetFrozenRow Djl,djh For i = 1 To djh '总行高＝冻结行高＋可见首行至当前选定行高 djg = djg + rptx.GetRowHeight(i) * 15 Next rptx.GetFrozenRow Djl,djh For i = 1 To Djl - 1 '冻结列宽 djk = djk + rptx.GetColWidth(i) * 15 Next For i = leftC To C1 - 1 Ljk = Ljk + rptx.GetColWidth(i) * 15 Next For i = topR To R1 - 1 Ljg = Ljg + rptx.GetRowHeight(i) * 15 Next For i = 1 To IIf(djh < R1,djh - 1,R1 - 1) Djljg = Djljg + rptx.GetRowHeight(i) * 15 Next For i = 1 To IIf(Djl < C1,Djl - 1,C1 - 1) Djljk = Djljk + rptx.GetColWidth(i) * 15 Next If OutRpt Then '控件在rpt这外 Objs.Top = rptx.PoleHeight * 15.3 + Ljg + Djljg + rptx.Top '不能加djh高，因为控件在rpt外，一般是需要放在冻结行中的 Objs.Left = rptx.PoleWidth * 15.3 + Ljk + Djljk + rptx.Left '不能加djl宽 Else Objs.Top = rptx.PoleHeight * 15.3 + Ljg + djg '不需要加上rptx.Top值，因为控件必须拖放到rpt内，成为下级控件，起始位置是0 Objs.Left = rptx.PoleWidth * 15.3 + Ljk + djk '不需要加上rptx.left值 End If If ResizeC Then For i = C1 To C2 Dygk = Dygk + rptx.GetColWidth(i) * 15 '单元格宽高受合并单元格影响，有合并的单元格c1或r2为最后一格位置 Objs.Width = Dygk Next For i = R1 To R2 Dygg = Dygg + rptx.GetRowHeight(i) * 15 Objs.Height = Dygg Next Objs.SelStart = 0 Objs.SelLength = Len(Objs.Text) End If Objs.Visible = True Objs.ZOrder 0 DoEvents Objs.SetFocus '只有单元格是锁定的时候这个才有效 End Sub 【二】、AcReport报表控件，Excel式报表，所有字段可直接拖入表格，多页面，单页只能单字段分组，支持pascal语法的脚本，拖放创建的对象可用“对象名.属性”操作(但表格不能在例如cell_1_1等单元格中引用其他单元格属性，只能text:='ok'或memo.add('yes')等对本单元格操作）。　引用数据字段的表达式为:tablename.fieldname。　【要取表某单元格值用cell(行，列)函数，行号与设计状态对应，到3.2版本为止用cell函数要放在被取值的行列后，否则预览打印的首页无法正常取值。】 发布只要regsvr32注册AcReport.dll即可，非商业注册版打印时会弹出注册框两次。 1、Public WithEvents AcEng As AcRptEngine '声明带事件的报表对象(带事件不支持new关键字) 2、Set AcEng = New AcRptEngine '每个由带事件对象生成的新对象都被关联原对象的事件 3、Dim errcode&,errmsg$ AcRptObject.SetRegisterInfo "280853595D4033132E36CC85879681948B9690A4978D8A85CA878B89C49595DED5D2D1D1D7D3D7DCD1DDCDD6D78680D8A" + _ "D0CFAADC1DDF8F566934E1BAD6B8B296DB4BC968283E9F8FE23728EF0F71F9417C40DB6D30C729ECD01D774746D80E3EE321C6D",_ "天方工作室(acreport@sina.com qq:1655373859)","23bd","",ErrCode,ErrMsg '注册报表控件，不然只能追加30个数据源，每个表限100字段，预览限100页，注册后无限制但会在控件底部显示“天方...” 4、If rs.State = 1 Then rs.Close rs.Open sql AcEng.Init '报表控件初始化，所有数据源清除 AcEng.AddDataset "MysqL",rs '追加数据源给报表(制作前) 【制作时追加数据源：下方页标题处右键“新增数据模块”，然后添加AdoDatabase并设置连接串、AdoQuery对象并设置数据库为Database1对象再设置查询语句，最后设字段列表。】 AcEng.ShowDesigner '显示报表设计界面，【可以在这里打开报表，制作报表，保存报表。】 AcEng.LoadFromFile "rkd.apt" '载入报表（注意：记录集要与设计时结构匹配） aceng.PrepareReport '准备报表，可以在打印、预览前取报表页数等【建议读取完打印否则可能打印出错】 AcEng.Preview '预览前会自动prepareReport 　5、要用到[总页数]，要在"文件－报表及页面属性－选项"中勾选两遍扫描报表 　6、打印机可能没有的纸张要选虚拟打印机，勾选默认打印机，然后自定义，否则碰到打印机未设置的纸张默认为A4 　7、设计报表前一定要先在“文件－报表样式设置”里选定报表类型（如：有无分组），单击单元格，然后右键－行－添加行/插入行，右键－一分为二列，或者合并所选单元格 　8、单击单元格，右键－隐藏行，或选中被隐藏行的上下行右键－取消隐藏（对被脚本隐藏的行一样有效），如果被隐藏的是顶行则在下一行取消隐藏 　9、自动合并值相同的上下单元格，只能在“工具栏-自动合并选项（一个像分割合并单元格右边有下拉小三角的图标）”按钮设置。 10、子报表功能，可以实现类似多层分组等功能，在页面下方右键，新增一页，新增的页可以从属于主表或子表，实现多层子报表。 11、只有AcRptEngine能直接实例化,AcPage，AcLine,AcCell要dim object然后set object=AcRptEngine.getsubpage()/getlinex()/getcellx()来实例化后使用。 12、【AcReport会对分组字段排序，如果数据源本身没有对该字段排序，则行可能混乱。*** 设为数值的单元格如果写入非数值则显示不正常(删除内容能看到一个红叉)，只要在单元格属性中选为常规即恢复】。 【三】、Grid++report报表控件，支持复杂多层多字段分组，在安装好软件后用报表设计器设计报表，支持java和vbs脚本，发布只要regsvr32注册grdes6.dll(报表设计器)、gregn6.dll（报表显示）两个文件。 1、插入－明细网格 　2、插入－分组 　3、明细网格上的sql按钮设置数据源，然后依次生成字段生成列 　4、列顺序与多层表头－“增加”按钮有下拉列表，其中“组标题格”才可以容纳下级列设计出多层表头。 　5、右边框内点－报表主对象，下方属性可以设置“打印时脚本”等事件脚本。 　6、右边框内点－Group1（具体的分组对象），下方的行为框内设分组“依据字段”，多字段分组可以设多个分组对象。 　7、分组尾－行为“换新页”可选节后换页等 　8、右边上方框点－内容行，下方行为“每页行数”可设置每页最大行数，行少于该值不会自动加空行。 9、动态编程： Dim WithEvents Report As gregn6LibCtl.GridppReport Report.LoadFromFile ("...grf") Report.ConnectionString = "..."; Report.Querysql = "..."; GRDesigner1.Report = Report '将报表发给设计器 Report.PrintPreview True '报表打印预览，也可以把report发给已经拖放到窗体中的预览控件，自定义预览窗口(同上行的设计器) Report.[Print] True '直接打印报表 ，false则不显示打印机设置对话框 'Report.PrintEx 3,True '直接打印报表，3生成所有报表数据（1仅生成表单数据2仅报表内容数据4预览所有数据，但只打印内容） gpp.LoadFromFile "f.grf" '接收推送的Rs也必须要载入报表 gpp.SkipQuery = True '忽略原查询及连接 gpp.PrepareLoadData '【如果没有这个语句则必须在GridppReport的FetchRecord事件、或GRDisplayViewer的BatchFetchRecord事件中调用】 FetchRs gpp,rs1.GetADORsFromContent '使用以下FetchRs()函数将记录集数据推送给报表 gpp.PrintPreview '在GRDesigner中没有类似fetchRecord事件，所以推送的记录集无法在设计器中预览。 'gdisplay.report=gpp 'gdisplay.BatchGetRecord=true '这个语句必须，否则记录集不会被推送 'gdisplay.BatchWantRecords = 50 '限制预览每页记录数,可选 'gdisplya.start '开始在报表预览控件中显示报表 '将记录集推送给报表，必须使用GridReport安装目录\Samples\VB\Advance\LoadFromDB例程FillRecord模块中的GRFetchRecordFromRecordset Report,rs ● '推送rs到报表函数如下【与原报表字段名一样的字段才会在报表中显示】： Private Type MatchFieldPair '放模块头 rsField As ADODB.Field grField As gregn6LibCtl.IGRField End Type Public Sub FetchRs(greport As GridppReport,rst As Recordset) '将记录集推送至报表 If rst.BOF And rst.EOF Then Exit Sub Dim grRecordset As gregn6LibCtl.IGRRecordset Set grRecordset = greport.DetailGrid.Recordset Dim FieldCount As Integer FieldCount = grRecordset.fields.Count Dim rsFieldCount As Integer rsFieldCount = rst.fields.Count Dim FieldPairs() As MatchFieldPair ReDim FieldPairs(FieldCount) Dim MatchFieldCount As Integer MatchFieldCount = 0 Dim I As Integer For I = 1 To FieldCount Set FieldPairs(MatchFieldCount).grField = grRecordset.fields.Item(I) 'Set FieldPairs(MatchFieldCount).rsField = rst.Fields.Item(FieldPairs(MatchFieldCount).grField.Name) Dim J As Integer For J = 0 To rsFieldCount - 1 If LCase(FieldPairs(MatchFieldCount).grField.RunningDBField) = LCase(rst.fields.Item(J).Name) Then Set FieldPairs(MatchFieldCount).rsField = rst.fields.Item(J) MatchFieldCount = MatchFieldCount + 1 Exit For End If Next Next rst.MoveFirst Do Until rst.EOF greport.DetailGrid.Recordset.Append For I = 0 To MatchFieldCount - 1 If Not IsNull(FieldPairs(I).rsField.Value) Then Select Case FieldPairs(I).grField.FieldType Case grftString FieldPairs(I).grField.AsString = FieldPairs(I).rsField.Value Case grftInteger FieldPairs(I).grField.AsInteger = FieldPairs(I).rsField.Value Case grftFloat FieldPairs(I).grField.AsFloat = FieldPairs(I).rsField.Value Case grftBoolean FieldPairs(I).grField.AsBoolean = FieldPairs(I).rsField.Value Case grftDateTime FieldPairs(I).grField.AsDateTime = FieldPairs(I).rsField.Value Case Else 'grftBinary FieldPairs(I).grField.Value = FieldPairs(I).rsField.Value End Select End If Next greport.DetailGrid.Recordset.Post rst.MoveNext Loop End Sub 八、WinSock控件（VB网络连接控件，可用于局域网和Internet） 　　　1、TCP方式连接，设双方winsock.Protocol＝0然后服务器的LocalPort为要监听的窗口（或用Bind方法）然后用Listen方法开始监听，再在ConnectionRequest事件中用Accept方法接收连接请求，客户端用connect方法连接服务器所在IP和Port，【winsock.state=0即close状态下才能接受连接(监听时state=2也不能接收连接)，监听最好单独使用一个Winsock(保持一个sock始终在监听状态避免频繁开关端口)，接受连接和收发用单独的WinSock或控件组(断开事件也在此控件中响应)。注意：TCP的客户端(申请服务器接受连接的一端)绝对不能设置LocalPort值否则只能连接一次，二次后就无法连接也没有错误提示(原因暂时不明)】，连接后用SendData方法发送消息，在DataArrival事件中用Getdata方法接收消息(要定义一个接收用的变量)。 2、UDP无连接收发，设收发双方的winsock.Protocol＝1，然后用Bind方法设置各自的本地接收端口（必须用Bind方法，因为用后才能使winsock.state=1转为打开状态），将RemotetHost(可以是计算机名或IP地址)和RemotePort为要发送的地址，即可相互收发消息。 (收到消息同时会将发信息的计算机IP和端口写入RemoteHoshtIP和RemotePort) 3、①winsock的close事件仅指已经连接的客户端正常关闭（包括客户端close或客户端所在程序退出），不含对方强行关机断网等，亦不含自身关闭事件，判断对方是否在线都是采用定时发送心跳包验证，两类心跳包原理都一样，新客户端接入就启动计时器，客户端连接不存在或服务器收到客户端断开事件就关闭服务器连接且设计时器Enabled=False。1、服务器端定时发消息，产生40006错误则是客户端连接不存在。 2、客户端定时向服务器发"aLive"，服务器收到就将计时器时间重置，服务器计时器时间一到就说明客户端连接不存在。 ②Listen端口和Bind端口互不冲突，即使端口号完全一样，端口冲突会产生10048错误，如果Listen成功state=2，如果Bind成功state=1。 九、多个子窗体的MDI窗体 　 1、在工程视图中右键--添加MDI窗体，将要放入MDI的子窗体的MDIChild属性设为true。 2、在MDI窗体中可以添加菜单，工具栏，状态栏等，工具和状态栏用PictureBox控件，将控件拖入窗口，然后设置Align属性，设align属性后可以设width或height值，这样就可以把PictureBox自动停靠在上下左右。 3、在子窗体的Unload或Terminate事件中不可以添加End语句，否则可能会导致不断重启（因为MDI退出时会逐个卸载子窗体，这时子窗体直接用End结束所有进程会和MDI冲突）。 　　十、passwordchar属性可将文本框变为密码框（不显示实际文本）。　文本框限制输入可在keypress事件中判断keyascii值并可用keyascii=0取消输入 或用 sendkeys chr(9)模拟TAB按键等。常用ascii值：48-57为数字0-9，8为退格键，13为回车键，46为.字符，45为-字符。（易语言不支持keyascii=0取消输入功能） 十一、组合框列表框专题(这两个控件数据源无效，数据源必须用Datalist控件) combo（组合框）list(列表框)：读写用combo1.list(index)第一项索引号为0。　combo(只可选禁输入状态)和listBox的Text也表示当前选中项的值。 选中项改变时会产生click事件，设置listindex也会产生click事件。combo弹出下拉列表或下拉列表未收回时焦点离开，会自动选中首字符与当前文本匹配的第一项，但不会触发click事件。即使使用API　SendMessage combo.hwnd,319,0　弹出下拉列表也会自动选中 Style属性为2时只能从列表中选择而不能输入，为0时可输入可选择，为1时可输入可选择下拉列表显示多少条由Height属性决定。　List属性在开发窗口中即可设置列表项，列表项会被编译在应用程序的PropertyBag中。 '清空组合框下拉列表内容，保留text内容。　列表框、组合框的首项Index都为0 Private Sub clearlist() On Error Resume Next Dim xx As String Dim ss As Long Dim ll As Long ss = syscombo1.SelStart ll = syscombo1.SelLength xx = syscombo1.text SendMessage syscombo1.hwnd,CB_SHOWDROPDOWN,0 '必须先收回已弹出的下拉列表再清空，否则会出错。 '用逐项删除的方法是不可行的 'Dim ii,tt As Long 'tt = syscombo1.ListCount 'For ii = 1 To tt 'syscombo1.RemoveItem tt - ii 'Next 'Debug.Print syscombo1.ListCount syscombo1.Clear '只能用clear方法 syscombo1.Refresh syscombo1.text = xx syscombo1.SelStart = ss syscombo1.SelLength = ll DoEvents SendMessage syscombo1.hwnd,0 '清空列表后弹出下拉列表 End Sub Sub Rs2List(rst As ADODB.Recordset,ListBoxS As Object,Optional Fieldn = 0) '记录集读入列表框或组合框，默认是第一个字段值 ListBoxS.Clear rst.MoveFirst Do While Not rst.EOF ListBoxS.AddItem rst.fields(Fieldn).Value rst.MoveNext Loop End Sub 十二、MsHFlexGrid、DataGrid表格　（hflexgrid不支持输入，dataGrid支持输入但仅用于绑定记录集再操作，这两个表格速度都比收费的慢与reportx接近） 1、常用属性及方法：row和col属性用于取得或设置当前单元格、text属性用于取得或设置当前单元格内容、TextMatrix(行,列)集合用于直接取得或设置指定单元格而不改变row和col。范围选择时row和col表示起始选择而rowsel和colse表示选择结束位置。Cols和Rows取得或设置表格行列数。ColAlignment(Id)集合用于取得或设置对齐方式（设计时可用FormatString属性设置固定列标题，列宽和对齐方式如："^ |> 品名|<数量| "其中|分割各列，<>^表示对齐方式，其他字符用于填充并调整列宽） 2、mshflexgrid首行和首列都是0，用Fixedcols、Fixedrows取得或设置固定标题列或行（如：固定标题行为1，则单元格首行为1，类推）。注意：设置rows或cols小于或等于fixed...时会将固定列或行清零 3、刷新表格前要调用Doevents()表格格式和标题行才能正常显示，绑定空记录集会使表格不能正常选取单元格和范围，所以判断为空记录时必须set datasource=Nothing，后用clear清空，再将Rows设为比固定行多1。 十三、VB与易语言对比 0、VB有容错机制即：On Error Resume Next或On error Exit Function等 ，而易语言没有。 1、VB变量默认即是变体型，而易语言中变体型相当麻烦。 　2、VB自带datareport等报表工具　及　多种数据感知控件如：PictureBox、MsHflexgrid等。 　3、VB可以制作ActiveX控件等，易语言不能，但易可以直接作标准动态链接库（dll）。 　4、VB可以直接装载使用ActiveX对象，易语言不能直接使用含有“集合”的ActiveX对象（如：ADODB等）,且使用ActiveX对象前要先有一个.npk汉化文件才能使用，如ActiveX对象成员有变，则要重新制作npk文件，新旧npk不兼容，要间接使用ActiveX对象，只能动态创建对象并使用，这样效率则不如直接使用对象。 5、VB的MSHflexgrid等表格虽然支持数据源，但不支持输入和预览打印，可用第三方reportX控件补。 6、VB支持控件数组，支持如：Cmd(n).caption="按钮" 或　Load cmd(n)创建新控件等动态快捷的控件操作，易语言没有类似功能。 7、VB的len(),lenB(),instr(),instrb()等可按字符或字节操作（按字符操作则能自动识别占两个字节的字符如汉字），易语言只能按字节而使汉字等操作相当难。 　8、易语言支持“总在最前”这样的窗体属性。 9、易语言会自动给第三方控件加上如setfocus这样的通用方法，而VB不会。 10、易语言支持取汉字拼音、转金额大写、取硬盘物理序列号、非对称算法等，而VB只能自编或外来。 十四、DataReport报表专题 1、在“工程--添加Data Report”菜单中添加DP,一个DP相当于一个报表模版。 2、页头页脚显示页号时间等用以下格式 Current Page Number: %p Total Number of: Pages %P Current Date (Short Format): %d Current Date (Long Format): %D Current Time (Short Format): %t Current Time (Long Format): %T Report Title: %i 注意 要显示百分号，请使用%%。 十五、ADODC及DataEnvironment数据环境专题(这两个默认为客户端游标，通过CursorLocation属性设置) 1、Adodc通过设置ConnectionString和RecordSource属性后，使用Refresh方法更新结果集，adodc.recordset即是结果集对象，Adodc.Recordset.ActiveConnection就是connection对象。 2、在“工程--添加Data Environment”菜单中添加DE。 3、可以像使用Adodb.Recordset一样使用DE中的rscommand。 4、可以使用DE作为sql语句测试工具，具体为“右键connection--属性”设置连接，再右键“添加命令”，“右键command--属性”在通用页下方点选sql语句，在框中输入普通sql语句，点应用后如果出现...执行命令吗？对话框则表示语句错误，语句正确时command会显示字段列表。 5、可用于生成ADO shape()层次结构语句，在各个command和子command中设置普通sql语句，然后右键最顶级command--层次结构信息，即可查看系统生成的shape语句，该类语句可直接复制用于其他ADO连接中并用MSHFlexGrid显示。 十六、VB文件操作主要有三种方法： 一、是通过VB自带的语句/函数如：Open；Dir、Name、MkDir、Chdir、FileLen、filecopy、Kill、rmdir等进行操作,Dir()可以返回目录中所有文件或判断文件是否存在等(对于局域网文件或目录Dir不能用，只能通过Api的open或给filelistBox、dirlistBox等赋值返回错误判断，也可以通过drivelistBox来取所有盘符。xxxListBox都是VB默认控件)，详细方法参见MSDN索引中“文件”相关内容。，以下以Open语句为例： '文件读写要通过一个变量中转，用于装载文件内容的变量必须是定义了长度的字符型变量或动态字节数组。（如没有通过变量而直接读写会出错） Dim gd() As Byte Open App.Path & "\data\" & nu & ".xtb" For Binary As #1 gd = LoadResData(101,"custom") '载入VB资源文件内容，资源文件在“工具－－资源编辑器”中配置。 Put #1,gd Close #1 1、Open filename for binary/random/append/output… as [#]FileNumber 语句打开文件，FileNumber可以是1-511的整数或用FreeFile()取一个空闲文件号。 2、读文件使用Line Input、Input #（文本方式）和 Get #1,[开始读出的位置，文件首位为1],存放读出内容的变量（长度必须已经定义）（二进制方式） 3、写文件使用Print #1,"..."、Write（文本方式）和 Put 1,[写入数据的指针位置，写入是覆盖式],要写入内容的变量 （二进制方式） 4、Close语句关闭文件 5、二进制时指定文件读写位置也可使用Seek语句。 6、获得文件的长度 lof(filenumber) 判断读写位置是否到结尾 eof(filenumber) 获得文件读写指针当前位置 loc(filenumber) 注： 以output方式会清空文件并将其打开等待写入操作，如：Open ".\t.txt" For Output As #1 : Close #1 ‘这两个语句就会清空文本文件 装载读入文件内容的变量必须预分配变量大小空间如：dim fc as string * 1280 或 dim fc$:fc=space(1280) 或 dim fc(1280) as byte。 print #写出文本会在末尾加Chr(13)+Chr(10)，而write写出文本每行前后加双引号，并也带回车换行符，【而读入的则不带回车换行符,如果自行加vbCrLf回车换行则在判断行值时要用if lineV=("..." & vbCrLf) then判断】。 文件最大操作块大小为2G。　 除Input方式打开外，其他方式打开时，如文件不存在，将创建一个空文件。 在Binary、Input和Random方式下可以用不同的文件号打开同一文件，而不必先将该文件关闭。在Append和Output方式下则必须在打开文件之前先关闭该文件。 Public Function ReadFile(FName$,Optional startLine& = 1,Optional Lines& = -1) As String '***读入文件，从指定行开始读入指定行数，-1表示全部********* Dim temStr$,Freef&,TemText$,LineText,invaildLine$ If Dir(FName,vbNormal + 7) = "" Then Exit Function Freef = FreeFile() Open FName For Input As #Freef If Lines = -1 Then Lines = 2000000000 '最大2G，即2147483647 Else Lines = startLine + Lines - 1 End If Do While i < Lines And (Not EOF(Freef)) i = i + 1 If i >= startLine Then Line Input #Freef,LineText TemText = TemText & LineText & vbCrLf '在行尾加回车换行符 Else Line Input #Freef,invaildLine End If Loop Close #Freef ReadFile = TemText End Function 二、是通过CreateObject("Scripting.FileSystemObject")语句调用文件对象进行操作 三、是通过shell函数执行外部DOS命令（详见前述shell函数说明） 十七、VB6.0中提供了Validate事件用于验证是否可以将焦点移出控件，设事件的参数Cancel=true则不允许移出焦点。注意，只有即将获得焦点的控件和即将失去焦点的控件CausesValidation属性值都为True时，Validate事件才发生，CausesValidation属性默认为真。 十八、ActiveX制作、发布注意事项 (ActiveX EXE要在“工程--..属性--部件”中选独立方式，否则sub main无法显示窗体) 1、在工程属性“通用页”中勾选要求许可证关键字，这样发布的控件在未注册许可证的机子上就无法用于开发环境。 2、如控件已经在某工程中使用，必须保存该控件在工程首次引用它时的原文件或被升级文件，决不可用非原控件升级的控件来替代。以下是升级控件的方法： 为了使更新后的控件能被已经使用它的工程支持，必须在制作控件的工程属性“通用页”勾选升级ActiveX控件，并在“部件页”中选“工程兼容”再在路径框中选择要更新（即对其升级）的OCX文件。 3、自制控件最好用加载"外接程序管理器--VB 6 ActiveX控件接口向导"生成控件的属性、方法、事件等(专业或企业完整版才有向导，Mini等版本没有)，也可以手动用菜单中的"工具--添加过程"，然后选定属性、函数、事件...进行添加。 Public Property Get ZV() As String '这个是属性最主要的，取属性最终值，并返回给控件使用者 ZV = m_ZV 'ZV是属性名，m_ZV可以是要给属性赋值的变量，也可以是控件中的某个属性值，没有这一句用户就无法取得属性值**** End Property Public Property Let ZDefaulValue(ByVal New_ZDefaulValue As String) '相当于用户设定属性值事件，属性是一个对像的应该用Property Set语句 m_ZDefaulValue = New_ZDefaulValue '将用户设定值传给变量 PropertyChanged "ZDefaulValue" '通知系统，属性已经改变 End Property 附：重要扩展 ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★ 自制Stext框● 1、设Zcnstring，Zsqltext，ZcurType服务器游标或客户端游标　　或 〖不设前述值可在ZQuery()中传rs给AdoRs〗 2、设Zfilter="品名 like '%<thistext}%' or 品名拼音 like %<thistext}%"并在ZQuery()选择autofilter=false 或　〖ZQuery()中默认由Zlist1--Zlist3字段自动生成zfilter〗 （说明：其中<thistext}会自动替换成当前文本框值，Like后值可加''也可不加''） 3、Zlist1-- Zlist3　属性设置要在下拉列表中显示的〖字段名或字段号〗 4、zrf所设字段值在lostfocus后会自动返回给控件文本框中 5、zback1--zback9 所对应字段值lostfocus后将自动返回给 zbr1--zbr9 6、【Zautosel是否自动选择结果】，如无可选结果集则返回ZdefaulValue属性值(用户输入的值zUserInput属性在lostfocus事件中Doevents后即可取得)。 7、【在GotFocus事件中加stext.ZQuery启动查询】，如果列表被其他控件遮挡可以用stext.ZOrder 0，Zquery后可以清除Zcnstring值不影响控件。 '90版最简单操作只要一条语句就能实现智能下拉列表 Private Sub stext1_GotFocus() stext1.zQuery ADO_recordset '默认把记录集第一个字段(即rs(0))列表并返回给stext框及zbr1，要实现拼音下拉可以在zList2中设对应的拼音字段，也可以不用列表把AutoFilter设为False手动设置zFilter属性 end sub '原第90版本以前需要以下代码：　（第90版已经默认zrf=0,zback1=0,zlist1=0，如果仅使用第一个字段列表及返回则可以不用设这些属性，zfilter一般也可以直接用默认的） 1、在stext.kpress事件中添加 If KeyAscii = 13 Then stext1.Text = stext1.Zbr1 '将返回值返回给文本框 ，也可以直接设置Zrf属性值为要返回给text的字段。 otherObj.SetFocus '将焦点移给其他控件 End If 2、在GotFocus事件中加stext.SelStart = 0和stext.SelLength = Len(stext.Text)自动全选文字。第86版后控件已自带全选，并gotfocus时不会自动弹出下拉。 取拼音控件 【qpy1.start ("a1234526204") '取拼音控件注册并启用，没有这个初始化程序会出错】 qpy1.qpy("汉",1) '取单个汉字读音，返回han4，第二个参数为要取第几个读音，参数可省略，默认返回第一个读音。无法识别的字符返回原字符。 qpy1.qdys("汉") '返回单个汉字的读音数目，无法识别返回0。 qpy1.qszm("中华人民共和国成立60周年（2009.10.1）") '返回zhrmghgcl60zn(2009.10.1)，常见多音字，返回较常见的读音，其余多音字返回第一个读音。 大写金额控件（含加解密类） daxie()：将数字转换为汉字大写金额如：壹拾元整。最大支持亿亿，小数2位。 fxor(): 文件位异或输出，如带checktext参数则检查文件尾是否相符，相符则进行加解密，不符则返回-1。 qszjy(): 取文本的MD5（32位16进制文本，其中字母为大写） qyph(): 取本机主盘物理序列号 RSA全套如下 qsjs(): 返回随机生成RSA的“私锁xxx公锁xxx模数xxx” qszqm(): 用私锁将硬盘ID等信息转为“注册码”，即取数字签名。（注册机用） hyqm(): 用公锁和模数将注册信息还原至硬盘ID等信息，即还原签名。（客户） 日期框 dBox1.Text = Format(Date,"yyyy-mm-dd") '设置日期框为当前日期 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ smartbi或fineReport等报表软件可以直接发布网页报表(交互可回填到数据库，完全基于Java无OCX) Grid++Report支持复杂多表头多层分组统计等，但创建模版相对复杂，发布软件或网页都需要下载注册OCX控件。(免费但预览时有logo) AcReport像表格一样的报表控件，可以设多个数据源，但仅支持一个分组头尾(可以用子报表等实现类似功能)，打印比卡尺小10%。(OCX,免费版只100页预览限100个字段每个数据表，可以添加30个数据表源) ReportX主要是表格控件，支持打印，但数据源功能基本无用，连续打单需编程。 (OCX，完全免费) FarPoint Spread8 速度与VsFlexGrid差不多表格控件，无缝导入导出excel(多页面带格式)，绑定数据源仅用于显示（dataSave方法与DAutoSave=True都是无效的），支持打印预览。【收费控件， 缺点：①行多时滚动条不能拉到最底行 ②绑定时修改记录集会很慢(会不断刷新表格内容)　③不论如何绑定数据源均不能同步保存修改，但不会出现vsflexgrid那样读出""的问题】 操作：第一个单元格为1,1，顶标题行ColHeaderRows和左标题列RowHeadersCols赋值用row=0:col=0（多行的：row=1-1000表示第2行表头，row=2-1000第3行表头） 1、页面 sheet=0 2、列、行 col=2:row=3 : col2=maxcols:row2=-1 '指定当前行列，col2和row2为选中范围的最后列行，-1表示全部 3、text="t"、lock时要确认Protect属性为true、Formula = "SUM(A1:A4)" '设置或取得这些单元格属性，都要先指定当前单元格(设BlockMode = True则属性赋值时对col、row、col2及row2范围内有效)。 4、getText(列,行,取值变量)、settext() 'getText()比较无用，一般用自定义方法取值 5、set dataSource=rs '绑定数据源 6、ImportExcelBook()、ExportExcelBook() '无缝多表导入导出excel，支持2007 7、InsertRows 2,1在第2行前插入1行、DeleteCols 2,1在第2列前删除1列 8、Enabled 是否可以编辑、.ScrollBars选则h..横向滚动条V..纵向滚动条、SelectBlockOptions选定单元格还是整行或整列、SetOddEvenRowColor奇偶行颜色、ColHeaderRows顶端标题行数、RowHeadeRSShow左端行标题显示隐藏、AddCellSpan 3,4,1从第3列第4行起合并单元格，跨度为2列1行、ColWidth(Ind)=123设列宽、TypeHAlign水平对齐方式、TypeVAlign垂直对齐方式、TypeNumberDecPlaces = 2设置小数位数、TypeNumberShowSep = True设置千位分隔 注意：必须设 EditModeReplace=True : EditModePermanent=True 才能使单元格一点击即是全选中待编辑状态 ComponentOne VsFlexGrid可绑定数据源（修改表格可直接同步修改数据库），可打印(不可预览)，可编辑，速度快，功能多。【收费，bug：①不论哪种datamode绑定数据源，只要所在单元格未被浏览过，text和value属性都可能为""或0，因为只有浏览到的行列记录集中数据才会被读入表格。　②绑定数据源的最好直接操作数据源，表格仅是显示用 ③除了freeBound外其他绑定时修改记录集会很慢(会不断刷新表格内容)　】 ==================== 首行首列都为0（包含固定行列,如固定2行为标题行则0和1行指标题行） row取得或设置当前行号，rows行数，cols列数，FixedRows = 1固定几行，FixedCols固定列，ColSel返回/设置最后选择的列【rowsel可能小于row，看选择方向定】 TextMatrix(行,列)读写单元格文本值，ValueMatrix(r,c)读写单元格数值值（非数值返回0） FocusRect '选定单元格的边框风格，一般要设为2或3（默认为1，5为文本框型）● AllowUserResizing=flexResizeBothUniform　　'用户可调整行高列宽 uniform表示调一行/列，其他行列都跟着相同宽/高 vsfg.AutoSize vsfg.fixedcols,vsfg.cols-1 '从非固定的第1列到最后一列自动调整宽度 vsfg.WordWrap = True '列宽不够时自动换行显示 ExplorerBar=15 '在没绑定数据源情况下可拖到行列，可单击列头排序 ColAlignment(-1)=flexAlignLeftCenter '-1表示所有列，设对齐方式 FindRow(查找值,[行(从第N行起查找)],[列],[敏感],[精度])：返回一个符合查找条件的行号，找不到返回-1 GridColor = RGB(245,240,210)单元线条色 ForeColor = RGB(0,0)单元前景色(字符色) MergeCol(Col) = True允许合并列 MergeRow(Row) = True允许合并行 MergeCells = 0|1|2|3|4|5|6 Clear([0|1],[0|1])清除单元格内容 Sort=flexSortStringDescending '排序，对绑定数据源的无效 TopRow顶部可见行号 AddItem "",2 '在第三行插入 ，【""中用chr(9)即tab符分割各列值】 RemoveItem(行) '删除指定行 Private Sub VsFlexGrid_BeforeEdit(ByVal Row As Long,ByVal Col As Long,Cancel As Boolean) '禁止某列被编辑 If Col = 1 Then Cancel = True End Sub BackColorAlternate = RGB(184,253,253) '间隔行背景色(浅天兰) '绑定数据源(直接写入表格多行数据要设置Redraw=flexRDNone禁止刷新，写完Redraw=1恢复默认，速度与reportx接近)● Adodc1.ConnectionString ＝ 连接字符串 Adodc1.RecordSource ＝ sql Adodc1.Refresh with VSFlexGrid1 set .DataSource=Adodc1.GetRecordset '绑定 .Refresh .Editable ＝ 1 '表格可以修改 .DataMode ＝ 3 '同步更新数据源(2为批量更新，需用Rs.UpdateBatch确认。　如果有变更未update或rs.requery则rs不可关闭)。　绑定不论何种数据源对表格的修改都是强制字段类型的（类型不符会有英文错误提示，改变无效，但不会退出）。 如果没有PRIMARY KEY或unique index，修改时可能出错，即使包含rowid也还可能出错。　　查询中用了别名的字段绑定后修改都会报错（要编辑的字段不能用as 别名，只能绑定后手动改标题）● .TextMatrix(0,1) = "序号" '绑定后修改标题 For i=1 to 10 .RemoveItem '删除1-10行，必须用循环，列只能隐藏不能删除 (省略参数则从首行开始删，注意同步数据源的数用i，批量更新或没绑定的用起删行号)● next .Refresh '绑定并同步更新数据源，表格内容改变后必须立即刷新，否则下次编辑将出错。 Rs.Requery '如果绑定后不是通过被绑定到表格的Rs.update更新数据库（比如cn.excute ...）或者使用批量updatebetch无法完成更新时，则必须用rs.requery刷新(requery会同时刷新表，且没有update的记录集所有修改都不再生效，哪怕接下一行就update)● '记录集到表格，要设置Redraw=flexRDNone禁止刷新，写完Redraw=1恢复默认，速度与reportx接近● Public Function Rs2fg(ByRef rst As Object,ByRef vsfg As Object,Optional AutoPB As Boolean = True) As Long '记录集列表，并返回记录总数 'On Error Resume Next Dim ZiDuanZhi '字段值 vsfg.Redraw = flexRDNone If rst.EOF Or rst.fields.Count <= 0 Then vsfg.Rows = 1 Exit Function End If rst.MoveFirst Dim i&,r& 'c列数r行数 With vsfg vsfg.Rows = 1 c = rst.fields.Count vsfg.cols = c + 1 '加一固定列 For i = 1 To c '增加列并写列名 .TextMatrix(0,i) = rst(i - 1).Name Next j = 0 '取行数 Do While Not rst.EOF rst.MoveNext j = j + 1 Loop r = j .Rows = j + 1 '加一行固定行 If j > 0 Then rst.MoveFirst '逐列写入行数据 j = 1 Do While Not rst.EOF For i = 1 To c ZiDuanZhi = rst(i - 1).Value If Not IsNull(ZiDuanZhi) Then .TextMatrix(j,i) = ZiDuanZhi Next j = j + 1 rst.MoveNext Loop If AutoPB Then '排版 .AllowUserResizing = flexResizeBoth .AutoSizeMode = flexAutoSizeColWidth .WordWrap = True .AutoSize 1,c .ColAlignment(-1) = flexAlignLeftCenter .BackColorAlternate = RGB(184,253) End If .Redraw = 1 End With Rs2fg = j - 1 End Function 'VsFlexGrid写回记录集● Public Function fg2Rs(ByRef vsfg As Object,ByRef rst As Object,Optional BanReNewC$ = "rowid") 'On Error Resume Next If vsfg.Rows < 2 Then Exit Function Dim i&,F&,rr& 'c为列数，r为行数,rr为记录集行数 With vsfg c = vsfg.cols - vsfg.FixedCols '取表列数 r = vsfg.Rows - vsfg.FixedRows '取表行数 F = rst.fields.Count '取记录集列数 rr = rst.RecordCount 'rst.Delete adAffectAll 'adAffectGroup和adAffectAll等都是无效的参数，只能一条条删除 If rr > 0 Then rst.MoveFirst For i = 1 To rr '逐行删除记录 rst.Delete ' If Upd Then rst.Update '这里update是否有效取决于rs的locktype，如果为4批量乐观，则本次对记录集所有操作都不会改写数据库。悲观和乐观锁定都会改写数据库。 rst.MoveNext '如果记录集是cRecordset此行删除即可 ★★★ j = j + 1 Next rr = 0 j = 1 '初始化变量及记录集指针 i = 1 Dim bgsh&,bgsl& '表格首行，表格首列 bgsh = .FixedRows - 1 bgsl = .FixedCols - 1 Dim RowV,ColV r = r For j = 1 To r '逐行写完，移到下行 RowV = vsfg.TextMatrix(j + bgsh,invalidC) If RowV <> Empty And RowV <> "0" Then rst.AddNew rr = rr + 1 For i = 1 To F '列数以记录集为准 If rst(i - 1).Name <> BanReNewC Then '非rowid列 'if rst.fields(i - 1).Type < 7 Then ' rst.fields(i - 1).Value = Val(ColV) 'Else '列为字符或变体型，rs(i).type=202 ' rst.fields(i - 1).Value = ColV 'End If ColV = vsfg.TextMatrix(j + bgsh,i + bgsl) If CStr(Trim(Val(ColV))) = ColV Then ColV = Val(ColV) '判断值的类型，替代判断rs列类型 rst.fields(i - 1).Value = ColV End If Next 'If Upd Then rst.Update '这里update是否有效取决于rs的locktype，如果为4批量乐观，则本次对记录集所有操作都不会改写数据库。悲观和乐观锁定都会改写数据库。 End If Next End With If Upd Then rst.UpdateBatch DoEvents fg2Rs = rr End Function '将VsFlexGrid写回数据库(支持ADO及vbRichClient的cairo_sqlite连接),wheretext是删除原有记录的条件，为""时即将表格内容添加到数据库中，*表示删除所有记录后再追加 ● Public Function Fg2db(fGrid As VSFlexGrid,cnOrcCn As Object,tbName$,whereText$,Optional fName = "［AllFields］") Dim i&,qsh&,qsl&,jsh&,jsl&,hz '列数，行数，起始行，起始列，行值 With cnOrcCn qsh = fGrid.FixedRows qsl = fGrid.FixedCols c = fGrid.cols - fGrid.FixedCols r = fGrid.Rows - fGrid.FixedRows jsh = qsh + r - 1 jsl = qsl + c - 1 If fName = "［AllFields］" Then fName = "" fName = Replace(fName,") '自动替换所有中文逗号 fGrid.Redraw = flexRDNone .BeginTrans If Trim(whereText) <> "" Then '参数带删除条件 If whereText = "*" Then '删除所有记录 .Execute "delete from " & tbName Else '删除指定记录 .Execute "delete from " & tbName & " where " & whereText End If End If For i = qsh To jsh hz = "" For j = qsl To jsl hz = hz & sqlFV(fGrid.TextMatrix(i,j)) & "," Next j hz = Left(hz,Len(hz) - 1) '去掉最后一个逗号 If Trim(fName) = "" Then '如果不带字段名列表参数 .Execute "insert into " & tbName & " values(" & hz & ")" Else '带字段名列表 .Execute "insert into " & tbName & "(" & fName & ") values(" & hz & ")" End If Next i .CommitTrans fGrid.Redraw = 1 End With End Function ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ 使用 VBRichClient 库 ==================== 功能：多线程、函数指针调用、数组列表、高级集合类 内存数据库、XML DOM/SAX访问、子类化、公式计算、SGDI封装、各种加密和压缩算法、文件处理、网络Socket、 简单下载、JSON、JPG压缩解码、音频设备访问、物理引擎、Webkit浏览器、 sqlite数据库(cConnection和cRecordset对象可以直接操作sqlite,还可以getADOrsfromconnect，但绑定vsflexgrid后不能同步修改数据库。 自带sqlite加解密) 基于Cairo的2D绘图、打印、RPC、Web服务器…… 多到你想不到的功能，而且一直在不断扩展中，官方网站 http://www.VBRichClient.com/ 点带下划线的free available进入下载。或http://www.ediy.co.nz/dhrichclient-xidc100952.html下载老版本及例程。 ★操作sqlite例，需要vb_cairo_sqlite.dll（不用注册）与vbRichClient5.dll(需注册)放在一个目录，5.0.38版本对应sqlite3.9。　【与ADO版本不兼容，因为cairo_Rs对字段类型是强制要求要有的，如果创建表时没有定义字段类型，则crs不能改写字段值，也不能用addnew添加记录（必须用insert into语句插入记录以确定字段类型后再addnew）】【另外crs删除与修改记录集速度非常慢，新增与读速度与ado同】 ● '绑定vsflexgrid后要同步增、删、改数据库，可在vsflexgrid1_AfterEdit事件中或增删按钮中使用代码实现 Option Explicit Dim cn As New cConnection Dim rs As New cRecordset Private Sub C1_Click() '用vsflexgrid显示 cn.OpenDB "f:\x.db" rs.OpenRecordset "select rowid,* from tb",cn Set g1.DataSource = rs.GetADORsFromContent '转为adors， 也可用cCn.CreateTableFromADORs可以把adors存为cairo_sqlite的表 ● g1.Refresh End Sub Private Sub C2_Click() '删除，修改记录，修改后要重新读入 cn.OpenDB "f:\x.db" rs.OpenRecordset "select * from tb",cn '打开rs不用判断rs的状态，也不需要关闭原连接再打开 rs.AbsolutePosition = 6 '首行为1 (与ado.rs一样) rs.MoveNext '行ID＝7，即实际对应第8行 rs.Delete '删除所在行，但如果其他行内容与当前行完全一样，则其他行也会被删除，不会报错，所以主键是必须的。(删除后指针会自动移到下一行，与ADO不同) rs.ValueMatrix(2,2) = "新值" '可以直接像单元格一样操作 rs.Fields(2) = "新新值" '原来的第7行被删除，第8行被上提，所以新值在原来的第8行 rs.UpdateBatch 'UpdateBatch自带事务启动与提交（错误时回滚） ● End Sub Private Sub C3_Click() cn.OpenDB "f:\x.db" cn.ReKey "hhh" '改密码，打开有密码的数据库用opendb的第二个参数 End Sub Private Sub createc_Click() '建新库 dim temCN as new cConnection dim temRs as cRecordset temCn.CreateNewDB '不带任何参数直接创建内存数据库，数据库创建同时已经打开 ● Set temRs = temcCcn.OpenRecordset("SELECT julianday('" & sqliteTimeStr & "')") '取sqlite用的数值型时间 t=temRs(0) Ccn.CreateNewDB cn.CreateNewDB ".\x.db" cn.OpenDB ".\x.db" cn.Execute "create table tb(a,c)" End Sub Private Sub Command4_Click() '写2000记录 Dim i& cn.OpenDB ".\x.db" cn.BeginTrans For i = 1 To 2000 cn.Execute "insert into tb values(" & i & ",'ahhoho','从未开始')" Next cn.CommitTrans End Sub ★cFSO 文件复制、删除、移动，是否存在等操作，包括打开、保存文件对话框 Dim ctr As New cConstructor Set fd = ctr.FSO() '必须用其自带的对象初始化　● fs.ShowOpenDialog(OFN_EXPLORER,"账套文件.xdb|*.xdb") 　　'和comdialog过滤格式一样 ★cThreadHandler是多线程对象，主要用于异步调用Active DLL中的对象(msgBox或acreport.showdesigner等独立进程的调用多线程将停止) Private WithEvents TH As cThreadHandler '定义多线程对象 Dim RegFree As New cRegFree '提取com dll中的对象为免注册对象 Private Const ThreadKey$ = "Thread_HelloWorld" Private Const ThreadClass$ = "cThread" Private Const ThreadLibPath$ = App.Path & "\ThreadLib.dll" Set TH = RegFree.ThreadObjectCreate(ThreadKey,ThreadLibPath,ThreadClass) '第一个参数名称可以随意，第二个和第三个参数严格区分大小写。 StrResult = TH.CallSynchronous("StringReflection","ABC") '异步执行，有返回值的 TH.CallAsync "StringReflection","ABC" '异步执行，不需要返回值的 Sub TH_MethodFinished(...) '异步执行完成产生该事件，可以在事件中对返回的Result进行进一步处理，result可以是rs等对象 sub TH_ThreadEvent(...) '响应所调用进程中的事件 ★cCrypt 是加解密、压缩相关对象 ★cDDB 可以把字节图像输出到控件，可以实现读数据库中存储的图像等 ★cTCPClient TCP客户端对象 cTCPServer TCP服务端对象 cUDP UDP连接对象 【缺点是基本不返回错误，比如端口被占用也没有任何提示】 dim withevents tcpSV as ctcpserver set tcpSV = new ctcpserver 'new关键字后会列出的对象可以使用new直接初始化 ● 'TCPServer.Listen TCPServer.GetIP("计算机名"),12345 'host必须用本机IP或计算机名，不建议使用127.0.0.1或其他名称，因为该对象的连接是根据host参数字符串决定的，host参数与主机名或IP一致时连接最快，否则客户端连接时将遍历网络以找到该名称，timeout参数不能低于找主机所需秒数。 【GetIP和GetHost两个方法不需要连接服务器或对方UDP就可以直接取值】 'TCPServer.TCPAccepted 事件表示已经接受客户端连接 'TCPServer.TCPDisConnect表示客户端连接断开，但不包括断电断网(包括强制关闭程序与正常退出) 'Dim B() As Byte '用于收发的数组 'TCPClient.SendData hSocket,VarPtr(B(0)),UBound(B) + 1 'VarPtr()是VB自带隐藏函数，用于取任何对象的内存地址● 'ReDim B(BytesTotal - 1) '*** 'TCPServer.GetData hSocket,BytesTotal 'Sub udp1_NewDatagram（）'事件中接收数据 UDP 'Dim B() As Byte 'ReDim B(BytesTotal - 1) 'udp1.GetData VarPtr(b(0)),BytesTotal 'end sub ★cRPCListener,cRPCConnection允许连接局域网的远程Active Dll(即可通过regsvr32注册的com dll) dim RPCs As new cRPCListener　　　’【Dll服务器端】 rpcs.StartServer '默认使用程序所在文件夹的RPCDlls子文件夹(不存在则创建）中的dll，端口默认22222 －－－－－－－－－－－－－－－－ Dim RPCConn As cRPCConnection '【客户端】 Private Const ServerDll$ = "vbRichClient5.dll" Private Const ServerClass$ = "cConnection" ' Set RPCConn = New cRPCConnection RPCConn.Host = "" '非本机必须设定，【在客户端中只能设定为服务器IP】 RPCConn.Port = 22222　'无默认值，必须设定 RPCConn.KeepAlive = True RPCConn.UserName = "RPCServerAdmin" '这个和下面的密码非常重要，否则无法取得服务器信息● RPCConn.password = "default" '按服务器StartServer的参数设置，默认为"default" RPCConn.Connect '连接至Host、Port属性指定的服务器，【会返回连接成功与否，可以替代cTCP用于判断连接服务器是否成功，UDP与Listen端口号相同不会产生错误】 RPCConn.RPC(ServerDll,ServerClass,"CreateNewDB","f:\tt.dd") '执行远程DLL中的函数等【类名、函数名等完全区分大小写】 Set Rs = RPCConn.RPC(ServerDll,"GetADORsFromsql",5) '可以返回对象，也可以取回属性值（但无法为属性赋值） dim conn as cRPCConnection,Status As cRPCStatusInfo,CInfo As cRPCClientInfo,i 【查RPCListener状态,RPCListener是没有事件的】 set Status=conn.GetServerStatus(True,ThreadPoolSize) 'ThreadPoolSize就是服务器的第三个参数 For Each CInfo In Status.ClientInfos SArr(i) = CInfo.IPAndPort & " " & CInfo.Status i = i + 1 Next CInfo ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- 托盘图标： 　　都是通过API实现的，对于托盘事件的响应有两种方法，一种是使用API实现回调函数（此方法较麻烦，且VB例程(网络搜集)已经介绍较详细），第二种是用设置UCallbackMessage=WM_Mousemove直接将托盘鼠标事件与Form的Mousemove事件关联，具体如下： Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long,lpData As NOTIFYICONDATA) As Long '托盘图标设置API声明 'DwMessage 为消息设置值，它可以是以下的几个常数值：0、1、2 Const NIM_ADD = 0　　　　　'加入图标到系统状态栏中 Const NIM_MODIFY = 1 　　　'修改系统状态栏中的图标 Const NIM_DELETE = 2 　　　'删除系统状态栏中的图标 'LpData 用以传入NOTIFYICONDATA数据结构变量，其结构如下所示： Type NOTIFYICONDATA 　　cbSize As Long 　　　　　　　'NOTIFYICONDATA结构的长度，值即Len(NOTIFYICONDATA) 　　HWnd As Long 　　　　　　　　'接收回调的窗口或控件句柄 　　Uid As Long　　　　　　　　　'为图标所设置的ID值，大于1248小于65535的任意数 　　UFlags As Long 　　　　　　　'通常设为 NIF_ICON Or NIF_TIP Or NIF_MESSAGE 　　UCallbackMessage As Long　　 '消息编号 　　HIcon As Long 　　　　　　　 '显示在状态栏上的图标，必须指向句柄所指对象的成员。 　　SzTip As String * 64　　　　 '提示信息，只能用定长string，所以一定要* n。 End Type '常用到的常量 Const NIF_MESSAGE = 1 '使UCallbackMessage有效 Const NIF_ICON = 2 '使图标有效 Const NIF_TIP = 4 '提示信息有效 Const WM_MouseMove=512 '设UCallbackMessage值为此，即关联Form的mousemove事件。 Const WM_Lbuttonup=514 '左键放开 Const WM_LButtondblclk=515 '左键双击(注意：放开事件必在双击事件之前出现两次) Const WM_RButtonUp=517 '右键放开 Const WM_MouseMoving=512 '鼠标移动时，其他516、518等值较少用到，这里不列 '具体示例程序如下： Private Nid As NOTIFYICONDATA '1、添加图标 　　　With Nid 　　　　.Uid = 2000 　　　　.HWnd = form.HWnd　　　'接收回调的句柄，如为pictureBox.hwnd则.hicon=picture1.picture 　　　　.cbSize = Len(nid) .SzTip = "提示文本" + chr(0) '因为sztip是定长string所以要chr(0)强制结尾符。 　　　　.HIcon = form.Icon.Handle　　　'form.Icon等效，资源指针只能指向hwnd所指控件的成员。 　　　　.UCallbackMessage = WM_Mousemove '如设为TRAY_CALLBACK则使用自定义回调函数。 　　　　.UFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE 　　　End With 　　　Shell_NotifyIcon NIM_ADD,nid 　'根据前面定义NIM_ADD，设置为“添加模式”，然后添加 '删除与修改与添加类似，只不过是将DwMessage参数值设为相应的NIM_DELETE或NIM_MODIFY。 '托盘图标事件的实现(这是重点) '在添加图标时NOTIFYICONDATA结构中UFlags必须含NIF_MESSAGE，UCallbackMessage值设为WM_Mousemove。 '在nid.hwnd所指的窗口或控件的Mousemove事件中设代码，事件的参数X的值即是托盘图标事件类型值。 Dim UCBmsg as long if Me.scalemode=3 then 'scalemode为pixel时返回的X值才对应鼠标事件常量值,否则要换算 ucbmsg=x else ucbmsg=x/screen.TwipsPerPixelX '不为pixel时换算成相当于pixel的值 end if select case ucbmsg 'Debug.print换成自己的代码即可 case 514 'WM_Lbuttonup 左键放开，相当于单击托盘图标 　debug.print "单击" case 515 'WM_LButtondblclk 左键双击，解发本事件前会产生两次左键放开事件 debug.print "双击" case 517 'WM_RButtonUp 右键放开 debug.print "右键" PopupMenu TrayIconMenu '在托盘图标上弹出菜单,TrayIconMenu为Form的菜单项 case 512 'WM_MouseMoving 在图标上移动时 debug.print "移动" '还有如516,518等相关鼠标常量值，较少用，具体查API常量表 end select ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- 'API函数WaitForSingleObject可以在指定时间内监视进程，指定时间为-1则无限监视。直到函数返回值后才执行下行代码。 '以下wait类，延时等待，不影响系统正常响应，占系统资源极少(不像定时器或API的sleep函数，窗口直接无响应) Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Const WAIT_ABANDONED& = &H80& Private Const WAIT_ABANDONED_0& = &H80& Private Const WAIT_Failed& = -1& Private Const WAIT_IO_COMPLETION& = &HC0& Private Const WAIT_OBJECT_0& = 0 Private Const WAIT_OBJECT_1& = 1 Private Const WAIT_TIMEOUT& = &H102& Private Const INFINITE = &HFFFF Private Const ERROR_ALREADY_EXISTS = 183& Private Const QS_HOTKEY& = &H80 Private Const QS_KEY& = &H1 Private Const QS_MOUSEBUTTON& = &H4 Private Const QS_MOUSEMOVE& = &H2 Private Const QS_PAINT& = &H20 Private Const QS_POSTMESSAGE& = &H8 Private Const QS_SENDMESSAGE& = &H40 Private Const QS_TIMER& = &H10 Private Const QS_MOUSE& = (QS_MOUSEMOVE Or QS_MOUSEBUTTON) Private Const QS_INPUT& = (QS_MOUSE Or QS_KEY) Private Const QS_ALLEVENTS& = (QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or QS_PAINT Or QS_HOTKEY) Private Const QS_ALLINPUT& = (QS_SENDMESSAGE Or QS_PAINT Or QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON Or QS_MOUSEMOVE Or QS_HOTKEY Or QS_KEY) Private Const UNITS = 4294967296# Private Const MAX_LONG = -2147483648# Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long,ByVal bManualReset As Long,ByVal lpName As String) As Long Private Declare Function OpenWaitableTimer Lib "kernel32" Alias "OpenWaitableTimerA" (ByVal dwDesiredAccess As Long,ByVal bInheritHandle As Long,ByVal lpName As String) As Long Private Declare Function SetWaitableTimer Lib "kernel32" (ByVal hTimer As Long,lpDueTime As FILETIME,ByVal lPeriod As Long,ByVal pfnCompletionRoutine As Long,ByVal lpArgToCompletionRoutine As Long,ByVal fResume As Long) As Long Private Declare Function CancelWaitableTimer Lib "kernel32" (ByVal hTimer As Long) Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long,ByVal dwMilliseconds As Long) As Long Private Declare Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long,pHandles As Long,ByVal fWaitAll As Long,ByVal dwMilliseconds As Long,ByVal dwWakeMask As Long) As Long Private mlTimer As Long Private Sub Class_Terminate() On Error Resume Next If mlTimer <> 0 Then CloseHandle mlTimer End Sub Public Sub Wait(MilliSeconds As Long) On Error GoTo ErrHandler Dim ft As FILETIME Dim lBusy As Long Dim lRet As Long Dim dblDelay As Double Dim dblDelayLow As Double mlTimer = CreateWaitableTimer(0,True,App.EXEName & "Timer" & Format$(Now(),"NNSS")) If Err.LastDllError <> ERROR_ALREADY_EXISTS Then ft.dwLowDateTime = -1 ft.dwHighDateTime = -1 lRet = SetWaitableTimer(mlTimer,ft,0) End If ' Convert the Units to nanoseconds. dblDelay = CDbl(MilliSeconds) * 10000# ' By setting the high/low time to a negative number,it tells ' the Wait (in SetWaitableTimer) to use an offset time as ' opposed to a hardcoded time. If it were positive,it would ' try to convert the value to GMT. ft.dwHighDateTime = -CLng(dblDelay / UNITS) - 1 dblDelayLow = -UNITS * (dblDelay / UNITS - Fix(CStr(dblDelay / UNITS))) If dblDelayLow < MAX_LONG Then dblDelayLow = UNITS + dblDelayLow ft.dwLowDateTime = CLng(dblDelayLow) lRet = SetWaitableTimer(mlTimer,False) Do ' QS_ALLINPUT means that MsgWaitForMultipleObjects will ' return every time the thread in which it is running gets ' a message. If you wanted to handle messages in here you could,' but by calling Doevents you are letting DefWindowProc ' do its normal windows message handling---Like DDE,etc. lBusy = MsgWaitForMultipleObjects(1,mlTimer,False,INFINITE,QS_ALLINPUT&) DoEvents Loop Until lBusy = WAIT_OBJECT_0 ' Close the handles when you are done with them. CloseHandle mlTimer mlTimer = 0 Exit Sub ErrHandler: Err.Raise Err.Number,Err.Source,"[clsWaitableTimer.Wait]" & Err.Description End Sub ----------------------------------------------- '字符串可互逆加密 Private Function NumericPassword(ByVal password As String) As Long '*****************供加解密程序使用的私有过程 Dim value As Long Dim ch As Long Dim shift1 As Long Dim shift2 As Long Dim I As Integer Dim str_len As Integer str_len = Len(password) For I = 1 To str_len ' Add the next letter. ch = Asc(Mid$(password,I,1)) value = value Xor (ch * 2 ^ shift1) value = value Xor (ch * 2 ^ shift2) ' Change the shift offsets. shift1 = (shift1 + 7) Mod 19 shift2 = (shift2 + 13) Mod 23 Next I NumericPassword = value End Function Function JiaM(OldText$,MM$) As String '*****************加密 ，使用JieM还原，这两个过程可以对调使用，对汉字无效，　　大小写敏感 Dim cipher_text As String Const MIN_ASC = 32 ' Space. Const MAX_ASC = 126 ' ~. Const NUM_ASC = MAX_ASC - MIN_ASC + 1 Dim offset As Long Dim str_len As Integer Dim I As Integer Dim ch As Integer ' Initialize the random number generator. offset = NumericPassword(MM) Rnd -1 Randomize offset ' Encipher the string. str_len = Len(OldText) For I = 1 To str_len ch = Asc(Mid$(OldText,1)) If ch >= MIN_ASC And ch <= MAX_ASC Then ch = ch - MIN_ASC offset = Int((NUM_ASC + 1) * Rnd) ch = ((ch + offset) Mod NUM_ASC) ch = ch + MIN_ASC cipher_text = cipher_text & Chr$(ch) End If Next I JiaM = cipher_text End Function Function JieM(WaitJie$,MM$) '****************解密 与JiaM互逆 ，对汉字无效，　　大小写敏感 Dim plain_text As String ' Decipher mm,waitjie,plain_text 'ByVal password As String,ByVal from_text As String,to_text As String) Const MIN_ASC = 32 ' Space. Const MAX_ASC = 126 ' ~. Const NUM_ASC = MAX_ASC - MIN_ASC + 1 Dim offset As Long Dim str_len As Integer Dim I As Integer Dim ch As Integer ' Initialize the random number generator. offset = NumericPassword(MM) Rnd -1 Randomize offset ' Encipher the string. str_len = Len(WaitJie) For I = 1 To str_len ch = Asc(Mid$(WaitJie,1)) If ch >= MIN_ASC And ch <= MAX_ASC Then ch = ch - MIN_ASC offset = Int((NUM_ASC + 1) * Rnd) ch = ((ch - offset) Mod NUM_ASC) If ch < 0 Then ch = ch + NUM_ASC ch = ch + MIN_ASC plain_text = plain_text & Chr$(ch) End If Next I JieM = plain_text End Function -------------------------------------- 分类计算方法 1、不同类用不同的表，对表编号并顺序排列。（类别太多表用的多，一般只在手工时采用。） 2、流水记录表＋结果记录表　（需两张表，速度较快，但不易对以前记录动态结存。） 3、类名＋时间（等顺序信息）--排序--判断并动态更新结存列（一张表完成，但速度慢） -------------------------------------- 排序方法 1、有多少数据，“容器序列”就设多长 找出所有数据中最大/最小的，放在a1，删除该数据，再找放入a2...依此类推。 2、判断并逐个将数据插入“容器序列”中 a1=数1 用数n与现有数组逐个比较（数2之后的当前数据用“数n”表示，“a末”表示当前最后1个容器。） 如果数n＜a1，插到最前，如果数n＞＝a末，插在最后，如果数n＞＝an且数n<an+1,则插入数n在an。 -------------------------------------- ntsd -c q -pn 程序名.exe可以结束程序，也可以-p参数结束PID。 '用API结束进程 'TerminateProcess用于结束内部或外部进程（常因权限不够返回0结束外部进程失败），CloseWindow用于最小化窗口，ExitProcess一般用于结束自身进程，关闭msgBox可以用sendmessage例如下： Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String,ByVal lpWindowName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long,ByVal wMsg As Long,ByVal wParam As Long,lParam As Any) As Long Private Const WM_CLOSE = &H10 FindWindow("#32770","提示窗口标题") SendMessage WHandle,WM_CLOSE,0 '发送消息让窗口关闭。　#32270是msgBox的类名，类或标题设为VbNullString表示任意名。 由于VB应用本身是单线程的，Timer控件也是假多线程，当程序大量运算或交由外部对象时，线程很可能被这些程序控制，直到这些程序结束，才会继续Timer，所以FindWindow等API要另外放在一个单独的程序文件中才能不被自身影响。 要实现对各线程的监控，可以使用SetWindowsHookEx()等API设置hook，给系统或程序下勾子，以实现事件中断等拦截和改变。 -------------------------------------- 对象跟着鼠标走 在对象的鼠标按下事件中加入对象.投递消息(161,0) 对象就会贴在鼠标下边直到放开 或 在_对象_鼠标左键被按下时调用对象.发送消息(161,0) -------------------------------------- 组合框弹出与缩回 组合框1.发送信息 (335,0) 组合框弹出项目　　　 组合框1.发送信息 (335,0)　　　　缩回弹出项目 -------------------------------------- DOS、批命令及注册表 新建“文本文档”，编辑批命令然后改扩展名为.bat（可成批执行DOS命令，有一定编程语句），保存为.reg文件可以修改注册表第一行写windows registry editor version 5.0（win98的等一行写 regedit4）[项路径]直接增加路径项　[-项路径]删除该路径最后指的项　[项路径] "键值"=""增加或修改键值 "键值"=-删除该键值 '基本dos命令，通过win+R键的运行执行：cmd调出dos窗口。 cd 将当前目录指定到 “..”表示上级目录，“.”表示当前目录，\\serverName是局域网服务器根目录，\局网及本地目录分割符，//是WWW网 rd 删除目录 dir 显示目录中的文件和目录，【可以用< > >> 文件重定向符把结果输出到指定文件，>输出到文件并覆盖原文件 >>追加到文件 】 del *.*　删除文件 *和?文件通配符 *是任意个字符?是一个任意字符 md 建立目录 copy 路径\文件名 路径\文件名 ：把一个文件拷贝到后面指定的第二个路径中，通配符一样 move 路径\文件名 路径\文件名 ：把一个文件移动（就是剪切+复制） type 文件名 显示文件内容 deltree 删除文件夹和它下面的所有子文件夹还有文件，厉害。。。不要乱用。 xcopy /s 复制文件夹中所有文件和子文件夹中的所有文件。/e 复制文件的目录结构完全一样的复制方法。 ftp -v -d -i -n -g [主机名] 这个命令内容较多，请参考命令说明 ftp://... 访问ftp服务器...表示IP地址 ping 主机ip或名字 Ipconfig /all 查看当前IP及网关设置信息 NETSTAT 显示IP、TCP、UDP、ICMP等协议信息，端口占用情况，连接等 Net 很重要命令，有很多子命令（包括网络及共享设置访问，用户设置等） ROUTE 路由器配置 telnet---登陆到远程的计算机去，很强大的命令 At 安排等待执行某个命令 ::命令后面带 /?参数，就可以显示命令用法 regedt32-------注册表编辑器 gpedit.msc-----组策略 services.msc---本地服务设置 explorer-------打开资源管理器 calc-----------启动计算器 dxdiag---------检查DirectX信息 mem.exe--------显示内存使用情况 winver---------检查Windows版本 devmgmt.msc--- 设备管理器 secpol.msc-----本地安全策略 syskey---------系统加密，一旦加密就不能解开，保护windows xp系统的双重密码 '增加管理员账户（win10默认是不显示管理员账户的） net user administrator /active:yes '登录显示管理员账户(administrators是管理员用户组，参数最后改成no就可以关闭管理员账户) '文件夹权限设置 cacls f:\mp3 /g everyone:F ::这个命令是设置“安全权限”，对本地有效，远程访问以此权限优先于“共享权限”，XP中仅设这个权限即可 ::设置c:\temp目录所有人只读，然后把这个目录net share出来就是所有人只读了（安全权限优先） :: /T 更改当前目录及其所有子目录中 ::/G user:perm 赋予指定用户访问权限。（Perm 可以是: R读取 W写入 C更改(写入) F完全控制 ） ::/P user:perm 替换指定用户的访问权限 ::/R user 撤销指定用户的访问权限(仅在与 /E 一起使用时合法) Attrib \dirname -r +h /s ::/s是包含子文件夹中的　“-”号是取消，“＋”号是设置 r是只读h是隐藏s是系统A是存档 '批命令共享文件夹 net share mp3$=f:\mp3 /unlimited /grant:everyone,full :: net share mp4$=d:\mp4 /USERS:10 :: 【共享名后面加$，表示不显示在网上邻居列表中(只能通过完整路径访问如：\\SERVER\mp3$)，不加$则能显示出来。】 ::/unlimited 指定可以同时访问共享资源的、数量不受限制的用户。 ::/delete 停止共享资源 ::/users:number 限制用户数 ::【/grant:everyone,full winNT,win7要设置这个参数权限，xp此参数无效】 :: 当不带选项使用此命令时，它会列出该计算机上正在被共享的所有资源 ::批命令前两个冒号是解释语句，前面@号是不在DOS窗口显示命令执行过程。 ::“%” 批处理变量引导符 ::“:” 批处理过程标识符 %0 表示批处理命令文件本身的完整路径（含文件名），所以如果单独用%0做语句，会无限执行批命令... %1 %2 %3...指调用批命令时后带的参数，如：批命令文件为f.bat，执行dos命令 f xxx，那么%1=xxx %CD% === 当前路径 current directory %SystemRoot% === C:\WINDOWS (%windir% 同样) %ProgramFiles% === C:\Program Files %USERPROFILE% === C:\Documents and Settings\Administrator (子目录有“桌面”,“开始菜单”,“收藏夹”等) %APPDATA% === C:\Documents and Settings\Administrator\Application Data %TEMP% === C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp (%TEM% 同样) %APPDATA% === C:\Documents and Settings\Administrator\Application Data %OS% === Windows_NT (系统) %Path% === %SystemRoot%\system32;%SystemRoot%;%SystemRoot%\System32\Wbem (原本的设置) %HOMEDRIVE% === C: (系统盘) %HOMEPATH% === \Documents and Settings\Administrator Echo 命令 off 或 on 或　要显示的信息，用于打开回显或关闭请求回显功能，或显示消息 自定义变量 set var=我的变量 echo %var% ::这是自定义变量的定义和调用最简单例子，set命令可加参数/p表示要求用户输入变量值如：set /p var=xxx 执行多个命令时用括号括起来，命令间用&连接 for命令用法 FOR 参数 %%变量名 IN (相关文件或命令) DO 执行的命令 参数:FOR有4个参数 /d仅为目录 for /d %%i in (*) do @echo %%i 把C：要目录下的目录显示出来 /r包含子目录和文件 for /r c:/ %%i in (*.exe) do @echo %%i把C盘根目录,和每个目录的子目录下面全部的EXE文件都列出来了,这里的c:/就是目录了。 /f 文件 for %%i in (c:\t*.*) do echo %%i --显示c:\t*.*相匹配的文件(只显示文件名，不显示路径) /L数值范围，格式为 for /L %%Variable in (Start#,Step#,End#) 如： for /l %%xxx in (1,9)则xxx依次从1-4-7 %%变量名 :这个变量名可以是小写a-z或者大写A-Z,他们区分大小写,FOR会把每个读取到的值给他 if命令用法 if "字符串1"=="字符串2" 命令 else　命令 ::也可以写成 if 条件 命令，当条件为真，则执行 if 数值1 equ 数值2 命令　::equ是较两数值是否相等 gtr大于　geq大等于 lss小于 leq小等于 neq不等于 if defined str 命令 ::如果变量已经定义，或赋值则执行命令 Goto 命令 指定跳转到标签，找到标签后，程序将处理从下一行开始的命令。 语法：goto label （label是参数，指定所要转向的批处理程序中的行。） Sample： if %1 ==a goto noparms if %2==f: goto noparms @Rem check parameters if null show usage :noparms echo Usage: monitor.bat ServerIP PortNumber goto end if exist command device 是指DOS系统中已加载的设备,在win98下通常有: AUX,PRN,CON,NUL COM1,COM2,COM3,COM4 LPT1,LPT2,LPT3,LPT4 XMSXXXX0,EMMXXXX0 A: B: C: ...,CLOCK$,CONFIG$,DblBuff$,IFS$HLP$ 具体的内容会因硬软件环境的不同而略有差异,使用这些设备名称时,需要保证以下三点: 1. 该设备确实存在(由软件虚拟的设备除外) 2. 该设备驱动程序已加载(aux,prn等标准设备由系统缺省定义) 3. 该设备已准备好(主要是指a: b: ...,com1...,lpt1...等) 可通过命令 mem/d | find "device" /i 来检阅你的系统中所加载的设备 另外,在DOS系统中,设备也被认为是一种特殊的文件,而文件也可以称作字符设备; 因为设备(device)与文件都是使用句柄(handle)来管理的,句柄就是名字,类似于文件名,只不过句柄不是应用于磁盘管理,而是应用于内存管理而已,所谓设备加载也即指在内存中为其分配可引用的句柄. -------------------------------------- 【较大数值运算一般整数部分与小数部分开算，使用整型或变体型，小数超过4位用“变体=Cdec(数值)”来运算，format(val,"#.##")也可控制精确到哪位小数】! “! Single 单精度实际有效位数含整数与小数部分共7位”、“# Double双精度型实际有效15位” 计算精度不高（计算机二进制转十进制造成的,就像3进制常常无法精确表示10进制）而且不同精度一起计算时会出错，以下是产生错误的例子： Dim i,j As Single,e '如果j为变体或货币型都不会出错。 e = 16280 For i = 10430 To 11630 Step 10 '如果10430和11630是由公式计算出来的，就会很明显的看出10860*1.5=16289.9987053871这样的错误 For j = 1.4 To 1.56 Step 0.01 If i * j >= e And i * j < e + 10 Then List1.AddItem i & " * " & j & "=" & i * j & CStr(i * j < 16290) '错误看10860*1.5这行 Next Next '这个错误是因为“大数”和“小数”混合运算产生错误，如果j为Double型，以上运算则正确，但大数小数混合运算还是很容易超过Double精度，到时还是会错。 Dim a As Single,b As Single,c As Double,d As Single a = 1.1 b = 1.1 c = a + b d = a + b Debug.Print c,d 'c结果是2.20000004768372 d结果是2.2，这是因为VB中只要有精度转换就会错，解决方法是用相同的类型或用变体型。 VB还有个很白痴的问题 t=300*200 不论t是哪种数值类型都会“溢出”，只能 t=300# * 200 解决，或将300与200都放入变体型或货币型变量中。 ---------------------------------------------------------------- 编程对英文有一定要求：比如：without一般指“如果没有”，No没有，Not不是，Empty空，Void无，source来源，root根源 编程对算法有一定要求：比如：过程对自身的调用叫递归（有可能形成死循环） ---------------------------------------------------------------- '数据库用模块配置 Public Wjm$ '数据库文件名 Public MM$ '账套文件密码 (一般用JiaM("实际账套密码","加密算法用密码")函数处理后的值放在内存中，用时再用JieM()还原。) Public jMM$ '用于jieM()、jiaM()的第二个参数的加解密密码 '---------------- Public Wlb As Boolean '网络版登录时必须为止变量赋值true Public Ztml$ '账套目录 (sqlite网络版用)，为""则数据库未共享 public CnCursorType% '数据库连接游标类型 ★ADO必须设置cn游标类型★ public qLjwb() '用文件名、密码和jMM取共用连接文本 Public Cn As New ADODB.Connection '或者cConnection，用于全程序共用数据库读操作。 public dqH&,dqL&,dqH1&,dqL1 '当前行，当前列，当前行1(选取结束位置)，当前列1 '---------------- Public CC As New cConstructor '用于cairo部分控件初始化 Public FS As cFSO '用于各类文件、文件夹操作（带对话框） Public RPCCon As cRPCConnection,RPCState As cRPCStatusInfo '用于RPC远程连接执行com对象 public cTcpC as cTCPClient,cTcpS as cTCPServer,RPCUDP As New cUDP '用于取代winsock ---------------------------常用局部变量： a,c字符 x,y,z数值 i,k用于循环------------------------------------- 绿色软件 不打包成安装程序，在程序首次运行时将msvbvm60.dll,*.ocx等用到的ActiveX Dll/OCX复制到系统目录然后注册。 原文链接：https://www.f2er.com/vb/257025.html