WinBatch Scripting - System and User

System and User

udfBoxDisplay (time, title, text)

If (ItemLocate("udfboxdisplay",IntControl(77,103,0,0,0),@tab)>0) Then Goto skip_udfboxdisplay

#DefineFunction udfBoxDisplay (time, title, text)
BoxesUp("300,400,700,600", @normal)
BoxCaption(1,title)
BoxTextfont(1,"System",40,0,1)
BoxText(text)
BoxButtondraw(1,1,"&Ok","20,780,980,950")
start = GetTickCount()
stop = start + (1000*time)
While @true
   Ticks = stop - GetTickCount()
   If (Ticks < 0) Then Break
   If ((Ticks mod 1000) < 400) Then BoxCaption(1,StrCat(title," ... ",Int(Ticks/1000)))
   If BoxButtonstat(1,1) Then Break
   TimeDelay(0.2)
EndWhile
BoxDestroy(1)
Return
#EndFunction

:skip_udfboxdisplay


;--- test ---
udfBoxDisplay(10,"This is my title","... and this is my text.")
Exit

udfGetLongPathNameA ()
udfGetShortPathNameA ()
udfFolderNameLong ()
udfFolderNameShort ()

;------------------------------------------------------------------------------------------------------------------------------------------
; udfGetLongPathNameA ()                                                                                              ; 2002:08:19:20:04:21
; udfGetShortPathNameA ()                                                                                             ; 2002:08:19:20:04:21
; udfFolderNameLong ()                                                                                                ; 2002:08:19:20:04:21
; udfFolderNameShort ()                                                                                               ; 2002:08:19:20:04:21
;------------------------------------------------------------------------------------------------------------------------------------------

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfgetlongpathnamea",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfgetlongpathnamea

#DefineFunction udfGetLongPathNameA ()
sDirGet = DirGet()
iMAX_PATH = 262
hBB = BinaryAlloc(iMAX_PATH)
iLength = DllCall(StrCat(DirWindows(1),"kernel32.dll"),long:"GetLongPathNameA",lpstr:sDirGet,lpbinary:hBB,long:iMAX_PATH)
BinaryEodSet(hBB,iLength)
sPathName = BinaryPeekStr(hBB,0,iLength)
BinaryFree(hBB)
Return (sPathName)
#EndFunction

:skip_udfgetlongpathnamea
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfgetshortpathnamea",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfgetshortpathnamea

#DefineFunction udfGetShortPathNameA ()
sDirGet = DirGet()
iMAX_PATH = 262
hBB = BinaryAlloc(iMAX_PATH)
iLength = DllCall(StrCat(DirWindows(1),"kernel32.dll"),long:"GetShortPathNameA",lpstr:sDirGet,lpbinary:hBB,long:iMAX_PATH)
BinaryEodSet(hBB,iLength)
sPathName = BinaryPeekStr(hBB,0,iLength)
BinaryFree(hBB)
Return (sPathName)
#EndFunction

:skip_udfgetshortpathnamea
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffoldernamelong",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffoldernamelong

#DefineFunction udfFolderNameLong ()
Return (StrCat(FileNameLong(StrCat(DirGet(),".")),"\"))
#EndFunction

:skip_udffoldernamelong
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffoldernameshort",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffoldernameshort

#DefineFunction udfFolderNameShort ()
Return (FileNameShort(DirGet()))
; Return (StrCat(FileNameShort(StrCat(DirGet(),".")),"\"))
#EndFunction

:skip_udffoldernameshort
;------------------------------------------------------------------------------------------------------------------------------------------


; --- test ---

;------------------------------------------------------------------------------------------------------------------------------------------
:test1

sDirPath = "d:\tEmP\tRuEnAmEtEsT\"      ; just a common name
iResult = DirMake(sDirPath)

sDirPath = StrLower(sDirPath)           ; lowercase works
iResult = DirChange(sDirPath)

sDirPath1 = DirGet()                    ; appears as in last use of DirChange
sDirPath2 = udfGetLongPathNameA()       ; the actually really true name

MsgText  = StrCat("DirGet",@CRLF,sDirPath1,@CRLF,@CRLF,"udfGetLongPathNameA",@CRLF,sDirPath2)
MsgTitle = "udfGetLongPathNameA ()     Get long name path of a folder"
Message(MsgTitle,MsgText)

DirChange("..")
iResult = DirRemove(StrUpper(sDirPath)) ; uppercase works too

;------------------------------------------------------------------------------------------------------------------------------------------
:test2

sDirPath = "d:\tEmP\tRuEnAmEtEsT\"      ; just a common name
iResult = DirMake(sDirPath)

sDirPath = StrLower(sDirPath)           ; lowercase works
iResult = DirChange(sDirPath)

sDirPath1 = DirGet()                    ; appears as in last use of DirChange
sDirPath2 = udfGetShortPathNameA()      ; the actually really true name

MsgText  = StrCat("DirGet",@CRLF,sDirPath1,@CRLF,@CRLF,"udfGetShortPathNameA",@CRLF,sDirPath2)
MsgTitle = "udfGetShortPathNameA ()    Get short name path of a folder"
Message(MsgTitle,MsgText)

DirChange("..")
iResult = DirRemove(StrUpper(sDirPath)) ; uppercase works too

;------------------------------------------------------------------------------------------------------------------------------------------
:test3

sDirPath = "d:\tEmP\tRuEnAmEtEsT\"      ; just a common name
iResult = DirMake(sDirPath)

sDirPath = StrLower(sDirPath)           ; lowercase works
iResult = DirChange(sDirPath)

sDirPath1 = DirGet()                    ; appears as in last use of DirChange
sDirPath2 = udfFolderNameLong()         ; the actually really true name

MsgText  = StrCat("DirGet",@CRLF,sDirPath1,@CRLF,@CRLF,"udfFolderNameLong",@CRLF,sDirPath2)
MsgTitle = "udfFolderNameLong ()       Get long name path of a folder"
Message(MsgTitle,MsgText)

DirChange("..")
iResult = DirRemove(StrUpper(sDirPath)) ; uppercase works too

;------------------------------------------------------------------------------------------------------------------------------------------
:test4

sDirPath = "d:\tEmP\tRuEnAmEtEsT\"      ; just a common name
iResult = DirMake(sDirPath)

sDirPath = StrLower(sDirPath)           ; lowercase works
iResult = DirChange(sDirPath)

sDirPath1 = DirGet()                    ; appears as in last use of DirChange
sDirPath2 = udfFolderNameShort()        ; the actually really true name

MsgText  = StrCat("DirGet",@CRLF,sDirPath1,@CRLF,@CRLF,"udfFolderNameShort",@CRLF,sDirPath2)
MsgTitle = "udfFolderNameShort ()      Get short name path of a folder"
Message(MsgTitle,MsgText)

DirChange("..")
iResult = DirRemove(StrUpper(sDirPath)) ; uppercase works too

;------------------------------------------------------------------------------------------------------------------------------------------



;------------------------------------------------------------------------------------------------------------------------------------------
:performancetest

MsgTitle = "Demo  udfGetLongPathNameA, udfGetShortPathNameA, udfFoldernameLong, udfFoldernameShort   Performance Test"

TestLoop = 100
Maxtests = 4

For t=1 To 1
   Display(1,MsgTitle,"Running Test %t%, please wait ...")
   Exclusive(@ON)
   start = GetTickCount()
   For i=1 To TestLoop
      str = udfGetLongPathNameA ()
   Next
   stop = GetTickCount()
   Exclusive(@OFF)
   Ticks%t% = stop-start
Next
For t=2 To 2
   Display(1,MsgTitle,"Running Test %t%, please wait ...")
   Exclusive(@ON)
   start = GetTickCount()
   For i=1 To TestLoop
      str = udfGetShortPathNameA ()
   Next
   stop = GetTickCount()
   Exclusive(@OFF)
   Ticks%t% = stop-start
Next
For t=3 To 3
   Display(1,MsgTitle,"Running Test %t%, please wait ...")
   Exclusive(@ON)
   start = GetTickCount()
   For i=1 To TestLoop
      str = udfFolderNameLong ()
   Next
   stop = GetTickCount()
   Exclusive(@OFF)
   Ticks%t% = stop-start
Next
For t=4 To 4
   Display(1,MsgTitle,"Running Test %t%, please wait ...")
   Exclusive(@ON)
   start = GetTickCount()
   For i=1 To TestLoop
      str = udfFolderNameShort ()
   Next
   stop = GetTickCount()
   Exclusive(@OFF)
   Ticks%t% = stop-start
Next

MaxTicks = 0
For t=1 To MaxTests
   MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
   Pct%t% = 100*Ticks%t%/MaxTicks
Next
MsgText = ""
For t=1 To MaxTests
   MsgText = StrCat(MsgText,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@CRLF)
Next
Message(MsgTitle,MsgText)

Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*

udfFileDisplayDlg (File, Caption, Btn1, Btn0)


#DefineFunction udfFileDisplayDlg(File, Caption, Btn1, Btn0)
fs = filesize(File)
If Btn1 == '' then Btn1 = 'OK'
If Btn0 == '' then Btn0 = 'Cancel'
If fs > 0
   bb = binaryalloc(fs)
   binaryread(bb, File)
   Txt = binarypeekstr(bb, 0, fs)
   Txt = strreplace(Txt, @crlf, @tab)
   binaryfree(bb)
   intcontrol(52,1,0,0,0)
   MyDialogFormat = `WWWDLGED,5.0`
   MyDialogCaption = Caption
   MyDialogX = 2000
   MyDialogY = 2000
   MyDialogWidth = 250
   MyDialogHeight = 205
   MyDialogNumControls = 3
   MyDialog01 = `25 , 4 , 200, 170,ITEMBOX,Txt,DEFAULT`
   MyDialog02 = `50 , 170, 150,DEFAULT,PUSHBUTTON,DEFAULT,"%Btn1%",1`
   MyDialog03 = `50 , 184, 150,DEFAULT,PUSHBUTTON,DEFAULT,"%Btn0%",0`

Return dialog("MyDialog")
EndIf

:Cancel
Return 0

; published by rayche raymond.chevalier@vigilance.ca, Thursday, July 26, 2001 08:33 AM, in WinBatch Forum
; powered by George Vagenas gvag@home.com, Thursday, July 26, 2001 12:38 PM, in WinBatch Forum
#EndFunction

;--- test ---
Title = 'Demo udfFileDisplayDlg'
Dir = DirWindows(0)
fName = '%Dir%Win.ini'
Caption = 'Ray''s - File Display Dialog'
message(Title, udfFileDisplayDlg(fName, Caption, '', ''))
Exit

udfGetODBCDriverList (DriverPattern)
udfIsODBCDriverInstalled (DriverPattern)

;----------------------------------------------------------------------------------------------------
; udfGetODBCDriverList(DriverPattern)                                        ; DD.2001:11:13:20:40:06
; udfIsODBCDriverInstalled(DriverPattern)                                    ; DD.2001:11:13:20:40:06
;----------------------------------------------------------------------------------------------------
If itemlocate("udfgetodbcdriverlist", IntControl(77,103,0,0,0), @tab) then goto skip_udfgetodbcdriverlist
#DefineFunction udfGetODBCDriverList(DriverPattern)
DriverList=""
BufMax=4000
Buf=BinaryAlloc(BufMax)
BufEod=BinaryAlloc(4)
pBufEod=IntControl(42,BufEod,0,0,0)
If DllCall("ODBCCP32.DLL", long:"SQLGetInstalledDrivers",lpbinary:Buf,long:BufMax,long:pBufEod)
   BinaryEodSet(Buf,BinaryPeek4(BufEod,0)-1)
   BinaryFree(BufEod)
   BinaryReplace(Buf,"",@tab,@false)
   DriverList=BinaryPeekStr(Buf,0,BinaryEodGet(Buf)-1)
   BinaryFree(Buf)
   If (DriverPattern!="")
      icount=ItemCount(DriverList,@tab)
      i=1
      While (i<=icount)
         DriverItem=ItemExtract(i,DriverList,@tab)
         If !StrIndexWild(DriverItem,DriverPattern,1)
            DriverList=ItemRemove(i,DriverList,@tab)
            icount=icount-1
         else
            i=i+1
         EndIf
      EndWhile
   EndIf
EndIf
Return (DriverList)
; udfGetODBCDriverList("") returns a tab delimited list of all installed ODBC drivers.
; udfGetODBCDriverList("*dbf*") returns a tab delimited list of all installed "DBF" drivers.
; DD.20011113, Thanks to Stan Littlefield's request.
;
; this udf replaces WIL's ODBC extender routine:
; AddExtender("wwodb34i.dll")
; list=qDriverList()
;
#EndFunction
:skip_udfgetodbcdriverlist


If itemlocate("udfisodbcdriverinstalled", IntControl(77,103,0,0,0), @tab) then goto skip_udfisodbcdriverinstalled
#DefineFunction udfIsODBCDriverInstalled(DriverPattern)
Return (udfGetODBCDriverList(DriverPattern)!="")
#EndFunction
:skip_udfisodbcdriverinstalled


;--- test ---
item = AskItemList("ODBC Installed Drivers -all-",udfGetODBCDriverList(""),@tab,@unsorted,@single)       ; all drivers
item = AskItemList("ODBC Installed Drivers -*sql*-",udfGetODBCDriverList("*sql*"),@tab,@unsorted,@single)  ; only SQL
item = AskItemList("ODBC Installed Drivers -*soft*-",udfGetODBCDriverList("*soft*"),@tab,@unsorted,@single) ; only Microsoft
item = AskItemList("ODBC Installed Drivers -*dbf*-",udfGetODBCDriverList("*DBF*"),@tab,@unsorted,@single)  ; only DBF

DriverPattern = "*foxpro*"
noyes=ItemExtract(udfIsODBCDriverInstalled(DriverPattern)+1,"not ","")
message("Demo udfIsODBCDriverInstalled('%DriverPattern%')","Driver is %noyes%installed.")

DriverPattern = "*profox*"
noyes=ItemExtract(udfIsODBCDriverInstalled(DriverPattern)+1,"not ","")
message("Demo udfIsODBCDriverInstalled('%DriverPattern%')","Driver is %noyes%installed.")

:cancel
Exit

udfGetTempPath ()
udfGetTempPathA ()
udfGetWinDirA ()

;------------------------------------------------------------------------------------------------------------------------------------------
; udfGetTempPath_2 ()                                                        
; udfGetTempPath_1 ()                                                        
; udfGetTempPathA ()                                                         
; udfGetWinDirA ()                                                           
;------------------------------------------------------------------------------------------------------------------------------------------

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfgettemppath_2",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfgettemppath_2

#DefineFunction udfGetTempPath_2 ()
sFilenameTemp = FileCreateTemp("TMP")
FileDelete(sFilenameTemp)
sPathTemp = FilePath(sFilenameTemp)
Terminate(!DirMake(sPathTemp),"udfGetTempPath",StrCat("Cannot access temporary folder:",@LF,sPathTemp))
Return (sPathTemp)
;..........................................................................................................................................
; Brute force method. This function creates a 0-byte file with a unique name in the directory 
; designated for temporary files as specified by the "TMP" or "TEMP" environment variable
; and deletes it immediately, but remembers the filepath.
; GetTempPath returns the temporary folder path string,
; delimited with trailing backslash, for example "C:\TEMP\".
; Detlev Dalitz.20020127
;..........................................................................................................................................
#EndFunction

:skip_udfgettemppath_2
;------------------------------------------------------------------------------------------------------------------------------------------

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfgettemppath_1",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfgettemppath_1

#DefineFunction udfGetTempPath_1 ()
sPathTemp = Environment("TMP")
If (sPathTemp <> "") Then Goto label
sPathTemp = Environment("TEMP")
If (sPathTemp <> "") Then Goto label
sPathTemp = DirWindows(0)
:label
If (StrSub(sPathTemp,StrLen(sPathTemp),1) <> "\") Then sPathTemp = StrCat(sPathTemp,"\")
Terminate(!DirMake(sPathTemp),"udfGetTempPath",StrCat("Cannot access temporary folder:",@LF,sPathTemp))
Return (sPathTemp)
;..........................................................................................................................................
; This udf GetTempPath returns the temporary folder path string,
; delimited with trailing backslash, for example "C:\TEMP\".
; Works similar to the KERNEL32.DLL "udfGetTempPathA" call in Windows NT/2000/XP.
; Detlev Dalitz.20020127
;..........................................................................................................................................
#EndFunction

:skip_udfgettemppath_1
;------------------------------------------------------------------------------------------------------------------------------------------

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfgettemppatha",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfgettemppatha

#DefineFunction udfGetTempPathA ()
DllKernel32 = StrCat(DirWindows(1),"kernel32.dll")
hBB = BinaryAlloc(0)
Terminate((hBB == 0),"udfGetTempPathA","Buffer allocation failed.")
iResult = DllCall(DllKernel32,long:"GetTempPathA",long:0,lpbinary:hBB)
BinaryFree(hBB)
hBB = BinaryAlloc(iResult)
Terminate((hBB == 0),"udfGetTempPathA","Buffer allocation failed.")
iResult = DllCall(DllKernel32,long:"GetTempPathA",long:iResult,lpbinary:hBB)
Terminate((iResult == 0),"udfGetTempPathA","Kernel32.dll failed to detect temporary folder path.")
BinaryEodSet(hBB,iResult)
sPathTemp = BinaryPeekStr(hBB,0,iResult)
BinaryFree(hBB)
Terminate((sPathTemp == ""),"udfGetTempPathA","Detected temporary folder path is zero length.")
Terminate(!DirMake(sPathTemp),"udfGetTempPathA",StrCat("Cannot access temporary folder:",@LF,sPathTemp))
Return (sPathTemp)
;..........................................................................................................................................
; The GetTempPath function returns the Windows systems temporary folder path string,
; already delimited with trailing backslash, for example "C:\TEMP\".
;
; Windows 95/98/Me:
; The GetTempPath function gets the temporary file path as follows:
; The path specified by the TMP environment variable.
; The path specified by the TEMP environment variable,
; if TMP is not defined or if TMP specifies a directory that does not exist.
; The current directory, if both TMP and TEMP are not defined or specify nonexistent directories.
;
; Windows NT/2000/XP:
; The GetTempPath function does not verify that the directory
; specified by the TMP or TEMP environment variables exists.
; The function gets the temporary file path as follows:
; The path specified by the TMP environment variable.
; The path specified by the TEMP environment variable, if TMP is not defined.
; The Windows directory, if both TMP and TEMP are not defined.
;
; Thanks to "choppc chuckchopp@rtfmcsi.com",
; who published his Winbatch wrapper script
; and additional information from MSDN Win32 Platform SDK
; in WinBatch forum on "Saturday, January 26, 2002 10:23 AM".
; DD.20020127
;..........................................................................................................................................
#EndFunction

:skip_udfgettemppatha
;------------------------------------------------------------------------------------------------------------------------------------------

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfgetwindira",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfgetwindira

#DefineFunction udfGetWinDirA ()
DllKernel32 = StrCat(DirWindows(1),"kernel32.dll")
hBB = BinaryAlloc(0)
Terminate((hBB == 0),"udfGetWinDirA","Buffer allocation failed.")
iResult = DllCall(DllKernel32,long:"GetWindowsDirectoryA",lpbinary:hBB,long:0)
BinaryFree(hBB)
hBB = BinaryAlloc(iResult)
Terminate((hBB == 0),"udfGetWinDirA","Buffer allocation failed.")
iResult = DllCall(DllKernel32,long:"GetWindowsDirectoryA",lpbinary:hBB,long:iResult)
Terminate((iResult == 0),"udfGetWinDirA","Kernel32.dll failed to detect Windows folder path.")
BinaryEodSet(hBB,iResult)
sFolder = BinaryPeekStr(hBB,0,iResult)
sFolder = StrCat(sFolder,"\")
BinaryFree(hBB)
Return (sFolder)
; Detlev Dalitz.20020204
#EndFunction

:skip_udfgetwindira
;------------------------------------------------------------------------------------------------------------------------------------------

;--- test ---
Message("Demo udfGetTempPath_1 ()",StrCat("Temporary folder is:",@LF,udfGetTempPath_1()))
Message("Demo udfGetTempPath_2 ()",StrCat("Temporary folder is:",@LF,udfGetTempPath_2()))
Message("Demo udfGetTempPathA ()" ,StrCat("Temporary folder is:",@LF,udfGetTempPathA()))
Message("Demo udfGetWinDirA ()"   ,StrCat("Windows folder is:"  ,@LF,udfGetWinDirA()))
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*

udfGetUserNameA ()

If ItemLocate("udfgetusernamea", IntControl(77,103,0,0,0), @tab) then goto skip_udfgetusernamea
#DefineFunction udfGetUserNameA ()
Buffer=BinaryAlloc(256)
Dword=BinaryAlloc(4)
BinaryPoke4(Dword,0,256)
BinaryEodSet(Buffer,255)
User=""
advapi=strcat(dirwindows(1),"advapi32.dll")
If dllcall(advapi,long:"GetUserNameA",lpbinary:Buffer,lpbinary:Dword) then User=BinaryPeekStr(Buffer,0,256)
BinaryFree(Dword)
BinaryFree(Buffer)
Return (User)
;Conf:  WinBatch
;From:  akreutzer kreutzer@ost.state.or.us
;Date:  Tuesday, February 05, 2002 08:09 AM
#EndFunction
:skip_udfgetusernamea

;--- test ---
Message("Demo udfGetUserNameA ()",udfGetUserNameA())
Exit

udfMsgEx (lpText, lpCaption, wType)

#DefineFunction udfMsgEx(lpText,lpCaption,wType)

sDLLName = StrCat(DirWindows(1),"user32.DLL")
sEntry = StrCat("long:",'"MessageBoxA"')
hWnd=DLLhWnd("")

sArgs = "long:hWnd"
sArgs = StrCat(sArgs, ", lpstr:lpText")
sArgs = StrCat(sArgs, ", lpstr:lpCaption")
sArgs = StrCat(sArgs, ", long:wType")

xx=DLLCall(sDLLName, %sEntry%, %sArgs%)
Return xx
;published by Guido sedar@yahoo.com, Friday, July 13, 2001 03:18 PM, WinBatch Forum
#EndFunction

;--- test ---
result = udfMsgEx("Format hard drive?","Warning",4|48|256|4096)
Exit

;===============================================================================
;This udf is the same as the xMessageBox of the wilx extender,
;it could be useful to reduce the size of a compiled script if you only use the extender for that function,
;i dont have the compiler i don´t know if it works in exe format.
;
;Syntax: udfMsgEx(text,caption,type)
;Type:
;0 : OK
;1 : OKCANCEL ; close message enabled
;2 : ABORTRETRYIGNORE
;3 : YESNOCANCEL ; close message enabled
;4 : YESNO
;5 : RETRYCANCEL ; close message enabled
;ICONS:
;16 : STOP
;32 : QUESTION
;48 : EXCLAIM
;64 : INFO
;4096 : WINDOWS ICON IN CAPTION
;BUTTONS:
;0 : DEFAULT BUTTON 1
;256: DEFAULT BUTTON 2
;512: DEFAULT BUTTON 3
;You can combine the type values:
;udfMsgEx("Format hard drive?","Warning",4|48|256|4096)
;===============================================================================

udfProgressbar (hBBPbar, sCaption, iScale, iCurrent)

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfprogressbar", IntControl(77,103,0,0,0), @TAB) Then Goto skip_udfprogressbar

#DefineFunction udfProgressbar (hBBPbar, sCaption, iScale, iCurrent)
If !BinaryPeek(hBBPbar,0)
   BinaryPoke(hBBPbar,0,1)
   BoxesUp("250,150,664,230",@NORMAL) ; Adjust screen position of the box.
   BoxColor(1,"255,255,0","0")
   BoxTextColor(1,"0,0,0")
   BoxCaption(1,sCaption)
   BoxTextFont(1,"System",40,0,1)
   BoxDatatag(1,"Progressbar")
   If !IsDefined(iCurrent) Then iCurrent = 0
   If !IsDefined(iScale) Then iScale = 100
EndIf

iLength = 50 ; User configurable length (width of the bar) ; Adjust width of the box too, see BoxesUp statement above.
iPercent = 100*iCurrent/iScale
iDone = iLength*iCurrent/iScale
sPbar = StrCat("[",StrFix(StrCat(StrFixLeft(StrCat(" ",iCurrent,"/",iScale),"-",(iLength/2))," = ",iPercent,"%%"," "),"-",iLength),"]")
sPbar = StrCat(sPbar,@CRLF,"[",StrFill("*",iDone),StrFill("-",iLength-iDone),"]")
BoxDataclear(1,"Progressbar")
BoxText(sPbar)
If (iCurrent >= iScale)
   BoxDestroy(1)
   BinaryFree(hBBPbar)
EndIf
Return
;..........................................................................................................................................
; Define the global handle from outside of this udf with "hBBPbar = BinaryAlloc(1)".
; Detlev Dalitz.20010727
;..........................................................................................................................................
#EndFunction

:skip_udfprogressbar
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfprogressbarv", IntControl(77,103,0,0,0), @TAB) Then Goto skip_udfprogressbarv

#DefineFunction udfProgressbarV (hBBPbar, sCaption, iScale, iCurrent)
If !BinaryPeek(hBBPbar,0)
   BinaryPoke(hBBPbar,0,1)
   BoxesUp("800,200,840,690",@NORMAL) ; Adjust screen position of the box.
   BoxColor(1,"255,255,0","0")
   BoxTextColor(1,"0,0,0")
   BoxCaption(1,sCaption)
   BoxTextFont(1,"System",40,0,1)
   BoxDatatag(1,"Progressbar")
   If !IsDefined(iCurrent) Then iCurrent = 0
   If !IsDefined(iScale) Then iScale = 100
EndIf

iLength = 20 ; User configurable length (height of the bar) ; Adjust height of the box too, see BoxesUp statement above.
iPercent = 100*iCurrent/iScale
iDone = iLength*iCurrent/iScale

iScaleLength = StrLen(iScale)
sPbar = StrCat(StrFixLeft(iPercent," ",Max(3,iScaleLength)),"%%",@CR)
sPbar = StrCat(sPbar,StrFill(@CR,iLength-iDone),StrFill(StrCat("***",@CR),iDone*4))
sPbar = StrCat(sPbar,StrFixLeft(iCurrent," ",Max(4,iScaleLength)),@CR,StrFixLeft(iScale," ",Max(4,iScaleLength)))

BoxDataclear(1,"Progressbar")
BoxText(sPbar)
If (iCurrent >= iScale)
   BoxDestroy(1)
   BinaryFree(hBBPbar)
EndIf
Return
;..........................................................................................................................................
; Define the global handle from outside of this udf with "hBBPbar = BinaryAlloc(1)".
; Detlev Dalitz.20010727
;..........................................................................................................................................
#EndFunction

:skip_udfprogressbarv
;------------------------------------------------------------------------------------------------------------------------------------------


;--- test ---

iScale = 333
hBBPbar = BinaryAlloc(1)
For iCurrent=0 To iScale
   udfProgressbar(hBBPbar,"Fortschritt",iScale,iCurrent)
Next

iScale = 100
hBBPbar = BinaryAlloc(1)
For iCurrent=0 To iScale
   udfProgressbarV(hBBPbar,"Fortschritt",iScale,iCurrent)
Next

Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF

udfScrollText (newline, scrolltext, linecount)

If itemlocate("udfscrolltext", IntControl(77,103,0,0,0), @tab) then goto skip_udfscrolltext
#DefineFunction udfScrollText(newline,scrolltext,linecount)
If (scrolltext == "")
   scrolltext = newline
else
   scrolltext = ItemInsert(newline,-1,scrolltext,@lf)
EndIf
While (itemcount(scrolltext,@lf) > linecount)
   scrolltext = itemremove(1,scrolltext,@lf)
EndWhile
Return (scrolltext)
; Published on WinBatch forum by
; rayche raymond.chevalier@vigilance.ca
; Thursday, November 01, 2001 12:39 PM
;
; Scrolling text messages to show process progress
; The displayed text in the message box is stored in SCROLL_TXT
; NEWLINE is the new line which will be inserted at the end of the display
; LINECOUNT is the maximum number of scroll lines in the message box
; udf and example slightly modified by DD.20011102
#EndFunction
:skip_udfscrolltext


;--- test ---
scrolltext = ""
BoxOpen("Demo udfScrollText(newline,scrolltext,linecount)","")

For x = 1 to 20
   timedelay(0.2)
   newline=strcat(strfill(" ", x), "this is line ", x)

   scrolltext = udfScrollText(newline,scrolltext,7)
   scrolltext = ItemInsert("This is a fix line at top",0,scrolltext,@lf)
   scrolltext = ItemInsert("This is a fix line at bottom",-1,scrolltext,@lf)
   BoxText(scrolltext)
   scrolltext = ItemRemove(1,scrolltext,@lf)
   scrolltext = ItemRemove(ItemCount(scrolltext,@lf),scrolltext,@lf)
Next
timedelay(2)
Exit

udfSendKeyEx (str)
udfSendKeysToEx (windowname, str)

#DefineFunction udfSendKeyEx (str)
dummy = Num2Char(7)
str=StrReplace(str, "{", dummy)
str=StrReplace(str, "}", "{}}")
str=StrReplace(str, dummy,"{{}")
str=StrReplace(str, "+", "{+}")
str=StrReplace(str, "!", "{!}")
str=StrReplace(str, "^", "{^}")
str=StrReplace(str, "~", "{~}")
Return (SendKey(str))
; Detlev Dalitz.20010726.20020524
#EndFunction

#DefineFunction udfSendKeysToEx (windowname, str)
dummy = Num2Char(7)
str=StrReplace(str, "{", dummy)
str=StrReplace(str, "}", "{}}")
str=StrReplace(str, dummy,"{{}")
str=StrReplace(str, "+", "{+}")
str=StrReplace(str, "!", "{!}")
str=StrReplace(str, "^", "{^}")
str=StrReplace(str, "~", "{~}")
Return (SendKeysTo(windowname,str))
; Detlev Dalitz.20010726.20020524
#EndFunction


; --- test ---

Run("notepad","")
udfSendKeyEx("~{+44}!")

SendKey("{ENTER}")
udfSendKeyEx("-44!^~")

SendKey("{ENTER}")
udfSendKeysToEx("~Notepad","+999!~")

Exit

udfShowDesktop (option)

#DefineFunction udfShowDesktop (Option)
user32 = DllLoad(strcat(dirwindows(1),"User32.DLL"))
hWnd = DllCall(user32, long:"FindWindowExA", long:0,long:0,lpstr:"Progman",long:0)
If (hWnd<>0)
   option = min(@true,max(@false,option))
   DllCall(user32, long:"ShowWindow", long:hWnd, long:option)
EndIf
DllFree(user32)
Return
; When option is: @TRUE = Show Desktop, @FALSE = Hide Desktop
; Conf:  WinBatch
; From:  akreutzer kreutzer@ost.state.or.us
; Date:  Wednesday, October 03, 2001 04:08 PM
; modified by Detlev Dalitz.20020204
#EndFunction


;--- test ---
While @true
   MyDialogFormat=`WWWDLGED,5.0`
   MyDialogCaption=`WIL Dialog`
   MyDialogX=100
   MyDialogY=30
   MyDialogWidth=89
   MyDialogHeight=65
   MyDialogNumControls=3
   MyDialog01=`12,6,64,DEFAULT,PUSHBUTTON,DEFAULT,"Hide Desktop",10`
   MyDialog02=`12,22,64,DEFAULT,PUSHBUTTON,DEFAULT,"Show Desktop",11`
   MyDialog03=`12,38,64,DEFAULT,PUSHBUTTON,DEFAULT,"Exit",12`
   ButtonPushed=Dialog("MyDialog")

   If ButtonPushed == 10 then udfShowDesktop(@false)
   If ButtonPushed == 11 then udfShowDesktop(@true)
   If ButtonPushed == 12 then break
EndWhile
Exit

udfGetCodepage ()

;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGetCodepage ()
Return (DllCall(StrCat(DirWindows(1),"kernel32.dll"),long:"GetACP"))
#EndFunction


;--- test ---
iCP = GetCodepage()
Message("Current Codepage",iCP)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*

udfGetTimezoneInfo ()

;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGetNthDOWInMonth (sYmdHms, iOccurrence, iDayOfWeek)
; With iDayOfWeek = 0..6 ; Sunday..Saturday.
@000 = "0:0:0"
@007 = "0:0:7"
@00D = "0:0:D"
@D   = "D"
@58  = ":"
iOccurrence = Min(5,Max(1,iOccurrence))                                             ; Limit to 1..5 weeks.
iDayOfWeek  = Min(6,Max(0,iDayOfWeek))                                              ; Limit to 0..6 days.
iMonth  = ItemExtract(2,sYmdHms,@58)                                                ; Save for later check.
sYmdHms = ItemReplace(1,3,sYmdHms,@58)                                              ; Set the 01.mm.yyyy of month.
iFirstDay = ((TimeJulianDay(sYmdHms)+5) mod 7)                                      ; Sunday=0
If ((iOccurrence==1)&&(iDayOfWeek==iFirstDay)) Then Return (TimeAdd(sYmdHms,@000))  ; Return if first day of month hits the rule.
sYmdHms = TimeAdd(sYmdHms,StrReplace(@00D,@D,(7+iDayOfWeek-iFirstDay) mod 7))       ; Add diff. days to the first occurrence.
If (iOccurrence==1) Then Return (sYmdHms)                                           ; Return if this day hits the rule.
sYmdHms = TimeAdd(sYmdHms,StrReplace(@00D,@D,(7*(iOccurrence-1))))                  ; Add diff. weeks to hit the rule.
If (iMonth!=ItemExtract(2,sYmdHms,@58)) Then sYmdHms = TimeSubtract(sYmdHms,@007)   ; Fallback if necessary and subtract 7 days.
Return (sYmdHms)
;..........................................................................................................................................
; This Function "udfGetNthDowInMonth" returns the Nth occurence of the day of the week
; (for example, the second Tuesday) in the specified month.
; If the Nth day cannot be resolved in this month, then the last occurence of day will be returned.
; (for example : the fifth Thursday in July 2002 does not exist (actually it will be calculated to the 01.08.2002),
; so this function returns the last 'good' Thursday 25.07.2002.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfGetTimezoneInfo()
TIME_ZONE_ID_INVALID  = -1
TIME_ZONE_ID_UNKNOWN  = 0
TIME_ZONE_ID_STANDARD = 1
TIME_ZONE_ID_DAYLIGHT = 2
@0 = ""
@58 = ":"
@000 = "0:0:0"
sResult = @0
sStandardDate = @0
iStandardBias = @0
sStandardName = @0
sDaylightDate = @0
iDaylightBias = @0
sDaylightName = @0
iCurrentBias  = @0
iYearNow = ItemExtract(1,TimeYmdHms(),@58)
hBB = BinaryAlloc(172) ; Buffer for TIME_ZONE_INFORMATION structure.
BinaryEodSet(hBB,172)
iResult = DllCall(StrCat(DirWindows(1),"Kernel32.dll"),long:"GetTimeZoneInformation",lpbinary:hBB)
sResult = StrCat(iResult,StrFill(@TAB,7))
Switch iResult
Case TIME_ZONE_ID_INVALID
Case TIME_ZONE_ID_UNKNOWN
   Break
Case TIME_ZONE_ID_DAYLIGHT
Case TIME_ZONE_ID_STANDARD
   iCurrentBias = BinaryPeek4(hBB,0)
   iMonth = BinaryPeek2(hBB,70)
   If (iMonth>0)
      iWeekDay    = BinaryPeek2(hBB,72)
      iOccurrence = BinaryPeek2(hBB,74)
      iHour       = BinaryPeek2(hBB,76)
      sStandardDate = TimeAdd(ItemReplace(iHour,4,udfGetNthDOWInMonth(StrCat(iYearNow,@58,iMonth,@58,1),iOccurrence,iWeekDay),@58),@000)
      iStandardBias = BinaryPeek4(hBB,84)
   EndIf
   iMonth = BinaryPeek2(hBB,154)
   If (iMonth>0)
      iWeekDay    = BinaryPeek2(hBB,156)
      iOccurrence = BinaryPeek2(hBB,158)
      iHour       = BinaryPeek2(hBB,160)
      sDaylightDate = TimeAdd(ItemReplace(iHour,4,udfGetNthDOWInMonth(StrCat(iYearNow,@58,iMonth,@58,1),iOccurrence,iWeekDay),@58),@000)
      iDaylightBias = BinaryPeek4(hBB,168)
   EndIf
   BinaryConvert(hBB,3,0,0,0) ; Ugly but works.
   sStandardName = BinaryPeekStr(hBB,2,32)
   sDaylightName = BinaryPeekStr(hBB,44,32)
   sResult = StrCat(iResult,@TAB,iCurrentBias,@TAB,sStandardDate,@TAB,iStandardBias,@TAB,sStandardName,@TAB,sDaylightDate,@TAB,iDaylightBias,@TAB,sDaylightName)
   Break
EndSwitch
BinaryFree(hBB)
Return (sResult)
;..........................................................................................................................................
;   This function returns a tab delimited list of 8 items,
;   containing information about Standard and Daylight TimeZone settings.
;
;   1.
;   Status of the TIME_ZONE_ID.
;      e.g. "2"
;
;      TIME_ZONE_ID_INVALID  = -1
;
;      TIME_ZONE_ID_UNKNOWN  = 0 ...
;         The system cannot determine the current time zone.
;         Windows NT/2000/XP:
;         This value is returned if daylight saving time is not used in the current time zone, because there are no transition dates.
;
;      TIME_ZONE_ID_STANDARD = 1
;         The system is operating in the range covered by the StandardDate member of the TIME_ZONE_INFORMATION structure.
;         Windows 95/98/Me:
;         This value is returned if daylight saving time is not used in the current time zone, because there are no transition dates.
;
;      TIME_ZONE_ID_DAYLIGHT = 2
;         The system is operating in the range covered by the DaylightDate member of the TIME_ZONE_INFORMATION structure.
;
;   2.
;   Current bias for local time translation on this computer, in minutes.
;   The bias is the difference, in minutes, between Coordinated Universal Time (UTC) and local time.
;   All translations between UTC and local time are based on the following formula:
;   UTC = local time + bias
;      e.g. (GMT-10:00) Hawaii ==>iCurrentBias=600
;
;   3.
;   StandardDate
;      A YmdHms datetime string.
;      e.g. "2003:10:26:03:00:00"
;
;   4.
;   StandardBias
;      Bias value to be used during local time translations that occur during standard time.
;      This member is ignored if a value for the StandardDate member is not supplied.
;      This value is added to the value of the Bias member to form the bias used during standard time.
;      In most time zones, the value of this member is zero.
;
;   5.
;   StandardName
;      A string associated with standard time on this operating system.
;      For example, this member could contain "EST" to indicate Eastern Standard Time.
;      This string is not used by the operating system, it has only descriptive information.
;      e.g. "(MEZ) Mitteleuropäische Zeit"
;
;   6.
;   DaylightDate
;      a YmdHms datetime string.
;      e.g. "2003:03:30:02:00:00"
;
;   7.
;   DaylightBias
;      Bias value to be used during local time translations that occur during daylight saving time.
;      This member is ignored if a value for the DaylightDate member is not supplied.
;      This value is added to the value of the Bias member to form the bias used during daylight saving time.
;      In most time zones, the value of this member is - 60.
;
;   8.
;   DaylightName
;      A string associated with daylight saving time on this operating system.
;      For example, this member could contain "PDT" to indicate Pacific Daylight Time.
;      This string is not used by the operating system, it has only descriptive information.
;      e.g. "(MEZ) - Mitteleurop. Sommerzeit"
;
;..........................................................................................................................................
; Detlev Dalitz.20030920.20030924
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------



; --- test ---

sMsgTitle = "Demo  udfGetTimezoneInfo()"

sTimezoneInfo = udfGetTimezoneInfo()

iStatus       = ItemExtract(1,sTimezoneInfo,@TAB)
iCurrentBias  = ItemExtract(2,sTimezoneInfo,@TAB)
sStandardName = ItemExtract(5,sTimezoneInfo,@TAB)
sStandardDate = ItemExtract(3,sTimezoneInfo,@TAB)
iStandardBias = ItemExtract(4,sTimezoneInfo,@TAB)
sDaylightName = ItemExtract(8,sTimezoneInfo,@TAB)
sDaylightDate = ItemExtract(6,sTimezoneInfo,@TAB)
iDaylightBias = ItemExtract(7,sTimezoneInfo,@TAB)
sStatus = ItemExtract(2+iStatus,"Invalid,Unknown,Standard,Daylight saving",",")

TzInfoFormat=`WWWDLGED,6.1`
TzInfoCaption=`Timezone Information`
TzInfoX=-01
TzInfoY=-01
TzInfoWidth=178
TzInfoHeight=193
TzInfoNumControls=022
TzInfoProcedure=`DEFAULT`
TzInfoFont=`DEFAULT`
TzInfoTextColor=`DEFAULT`
TzInfoBackground=`DEFAULT,240|236|192`
TzInfoConfig=1
TzInfo001=`069,043,100,012,EDITBOX,iCurrentBias,DEFAULT,DEFAULT,4,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo002=`069,153,100,012,EDITBOX,iDaylightBias,DEFAULT,DEFAULT,10,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo003=`069,097,100,012,EDITBOX,iStandardBias,DEFAULT,DEFAULT,7,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo004=`069,029,024,012,EDITBOX,iStatus,DEFAULT,DEFAULT,2,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo005=`069,139,100,012,EDITBOX,sDaylightDate,DEFAULT,DEFAULT,9,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo006=`069,125,100,012,EDITBOX,sDaylightName,DEFAULT,DEFAULT,8,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo007=`069,083,100,012,EDITBOX,sStandardDate,DEFAULT,DEFAULT,6,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo008=`069,069,100,012,EDITBOX,sStandardName,DEFAULT,DEFAULT,5,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo009=`095,029,074,012,EDITBOX,sStatus,DEFAULT,DEFAULT,3,8,DEFAULT,DEFAULT,"255|255|255"`
TzInfo010=`003,117,170,052,GROUPBOX,DEFAULT,"Daylight",DEFAULT,33,DEFAULT,"MS Sans Serif|5632|40|34","0|128|128","240|236|192"`
TzInfo011=`003,061,170,052,GROUPBOX,DEFAULT,"Standard",DEFAULT,32,DEFAULT,"MS Sans Serif|5632|40|34","0|128|128","240|236|192"`
TzInfo012=`003,021,170,038,GROUPBOX,DEFAULT,DEFAULT,DEFAULT,31,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
TzInfo013=`073,175,036,012,PUSHBUTTON,DEFAULT,"OK",1,1,32,"MS Sans Serif|5632|70|34","0|128|128","240|236|192"`
TzInfo014=`007,141,060,012,STATICTEXT,DEFAULT,"Begin of Daylight Time",DEFAULT,27,0,DEFAULT,DEFAULT,DEFAULT`
TzInfo015=`007,085,060,012,STATICTEXT,DEFAULT,"Begin of Standard Time",DEFAULT,24,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
TzInfo016=`007,041,060,016,STATICTEXT,DEFAULT,"Bias for local time translation",DEFAULT,22,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
TzInfo017=`007,155,060,012,STATICTEXT,DEFAULT,"Daylight Bias",DEFAULT,28,0,DEFAULT,DEFAULT,DEFAULT`
TzInfo018=`007,099,060,012,STATICTEXT,DEFAULT,"Standard Bias",DEFAULT,25,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
TzInfo019=`003,005,170,016,STATICTEXT,DEFAULT,"Timezone Information",DEFAULT,20,0,"Verdana|13824|70|34","0|128|128",DEFAULT`
TzInfo020=`007,031,060,012,STATICTEXT,DEFAULT,"Timezone Status",DEFAULT,21,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
TzInfo021=`007,127,060,012,STATICTEXT,DEFAULT,"Zonename",DEFAULT,26,0,DEFAULT,DEFAULT,DEFAULT`
TzInfo022=`007,071,060,012,STATICTEXT,DEFAULT,"Zonename",DEFAULT,23,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
TzInfoButtonPushed=Dialog("TzInfo")
:CANCEL

DropWild("TzInfo*")
Drop(iCurrentBias,iDaylightBias,iStandardBias,iStatus,sDaylightDate,sDaylightName,sMsgTitle,sStandardDate,sStandardName,sStatus,sTimezoneInfo)

Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*