Ubah Resolusi Display

{ Vfp Code }
FUNCTION ChangeRes
LPARAMETERS tnWidth, tnHeight
LOCAL lnWidth, lnHeight, lnModeNum, lcDevMode
*!* Valores
lnModeNum = 0
lcDevMode = REPLICATE(CHR(0), 156)
lnWidth = IIF(EMPTY(tnWidth), 800, tnWidth)
lnHeight = IIF(EMPTY(tnHeight), 600, tnHeight)
*!* Instrucciones DECLARE DLL par'a cambiar resolución
DECLARE INTEGER EnumDisplaySettings IN Win32API ;
STRING lpszDeviceName,;
INTEGER iModeNum, ;
STRING @lpDevMode
DECLARE INTEGER ChangeDisplaySettings IN Win32API STRING @lpDevMode, INTEGER dwFlags
*!* Bucle para obtener todos los modos disponibles
DO WHILE EnumDisplaySettings(NULL, lnModeNum, @lcDevMode) <> 0
lnModeNum = lnModeNum +1
ENDDO
*!* Configurar la structura DevMode
lcDevMode = STUFF(lcDevMode, 41, 4, LongToStr(1572864))
lcDevMode = STUFF(lcDevMode, 109, 4, LongToStr(tnWidth)) && Ancho
lcDevMode = STUFF(lcDevMode, 113, 4, LongToStr(tnHeight)) && Alto
*!* Cambiar resolucion
ChangeDisplaySettings(@lcDevMode, 1)
ENDFUNC
*!* Convierte un long integer a un 4-byte character string
*!* Sintaxis: LongToStr(lnLongVal)
*!* Valor devuelto: lcRetStr
*!* Argumentos: lnLongVal
*!* lnLongVal especifica el long integer a convertir
FUNCTION LongToStr
LPARAMETERS lnLongVal
LOCAL lnCnt, lcRetStr
lcRetStr = ''
FOR lnCnt = 24 TO 0 STEP -8
lcRetStr = CHR(INT(lnLongVal/(2^lnCnt))) + lcRetStr
lnLongVal = MOD(lnLongVal, (2^lnCnt))
NEXT
RETURN lcRetStr
ENDFUNC
{ End Code }

Memperbaiki File Dbf Yang Corrupted

{ Vfp Code }
SET SAFETY OFF
SET TABLEVALIDATE TO 0 && No Table Validation performed
Use cFileCorruptedName
Copy to cTempFile && Ada bagusnya cTempFile diletakan di GETENV("Temp")+"\cTempFile"
Use cTempFile
Copy to cFileCorruptedName
*** Jika ada Index File maka tambahkan command berikut ini, dan jika tidak abaikan.
IF FILE("cFileCorruptedName.cdx")
Use cFileCorruptedName Exc
SET INDEX TO cFileCorruptedName.cdx
ReIndex
Endif
CLOSE ALL
SET TABLEVALIDATE TO 3 && Return to Default Level
*** End Statement
USE IN cTempFile
DELETE FILE cTempFile
{ End Code }

Baca Proccesor Id

{ Vfp Code }
FUNCTION GetProcID
LOCAL lcComputerName, loWMI, lowmiWin32Objects, lowmiWin32Object,ProcessorId
lcComputerName = GETWORDNUM(SYS(0),1)
loWMI = GETOBJECT("WinMgmts://" + lcComputerName)
lowmiWin32Objects = loWMI.InstancesOf("Win32_Processor")
FOR EACH lowmiWin32Object IN lowmiWin32Objects
WITH lowmiWin32Object
ProcessorId=TRANSFORM(.ProcessorId)
ENDWITH
ENDFOR
RETURN ProcessorId
{ End Code }

Check Applikasi Running di Windows

{ Vfp Code }
DIMENSION awin_apps[1]
* --- Initialize variable to store handle for current application
vfp_handle=0
* --- Declare API Functions
DECLARE INTEGER FindWindow ;
IN win32api ;
INTEGER nullpointer, ;
STRING cwindow_name
DECLARE INTEGER GetWindow ;
IN win32api ;
INTEGER ncurr_window_handle, ;
INTEGER ndirection
DECLARE INTEGER GetWindowText ;
IN win32api ;
INTEGER n_win_handle, ;
STRING @ cwindow_title, ;
INTEGER ntitle_length
* --- End of API function declarations
* --- Get handle for current application
app_screen = FindWindow(0,_SCREEN.CAPTION)
* --- Store handle of current app to a variable
ln_current_window = app_screen
* --- Initialize a count variable used to dimension array of running apps
ln_window_count = 0
DO WHILE ln_current_window > 0
* --- Initialize variable to store application title
lc_window_title=SPACE(255)
* --- Call to GetWindowText to fetch window caption
ln_length=GetWindowText(ln_current_window, ;
@lc_window_title,LEN(lc_window_title))
* --- Note that the lc_window_title variable is used as a buffer to
* --- receive text from the call to GetWindowText
IF ln_length>0
lc_window_title=STRTRAN(TRIM(lc_window_title),CHR(0),"")
ELSE
lc_window_title=""
ENDIF
IF ln_current_window>0 .AND. !EMPTY(lc_window_title)
* --- Increment the window count and re-dimension the array of running
* --- applications
ln_window_count=ln_window_count+1
DIMENSION awin_apps(ln_window_count)
awin_apps[ln_Window_Count]=lc_window_title
ENDIF
* --- Call to GetWindow to fetch handle of running applications.
ln_current_window=GetWindow(ln_current_window,2)
ENDDO
* --- Get a unique file name for this in the event this is run
* --- on a centralized multi-user server
isrunfyl=SUBSTR(SYS(2015),3,10)
* --- Create a free table based upon unique name
CREATE CURSOR isrunfyl (appname C(200))
*USE &isrunfyl ALIAS isrunfyl
* --- Fill the table
IF ALEN(awin_apps,1) > 0
SELECT isrunfyl
FOR i=1 TO ALEN(awin_apps,1)
APPEND BLANK
REPLACE appname WITH ALLTRIM(awin_apps[i])
NEXT
ENDIF
GOTO TOP
SELECT appname,COUNT(appname) AS counted ;
FROM isrunfyl ;
INTO CURSOR ctemp ;
ORDER BY appname GROUP BY appname
USE IN isrunfyl
SELECT appname,counted ;
FROM ctemp INTO CURSOR ctemp ORDER BY counted DESC
SELECT ctemp
BROWSE NORMAL
{ End Code }

SETTING TOOL

{ Vfp Code }
SET RESOURCE OFF
USE (SYS(2005)) excl
PACK
USE
SET RESOURCE ON
{ End Code }

Check IP Address

{ Vfp Code }
IPcomp = CREATEOBJECT('MSWinsock.Winsock.1')
MESSAGEBOX("IP Address Computer Anda : "+CHR(13)+IPcomp.LocalIP,64+0,"IP address")
{ End Code }

Fox-Mania

Selamat Datang di Blog http://fox-mania.blogspot.com/

Blog ini dikhususkan bagi para programmer yg menggunakan Visual Foxpro dan berdomisili di Indonesia. Silahkan bergabung disini.