1、利用Api函数计算Windows从启动后所运行的总时间
Function long GetTickCount() Library "kernel32.dll" //获取windows从启动开始的总微秒数
窗口w_example的open事件：
timer(0.05)//触发timer事件
窗口的timer事件：
long hour , minute ,second
hour = GetTickCount() / 1000 / 60 / 60//获取小时数
st_1.text = String(hour) + "小时"
minute = (GetTickCount() - hour * 60 * 60 * 1000) / 1000 / 60//获取分钟数
st_2.text = Str(minute) + "分钟"
second = (GetTickCount() - long(st_1.text) * 60 * 60 * 1000 - long(st_2.text) * 60 * 1000) / 1000//获取总秒数
st_3.text = String(second) + "秒钟"
2、GetSystemMetrics函数
Function long GetSystemMetrics (long nIndex ) Lib “user32.dll”
其中nIndex的不同取值可以使该函数实现不同的功能。例如返回Win桌面中各种显示单元的宽度和高度、是否安装鼠标、是否调换了鼠标左右键的定义等。
当nIndex = 67（SM_CLEANBOOT）时，该函数的返回值表示Windows9x的当前运行模式。
在以下的示例中我们可以看到GetSystemMetrics函数的用法和作用。
首先在窗口w_example中定义实例变量：
Public Constant long SM_CLEANBOOT = 67 定义外部函数引用声明：
Function long GetSystemMetrics (long nIndex ) Lib “user32.dll”
在窗口w_example中添加static text控件st_1和commandbutton控件 Cb_1，设置如下代码：
cb_1.clicked:
choose case GetSystemMetrics(SM_CLEANBOOT)
Case 0
st_1.text=“系统运行于正常模式”
Case 1
st_1.text=“系统运行于安全模式”
Case 2
st_1.text=“系统运行于网络环境下的安全模式”
end choose
3、获取磁盘分区大小（支持大的分区)
type large_integer from structure
unsignedlong lowpart
unsignedlong highpart
end type//定义能够保存64位整形的结构
定义外部函数引用声明
Function long GetDiskFreeSpaceExA(ref string lpRootPathName, ref large_integer lpFreeBytesAvailableToCaller,ref large_integer lpTotalNumberOfBytes, ref large_integer lpTotalNumberOfFreeBytes) Library "kernel32.dll"
api函数解析：
lpRootPathName String ，不包括卷名的磁盘根路径名
lpFreeBytesAvailableToCaller LARGE_INTEGER，指定一个变量，用于容纳调用者可用的字节数量
lpTotalNumberOfBytes LARGE_INTEGER ，指定一个变量，用于容纳磁盘上的总字节数
lpTotalNumberOfFreeBytes LARGE_INTEGER，指定一个变量，用于容纳磁盘上可用的字节数
实现代码解析：
public function double of_get_drive_totalspace (string as_drive);/*函数作用:获取指定的驱动器的空间大小
参数:as_drive string 驱动器名
返回值:real */
Double ld_capacity
any ia_pass
if right(as_drive,1)<>":" then
as_drive=as_drive+":"
end if//判断传递的驱动器参数的最后一个字符是否为":"
LARGE_INTEGER lngFreeCaller,lngTotal,lngTotalFree//定义结构的三个变量
GetDiskFreeSpaceExA(as_drive, lngFreeCaller, lngTotal, lngTotalFree)//调用api函数获取对应的分区信息
IF lngTotal.Highpart > 0 THEN
ld_capacity = ( lngTotal.Highpart * 1.0 * 4294967295 ) +lngTotal.LowPart
ELSE
ld_capacity = lngTotal.LowPart
END IF//进行对应的结构变量转化为double类型并返回
return ld_capacity
4、用API函数控制光驱的开关
使用API函数CDdoor 来控制光驱门的开和关程序十分简单，由于 CDdoor 函数自身包含了对异常错误的处理机制，因此这个程序的通用性很高，你可以把这段代码移植到你的程序中，实现某些多媒体播放器所常用的开关光驱的功能。
以下是源代码：
// -------------------------------------------
// 利用API函数控制光驱的开和关
// -------------------------------------------
// 程序说明：
// 本例使用API函数 CDdoor 来控制光驱门的开和关
// 程序十分简单，由于 CDdoor 函数自身包含了对异常
// 错误的处理机制，因此这个程序的通用性很高，你可
// 以把这段代码移植到你的程序中，实现某些多媒体播
// 放器所常用的开关光驱的功能。
// -------------------------------------------
说明：CDdoor函数是安装WINDOWS时所自带的winmm.dll文件中包含的函数
定义外部函数引用声明：
Declare Function long CDdoor( string lpstrCommand , string lpstrReturnString, long uReturnLength , long hwndCallback ) Libraray "winmm.dll" Alias for "mciSendStringA"
定义实例变量：
boolean CDOpen // CDOpen用来标示光驱开与关的状态
w_example的cb_1的clicked事件：
//如果关闭则打开，并且按钮做相应变化
If CDOpen = False Then
CDdoor("set CDAudio door open", "0", 0, 0)
CDOpen = True
Cb_1.text = "点击关闭光驱"
Else
//否则关闭
CDdoor("set CDAudio door closed", "0", 0, 0)
CDOpen = False
Cb_1.text = "点击打开光驱"
End If
w_example的open事件：
CDOpen = False
CDdoor("set CDAudio door closed", "0", 0, 0)
相关api函数解析：
CDdoor函数是安装WINDOWS时所自带的winmm.dll文件中包含的函数，我们只须先加入如下的声明后就能引用这个API函数：
Function long CDdoor( string lpstrCommand , //String，这是控制命令参数
string lpstrReturnString , // String，这是返回值
long uReturnLength, //Long，返回值长度参数
long hwndCallback ) Librara y "winmm.dll" Alias for "mciSendStringA"
引用的语法是CDdoor("set CDAudio door closed", "0", 0, 0)//用以关闭光驱门
CDdoor("set CDAudio door open", "0", 0, 0)//用以打开光驱门
程序解析：
程序中使用了一个布尔型变量来标示当前光驱门开与关的状态。
如果配合检测光驱是否存在的函数一起使用，此程序的通用性会更高。而关于检测驱动器信息的函数请参看 GetDriveType，GetLogicalDrives这两个api函数的用法。
5、使用文件的默认的打开方式
许多应用程序都需要通过默认的打开方式来打开一些文档。在某些情况下，你的应用程序可能需要显示像HTML或者RTF这样的文件。但是我们如何知道哪个应用程序与这些文件建立了关联关系呢？幸好，Windows API提供给我们使文档显示在其默认的程序里的方法。
我们可以通过Windows shell.方法使用ShellExecute API函数来加载文档。这个函数将自动的来判断文件的默认打开方式，并用默认的打开方式来开启文档。
以下就是ShellExecute函数的声明：
Function long ShellExecuteA (long hWnd As Long, string lpOperation , string lpFile , string lpParameters, string lpDirectory , long nShowCmd ) Library "shell32.dll"
Constant long SW_SHOWNORMAL = 1
Constant long SW_HIDE = 0
我们将结合下面的例子来解释该API函数的主要参数的意义。
string ls_temp
setnull(ls_temp)
ShellExecute(handle(this), "Open", "c:/mypage.html", ls_temp, ls_temp, SW_SHOWNORMAL)
“handle(this)”：表示那个你将要作为父窗体的窗体句柄。
“Operatio”：该参数付值为“Open”，表示使用“打开”方法来操作该文档。
“File”：该参数表示要操作哪个文件，必须用该文件的完全路径表示。
“Parameters”：该参数表示打开文件时的命令行参数。
“Directory”：该参数用于指定该应用程序的默认目录。
“ShowCmd”：该参数将被设置为“SW_SHOWNORMAL”以打开文档。
6、使用SendMessage来实现剪切、复制和粘贴
调用SendMessage API就能够向任何带有handle属性的窗口或者控件发送Windows消息。很多控件内置有对特定消息的响应机制。使用这一机制，你在自己的powerbuilder应用程序里很容易就能够实现剪切、复制和粘贴的功能。
要使用这一技巧，你就需要声明用于剪切、复制和粘贴的常数：
Constant long WM_COPY = 769
Constant long WM_CUT = 768
Constant long WM_PASTE =770
然后，声明对SendMessage API的调用：
Function long SendMessage (long hWnd, long wMsg , long wParam , long lParam ) Library "user32.dll"
HWnd自变量能够接受消息发送的目的控件的句柄，而wMsg自变量会接受一个表明要被发送的是哪个对象的常数。WParam和lParam自变量被用来把其他信息同消息一起传递，但是不对WM_CUT、WM_COPY或者WM_PASTE使用。
下面是从菜单点击事件调用SendMessage API的代码：
m_Copy.Clicked:
SendMessage(Me.ActiveControl.hwnd, WM_COPY, 0, 0)
m_Cut.Clicked
SendMessage(Me.ActiveControl.hwnd, WM_CUT, 0, 0)
m_Paste.Clicked
SendMessage(Me.ActiveControl.hwnd, WM_PASTE, 0, 0)
这个技巧能够用于任何实现handle方法，并能够响应WM_CUT、WM_COPY和WM_PASTE消息的控件。还应该实现错误处理，以处理不带handle方法的控件。
7、隐藏/显示开始菜单
Function long FindWindow (string lpClassName, string lpWindowName ) Library "user32.dll" Alias for "FindWindowA"
注释：寻找窗口列表中第一个符合指定条件的顶级窗口
注释：lpClassName指向包含了窗口类名的空中止（C语言）字串的指针；或设为零，注释：表示接收任何类
注释：lpWindowName指向包含了窗口文本（或标签）的空中止（C语言）字串的指针；注释：或设为零，表示接收任何窗口标题
Function long FindWindowEx (long hWnd1 ,long hWnd2, string lpsz1 , string lpsz2 ) Library "user32.dll" Alias for "FindWindowExA"
注释：在窗口列表中寻找与指定条件相符的第一个子窗口
注释：hWnd1在其中查找子的父窗口
注释：hWnd2从这个窗口后开始查找。这样便可利用对FindWindowEx的多次调用找到符合条件的所有子窗口。如设为零，表示从第一个子窗口开始搜索
Function long ShowWindow(long hwnd , long nCmdShow ) Library "user32.dll"
注释：控制窗口的可见性
注释：hwnd窗口句柄，要向这个窗口应用由nCmdShow指定的命令
注释：nCmdShow为窗口指定可视性方面的一个命令
实现代码：cb_1.clicked:
long Handle ,FindClass
string ls_temp
setnull(ls_temp)
FindClass = FindWindow("Shell_TrayWnd", "")
Handle = FindWindowEx(FindClass, 0, "Button", ls_temp)
ShowWindow(Handle, 0)//隐藏开始菜单
cb_2.clicked:
long Handle , FindClass
FindClass = FindWindow("Shell_TrayWnd", "")
Handle = FindWindowEx(FindClass, 0, "Button", ls_temp)
ShowWindow(Handle, 1)//显示开始菜单
8、起用和禁止ctrl-alt-del
Function long SystemParametersInfo (long uAction , long uParam, Ref any lpvParam, long fuWinIni ) Library "user32.dll" Alias for "SystemParametersInfoA"
注释：允许获取和设置数量众多的windows系统参数
注释：uAction指定要设置的参数
Constant long SPI_SCREENSAVERRUNNING = 97
实现代码：起用ctrl-alt-del:
integer ret As Integer
boolean pOld
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
禁止ctrl-alt-del:
integer ret
boolean pOld
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
9、隐藏和显示系统托盘
//注释：隐藏系统托盘
long FindClass, Handle
string ls_temp
setnull(ls_temp)
FindClass = FindWindow("Shell_TrayWnd", "")
Handle = FindWindowEx(FindClass, 0, "TrayNotifyWnd", ls_temp)
ShowWindow(Handle, 0)
//显示系统托盘
//注释：隐藏系统托盘
long FindClass, Handle
string ls_temp
setnull(ls_temp)
FindClass = FindWindow("Shell_TrayWnd", "")
Handle = FindWindowEx(FindClass, 0, "TrayNotifyWnd", ls_temp)
ShowWindow(Handle, 1)
10、显示/隐藏任务栏
long FindClass, FindClass2 , Parent, Handle
string ls_temp
setnull(ls_temp)
FindClass = FindWindow("Shell_TrayWnd", "")
FindClass2 = FindWindowEx(FindClass, 0, "ReBarWindow32", ls_temp)
Parent = FindWindowEx(FindClass2, 0, "MSTaskSwWClass", ls_temp)
Handle = FindWindowEx(Parent, 0, "SysTabControl32", vls_temp)
ShowWindow(Handle, 0)//显示任务栏
long FindClass, FindClass2 , Parent, Handle
string ls_temp
setnull(ls_temp)
FindClass = FindWindow("Shell_TrayWnd", "")
FindClass2 = FindWindowEx(FindClass, 0, "ReBarWindow32", ls_temp)
Parent = FindWindowEx(FindClass2, 0, "MSTaskSwWClass", ls_temp)
Handle = FindWindowEx(Parent, 0, "SysTabControl32", vls_temp)
ShowWindow(Handle, 1)//隐藏任务栏
11、怎样确定系统是否安装了声卡？
//API函数声明：
Function long waveOutGetNumDevs () Library "winmm.dll"
代码如下：
integer i
i = waveOutGetNumDevs()
If i > 0 Then
messagebox("声卡检测","你的系统可以播放声音!")
Else
messagebox("声卡检测","你的系统不能播放声音!")
End If
12、powerbuilder中如何使用未安装的字体？
Function long AddFontResource(string lpFileName) Library "gdi32.dll" Alias for "AddFontResourceA"
Function long RemoveFontResource (string lpFileName ) Library "gdi32.dll" Alias for "RemoveFontResourceA"
//增加字体：
long lResult
lResult = AddFontResource("c:myAppmyFont.ttf")
// 删除字体：
long lResult
lResult = RemoveFontResource("c:myAppmyFont.ttf")
13、半透明窗体(win2000特有API)
Function long SetLayeredWindowAttributes (long hwnd , long crKey , long bAlpha , long dwFlags ) Library "user32.dll"
注释：具体可以使用的常量及其用法
Constant long LWA_ALPHA=2 //注释：表示把窗体设置成半透明样式
Constant long LWA_COLORKEY=1 // 注释：表示不显示窗体中的透明色
实现代码：
Function long GetWindowLong (long hwnd , long nIndex ) Library "user32.dll" Alias for "GetWindowLongA"
Function long SetWindowLong (long hwnd, long nIndex , long dwNewLong ) Library "user32.dll" Alias for "SetWindowLongA"
Function long SetLayeredWindowAttributes (long hwnd , long crKey , long bAlpha , long dwFlags ) Library "user32.dll"
Constant long WS_EX_LAYERED = 32768
Constant long GWL_EXSTYLE =-20
Constant long LWA_ALPHA =2
Constant long LWA_COLORKEY =1
窗口w_example的open事件：
long rtn
rtn = GetWindowLong(handle(this), GWL_EXSTYLE) //注释：取的窗口原先的样式
rtn = rtn + WS_EX_LAYERED //注释：使窗体添加上新的样式WS_EX_LAYERED
SetWindowLong(handle(thios), GWL_EXSTYLE, rtn )// 注释：把新的样式赋给窗体
SetLayeredWindowAttributes(handle(this), 0, 192, LWA_ALPHA)
//注释：把窗体设置成半透明样式,第二个参数表示透明程度
//注释：取值范围0--255,为0时就是一个全透明的窗体了
14、使窗体右上角的X按钮失效
外部函数声明
Function long GetSystemMenu(long hwnd, long bRevert) Library "user32.dll"
//函数功能
//取得指定窗口的系统菜单的句柄。在powerbuilder，“系统菜单”的正式名称为“控制菜单”，即单击窗口左上角的控制框时出现的菜单
//返回值
//Long，如执行成功，返回系统菜单的句柄；零意味着出错。如bRevert设为TRUE，也会返回零（简单的恢复原始的系统菜单）
//备注
//在powerbuilder里使用：系统菜单会向窗口发送一条WM_SYSCOMMAND消息，而不是WM_COMMAND消息
//参数表
//hwnd ----------- Long，窗口的句柄
//bRevert -------- Long，如设为TRUE，表示接收原始的系统菜单
Function long RemoveMenu(long hMenu, long nPosition, long wFlags) Library "user32.dll"
//函数功能
//删除指定的菜单条目。如删除的条目属于一个弹出式菜单，那么这个函数不会同时删除弹出式菜单。首先应该用GetSubMenu函数取得弹出式菜单的句柄，再在以后将其删除
//返回值
//Long，非零表示成功，零表示失败。会设置GetLastError
//备注
//强烈建议大家使用powerbuilder菜单的visible属性从菜单中删除条目，而不要用这个函数，否则会造成指定菜单中其他菜单条目的visible属性对错误的菜单条目产生影响
//参数表
//hMenu ---------- Long，菜单的句柄
//nPosition ------ Long，欲改变的菜单条目的标识符。如在wFlags参数中指定了MF_BYCOMMAND，这个参数就代表欲改变的菜单条目的命令ID。如设置的是MF_BYPOSITION，这个参数就代表菜单条目在菜单中的位置（第一个条目的位置为零）
//wFlags --------- Long，常数MF_BYCOMMAND或MF_BYPOSITION，取决于nPosition参数
实现代码：
w_example窗口的open事件：
long R,mymenu
MyMenu = GetSystemMenu(handle(this), 0)
RemoveMenu(MyMenu, 96, R)
//程序中用到了两个API函数GetSystemMenu、RemoveMenu，其中GetSystemMenu函数用来得到系统菜单的句柄，RemoveMenu用来删除指定的菜单条目，我们先来看看这个函数的声明和参数：
Function long GetSystemMenu(long hwnd, long bRevert) Library "user32.dll"
Function long RemoveMenu(long hMenu, long nPosition, long wFlags) Library "user32.dll"
其中各GetSystemMenu参数的意义如下表:
参数 意义
hwnd Long 系统菜单所在窗口的句柄
bRevert Long 如设为TRUE，表示恢复原始的系统菜单
返回值 Long 如执行成功，返回系统菜单的句柄；零意味着出错。如bRevert设为TRUE，也会返回零（简单的恢复原始的系统菜单）
而RemoveMenu参数的意义如下表:
参数 意义
hMenu Long 菜单的句柄
nPosition Long 欲改变的菜单条目的标识符。如在wFlags参数中指定了MF_BYCOMMAND，这个参数就代表欲改变的菜单条目的命令ID。如设置的是MF_BYPOSITION，这个参数就代表菜单条目在菜单中的位置（第一个条目的位置为零）
wFlags Long 常数MF_BYCOMMAND＝0或MF_BYPOSITION＝1024，取决于nPosition参数
返回值 Long，非零表示成功，零表示失败
然后就可以在程序中使用这两个函数了，我们在窗体的Form_Load()过程中加入如下代码：
MyMenu = GetSystemMenu(handle(this),0)//得到系统菜单的句柄，handle(this)表示当前窗体的句柄
RemoveMenu(MyMenu, 96, MF_BYCOMMAND)//移去“关闭”菜单项，96“关闭”菜单项的命令ID
15、如何获得屏幕保护程序的密码
//如果屏幕保护程序设置了密码，密码将被加密，然后写到注册表的“HKEY_CURRENT_USER/Control Panel/Desktop/ScreenSave_Data”位置。屏保密码的最大长度为128位。加密方式是将密码与一特定字符串异或后得到密文，经过参考有关资料，笔者利用VB成功地破解了屏保的密码。
外部函数声明：
Function long RegOpenKeyEx(long hKey, string lpSubKey, long ulOptions, long samDesired, long phkResult) Library "advapi32.dll" Alias for "RegOpenKeyExA"
Function long RegCloseKey(long hKey) Library "advapi32.dll"
Function long RegQueryValueEx(long hKey,string lpValueName, long lpReserved,long lpType,any lpData,long lpcbData) Library "advapi32.dll" Alias for "RegQueryValueExA"
Function long RegSetValueEx(long hKey, string lpValueNames, long Reserved,long dwType, any lpData, long cbData) Library "advapi32.dll" Aliasfor "RegSetValueExA" //以上api可以使用powerbuilder提供的注册表函数替代
实例变量声明：
//注释：加密和解密所用的字符串
Constant string Key = "48EE761D6769A11B7A8C47F85495975F78D9DA6C59D76B35C57785182A0E52FF00
E31B718D3463EB91C3240FB7C2F8E3B6544C3554E7C94928A385110B2C68FBEE7DF66CE39C2DE47
2C3BB851A123C32E36B4F4DF4A924C8FA78AD23A1E46D9A04CE2BC5B6C5EF935CA8852B413772FA
574541A1204F80B3D52302643F6CF10F"
Constant long HKEY_CURRENT_USER = 2147483649
Constant long REG_SZ = 1
Constant long KEY_READ = &H20019
窗口自定义函数：
//注释：自定义函数，找到屏保密码
Function string GetScreenSaverPwd()
string EncryptedPassword ,DecryptedPassword,strRetVal,strreturn
long lngResult,lngHandle,lngcbData
//注释：从注册表中读取已经加密的屏保密码
RegOpenKeyEx(HKEY_CURRENT_USER, "Control Panel/desktop", 0, KEY_READ, lngHandle)
RegQueryValueEx(lngHandle, "ScreenSave_Data", 0, lngType, ByVal strRetVal, lngcbData )
strRetVal = Space(lngcbData)
lngResult = RegQueryValueEx(lngHandle, "ScreenSave_Data", 0, lngType, ByVal strRetVal, lngcbData)
RegCloseKey (lngHandle)
EncryptedPassword = strRetVal
//注释：解密,得到密码
If Len(EncryptedPassword) <> 1 Then
EncryptedPassword = Left(EncryptedPassword, Len(EncryptedPassword) - 1)
//注释：每2位与Key进行异或运算，得到密码
For i = 1 To Len(EncryptedPassword) Step 2
DecryptedPassword = wf_or(DecryptedPassword,wf_Xor(Mid(EncryptedPassword, i, 2),Mid(Key, i, 2)))//这个是随便写的，可能有问题的：）
Next
str_return = DecryptedPassword
Else
str_return = ""
End If
If str_return = "" Then str_return = "未设置屏保密码。"
return str_return
16、设置本地机器的时间
外部函数引用声明：
Function long SetSystemTime(stc_systemtime lpSystemTime) Library "kernel32.dll"
结构声明：
type stc_systemtime from structure
integer wyear
integer wmonth
integer wdayofweek
integer wday
integer whour
integer wminute
integer wsecond
integer wmilliseconds
end type
实现代码：
public function boolean of_setsystemtime (datetime adt_datetime);
stc_systemtime lstc_systemtime
date ld_date
time lt_time
ld_date=date(adt_datetime)
lt_time=time(adt_datetime)
lstc_systemtime.wyear=year(ld_date)//设置结构变量的年
lstc_systemtime.wmonth=month(ld_date)//设置结构变量的月
lstc_systemtime.wday=day(ld_date)//)//设置结构变量的天lstc_systemtime.wdayofweek=daynumber(ld_date)//设置结构变量的星期数lstc_systemtime.whour=hour(lt_time)//设置结构变量的小时
lstc_systemtime.wminute=minute(lt_time)//设置结构的秒数
lstc_systemtime.wsecond=minute(lt_time)//设置结构的分钟数
lstc_systemtime.wmilliseconds=0//设置结构的微秒数
return setsystemtime(lstc_systemtime)<>0//返回是否设置成功
end function
17、调用API函数设计ABOUT窗口
Windows操作系统的许多软件中都包含一个windows 风格的about 窗口，它向用户反映了当前系统的一些基本信息，其中显示有关windows 及其应用软件的版本、版权和系统的工作状态等信息。以下通过调用API 函数设计应用系统的ABOUT 窗口。
外部函数引用声明：
Function long GetWindowWord (long hwnd, long nIndex ) Library "user32.dll"
Function long ShellAbout (long hwnd, string szApp , string szOtherStuff, long hIcon) Library "shell32.dll" Alias for "ShellAboutA"
Function long ExtractIcon (long hinst, string lpszExeFileName, long nIconIndex ) Library "shell32.dll" Alias for "ExtractIconA"
Function long GetDiskFreeSpace (string lpRootPathName, long lpSectorsPerCluster, long lpBytesPerSector , long lpNumberOfFreeClusters , long lpTotalNumberOfClusters) Library "kernel32.dll" Alias for "GetDiskFreeSpaceA"
function long GetDriveType(string nDrive) Library "kernel32.dll" Alias for "GetDriveTypeA"
Subroutine GetSystemInfo ( SYSTEM_INFO lpSystemInfo) Libaray "kernel32.dll"
Function long GetSystemMetrics(long nIndex ) Library "user32.dll"
定义实例变量：
Constant long GWL_EXSTYLE = -20
Constant long GWL_STYLE = -16
Constant long GWL_WNDPROC = -4
Constant long GWL_HINSTANCE = -6
Constant long SM_CXSCREEN = 0
Constant long SM_CYSCREEN = 1
定义结构system_info
Type SYSTEM_INFO from structure
long dwOemID
long dwPageSize
long lpMinimumApplicationAddress
long lpMaximumApplicationAddress
long dwActiveProcessorMask
long dwNumberOrfProcessors
long dwProcessorType
long dwAllocationGranularity
long dwReserved
End Type
实现代码：
w_example.cb_1.clicked:
long hinst ,icons,abouts,cls1, cls2,secs ,bytes,x
string dispx,dispy ,cps ,space1 ,space2,buffs
system_info sysinfo hinst = GetWindowWord(handle(parent), GWL_HINSTANCE)//获得指定窗口结构的信息
icons = ExtractIcon(hinst, "d:/fpw26/foxprow.exe", 0)//获取指定的可执行程序的图标
buff = "C:/"
GetDriveType(buffs)//获取盘的类型
GetDiskFreeSpace(buffs, secs, bytes, cls1, cls2)//获取指定分区的容量，注：这个api函数不能获取大硬盘分区的信息
cls1 = cls1 * secs * bytes
cls2 = cls2 * secs * bytes
space1 = "C驱动器总共容量：" +string(cls2/1024, "#, #") + "千字节"
space2 = "C驱动器可用容量：" + string(cls1/1024, "#, #") + "千字节"
x=GetSystemMetrics(SM_CXSCREEN)//获取显示器的水平方向分辨率
dispx = "显示器分辨率：" + String(x)
x = GetSystemMetrics(SM_CYSCREEN)//获取显示器的垂直方向分辨率
dispy = String(x)
GetSystemInfo(sysinfo)//获取系统信息（如cpu，电源）
choose Case sysinfo.dwProcessorType
Case 386
cpus = "处理器类型:386"
Case 486
cpus = "处理器类型:486"
Case 586
cpus = "处理器类型:586"
end choose
abouts = ShellAbout(handle(parent), "演示程序","销售管理系统V2.0版权所有[C]2004-2005天天软件" +&
Char(13) + Char(10) + space1 + Char(13) + Char(10)+&
space2+ char(13) + Char(10) + cpus + " " + dispx +&
"*" + dispy , icons)//显示标准的about对话框
18、获得IE的版本号
定义结构：
Type DllVersionInfo from structure
long cbSize
long dwMajorVersion
long dwMinorVersion
long dwBuildNumber
long dwPlatformID
End Type
外部函数引用声明：
Funcation long DllGetVersion Lib( DllVersioninfo dwVersion) library "Shlwapi.dll"
窗口w_example的窗口级函数:
string Wf_VersionString()
string ls_return
DllVersionInfo DVI
DVI.cbSize = 160//对DllVersioninfo的相关成员进行初始化
DllGetVersion(DVI) //调用api函数有关IE的信息
ls_return = "Internet Explorer " +DVI.dwMajorVersion + "." +DVI.dwMinorVersion+ "." +DVI.dwBuildNumber
return ls_return
19.指定ip能否ping通
定义两个结构：
str_ip_option:
ttl char
tos char
flags char
size char
data long
str_icmp_ech
address ulong
status ulong
roundtriphome ulong
datasize uint
reserved uint
datapointer ulong
options str_ip_option
data[250] char
声明外部函数:
function long inet_addr(ref string addr) library "wsock32.dll"
function long IcmpCloseHandle(long IcmpHandle) library "icmp.dll"
function long IcmpSendEcho (long IcmpHandle,long DestinationAddress,string requestData,integer requestSize,long requestOption,ref str_icmp_echo replyBuffer,long replySize,long timeout ) library "icmp.dll"
function long IcmpCreateFile() library "icmp.dll"
函数,返回true表示能ping通:
boolean f_ping(string ps_ipaddr):
ulong lul_NetAddress
long ll_hFile,ll_ret
string ls_Message=Space(20)
str_icmp_echo preturn
lul_NetAddress=inet_addr(as_IPAddr)
IF lul_NetAddress=-1 THEN RETURN FALSE
ll_hFile=IcmpCreateFile()
IF ll_hFile = 0 THEN RETURN FALSE
ll_ret=IcmpSendEcho(ll_hFile,lul_NetAddress,ls_Message,Len(ls_Message),0,preturn,282,500)
IcmpCloseHandle(ll_hfile)
RETURN ll_ret > 0
20.使程序不出现在Windows任务列表中( Win98 )
定义常量：
constant long RSP_SIMPLE_SERVICE = 1
constant long RSP_UNREGISTER_SERVICE = 0
声明外部函数：
//获取当前进程id
function long GetCurrentProcessId() library 'kernel32'
//注册服务进程
function long RegisterServiceProcess(long processid, long type) library 'kernel32'
application的open事件:
long ll_procid
ll_procid = GetCurrentProcessId()
RegisterServiceProcess(ll_procid, RSP_SIMPLE_SERVICE)
application的close事件:
long ll_procid
ll_procid = GetCurrentProcessId()
RegisterServiceProcess(ll_procid, RSP_UNREGISTER_SERVICE)
21、获取光驱的盘符
外部函数声明：
Function uint GetDriveTypeA(string lpRootPathName) LIBRARY "kernel32.dll"
自定义用户函数
public function string of_get_drive_type (string as_rootpathname);/*函数作用:获取指定的驱动器的类型
参数:as_drive string 驱动器名
返回值:string */
string ls_DriveType
as_RootPathName=Left(as_RootPathName,1)+":"
CHOOSE CASE GetDriveTypeA(as_RootPathName)
CASE 2
ls_DriveType="REMOVABLE"//可移动磁盘
CASE 3
ls_DriveType="FIXED"//软驱
CASE 4
ls_DriveType="REMOTE"//网络驱动盘符
CASE 5
ls_DriveType="CDROM"//光驱
CASE 6
ls_DriveType="RAMDISK"//随机存储设备
CASE ELSE
SetNull(ls_DriveType)
END CHOOSE
RETURN ls_DriveType
end function
public function string of_get_drive_cdrom ();/*函数作用:获取光驱的驱动器名
返回值:string */
integer li_i,li_start,li_end
string ls_CDRoms=""
li_start=Asc("A")
li_end=Asc("Z")
FOR li_i=li_start TO li_end
IF of_get_drive_Type(Char(li_i))="CDROM" THEN ls_CDRoms=ls_CDRoms+Char(li_i)
//调用自定义函数of_get_drive_type()并判断函数返回值，如是CDROM则退出循环
NEXT
RETURN ls_CDRoms
end function
22、实现系统托盘
WINDOWS状态栏也称系统托盘，在WINDOWS9X中已有系统时钟、音量控制、输入法等程序在WINDOWS的状态栏中设有图标，一些应用程序在安装完后也将它们本身的图标放入了状态栏中，如超级解霸、WINAMP等。通过在应用程序中有效地控制状态栏中的图标，不仅可以使应用程序具有专业水准，也方便了用户的操作。VB做为一种使用很广的高级语言，实现将图标放入状态栏的功能并不困难，只要有效地利用一个API函数 Shell_NotifyIcon和NOTIFYICONDATA数据结构就能达到这一目的，有关这两者的定义和使用在程序中有详细的注释，在此就不再详述了。
下面的这个程序运行后，将窗口图标加入到了WINDOWS状态栏中，用鼠标右击该图标会弹出一个菜单，可实现修改该图标、窗口复位、最小化、最大化及关闭程序等功能。
实现步骤：
结构定义
Type NOTIFYICONDATA from structure
long cbSize //注释：该数据结构的大小
long hwnd //注释：处理任务栏中图标的窗口句柄
long uID//注释：定义的任务栏中图标的标识
long uFlags //注释：任务栏图标功能控制，可以是以下值的组合（一般全包括）
//注释：NIF_MESSAGE 表示发送控制消息；
//注释：NIF_ICON表示显示控制栏中的图标；
//注释：NIF_TIP表示任务栏中的图标有动态提示。
long uCallbackMessage//注释：任务栏图标通过它与用户程序交换消息，处理该消息的窗口由hWnd决定
long hIcon //注释：任务栏中的图标的控制句柄
string szTip//注释：图标的提示信息
End Type
外部函数引用声明：
Function long Shell_NotifyIcon (long dwMessage,NOTIFYICONDATA lpData ) Library "shell32.dll" Alias for "Shell_NotifyIconA"
实例变量定义：
Constant long WM_SYSCOMMAND = 274
Constant long SC_RESTORE = 61728
integer LastState //注释：保留原窗口状态
//注释：---------- dwMessage可以是以下NIM_ADD、NIM_DELETE、NIM_MODIFY 标识符之一
Constant long NIM_ADD =0 //注释：在任务栏中增加一个图标
Constant long NIM_DELETE =2 //注释：删除任务栏中的一个图标
Constant long NIM_MODIFY = 1//注释：修改任务栏中个图标信息
Constant long NIF_MESSAGE = 1// 注释：NOTIFYICONDATA结构中uFlags的控制信息
Constant long NIF_ICON = 2
Constant long NIF_TIP =4
Constant long WM_MOUSEMOVE = 512//注释：当鼠标指针移至图标上
Constant long WM_LBUTTONUP = 514
Constant long WM_RBUTTONUP =517
NOTIFYICONDATA myData
w_example窗口的open事件：
If this. WindowState = Minimized! Then
LastState = Normal!
Else
LastState = this.WindowState
End If
myData.cbSize = 256
mydata.hwnd =handle(this)
mydata.uID = 0
mydata.uFlags = NIF_ICON + NIF_MESSAGE + NIF_TIP
mydata.uCallbackMessage = WM_MOUSEMOVE
mydata.hIcon = this.Icon//注释：默认为窗口图标
mydate.szTip = "提示"
Shell_NotifyIcon(NIM_ADD, myData)
窗口w_example的mousemove事件：
choose case long (X)
Case WM_RBUTTONUP //注释：鼠标在图标上右击时弹出菜单
m_popup im_pop
im_pop=create m_popup
im_pop.popmemu(x,y)
destroy im_pop
Case WM_LBUTTONUP //注释：鼠标在图标上左击时窗口若最小化则恢复窗口位置
If this.WindowState = Minimized Then
this.WindowState = LastState
this.SetFocus
End If
end choose
窗口w_example的close事件：
Shell_NotifyIcon（NIM_DELETE, myData）// 注释：窗口卸载时，将状态栏中的图标一同卸载
23、获取文件的相关时间信息
实现步骤
定义结构
type stc_find_data from structure
unsignedlong att
stc_filetime c_time
stc_filetime a_time
stc_filetime w_time
unsignedlong h_size
unsignedlong l_size
unsignedlong dwreserved0
unsignedlong dwreserved1
character cfilename[260]
character calternatefilename[16]
end type
type stc_filetime from structure
long htime
long ltime
end type
定义外部函数声明
Function ulong GetFileAttributesA(string lpFileName) LIBRARY "kernel32.dll"
FUNCTION ulong FindClose(ulong hFindFile) LIBRARY "kernel32.dll"
FUNCTION ulong FindFirstFile(ref string lpFileName,ref stc_find_data lpFindFileData) LIBRARY "kernel32.dll" ALIAS FOR "FindFirstFileA"
FUNCTION ulong FindNextFile(ulong hFindFile,ref stc_find_data lpFindFileData) LIBRARY "kernel32.dll" ALIAS FOR "FindNextFileA"
FUNCTION ulong FileTimeToDosDateTime(ref stc_filetime lpFileTime,ref long lpFatDate,ref long lpFatTime) LIBRARY "kernel32.dll"
FUNCTION ulong DosDateTimeToFileTime(ulong wFatDate,ulong wFatTime,ref stc_filetime lpFileTime) LIBRARY "kernel32.dll"
public function datetime of_get_file_writetime (string as_filename);/*函数作用:获取文件的最后写操作时间
参数: as_filename string 文件名，需绝对文件路径
返回值:datetime */
long ll_code
datetime ldt_filedatetime
long lul_date,lul_time
int lui_year,lui_month,lui_day,lui_hour,lui_minute,lui_second
stc_find_data ls_file
ll_code=findfirstfile(as_filename,ls_file)//查找文件
findclose(ll_code)
ldt_filedatetime=datetime(ls_file.w_time)//文件的最后写入时间
if ll_code=-1 then
setnull(ldt_filedatetime)
else
filetimetodosdatetime (ls_file.w_time,lul_date,lul_time)//转换dos时间为powerbuilder的日期、时间
lui_day=mod(lul_date,32)
lui_month=mod(lul_date,512)/32
if lui_month=0 then
lui_month=1
end if
lui_year=lul_date/512+1980
lui_second=mod(lul_time,32)*2
lui_minute=mod(lul_time,2048)/32
lui_hour=(lul_time)/2048 + 8
if lui_hour>=24 then
lui_hour=lui_hour - 24
ldt_filedatetime=datetime(relativedate(date(lui_year,lui_month,lui_day),1),time(lui_hour,lui_minute,lui_second))
else
ldt_filedatetime=datetime(date(lui_year,lui_month,lui_day),time(lui_hour,lui_minute,lui_second))
end if
end if
return ldt_filedatetime
end function
public function datetime of_get_file_createtime (string as_filename);/*函数作用:获取文件的创建时间
参数: as_filename string 文件名，需绝对文件路径
返回值:datetime */
long ll_code
datetime ldt_filedatetime
long lul_date,lul_time
int lui_year,lui_month,lui_day,lui_hour,lui_minute,lui_second
stc_find_data ls_file
ll_code=findfirstfile(as_filename,ls_file)
findclose(ll_code)
ldt_filedatetime=datetime(ls_file.c_time)
if ll_code=-1 then
setnull(ldt_filedatetime)
else
filetimetodosdatetime (ls_file.c_time,lul_date,lul_time)
lui_day=mod(lul_date,32)
lui_month=mod(lul_date,512)/32
if lui_month=0 then
lui_month=1
end if
lui_year=lul_date/512+1980
lui_second=mod(lul_time,32)*2
lui_minute=mod(lul_time,2048)/32
lui_hour=(lul_time)/2048 + 8
if lui_hour>=24 then
lui_hour=lui_hour - 24
ldt_filedatetime=datetime(relativedate(date(lui_year,lui_month,lui_day),1),time(lui_hour,lui_minute,lui_second))
else
ldt_filedatetime=datetime(date(lui_year,lui_month,lui_day),time(lui_hour,lui_minute,lui_second))
end if
end if
return ldt_filedatetime
end function
public function datetime of_get_file_accesstime (string as_filename);/*函数作用:获取文件的最后访问时间
参数: as_filename string 文件名，需绝对文件路径
返回值:datetime */
long ll_code
datetime ldt_filedatetime
long lul_date,lul_time
int lui_year,lui_month,lui_day,lui_hour,lui_minute,lui_second
stc_find_data ls_file
ll_code=findfirstfile(as_filename,ls_file)
findclose(ll_code)
ldt_filedatetime=datetime(ls_file.a_time)
if ll_code=-1 then
setnull(ldt_filedatetime)
else
filetimetodosdatetime (ls_file.a_time,lul_date,lul_time)
lui_day=mod(lul_date,32)
lui_month=mod(lul_date,512)/32
if lui_month=0 then
lui_month=1
end if
lui_year=lul_date/512+1980
lui_second=mod(lul_time,32)*2
lui_minute=mod(lul_time,2048)/32
lui_hour=(lul_time)/2048 + 8
if lui_hour>=24 then
lui_hour=lui_hour - 24
ldt_filedatetime=datetime(relativedate(date(lui_year,lui_month,lui_day),1),time(lui_hour,lui_minute,lui_second))
else
ldt_filedatetime=datetime(date(lui_year,lui_month,lui_day),time(lui_hour,lui_minute,lui_second))
end if
end if
return ldt_filedatetime
end function
24、清除开始菜单中“我的文档”的列表文件
清除开始菜单中“我的文档”的列表文件
在“任务栏 属性”的“开始菜单程序”中有一个“清除”按钮，用于清除“我的文档”所列出的最近打开的文件列表。
在Powerbuilder应用程序中如何实现这一功能呢？
首先我们来理解Windows是通过什么方式在文档中添加列表文件的。
在Windows中，当我们打开某些类型的文件时，均在开始菜单的“我的文档”中添加以该文件名命名的快捷方式。其实这
调用了shell32.dll文件所提供的函数SHAddToRecentDocs。此函数顾名思义是专门用来往开始菜单中“我的文档”添加列
表文件的。Powerbuilder调用它的相应格式为：
string NewFile
NewFile = "C:/TEST.TXT"
SHAddToRecentDocs(2,NewFile) //注释：添加项目
如果我们反其道而行之，能不能让它清除列表文件而不是添加新项目呢。请看如下代码：
//注释：外部函数引用声明
Subroutine SHAddToRecentDocs(long uFlags,string pv ) Library "shell32.dll"
//注释：给工程添加一个按钮，其单击事件的代码为：
w_example.cb_1.clicked:
string ls_temp
setnull(ls_temp)
SHAddToRecentDocs(2,ls_temp)// 注释：清除
25、用Semaphore检测运行实例的个数
使用到的api函数解释：
CreateSemaphore(SECURITY_ATTRIBUTES lpSemaphoreAttributes , long lInitialCount, long lMaximumCount, string lpName )
该函数是Windows提供用来创建一个Semaphore信号的函数,其参数含义如下：
lpSemaphoreAttributes：安全属性参数，是为Windows NT设置的，在Windows 95下可以忽略。但是在PowerBuilder中若如上述声明，则不能忽略，忽略后该函数有时不能正确执行，并返回0。此时，可以设置其为默认值，或者改为long lpSemaphoreAttributes，然后再传入0。
lInitialCount：Semaphore的初始值，一般设为0或lMaxmumCount。
lMaximunCount：Semaphore信号的最大值。
lpName：该信号名，以便其他进程对其进行调用，若是相同进程可以设为Null。
函数成功时返回创建的Semaphore信号的句柄。该函数有一个特点，就是在要创建的信号已经创建了的情况下，它等同于函数OpenSemaphore()，仅仅是打开该Semaphore信号，并返回信号句柄。
ReleaseSemaphore(long hSemaphore, long lReleaseCount，long lpPreviousCount)
hSemaphore：函数CreateSemaphore()返回的Semaphore信号句柄；
lReleaseCount： 当前信号值的改变量；
lpPreviousCount：返回的Semaphore信号被加之前的值，可用于跟踪测试。
如果Semaphore信号当前值加上lReleaseCount后不超过CreateSemaphore()中设定的最大值lMaximunCount，函数返回1(True),否则返回0(False),可用GetLastError()得到其失败的详细原因。
WaitForSingleObject(long hHandle , long dwMilliseconds)
hHandle：等待对象的句柄；
dwMilliseconds：等待时间。
该函数可以实现对一个可等待对象的等待操作,获取操作执行权。当等待的对象被释放时函数成功返回，同时使等待对象变为有信号状态，或者超时返回。该函数用于等待Semaphore信号时，若Semaphore信号不为0，则函数成功返回，同时使Semaphore信号记数减1。
实现步骤：
定义结构：
Type SECURITY_ATTRIBUTES from structure
long nLength
long lpSecurityDescriptor
long bInheritHandle
End Type
定义外部函数引用声明：
Function long ReleaseSemaphore (long hSemaphore, long lReleaseCount ,long lpPreviousCount) Library "kernel32.dll"
Function long CreateSemaphore(SECURITY_ATTRIBUTES lpSemaphoreAttributes, long lInitialCount, long lMaximumCount , string lpName ) Library "kernel32.dll" Alias for "CreateSemaphoreA"
Function long WaitForSingleObject (long hHandle, long dwMilliseconds) Library "kernel32.ll"
定义实例变量：
string Semaphore,
long Sema ,PrevSemaphore , Turn
SECURITY_ATTRIBUTES Security
窗口w_example的open事件：
Security.bInheritHandle = True //注释：默认的安全值
Security.lpSecurityDescriptor = 0
Security.nLength = 96
Semaphore = "Instance"
//创建或打开一个Semaphore记数信号，设资源空闲使用量为4
Sema = CreateSemaphore(Security, 4, 4, Semaphore)
//注释：申请一个权限，并立即返回
//Turn = WaitForSingleObject (Sema, 0)
//注释：如果不是正常返回，则表示没有申请到资源的使用权限
If Turn <> 0 Then
messagebox("", "Full!")
End If
窗口w_example的closequery事件：
//在当前值上加1，表示有一个程序退出，释放了一个权限，PrevSemaphore参数接收释放前的计数器的值
ReleaseSemaphore （Sema, 1, PrevSemaphore）
26、判断一个32位程序是否结束
实现步骤：
外部函数引用声明：
Function long OpenProcess(ref long dwDesiredaccess,ref long bInherithandle, ref long dwProcessid) Library "kernel32.dll"
Function long GetExitCodeProcess(long hProcess, long lpexitcode) Library "kernel32.dll"
定义实例变量：
Constant long STILL_ACTIVE = 259
Constant long PROCESS_QUERY_INFORMATION = 1024
定义窗口级函数
wf_ShellWait(string cCommandLine)
long hShell ,hProc, lExit
hShell = run(cCommandLine)
hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
Do
GetExitCodeProcess(hProc, lExit )
Yield ()
Loop until lExit = STILL_ACTIVE
//调用 ShellWait，控制权将不会交给一个过程，直到调用该过程的程序结束
27、如何为你的应用程序设置热键？
实现步骤：
外部函数引用声明：
Function long SendMessage (long hwnd , long wMsg , long wParam, long lParam) Library "user32.dll" alias for "SendMessageA"
Function long DefWindowProc (long hwnd,long wMsg, long wParam, long lParam) Library "user32.dll" Alias for "DefWindowProcA"
定义实例变量：
Constant long WM_SETHOTKEY = 50
Constant long WM_SHOWWINDOW = 24
Constant long HK_SHIFTA = 321//注释：Shift + A
Constant long HK_SHIFTB = 322//注释：Shift * B
Constant long HK_CONTROLA = 577//注释：Control + A
Constant long HK_ALTZ = 1114
//请注意组合键的值必须以低／高位字节的格式进行声明。也就是说是一个十六进制的数字。后两位是低端字节，如
41=a；前两位是高端字节，如01=1=shift。
窗口w_example的open事件：
long erg
this.WindowState = Minimized!//注释：让windows知道你想要的热键。
erg = SendMessage(handle(this), WM_SETHOTKEY,HK_ALTZ, 0) //注释：检查函数是否执行成功
If erg <> 1 Then
messagebox("提示" "你需要重新注册另一个热键"）
End If
//注释：告诉windows热键按下后做什么－－显示窗口
erg = DefWindowProc(handle(this), WM_SHOWWINDOW,0, 0)
28、如何设定屏幕颜色数
//原则上，只改这一次，下一次开机会还原，但如果需重开机，才会Update
Registry中的设定，并重开机。
如果要永久设定其设定值，请将
b = ChangeDisplaySettings(DevM, 0) 改成
b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
//注：DevM.dmBitsPerPel 便是设定颜色数，其实应说每个Pixel要多少Bits来显示
//4 --> 16色
//8 --> 256色
//16 --> 65536色 以此类推
实现步骤：
定义结构：
type devmode from structure
string dmdevicename
integer dmspecversion
integer dmdriverversion
integer dmsize
integer dmdriverextra
long dmfields
integer dmorientation
integer dmpapersize
integer dmpaperlength
integer dmpaperwidth
integer dmscale
integer dmcopies
integer dmdefaultsource
integer dmprintquantity
integer dmcolor
integer dmduplex
integer dmyresolution
integer dmttoption
integer dmcollate
string dmformname
integer dmunusedpadding
long dmbitsperpel
long dmpelswidth
long dmpelsheight
long dmdisplayflags
long dmdisplayfrequency
end type
定义外部函数引用声明：
Function long EnumDisplaySettings (long lpszDeviceName, long iModeNum , lpDevMode As DevMode) Library "user32.dll" Alias for "EnumDisplaySettingsA"
Function long ChangeDisplaySettings (DevMode lpDevMode , long dwflags) Library "user32" Alias for "ChangeDisplaySettingsA"
Function long ExitWindowsEx (long uFlags , long dwReserved ) Library "user32.dll"
定义实例变量：
Constant long EWX_REBOOT = 2// 注释： 重开机
Constant long CCDEVICENAME = 32
Constant long CCFORMNAME = 32
Constant long DM_BITSPERPEL = 262144
Constant long DISP_CHANGE_SUCCESSFUL = 0
Constant long DISP_CHANGE_RESTART = 1
Constant long CDS_UPDATEREGISTRY = 1
DevMode DevM
实现代码：
w_example窗口的命令按钮cb_1.clicked:
boolean a
long i
long b
long ans
a = EnumDisplaySettings(0, 0, DevM) //注释：Initial Setting
DevM.dmBitsPerPel = 8 //注释：设定成256色
DevM.dmFields = DM_BITSPERPEL
b = ChangeDisplaySettings(DevM, 0)
If b = DISP_CHANGE_RESTART Then
ans = messagebox("提示","要重开机设定才能完成，重开？", question!,yesno!)
If ans = 1 Then
b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
ExitWindowsEx(EWX_REBOOT, 0)//这个api函数只能在win98上使用，win nt以上须采用别的方法
End If
Else
If b <> DISP_CHANGE_SUCCESSFUL Then
Messagebox("提示","设定有误")
End If
End If
29、彩色BMP档转成灰度
将RGB想成3D之X,Y,Z轴,则BMP的RGB为(r,g,b)与座标(Y,Y,Y)距离最小时的Y即为灰度值
Y = 0.29900 * R + 0.58700 * G + 0.11400 * B
整数化
Y = ( 9798*R + 19235*G + 3735*B) / 32768
RGB(Y, Y, Y)就可以了
实现步骤：
外部函数引用声明：
Funcation long GetPixel (long hdc , long x , long Y) Library "gdi32.dll"
Funcation long SetPixelV (long hdc , long x , long Y , long crColor ) Library "gdi32.dll"
Funcation long GetDC(long handle) library "gdi32.dll"
定义实例变量：
picture tmpPic
窗口w_example的open事件：
P_1.setredraw(false)// 注释：设定所有Pixel的改变不立即在pictureBox上显示
tmpPic = Picture1.Picture
窗口w_example的cb_1.clicked:
long width5, heigh5, rgb5
long hdc5, i , j
long bBlue, bRed, bGreen
long y
width5 = unitstopixels(P_1.Width,xunitstopixels!)
heigh5 =unitstopixels(P_1.height,yunitstopixels!)
hdc5 = getdc(handle(this)
For i = 1 To width5
For j = 1 To heigh5
rgb5 = GetPixel(hdc5, i, j)
bBlue = Blue(rgb5)
bRed = Red(rgb5)
bGreen = Green(rgb5)
Y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) / 32768
rgb5 = RGB(Y, Y, Y)
SetPixelV (hdc5, i, j, rgb5)
Next
Next
P_1.setredraw(true)// 注释：此时才真正显示Picture
End Sub
w_example窗口级函数：
Function long Red(long mlColor )
return wf_and(mlColor,255)//对mlcolor进行位与计算
Function long Green(long mlColor )
return wf_and((mlColor/256) ,255)
Function long Blue(long mlColor)
return wf_and ((mlColor /65536) ,255)
30、如何将的游标显示成动画游标
动画在 Windows 底下是 .ani 格式的档案， 要显示此类游标，首先要利用LoadCursorFromFile API 载入.ani 档案，
然或利用 SetSystemCursor API 加以显示。
实现步骤：
定义实例变量
Constant long OCR_NORMAL = 32512
Constant long IDC_ARROW = 32512
外部函数引用声明
Function long LoadCursorFromFile (string lpFileName ) Library "user32.dll" Alias for "LoadCursorFromFileA"
Function long LoadCursor (ref long hInstance , long lpCursorName) Library "user32.dll" Alias for " LoadCursorA"
//注释： modified
Function long SetSystemCursor (long hcur , long id ) Library "user32.dll"
实现代码：
long hCursor
hCursor = LoadCursorFromFile(" 欲显示的 .ani 或 .cur 档案名称")
SetSystemCursor(hCursor, OCR_NORMAL)
//若要将鼠标游标还原原状， 则是执行以下叙述：
long ll_temp
ll_temp=0
hCursor = LoadCursor(0, IDC_ARROW)
SetSystemCursor(hCursor, OCR_NORMAL)
31、如何设定屏幕分辨率
原则上，只改这一次，下一次开机会还原，但如果需重开机，才会Update
Registry中的设定，并重开机。
如果要永久设定其设定值，请将
b = ChangeDisplaySettings(DevM, 0) 改成
b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
实现步骤：
定义结构：
type devmode from structure
string dmdevicename
integer dmspecversion
integer dmdriverversion
integer dmsize
integer dmdriverextra
long dmfields
integer dmorientation
integer dmpapersize
integer dmpaperlength
integer dmpaperwidth
integer dmscale
integer dmcopies
integer dmdefaultsource
integer dmprintquantity
integer dmcolor
integer dmduplex
integer dmyresolution
integer dmttoption
integer dmcollate
string dmformname
integer dmunusedpadding
long dmbitsperpel
long dmpelswidth
long dmpelsheight
long dmdisplayflags
long dmdisplayfrequency
end type
定义外部函数引用声明：
Function long EnumDisplaySettings (long lpszDeviceName, long iModeNum , lpDevMode As DevMode) Library "user32.dll" Alias for "EnumDisplaySettingsA"
Function long ChangeDisplaySettings (DevMode lpDevMode , long dwflags) Library "user32" Alias for "ChangeDisplaySettingsA"
Function long ExitWindowsEx (long uFlags , long dwReserved ) Library "user32.dll"
定义实例变量：
Constant long EWX_REBOOT = 2// 注释： 重开机
Constant long CCDEVICENAME = 32
Constant long CCFORMNAME = 32
Constant long DM_BITSPERPEL = 262144
Constant long DISP_CHANGE_SUCCESSFUL = 0
Constant long DISP_CHANGE_RESTART = 1
Constant long CDS_UPDATEREGISTRY = 1
DevMode DevM
w_example窗口的命令按钮cb_1.clicked:
long i,b,ans,a
a = EnumDisplaySettings(0, 0, DevM) //注释：Initial Setting
DevM.dmFields = DM_PELSWIDTH + DM_PELSHEIGHT
DevM.dmPelsWidth = 800 // 注释：设定成想要的分辨率
DevM.dmPelsHeight = 600
b = ChangeDisplaySettings(DevM, 0) //注释：Changed Only this time
If b = DISP_CHANGE_RESTART Then
ans = MsgBox("提示","要重开机设定才能完成，重开？", question!,yesno!)
If ans = 1 Then
b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
// 注释：after this , Will Update in Registry
ExitWindowsEx(EWX_REBOOT, 0)
// 只能在win98下这样使用，在win nt以上须采用别的方法实现系统的重新启动
End If
Else
If b <> DISP_CHANGE_SUCCESSFUL Then
MessageBox("提示","设定有误")
End If
End If
32、取得Window, System, Temp所在目录
外部函数引用声明：
Function uint GetWindowsDirectoryA(ref string lpBuffer,uint uSize) Library "kernel32.dll"//windows目录
Function uint GetSystemDirectoryA(ref string lpBuffer,uint uSize) Library "kernel32.dll"//system目录
Function ulong GetTempPathA(ulong nBufferLength,ref string lpBuffer) Library "kernel32.dll"//temp目录
public function string of_get_windows ();
/*函数作用:获取windows文件夹名 返回值:string */
string ls_Buffer
ulong ll_RequiredBufferSize
ls_Buffer=Space(255)
ll_RequiredBufferSize=GetWindowsDirectoryA(ls_Buffer,255)
IF ll_RequiredBufferSize=0 or ll_RequiredBufferSize>255 THEN SetNull(ls_Buffer)
RETURN ls_Buffer
end function
public function string of_get_system ();
/*函数作用:获取系统文件夹名 返回值:string */
string ls_Buffer
ulong ll_RequiredBufferSize
ls_Buffer=Space(255)
ll_RequiredBufferSize=GetSystemDirectoryA(ls_Buffer,255)
IF ll_RequiredBufferSize=0 or ll_RequiredBufferSize>255 THEN SetNull(ls_Buffer)
RETURN ls_Buffer
end function
public function string of_get_temp ();
/*函数作用:获取系统临时文件夹名 返回值:string */
ulong nBufferLength=255
string lpBuffer
lpbuffer=fill(' ',255)
GetTempPath(nBufferLength,lpBuffer)
return lpbuffer
end function
33、创建不规则窗体
实现步骤：
定义结构
Type POINTAPI from structure
long x
long y
End Type
定义外部函数引用声明：
Function long CreatePolygonRgn (Pointapi lpPoint , long nCount , long nPolyFillMode) Library "gdi32.dll"
Function long SetWindowRgn (long hWnd , long hRgn, boolean bRedraw ) Lib "user32.dll"
定义实例变量：
Pointapi XYPOINT[]
窗口w_example的命令按钮cb_1.clicked:
//定义区域句柄
long hRgn,lRes
//确定T型顶点坐标的值
XYPOINT[1].X = 0
XYPOINT[1]Y = 0
XYPOINT[2].X =unitstopixels(parant.width,xunitstopixels!)
XYPOINT[2].Y = 0
XYPOINT[3].X = unitstopixels(parant.width,xunitstopixels!)
XYPOINT[3].Y =unitstopixels(parant.height/2,yunitstopixels!)
XYPOINT[4].X = unitstopixels(parant.width,xunitstopixels!) - unitstopixels(parant.width,xunitstopixels!)/3
XYPOINT[4].Y = unitstopixels(parant.height/2,yunitstopixels!)
XYPOINT[5].X = unitstopixels(parant.width,xunitstopixels!) - unitstopixels(parant.width,xunitstopixels!)/3
XYPOINT[5].Y = unitstopixels(parant.height,yunitstopixels!)
XYPOINT[6].X = unitstopixels(parant.width,xunitstopixels!) /3
XYPOINT[6].Y = unitstopixels(parant.height,yunitstopixels!)
XYPOINT[7].X = unitstopixels(parant.width,xunitstopixels!) /3
XYPOINT[7].Y = unitstopixels(parant.width,yunitstopixels!) /2
XYPOINT[8].X = 0
XYPOINT[8].Y = unitstopixels(parant.height,yunitstopixels!) /2
hRgn = CreatePolygonRgn(XYPOINT[1], 8, 1)
lRes = SetWindowRgn(handle(this), hRgn, True)
34、获取指定的驱动器的卷标名称
外部函数引用声明：
Function boolean GetVolumeInformationA(string lpRootPathName,ref string lpVolumeNameBuffer,ulong nVolumeNameSize,ref ulong lpVolumeSerialNumber,ref ulong lpMaximumComponentLength,ref ulong lpFileSystemFlags,ref string lpFileSystemNameBuffer,ulong nFileSystemNameSize) LIBRARY "kernel32.dll"
public function string of_get_drive_volumename (string as_drive);/*函数作用:获取指定的驱动器的卷标名称
参数:as_drive string 驱动器名
返回值:string */
string ls_VolumeNameBuffer
ulong ll_VolumeSerialNumber
ulong ll_MaximumComponentLength
ulong ll_FileSystemFlags
string ls_FileSystemNameBuffer
as_drive=Left(as_drive,1)+":"
ls_VolumeNameBuffer=Space(20)
ls_FileSystemNameBuffer=Space(20)
IF not GetVolumeInformationA(as_drive,ls_VolumeNameBuffer,20,ll_VolumeSerialNumber,ll_MaximumComponentLength,ll_FileSystemFlags,ls_FileSystemNameBuffer,20) THEN
SetNull(ls_VolumeNameBuffer)
END IF
RETURN ls_VolumeNameBuffer
end function
35、检测声卡和音量设置
实现步骤：
定义实例变量：
Constant long HIGHEST_VOLUME_SETTING = 100
Constant long AUX_MAPPER = -1
Constant long MAXPNAMELEN = 32
Constant long AUXCAPS_CDAUDIO = 1
Constant long AUXCAPS_AUXIN = 2
Constant long AUXCAPS_VOLUME = 1
constant long AUXCAPS_LRVOLUME =2
Constant long MMSYSERR_NOERROR = 0
Constant long MMSYSERR_BASE = 0
Constant long MMSYSERR_BADDEVICEID = 2
定义结构
Type AUXCAPS from structure
integer wMid
integer wPid
long vDriverVersion
string szPname
integer wTechnology
long dwSupport
End Type
Type VolumeSetting from structure
integer LeftVol
integer RightVol
End Type
定义外部函数引用声明：
Function long auxGetNumDevs() Library "winmm.dll"
Function long auxGetDevCaps (long uDeviceID, AUXCAPS lpCaps, long uSize) Library "winmm.dll" Alias for "auxGetDevCapsA"
Function long auxSetVolume(long uDeviceID , long dwVolume) Library "winmm.dll"
Function long auxGetVolume (long uDeviceID, ref VolumeSetting lpdwVolume) Library "winmm.dll"
Subroutine CopyMemory (VolumeSetting hpvDest ,VolumeSetting hpvSource, long cbCopy)Library "kernel32.dll" Alias for "RtlMoveMemory"
定义窗口级函数:
Function integer wf_nSigned(long lUnsignedInt )
integer nReturnVal
If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
Messagebox("error", "Error in conversion from Unsigned to nSigned Integer")
return 0
End If
If lUnsignedInt > 32767 Then
nReturnVal = lUnsignedInt - 65536
Else
nReturnVal = lUnsignedInt
End If
return nRetrunVal
Function long wf_lUnsigned(integer nSignedInt )
long lReturnVal
If nSignedInt < 0 Then
lReturnVal = nSignedInt + 65536
Else
lReturnVal = nSignedInt
End If
If lReturnVal > 65535 Or lReturnVal < 0 Then
messagebox("error","Error in conversion from nSigned to Unsigned Integer")
lReturnVal = 0
End If
return lReturnVal
Function long lSetVolume(ref long lLeftVol , Ref long lRightVol, long lDeviceID)
long lReturnVal
VolumeSetting Volume
long lBothVolumes
Volume.LeftVol = wf_nSigned(lLeftVol * 65535 / HIGHEST_VOLUME_SETTING)
Volume.RightVol = wf_nSigned(lRightVol * 65535 / HIGHEST_VOLUME_SETTING)
//copy our Volume-variable to a long
CopyMemory (lBothVolumes, Volume.LeftVol,64)
//call the SetVolume-function
lReturnVal = auxSetVolume(lDeviceID, lBothVolumes)
return lReturnVal
窗口w_example的open事件：
VolumeSetting Volume,
long Cnt
AUXCAPS AC //set the output to a persistent graphic
this.setredraw(false)
//loop through all the devices
For Cnt = 0 To auxGetNumDevs - 1 //auxGetNumDevs is zero-based
//get the volume
auxGetVolume(Cnt, Volume)
//get the device capabilities
auxGetDevCaps(Cnt, AC, 1024)
//print the name on the form
st_1.text=st_1.text+"Device #" + String(Cnt + 1) + ": " + AC.szPname
//print the left- and right volume on the form
st_1.text=st_1.text+ "Left volume:" + String(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.LeftVol) / 65535)
st_1.text=st_1.text+ "Right volume:" + String(HIGHEST_VOLUME_SETTING * lUnsigned(Volume.RightVol) / 65535)
//set the left- and right-volume to 50%
lSetVolume(50, 50, Cnt)
messagebox("clue","Both volumes now set to 50%")
Next
36、获取网卡的MAC地址
实现步骤：
定义结构：
type str_ipaddrrow from structure
long addr
long interface
long m
long b
long as
integer u1
integer u2
end type
type str_ipaddrtable from structure
long numentries
str_ipaddrrow table[6]
end type
type str_ipnetrow from structure
long index
long physaddrlen
character bphysaddr[8]
long addr
long iptype
end type
type str_ipnettable from structure
long numentries
str_ipnetrow table[255]
end type
type str_ipnettable1 from structure
long numentries
long asd
end type
type str_mac from structure
character mac[8]
end type
定义外部函数引用声明：
FUNCTION long gethostbyaddr(ref long addr, long addr_len,long addr_type) LIBRARY "ws2_32.dll"
SUBROUTINE RtlMoveMemoryString(ref string hpvDest,long hpvSource,long cbCopy) LIBRARY "kernel32.dll" ALIAS FOR "RtlMoveMemory"
FUNCTION long GetIpAddrTable(ref str_ipaddrtable llll, ref long addr_len,boolean ip_sort) LIBRARY "iphlpapi.dll"
FUNCTION LONG inet_addr( ref string cp ) LIBRARY "ws2_32.dll"
FUNCTION LONG GetIpNetTable(ref str_ipnettable llll, ref long addr_len,boolean ip_sort) LIBRARY "iphlpapi.dll"
FUNCTION LONG DeleteIpNetEntry(ref str_ipnetrow ip) LIBRARY "iphlpapi.dll"
FUNCTION LONG FlushIpNetTable(long ip) LIBRARY "iphlpapi.dll"
FUNCTION LONG SendARP(long ip, long ipsur ,ref str_mac str, ref long len) LIBRARY "iphlpapi.dll"
实现函数：
public function string uf_getmac (string as_ip);str_ipnettable lstr_table //ARP表
long ll_buffer //缓冲区大小
boolean lb_type // 排序
str_mac lstr_mac
long ll_len
long ll_type, ll_inetaddr, ll_row
string ls_ip, ls_mac
ls_ip = TRIM(as_ip)
ll_inetaddr = inet_addr(ls_ip)
lb_type = false
ll_type = GetIpNetTable(lstr_table, ll_buffer, lb_type) //第一次得到缓冲区大小
ll_type = GetIpNetTable(lstr_table, ll_buffer, lb_type)
if ll_type=0 then //ARP表中有ip地址
for ll_row=1 to lstr_table.numentries
if lstr_table.table[ll_row].addr = ll_inetaddr then
//找到所指定的ip删除
ll_type = DeleteIpNetEntry(lstr_table.table[ll_row])
end if
next
end if
ll_len = 8
ll_type = SendARP(ll_inetaddr, 0, lstr_mac, ll_len)
if ll_type <>0 then return '12345' //没有找到
for ll_row =1 to 6
ls_mac += string(asc(lstr_mac.mac[ll_row]))
next
Return left(ls_mac,len(ls_mac)-1)
37、调用系统的“运行程序“对话框、”查找文件“对话框、更改与文件相关联的图标对话框
实现步骤：
定义结构：
Type BrowseInfo from structure
long hwndOwner
long Root
long splayName
long itle
long ulFlags
long lpfnCallback
long lParam
long iImage
End Type
定义外部函数引用声明：
Function long SHObjectProperties (long hwndOwner ,long uFlags , string lpstrName, string lpstrPar)Library "Shell32.dll"
Subroutine CoTaskMemFree (long hMem ) Library "ole32.dll"
Function long SHBrowseForFolder (Browseinfo lpbi) Library "Shell32.dll"
Function long SHFindFiles (long pIDLRoot ,long pidlSavedSearch) Library "Shell32.dll"
Function long GetFileNameFromBrowse ( long hwndOwner,string lpstrFile, long nMaxFile , string lpstrInitDir, string lpstrDefExt , string lpstrFilter, string lpstrTitle ) Library "Shell32.dll"
Subroutine PickIconDlg (long hwndOwner , string lpstrFile, long nMaxFile, long lpdwIconIndex )Library "Shell32.dll"
Function long SHRunFileDlg (long hOwner , long hIcon ,string lpstrDirectory ,string szTitle , string szPrompt, long uFlags) Library "Shell32.dll"
定义实例变量：
Constant long BIF_RETURNONLYFSDIRS = 1
Constant long MAX_PATH = 260
实现代码：
w_example.cb_1.clicked://运行程序示例
SHRunFileDlg (handle(parent), handle(parent.Icon), "c:/windows", "运行程序演示", "在文本框中输入程序名或按浏览键查找程序", 0)//handle(parent.icon)这个须是一个icon图标的句柄
w_example.cb_2.clicked://更改图标示例
long a
string astr
astr = "c:/windows/notepad.exe"
PickIconDlg (handle(parent), astr, 1, a)
w_example.cb_3.clicked://打开文件示例
string astr ,bstr bstr = "c:/windows"
GetFileNameFromBrowse(handle(parent), astr, 256, bstr, "*.txt", "文本文件 *.txt", "Open Sample")
messagebox("提示",astr)
w_example.cb_4.clicked://查找文件示例
long lpIDList
Browseinfo udtBI
// 注释：初试化udtBI结构
udtBI.hwndOwner = handle(parent)
udtbl.ulFlags = BIF_RETURNONLYFSDIRS
//注释：弹出文件夹查看窗口
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
// 注释：查找文件
SHFindFiles( lpIDList, 0)
CoTaskMemFree(lpIDList)
End If
w_example.cb_5.clicked://显示文件属性示例
SHObjectProperties(handle(parent), 2, "c:/windows/notepad.exe", "Samples")
38、判断一个文件是否在IE的缓存中
当你建立一个联到网上文件的快捷方式时，你可能需要知道它是否已经被访问过，于是你就可以适当地改变链接的颜色等
。这则小技巧就是告诉你如何判断一个文件是否在Internet Explorer的缓存中，以满足你的须要。
实现步骤：
定义实例变量：
Constant long ERROR_INSUFFICIENT_BUFFER = 122
Constant long eeErrorBase = 26720
Constant long FORMAT_MESSAGE_ALLOCATE_BUFFER = 256
Constant long FORMAT_MESSAGE_ARGUMENT_ARRAY = 8192
Constant long FORMAT_MESSAGE_FROM_HMODULE = 2048
Constant long FORMAT_MESSAGE_FROM_STRING = 1024
Constant long FORMAT_MESSAGE_FROM_SYSTEM = 4096
Constant long FORMAT_MESSAGE_IGNORE_INSERTS =512
Constant FORMAT_MESSAGE_MAX_WIDTH_MASK = 255
定义结构：
Type FILETIME from structure
long dwLowDateTime
long dwHighDateTime
End Type
Type INTERNET_CACHE_ENTRY_INFO from structure
long dwStructSize
string lpszSourceUrlName
strng lpszLocalFileName
string CacheEntryType
long dwUseCount
long dwHitRate
long dwSizeLow
long dwSizeHigh
filetime LastModifiedTime
filetime ExpireTIme
filetime LastAccessTime
filetime LastSyncTime
long lpHeaderInfo
long dwHeaderInfoSize
string lpszFileExtension
long dwReserved
End Type
定义外部函数引用声明：
Function long GetUrlCacheEntryInfo (string sUrlName , INTERNET_CACHE_ENTRY_INFO lpCacheEntryInfo, long lpdwCacheEntryInfoBufferSize) Library "wininet.dll" Alias for "GetUrlCacheEntryInfoA"
Function long FormatMessage (long dwFlags,long lpSource, long MessageId , long dwLanguageId , string lpBuffer, long nSize ,long Arguments ) Library "kernel32.dll" Alias for "FormatMessageA"
定义窗口级函数:
Function string wf_WinAPIError(long lLastDLLError)
string sBuff ,s_return
long lCount
// 注释：返回与LastDLLError相关的出错信息：
sBuff =space(256)
lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0, sBuff, 256, 0)
If lCount>0 Then
s_return = Left(sBuff, lCount)
End If
return s_return
Function boolean GetCacheEntryInfo(long hWnd, string lpszUrl )
long dwEntrySize=1024
INTERNET_CACHE_ENTRY_INFO lpCacheEntry
return GetUrlCacheEntryInfo(lpszUrl, lpCacheEntry ,dwEntrySize)) <> 0
窗口的w_example.cb_1.clicked：
If (GetCacheEntryInfo(handle(this), sle_1.Text))=true Then
Messagebox("提示", "URL In Cache.")
Else
Messagebox("提示", "URL Not In Cache.")
End If
39、格式化磁盘
//在Drive的参数中 "A:" = 0，类推。
Constant long SHFMT_ID_DEFAULT =65535//Currently the only fmtID supported.
Function long SHFormatDrive(long hWnd , long Drive, long fmtID , long Options) Library "shell32.dll"
w_example.cb_1.clicked:
long lret
lret = SHFormatDrive(handle(parent), 0, SHFMT_ID_DEFAULT, 0)
choose Case lret
Case -2
messagebox("提示", "磁盘格式化成功!")
Case -3
messagebox("提示","不能格式化只读的磁盘！")
End choose
40、获取操作系统使用的语言集：
Function long GetSystemDefaultLCID () Library "kernel32.dll"
例子：
long LocaleID
LocalID = GetSystemDefaultLCID()
choose case LocalelID
case 1028
messagebox("提示","中文繁体（台湾）")
case 2051
messagebox("提示","中文简体（大陆）")
case 1033
messagebox("提示","英文 ... ")
end choose
41、判断是否连接internet
定义外部函数引用声明：
Function long InternetSetDialState(string lpszConnectoid , long dwState , long dwReserved ) Library "wininet.dll"
Function long InternetOpen (string sAgent , long lAccessType, string sProxyName, string sProxyBypass , long lFlags ) Library "wininet.dll" Alias for "InternetOpenA"
Function long InternetGetConnectedStateEx (ref long lpdwFlags ,string lpszConnectionName, long dwNameLen , long dwReserved) Library "wininet.dll" Alias for "InternetGetConnectedStateExA"
定义实例变量：
constant long INTERNET_CONNECTION_MODEM = 1
constant long INTERNET_CONNECTION_LAN = 2
constant long INTERNET_CONNECTION_PROXY = 4
constant long INTERNET_RAS_INSTALLED = 16
constant long INTERNET_CONNECTION_OFFLINE = 32
constant long INTERNET_CONNECTION_CONFIGURED = 64
long eR
string sMsg
string sName
boolean bConnected
实现代码：
//InternetConnected 函数判断是否连接到Internet的函数,获得是否以及通过何中方式连接到Internet上
Function boolean wf_InternetConnected(ref long eConnectionInfo , ref string sConnectionName )
long dwFlags
string sNameBuf
long lR
long iPos
sNameBuf = space(513)
lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0)
eConnectionInfo = dwFlags
iPos =pos(sNameBuf, " ")
If iPos > 0 Then
sConnectionName = Left(sNameBuf, iPos - 1)
ElseIf Not sNameBuf =space(513) Then
sConnectionName = sNameBuf
End If
return lr=1
42、控制由Run运行的程序（简称Run程序）
在PB程序设计中，可以用Run()来运行一些程序。但Run程序无法与PB主程序协调
工作，若用户多次调用，就会启动Run程序的多个实例，主程序退出时，Run程序
依然运行。可以用如下函数使它们协调工作：
function Ulong FindWindowA(Ulong classname, String windowname)
Library "user32.dll”
function Long SetParent(Long childwin, Long parentwin) Library "user32.dll”
（1） 使Run程序只运行一个实例
handle = FindWindowsA(nul,wtitle)
//查找Run程序是否已经运行，wtitle为Run程序的窗口标题
If handle > 0 Then Return
//若已经在运行就返回
Run(“c:/luhan.chm”)
//否则运行Run程序
（2） PB主程序退出时，Run程序也关闭
Handle = FindWindowA(nul,wtitle)
SetParent(handle,Handle(w_main))
//使Run程序窗口成为PB主程序的子窗口
43、和取消映像网络驱动器
若要在程序中把远程主机的资源映像到本地驱动器，可以用如下函数：
function Long WNetAddConnectionA(String path, String pwd, String drv)
Library “mpr.dll”
如下代码可以把远程主机Alexander上的共享文件夹My Documents映像到本地的J
盘：
WnetAddConnectionA(“// Alexander/ My Documents”,””,”J:”) //参数2
为访问口令
它的作用相当于在DOS提示符下执行：Net Use J: // Alexander/ My Documents
取消网络映像盘：
Function long WNetCancelConnectionA(string lpszName,long bForce) Library "mpr.dll"
String lpszName ﹐已连接資源的远端盘符或本地盘符
long bForce, 如为TRUE﹐表示切断连接(即使连接的资源上正有打开的文件或作业)
44、如何在PB中播放音乐
PB没有提供任何多媒体函数，要播放音乐只能通过Win32 API的PlaySound来实现：
function Long PlaySound(String Filename, Int Mod, Int Flags) Library "winmm.dll"
参数1为wav文件名，参数2必须取0，参数3取1表示后台播放，取8表示循环播放，
因此取9（=1+8）表示在后台循环播放。
45、如何将长文件名转换为短文件名
通过GetShortPathName函数可以把上文件名转换为8.3格式，其声明为：
Function Long GetShortPathNameA(String lf, ref String sf, Long buflen) Library “kernel32.dll”
参数1为长文件名，参数2为保存短文件名的缓冲区，参数3为缓冲区长度。例如：
GetShortPathNameA(“C:/My Document/Powerbuilder编程实践.Doc”,sf,256) /
//sf = Spcace(256)
46、如何使PB窗口总在最上层
通过SetWindowPos函数吧窗口的显示层次修改为HWND_TOPMOST，就可以使指定窗口永远不会被其他窗口覆盖，该函数声明为：
Function Long SetWindowPos( long hwnd, Long ord, Long x, Long y, Long dx, Long dy, Long uflag)
Library "user32.dll"
参数1为要顶层显示的窗口句柄，参数2指定显示的层次，参数7为附加选项，其余参数指定窗口位置和大小，均可忽略。
在窗口的Open或Activate事件中加入如下函数调用：
SetWindowPos(Handle(This),-1,0,0,0,0,3)
参数2取-1表示在最顶层显示窗口，取1表示在最底层显示；最后一个参数若取1，表示窗口大小保持不变，取2表示保持位置不变，因此，取3（=1+2）表示大小和位置均保持不变，取0表示将窗口的大小和位置改变为指定值。
亦可调用api函数：
Function long SetForegroundWindow (long hWnd ) Lib "user32.dll"
实现窗口的永远置于最顶层
47、复制文件
PowerBuilder 提供了过时的FileCopy语句.问题是使用该函数时并不显示文件复制对话框,也就是说,当拷贝一个大文件时,用
户看不到Windows的标准文件复制对话框,无法从进度条上判断当前复制的进度.那么,如何做到这一点呢?
可以通过调用api函数实现这样的功能，具体步骤如下：
定义结构：
Type SHFILEOPSTRUCT from structure
long hWnd
long wFunc
string pFrom
string pTo
integer fFlags
boolean fAnyOperationsAborted
long hNameMappings
string lpszProgressTitle
End Type
外部函数引用声明：
Function long SHFileOperation ( SHFILEOPSTRUCT lpFileOp) Library "shell32.dll" Alias for "SHFileOperationA"
定义实例变量：
Constant long FO_COPY = 2
Constant long FOF_ALLOWUNDO =64
实现函数为：
boolean wf_ShellCopyFile(string Source , string Dest)
//函数返回值为:boolean,成功执行，返回true,未成功返回false
//参数：string source为源文件
// string dest为目标文件
boolean ib_return
long result
SHFILEOPSTRUCT fileop
初始化结构体
fileop.hwnd = 0
fileop.wFunc = FO_COPY
fileop.pFrom = Source
fileop.pTo = Dest
fileop.fFlags = FOF_ALLOWUNDO
result = SHFileOperation(fileop)
If result ＜＞ 0 Then
return false
ElseIf fileop.fAnyOperationsAborted ＜＞ 0 Then
return false
End If
return true
48、如何列出系统正在进行的程序及强行关闭该程序
1、Declare四个Win32Api函数。
Function Long GetCurrentProcessId() Library "kernel32.dll"
Function Long CreateToolhelp32Snapshot(Long Flags,Long ProcessId) Library "kernel32.dll"
Function Integer Process32First(uLong Snapshot,ref s_Process Process) Library "kernel32.dll"
Function Integer Process32Next(uLong Snapshot,ref s_Process Process) Library "kernel32.dll"
2、定义s_Process结构
unsignedlong structsize
unsignedlong usage
unsignedlong processid
unsignedlong defaultheapid
unsignedlong moduleid
unsignedlong threads
unsignedlong parentprocessid
unsignedlong classbase
unsignedlong flags
character filename[260]
3、调用示例(此函数查找在系统中是否已有当前程序的复本在运行)
s_Process lst_Process //进程结构
String ls_FileName[100],ls_CurExeName //最多100个进程，可改进
ulong ln_ProcessID,ln_SameCount,ln_Snapshot,ln_Circle,ln_Count
ln_ProcessID = GetCurrentProcessId() //取当前进程的ID
if IsNull(ln_ProcessID) or ln_ProcessID<1 then return -1 //出错则返回
ln_Snapshot = CreateToolhelp32Snapshot(2,0) //在堆上创建进程快照
if (ln_Snapshot<1) then return -1 //出错则返回
lst_Process.StructSize = 296 //Win32api的Process结构大小
ln_SameCount = 0 //复本数为0
if Process32First(ln_Snapshot,lst_Process)=0 then return -1 //取第一个进程失败则返回
ln_Count = 1
ls_FileName[ln_Count] = lst_Process.FileName //列举的进程名称放入数组
//如列举到的进程ID等于当前进程ID,则知道了当前进程的名称,保存
if lst_Process.ProcessID=ln_ProcessID then ls_CurExeName=lst_Process.FileName
do while true //循环取列举的进程名称，放入数组
if Process32Next(ln_Snapshot,lst_Process)=0 then exit //列举完毕
ln_Count = ln_Count + 1
ls_FileName[ln_Count] = lst_Process.FileName
if lst_Process.ProcessID=ln_ProcessID then ls_CurExeName=lst_Process.FileName
loop
for ln_Circle=1 to ln_Count //计算系统中有几个同名进程
if ls_CurExeName=ls_FileName[ln_Circle] then ln_SameCount=ln_SameCount+1
next
return ln_SameCount //如当前进程无复本在运行，返回1;否则有几个在运行则返回几
49、如何判断显示模式是大字体还是小字体
一个近似的方法是使用GetDeviceCaps()获得LOGPIXELSY和LOGPIXELSX的设置，一般的每英寸96个点为小字体，而
120个点为大字体。不过修改字体设置必须要重新启动计算机。
微软推荐的检测大/小字体的方法（Windows 95, Windows 98, Windows Me, or Windows NT 3.51）是调用API函数
GetTextMetrics()。Windows显示驱动在小字体模式下使用VGASYS.FON，而在大字体模式下使用8514SYS.FON 。
下面是一个例子：
定义结构：
Type TEXTMETRIC from structure
integer tmHeight
integer tmAscent
integer tmDescent
integer tmInternalLeading
integer tmExternalLeading
integer tmAveCharWidth
integer tmMaxCharWidth
integer tmWeight
string tmItalic
string tmUnderlined
string tmStruckOut
string tmFirstChar
string tmLastChar
string tmDefaultChar
string tmBreakChar
string tmPitchAndFamily
string tmCharSet
integer tmOverhang
integer tmDigitizedAspectX
integer tmDigitizedAspectY
End Type
定义外部函数引用声明：
Function long GetTextMetrics(long hdc , TEXTMETRIC lpMetrics) Libraray "gdi32.dll" Alias for "GetTextMetricsA"
Function long GetDesktopWindow() Library "user32.dll"
Function long GetWindowDC(long hwnd) Library "user32.dll"
Function long ReleaseDC (long hwnd, long hdc)Library "user32.dll"
Function long SetMapMode (long hdc, long nMapMode ) Library "gdi32.dll"
定义窗口级实例变量：
Constant long MM_TEXT = 1
实现函数：
Function string wf_GetFontRes()
long hdc, hwnd, PrevMapMode
TEXTMETRIC tm
string ls_return
//默认返回小字体
ls_return= "VGA"
//获得桌面窗口的句柄
hwnd = GetDesktopWindow()
//获得桌面的上下文句柄
hdc = GetWindowDC(hwnd)
If hdc<>0 Then
//设置映射方式为点阵
//PrevMapMode = SetMapMode(hdc, MM_TEXT)
//获得系统字体的大小
GetTextMetrics(hdc, tm )
//设置映射方式回原来的值
// PrevMapMode = SetMapMode(hdc, PrevMapMode)
// 释放设备上下文句柄
ReleaseDC( hwnd, hdc )
//如果系统字体大于16个像素，则使用大字体
If tm.tmHeight > 16 Then ls_return= "8514"
End If
return ls_return
50、获取系统进程列表
实现步骤：
定义结构：
type processentry32 from structure
unsignedlong dwsize
unsignedlong cntusage
unsignedlong th32processid
unsignedlong th32defaultheapid
unsignedlong th32moduleid
unsignedlong cntthreads
unsignedlong th32parentprocessid
long pcpriclassbase
unsignedlong dwflags
character szexefile[260]
end type
type moduleentry32 from structure
unsignedlong dwsize
unsignedlong th32moduleid
unsignedlong th32processid
unsignedlong glblcntusage
unsignedlong proccntusage
unsignedlong modbaseaddr
unsignedlong modbasesize
unsignedlong hmodule
character szmodule[256]
character szexepath[260]
end type
type THREADENTRY32 from structure
ulong dwSize
ulong cntUsage
ulong th32ThreadID
ulong th32OwnerProcessID
long tpBasePri
long tpDeltaPri
ulong dwFlags
end type
定义外部函数引用：
function long CreateToolhelp32Snapshot(ulong dwFlags, ulong th32ProcessID) library "kernel32"
function boolean Process32First(long hSnapshot, ref PROCESSENTRY32 lppe) library "kernel32"
function boolean Process32Next(long hSnapshot, ref PROCESSENTRY32 lppe) library "kernel32"
function boolean Module32First(long hSnapshot, ref MODULEENTRY32 lpme) library "kernel32"
function boolean Module32Next(long hSnapshot, ref MODULEENTRY32 lpme) library "kernel32"
function boolean Thread32First(ulong hSnapshot, ref THREADENTRY32 lpte) library "kernel32"
function boolean Thread32Next(ulong hSnapshot, ref THREADENTRY32 lpte) library "kernel32"
function boolean CloseHandle(long hObject) library "kernel32"
定义窗口实例变量：
constant long TH32CS_SNAPHEAPLIST = 1
constant long TH32CS_SNAPPROCESS = 2
constant long TH32CS_SNAPTHREAD = 4
constant long TH32CS_SNAPMODULE = 8
实现函数：
public subroutine of_getprocesslist ();long hSnapshot
string ls_caption
listviewitem l_tvi
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
if hSnapshot <= 0 then return
PROCESSENTRY32 pe
pe.dwSize = 296 //sizeof(pe)
Process32First(hSnapshot, pe)
do while true
ls_caption = string(pe.szExeFile) + "~t" + string(pe.th32ProcessID) +"~t" + string(pe.cntThreads)
l_tvi.label = ls_caption
l_tvi.data = long(pe.th32ProcessID )
l_tvi.pictureindex = 1
lv_list.AddItem(l_tvi)
if not Process32Next(hSnapshot, pe) then exit
loop
CloseHandle(hSnapShot)
end subroutine
51、获取定义进程所调用的模块
public subroutine of_getmodulelist (long processid);lv_module.DeleteItems()
long hModuleShot
listviewitem l_tvi
MODULEENTRY32 me
me.dwSize = 548
hModuleShot = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE, processid)
if hModuleShot <= 0 then return
Module32First(hModuleShot, me)
do while true
l_tvi.label = me.szModule + "~t" + me.szExePath
l_tvi.pictureindex = 1
l_tvi.data = me.hModule
lv_module.AddItem(l_tvi)
if not Module32Next(hModuleShot, me) then exit
loop
CloseHandle(hModuleShot)
end subroutine
52、 枚举所有窗口的入口函数
实现步骤：
定义窗口实例变量：
Constant long GW_CHILD = 5
Constant long GW_HWNDNEXT = 2
定义外部函数引用声明：
function ulong GetDesktopWindow() library "user32"
Function int GetClassName(ulong hWnd, ref string lpClassName, int nMaxCount) library "user32" alias for "GetClassNameA"
function long GetWindowText(long hwnd, ref string lpString, long nMaxCount) library "user32" alias for "GetWindowTextA"
function long IsWindowVisible(ulong hwnd) library "user32"
实现代码：
ulong hWnd, hTreeItem
string ls_classname, ls_caption, ls_handle
TreeViewItem l_tvi
hWnd = GetDesktopWindow()//获取桌面窗口的句柄
ls_classname = space(255)
GetClassName(hWnd, ls_classname, 255)//获取桌面窗口的窗口类型
//显示桌面窗口的相关信息
l_tvi.label =wf_Dec2Hex(hWnd, 8) + "(Dec:" + string(hWnd) + ")" + " " + ls_classname + ' -- "桌面"'
l_tvi.data = hWnd
l_tvi.PictureIndex = 1
l_tvi.SelectedPictureIndex = 1
hTreeItem = tv_win.InsertItemLast(0, l_tvi)
//调用函数wf_enumwin()显示桌面窗口所有的子窗口
wf_EnumWin(hWnd, hTreeItem)
tv_win.ExpandItem(hTreeItem)
private subroutine wf_enumwin (unsignedlong hparentwnd, unsignedlong hparenttreeitem)
function ulong GetWindow(ulong hWnd, int uCmd) library "user32"
function long GetWindowText(long hwnd, ref string lpString, long nMaxCount) library "user32" alias for "GetWindowTextA"
ulong hWnd, hTreeItem
string ls_classname, ls_handle, ls_caption
long ll_pictureindex
TreeViewItem l_tvi
ls_classname = space(255)
ls_caption = space(255)
hWnd = GetWindow(hParentWnd, GW_CHILD)//获取指定窗口的子窗口的句柄
do while hWnd > 0
GetClassName(hWnd, ls_classname, 255)//获取窗口的类型
GetWindowText(hWnd, ls_caption, 255)//获取窗口的标题栏中的文字
SendMessage(hWnd, 13, 255, ls_caption)//向窗口发送消息
ls_handle = wf_Dec2Hex(hWnd, 8)//转化10进制为16进制
if IsWindowVisible(hWnd) > 0 then//判断窗口是否为可见
ll_pictureindex = 1
else
ll_pictureindex = 2
end if
l_tvi.label = ls_handle + "(Dec:" + string(hWnd) + ")" + " " + ls_classname + ' -- "' + ls_caption + '"'
l_tvi.data = hWnd
l_tvi.PictureIndex = ll_pictureindex
l_tvi.SelectedPictureIndex = ll_pictureindex
hTreeItem = tv_win.InsertItemLast(hParentTreeItem, l_tvi)
wf_EnumWin(hWnd, hTreeItem)//递归调用函数wf_enumwin()获取该窗口的所有子窗口
hWnd =GetWindow(hWnd,GW_HWNDNEXT)//获取下一个子窗口
loop
end subroutine
53、使菜单项左对齐
定义结构：
type menuiteminfo from structure
long cbsize
long fmask
long ftype
long fstate
long wid
long hsubmenu
long hbmpchecked
long hbmpunchecked
long dwitemdata
string dwtypedata
long cch
end type
定义外部函数引用：
FUNCTION ulong SetMenuItemInfo(ulong hMenu,ulong un,boolean bool,ref MENUITEMINFO lpcMenuItemInfo) LIBRARY "user32.dll" ALIAS FOR "SetMenuItemInfoA"
FUNCTION ulong GetMenuItemInfo(ulong hMenu,ulong un,boolean b,ref MENUITEMINFO lpMenuItemInfo) LIBRARY "user32.dll" ALIAS FOR "GetMenuItemInfoA"
FUNCTION ulong DrawMenuBar(ulong hwnd) LIBRARY "user32.dll"
FUNCTION ulong GetMenu(ulong hwnd) LIBRARY "user32.dll"
实现函数：
long wf_setmenu_position(long handle,long position)
/*参数long handle 窗口的的句柄
long position 是菜单的左对齐的菜单项*/
menuiteminfo my_menuiteminfo
long return_value
/*初始化结构体*/
my_menuiteminfo.cbsize=44
my_menuiteminfo.fmask=16
my_menuiteminfo.cch=128
my_menuiteminfo.dwtypedata=Space(128)
/*获取菜单信息*/
return_value=getmenuiteminfo(handle,position,true,my_menuiteminfo)
my_menuiteminfo.ftype=16384
/*设置菜单信息*/
return_value=setmenuiteminfo(handle,position,true,my_menuiteminfo)
/*画菜单栏*/
return_value=drawmenubar(getmenu(handle))
return return_value
54、修改窗口的样式
funcation long SetWindowLongA(Uint hWindow,integer unindex,long lnewvalue) library "user32.dll"
funcation long GetWindowLongA(uInt hWindow,integer unindex) library "user32.dll"
以下代码为添加最小化按钮并删除（禁止）最大化按钮来修改已有窗口
uInt hWindow
integer GWL_STYLE=-16
long WS_MAXIMIZEBOX=65536,WS_MINIMIZEDBOX=131072,LoldStyle
hWindow=handle(this)
LoldStyle=getwindowlonga(hwindow,GWL_STYLE)
setwindowlonga(hwindow,GWL_STYLE,loldstyle+ WS_MINIMIZEDBOX- WS_MAXIMIZEBOX)
55、捕获datawindow内的单个按键
定义结构：
s_win_message
uint hwnd
uint unmessage
uint unwparam
long llParm
long ltime
int npt
定义外部函数引用声明：
funcation boolean PeekMessage(ref s_win_message smsg,uint hwnd,uint unfilterfirst,uint unfilterlast,uint unremove)library "user32.dll"
funcation uint GetWindow(uint hwnd,int nrelationship)library "user32.dll"
实现过程：
datawindow控件的自定义事件ue_dwnkey(pbm_dwnkey)
uint hdatawindowcontrol,heditcontrol
integer GW_CHILD=5
boolean breturn
s_win_message smsg
hdatawindowcontrol=handle(this)
heditcontrol=getwindow(hdatawindowcontrol,gw_child)
breturn=peekmessage(smsg,heditcontrol,0,0,0)
56、获取系统用户名
申明API函数
FUNCTION ulong WNetGetUser(ref string lpName,ref string lpUserName,ref ulong lpnLength) LIBRARY "mpr.dll" ALIAS FOR "WNetGetUserA"
PB脚本语言
string ls_name, ls_username
ulong ll_len
ll_len = 256
ls_username = space(ll_len)
setnull(ls_name)
WNetGetUser(ls_Name,ls_UserName,ll_Len)
messagebox("系统登录用户名",ls_username)
57、通过调用APi函数WNetGetUserName，你可以获取大数网络客户端的网络用户标识，该函数适用于Netware, Windows for Workgroups, Windows NT, Windows 95与LanManager. 对于32 位应用程序，需要使用另一个API函数:GetUserNameA().
16-bit程序
//外部函数说明:
function int WNetGetUser( ref string userid, ref uint len ) library "user.exe"
PowerScript脚本
string login_name
uint lui_len
int li_rc
string ls_temp
lui_len = 255
ls_temp = space( 255 )
li_rc = WNetGetUser( ls_temp, lui_len )
login_name = Trim( ls_temp )
32-bit程序
//外部函数说明
Function boolean GetUserNameA( ref string userID, ref ulong len ) library "ADVAPI32.DLL"
Powerscript脚本
string login_name
string ls_temp
ulong lul_value
boolean lb_rc
lul_value = 255
ls_temp = Space( 255 )
lb_rc = GetUserNameA( ls_temp, lul_value )
login_name = Trim( ls_temp )
58、下面的例子给出了通过调用Novell API来获取用户名的方法：
1.说明下面的外部函数:
function ulong NWInitialize() library "NWInfo"
function ulong NWGetInfo( Long Drv, Long info, ref string buffer ) Library "NWInfo"
2.然后定义一个函数并加入下面的程序
// i_sys=1 - novell
string login_name
string ls_temp
integer drv,info
long l_ret
login_name = "user_name_error"
if i_sys = 1 then // novell login name.
l_ret = NWInitialize() // init the dll, check for client 32 ...
if l_ret = 0 then
drv = 7 // network drive g:
info = 35 // typeless user name
ls_temp = Space( 129 )
// get the login name for specific drive
l_ret = NWGetInfo( drv, info, ls_temp )
if l_ret = 0 then
login_name = Trim( ls_temp )
end if
end if
end if
return login_name
59、在应用程序中启动控制面板
在应用程序中启动控制面板，只需用ShellExecute函数打开对应的CPL文件即可，例如要在应用程序中修改Windows密码，只需打开Password.cpl文件，启动ODBC管理器只要打开ODBCCP32.CPL。
函数声明：
Function Long ShellExecute(Long hwindow, String lpOperation, String lpFile, String lpParameters, String lpDirectory, Long nShowCmd) Library 'shell32.dll' Alias for ShellExecuteA
Function Long GetDesktopWindow() Library 'user32.dll'
脚本如下：
String ls_cpl_name
String ls_null
SetNull(ls_null)
ls_cpl_name = "Password.cpl"
ShellExecute(GetDesktopWindow(), ls_null, 'rundll32.exe', "shell32.dll,Control_RunDLL " + ls_cpl_name + ",", ls_null, 0)
60、因为要用连续纸打印发票和报表，在PWIN95中打印机设置处，用自定义纸张设好特定大小发票，用于打印发票。但是当打印完一张发票以后，打印机自动切纸以后，再打第二张发票时，继续重新打在第一张发票的位置上，不知如何是好？是否要在PB中用调用外部函数设置自定义纸张大小，才起作用？
A1: I had a solution, like follows,
void WINAPI PrintSet(LPCTSTR PrinterName, DWORD PaperSize, DWORD Height, DWORD Width, LPDWORD ret_code, LPTSTR errortext)
{
DEVMODE* lv_devmode;
DEVMODE* lv_devmode_2;
PRINTER_INFO_2* lv_printer_info;
LPTSTR lv_str, pDeviceName;
HANDLE phPrinter;
DWORD pcbNeeded, lv_dword;
lv_printer_info = malloc( 500 );
if (!OpenPrinter(PrinterName, &phPrinter, NULL))
{
free(lv_printer_info);
*ret_code = GetLastError();
lv_str = "打开打印机失败 !";
strcpy(errortext, lv_str);
return;
}
if (!GetPrinter(phPrinter, 2, lv_printer_info, 500, &pcbNeeded ))
{
free(lv_printer_info);
*ret_code = GetLastError();
ClosePrinter(phPrinter);
lv_str = "无法得到打印机参数 !";
strcpy(errortext, lv_str);
return;
}
lv_devmode = lv_printer_info->pDevMode;
pDeviceName = lv_devmode->dmDeviceName;
lv_dword = DocumentProperties(0, phPrinter, pDeviceName, lv_devmode, 0, DM_OUT_BUFFER);
if (lv_dword<0)
{
free(lv_printer_info);
*ret_code = GetLastError();
ClosePrinter(phPrinter);
lv_str = "无法取得打印机参数 !";
strcpy(errortext, lv_str);
return;
}
// 修改DEVMODE结构， 设置纸张大小及其高度和宽度
lv_devmode->dmFields = lv_devmode->dmFields|DM_ORIENTATION|DM_PAPERLENGTH|DM_PAPERWIDTH|DM_PAPERSIZE;
lv_devmode->dmOrientation = DMORIENT_PORTRAIT ;
lv_devmode->dmPaperSize = PaperSize ;
lv_devmode->dmPaperLength = Height;
lv_devmode->dmPaperWidth = Width;
// 通过调用DOCUMENTPROPERTIES函数传会修改的DEVMODE结构，
// 在调用时指定DM_IN_BUFFER|DM_OUT_BUFFER
lv_devmode_2 = malloc(500);
lv_dword = DocumentProperties(0, phPrinter, pDeviceName, lv_devmode_2, lv_devmode, DM_IN_BUFFER|DM_OUT_BUFFER);
if (lv_dword<0)
{
free(lv_devmode_2);
free(lv_printer_info);
*ret_code = GetLastError();
ClosePrinter(phPrinter);
lv_str = "无法设置打印机参数 !";
strcpy(errortext, lv_str);
return;
}
if (!SetPrinter(phPrinter, 2, lv_printer_info, NULL))
{
free(lv_printer_info);
*ret_code = GetLastError();
ClosePrinter(phPrinter);
lv_str = "无法设置打印机参数 !";
strcpy(errortext, lv_str);
return;
}
free(lv_devmode_2);
free(lv_printer_info);
ClosePrinter(phPrinter);
lv_str = "设置打印机参数成功 !";
strcpy(errortext, lv_str);
*ret_code = 1;
return ;
}
61、禁用网络 恢复网络 程序
来源：www.pdriver.com 作者：wzlzn
private function boolean of_statechange (boolean benable, unsignedlong selecteditem, unsignedlong hdevinfo);SP_PROPCHANGE_PARAMS PropChangeParams
PropChangeParams.classinstallheader.cbsize = 8
SP_DEVINFO_DATA DeviceInfoData
DeviceInfoData.cbsize = 28 //12 + 16
if (SetupDiEnumDeviceInfo(hDevInfo,SelectedItem,ref DeviceInfoData) = 0) then return FALSE
//
// Set the PropChangeParams structure.
//
constant ULONG DIF_PROPERTYCHANGE = 18 //0x00000012
constant ULONG DICS_FLAG_GLOBAL = 1 //0x00000001
constant ULONG DICS_ENABLE = 1 //0x00000001
constant ULONG DICS_DISABLE = 2 //0x00000002
PropChangeParams.ClassInstallHeader.InstallFunction = DIF_PROPERTYCHANGE;
PropChangeParams.Scope = DICS_FLAG_GLOBAL;
if (bEnable) then
PropChangeParams.StateChange = DICS_ENABLE
else
PropChangeParams.StateChange = DICS_DISABLE
end if
if (SetupDiSetClassInstallParams(hDevInfo,ref DeviceInfoData,ref PropChangeParams,20/*sizeof(PropChangeParams)*/) = 0) then
return FALSE
end if
//
// Call the ClassInstaller and perform the change.
//
if (SetupDiCallClassInstaller(DIF_PROPERTYCHANGE,hDevInfo,ref DeviceInfoData) = 0) then return TRUE
return TRUE
end function
private function boolean of_isclassnet (guid oclassguid);// #define MAX_NUM 50
constant ULONG REG_SZ = 1
constant ULONG STANDARD_RIGHTS_READ = 131072 //(0x00020000L)
constant ULONG KEY_QUERY_value = 1
constant ULONG KEY_ENUMERATE_SUB_KEYS =0008
constant ULONG KEY_NOTIFY = 16 //(0x0010)
constant ULONG SYNCHRONIZE = 1048576 // (0x00100000L)
constant ULONG KEY_READ = (STANDARD_RIGHTS_READ + KEY_QUERY_value + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY)
constant ULONG ERROR_SUCCESS = 0
ULONG hKeyClass
LONG lRet
char ClassType[50]
char NetClass[50]
ulong dwLength ,dwType
dwLength = 50
dwType = REG_SZ
NetClass[1] = "N"
NetClass[2] = "e"
NetClass[3] = "t"
NetClass[4] = char(0) //= "Net"
hKeyClass = SetupDiOpenClassRegKey(oClassGuid,KEY_READ)
if (hKeyClass > 0) then
lRet = RegQueryvalueEx(hKeyClass,"Class", 0, ref dwType, ref ClassType, ref dwLength)
RegCloseKey(hKeyClass)
if (lRet <> ERROR_SUCCESS) then return FALSE
if (ClassType[1] = "N" and ClassType[2] = "e" and ClassType[3] = "t" and ClassType[4] = char(0) ) then
return TRUE
end if
return FALSE;
end if
return false
end function
public function boolean of_enablenetwork (boolean benable);LONG hDevInfo
SP_DEVINFO_DATA DeviceInfoData
ULONG i, Status, Problem
ULONG hKeyClass
char DeviceName[200]
hDevInfo = SetupDiGetClassDevs(0,0,0, DIGCF_PRESENT + DIGCF_ALLCLASSES)
if (INVALID_HANDLE_value = hDevInfo) then return FALSE
DeviceInfoData.cbsize = 28 //3 * 4 + 16
i = 0
DO WHILE (SetupDiEnumDeviceInfo(hDevInfo,i,REF DeviceInfoData) <> 0) // for (i=0;SetupDiEnumDeviceInfo(hDevInfo,i,&DeviceInfoData);i++)
if (of_IsClassNet(DeviceInfoData.ClassGuid)) then
if ( of_statechange(bEnable,i,hDevInfo)) then
end if
end if
i++
LOOP
return FALSE
end function
type sp_devinfo_data from structure
unsignedlong cbsize
guid classguid
unsignedlong devinst
unsignedlong reserved
end type
type SP_CLASSINSTALL_HEADER from structure
ULONG cbSize;
ULONG InstallFunction;
end type
type SP_PROPCHANGE_PARAMS from structure
SP_CLASSINSTALL_HEADER ClassInstallHeader
ulong StateChange;
ulong Scope;
ulong HwProfile;
end type
type guid from structure
unsignedlong data1
character data2[2]
character data3[2]
character data4[8]
end type
//
FUNCTION LONG SetupDiGetClassDevs(ULONG ClassGuid,ULONG Enumerator,ULONG hwndParent,ULONG Flags)LIBRARY "Setupapi.DLL" ALIAS FOR SetupDiGetClassDevsA
//FUNCTION ULONG SetupDiEnumDeviceInfo(ULONG DeviceInfoSet,ULONG MemberIndex, ref SP_DEVINFO_DATA DeviceInfoData)LIBRARY "Setupapi.DLL"
/*FUNCTION ULONG SetupDiOpenClassRegKeyEx(
const GUID* ClassGuid,
REGSAM samDesired,
DWORD Flags,
PCTSTR MachineName,
PVOID Reserved
);*/
FUNCTION ULONG SetupDiOpenClassRegKey(ref GUID ClassGuid,ULONG samDesired)LIBRARY "Setupapi.DLL"
FUNCTION ULONG SetupDiEnumDeviceInfo(ULONG DeviceInfoSet,ULONG MemberIndex,REF SP_DEVINFO_DATA DeviceInfoData)LIBRARY "Setupapi.DLL"
FUNCTION ULONG SetupDiSetClassInstallParams(ULONG DeviceInfoSet,SP_DEVINFO_DATA DeviceInfoData,ref SP_PROPCHANGE_PARAMS ClassInstallParams,ULONG ClassInstallParamsSize)LIBRARY "Setupapi.dll" ALIAS FOR "SetupDiSetClassInstallParamsA"
FUNCTION ULONG SetupDiCallClassInstaller(ULONG InstallFunction,ULONG DeviceInfoSet, SP_DEVINFO_DATA DeviceInfoData)LIBRARY "Setupapi.dll" ALIAS FOR "SetupDiCallClassInstaller"
FUNCTION LONG RegQueryvalueEx(ULONG hKey,STRING lpvalueName, ULONG lpReserved,REF ULONG lpType,REF CHAR lpData[50],REF ULONG lpcbData) LIBRARY "Advapi32.DLL" ALIAS FOR RegQueryvalueExA
FUNCTION LONG RegCloseKey(ULONG hKey)LIBRARY "Advapi32.DLL" ALIAS FOR RegCloseKey
constant LONG INVALID_HANDLE_value = -1
constant ULONG DIGCF_PRESENT = 00000002
constant ULONG DIGCF_ALLCLASSES = 00000004
62、修改进度条颜色源码
1，声明常量
Constant Long WM_USER = 1024
Constant Long PBM_SETBARCOLOR = WM_USER + 9
Constant Long CCM_FIRST = 8192
Constant Long CCM_SETBKCOLOR = CCM_FIRST + 1
2，进度条CONSTRUCTOR事件：
Send( Handle(This), PBM_SETBARCOLOR, 0, Rgb( 251, 230, 148 ) )
Send( Handle(This), CCM_SETBKCOLOR, 0, Rgb( 232, 127, 8 ) )
Showing flat scrollbars in a ListView
Long ll_ExStyle
Constant Integer LVM_SETEXTENDEDLISTVIEWSTYLE = 4150
Constant Integer LVM_GETEXTENDEDLISTVIEWSTYLE = 4151
Constant Integer LVS_EX_FLATSB = 256
ll_ExStyle = Send( Handle( this ), LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0 )
ll_Exstyle += LVS_EX_FLATSB
ll_ExStyle = Send( Handle( this ), LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ll_ExStyle )
Autosizing columns to match widest text within a column
uLong lul_Header, lul_LvHandle
Integer li_ItemCount, li_Loop
Constant Integer LVM_GETHEADER = 4127
Constant Integer LVSCW_AUTOSIZE = -1
Constant Integer LVSCW_AUTOSIZE_USEHEADER = -2
Constant Integer HDM_GETITEMCOUNT = 4608
// First get a handle to the header of the listview. You can use this
// to get the number of columns within your ListView.
// A ListView actually exists of two controls, a ListView and a
// header control (when the ListView is in ListViewReport! mode).
// Columnheaders exists within the header control.
lul_LvHandle = Handle( yourListView )
lul_Header = Send( lul_LvHandle, LVM_GETHEADER, 0, 0 )
If lul_Header <= 0 Then Return
// Second, get the number of columns within the listview
li_ItemCount = Send( lul_Header, HDM_GETITEMCOUNT, 0, 0 )
/* Third, set the columnwidth of the columns.
Indexes within ListView messages are zero-based so I start with column 0.
Using the LVM_SETCOLUMNWIDTH message with the LVSCW_AUTOSIZE_USEHEADER
value normally sizes your column to match the header width. For the
last column however, it fills the REMAINING part of your ListView */
For li_Loop = 0 To li_ItemCount - 1
Send( iul_lvHandle, LVM_SETCOLUMNWIDTH, li_Loop, LVSCW_AUTOSIZE_USEHEADER )
Next
3、Putting a ListBox in the Toolbar
Function uLong FindWindowExA( long hParent, long hChildAfter, String lpszClass, String lpszWindow ) Library "user32.dll"
Function uLong SetParent( uLong hChild, uLong hWnd ) Library "user32.dll"
In your MDI-frame Open-script:
String ls_ClassName, ls_Null
uLong lul_Toolbar, lul_Null, lul_ListBox
ListBox llb_1
SetNull( ls_Null )
SetNull( lul_Null )
ls_ClassName = 'FNFIXEDBAR60'
// Find handle of toolbar (for PB 7 use FNFIXEDBAR70)
lul_Toolbar = FindWindowExA( Handle( this ), lul_Null, ls_Classname, ls_Null )
// Create a listbox.
OpenUserObject( llb_1, 'Listbox', 0, 0 )
// Get handle of the listbox
lul_ListBox = Handle( llb_1 )
// Set toolbar to be the parent
SetParent( lul_ListBox, lul_Toolbar )
// Change some properties of listbox
llb_1.Y = 12
llb_1.X = 1000
llb_1.Width = 200
llb_1.Height = 61
63、枚举网络资源：
type str_netresource from structure
ulong dwscope
ulong dwtype
ulong dwdisplaytype
ulong dwusage
ulong lplocalname
ulong lpremotename
ulong lpcomment
ulong lpprovider
end type
Function ULONG WNetOpenEnum ( ULONG dwScope ,ULONG dwType , ULONG dwUsage , str_NetResource str_NET,REF uLONG lphEnum ) LibRARY "mpr.dll" alias for "WNetOpenEnumA"
Function ULONG WNetEnumResource(uLONG hEnum ,ref uLONG lpcCount, uLONG lpBuffer , ref uLONG lpBufferSize ) LibRARY "mpr.dll" alias for "WNetEnumResourceA"
Function ULONG WNetCloseEnum ( LONG hEnum ) LibRARY "mpr.dll"
Function ULONG GlobalAlloc ( LONG wFlags , LONG dwBytes ) LibRARY "KERNEL32"
Function ULONG GlobalFree ( LONG hMem ) LibRARY "KERNEL32"
Function ulong CopyMem (ref str_netresource hpvDest , ulong hpvSource , ulong cbCopy ) Library "KERNEL32" Alias for "RtlMoveMemory"
Function ulong CopyPointer2String ( ref string NewString , ulong OldString ) Library "KERNEL32" Alias for "lstrcpyA"
public subroutine wf_getnetresource (treeview tv_pass, str_netresource str_net, long ll_hand);Ulong ll_enum,ll_rc,ll_BUFF,ll_count,ll_buffsize,ll_source,ll_time
LONG ll_row,ll_thand
integer ll_level
WNetOpenEnum(2, 0, 0, str_net, ll_Enum)
do while true
str_netresource str_dest
ll_buffsize=1000
ll_count=-1
ll_Buff = GlobalAlloc(64, ll_buffsize)
ll_rc = WNetEnumResource(LL_Enum,ll_count, LL_BUFF, ll_buffsize)
if ll_rc<>0 then
GlobalFree(ll_buff)
exit
end if
ll_source=ll_buff
for ll_time=1 to ll_count
CopyMem(str_net,ll_source,32)
if str_net.dwdisplaytype=6 then
ll_level=0
else
ll_level=str_net.dwdisplaytype
end if
if ll_level<>3 then
li_hand=tv_pass.InsertItemlast(wf_iif(ll_level>0,ll_hand,0),wf_p2s(str_net.lpremotename),str_net.dwdisplaytype+str_net.dwtype - 3)
wf_getnetresource(tv_pass,str_net,li_hand)
end if
ll_source=ll_source+32
next
GlobalFree ( ll_buff)
loop
WNetCloseEnum(LL_ENUM)
end subroutine
public function any wf_iif (boolean lb_cond, any la_a, any la_b);if lb_cond then
return la_a
else
return la_b
end if
end function
public function string wf_p2s (unsignedlong ll_p);string ls_s
ls_s = space(255)
CopyPointer2String( ls_s, ll_p)
return ls_s
end function
64、用api 调用摄像头源码
//定义变量
uint lhand
//定义常数
long WM_USER=1024
long WM_CAP_START = WM_USER
long WM_CAP_STOP = WM_CAP_START + 68
long WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
long WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
long WM_CAP_SAVEDIB = WM_CAP_START + 25
long WM_CAP_GRAB_FRAME = WM_CAP_START + 60
long WM_CAP_SEQUENCE = WM_CAP_START + 62
long WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20
long WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+ 63
long WM_CAP_SET_OVERLAY =WM_CAP_START+ 51
long WM_CAP_SET_PREVIEW =WM_CAP_START+ 50
long WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6
long WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2
long WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3
long WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5
long WM_CAP_SET_SCALE=WM_CAP_START+ 53
long WM_CAP_SET_PREVIEWRATE=WM_CAP_START+ 52
//定义api
function ulong capCreateCaptureWindowA(string lpszWindowName,ulong dwStyle,long x ,long y ,long nWidth ,long nHeight ,ulong ParentWin ,long nId ) LIBRARY 'AVICAP32.DLL'
//代码
string lpszName
ulong l1
l1=handle(w_main)
lpszName='摄像头界面...'
lhand=capCreateCaptureWindowA(lpszName,262144+12582912+1073741824 + 268435456 ,0,0,200,200,l1,0)
if lhand <> 0 then
send(lhand, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0)
send(lhand, WM_CAP_SET_CALLBACK_ERROR, 0, 0)
send(lhand, WM_CAP_SET_CALLBACK_STATUSA, 0, 0)
send(lhand, WM_CAP_DRIVER_CONNECT, 0, 0)
send(lhand, WM_CAP_SET_SCALE, 1, 0)
send(lhand, WM_CAP_SET_PREVIEWRATE, 66, 0)
send(lhand, WM_CAP_SET_OVERLAY, 1, 0)
send(lhand, WM_CAP_SET_PREVIEW, 1, 0)
end if
65、如何隐藏窗口的TITLE标题？
1、把下列声明加到GLOBAL EXTERNAL FUNCTIONS：
Function ulong SetWindowPos(ulong hwnd,ulong hWndInsertAfter,ulong x,ulong y,ulong cx,ulong cy,ulong wFlags) LIBRARY "user32.dll"
Function ULong SetWindowLongA(Long hwnd, Long nIndex, Long dwNewLong) Library 'user32.dll'
Function ULong GetWindowLongA(Long hwnd, Long nIndex) Library 'user32.dll'
2、把下列代码加到W_FRAME窗口（即MDI窗口）的OPEN事件：
long dwStyle
dwStyle = GetWindowLongA(handle(this), -16)
dwStyle = dwStyle - 12582912
dwStyle = SetWindowLongA(handle(this), -16, dwStyle)
SetWindowPos(handle(this), -2, 0, 0, 0, 0, 39)
66、如何在PB中编写PING代码？
解决方案：
声明外部函数：
Function ulong IcmpCreateFile () Library "icmp.dll"
Function long IcmpSendEcho (ulong IcmpHandle, ulong DestinationAddress, string RequestData,long RequestSize, long RequestOptions, Ref icmp_echo_reply ReplyBuffer, long ReplySize, long Timeout ) Library "icmp.dll" Alias for "IcmpSendEcho"
Function long IcmpCloseHandle (ulong IcmpHandle) Library "icmp.dll"
Function ulong inet_addr (string cp) Library "ws2_32.dll" Alias for "inet_addr"
代码：
ULong lul_address, lul_handle
Long ll_rc, ll_size
String ls_reply
icmp_echo_reply lstr_reply
lul_address = inet_addr(as_ipaddress)
If lul_address > 0 Then
lul_handle = IcmpCreateFile()
ll_size = Len(as_echomsg)
ll_rc = IcmpSendEcho(lul_handle, lul_address, &
as_echomsg, ll_size, 0, &
lstr_reply, 278, 200)
IcmpCloseHandle(lul_handle)
If ll_rc <> 0 Then
If lstr_reply.Status = 0 Then
ls_reply = String(lstr_reply.Data)
If ls_reply = as_echomsg Then
Return True
End If
End If
End If
End If
Return False
//True 表示PING成功，反之失败
67、如何调用NetMessageBufferSend发送消息？
问题描述：
如何调用WINNT/2K/XP下的API函数NetMessageBufferSend模拟net send命令来发送消息？
解决方案：
下面代码已测试成功，直接导入PBL即可
$PBExportHeader$w_main.srw
forward
global type w_main from Window
end type
type mle_1 from multilineedit within w_main
end type
type cb_1 from commandbutton within w_main
end type
type sle_1 from singlelineedit within w_main
end type
type st_2 from statictext within w_main
end type
type st_1 from statictext within w_main
end type
end forward
type icmp_echo_reply from structure
unsignedlong address
unsignedlong status
unsignedlong roundtriptime
unsignedlong datasize
unsignedlong reserved[3]
character data[250]
end type
global type w_main from Window
int X=1056
int Y=484
int Width=1531
int Height=1152
boolean TitleBar=true
string Title="NETMESSAGESEND"
long BackColor=80269524
boolean ControlMenu=true
boolean MinBox=true
boolean Resizable=true
mle_1 mle_1
cb_1 cb_1
sle_1 sle_1
st_2 st_2
st_1 st_1
end type
global w_main w_main
type prototypes
Function ulong NetMessageBufferSend(ulong servername, ref char msgname[],ulong fromname, ref char buf[], ulong buflen) Library "netapi32.dll" Alias for "NetMessageBufferSend"
Function ulong IcmpCreateFile () Library "icmp.dll"
Function long IcmpSendEcho (ulong IcmpHandle, ulong DestinationAddress, string RequestData,long RequestSize, long RequestOptions, Ref icmp_echo_reply ReplyBuffer, long ReplySize, long Timeout ) Library "icmp.dll" Alias for "IcmpSendEcho"
Function long IcmpCloseHandle (ulong IcmpHandle) Library "icmp.dll"
Function ulong inet_addr (string cp) Library "ws2_32.dll" Alias for "inet_addr"
end prototypes
type variables
CONSTANT ulong NERR_Success = 0
end variables
forward prototypes
public subroutine wf_string_to_unicode (string as_string, ref character ac_unicode[])
public subroutine wf_string_to_unicode (string as_string, ref character ac_unicode[])
public function boolean wf_netmessagebuffersend (string as_sendto, string as_msgtext)
public function boolean wf_ping (string as_ipaddress, string as_echomsg)
end prototypes
public subroutine wf_string_to_unicode (string as_string, ref character ac_unicode[]);Integer li_loop, li_len, li_uni
li_len = Len(as_string)
FOR li_loop = 1 TO li_len
li_uni = li_uni + 1
ac_unicode[li_uni] = Mid(as_string, li_loop, 1)
li_uni = li_uni + 1
ac_unicode[li_uni] = Char(0)
NEXT
li_uni = li_uni + 1
ac_unicode[li_uni] = Char(0)
li_uni = li_uni + 1
ac_unicode[li_uni] = Char(0)
end subroutine
public function boolean wf_netmessagebuffersend (string as_sendto, string as_msgtext);Ulong lul_result, lul_buflen
Char lc_msgname[],lc_msgtext[]
wf_string_to_unicode(as_sendto, lc_msgname)
wf_string_to_unicode(as_msgtext, lc_msgtext)
lul_buflen = UpperBound(lc_msgtext)
lul_result = NetMessageBufferSend(0, lc_msgname,0, lc_msgtext, lul_buflen)
If lul_result = NERR_Success Then
Return True
Else
Return False
End If
end function
public function boolean wf_ping (string as_ipaddress, string as_echomsg);ULong lul_address, lul_handle
Long ll_rc, ll_size
String ls_reply
icmp_echo_reply lstr_reply
lul_address = inet_addr(as_ipaddress)
If lul_address > 0 Then
lul_handle = IcmpCreateFile()
ll_size = Len(as_echomsg)
ll_rc = IcmpSendEcho(lul_handle, lul_address, &
as_echomsg, ll_size, 0, &
lstr_reply, 278, 200)
IcmpCloseHandle(lul_handle)
If ll_rc <> 0 Then
If lstr_reply.Status = 0 Then
ls_reply = String(lstr_reply.Data)
If ls_reply = as_echomsg Then
Return True
End If
End If
End If
End If
Return False
end function
on w_main.create
this.mle_1=create mle_1
this.cb_1=create cb_1
this.sle_1=create sle_1
this.st_2=create st_2
this.st_1=create st_1
this.Control[]={this.mle_1,&
this.cb_1,&
this.sle_1,&
this.st_2,&
this.st_1}
end on
on w_main.destroy
destroy(this.mle_1)
destroy(this.cb_1)
destroy(this.sle_1)
destroy(this.st_2)
destroy(this.st_1)
end on
type mle_1 from multilineedit within w_main
int X=27
int Y=264
int Width=1399
int Height=604
int TabOrder=20
BorderStyle BorderStyle=StyleLowered!
long TextColor=33554432
int TextSize=-10
int Weight=400
string FaceName="方正姚体"
FontCharSet FontCharSet=GB2312CharSet!
FontPitch FontPitch=Variable!
end type
type cb_1 from commandbutton within w_main
int X=1070
int Y=904
int Width=357
int Height=108
int TabOrder=30
string Text=" 发送(&S)"
int TextSize=-10
int Weight=400
string FaceName="方正姚体"
FontCharSet FontCharSet=GB2312CharSet!
FontPitch FontPitch=Variable!
end type
event clicked;if not wf_ping(trim(sle_1.text),"") then
messagebox("提示","指定目标地址不存在或不通!")
return
end if
if wf_NetMessageBufferSend(trim(sle_1.text),trim(mle_1.text)) then
messagebox("提示","发送成功!")
else
messagebox("提示","发送失败!")
end if
end event
type sle_1 from singlelineedit within w_main
int X=430
int Y=48
int Width=997
int Height=92
int TabOrder=10
BorderStyle BorderStyle=StyleLowered!
boolean AutoHScroll=false
long TextColor=33554432
int TextSize=-10
int Weight=400
string FaceName="方正姚体"
FontCharSet FontCharSet=GB2312CharSet!
FontPitch FontPitch=Variable!
end type
type st_2 from statictext within w_main
int X=14
int Y=172
int Width=379
int Height=76
boolean Enabled=false
string Text="发送内容："
boolean FocusRectangle=false
long TextColor=33554432
long BackColor=67108864
int TextSize=-10
int Weight=400
string FaceName="方正姚体"
FontCharSet FontCharSet=GB2312CharSet!
FontPitch FontPitch=Variable!
end type
type st_1 from statictext within w_main
int X=14
int Y=52
int Width=379
int Height=76
boolean Enabled=false
string Text="目标地址："
boolean FocusRectangle=false
long TextColor=33554432
long BackColor=67108864
int TextSize=-10
int Weight=400
string FaceName="方正姚体"
FontCharSet FontCharSet=GB2312CharSet!
FontPitch FontPitch=Variable!
end type
68、PB程序间传递字符串变量
我们知道可以用Send ( handle, message#, lowword, long )函数完成不同程序窗口间的消息传递，其中最后两个参数为long型，因此可以利用这两个参数来传递数字型的变量。如果想传递的是字符串呢？由于每个进程都有自己独立的内存地址和内存空间，因此不可能直接通过访问变量地址的方法得到变量。
下面给出pb的方法：
source程序：
外部函数：
Function ulong GetCurrentProcessId() LIBRARY "kernel32.dll"
Function integer SndMsg(long hWnd, long uMsg, long url, &
ref blob info) library "user32.dll" Alias For "SendMessageA
constant long PBM_CUSTOM01 = 1024
程序：
IF il_hTarget <= 0 THEN findTarget() //找接受变量的窗口，主要用findwindow实现
IF il_hTarget > 0 THEN
String ls_len
//组成一个要发送的字符串
url+= " "+info+" "+String(srctype)+" "+String(offlinetype)
//计算整个要发送字符的长度，并转化为长度为10的字符串
ls_len = String(Len(url))
IF Len(ls_len) < 10 THEN
ls_len = Space(10 - Len(ls_len))+ls_len
END IF
//转化为blob并发送
Blob lb_snd
lb_snd = Blob(ls_len+url)
SndMsg(il_hTarget, PBM_CUSTOM01 +9,getcurrentprocessID(),lb_snd)
END IF
target程序：
外部函数：
Function ulong OpenProcess(ulong dwDesiredAccess,ulong bInheritHandle,ulong dwProcessId) LIBRARY "kernel32.dll"
Function ulong ReadProcessMemoryStr(ulong hProcess,long lpBaseAddress,ref string lpBuffer,ulong nSize,ref long lpNumberOfBytesWritten) LIBRARY "kernel32.dll" Alias for "ReadProcessMemory"
Function ulong ReadProcessMemoryBlob(ulong hProcess,long lpBaseAddress,ref blob lpBuffer,ulong nSize,ref long lpNumberOfBytesWritten) LIBRARY "kernel32.dll" Alias for "ReadProcessMemory"
事件pbm_custom10:
If (wparam = 0) Or (lparam = 0) THEN RETURN
Long ll_null
SetNull(ll_null)
Long processhnd
CONSTANT Long PROCESS_VM_READ = 16
processhnd = openprocess(PROCESS_VM_READ,0,wparam);
//读取发送进程的内存数据
String ls_size
Long ll_size
ls_size = Space(10) //数据的大小
ReadProcessMemoryStr(processhnd,lparam,ls_size,10,ll_null)
ll_size = Long(Trim(ls_size))
Blob lb_data
lb_data = Blob(String(Space(ll_size)))
ReadProcessMemoryBlob(processhnd,lparam+10,lb_data,ll_size,ll_null)
string ls_data
ls_data = String(lb_data) //好啦，收到礼物了
69、谈谈如何在图片框上输出透明文字
1、声明API函数：
FUNCTION ulong GetDC(ulong hwnd) LIBRARY "user32.dll"
FUNCTION ulong SetBkMode(ulong hdc,ulong nBkMode) LIBRARY "gdi32.dll"
FUNCTION ulong TextOut(ulong hdc,ulong x,ulong y,ref string lpString,ulong nCount) LIBRARY "gdi32.dll" ALIAS FOR "TextOutA"
2、声明一窗口级实例变量：
//获取图片框的句柄
ulong i_ulng_handle
3、在窗口中放入一图片框控件，名为：p_1，在constructor事件中加入以下代码：
i_ulng_handle=getdc(handle(this))
//设置此控件的背景为透明模式
setbkmode(i_ulng_handle,1)
4、加一按纽，text为：写字，单击事件中加入以下代码：
long lng_len,lng_x,lng_y
string str_text
str_text="这只是测试"
lng_len=len(str_text)
//使文字在图片中居中
lng_x=unitstopixels((p_1.width - lng_len*40),xunitstopixels!) /2
lng_y=unitstopixels(p_1.height - 40,yunitstopixels!) /2
//这是必需的，不知为啥？
p_1.enabled=false
//输出文字
textout(i_ulng_handle,lng_x,lng_y,str_text,lng_len)
5、加一按纽，text为：抹掉，单击事件中加入以下代码：
p_1.enabled=true
70、取局域网计算机名、IP、MAC、工作组等信息
使用的API：
Function boolean IsWindow (Long hwnd ) Library "user32.dll"
FUNCTION ulong WinExec(ref string lpCmdLine,ulong nCmdShow) LIBRARY "kernel32.dll"
使用到的《PB扩充函数1.5》中的函数
uf_Network_Ping、uf_file_isavailable。虽然使用《PB扩充函数1.5》时需要一个mhand.dll，但是我们用到的2个函数并没有使用到mhand.dll，所以也算是没有借助第三方DLL。
检索IP等信息使用2个自建的函数：
f_searchip():
string ls_ip,ls_temp
//ls_temp为需要检索的ip段，格式为xxx.xxx.xxx. 如：192。168。0。
ls_temp=192.168.0.
for i=1 to 255
ls_ip=ls_temp + string(i)
f_searchip1(ls_ip)
next
f_searchip1(string ls_ip):
//得到一个一个ip地址计算机信息并且插入数据窗口
u_kchs lu_kchs
string ls_temp
long ll_row,p
integer li_filenum
ulong ll_handle
string ls_pcname,ls_mac,ls_group
sle_ts.text='正在检索'+as_ip
//如果能ping通为有效ip
if not(lu_kchs.uf_Network_Ping(as_ip)) then return
//使用NBTSTAT命令取得相关信息
ls_temp="nbtstat -a "+as_ip+">temp/"+as_ip
li_FileNum = FileOpen("run.bat",StreamMode!, Write!, LockWrite!, Replace!)
FileWrite(li_FileNum,ls_temp)
FileClose(li_filenum)
ls_temp='run.bat'
ll_handle=WinExec(ls_temp,0)
//等待DOS窗口关闭
Do While isWindow(ll_handle)
Yield()
Loop
//等待临时文件创建成功
do while not(lu_kchs.uf_file_isavailable("temp/"+as_ip))
Yield()
Loop
//取计算机mac,工作组等信息
li_FileNum=FileOpen("temp/"+as_ip,StreamMode!,Read! )
if li_FileNum>0 then
FileRead(li_FileNum,ls_temp)
FileClose(li_filenum)
FileDelete("temp/"+as_ip)
p=pos(ls_temp,'MAC Address = ')
ls_mac=mid(ls_temp,p + 14,17)
p=pos(ls_temp,'UNIQUE Registered')
ls_pcname=trim(mid(ls_temp,p - 21,14))
p=pos(ls_temp,'GROUP Registered')
ls_group=trim(mid(ls_temp,p - 21,14))
if ls_mac='/NetBT_Tcpip_{942' then ls_mac='其他设备'
if ls_mac<>'其他设备' and trim(ls_mac) <> '' then
//因为使用DHCP动态分配IP,所以根据MAC地址来标识唯一的计算机
ll_row=dw_cx.find("mac='"+ls_mac+"'",1,dw_cx.rowcount())
if ll_row>0 then
//如果原来有数据则修改
dw_cx.o b j e c t.mac[ll_row]=ls_mac
dw_cx.o b j e c t.pcname[ll_row]=ls_pcname
dw_cx.o b j e c t.workgroup[ll_row]=ls_group
dw_cx.o b j e c t.ip[ll_row]=as_ip
dw_cx.o b j e c t.online[ll_row]=1
else
ll_row=dw_cx.insertrow(0)
dw_cx.o b j e c t.rowid[ll_row]=0
dw_cx.o b j e c t.mac[ll_row]=ls_mac
dw_cx.o b j e c t.pcname[ll_row]=ls_pcname
dw_cx.o b j e c t.workgroup[ll_row]=ls_group
dw_cx.o b j e c t.ip[ll_row]=as_ip
dw_cx.o b j e c t.online[ll_row]=1
end if
end if
end if
71、如何在PB中实现串口编程
可以使用mscomm32.ocx控件
脚本如下：
String ls_data
//使用COM1端口。
ole_1.object.CommPort = 1
//设置速率为9600,无奇偶校验，8 位数据，一个停止位。
ole_1.object.Settings = "9600,N,8,1"
//读入整个缓冲区的数据。
ole_1.object.InputLen = 0
打开端口
ole_1.object.PortOpen = True
//发送attention命令
ole_1.object.Output = "ATV1Q0" + char(13)
//等待数据。
Do
Yield()
//从Com端口取数据
ls_data += ole_1.object.Input
LOOP Until(Pos(ls_data, "OK" + char(13) + char (10)) > 0)
//向Com端口发送数据使用Output方法
ole_1.Object.Output = ls_data
//关闭端口。
ole_1.object.PortOpen = FALSE
308
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
