您的位置:首页 > 产品设计 > UI/UE

PowerBuilder中的一些不太常用的方法

2014-03-27 15:02 288 查看
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
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: