|
1、Here how you get the network username using the Windows Scripting Host
2、Have a button with many lines
3、Get PBL name
4、Time the execution
5、Retrieve an environment vari
6、Detect PB version
7、Make a window stay "on top"
8、Capitalize a name
9、Convert an hex string to its decimal equivalent
10、Convert a number to hexadecimal
11、Detect if running in PB or executable
12、Terminate an another application
13、Use WSH-VBScript functionalities
14、Start a dial-up connection
15、Start/Stop services
16、Display default email window to type and send an email
17、Use RunDll32 utility
18、Get the execution path of the current application
19、Get the current directory
20、Change directory
21、Create or remove a directory
22、Rename a file
23、Generate a unique filename
24、Determine the TEMP directory designated for temporary files.
25、Shutdown from application
26、Start the screen saver
27、Get the CDROM drive letter
28、Get the user name and the computer name
29、Retrieve the UNC from a mapped drive
30、Make a window popup "on top"
31、Make the "hourglass" cursor stay
32、Move a window without a titlebar
33、Change screen resolution
34、Flash a Window Title bar
35、Retrieve error from calling a Win API
36、Get the IP address
37、Animate a Window
38、Use Microsoft Crypto API
39、Get Windows OS version
40、Make a window unmoveable
41、Retrieve window handle by its title
42、Have a transparent window
43、Bypass Window Error popup message
44、Get hard disk serial number
1、Here how you get the network username using the Windows Scripting Host
OleObject wsh
Integer li_rc
wsh = CREATE OleObject
li_rc = wsh.ConnectToNewObject( "WScript.Network" )
IF li_rc = 0 THEN
MessageBox( "Domain", String( wsh.UserDomain ) )
END IF
2、Have a button with many lines
Use PictureButton with no picture
3、Get PBL name
ClassDefinition lcd
lcd = this.ClassDefinition
MessageBox("", "My PBL name is " + lcd.LibraryName )
4、Time the execution
Use the CPU() function for timing. long ll_start, ll_elapsed
ll_Start = CPU ( )
/*
**your code to time test
*/
ll_elapsed = CPU ( ) - ll_Start
5、Retrieve an environment variable
// PB6
ContextKeyword lcxk_base
string ls_Path
string ls_values[]
this.GetContextService("Keyword", lcxk_base)
lcxk_base.GetContextKeywords("path", ls_values)
IF Upperbound(ls_values) > 0 THEN
ls_Path = ls_values[1]
ELSE
ls_Path = "*UNDEFINED*"
END IF
6、Detect PB version
string ls_PBver
environment env
GetEnvironment(env)
ls_PBver = string(env.pbmajorrevision) + '.' + &
string(env.pbminorrevision) + '.' + &
string(env.pbfixesrevision)
7、Make a window stay "on top"
windowname.SetPosition(TopMost!)
8、Capitalize a name
For example, to change "john smith" to "John Smith", you can use datawindow function WordCap() ls_string ='john smith'
ls_string = dw_1.Describe ( "Evaluate('WordCap(~"" + ls_string + "~")',0)")
Or use the appropriate database function (if supported), for Oracle it looks like SELECT InitCap('john smith') into :ls_name
FROM dual USING SQLCA;
9、Convert an hex string to its decimal equivalent
[of_hex2long(as_hex) returns a long]
string ls_hex
integer i,length
long result = 0
length = len(as_hex)
ls_hex = Upper(as_hex)
FOR i = 1 to length
result += &
(Pos ('123456789ABCDEF', mid(ls_hex, i, 1)) * &
( 16 ^ ( length - i ) ))
NEXT
RETURN result
10、Convert a number to hexadecimal
[of_long2hex(long alnumber, integer ai_digit) returns a string]
long ll_temp0, ll_temp1
char lc_ret
IF ai_digit > 0 THEN
ll_temp0 = abs(al_number / (16 ^ (ai_digit - 1)))
ll_temp1 = ll_temp0 * (16 ^ (ai_digit - 1))
IF ll_temp0 > 9 THEN
lc_ret = char(ll_temp0 + 55)
ELSE
lc_ret = char(ll_temp0 + 48)
END IF
RETURN lc_ret + &
of_long2hex(al_number - ll_temp1 , ai_digit - 1)
END IF
RETURN ""
// of_longhex(256, 4) returns "0100"
// of_longhex(256, 3) returns "100"
11、Detect if running in PB or executable
IF Handle(GetApplication()) = 0 THEN
MessageBox("Info", "Running in PB environment")
ELSE
MessageBox("Info",
12、Terminate an another application
We post the WM_QUIT message to an application (developped with Powerbuilder or not) to close it.
In this example, if the Windows Calculator is running then it will be closed from Powerscript.
The target window handle is retrieved by looking at its title. [local external function declaration]
FUNCTION ulong FindWindowA(ulong classname, String windowname) &
LIBRARY "user32.dll"
FUNCTION boolean PostMessageA(ulong hwndle,UINT wmsg,ulong wParam,ulong lParam) &
LIBRARY "user32.dll"
[powerscript]
CONSTANT uint WM_QUIT = 18 // hex 0x0012
ulong lul_handle
string ls_app
ls_app = "Calculator"
// ls_app = "Calculatrice" in french windows!
lul_handle = FindWindowA(0, ls_app)
IF lul_handle > 0 THEN
PostMessageA(lul_handle, WM_QUIT, 0, 0);
ELSE
MessageBox("Oups", ls_app + " is not running!")
END IF
13、Use WSH-VBScript functionalities
Here how you get the network username using the Windows Scripting Host : OleObject wsh
Integer li_rc
wsh = CREATE OleObject
li_rc = wsh.ConnectToNewObject( "WScript.Network" )
IF li_rc = 0 THEN
MessageBox( "Domain", String( wsh.UserDomain ) )
END IF
By calling WSH-VBScript functions, we can achieve some useful tasks very easily.
The next example shows you how to start Notepad and send some keys to it. OleObject wsh
Integer li_rc
wsh = CREATE OleObject
li_rc = wsh.ConnectToNewObject( "WScript.Shell" )
wsh.Run("Notepad")
Sleep(500)
wsh.AppActivate("Untitled - Notepad")
wsh.SendKeys("hello from PB")
The declaration for the Sleep API is [local external function declaration]
SUBROUTINE Sleep(Long lMilliSec) LIBRARY "Kernel32.dll"
NOTE: Recent version of WSH have their own Sleep function.
This one is calling the Windows Calculator ole O B J E C T wsh
long ll_rc
wsh = CREATE ole O B J E C T
ll_rc = wsh.ConnectToNewObject("WScript.Shell")
IF ll_rc < 0 THEN
messagebox("error","error")
END IF
wsh.Run( "calc")
Sleep (100)
wsh.AppActivate( "Calculator")
Sleep (100)
wsh.SendKeys( "1{+}")
Sleep (500)
wsh.SendKeys ("2")
Sleep (500)
wsh.SendKeys( "=")
Sleep (500)
wsh.SendKeys( "*4" )
Sleep (500)
wsh.SendKeys( "=" )
// 1+2 = 3 * 4 = 12
SendKeys can send "special key" using the following code : BACKSPACE {BACKSPACE}, {BS}, or {BKSP}
BREAK {BREAK}
CAPS LOCK {CAPSLOCK}
DEL or DELETE {DELETE} or {DEL}
DOWN ARROW {DOWN}
END {END}
ENTER {ENTER} or ~
ESC {ESC}
HELP {HELP}
HOME {HOME}
INS or INSERT {INSERT} or {INS}
LEFT ARROW {LEFT}
NUM LOCK {NUMLOCK}
PAGE DOWN {PGDN}
PAGE UP {PGUP}
PRINT SCREEN {PRTSC}
RIGHT ARROW {RIGHT}
SCROLL LOCK {SCROLLLOCK}
TAB {TAB}
UP ARROW {UP}
F1 {F1}
F2 {F2}
F3 {F3}
F4 {F4}
F5 {F5}
F6 {F6}
F7 {F7}
F8 {F8}
F9 {F9}
F10 {F10}
F11 {F11}
F12 {F12}
F13 {F13}
F14 {F14}
F15 {F15}
F16 {F16}
SHIFT +
CTRL ^
ALT %
You can use some vbscript to do things which can't be done easily in powerscript like binary operations : OleObject wsh
Integer li_rc, i, j , k
wsh = CREATE OleObject
li_rc = wsh.ConnectToNewObject( "MSScriptControl.ScriptControl" )
wsh.language = "vbscript"
i = 1
j = 2
k = integer(wsh.Eval( string(i) + " xor " + string(j)))
MessageBox( "Result" , string(i) + " xor " + string(2) + " = " + string(k))
Call the Windows RUN dialog : OleObject wsh
wsh = CREATE OleObject
wsh.ConnectToNewObject( "Shell.Application" )
wsh.filerun
You can even create some VBScript code on the fly with PB and execute it. OleObject wsh
Integer li_rc, i, j , k
wsh = CREATE OleObject
li_rc = wsh.ConnectToNewObject( "MSScriptControl.ScriptControl" )
wsh.language = "vbscript"
wsh.addcode("function retfnc(s) retfnc=s end function")
wsh.executestatement ('msgbox retfnc("true")')
14、Start a dial-up connection
string command
command='rundll rnaui.dll,RnaDial YourConnection' // case sensitive
Run(command)
15、Start/Stop services
run( "NET START ServiceName" )
run( "NET STOP ServiceName" )
16、Display default email window to type and send an email
run("rundll32 url.dll,FileProtocolHandler " + &
mailto:real@rgagnon.com&subject=HelloWorld)
17、Use RunDll32 utility
RunDll32 executable can be used to start various Windows utility like the Control Panel.
Here a list of what is available rundll32 shell32,Control_RunDLL Run The Control Panel
rundll32 shell32,Control_RunDLL X Start applet X of Control Panel
("X" = any CPL filename)
rundll32 shell32,OpenAs_RunDLL" Open The 'Open With...' Window
rundll32 shell32,ShellAboutA Info-Box Open 'About Window Window'
rundll32 shell32,Control_RunDLL desk.cpl Open Display Properties
rundll32 user,cascadechildwindows Cascade All Windows
rundll32 user,tilechildwindows" Minimize All Child-Windows
rundll32 user,repaintscreen Refresh Desktop
rundll32 keyboard,disable Lock The Keyboard
rundll32 mouse,disable Disable Mouse
rundll32 user,swapmousebutton Swap Mouse Buttons
rundll32 user,setcursorpos Set Cursor Position To (0,0)
rundll32 user,wnetconnectdialog Show 'Map Network Drive' Window
rundll32 user,wnetdisconnectdialog Show 'Disconnect Network Disk' Window
rundll32 user,disableoemlayer Display The BSOD (blue screen of death)Window
rundll32 diskcopy,DiskCopyRunDll Show Copy Disk Window
rundll32 rnaui.dll,RnaWizard Run 'Internet Connection Wizard'
rundll32 shell32,SHFormatDrive Run 'Format Disk (A)' Window
rundll32 shell32,SHExitWindowsEx -1 Cold Restart Of Windows Explorer
rundll32 shell32,SHExitWindowsEx 1 Shut Down Computer
rundll32 shell32,SHExitWindowsEx 0 Logoff Current User
rundll32 shell32,SHExitWindowsEx 2 Windows9x Quick Reboot
rundll32 krnl386.exe,exitkernel Force Windows 9x To Exit (no confirmation)
rundll32 rnaui.dll,RnaDial "MyConnect" Run 'Net Connection' Dialog
rundll32 msprint2.dll,RUNDLL_PrintTestPage Choose & Print Test Page Of Current Printer
rundll32 user,setcaretblinktime Set New Cursor Rate Speed
rundll32 user, setdoubleclicktime Set New DblClick Speed (Rate)
rundll32 sysdm.cpl,InstallDevice_Rundll Hardware installation wizard
rundll32 user,MessageBeep Default beep sound
rundll32 shell32.dll,Control_RunDLL appwiz.cpl Add/remove programs
rundll32 shell32.dll,Control_RunDLL timedate.cpl,,0 Date/time settings
rundll32 shell32.dll,Control_RunDLL odbccp32.cpl ODBC settings
18、Get the execution path of the current application
[PB external function declaration]
FUNCTION int GetModuleFileNameA(&
ulong hinstModule, &
REF string lpszPath, &
ulong cchPath) LIBRARY "kernel32"
[Powerscript]
string ls_Path
unsignedlong lul_handle
ls_Path = space(1024)
lul_handle = Handle(GetApplication())
GetModuleFilenameA(lul_handle, ls_Path, 1024)
MessageBox("Current application path", ls_path)
19、Get the current directory
First declare FUNCTION long GetCurrentDirectoryA( long length , ref string path) &
LIBRARY "Kernel32"
and then long ll_ret
string ls_path
ls_path = Space(250)
ll_ret = GetCurrentDirectoryA(250, ls_path)
IF ll_ret > 0 THEN
ls_path = Left(ls_path,ll_ret)
MessageBoxBox("", ls_path)
ELSE
Messagebox("Error","Err GetCurrentDirectory " + String(ll_ret))
END IF
20、Change directory
[FUNCTION DECLARATIONS]
FUNCTION boolean SetCurrentDirectoryA(ref string lpsdir) &
LIBRARY "kernel32.dll"
[powerscript]
String ls_Directory
ls_Directory = "C:/MyNewDirectory/"
lb_Return = SetCurrentDirectoryA(ls_Directory)
21、Create or remove a directory
Declare these functions : FUNCTION boolean CreateDirectoryA(ref string path, long attr)
LIBRARY "kernel32.dll"
FUNCTION boolean RemoveDirectoryA( ref string path )
LIBRARY "kernel32.dll"
and then CreateDirectoryA( "C:/TempDir", 0 ) // always 0
RemoveDirectoryA( "C:/TempDir" )
22、Rename a file
Simply "move" it under a new name with the function FUNCTION BOOLEAN MoveFileA(STRING oldfile, STRING newfile)
LIBRARY "Kernel32.dll"
23、Generate a unique filename
[function declaration]
FUNCTION integer GetTempFileNameA &
(ref string tempdir, ref string prefix, &
integer seed, ref string tempfile )&
LIBRARY "kernel32"
[powerscript]
integer li_rc
string ls_tempdir = "c:/temp"
string ls_prefixe = "app"
integer li_seed = 0
string ls_filename
ls_filename = space(256)
li_rc = GetTempFileNameA(ls_tempdir, ls_prefixe, li_seed, ls_filename)
IF li_rc = 0 THEN
MessageBox("Oups", "Error")
ELSE
MessageBox("Unique filename", ls_tempfile)
END IF
24、Determine the TEMP directory designated for temporary files.
In PB6, simply get the value of the environment variable TEMP ContextKeyword lcxk_base
string ls_temp[]
this.GetContextService("Keyword", lcxk_base)
lcxk_base.getContextKeywords("TEMP", ls_temp)
RETURN ls_temp[1]
Or you can use the following API call [External function declaration]
FUNCTION ulong GetTempPath(ulong nBufferLength, ref string lpBuffer) &
LIBRARY "kernel32" ALIAS FOR GetTempPathA
[powerscript]
long ll_bufferlength = 256
string ls_tempDir
ls_tempDir = SPACE(ll_bufferLength)
IF GetTempPath(ll_bufferLength, ls_tempDir) = 0 THEN
MessageBox("Temp dir", "not defined")
ELSE
MessageBox("Temp dir", ls_tempDir)
END IF
25、Shutdown from application
[PB external function declaration]
FUNCTION boolean ExitWindowsEx(ulong uFlags, long dwReserved ) &
LIBRARY 'user32.dll'
[Powerscript]
ulong EWX_LOGOFF = 0
ulong EWX_SHUTDOWN = 1
ulong EWX_REBOOT = 2
ExitWindows(EWX_REBOOT, 0)
NOTE: While you can shutdown from an application in Win95, you can't with WinNT. You need to call first the AdjustTokenPrivileges API function to grant the current process to right to shutdown the workstation. [structure definitions]
luid
unsignedlong lowpart
long highpart
luid_and_attributes
luid pluid
long attributes
token_privileges
long privilegecount
luid_and_attributes privileges
[functions declaration]
Function long OpenProcessToken &
(long ProcessHandle, long DesiredAccess, ref long TokenHandle) &
Library "ADVAPI32.DLL"
Function long GetCurrentProcess () Library "kernel32"
Function long LookupPrivilegeValue &
(string lpSystemName, string lpName, ref LUID lpLUID) &
Library "ADVAPI32.DLL" Alias for "LookupPrivilegeValueA"
Function long AdjustTokenPrivileges &
(long TokenHandle, long DisableAllPrivileges, &
ref TOKEN_PRIVILEGES newstate, long BufferLength, &
ref TOKEN_PRIVILEGES PreviousState, ref long ReturnLength) &
Library "ADVAPI32.DLL"
Function long CloseHandle (long hObject) Library "kernel32"
FUNCTION long ExitWindowsEx(uint Flags, long dwReserved) &
LIBRARY "User32.dll"
[Powerscript]
Constant string SE_SHUTDOWN_NAME = "SeShutdownPrivilege"
Constant long SE_PRIVILEGE_ENABLED = 2
Constant long TOKEN_ADJUST_PRIVILEGES = 32
Constant long TOKEN_QUERY = 8
CONSTANT long TokenDefaultDacl = 6
CONSTANT long TokenGroups = 2
CONSTANT long TokenImpersonationLevel = 9
CONSTANT long TokenOwner = 4
CONSTANT long TokenPrimaryGroup = 5
CONSTANT long TokenPrivileges = 3
CONSTANT long TokenSource = 7
CONSTANT long TokenStatistics = 10
CONSTANT long TokenType = 8
CONSTANT long TokenUser = 1
CONSTANT INTEGER EWX_LOGOFF = 0
CONSTANT INTEGER EWX_SHUTDOWN = 1
CONSTANT INTEGER EWX_REBOOT = 2
CONSTANT INTEGER EWX_FORCE = 4
// author Philip Salgannik
LUID tLUID
ULong hProcess
Long hToken
TOKEN_PRIVILEGES tTPOld, tTP
Long lTpOld, lR, ll_size
string ls_null
boolean NTEnableShutDown
SetNull(ls_null)
lR = LookupPrivilegeValue(ls_null, SE_SHUTDOWN_NAME, tLUID)
IF (lR <> 0) THEN
// Get the current process handle:
hProcess = GetCurrentProcess()
IF (hProcess <> 0) THEN
lR = OpenProcessToken &
(hProcess, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken)
IF (lR <> 0) THEN
//Ok we can now adjust the shutdown priviledges:
tTP.PrivilegeCount = 1
tTP.Privileges.Attributes = SE_PRIVILEGE_ENABLED
tTP.Privileges.pLuid.HighPart = tLUID.HighPart
tTP.Privileges.pLuid.LowPart = tLUID.LowPart
//Now allow this process to shutdown the system:
ll_size = 16 //sizeof(tTP)
lR = AdjustTokenPrivileges(hToken, 0, tTP, ll_size, tTPOld, lTpOld)
IF (lR <> 0) THEN
NTEnableShutDown = True
ELSE
MessageBox &
("Error", "You do not have the privileges to shutdown this system.")
END IF
CloseHandle(hToken)
END IF
END IF
END IF
IF NOT NTEnableShutDown THEN RETURN
lR = ExitWindowsEx(ewx_shutdown, 0)
IF (lR = 0) THEN
MessageBox("Error", "ShutdownSystem failed")
RETURN
ELSE
RETURN
END IF
26、Start the screen saver
/*
** WM_SYSCOMMAND 0x0112 274
** SC_SCREENSAVE 0xF140 61760
*/
send(handle(This),274,61760,0)
27、Get the CDROM drive letter
[Function declarations]
FUNCTION ulong GetLogicalDrives() LIBRARY "Kernel32.dll"
FUNCTION uint GetDriveType( Ref String as_root_path )
LIBRARY "kernel32.dll" ALIAS FOR "GetDriveTypeA"
[PB function String of_GetCDRootPath()]
integer li_ctr
string ls_root
ulong lul_drives, lul_rem
lul_drives = GetLogicalDrives()
DO
lul_rem = MOD(lul_drives, 2)
IF lul_rem = 1 THEN
ls_root = Char(li_ctr + 64) + ":/"
IF GetDriveType(ls_root_path) = 5 THEN
Return ls_root_path
END IF
li_ctr ++
END IF
lul_drives /= 2
LOOP UNTIL lul_drives = 0
RETURN ""
28、Get the user name and the computer name
You need to declare two API calls. FUNCTION long GetComputerNameA(ref string ComputerName, ref ulong BufferLength)
LIBRARY "KERNEL32.DLL"
FUNCTION long GetUserNameA(ref string UserName, ref ulong BufferLength)
LIBRARY "ADVAPI32.DLL"
and then long ll_ret
string ls_ComputerName, ls_UserName
ulong BufferLength = 250 // you may need to adjust this. see Note
ls_ComputerName = Space(BufferLength)
ls_UserName = Space(BufferLength)
ll_ret = GetComputerNameA(ls_ComputerName, BufferLength)
ll_ret = GetuserNameA(ls_UserName, BufferLength)
NOTE : From H. Andersson, "In your example to get the username with the function GetUserNameA you take as bufferlength 250. If you have a longer username (for example administrator) the function doesn't return what we expect. I took 100 as bufferlength and now it works."
29、Retrieve the UNC from a mapped drive
To convert a normal paths (N:/PATH) to UNC (//SERVER/PATH). [local external function declaration]
FUNCTION ulong WNetGetConnectionA &
( ref string drv, ref string unc, ref ulong buf ) &
LIBRARY "mpr.dll"
[powerscript]
string ls_tmp, ls_unc
Ulong ll_rc, ll_size
ls_tmp = upper(left(as_path,2))
IF right(ls_tmp,1) <> ":" THEN RETURN as_path
ll_size = 255
ls_unc = Space(ll_size)
ll_rc = WNetGetConnectionA (ls_tmp, ls_unc, ll_size)
IF ll_rc = 2250 THEN
// prbably local drive
RETURN as_path
END IF
IF ll_rc <> 0 THEN
MessageBox("UNC Error", &
"Error " + string(ll_rc) + " retrieving UNC for " + ls_tmp)
RETURN as_path
END IF
// Concat and return full path
IF len(as_path) > 2 THEN
ls_unc = ls_unc + mid(as_path,3)
END IF
RETURN ls_unc
30、Make a window popup "on top"
Declare the following fonction : FUNCTION boolean SetForegroundWindow( long hWnd ) LIBRARY "USER32"
and long hWnd
hWnd = Handle(w_my_popup)
SetForegroundWindow( hWnd )
31、Make the "hourglass" cursor stay
Sometime the cursor is resetted after database operations. To make sure the cursor stay in a known state, simply call the following APIs. [FUNCTION DECLARATIONS]
FUNCTION ulong SetCapture(ulong a) LIBRARY "user32.dll"
FUNCTION boolean ReleaseCapture() LIBRARY "user32.dll"
[powerscript]
ulong ll_handle, ll_rc
ll_handle = Handle(this)
ll_rc = SetCapture(ll_handle)
SetPointer(hourglass!)
// some operations
ReleaseCapture()
32、Move a window without a titlebar
In a window [Instance declaration]
CONSTANT uint WM_NCLBUTTONDOWN = 161
CONSTANT uint HTCAPTION = 2
[mousedown event]
Post( Handle( this ), WM_NCLBUTTONDOWN, HTCAPTION, Long( xpos, ypos ) )
33、Change screen resolution
[Local external function declaration]
FUNCTION long ChangeDisplaySettingsA (ref devmode lpst, ulong Flags) &
LIBRARY "USER32.DLL"
[structure definition, devmode]
character dmdevicename[32]
integer dmspecversion
integer dmdriverversion
integer dmsize
integer dmdriverextra
long dmfields
integer dmorientation
integer dmpapersize
integer dmpaperlength
integer dmpaperwidth
integer dmscale
integer dmdefaultsource
integer dmprintquality
integer dmcolor
integer dmduplex
integer dmresolution
integer dmttoption
integer dmcollate
character dmformname[32]
integer dmlogpixels
long dmbitsperpel
long dmpelswidth
long dmpelsheight
long dmdisplayflags
long dmdisplayfrequency
long dmicmmethod
long dmicmintent
long dmmediatype
long dmdithertype
long dmreserved1
long dmreserved2
[Instance variable declaration]
Ulong CDS_FORCE = 8*16*16*16*16*16*16*16
long DM_BITSPERPEL_H = 4*16*16*16*16
long DM_PELSWIDTH_H = 8*16*16*16*16
long DM_PELSHEIGHT_H = 16*16*16*16*16
long DM_DISPLAYFLAGS_H = 2*16*16*16*16*16
[powerscript to switch to 800x600]
devmode dm
long a
dm.dmPelsWidth = 800
dm.dmPelsHeight = 600
dm.dmBitsPerPel = 16
dm.dmFields = DM_PELSWIDTH_H + DM_BITSPERPEL_H
dm.dmSize = 188
a = ChangeDisplaySettingsA(dm, CDS_FORCE)
[powerscript to switch to 1024x768]
devmode dm
long a
dm.dmPelsWidth = 1024
dm.dmPelsHeight = 768
dm.dmBitsPerPel = 16
dm.dmFields = DM_PELSWIDTH_H + DM_BITSPERPEL_H
dm.dmSize = 188
a = ChangeDisplaySettingsA(dm, CDS_FORCE)
Here you can download a devmode structure and a test window. Just import them in a PBL and run the window.
34、Flash a Window Title bar
[structure s_flashinfo]
cbsize unsignedlong
hwnd unsignedlong
dwflags unsignedlong
ucount unsignedlong
dwtimeout unsignedlong
[external function declaration]
FUNCTION boolean FlashWindowEx(REF s_flashinfo str_flashinfo) &
LIBRARY "user32.dll"
[powerscript]
CONSTANT unsignedlong FLASHW_STOP = 0 // Stop flashing
CONSTANT unsignedlong FLASHW_CAPTION = 1 // Flash the window caption
CONSTANT unsignedlong FLASHW_TRAY = 2 // Flash the taskbar button.
// Flash both the window caption and taskbar button.
CONSTANT unsignedlong FLASHW_ALL = 3
// Flash continuously, until the FLASHW_STOP flag is set.
CONSTANT unsignedlong FLASHW_TIMER = 4
// Flash continuously until the window comes to the foreground
CONSTANT unsignedlong FLASHW_TIMERNOFG = 12
ulong ll_win
s_flashinfo lstr_flashinfo
lstr_flashinfo.cbSize = 20
lstr_flashinfo.hwnd = Handle(this) // handle(parent) if from a control
lstr_flashinfo.dwflags = FLASHW_ALL
lstr_flashinfo.ucount = 10 // 10 times
lstr_flashinfo.dwtimeout = 0 // speed in ms, 0 default blink cursor rate
FlashWindowEx(lstr_flashinfo)
The FlashWindowEx() API is only available on Win98 or WinNT/Win2000.
On Win95 or NT4, use this API instead. Call it in a loop or from a timer event to toggle the Window title bar. [external function declaration]
FUNCTION boolean FlashWindow(ulong hndl boolean flash) &
LIBRARY "user32.dll"
35、Retrieve error from calling a Win API
If a Win API call fails for any reason, a return code is returned. Habitually, an error message is available. You can get it by calling the FormatMessage() function. [local external function declaration]
FUNCTION long GetLastError() LIBRARY "kernel32" ALIAS FOR "GetLastError"
FUNCTION long FormatMessage &
(Long dwFlags ,ref Any lpSource , Long dwMessageId , &
Long dwLanguageId , ref String lpBuffer , &
Long nSize , Long Arguments) LIBRARY "kernel32" ALIAS FOR "FormatMessageA"
In the following example, we call the ShellExecute API giving it a non-existent filename. Then we can get the error message generated by the Windows API call. [local external function declaration]
FUNCTION long ShellExecuteA( long hwnd, string lpOperation, &
string lpFile, string lpParameters, string lpDirectory, &
integer nShowCmd ) LIBRARY "SHELL32"
string ls_Null
long ll_rc
string ls_err_str
long ll_last_error
Any temp
CONSTANT long FORMAT_MESSAGE_FROM_SYSTEM = 4096
SetNull(ls_Null)
// try to execute a non-existent filename.
ll_rc = ShellExecuteA( Handle( This ), "open", &
"MyPage.xyz", ls_Null, ls_Null, 1)
IF ll_rc > 1 THEN
temp = 0
ll_last_error = GetLastError()
ls_err_str = Fill(Char(0),255)
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, temp, ll_last_error,&
0, ref ls_err_str, 255, 0)
MessageBox("error", ls_err_str)
END IF
36、Get the IP address
[Structure]
str_wsadata
unsignedinteger version
unsignedinteger highversion
character description[257]
character systemstatus[129]
nsignedinteger maxsockets
unsignedinteger maxupddg
string vendorinfo
[External function]
function int WSAStartup (uint UIVerionrequested, ref str_wsadata lpWSAdata)
library "wsock32.DLL"
function int WSACleanup() library "wsock32.DLL"
function int WSAGetLastError() library "wsock32.DLL"
function int gethostname(ref string name, int namelen) library
"wsock32.DLL"
function string GetHost(string lpszhost,ref blob lpszaddress) library
"pbws32.dll"
[Powerscript]
String ls_ip, ls_host
Blob{4} lb_host
Integer li_version, li_rc
str_wsadata lstr_wsadata
ls_host = Space(128)
li_version = 257
If WSAStartup(li_version, lstr_wsadata) = 0 Then
If GetHostName(ls_host, Len(ls_host)) < 0 Then
li_rc = WSAGetLastError()
Else
GetHost(ls_host, lb_host)
ls_ip = String(Asc(String(BlobMid(lb_host, 1, 1)))) + "."
ls_ip += String(Asc(String(BlobMid(lb_host, 2, 1)))) + "."
ls_ip += String(Asc(String(BlobMid(lb_host, 3, 1)))) + "."
ls_ip += String(Asc(String(BlobMid(lb_host, 4, 1))))
li_rc = 0
End If
MessageBox("My IP", ls_ip)
Else
li_rc = WSAGetLastError()
End If
WSACleanup()
37、Animate a Window
Starting with Win98, a new API is available to add a special effect to your application. The AnimateWindow() is very easy to use, you simply need to pass your window's handle, a delay and some flags to specify the desired effect. These effects are designed to enhance the opening or closing of a window. [local function declaration]
FUNCTION boolean AnimateWindow( long lhWnd, long lTm, long lFlags) &
LIBRARY 'user32'
[instance variable]
CONSTANT LONG AW_HOR_POSITIVE = 1
CONSTANT LONG AW_HOR_NEGATIVE = 2
CONSTANT LONG AW_VER_POSITIVE = 4
CONSTANT LONG AW_VER_NEGATIVE = 8
CONSTANT LONG AW_CENTER = 16
CONSTANT LONG AW_HIDE = 65536
CONSTANT LONG AW_ACTIVATE = 131072
CONSTANT LONG AW_SLIDE = 262144
CONSTANT LONG AW_BLEND = 524288
[powerscript, open event]
// slide right to left
AnimateWindow ( Handle( this ),500,AW_HOR_NEGATIVE)
// slide left to right
AnimateWindow ( Handle( this ),500,AW_HOR_POSITIVE)
// slide top to bottom
AnimateWindow ( Handle( this ),500,AW_VER_POSITIVE)
// slide bottom to top
AnimateWindow ( Handle( this ),500,AW_VER_NEGATIVE)
// from center expand
AnimateWindow ( Handle( this ),500,AW_CENTER)
// reveal diagonnally
AnimateWindow ( Handle( this ),500,AW_VER_NEGATIVE + AW_HOR_NEGATIVE)
Here some notes about the flags (from MSDN) AW_SLIDE Uses slide animation.
By default, roll animation is used.
This flag is ignored when used with the AW_CENTER flag.
AW_ACTIVATE Activates the window. Do not use this flag with AW_HIDE.
AW_BLEND Uses a fade effect.
This flag can be used only if hwnd is a top-level window.
AW_HIDE Hides the window. By default, the window is shown.
AW_CENTER Makes the window appear to collapse inward
if the AW_HIDE flag is used or expand outward
if the AW_HIDE flag is not used.
AW_HOR_POSITIVE Animates the window from left to right.
This flag can be used with roll or slide animation.
It is ignored when used with the AW_CENTER flag.
AW_HOR_NEGATIVE Animates the window from right to left.
This flag can be used with roll or slide animation.
It is ignored when used with the AW_CENTER flag.
AW_VER_POSITIVE Animates the window from top to bottom.
This flag can be used with roll or slide animation.
It is ignored when used with the AW_CENTER flag.
AW_VER_NEGATIVE Animates the window from bottom to top.
This flag can be used with roll or slide animation.
It is ignored when used with the AW_CENTER flag.
38、Use Microsoft Crypto API
With almost all Windows installation, the Microsoft Crypto API is available.
CryptoAPI 1.0 is provided through Microsoft Windows NT 4.0 and Microsoft Internet Explorer 3.0 and later. CryptoAPI 1.0 will also ship with the Windows 95 update.
Microsoft provides a separate COM O B J E C T to make it easy to exploit this API from VBScript or Powerbuilder. But you need to installed the COM O B J E C T before using it. This How-to will show you how to call directly the Crypto DLL.
The n_cst_crypto O B J E C T can encrypt/decrypt a string based on a given key. This can be used to encrypt user/password entries in INI file for example.
Based on this Visual Basic example, the PB7 PBL containing the n_cst_crypto O B J E C T can be download from here.
Many thanks to Martyn Bannister for VB to PB development.
To encrypt a string n_cst_crypto lnv_crypt
string ls_encrypted
lnv_crypt = CREATE n_cst_crypto
ls_encrypted = lnv_crypt.EncryptData("my sensitive data" , "SecretKey")
DESTROY lnv_crypt
To decrypt a string n_cst_crypto lnv_crypt
string ls_decrypted
lnv_crypt = CREATE n_cst_crypto
ls_decrypted = lnv_crypt.DecryptData(is_crypted , "SecretKey")
DESTROY lnv_crypt
39、Get Windows OS version
You can't rely on the PB Environment Object because it doesn't return enough details. For on W2K system, the Environment returns NT as the operating system. A better way is to call directly the Win API to query the OS version. [local external function]
FUNCTION ulong GetVersionExA( REF str_osversioninfo lpVersionInfo ) &
LIBRARY "kernel32.dll"
the required structure [str_osversioninfo]
ulong dwOSVersionInfoSize
ulong dwmajorversion
ulong dwminorversion
ulong dwbuildnumber
ulong dwplatformid
character szcsdverion[128]
the possible values dwMajorVersion
Windows 95: 4
Windows 98 4
Windows ME 4
Windows NT 3.51 3
Windows NT 4 4
Windows 2000 5
Windows XP 5
dwMinorVersion
Windows 95 0
Windows 98 10
Windows ME 90
Windows NT 3.51 51
Windows NT 4 0
Windows 2000 0
Windows XP 1
To distinguish between 95 and NT, you also need to check the dwPlatformId value VER_PLATFORM_WIN32s 0
VER_PLATFORM_WIN32_WINDOWS 1 // WIN95
VER_PLATFORM_WIN32_NT 2 // NT
and from Powerscript, for example str_osversioninfo lstr_osver
lstr_osver.dwosversioninfosize = 148
GetVersionExA( lstr_osver )
IF (lstr_osver.dwmajorversion = 5 AND lstr_osver.dwminorversion = 1) THEN
MessageBox("", "Running on XP");
END IF
40、Make a window unmoveable
Map pbm_nclbuttondown to your own user event, then from your user event IF hittestcode = 2 THEN // HTCAPTION
message.processed = TRUE
RETURN 1
END IF
RETURN 0
41、Retrieve window handle by its title
[local fucntion declaration]
FUNCTION ulong FindWindowA(ulong classname,string windowname) &
LIBRARY "user32.dll"
[powerscript]
public function unsignedlong uf_findwindow (string as_name);
//
// as_name: Name of window (case sensitive)
//
// Returns: Window handle or zero if not found
//
ulong ul_class
SetNull(ul_class)
RETURN FindWindowA(ul_class,as_name)
42、Have a transparent window
[Available on W2K or better] A cool effect giving a see-through window. [local external function]
FUNCTION long GetWindowLong (ulong hWnd, int nIndex) &
LIBRARY "USER32.DLL" ALIAS FOR "GetWindowLongA"
FUNCTION long SetWindowLong (ulong hWnd, int nIndex, long dwNewLong) &
LIBRARY "USER32.DLL" ALIAS FOR "SetWindowLongA"
//W2K or better
FUNCTION long SetLayeredWindowAttributes &
(long hWnd, Long crKey , char /*Byte*/ bAlpha , Long dwFlags) &
LIBRARY "USER32.DLL"
[powerscript]
CONSTANT long LWA_COLORKEY = 1, LWA_ALPHA = 2
CONSTANT long GWL_EXSTYLE = - 20
CONSTANT long WS_EX_LAYERED = 524288 //2^19
long ll_Ret, ll_handle
// or-bitwise function
OleObject wsh
wsh = CREATE OleObject
wsh.ConnectToNewObject( "MSScriptControl.ScriptControl" )
wsh.language = "vbscript"
ll_handle = Handle (this) // handle of the window
ll_Ret = GetWindowLong(ll_handle, GWL_EXSTYLE)
ll_Ret = wsh.Eval(string(ll_ret) + " or " + string(WS_EX_LAYERED))
SetWindowLong (ll_handle, GWL_EXSTYLE, ll_Ret)
// Set the opacity of the layered window to 128 (transparent)
SetLayeredWindowAttributes (ll_handle, 0, char(128),LWA_ALPHA)
// Set the opacity of the layered window to 255 (opaque)
// SetLayeredWindowAttributes (ll_handle, 0, char(255),LWA_ALPHA)
43、Bypass Window Error popup message
[local external function]
FUNCTION ulong SetErrorMode(ulong uMode) LIBRARY "KERNEL32.DLL"
The possible parameter values are: CONSTANT ulong SEM_FAILCRITICALERRORS 1
CONSTANT ulong SEM_NOGPFAULTERRORBOX 2
CONSTANT ulong SEM_NOALIGNMENTFAULTEXCEPT 4
CONSTANT ulong SEM_NOOPENFILEERRORBOX 32768
44、Get hard disk serial number
[local external function declaration]
FUNCTION long GetVolumeInformation &
(string lpRootPathName, REF string lpVolumeNameBuffer, long nVolumeNameSize, &
REF long lpVolumeSerialNumber, REF long lpMaximumComponentLength, &
REF long lpFileSystemFlags, REF string lpFileSystemNameBuffer, &
long nFileSystemNameSize) &
LIBRARY "Kernel32.dll" ALIAS FOR "GetVolumeInformationA"
[powerscript]
String ls_volbuffer, ls_fsname
Long ll_serial, ll_MaxCompLength, ll_FileSystemFlags, ll_rtn
ls_volbuffer = Space(255)
ls_fsname = Space(255)
ll_maxCompLength = 0
ll_FileSystemFlags = 0
ll_rtn = GetVolumeinformation("C:/", ls_volbuffer, 255, ll_serial, &
ll_MaxCompLength, ll_FileSystemFlags , ls_fsname, 255)
// ls volbuffer - volume name
// ll_serial - hard disk serial number
// ls_fsname - file system name ex. NTFS |
转播
