(转)pb+api实际应用

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

 

你可能感兴趣的:(API相关)