我收藏的一些源代码
xml格式的,用空格替代 chr(13)代替<br>
<数据>
<名称>读写INI文件的四个函数</名称>
<类别>VB文件</类别>
<数据来源>自己制作</数据来源>
<来源时间>2002-01-04 19:17:00</来源时间>
<保存时间>2002-01-06 02:43:28</保存时间>
<删除>False</删除>
<删除时间>2002-01-09 23:57:09</删除时间>
<关键字1>INI</关键字1>
<关键字2>函数</关键字2>
<关键字3 />
<内容简介 />
<内容>'文件名SourceDB.ini文件<br> Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long<br> Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long<br> <br> '以下两个函数,读/写ini文件,固定节点setting,in_key为写入/读取的主键<br> '仅仅针对是非值<br> 'Y:yes,N:no,E:error<br> Public Function GetIniTF(ByVal In_Key As String) As Boolean<br> On Error GoTo GetIniTFErr<br> GetIniTF = True<br> Dim GetStr As String<br> GetStr = VBA.String(128, 0)<br> GetPrivateProfileString "Setting", In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"<br> GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")<br> If GetStr = "1" Then<br> GetIniTF = True<br> GetStr = ""<br> Else<br> GoTo GetIniTFErr<br> End If<br> Exit Function<br> GetIniTFErr:<br> Err.Clear<br> GetIniTF = False<br> GetStr = ""<br> End Function<br> <br> Public Function WriteIniTF(ByVal In_Key As String, ByVal In_Data As Boolean) As Boolean<br> On Error GoTo WriteIniTFErr<br> WriteIniTF = True<br> If In_Data = True Then<br> WritePrivateProfileString "Setting", In_Key, "1", App.Path & "\SourceDB.ini"<br> Else<br> WritePrivateProfileString "Setting", In_Key, "0", App.Path & "\SourceDB.ini"<br> End If<br> Exit Function<br> WriteIniTFErr:<br> Err.Clear<br> WriteIniTF = False<br> End Function<br> <br> <br> '以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键<br> '针对字符串值<br> '空值表示出错<br> Public Function GetIniStr(ByVal AppName As String, ByVal In_Key As String) As String<br> On Error GoTo GetIniStrErr<br> If VBA.Trim(In_Key) = "" Then<br> GoTo GetIniStrErr<br> End If<br> Dim GetStr As String<br> GetStr = VBA.String(128, 0)<br> GetPrivateProfileString AppName, In_Key, "", GetStr, 256, App.Path & "\SourceDB.ini"<br> GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")<br> If GetStr = "" Then<br> GoTo GetIniStrErr<br> Else<br> GetIniStr = GetStr<br> GetStr = ""<br> End If<br> Exit Function<br> GetIniStrErr:<br> Err.Clear<br> GetIniStr = ""<br> GetStr = ""<br> End Function<br> <br> Public Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean<br> On Error GoTo WriteIniStrErr<br> WriteIniStr = True<br> If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then<br> GoTo WriteIniStrErr<br> Else<br> WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "\SourceDB.ini"<br> End If<br> Exit Function<br> WriteIniStrErr:<br> Err.Clear<br> WriteIniStr = False<br> End Function</内容>
</数据>
- <数据>
<名称>如何取得计算机名</名称>
<类别>VBAPI</类别>
<数据来源>yesky</数据来源>
<来源时间>2001-11-24 22:09:12</来源时间>
<保存时间>2002-01-05 22:14:41</保存时间>
<删除>False</删除>
<删除时间>NULL</删除时间>
<关键字1>API</关键字1>
<关键字2>计算机名</关键字2>
<关键字3>取得</关键字3>
<内容简介>NULL</内容简介>
<内容>程序说明: <br> <br> 这个程序比较简单,大家自己看吧 <br> <br> 计算机名就是你打开 控制面板-系统-网络标识-完整的计算机名称 <br> <br> 程序代码: <br> <br> <br> <br> Form1 <br> <br> Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long <br> <br> Private Sub Command1_Click()<br> Dim Name As String, Length As Long <br> <br> Length = 225<br> Name = String(Length, Chr(0))<br> GetComputerName Name, Length<br> Name = Left(Name, Length)<br> Label1.Caption = Name <br> <br> End Sub <br> <br> Private Sub Form_Load() <br> <br> End Sub</内容>
</数据>
- <数据>
<名称>计算Windows从启动后所运行的总时间</名称>
<类别>VBAPI</类别>
<数据来源>yesky</数据来源>
<来源时间>2001-11-24 22:09:12</来源时间>
<保存时间>2002-01-10 15:03:09</保存时间>
<删除>False</删除>
<删除时间>NULL</删除时间>
<关键字1>API</关键字1>
<关键字2>运行</关键字2>
<关键字3>时间</关键字3>
<内容简介 />
<内容>利用Api函数计算Windows从启动后所运行的总时间 <br> <br> Private Declare Function GetTickCount Lib "kernel32" () As Long<br> <br> Private Sub Timer1_Timer()<br> Dim hour As Integer<br> Dim minute As Integer<br> Dim second As Integer<br> hour = GetTickCount \ 1000 \ 60 \ 60<br> Label1.Caption = Str(hour) + "小时"<br> <br> minute = (GetTickCount - hour * 60 * 60 * 1000) \ 1000 \ 60<br> Label2.Caption = Str(minute) + "分钟"<br> <br> second = (GetTickCount - Val(Label1.Caption) * 60 * 60 * 1000 - Val(Label2.Caption) * 60 * 1000) \ 1000<br> Label3.Caption = Str(second) + "秒钟"<br> End Sub</内容>
</数据>
- <数据>
<名称>使窗体右上角的X按钮失效</名称>
<类别>控件特效</类别>
<数据来源 />
<来源时间>NULL</来源时间>
<保存时间>2002-01-08 18:13:01</保存时间>
<删除>False</删除>
<删除时间>NULL</删除时间>
<关键字1>API</关键字1>
<关键字2>窗体</关键字2>
<关键字3>失效</关键字3>
<内容简介 />
<内容>窗体右上角的X按钮通常用来关闭一个程序,这个小X按钮实际上是和系统菜单的“关闭”菜单项关联在一起的,什么?不知道什么是系统菜单,系统菜单是指我们点击窗体左上角的小图标时所弹出的菜单,其中好象有“恢复”、“移动”、“最大化”、“最小化”、“关闭”这么几个按钮。这个菜单用普通的方法是不能编辑和改变的,但是我们可以通过API函数GetSystemMenu来得到它的句柄,然后通过菜单相关的API函数就能改变它了,下面一起看看怎么做吧。 <br> <br> 为了学习方便,下面先给出源码,并且已经作了详细的中文注释: <br> <br> 程序说明:<br> 本例利用API函数GetSystemMenu得到系统菜单的句柄<br> X按钮是系统菜单的一菜单项,然后用RemoveMenu函数<br> 删去这一菜单项,也就是使X按钮失效了。<br> -------------------------------------------<br> 【VB声明】 <br> <br> Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long <br> <br> <br> 【说明】<br> 取得指定窗口的系统菜单的句柄。在vb环境,“系统菜单”的正式名称为“控制菜单”,即单击窗口左上角的控制框时出现的菜单 <br> <br> 【返回值】<br> Long,如执行成功,返回系统菜单的句柄;零意味着出错。如bRevert设为TRUE,也会返回零(简单的恢复原始的系统菜单) <br> <br> 【备注】<br> 在vb里使用:系统菜单会向窗口发送一条WM_SYSCOMMAND消息,而不是WM_COMMAND消息 <br> <br> 【参数表】<br> hwnd ----------- Long,窗口的句柄 <br> <br> bRevert -------- Long,如设为TRUE,表示接收原始的系统菜单 <br> <br> Private Declare Function GetSystemMenu Lib "user32" ( _<br> ByVal hwnd As Integer, _<br> ByVal bRevert As Integer _<br> ) As Integer <br> <br> 【VB声明】 <br> <br> Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long <br> 【说明】<br> 删除指定的菜单条目。如删除的条目属于一个弹出式菜单,那么这个函数不会同时删除弹出式菜单。首先应该用GetSubMenu函数取得弹出式菜单的句柄,再在以后将其删除 <br> <br> 【返回值】<br> Long,非零表示成功,零表示失败。会设置GetLastError <br> <br> 【备注】 <br> 强烈建议大家使用vb菜单的visible属性从菜单中删除条目,而不要用这个函数,否则会造成指定菜单中其他菜单条目的visible属性对错误的菜单条目产生影响 <br> <br> 【参数表】<br> hMenu ---------- Long,菜单的句柄 <br> <br> nPosition ------ Long,欲改变的菜单条目的标识符。如在wFlags参数中指定了MF_BYCOMMAND,这个参数就代表欲改变的菜单条目的命令ID。如设置的是MF_BYPOSITION,这个参数就代表菜单条目在菜单中的位置(第一个条目的位置为零) <br> <br> wFlags --------- Long,常数MF_BYCOMMAND或MF_BYPOSITION,取决于nPosition参数<br> <br> <br> <br> Private Declare Function RemoveMenu Lib "user32" ( _<br> ByVal hMenu As Integer, _<br> ByVal nPosition As Integer, _<br> ByVal wFlags As Integer _<br> ) As Integer <br> <br> Private Sub Command1_Click()<br> Unload Me<br> End Sub <br> <br> Private Sub Form_Load()<br> Dim R As Integer<br> MyMenu = GetSystemMenu(Me.hwnd, 0)<br> RemoveMenu MyMenu, &HF060, R<br> End Sub <br> <br> <br> 程序中用到了两个API函数GetSystemMenu、RemoveMenu,其中GetSystemMenu函数用来得到系统菜单的句柄,RemoveMenu用来删除指定的菜单条目,我们先来看看这个函数的声明和参数:<br> <br> Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long <br> <br> Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long <br> 其中各GetSystemMenu参数的意义如下表: <br> <br> 参数 意义 <br> hwnd Long 系统菜单所在窗口的句柄 <br> bRevert Long 如设为TRUE,表示恢复原始的系统菜单 <br> 返回值 Long 如执行成功,返回系统菜单的句柄;零意味着出错。如bRevert设为TRUE,也会返回零(简单的恢复原始的系统菜单) <br> <br> 而RemoveMenu参数的意义如下表: <br> <br> 参数 意义 <br> hMenu Long 菜单的句柄 <br> nPosition Long 欲改变的菜单条目的标识符。如在wFlags参数中指定了MF_BYCOMMAND,这个参数就代表欲改变的菜单条目的命令ID。如设置的是MF_BYPOSITION,这个参数就代表菜单条目在菜单中的位置(第一个条目的位置为零) <br> wFlags Long 常数MF_BYCOMMAND=&H0&或MF_BYPOSITION=&H400&,取决于nPosition参数 <br> 返回值 Long,非零表示成功,零表示失败 <br> <br> 然后就可以在程序中使用这两个函数了,我们在窗体的Form_Load()过程中加入如下代码: <br> <br> MyMenu = GetSystemMenu(Me.hwnd,0) 得到系统菜单的句柄,Me.hwnd表示当前窗体的句柄 <br> <br> RemoveMenu MyMenu, &HF060, MF_BYCOMMAND 移去“关闭”菜单项,&HF060“关闭”菜单项的命令ID <br> <br> 接着我们运行程序,看看窗体右上角的X按钮是不是已经不可点击了,系统菜单中的“关闭”项也消失了,很有趣,不过一定记着为程序留一个“退出”按钮哦!</内容>
</数据>
- <数据>
<名称>动态改变及恢复屏幕设置下</名称>
<类别>VBAPI</类别>
<数据来源>NULL</数据来源>
<来源时间>NULL</来源时间>
<保存时间>2002-01-05 22:25:20</保存时间>
<删除>False</删除>
<删除时间>NULL</删除时间>
<关键字1>API</关键字1>
<关键字2>屏幕设置</关键字2>
<关键字3>动态</关键字3>
<内容简介>NULL</内容简介>
<内容>三、在工程窗体中,加入两个按钮Command1和Command2,其Caption属性分别为“800x600x16”和“恢复原设置”。 <br> <br> 其程序代码为: <br> <br> 窗口的“通用|声明”区 <br> <br> <br> <br> Option Explicit<br> Dim H, V, Color As Long <br> <br> 声名变量,用于保存最初屏幕设置<br> Private Sub Form_Load()<br> ---------------以下代码用于得到最初的屏幕设备--------------<br> <br> <br> <br> H = GetDeviceCaps(Form1.hdc, HORZRES)<br> V = GetDeviceCaps(Form1.hdc, VHORZRES)<br> Color = GetDeviceCaps(Form1.hdc, BITSPIXEL)<br> End Sub <br> <br> Private Sub Command1_Click() <br> <br> 调用SetDispMode函数改变屏幕设置<br> <br> <br> <br> SetDispMode 800, 600, 16<br> End Sub <br> <br> Private Sub Command2_Click() <br> <br> 恢复最初屏幕设置<br> <br> SetDispMode Cint(H), Cint(V), Cint(Color)<br> End Sub <br> <br> 四、将程序编译执行。 <br> <br> 本程序执行后,如果单击Command1,则您的计算机屏幕显示模式将被设置为“800x600x16”的显示模式;如果单击Command2, 则您的计算机屏幕显示模式将被设置为原来的显示模式。此程序稍加修改,即可放置于桌面或任务栏中,直接快捷的修改屏幕设置。</内容>
</数据>